From gitlab at gitlab.haskell.org Thu Jun 1 00:04:43 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Wed, 31 May 2023 20:04:43 -0400 Subject: [Git][ghc/ghc][wip/haddock-mem-fixes] 2 commits: Memory usage fixes for Haddock Message-ID: <6477e09b1fcc9_16c0273b4dfa4973b9@gitlab.mail> Finley McIlwaine pushed to branch wip/haddock-mem-fixes at Glasgow Haskell Compiler / GHC Commits: d3fe2047 by Finley McIlwaine at 2023-05-25T13:37:33-06:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Strictly evaluate some SrcSpans in mkDoc{Next,Prev} to avoid thunks - Strictly evaluate names in `rnHsDoc` to avoid retention of GlobalRdrEnv - Strictly evaluate fields of `IfaceTyConInfo` - Update haddock perf tests to be more accurate and force evaluation of renamed doc thunks using `-fwrite-interface` - Accept a higher increase (40%) in allocations in the renamer due to `-haddock`. - Update Haddock submodule to move over to initial implementation of hi-haddock, including the other memory performance gains recently added to haddock. - - - - - 8a4cef74 by Finley McIlwaine at 2023-05-31T18:02:25-06:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. Also bump haddock to latest dev commit. - - - - - 10 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/Doc.hs - compiler/GHC/Types/Name/Occurrence.hs - testsuite/tests/haddock/perf/Fold.hs - testsuite/tests/haddock/perf/Makefile - utils/haddock Changes: ===================================== compiler/GHC/Driver/Backend.hs ===================================== @@ -551,17 +551,14 @@ backendRespectsSpecialise (Named NoBackend) = False -- | This back end wants the `mi_globals` field of a -- `ModIface` to be populated (with the top-level bindings --- of the original source). True for the interpreter, and --- also true for "no backend", which is used by Haddock. --- (After typechecking a module, Haddock wants access to --- the module's `GlobalRdrEnv`.) +-- of the original source). Only true for the interpreter. backendWantsGlobalBindings :: Backend -> Bool backendWantsGlobalBindings (Named NCG) = False backendWantsGlobalBindings (Named LLVM) = False backendWantsGlobalBindings (Named ViaC) = False backendWantsGlobalBindings (Named JavaScript) = False +backendWantsGlobalBindings (Named NoBackend) = False backendWantsGlobalBindings (Named Interpreter) = True -backendWantsGlobalBindings (Named NoBackend) = True -- | The back end targets a technology that implements -- `switch` natively. (For example, LLVM or C.) Therefore ===================================== compiler/GHC/Hs/Doc.hs ===================================== @@ -123,7 +123,7 @@ type LHsDoc pass = Located (HsDoc pass) data DocStructureItem = DsiSectionHeading !Int !(HsDoc GhcRn) | DsiDocChunk !(HsDoc GhcRn) - | DsiNamedChunkRef !(String) + | DsiNamedChunkRef !String | DsiExports !Avails | DsiModExport !(NonEmpty ModuleName) -- ^ We might re-export avails from multiple ===================================== compiler/GHC/HsToCore/Docs.hs ===================================== @@ -31,18 +31,18 @@ import Data.Bifunctor (first) import Data.Foldable (toList) import Data.IntMap (IntMap) import qualified Data.IntMap as IM +import qualified Data.List.NonEmpty as NonEmpty +import Data.List.NonEmpty (NonEmpty ((:|))) import Data.Map.Strict (Map) import qualified Data.Map as M -import qualified Data.Set as Set import Data.Maybe +import qualified Data.Set as Set import Data.Semigroup import GHC.IORef (readIORef) import GHC.Unit.Types import GHC.Hs import GHC.Types.Avail import GHC.Unit.Module -import qualified Data.List.NonEmpty as NonEmpty -import Data.List.NonEmpty (NonEmpty ((:|))) import GHC.Unit.Module.Imported import GHC.Driver.Session import GHC.Types.TypeEnv @@ -192,7 +192,13 @@ mkDocStructureFromDecls env all_exports decls = Just loc -> L loc (DsiExports [avail]) -- FIXME: This is just a workaround that we use when handling e.g. -- associated data families like in the html-test Instances.hs. - Nothing -> noLoc (DsiExports [avail]) + Nothing -> noLoc (DsiExports []) + + -- This causes the associated data family to be incorrectly documented + -- separately from its class: + -- Nothing -> noLoc (DsiExports []) + + -- This panics on the associated data family: -- Nothing -> panicDoc "mkDocStructureFromDecls: No loc found for" -- (ppr avail) ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -355,13 +355,13 @@ See Note [The equality types story] in GHC.Builtin.Types.Prim. -} data IfaceTyConInfo -- Used only to guide pretty-printing - = IfaceTyConInfo { ifaceTyConIsPromoted :: PromotionFlag + = IfaceTyConInfo { ifaceTyConIsPromoted :: !PromotionFlag -- A PromotionFlag value of IsPromoted indicates -- that the type constructor came from a data -- constructor promoted by -XDataKinds, and thus -- should be printed as 'D to distinguish it from -- an existing type constructor D. - , ifaceTyConSort :: IfaceTyConSort } + , ifaceTyConSort :: !IfaceTyConSort } deriving (Eq) -- This smart constructor allows sharing of the two most common ===================================== compiler/GHC/Parser/PostProcess/Haddock.hs ===================================== @@ -1360,11 +1360,15 @@ mkDocIE (L l_comment hdk_comment) = span = mkSrcSpanPs l_comment mkDocNext :: PsLocated HdkComment -> Maybe (Located HsDocString) -mkDocNext (L l (HdkCommentNext doc)) = Just (L (mkSrcSpanPs l) doc) +mkDocNext (L l (HdkCommentNext doc)) = + let !src_span = mkSrcSpanPs l + in Just (L src_span doc) mkDocNext _ = Nothing mkDocPrev :: PsLocated HdkComment -> Maybe (Located HsDocString) -mkDocPrev (L l (HdkCommentPrev doc)) = Just (L (mkSrcSpanPs l) doc) +mkDocPrev (L l (HdkCommentPrev doc)) = + let !src_span = mkSrcSpanPs l + in Just (L src_span doc) mkDocPrev _ = Nothing ===================================== compiler/GHC/Rename/Doc.hs ===================================== @@ -1,5 +1,7 @@ module GHC.Rename.Doc ( rnHsDoc, rnLHsDoc, rnLDocDecl, rnDocDecl ) where +import Control.DeepSeq (force) + import GHC.Prelude import GHC.Tc.Types @@ -33,7 +35,11 @@ rnDocDecl (DocGroup i doc) = do rnHsDoc :: WithHsDocIdentifiers a GhcPs -> RnM (WithHsDocIdentifiers a GhcRn) rnHsDoc (WithHsDocIdentifiers s ids) = do gre <- tcg_rdr_env <$> getGblEnv - pure (WithHsDocIdentifiers s (rnHsDocIdentifiers gre ids)) + + -- This is forced to avoid retention of the GlobalRdrEnv + let !rn = force $ rnHsDocIdentifiers gre ids + + pure (WithHsDocIdentifiers s rn) rnHsDocIdentifiers :: GlobalRdrEnv -> [Located RdrName] ===================================== compiler/GHC/Types/Name/Occurrence.hs ===================================== @@ -600,7 +600,7 @@ unitOccEnv (OccName ns s) a = MkOccEnv $ unitFsEnv s (unitUFM ns a) -- | Add a single element to an 'OccEnv'. extendOccEnv :: OccEnv a -> OccName -> a -> OccEnv a extendOccEnv (MkOccEnv as) (OccName ns s) a = - MkOccEnv $ extendFsEnv_C plusUFM as s (unitUFM ns a) + MkOccEnv $ extendFsEnv_C plusUFM as s $! unitUFM ns a -- | Extend an 'OccEnv' by a list. -- ===================================== testsuite/tests/haddock/perf/Fold.hs ===================================== @@ -143,6 +143,7 @@ import Prelude import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NonEmpty import Control.Monad as Monad +import Control.Monad.Fix import Control.Monad.Reader import qualified Control.Monad.Reader as Reader import Data.Functor ===================================== testsuite/tests/haddock/perf/Makefile ===================================== @@ -4,12 +4,12 @@ include $(TOP)/mk/test.mk # We accept a 5% increase in parser allocations due to -haddock haddock_parser_perf : - WithHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fforce-recomp -Wno-all -ddump-timings -haddock -O0 Fold.hs 2>/dev/null | grep Parser | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ - WithoutHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fforce-recomp -Wno-all -ddump-timings -O0 Fold.hs 2>/dev/null | grep Parser | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ + WithHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface -fforce-recomp -Wno-all -ddump-timings -haddock -O0 Fold.hs 2>/dev/null | grep Parser | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ + WithoutHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface -fforce-recomp -Wno-all -ddump-timings -O0 Fold.hs 2>/dev/null | grep Parser | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ awk "BEGIN { ratio = ($$WithHaddock / $$WithoutHaddock); if (ratio > 1.05) {print \"-haddock allocation ratio too high:\", ratio; exit 1} else {exit 0} }" -# Similarly for the renamer +# We accept a 40% increase in renamer allocations due to -haddock haddock_renamer_perf : - WithoutHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fforce-recomp -Wno-all -ddump-timings -O0 Fold.hs 2>/dev/null | grep Renamer | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ - WithHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fforce-recomp -Wno-all -ddump-timings -haddock -O0 Fold.hs 2>/dev/null | grep Renamer | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ - awk "BEGIN { ratio = ($$WithHaddock / $$WithoutHaddock); if (ratio > 1.20) {print \"-haddock allocation ratio too high:\", ratio; exit 1} else {exit 0} }" + WithoutHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface -fforce-recomp -Wno-all -ddump-timings -O0 Fold.hs 2>/dev/null | grep Renamer | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ + WithHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface -fforce-recomp -Wno-all -ddump-timings -haddock -O0 Fold.hs 2>/dev/null | grep Renamer | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ + awk "BEGIN { ratio = ($$WithHaddock / $$WithoutHaddock); if (ratio > 1.40) {print \"-haddock allocation ratio too high:\", ratio; exit 1} else {exit 0} }" ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit e16e20d592a6f5d9ed1af17b77fafd6495242345 +Subproject commit e85b2a7be1e1d03ee5dfbb26b2a4bc3d0e455166 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0bf53ae8427973c0b29e858668b08a37ff5e760e...8a4cef74d1dab2c8698b54bdc4a30a3431cbb16c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0bf53ae8427973c0b29e858668b08a37ff5e760e...8a4cef74d1dab2c8698b54bdc4a30a3431cbb16c You're receiving 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 Jun 1 00:05:11 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Wed, 31 May 2023 20:05:11 -0400 Subject: [Git][ghc/ghc][wip/haddock-mem-fixes] 48 commits: Migrate errors in GHC.Tc.Validity Message-ID: <6477e0b710d68_16c027c2c2c97927@gitlab.mail> Finley McIlwaine pushed to branch wip/haddock-mem-fixes at Glasgow Haskell Compiler / GHC Commits: 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - 10cc17e5 by Finley McIlwaine at 2023-05-31T18:05:01-06:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Strictly evaluate some SrcSpans in mkDoc{Next,Prev} to avoid thunks - Strictly evaluate names in `rnHsDoc` to avoid retention of GlobalRdrEnv - Strictly evaluate fields of `IfaceTyConInfo` - Update haddock perf tests to be more accurate and force evaluation of renamed doc thunks using `-fwrite-interface` - Accept a higher increase (40%) in allocations in the renamer due to `-haddock`. - Update Haddock submodule to move over to initial implementation of hi-haddock, including the other memory performance gains recently added to haddock. - - - - - 484c547b by Finley McIlwaine at 2023-05-31T18:05:01-06:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. Also bump haddock to latest dev commit. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CmdLine.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Config/Cmm.hs - compiler/GHC/Driver/Config/Cmm/Parser.hs - compiler/GHC/Driver/Config/CmmToAsm.hs - compiler/GHC/Driver/Config/CmmToLlvm.hs - compiler/GHC/Driver/Config/Core/Lint.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8a4cef74d1dab2c8698b54bdc4a30a3431cbb16c...484c547bfa513e47e062d85c1dab732175d481c4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8a4cef74d1dab2c8698b54bdc4a30a3431cbb16c...484c547bfa513e47e062d85c1dab732175d481c4 You're receiving 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 Jun 1 00:27:09 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Wed, 31 May 2023 20:27:09 -0400 Subject: [Git][ghc/ghc][wip/expand-do] 43 commits: Introduce GHCiMessage to wrap GhcMessage Message-ID: <6477e5dd48184_16c027c2f601043ba@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - 19189127 by Apoorv Ingle at 2023-05-31T16:25:13-05:00 Fixes #18324 #23147 Expands do notation before typechecking using `HsExpansion` - Adds testcases T18324, T18324b, DoubleMatch Expands - Do statements - Monadic do statements - monadic fix blocks - make sure fail is used for pattern match failures in bind statments - Makes sure unused binds generate warnings - runs the pattern match check in generated lambda exprs to avoid getting suprious pattern match failures. c.f. pmcheck/should_compile/DoubleMatch.hs - PopSrcSpan in HsExpr to pop error context - Discards default monad fail alternatives that are spuriously generated - Make sure we check for generated loc span for checking if the (>>) is user written or expanded for /do/ purposes - - - - - 8b3ad06d by Apoorv Ingle at 2023-05-31T16:25:17-05:00 PopSrcSpan as a XXExprGhcRn - - - - - 1b9973f1 by Apoorv Ingle at 2023-05-31T16:25:17-05:00 add PopSrcSpan in appropriate places while desugaring - - - - - 070308fb by Apoorv Ingle at 2023-05-31T16:25:17-05:00 add correct source spans for warnDiscardedDoBindings - - - - - fb514286 by Apoorv Ingle at 2023-05-31T16:25:17-05:00 use mkExpandStmt to store original stmts along with expanded expr for using the right context for error message printing - - - - - 356caa8d by Apoorv Ingle at 2023-05-31T16:25:18-05:00 do not leak generated expressions in the error context, need to fix push and pop error contexts for ExpandedStmts - - - - - 579be422 by Apoorv Ingle at 2023-05-31T16:25:18-05:00 imporving error messages for applicative do - - - - - 58b44624 by Apoorv Ingle at 2023-05-31T16:26:45-05:00 remove special case from isMatchContextPmChecked - - - - - fed5b2be by Apoorv Ingle at 2023-05-31T16:26:50-05:00 set correct src spans to statement expansions - - - - - 0880bfcd by Apoorv Ingle at 2023-05-31T16:26:50-05:00 PopSrcSpan should be followed by tcApp - - - - - 0864285c by Apoorv Ingle at 2023-05-31T16:26:50-05:00 change the match ctxt while type checking HsLam if the lambda match is due to an expression generated from a do block - - - - - ab032ddb by Apoorv Ingle at 2023-05-31T16:26:50-05:00 add a more appropriate error context for case alternative in failable do stmt pattern binding - - - - - a6544bfc by Apoorv Ingle at 2023-05-31T16:26:50-05:00 more error context changes - - - - - f581d27c by Apoorv Ingle at 2023-05-31T19:27:00-05:00 call tcExpr and not tcApp in PopSrcSpan so make sure impredicativity works fine - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Type.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CmdLine.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Config/Cmm.hs - compiler/GHC/Driver/Config/Cmm/Parser.hs - compiler/GHC/Driver/Config/CmmToAsm.hs - compiler/GHC/Driver/Config/CmmToLlvm.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Config/Core/Lint/Interactive.hs - compiler/GHC/Driver/Config/Core/Opt/Arity.hs - compiler/GHC/Driver/Config/Core/Opt/LiberateCase.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ba56694691955e3bcedaad9cf419cdcf0bab2796...f581d27c9eb37db5954dffa7b138ba9b7cc36b17 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ba56694691955e3bcedaad9cf419cdcf0bab2796...f581d27c9eb37db5954dffa7b138ba9b7cc36b17 You're receiving 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 Jun 1 00:44:30 2023 From: gitlab at gitlab.haskell.org (Matthew Craven (@clyring)) Date: Wed, 31 May 2023 20:44:30 -0400 Subject: [Git][ghc/ghc][wip/generate-addr-ops] Generate Addr# access ops programmatically Message-ID: <6477e9ee5b29d_16c027c2f60107924@gitlab.mail> Matthew Craven pushed to branch wip/generate-addr-ops at Glasgow Haskell Compiler / GHC Commits: ee0b2e24 by Matthew Craven at 2023-05-31T20:39:53-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - 5 changed files: - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - hadrian/src/Rules/Generate.hs - rts/gen_event_types.py Changes: ===================================== compiler/GHC/Builtin/bytearray-ops.txt.pp deleted ===================================== @@ -1,551 +0,0 @@ - ------------------------------------- --- ByteArray# operations ------------------------------------- - - --- Do not edit. This file is generated by utils/genprimopcode/gen_bytearray_ops.py. --- To regenerate run, --- --- python3 utils/genprimops/gen_bytearray_ops.py > compiler/GHC/Builtin/bytearray-ops.txt.pp - - ------------------------------------- --- aligned index operations ------------------------------------- - -primop IndexByteArrayOp_Char "indexCharArray#" GenPrimOp - ByteArray# -> Int# -> Char# - {Read a 8-bit character; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_WideChar "indexWideCharArray#" GenPrimOp - ByteArray# -> Int# -> Char# - {Read a 32-bit character; offset in 4-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Int "indexIntArray#" GenPrimOp - ByteArray# -> Int# -> Int# - {Read a word-sized integer; offset in machine words.} - with can_fail = True - -primop IndexByteArrayOp_Word "indexWordArray#" GenPrimOp - ByteArray# -> Int# -> Word# - {Read a word-sized unsigned integer; offset in machine words.} - with can_fail = True - -primop IndexByteArrayOp_Addr "indexAddrArray#" GenPrimOp - ByteArray# -> Int# -> Addr# - {Read a machine address; offset in machine words.} - with can_fail = True - -primop IndexByteArrayOp_Float "indexFloatArray#" GenPrimOp - ByteArray# -> Int# -> Float# - {Read a single-precision floating-point value; offset in 4-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Double "indexDoubleArray#" GenPrimOp - ByteArray# -> Int# -> Double# - {Read a double-precision floating-point value; offset in 8-byte words.} - with can_fail = True - -primop IndexByteArrayOp_StablePtr "indexStablePtrArray#" GenPrimOp - ByteArray# -> Int# -> StablePtr# a - {Read a 'StablePtr#' value; offset in machine words.} - with can_fail = True - -primop IndexByteArrayOp_Int8 "indexInt8Array#" GenPrimOp - ByteArray# -> Int# -> Int8# - {Read a 8-bit signed integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Int16 "indexInt16Array#" GenPrimOp - ByteArray# -> Int# -> Int16# - {Read a 16-bit signed integer; offset in 2-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Int32 "indexInt32Array#" GenPrimOp - ByteArray# -> Int# -> Int32# - {Read a 32-bit signed integer; offset in 4-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Int64 "indexInt64Array#" GenPrimOp - ByteArray# -> Int# -> Int64# - {Read a 64-bit signed integer; offset in 8-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Word8 "indexWord8Array#" GenPrimOp - ByteArray# -> Int# -> Word8# - {Read a 8-bit unsigned integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word16 "indexWord16Array#" GenPrimOp - ByteArray# -> Int# -> Word16# - {Read a 16-bit unsigned integer; offset in 2-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Word32 "indexWord32Array#" GenPrimOp - ByteArray# -> Int# -> Word32# - {Read a 32-bit unsigned integer; offset in 4-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Word64 "indexWord64Array#" GenPrimOp - ByteArray# -> Int# -> Word64# - {Read a 64-bit unsigned integer; offset in 8-byte words.} - with can_fail = True - - ------------------------------------- --- unaligned index operations ------------------------------------- - -primop IndexByteArrayOp_Word8AsChar "indexWord8ArrayAsChar#" GenPrimOp - ByteArray# -> Int# -> Char# - {Read a 8-bit character; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsWideChar "indexWord8ArrayAsWideChar#" GenPrimOp - ByteArray# -> Int# -> Char# - {Read a 32-bit character; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsInt "indexWord8ArrayAsInt#" GenPrimOp - ByteArray# -> Int# -> Int# - {Read a word-sized integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsWord "indexWord8ArrayAsWord#" GenPrimOp - ByteArray# -> Int# -> Word# - {Read a word-sized unsigned integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsAddr "indexWord8ArrayAsAddr#" GenPrimOp - ByteArray# -> Int# -> Addr# - {Read a machine address; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsFloat "indexWord8ArrayAsFloat#" GenPrimOp - ByteArray# -> Int# -> Float# - {Read a single-precision floating-point value; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsDouble "indexWord8ArrayAsDouble#" GenPrimOp - ByteArray# -> Int# -> Double# - {Read a double-precision floating-point value; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsStablePtr "indexWord8ArrayAsStablePtr#" GenPrimOp - ByteArray# -> Int# -> StablePtr# a - {Read a 'StablePtr#' value; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsInt16 "indexWord8ArrayAsInt16#" GenPrimOp - ByteArray# -> Int# -> Int16# - {Read a 16-bit signed integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsInt32 "indexWord8ArrayAsInt32#" GenPrimOp - ByteArray# -> Int# -> Int32# - {Read a 32-bit signed integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsInt64 "indexWord8ArrayAsInt64#" GenPrimOp - ByteArray# -> Int# -> Int64# - {Read a 64-bit signed integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsWord16 "indexWord8ArrayAsWord16#" GenPrimOp - ByteArray# -> Int# -> Word16# - {Read a 16-bit unsigned integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsWord32 "indexWord8ArrayAsWord32#" GenPrimOp - ByteArray# -> Int# -> Word32# - {Read a 32-bit unsigned integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsWord64 "indexWord8ArrayAsWord64#" GenPrimOp - ByteArray# -> Int# -> Word64# - {Read a 64-bit unsigned integer; offset in bytes.} - with can_fail = True - - ------------------------------------- --- aligned read operations ------------------------------------- - -primop ReadByteArrayOp_Char "readCharArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) - {Read a 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_WideChar "readWideCharArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) - {Read a 32-bit character; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int "readIntArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #) - {Read a word-sized integer; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word "readWordArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #) - {Read a word-sized unsigned integer; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Addr "readAddrArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Addr# #) - {Read a machine address; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Float "readFloatArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Float# #) - {Read a single-precision floating-point value; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Double "readDoubleArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Double# #) - {Read a double-precision floating-point value; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_StablePtr "readStablePtrArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, StablePtr# a #) - {Read a 'StablePtr#' value; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int8 "readInt8Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int8# #) - {Read a 8-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int16 "readInt16Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int16# #) - {Read a 16-bit signed integer; offset in 2-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int32 "readInt32Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int32# #) - {Read a 32-bit signed integer; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int64 "readInt64Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int64# #) - {Read a 64-bit signed integer; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8 "readWord8Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word8# #) - {Read a 8-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word16 "readWord16Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word16# #) - {Read a 16-bit unsigned integer; offset in 2-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word32 "readWord32Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word32# #) - {Read a 32-bit unsigned integer; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word64 "readWord64Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word64# #) - {Read a 64-bit unsigned integer; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - - ------------------------------------- --- unaligned read operations ------------------------------------- - -primop ReadByteArrayOp_Word8AsChar "readWord8ArrayAsChar#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) - {Read a 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsWideChar "readWord8ArrayAsWideChar#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) - {Read a 32-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsInt "readWord8ArrayAsInt#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #) - {Read a word-sized integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsWord "readWord8ArrayAsWord#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #) - {Read a word-sized unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsAddr "readWord8ArrayAsAddr#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Addr# #) - {Read a machine address; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsFloat "readWord8ArrayAsFloat#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Float# #) - {Read a single-precision floating-point value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsDouble "readWord8ArrayAsDouble#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Double# #) - {Read a double-precision floating-point value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsStablePtr "readWord8ArrayAsStablePtr#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, StablePtr# a #) - {Read a 'StablePtr#' value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsInt16 "readWord8ArrayAsInt16#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int16# #) - {Read a 16-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsInt32 "readWord8ArrayAsInt32#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int32# #) - {Read a 32-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsInt64 "readWord8ArrayAsInt64#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int64# #) - {Read a 64-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsWord16 "readWord8ArrayAsWord16#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word16# #) - {Read a 16-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsWord32 "readWord8ArrayAsWord32#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word32# #) - {Read a 32-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsWord64 "readWord8ArrayAsWord64#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word64# #) - {Read a 64-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - - ------------------------------------- --- aligned write operations ------------------------------------- - -primop WriteByteArrayOp_Char "writeCharArray#" GenPrimOp - MutableByteArray# s -> Int# -> Char# -> State# s -> State# s - {Write a 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_WideChar "writeWideCharArray#" GenPrimOp - MutableByteArray# s -> Int# -> Char# -> State# s -> State# s - {Write a 32-bit character; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int "writeIntArray#" GenPrimOp - MutableByteArray# s -> Int# -> Int# -> State# s -> State# s - {Write a word-sized integer; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word "writeWordArray#" GenPrimOp - MutableByteArray# s -> Int# -> Word# -> State# s -> State# s - {Write a word-sized unsigned integer; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Addr "writeAddrArray#" GenPrimOp - MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s - {Write a machine address; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Float "writeFloatArray#" GenPrimOp - MutableByteArray# s -> Int# -> Float# -> State# s -> State# s - {Write a single-precision floating-point value; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Double "writeDoubleArray#" GenPrimOp - MutableByteArray# s -> Int# -> Double# -> State# s -> State# s - {Write a double-precision floating-point value; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_StablePtr "writeStablePtrArray#" GenPrimOp - MutableByteArray# s -> Int# -> StablePtr# a -> State# s -> State# s - {Write a 'StablePtr#' value; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int8 "writeInt8Array#" GenPrimOp - MutableByteArray# s -> Int# -> Int8# -> State# s -> State# s - {Write a 8-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int16 "writeInt16Array#" GenPrimOp - MutableByteArray# s -> Int# -> Int16# -> State# s -> State# s - {Write a 16-bit signed integer; offset in 2-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int32 "writeInt32Array#" GenPrimOp - MutableByteArray# s -> Int# -> Int32# -> State# s -> State# s - {Write a 32-bit signed integer; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int64 "writeInt64Array#" GenPrimOp - MutableByteArray# s -> Int# -> Int64# -> State# s -> State# s - {Write a 64-bit signed integer; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8 "writeWord8Array#" GenPrimOp - MutableByteArray# s -> Int# -> Word8# -> State# s -> State# s - {Write a 8-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word16 "writeWord16Array#" GenPrimOp - MutableByteArray# s -> Int# -> Word16# -> State# s -> State# s - {Write a 16-bit unsigned integer; offset in 2-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word32 "writeWord32Array#" GenPrimOp - MutableByteArray# s -> Int# -> Word32# -> State# s -> State# s - {Write a 32-bit unsigned integer; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word64 "writeWord64Array#" GenPrimOp - MutableByteArray# s -> Int# -> Word64# -> State# s -> State# s - {Write a 64-bit unsigned integer; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - - ------------------------------------- --- unaligned write operations ------------------------------------- - -primop WriteByteArrayOp_Word8AsChar "writeWord8ArrayAsChar#" GenPrimOp - MutableByteArray# s -> Int# -> Char# -> State# s -> State# s - {Write a 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsWideChar "writeWord8ArrayAsWideChar#" GenPrimOp - MutableByteArray# s -> Int# -> Char# -> State# s -> State# s - {Write a 32-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsInt "writeWord8ArrayAsInt#" GenPrimOp - MutableByteArray# s -> Int# -> Int# -> State# s -> State# s - {Write a word-sized integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsWord "writeWord8ArrayAsWord#" GenPrimOp - MutableByteArray# s -> Int# -> Word# -> State# s -> State# s - {Write a word-sized unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsAddr "writeWord8ArrayAsAddr#" GenPrimOp - MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s - {Write a machine address; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsFloat "writeWord8ArrayAsFloat#" GenPrimOp - MutableByteArray# s -> Int# -> Float# -> State# s -> State# s - {Write a single-precision floating-point value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsDouble "writeWord8ArrayAsDouble#" GenPrimOp - MutableByteArray# s -> Int# -> Double# -> State# s -> State# s - {Write a double-precision floating-point value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsStablePtr "writeWord8ArrayAsStablePtr#" GenPrimOp - MutableByteArray# s -> Int# -> StablePtr# a -> State# s -> State# s - {Write a 'StablePtr#' value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsInt16 "writeWord8ArrayAsInt16#" GenPrimOp - MutableByteArray# s -> Int# -> Int16# -> State# s -> State# s - {Write a 16-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsInt32 "writeWord8ArrayAsInt32#" GenPrimOp - MutableByteArray# s -> Int# -> Int32# -> State# s -> State# s - {Write a 32-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsInt64 "writeWord8ArrayAsInt64#" GenPrimOp - MutableByteArray# s -> Int# -> Int64# -> State# s -> State# s - {Write a 64-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsWord16 "writeWord8ArrayAsWord16#" GenPrimOp - MutableByteArray# s -> Int# -> Word16# -> State# s -> State# s - {Write a 16-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsWord32 "writeWord8ArrayAsWord32#" GenPrimOp - MutableByteArray# s -> Int# -> Word32# -> State# s -> State# s - {Write a 32-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsWord64 "writeWord8ArrayAsWord64#" GenPrimOp - MutableByteArray# s -> Int# -> Word64# -> State# s -> State# s - {Write a 64-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - ===================================== utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py ===================================== @@ -1,8 +1,32 @@ #!/usr/bin/env python # -*- coding: utf-8 -*- +# This script generates the primop descriptions for many similar ByteArray# +# and Addr# access operations. Its output is #include-d into primops.txt.pp. + from typing import Optional, NamedTuple import textwrap +import argparse + +arg_parser = argparse.ArgumentParser() +arg_parser.add_argument('addr_or_bytearray', + choices = ["addr-access-ops", "bytearray-access-ops"], + ) +arg_parser.add_argument('output_file', + type=argparse.FileType('w'), + metavar='FILE', + ) +args = arg_parser.parse_args() +write = args.output_file.write + + + +write(''' +-- Do not edit. +-- This file is generated by compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py. +-- (The build system should take care of this for you.) + +''') class ElementType(NamedTuple): name: str @@ -28,26 +52,13 @@ element_types = [ ElementType("StablePtr", "StablePtr# a", "'StablePtr#' value", MACH_WORD), ] -# TODO: Eventually when the sized integer primops use proper unboxed types we -# should rather do: -# -#for n in [8,16,32,64]: -# element_types += [ ElementType(f"Int{n}", f"Int{n}#", f"{n}-bit signed integer", n // 8) ] -# -#for n in [8,16,32,64]: -# element_types += [ ElementType(f"Word{n}", f"Word{n}#", f"{n}-bit unsigned integer", n // 8) ] - -element_types += [ - ElementType("Int8", "Int8#", "8-bit signed integer", 1), - ElementType("Int16", "Int16#", "16-bit signed integer", 2), - ElementType("Int32", "Int32#", "32-bit signed integer", 4), - ElementType("Int64", "Int64#", "64-bit signed integer", 8), - - ElementType("Word8", "Word8#", "8-bit unsigned integer", 1), - ElementType("Word16", "Word16#", "16-bit unsigned integer", 2), - ElementType("Word32", "Word32#", "32-bit unsigned integer", 4), - ElementType("Word64", "Word64#", "64-bit unsigned integer", 8), -] +for n in [8,16,32,64]: + element_types += [ + ElementType(f"Int{n}", f"Int{n}#", + f"{n}-bit signed integer", n // 8), + ElementType(f"Word{n}", f"Word{n}#", + f"{n}-bit unsigned integer", n // 8) + ] def pretty_offset(n: Optional[int]) -> str: if n == MACH_WORD: @@ -57,87 +68,134 @@ def pretty_offset(n: Optional[int]) -> str: else: return f'{n}-byte words' +def get_align_warn(n: ElementType) -> str: + if n.width == 1: + return '' + return ''' + On some platforms, the access may fail + for an insufficiently aligned @Addr#@. + ''' + def print_block(template: str, **kwargs) -> None: - print(textwrap.dedent(template.format(**kwargs)).lstrip()) + write(textwrap.dedent(template.format(**kwargs)).lstrip()) + write('\n') def header(s: str): - print('') + write('\n') print_block(''' ------------------------------------ -- {s} ------------------------------------ ''', s=s) +if args.addr_or_bytearray == "bytearray-access-ops": + header("ByteArray# operations") -header("ByteArray# operations") - -print(''' --- Do not edit. This file is generated by utils/genprimopcode/gen_bytearray_ops.py. --- To regenerate run, --- --- python3 utils/genprimops/gen_bytearray_ops.py > compiler/GHC/Builtin/bytearray-ops.txt.pp -''') - -header('aligned index operations') -for t in element_types: - offset = pretty_offset(t.width) - print_block(''' + header('aligned index operations') + for t in element_types: + offset = pretty_offset(t.width) + print_block(''' primop IndexByteArrayOp_{name} "index{name}Array#" GenPrimOp ByteArray# -> Int# -> {rep_ty} {{Read a {desc}; offset in {offset}.}} with can_fail = True - ''', offset = offset, **t._asdict()) + ''', offset = offset, **t._asdict()) -header('unaligned index operations') -for t in element_types: - if t.name in ['Int8', 'Word8']: continue - print_block(''' + header('unaligned index operations') + for t in element_types: + if t.name in ['Int8', 'Word8']: continue + print_block(''' primop IndexByteArrayOp_Word8As{name} "indexWord8ArrayAs{name}#" GenPrimOp ByteArray# -> Int# -> {rep_ty} {{Read a {desc}; offset in bytes.}} with can_fail = True - ''', **t._asdict()) + ''', **t._asdict()) -header('aligned read operations') -for t in element_types: - offset = pretty_offset(t.width) - print_block(''' + header('aligned read operations') + for t in element_types: + offset = pretty_offset(t.width) + print_block(''' primop ReadByteArrayOp_{name} "read{name}Array#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> (# State# s, {rep_ty} #) {{Read a {desc}; offset in {offset}.}} with has_side_effects = True can_fail = True - ''', offset = offset, **t._asdict()) + ''', offset = offset, **t._asdict()) -header('unaligned read operations') -for t in element_types: - if t.name in ['Int8', 'Word8']: continue - print_block(''' + header('unaligned read operations') + for t in element_types: + if t.name in ['Int8', 'Word8']: continue + print_block(''' primop ReadByteArrayOp_Word8As{name} "readWord8ArrayAs{name}#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> (# State# s, {rep_ty} #) {{Read a {desc}; offset in bytes.}} with has_side_effects = True can_fail = True - ''', **t._asdict()) + ''', **t._asdict()) -header('aligned write operations') -for t in element_types: - offset = pretty_offset(t.width) - print_block(''' + header('aligned write operations') + for t in element_types: + offset = pretty_offset(t.width) + print_block(''' primop WriteByteArrayOp_{name} "write{name}Array#" GenPrimOp MutableByteArray# s -> Int# -> {rep_ty} -> State# s -> State# s {{Write a {desc}; offset in {offset}.}} with has_side_effects = True can_fail = True - ''', offset = offset, **t._asdict()) + ''', offset = offset, **t._asdict()) -header('unaligned write operations') -for t in element_types: - if t.name in ['Int8', 'Word8']: continue - print_block(''' + header('unaligned write operations') + for t in element_types: + if t.name in ['Int8', 'Word8']: continue + print_block(''' primop WriteByteArrayOp_Word8As{name} "writeWord8ArrayAs{name}#" GenPrimOp MutableByteArray# s -> Int# -> {rep_ty} -> State# s -> State# s {{Write a {desc}; offset in bytes.}} with has_side_effects = True can_fail = True - ''', **t._asdict()) + ''', **t._asdict()) + + +else: # addr_or_bytearray == "addr-access-ops": + header("Addr# access operations") + + header('aligned index operations') + for t in element_types: + offset = pretty_offset(t.width) + align_warn = get_align_warn(t) + print_block(''' + primop IndexOffAddrOp_{name} "index{name}OffAddr#" GenPrimOp + Addr# -> Int# -> {rep_ty} + {{ Read a {desc}; offset in {offset}. + {align_warn} + }} + with can_fail = True + ''', offset = offset, align_warn = align_warn, **t._asdict()) + + header('aligned read operations') + for t in element_types: + offset = pretty_offset(t.width) + align_warn = get_align_warn(t) + print_block(''' + primop ReadOffAddrOp_{name} "read{name}OffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, {rep_ty} #) + {{ Read a {desc}; offset in {offset}. + {align_warn} + }} + with has_side_effects = True + can_fail = True + ''', offset = offset, align_warn = align_warn, **t._asdict()) + + header('aligned write operations') + for t in element_types: + offset = pretty_offset(t.width) + align_warn = get_align_warn(t) + print_block(''' + primop WriteOffAddrOp_{name} "write{name}OffAddr#" GenPrimOp + Addr# -> Int# -> {rep_ty} -> State# s -> State# s + {{ Write a {desc}; offset in {offset}. + {align_warn} + }} + with has_side_effects = True + can_fail = True + ''', offset = offset, align_warn = align_warn, **t._asdict()) ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -1941,7 +1941,7 @@ primop GetSizeofMutableByteArrayOp "getSizeofMutableByteArray#" GenPrimOp @since 0.5.0.0} -#include "bytearray-ops.txt.pp" +#include "bytearray-access-ops.txt.pp" primop CompareByteArraysOp "compareByteArrays#" GenPrimOp ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int# @@ -2242,233 +2242,7 @@ primop AddrNeOp "neAddr#" Compare Addr# -> Addr# -> Int# primop AddrLtOp "ltAddr#" Compare Addr# -> Addr# -> Int# primop AddrLeOp "leAddr#" Compare Addr# -> Addr# -> Int# -primop IndexOffAddrOp_Char "indexCharOffAddr#" GenPrimOp - Addr# -> Int# -> Char# - {Reads 8-bit character; offset in bytes.} - with can_fail = True - -primop IndexOffAddrOp_WideChar "indexWideCharOffAddr#" GenPrimOp - Addr# -> Int# -> Char# - {Reads 31-bit character; offset in 4-byte words.} - with can_fail = True - -primop IndexOffAddrOp_Int "indexIntOffAddr#" GenPrimOp - Addr# -> Int# -> Int# - with can_fail = True - -primop IndexOffAddrOp_Word "indexWordOffAddr#" GenPrimOp - Addr# -> Int# -> Word# - with can_fail = True - -primop IndexOffAddrOp_Addr "indexAddrOffAddr#" GenPrimOp - Addr# -> Int# -> Addr# - with can_fail = True - -primop IndexOffAddrOp_Float "indexFloatOffAddr#" GenPrimOp - Addr# -> Int# -> Float# - with can_fail = True - -primop IndexOffAddrOp_Double "indexDoubleOffAddr#" GenPrimOp - Addr# -> Int# -> Double# - with can_fail = True - -primop IndexOffAddrOp_StablePtr "indexStablePtrOffAddr#" GenPrimOp - Addr# -> Int# -> StablePtr# a - with can_fail = True - -primop IndexOffAddrOp_Int8 "indexInt8OffAddr#" GenPrimOp - Addr# -> Int# -> Int8# - with can_fail = True - -primop IndexOffAddrOp_Int16 "indexInt16OffAddr#" GenPrimOp - Addr# -> Int# -> Int16# - with can_fail = True - -primop IndexOffAddrOp_Int32 "indexInt32OffAddr#" GenPrimOp - Addr# -> Int# -> Int32# - with can_fail = True - -primop IndexOffAddrOp_Int64 "indexInt64OffAddr#" GenPrimOp - Addr# -> Int# -> Int64# - with can_fail = True - -primop IndexOffAddrOp_Word8 "indexWord8OffAddr#" GenPrimOp - Addr# -> Int# -> Word8# - with can_fail = True - -primop IndexOffAddrOp_Word16 "indexWord16OffAddr#" GenPrimOp - Addr# -> Int# -> Word16# - with can_fail = True - -primop IndexOffAddrOp_Word32 "indexWord32OffAddr#" GenPrimOp - Addr# -> Int# -> Word32# - with can_fail = True - -primop IndexOffAddrOp_Word64 "indexWord64OffAddr#" GenPrimOp - Addr# -> Int# -> Word64# - with can_fail = True - -primop ReadOffAddrOp_Char "readCharOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Char# #) - {Reads 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_WideChar "readWideCharOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Char# #) - {Reads 31-bit character; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int "readIntOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word "readWordOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Addr "readAddrOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Addr# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Float "readFloatOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Float# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Double "readDoubleOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Double# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_StablePtr "readStablePtrOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, StablePtr# a #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int8 "readInt8OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int8# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int16 "readInt16OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int16# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int32 "readInt32OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int32# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int64 "readInt64OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int64# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word8 "readWord8OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word8# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word16 "readWord16OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word16# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word32 "readWord32OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word32# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word64 "readWord64OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word64# #) - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Char "writeCharOffAddr#" GenPrimOp - Addr# -> Int# -> Char# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_WideChar "writeWideCharOffAddr#" GenPrimOp - Addr# -> Int# -> Char# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int "writeIntOffAddr#" GenPrimOp - Addr# -> Int# -> Int# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word "writeWordOffAddr#" GenPrimOp - Addr# -> Int# -> Word# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Addr "writeAddrOffAddr#" GenPrimOp - Addr# -> Int# -> Addr# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Float "writeFloatOffAddr#" GenPrimOp - Addr# -> Int# -> Float# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Double "writeDoubleOffAddr#" GenPrimOp - Addr# -> Int# -> Double# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_StablePtr "writeStablePtrOffAddr#" GenPrimOp - Addr# -> Int# -> StablePtr# a -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int8 "writeInt8OffAddr#" GenPrimOp - Addr# -> Int# -> Int8# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int16 "writeInt16OffAddr#" GenPrimOp - Addr# -> Int# -> Int16# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int32 "writeInt32OffAddr#" GenPrimOp - Addr# -> Int# -> Int32# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int64 "writeInt64OffAddr#" GenPrimOp - Addr# -> Int# -> Int64# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word8 "writeWord8OffAddr#" GenPrimOp - Addr# -> Int# -> Word8# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word16 "writeWord16OffAddr#" GenPrimOp - Addr# -> Int# -> Word16# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word32 "writeWord32OffAddr#" GenPrimOp - Addr# -> Int# -> Word32# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word64 "writeWord64OffAddr#" GenPrimOp - Addr# -> Int# -> Word64# -> State# s -> State# s - with has_side_effects = True - can_fail = True +#include "addr-access-ops.txt.pp" primop InterlockedExchange_Addr "atomicExchangeAddrAddr#" GenPrimOp Addr# -> Addr# -> State# s -> (# State# s, Addr# #) ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -32,6 +32,17 @@ primopsSource = "compiler/GHC/Builtin/primops.txt.pp" primopsTxt :: Stage -> FilePath primopsTxt stage = buildDir (vanillaContext stage compiler) -/- "primops.txt" +accessOpsSource :: FilePath +accessOpsSource = "compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py" + +byteArrayAccessOpsTxt :: Stage -> FilePath +byteArrayAccessOpsTxt stage + = buildDir (vanillaContext stage compiler) -/- "bytearray-access-ops.txt.pp" + +addrAccessOpsTxt :: Stage -> FilePath +addrAccessOpsTxt stage + = buildDir (vanillaContext stage compiler) -/- "addr-access-ops.txt.pp" + isGeneratedCmmFile :: FilePath -> Bool isGeneratedCmmFile file = takeBaseName file == "AutoApply" @@ -142,8 +153,21 @@ generatePackageCode context@(Context stage pkg _ _) = do root -/- "**" -/- dir -/- "GHC/Platform/Host.hs" %> go generatePlatformHostHs when (pkg == compiler) $ do + let ba_ops_txt = root -/- byteArrayAccessOpsTxt stage + let addr_ops_txt = root -/- addrAccessOpsTxt stage + ba_ops_txt %> \file -> do + need [accessOpsSource] + runBuilder Python + [accessOpsSource, "bytearray-access-ops", file] + [] [] + addr_ops_txt %> \file -> do + need [accessOpsSource] + runBuilder Python + [accessOpsSource, "addr-access-ops", file] + [] [] root -/- primopsTxt stage %> \file -> do - need $ [primopsSource] + need $ [primopsSource, ba_ops_txt, addr_ops_txt] + -- ba_ops_txt and addr_ops_txt get #include-d build $ target context HsCpp [primopsSource] [file] when (pkg == rts) $ do ===================================== rts/gen_event_types.py ===================================== @@ -157,7 +157,7 @@ def generate_event_types_array() -> str: pr = lambda s: x.append(s) pr('/*') - pr(' * Do not edit: This file is generated by event_types.py') + pr(' * Do not edit: This file is generated by gen_event_types.py') pr(' */') pr('') pr('EventType eventTypes[] = {') @@ -184,7 +184,7 @@ def generate_event_types_defines() -> str: pr = lambda s: x.append(s) pr('/*') - pr(' * Do not edit: This file is generated by event_types.py') + pr(' * Do not edit: This file is generated by gen_event_types.py') pr(' */') pr('') pr('#pragma once') View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0b2e24385815c5651616a58c561d328367dec7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ee0b2e24385815c5651616a58c561d328367dec7 You're receiving 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 Jun 1 01:32:14 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Wed, 31 May 2023 21:32:14 -0400 Subject: [Git][ghc/ghc][wip/expand-do] look into XExprs in tcInferAppHead_maybe for infering the type to make T18324 typecheck and run Message-ID: <6477f51e29920_16c0273b4dfa4111631@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: be6ecf94 by Apoorv Ingle at 2023-05-31T20:31:51-05:00 look into XExprs in tcInferAppHead_maybe for infering the type to make T18324 typecheck and run - - - - - 6 changed files: - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Match.hs - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_compile/T18324.hs → testsuite/tests/typecheck/should_run/T18324.hs - testsuite/tests/typecheck/should_run/all.T Changes: ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -217,7 +217,7 @@ tcExpr (XExpr (ExpandedStmt (HsExpanded stmt expr))) res_ty , text "res_ty" <+> ppr res_ty ]) ; addErrCtxt (pprStmtInCtxt @Renamed @Renamed @Renamed (HsDoStmt (DoExpr Nothing)) (unLoc stmt)) $ - tcApp (unLoc expr) res_ty + tcExpr (unLoc expr) res_ty } ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -785,6 +785,8 @@ tcInferAppHead_maybe fun args HsOverLit _ lit -> Just <$> tcInferOverLit lit HsUntypedSplice (HsUntypedSpliceTop _ e) _ -> tcInferAppHead_maybe e args + XExpr (PopSrcSpan e) -> tcInferAppHead_maybe (unLoc e) args + XExpr (ExpandedStmt (HsExpanded _ e)) -> tcInferAppHead_maybe (unLoc e) args _ -> return Nothing addHeadCtxt :: AppCtxt -> TcM a -> TcM a ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1235,10 +1235,9 @@ expand_do_stmts do_or_lc (stmt@(L loc (LetStmt _ bnds)) : lstmts) = -- ------------------------------------------------ -- let x = e ; stmts ~~> let x = e in stmts' do expand_stmts <- expand_do_stmts do_or_lc lstmts - return $ L loc $ mkExpandedStmt stmt - (wrapGenSpan (HsLet noExtField - noHsTok bnds - noHsTok expand_stmts)) + return $ (wrapGenSpan (HsLet noExtField + noHsTok bnds + noHsTok $ L loc (mkPopSrcSpanExpr (L loc (mkExpandedStmt stmt expand_stmts))))) expand_do_stmts do_or_lc (stmt@(L loc (BindStmt xbsrn pat e)): lstmts) | SyntaxExprRn bind_op <- xbsrn_bindOp xbsrn ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -875,5 +875,3 @@ test('T23171', normal, compile, ['']) test('T23192', normal, compile, ['']) test('T23199', normal, compile, ['']) test('T23156', normal, compile, ['']) -# Tests for expanding do before typechecking (Impredicative) -test('T18324', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_compile/T18324.hs → testsuite/tests/typecheck/should_run/T18324.hs ===================================== @@ -16,5 +16,5 @@ foo2 = do { x <- t ; return (p x) } blah x y = return (3::Int) -main = do x <- foo1 +main = do x <- foo2 putStrLn $ show x ===================================== testsuite/tests/typecheck/should_run/all.T ===================================== @@ -163,3 +163,5 @@ test('T19397M4', extra_files(['T19397S.hs']), compile_and_run, ['-main-is foo']) test('T19667', normal, compile_and_run, ['-fhpc']) test('T20768', normal, compile_and_run, ['']) test('T22510', normal, compile_and_run, ['']) +# Tests for expanding do before typechecking (Impredicative) +test('T18324', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/be6ecf94873df437026961022a31ec7068fabfc5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/be6ecf94873df437026961022a31ec7068fabfc5 You're receiving 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 Jun 1 02:13:07 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 31 May 2023 22:13:07 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 18 commits: Data.Bag: add INLINEABLE to polymorphic functions Message-ID: <6477feb378a51_16c027c2f60117859@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - 09e7881c by Finley McIlwaine at 2023-05-31T22:13:00-04: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. - - - - - 5d052933 by Finley McIlwaine at 2023-05-31T22:13:00-04: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 - - - - - a4f3b3a8 by Finley McIlwaine at 2023-05-31T22:13:00-04: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. - - - - - acd615d6 by Finley McIlwaine at 2023-05-31T22:13:01-04: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. - - - - - cd10bf27 by Finley McIlwaine at 2023-05-31T22:13:01-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 740384d4 by Finley McIlwaine at 2023-05-31T22:13:01-04: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. - - - - - 17905ddf by Finley McIlwaine at 2023-05-31T22:13:01-04: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 - - - - - 53d4dcb7 by Finley McIlwaine at 2023-05-31T22:13:01-04: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. - - - - - 9ea1af7e by Finley McIlwaine at 2023-05-31T22:13:01-04: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. - - - - - dbb2a50d by Finley McIlwaine at 2023-05-31T22:13:01-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 6cad744d by Finley McIlwaine at 2023-05-31T22:13:01-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 2ddb4310 by Krzysztof Gogolewski at 2023-05-31T22:13:01-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Core/Type.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Deriv/Infer.hs - compiler/GHC/Tc/Deriv/Utils.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Hole.hs-boot - 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/Default.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e2173edfec04025eb868ea81edda2843c4549852...2ddb4310b25e828aa667d13797c0dacd5076279e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e2173edfec04025eb868ea81edda2843c4549852...2ddb4310b25e828aa667d13797c0dacd5076279e You're receiving 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 Jun 1 06:07:42 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Thu, 01 Jun 2023 02:07:42 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/modern-STV-extension-shuffling] 13 commits: Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) Message-ID: <647835ae73e71_16c027c2f741366b7@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/modern-STV-extension-shuffling at Glasgow Haskell Compiler / GHC Commits: 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - cc1dc1a5 by Andrei Borzenkov at 2023-06-01T06:07:38+00:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 5dd3c909 by Andrei Borzenkov at 2023-06-01T06:07:38+00:00 Extension shuffling (#23291) Where introduced 4 new extensions: - PatternSignatures - ExtendedForAllScope - MethodTypeVariables - ImplicitForAll Tasks of ScopedTypeVariables extension were distributed between PatternSignatures, ExtendedForAllScope and MethodTypeVariables according to the proposal. Now ScopedTypeVaribles only implies these three exntesions. Extension ImplicitForAll saves current behavior. NoImplicitForAll disables implicit bounding of type variables in many contexts. Was introduced one new warning option: -Wpattern-signature-binds It warns when pattern signature binds into scope new type variable. For example: f (a :: t) = ... - - - - - 30 changed files: - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Type.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Generate.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a47e341d524a104c6f81260bf478bbc4c9ec52a0...5dd3c909f87d5e66874da5c1fb8dacd4833bdcc7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a47e341d524a104c6f81260bf478bbc4c9ec52a0...5dd3c909f87d5e66874da5c1fb8dacd4833bdcc7 You're receiving 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 Jun 1 07:17:57 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Thu, 01 Jun 2023 03:17:57 -0400 Subject: [Git][ghc/ghc][wip/js-th] TH_import_loop is now broken as expected Message-ID: <64784625b78be_16c0279d20efc1436de@gitlab.mail> Sylvain Henry pushed to branch wip/js-th at Glasgow Haskell Compiler / GHC Commits: 020790c2 by Sylvain Henry at 2023-05-31T16:45:11+02:00 TH_import_loop is now broken as expected - - - - - 1 changed file: - testsuite/tests/th/TH_import_loop/TH_import_loop.T Changes: ===================================== testsuite/tests/th/TH_import_loop/TH_import_loop.T ===================================== @@ -1,7 +1,6 @@ test('TH_import_loop', [extra_files(['Main.hs', 'ModuleA.hs', 'ModuleA.hs-boot', 'ModuleB.hs', 'ModuleC.hs']) - # only broken for native linker, not the JS one - , unless(js_arch(), expect_broken(1012)) + , expect_broken(1012) ], multimod_compile_and_run, ['Main', '-v0']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/020790c2ec2741b3ee121ddd2459e8ca9c62de01 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/020790c2ec2741b3ee121ddd2459e8ca9c62de01 You're receiving 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 Jun 1 08:53:57 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 01 Jun 2023 04:53:57 -0400 Subject: [Git][ghc/ghc][master] 11 commits: Restructure IPE buffer layout Message-ID: <64785ca5ab146_16c0273b4dfa41580e@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 22 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/StgToCmm/InfoTableProv.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/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 ===================================== @@ -141,6 +141,7 @@ data BuildConfig , llvmBootstrap :: Bool , withAssertions :: Bool , withNuma :: Bool + , withZstd :: Bool , crossTarget :: Maybe String , crossEmulator :: CrossEmulator , configureWrapper :: Maybe String @@ -154,10 +155,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 @@ -172,8 +174,12 @@ mkJobFlavour BuildConfig{..} = Flavour buildFlavour opts 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 @@ -192,6 +198,7 @@ vanilla = BuildConfig , llvmBootstrap = False , withAssertions = False , withNuma = False + , withZstd = False , crossTarget = Nothing , crossEmulator = NoEmulator , configureWrapper = Nothing @@ -224,6 +231,9 @@ debug = vanilla { buildFlavour = SlowValidate , withNuma = True } +zstdIpe :: BuildConfig +zstdIpe = vanilla { withZstd = True } + static :: BuildConfig static = vanilla { fullyStatic = True } @@ -313,18 +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" - flavourString BootNonmovingGc = "boot_nonmoving_gc" + 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 BootNonmovingGc = "boot_nonmoving_gc" -- The path to the docker image (just for linux builders) dockerImage :: Arch -> Opsys -> Maybe String @@ -517,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 @@ -553,6 +563,7 @@ data Rule = FastCI -- ^ Run this job when the fast-ci label is set | 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. + | IpeData -- ^ Only run this job when the "IPE" label is set | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) @@ -579,12 +590,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 @@ -873,6 +886,7 @@ job_groups = , validateBuilds Amd64 (Linux Debian10) nativeInt , fastCI (validateBuilds Amd64 (Linux Debian10) unreg) , fastCI (validateBuilds Amd64 (Linux Debian10) debug) + , disableValidate (validateBuilds Amd64 (Linux Debian10) zstdIpe) , -- Nightly allowed to fail: #22520 modifyNightlyJobs allowFailure (modifyValidateJobs manual tsan_jobs) @@ -880,7 +894,7 @@ job_groups = modifyNightlyJobs allowFailure (modifyValidateJobs manual (validateBuilds Amd64 (Linux Debian10) noTntc)) , addValidateRule LLVMBackend (validateBuilds Amd64 (Linux Debian10) llvm) - + , addValidateRule IpeData (validateBuilds Amd64 (Linux Debian10) zstdIpe) , 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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -641,7 +641,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -703,7 +703,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -765,7 +765,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -826,7 +826,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -887,7 +887,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1008,7 +1008,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1067,7 +1067,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1186,7 +1186,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1245,7 +1245,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1264,7 +1264,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-ipe-data-compression", "TEST_ENV": "x86_64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -1304,7 +1304,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1363,7 +1363,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1422,7 +1422,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1483,7 +1483,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1544,7 +1544,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1606,7 +1606,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1665,7 +1665,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1725,7 +1725,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1784,7 +1784,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1845,7 +1845,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1907,7 +1907,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1968,7 +1968,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2028,7 +2028,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2087,7 +2087,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2142,7 +2142,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2201,7 +2201,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2264,7 +2264,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2328,7 +2328,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2389,7 +2389,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2450,7 +2450,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2516,7 +2516,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2579,7 +2579,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2642,7 +2642,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2705,7 +2705,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2766,7 +2766,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2827,7 +2827,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2888,7 +2888,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2949,7 +2949,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3011,7 +3011,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3072,7 +3072,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3135,7 +3135,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3198,7 +3198,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3261,7 +3261,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3322,7 +3322,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3383,7 +3383,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3440,7 +3440,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3500,7 +3500,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3564,7 +3564,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3628,7 +3628,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3688,7 +3688,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3749,7 +3749,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3810,7 +3810,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -3871,7 +3871,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -3931,7 +3931,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3990,7 +3990,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4048,7 +4048,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4107,7 +4107,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4130,6 +4130,64 @@ "TEST_ENV": "x86_64-linux-deb10-unreg-validate" } }, + "x86_64-linux-deb10-validate": { + "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.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\") && (\"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", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "TEST_ENV": "x86_64-linux-deb10-validate" + } + }, "x86_64-linux-deb10-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -4165,7 +4223,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4223,7 +4281,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4282,7 +4340,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4342,7 +4400,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4402,7 +4460,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4463,7 +4521,7 @@ ], "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\")", + "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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4522,7 +4580,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4578,7 +4636,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -1,67 +1,188 @@ +{-# 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.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, unpackFS, LexicalFastString(..)) +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. + +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). -emitIpeBufferListNode :: Module - -> [InfoProvEnt] - -> FCode () +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 + + entries_bytes :: BS.ByteString + entries_bytes = compress defaultCompressionLevel uncompressed_entries - 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 :: [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 @@ -77,7 +198,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 @@ -105,7 +226,7 @@ data StringTable = StringTable { stStrings :: DList ShortText , stLookup :: !(M.Map ShortText StrTabOffset) } -newtype StrTabOffset = StrTabOffset Int +type StrTabOffset = Word32 emptyStringTable :: StringTable emptyStringTable = @@ -130,9 +251,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 + -- While the boot compiler fixes ghc's unit-id to `ghc`, the stage0 compiler must still be compiled with `-this-unit-id ghc` Flag hadrian-stage0 Description: Enable if compiling the stage0 compiler with hadrian @@ -77,6 +81,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 ===================================== @@ -1105,6 +1105,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 @@ -1250,6 +1254,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 ===================================== @@ -119,6 +119,17 @@ Compiler GHC used to accept the contradictory ``Int~Bool`` in the type signature, but reject the ``Int~Bool`` constraint that arises from typechecking the definition itself. Now it accepts both. More details in `GHC ticket #23413 `_, which gives examples of the previous inconsistency. GHC now implements the "PermissivePlan" described in that ticket. +- 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 ===================================== @@ -199,10 +199,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 @@ -161,6 +163,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 ===================================== @@ -292,6 +292,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 ===================================== @@ -74,6 +74,7 @@ packageArgs = do [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" , notM cross `cabalFlag` "terminfo" , arg "-build-tool-depends" + , flag UseLibzstd `cabalFlag` "with-libzstd" -- ROMES: While the boot compiler is not updated wrt -this-unit-id -- not being fixed to `ghc`, when building stage0, we must set -- -this-unit-id to `ghc` because the boot compiler expects that. @@ -288,6 +289,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 @@ -394,6 +397,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 == 1) { + // 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 leading-underscore default: @CabalLeadingUnderscore@ flag smp @@ -211,6 +213,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/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/70526f5bd8886126f49833ef20604a2c6477780a...41b41577c8a28c236fa37e8f73aa1c6dc368d951 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/70526f5bd8886126f49833ef20604a2c6477780a...41b41577c8a28c236fa37e8f73aa1c6dc368d951 You're receiving 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 Jun 1 08:54:18 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 01 Jun 2023 04:54:18 -0400 Subject: [Git][ghc/ghc][master] Fix build with 9.2 Message-ID: <64785cba57bcb_16c027c2ee81617e5@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1 changed file: - compiler/GHC/Tc/Zonk/Type.hs Changes: ===================================== compiler/GHC/Tc/Zonk/Type.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE GADTs #-} {- (c) The University of Glasgow 2006 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/982bef3aa8cabffe6a4b4662f53f7f8c781b7212 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/982bef3aa8cabffe6a4b4662f53f7f8c781b7212 You're receiving 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 Jun 1 09:12:12 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Thu, 01 Jun 2023 05:12:12 -0400 Subject: [Git][ghc/ghc][wip/or-pats] Update tests Message-ID: <647860ec5e8e4_16c027c2f601640ee@gitlab.mail> David pushed to branch wip/or-pats at Glasgow Haskell Compiler / GHC Commits: 3ea8d86e by David Knothe at 2023-06-01T11:12:07+02:00 Update tests - - - - - 4 changed files: - testsuite/tests/deSugar/should_run/Or4.hs - testsuite/tests/parser/should_fail/Or1.hs - testsuite/tests/parser/should_fail/Or2.hs - testsuite/tests/typecheck/should_fail/Or3.hs Changes: ===================================== testsuite/tests/deSugar/should_run/Or4.hs ===================================== @@ -19,20 +19,20 @@ main = do f1 x = case x of 3 -> 1 4 -> 2 - (one of 3,4,5) -> 3 + (one of 3;4;5) -> 3 f2 y = case y of - (one of _:2:_, 1:_) | length y /= 2 -> 1 - (one of [1,2], 1:3:_)-> 2 - (one of _, _) -> 3 + (one of _:2:_; 1:_) | length y /= 2 -> 1 + (one of [1,2]; 1:3:_)-> 2 + (one of _; _) -> 3 f3 :: (Eq a, Show a) => a -> a -> Bool -f3 a (one of (== a) -> True, show -> "8") = True +f3 a (one of (== a) -> True; show -> "8") = True f3 _ _ = False -a3 = (\(one of 1, 2) -> 3) 1 -a4 = (\(one of Left 0, Right 1) -> True) (Right 1) -a5 = (\(one of (one of [1], [2, _]), (one of [3, _, _], [4, _, _, _])) -> True) [4, undefined, undefined, undefined] +a3 = (\(one of 1; 2) -> 3) 1 +a4 = (\(one of Left 0; Right 1) -> True) (Right 1) +a5 = (\(one of (one of [1]; [2, _]); (one of [3, _, _]; [4, _, _, _])) -> True) [4, undefined, undefined, undefined] a6 = (\(one of 1, 2, 3) -> False) 3 backtrack :: String ===================================== testsuite/tests/parser/should_fail/Or1.hs ===================================== @@ -3,4 +3,4 @@ module Main where main = print $ h 1 h one = case one of - (one of 2, 3) -> True \ No newline at end of file + (one of 2; 3) -> True \ No newline at end of file ===================================== testsuite/tests/parser/should_fail/Or2.hs ===================================== @@ -6,4 +6,4 @@ main = case 3 of (one of 4) -> False g x = case x of - one of 4, 5 -> False + one of 4; 5 -> False ===================================== testsuite/tests/typecheck/should_fail/Or3.hs ===================================== @@ -16,12 +16,12 @@ data GADT a where IsInt2 :: GADT Int foo :: a -> GADT a -> a -foo x (one of IsInt1 {}, IsInt2 {}) = x + 1 +foo x (one of IsInt1 {}; IsInt2 {}) = x + 1 f x = case x of - (one of Left a, Right a) -> a + (one of Left a; Right a) -> a g x = case x of - (one of _, (one of _, x)) -> x + (one of _; (one of _; x)) -> x main = print $ foo 3 IsInt1 \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3ea8d86e361c09427aa1f9d4a99c9a36346e755a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3ea8d86e361c09427aa1f9d4a99c9a36346e755a You're receiving 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 Jun 1 09:22:32 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Thu, 01 Jun 2023 05:22:32 -0400 Subject: [Git][ghc/ghc][wip/or-pats] 86 commits: Make Warn = Located DriverMessage Message-ID: <64786358770e6_16c027c2bf01671c3@gitlab.mail> David pushed to branch wip/or-pats at Glasgow Haskell Compiler / GHC Commits: 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 062a5a03 by David Knothe at 2023-06-01T11:19:36+02:00 Implement Or Patterns (Proposal 0522) This commit introduces a language extension, `OrPatterns`, as described in proposal 0522. It extends the syntax by the production `pat -> (one of pat1, ..., patk)`. The or-pattern `pat` succeeds iff one of the patterns `pat1`, ..., `patk` succeed, in this order. Currently, or-patterns cannot bind variables. They are still of great use as they discourage the use of wildcard patterns in favour of writing out all "default" cases explicitly: ``` isIrrefutableHsPat pat = case pat of ... (one of WildPat{}, VarPat{}, LazyPat{}) = True (one of PArrPat{}, ConPatIn{}, LitPat{}, NPat{}, NPlusKPat{}, ListPat{}) = False ``` This makes code safer where data types are extended now and then - just like GHC's `Pat` in the example when adding the new `OrPat` constructor. This would be catched by `-fwarn-incomplete-patterns`, but not when a wildcard pattern was used. - Update submodule haddock. - - - - - 2369239f by David Knothe at 2023-06-01T11:19:38+02:00 stuff - - - - - d5137966 by David Knothe at 2023-06-01T11:19:39+02:00 Implement empty one of - - - - - 1838cc63 by David Knothe at 2023-06-01T11:21:49+02:00 Prohibit TyApps - - - - - c6ae3f49 by David Knothe at 2023-06-01T11:21:50+02:00 Remove unused - - - - - a0155c1e by David Knothe at 2023-06-01T11:21:50+02:00 update submodule haddock - - - - - 24c5f66b by David Knothe at 2023-06-01T11:21:50+02:00 Update tests - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - + a.out - compiler/GHC.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCon.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3ea8d86e361c09427aa1f9d4a99c9a36346e755a...24c5f66be3d61f3970a797d44f844571549e4c46 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3ea8d86e361c09427aa1f9d4a99c9a36346e755a...24c5f66be3d61f3970a797d44f844571549e4c46 You're receiving 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 Jun 1 10:32:46 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 01 Jun 2023 06:32:46 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/univ-co-variables Message-ID: <647873ceea612_16c027c2bf0184219@gitlab.mail> Matthew Pickering pushed new branch wip/univ-co-variables at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/univ-co-variables You're receiving 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 Jun 1 10:48:47 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Thu, 01 Jun 2023 06:48:47 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T20138 Message-ID: <6478778fc24c7_16c027c2bf01844fa@gitlab.mail> Sebastian Graf pushed new branch wip/T20138 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T20138 You're receiving 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 Jun 1 11:26:22 2023 From: gitlab at gitlab.haskell.org (Torsten Schmits (@torsten.schmits)) Date: Thu, 01 Jun 2023 07:26:22 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/torsten.schmits/23272 Message-ID: <6478805eb0505_16c02710b9511c1906ac@gitlab.mail> Torsten Schmits pushed new branch wip/torsten.schmits/23272 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/torsten.schmits/23272 You're receiving 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 Jun 1 11:26:48 2023 From: gitlab at gitlab.haskell.org (Torsten Schmits (@torsten.schmits)) Date: Thu, 01 Jun 2023 07:26:48 -0400 Subject: [Git][ghc/ghc][wip/torsten.schmits/23272] Filter out nontrivial substituted expressions in substTickish Message-ID: <64788078808f2_16c02710b9511c1908ef@gitlab.mail> Torsten Schmits pushed to branch wip/torsten.schmits/23272 at Glasgow Haskell Compiler / GHC Commits: c4938c96 by Torsten Schmits at 2023-06-01T13:26:33+02:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 4 changed files: - compiler/GHC/Core/Subst.hs - + testsuite/tests/simplCore/should_compile/T23272.hs - + testsuite/tests/simplCore/should_compile/T23272.script - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Subst.hs ===================================== @@ -592,9 +592,7 @@ substDVarSet subst@(Subst _ _ tv_env cv_env) fvs ------------------ substTickish :: Subst -> CoreTickish -> CoreTickish substTickish subst (Breakpoint ext n ids) - = Breakpoint ext n (map do_one ids) - where - do_one = getIdFromTrivialExpr . lookupIdSubst subst + = Breakpoint ext n [i | Var i <- lookupIdSubst subst <$> ids] substTickish _subst other = other {- Note [Substitute lazily] ===================================== testsuite/tests/simplCore/should_compile/T23272.hs ===================================== @@ -0,0 +1,9 @@ +module T23272 where + +class C a where +instance C () where + +bug :: (forall a. C a => a -> a) -> () +bug g = f () + where + f x = seq (g x) undefined ===================================== testsuite/tests/simplCore/should_compile/T23272.script ===================================== @@ -0,0 +1 @@ +:load T23272 ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -484,3 +484,5 @@ test('T23307a', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppres test('T23307b', normal, compile, ['-O']) test('T23307c', normal, compile, ['-O']) test('T23426', normal, compile, ['-O']) +# test('T23272', [only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -O')], ghci_script, ['T23272.script']) +test('T23272', normal, compile, ['-O -fbreak-points']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c4938c960a808ce2d16ef31e0ed98171f7def20e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c4938c960a808ce2d16ef31e0ed98171f7def20e You're receiving 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 Jun 1 11:29:31 2023 From: gitlab at gitlab.haskell.org (Torsten Schmits (@torsten.schmits)) Date: Thu, 01 Jun 2023 07:29:31 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/torsten.schmits/breakpoint-flag Message-ID: <6478811b4bb45_16c02710b9515819467e@gitlab.mail> Torsten Schmits pushed new branch wip/torsten.schmits/breakpoint-flag at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/torsten.schmits/breakpoint-flag You're receiving 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 Jun 1 11:56:12 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 01 Jun 2023 07:56:12 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Restructure IPE buffer layout Message-ID: <6478875c39633_16c027fa111c020526c@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 672d6236 by Krzysztof Gogolewski at 2023-06-01T07:55:56-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - d8bee255 by sheaf at 2023-06-01T07:56:02-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 383d8430 by Krzysztof Gogolewski at 2023-06-01T07:56:02-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 781438ca by Krzysztof Gogolewski at 2023-06-01T07:56:03-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - ae08b179 by Krzysztof Gogolewski at 2023-06-01T07:56:03-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Stg/Lint.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Solver/Rewrite.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Name/Reader.hs - compiler/GHC/Types/TyThing.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 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2ddb4310b25e828aa667d13797c0dacd5076279e...ae08b179de1e381d112dd1fbbba048bdc3ee8d1c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2ddb4310b25e828aa667d13797c0dacd5076279e...ae08b179de1e381d112dd1fbbba048bdc3ee8d1c You're receiving 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 Jun 1 12:47:02 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Thu, 01 Jun 2023 08:47:02 -0400 Subject: [Git][ghc/ghc][wip/js-th] JS: always recompile when TH is enabled (cf #23013) Message-ID: <647893465476a_16c02710a49c182190f6@gitlab.mail> Sylvain Henry pushed to branch wip/js-th at Glasgow Haskell Compiler / GHC Commits: 7fba0b4c by Sylvain Henry at 2023-06-01T14:52:30+02:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 3 changed files: - compiler/GHC/Driver/Main.hs - compiler/GHC/Iface/Recomp.hs - + testsuite/tests/driver/th-new-test/th-new-test.stdout-javascript-unknown-ghcjs Changes: ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -261,6 +261,8 @@ import GHC.Utils.Misc import GHC.Utils.Logger import GHC.Utils.TmpFs +import qualified GHC.LanguageExtensions as LangExt + import GHC.Data.FastString import GHC.Data.Bag import GHC.Data.StringBuffer @@ -871,6 +873,15 @@ hscRecompStatus , IsBoot <- isBootSummary mod_summary -> do msg UpToDate return $ HscUpToDate checked_iface emptyHomeModInfoLinkable + + -- Always recompile with the JS backend when TH is enabled until + -- #23013 is fixed. + | ArchJavaScript <- platformArch (targetPlatform lcl_dflags) + , xopt LangExt.TemplateHaskell lcl_dflags + -> do + msg $ needsRecompileBecause THWithJS + return $ HscRecompNeeded $ Just $ mi_iface_hash $ mi_final_exts $ checked_iface + | otherwise -> do -- Do need linkable -- 1. Just check whether we have bytecode/object linkables and then ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -197,6 +197,7 @@ data RecompReason | MismatchedDynHiFile | ObjectsChanged | LibraryChanged + | THWithJS deriving (Eq) instance Outputable RecompReason where @@ -229,6 +230,7 @@ instance Outputable RecompReason where MismatchedDynHiFile -> text "Mismatched dynamic interface file" ObjectsChanged -> text "Objects changed" LibraryChanged -> text "Library changed" + THWithJS -> text "JS backend always recompiles modules using Template Haskell for now (#23013)" recompileRequired :: RecompileRequired -> Bool recompileRequired UpToDate = False ===================================== testsuite/tests/driver/th-new-test/th-new-test.stdout-javascript-unknown-ghcjs ===================================== @@ -0,0 +1,26 @@ +[1 of 6] Compiling B +[2 of 6] Compiling A +[3 of 6] Compiling D +[4 of 6] Compiling C +[5 of 6] Compiling Main +[6 of 6] Linking Main +[1 of 6] Compiling B [JS backend always recompiles modules using Template Haskell for now (#23013)] +[2 of 6] Compiling A [JS backend always recompiles modules using Template Haskell for now (#23013)] +[3 of 6] Compiling D [JS backend always recompiles modules using Template Haskell for now (#23013)] +[4 of 6] Compiling C [JS backend always recompiles modules using Template Haskell for now (#23013)] +[6 of 6] Linking Main [Objects changed] +[1 of 6] Compiling B [Source file changed] +[2 of 6] Compiling A [B[TH] changed] +[3 of 6] Compiling D [JS backend always recompiles modules using Template Haskell for now (#23013)] +[4 of 6] Compiling C [D[TH] changed] +[6 of 6] Linking Main [Objects changed] +[1 of 6] Compiling B [JS backend always recompiles modules using Template Haskell for now (#23013)] +[2 of 6] Compiling A [JS backend always recompiles modules using Template Haskell for now (#23013)] +[3 of 6] Compiling D [Source file changed] +[4 of 6] Compiling C [D[TH] changed] +[6 of 6] Linking Main [Objects changed] +[1 of 6] Compiling B [Source file changed] +[2 of 6] Compiling A [B[TH] changed] +[3 of 6] Compiling D [Source file changed] +[4 of 6] Compiling C [D[TH] changed] +[6 of 6] Linking Main [Objects changed] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7fba0b4c835a2e49f27674cb961a01e1067f7b24 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7fba0b4c835a2e49f27674cb961a01e1067f7b24 You're receiving 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 Jun 1 12:49:58 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Thu, 01 Jun 2023 08:49:58 -0400 Subject: [Git][ghc/ghc][wip/cleanup-selfboot] 24 commits: Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) Message-ID: <647893f6c38c9_16c027fa111c02198cf@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/cleanup-selfboot at Glasgow Haskell Compiler / GHC Commits: 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 2816b7a5 by Krzysztof Gogolewski at 2023-06-01T13:55:44+02:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Type.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/JS/Optimizer.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Deriv/Infer.hs - compiler/GHC/Tc/Deriv/Utils.hs - compiler/GHC/Tc/Errors.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/112c2201e01208f237f26c4d0b10c755f5444b76...2816b7a5ac57b7dba04b787694be14d8f9d2832f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/112c2201e01208f237f26c4d0b10c755f5444b76...2816b7a5ac57b7dba04b787694be14d8f9d2832f You're receiving 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 Jun 1 13:08:23 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Thu, 01 Jun 2023 09:08:23 -0400 Subject: [Git][ghc/ghc][wip/js-th] JS: always recompile when TH is enabled (cf #23013) Message-ID: <64789847677a4_16c02710b9516c23336f@gitlab.mail> Sylvain Henry pushed to branch wip/js-th at Glasgow Haskell Compiler / GHC Commits: dadec553 by Sylvain Henry at 2023-06-01T15:13:47+02:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 3 changed files: - compiler/GHC/Driver/Main.hs - compiler/GHC/Iface/Recomp.hs - + testsuite/tests/driver/th-new-test/th-new-test.stdout-javascript-unknown-ghcjs Changes: ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -261,6 +261,8 @@ import GHC.Utils.Misc import GHC.Utils.Logger import GHC.Utils.TmpFs +import qualified GHC.LanguageExtensions as LangExt + import GHC.Data.FastString import GHC.Data.Bag import GHC.Data.StringBuffer @@ -871,6 +873,15 @@ hscRecompStatus , IsBoot <- isBootSummary mod_summary -> do msg UpToDate return $ HscUpToDate checked_iface emptyHomeModInfoLinkable + + -- Always recompile with the JS backend when TH is enabled until + -- #23013 is fixed. + | ArchJavaScript <- platformArch (targetPlatform lcl_dflags) + , xopt LangExt.TemplateHaskell lcl_dflags + -> do + msg $ needsRecompileBecause THWithJS + return $ HscRecompNeeded $ Just $ mi_iface_hash $ mi_final_exts $ checked_iface + | otherwise -> do -- Do need linkable -- 1. Just check whether we have bytecode/object linkables and then ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -197,6 +197,7 @@ data RecompReason | MismatchedDynHiFile | ObjectsChanged | LibraryChanged + | THWithJS deriving (Eq) instance Outputable RecompReason where @@ -229,6 +230,7 @@ instance Outputable RecompReason where MismatchedDynHiFile -> text "Mismatched dynamic interface file" ObjectsChanged -> text "Objects changed" LibraryChanged -> text "Library changed" + THWithJS -> text "JS backend always recompiles modules using Template Haskell for now (#23013)" recompileRequired :: RecompileRequired -> Bool recompileRequired UpToDate = False ===================================== testsuite/tests/driver/th-new-test/th-new-test.stdout-javascript-unknown-ghcjs ===================================== @@ -0,0 +1,26 @@ +[1 of 6] Compiling B +[2 of 6] Compiling A +[3 of 6] Compiling D +[4 of 6] Compiling C +[5 of 6] Compiling Main +[6 of 6] Linking Main +[1 of 6] Compiling B [JS backend always recompiles modules using Template Haskell for now (#23013)] +[2 of 6] Compiling A [JS backend always recompiles modules using Template Haskell for now (#23013)] +[3 of 6] Compiling D [JS backend always recompiles modules using Template Haskell for now (#23013)] +[4 of 6] Compiling C [JS backend always recompiles modules using Template Haskell for now (#23013)] +[6 of 6] Linking Main [Objects changed] +[1 of 6] Compiling B [Source file changed] +[2 of 6] Compiling A [B[TH] changed] +[3 of 6] Compiling D [JS backend always recompiles modules using Template Haskell for now (#23013)] +[4 of 6] Compiling C [D[TH] changed] +[6 of 6] Linking Main [Objects changed] +[1 of 6] Compiling B [JS backend always recompiles modules using Template Haskell for now (#23013)] +[2 of 6] Compiling A [JS backend always recompiles modules using Template Haskell for now (#23013)] +[3 of 6] Compiling D [Source file changed] +[4 of 6] Compiling C [D[TH] changed] +[6 of 6] Linking Main [Objects changed] +[1 of 6] Compiling B [Source file changed] +[2 of 6] Compiling A [B[TH] changed] +[3 of 6] Compiling D [Source file changed] +[4 of 6] Compiling C [D[TH] changed] +[6 of 6] Linking Main [Objects changed] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dadec5534075f0a044c42920ddee80e825d6010b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dadec5534075f0a044c42920ddee80e825d6010b You're receiving 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 Jun 1 14:54:35 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Thu, 01 Jun 2023 10:54:35 -0400 Subject: [Git][ghc/ghc][wip/haddock-mem-fixes] Fix associated data family doc structure items Message-ID: <6478b12b78ca6_16c02710a49c18257265@gitlab.mail> Finley McIlwaine pushed to branch wip/haddock-mem-fixes at Glasgow Haskell Compiler / GHC Commits: c3fea031 by Finley McIlwaine at 2023-06-01T08:54:22-06:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. Also bump haddock to latest dev commit. - - - - - 3 changed files: - compiler/GHC/Hs/Doc.hs - compiler/GHC/HsToCore/Docs.hs - utils/haddock Changes: ===================================== compiler/GHC/Hs/Doc.hs ===================================== @@ -123,7 +123,7 @@ type LHsDoc pass = Located (HsDoc pass) data DocStructureItem = DsiSectionHeading !Int !(HsDoc GhcRn) | DsiDocChunk !(HsDoc GhcRn) - | DsiNamedChunkRef !(String) + | DsiNamedChunkRef !String | DsiExports !Avails | DsiModExport !(NonEmpty ModuleName) -- ^ We might re-export avails from multiple ===================================== compiler/GHC/HsToCore/Docs.hs ===================================== @@ -31,18 +31,18 @@ import Data.Bifunctor (first) import Data.Foldable (toList) import Data.IntMap (IntMap) import qualified Data.IntMap as IM +import qualified Data.List.NonEmpty as NonEmpty +import Data.List.NonEmpty (NonEmpty ((:|))) import Data.Map.Strict (Map) import qualified Data.Map as M -import qualified Data.Set as Set import Data.Maybe +import qualified Data.Set as Set import Data.Semigroup import GHC.IORef (readIORef) import GHC.Unit.Types import GHC.Hs import GHC.Types.Avail import GHC.Unit.Module -import qualified Data.List.NonEmpty as NonEmpty -import Data.List.NonEmpty (NonEmpty ((:|))) import GHC.Unit.Module.Imported import GHC.Driver.DynFlags import GHC.Types.TypeEnv @@ -192,7 +192,13 @@ mkDocStructureFromDecls env all_exports decls = Just loc -> L loc (DsiExports [avail]) -- FIXME: This is just a workaround that we use when handling e.g. -- associated data families like in the html-test Instances.hs. - Nothing -> noLoc (DsiExports [avail]) + Nothing -> noLoc (DsiExports []) + + -- This causes the associated data family to be incorrectly documented + -- separately from its class: + -- Nothing -> noLoc (DsiExports []) + + -- This panics on the associated data family: -- Nothing -> panicDoc "mkDocStructureFromDecls: No loc found for" -- (ppr avail) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 3b113471906b1d383727227cf0da16f358b3e1f1 +Subproject commit daa07b2027a187f7d05148b66e3fe62acdcb2ba8 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c3fea031c98ea273ba2ff34b68511390b468791b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c3fea031c98ea273ba2ff34b68511390b468791b You're receiving 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 Jun 1 14:56:36 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 01 Jun 2023 10:56:36 -0400 Subject: [Git][ghc/ghc][master] Output Lint errors to stderr instead of stdout Message-ID: <6478b1a451312_16c027fa111c026090@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 3 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Stg/Lint.hs Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -302,6 +302,10 @@ path does not result in allocation in the hot path. This can be surprisingly impactful. Changing `lint_app` reduced allocations for one test program I was looking at by ~4%. +Note [MCInfo for Lint] +~~~~~~~~~~~~~~~~~~~~~~ +When printing a Lint message, use the MCInfo severity so that the +message is printed on stderr rather than stdout (#13342). ************************************************************************ * * @@ -425,7 +429,7 @@ displayLintResults :: Logger -> IO () displayLintResults logger display_warnings pp_what pp_pgm (warns, errs) | not (isEmptyBag errs) - = do { logMsg logger Err.MCDump noSrcSpan + = do { logMsg logger Err.MCInfo noSrcSpan -- See Note [MCInfo for Lint] $ withPprStyle defaultDumpStyle (vcat [ lint_banner "errors" pp_what, Err.pprMessageBag errs , text "*** Offending Program ***" @@ -436,9 +440,7 @@ displayLintResults logger display_warnings pp_what pp_pgm (warns, errs) | not (isEmptyBag warns) , log_enable_debug (logFlags logger) , display_warnings - -- If the Core linter encounters an error, output to stderr instead of - -- stdout (#13342) - = logMsg logger Err.MCInfo noSrcSpan + = logMsg logger Err.MCInfo noSrcSpan -- See Note [MCInfo for Lint] $ withPprStyle defaultDumpStyle (lint_banner "warnings" pp_what $$ Err.pprMessageBag (mapBag ($$ blankLine) warns)) ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -105,7 +105,7 @@ codeOutput logger tmpfs llvm_config dflags unit_state this_mod filenm location g (const ()) $ do { case cmmLint (targetPlatform dflags) cmm of Just err -> do { logMsg logger - MCDump + MCInfo -- See Note [MCInfo for Lint] in "GHC.Core.Lint" noSrcSpan $ withPprStyle defaultDumpStyle err ; ghcExit logger 1 ===================================== compiler/GHC/Stg/Lint.hs ===================================== @@ -149,7 +149,7 @@ lintStgTopBindings platform logger diag_opts opts extra_vars this_mod unarised w Nothing -> return () Just msg -> do - logMsg logger Err.MCDump noSrcSpan + logMsg logger Err.MCInfo noSrcSpan -- See Note [MCInfo for Lint] in "GHC.Core.Lint" $ withPprStyle defaultDumpStyle (vcat [ text "*** Stg Lint ErrMsgs: in" <+> text whodunit <+> text "***", View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1c96bc3d786b13af593c0d336772cc86ea0ac5e2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1c96bc3d786b13af593c0d336772cc86ea0ac5e2 You're receiving 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 Jun 1 14:57:19 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 01 Jun 2023 10:57:19 -0400 Subject: [Git][ghc/ghc][master] Refactor lookupExactOrOrig & friends Message-ID: <6478b1cf8d461_16c02710b951302658c6@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 13 changed files: - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Types/Name/Reader.hs - compiler/GHC/Types/TyThing.hs Changes: ===================================== compiler/GHC/Rename/Env.hs ===================================== @@ -331,26 +331,26 @@ lookupExactOcc_either name -- 'RuntimeRep's (#17837) UnboxedTuple -> tyConArity tycon `div` 2 _ -> tyConArity tycon + ; let info = case thing of + ATyCon {} -> IAmTyCon $ TupleFlavour $ tupleSortBoxity tupleSort + _ -> IAmConLike $ mkConInfo tupArity [] ; checkTupSize tupArity - ; let gre = (localTyConGRE (TupleFlavour $ tupleSortBoxity tupleSort) name) - { gre_lcl = False } - ; return (Right gre) } + ; return $ Right $ mkExactGRE name info } | isExternalName name - = Right <$> lookupExternalExactGRE name + = do { info <- lookupExternalExactName name + ; return $ Right $ mkExactGRE name info } | otherwise = lookupLocalExactGRE name -lookupExternalExactGRE :: Name -> RnM GlobalRdrElt -lookupExternalExactGRE name +lookupExternalExactName :: Name -> RnM GREInfo +lookupExternalExactName name = do { thing <- case wiredInNameTyThing_maybe name of Just thing -> return thing _ -> tcLookupGlobal name - ; return $ - (localVanillaGRE NoParent name) - { gre_lcl = False, gre_info = tyThingGREInfo thing } } + ; return $ tyThingGREInfo thing } lookupLocalExactGRE :: Name -> RnM (Either NotInScopeError GlobalRdrElt) lookupLocalExactGRE name @@ -370,7 +370,7 @@ lookupLocalExactGRE name [] -> -- See Note [Splicing Exact names] do { lcl_env <- getLocalRdrEnv - ; let gre = localVanillaGRE NoParent name -- LocalRdrEnv only contains Vanilla things + ; let gre = mkLocalVanillaGRE NoParent name -- LocalRdrEnv only contains Vanilla things ; if name `inLocalRdrEnvScope` lcl_env then return (Right gre) else @@ -451,7 +451,7 @@ lookupExactOrOrig :: RdrName -> (GlobalRdrElt -> r) -> RnM r -> RnM r lookupExactOrOrig rdr_name res k = do { men <- lookupExactOrOrig_base rdr_name ; case men of - FoundExactOrOrig n -> return $ res n + FoundExactOrOrig gre -> return $ res gre ExactOrOrigError e -> do { addErr (mkTcRnNotInScope rdr_name e) ; return $ res (mkUnboundGRERdr rdr_name) } @@ -464,9 +464,9 @@ lookupExactOrOrig_maybe :: RdrName -> (Maybe GlobalRdrElt -> r) -> RnM r -> RnM lookupExactOrOrig_maybe rdr_name res k = do { men <- lookupExactOrOrig_base rdr_name ; case men of - FoundExactOrOrig n -> return (res (Just n)) - ExactOrOrigError _ -> return (res Nothing) - NotExactOrOrig -> k } + FoundExactOrOrig gre -> return (res (Just gre)) + ExactOrOrigError _ -> return (res Nothing) + NotExactOrOrig -> k } data ExactOrOrigResult = FoundExactOrOrig GlobalRdrElt @@ -490,15 +490,15 @@ lookupExactOrOrig_base rdr_name ; mb_gre <- if nameIsLocalOrFrom this_mod nm then lookupLocalExactGRE nm - else Right <$> lookupExternalExactGRE nm + else do { info <- lookupExternalExactName nm + ; return $ Right $ mkExactGRE nm info } ; return $ case mb_gre of Left err -> ExactOrOrigError err Right gre -> FoundExactOrOrig gre } | otherwise = return NotExactOrOrig where - cvtEither (Left e) = ExactOrOrigError e - cvtEither (Right n) = FoundExactOrOrig n - + cvtEither (Left e) = ExactOrOrigError e + cvtEither (Right gre) = FoundExactOrOrig gre {- Note [Errors in lookup functions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -561,7 +561,7 @@ lookupRecFieldOcc mb_con rdr_name ; Just nm -> return nm } } | otherwise -- Can't use the data constructor to disambiguate - = greName <$> lookupGlobalOccRn' (IncludeFields WantField) rdr_name + = lookupGlobalOccRn' (IncludeFields WantField) rdr_name -- This use of Global is right as we are looking up a selector, -- which can only be defined at the top level. @@ -851,18 +851,16 @@ lookupSubBndrOcc :: DeprecationWarnings -> RnM (Either NotInScopeError Name) -- Find all the things the rdr-name maps to -- and pick the one with the right parent name -lookupSubBndrOcc warn_if_deprec the_parent doc rdr_name = do - res <- - lookupExactOrOrig rdr_name FoundChild $ - -- This happens for built-in classes, see mod052 for example - lookupSubBndrOcc_helper True warn_if_deprec the_parent rdr_name - case res of - NameNotFound -> return (Left (UnknownSubordinate doc)) - FoundChild child -> return (Right $ greName child) - IncorrectParent {} - -- See [Mismatched class methods and associated type families] - -- in TcInstDecls. - -> return $ Left (UnknownSubordinate doc) +lookupSubBndrOcc warn_if_deprec the_parent doc rdr_name = + lookupExactOrOrig rdr_name (Right . greName) $ + -- This happens for built-in classes, see mod052 for example + do { child <- lookupSubBndrOcc_helper True warn_if_deprec the_parent rdr_name + ; return $ case child of + FoundChild g -> Right (greName g) + NameNotFound -> Left (UnknownSubordinate doc) + IncorrectParent {} -> Left (UnknownSubordinate doc) } + -- See [Mismatched class methods and associated type families] + -- in TcInstDecls. {- Note [Family instance binders] @@ -1107,10 +1105,10 @@ lookup_demoted rdr_name ; let is_star_type = if star_is_type then StarIsType else StarIsNotType star_is_type_hints = noStarIsTypeHints is_star_type rdr_name ; if data_kinds - then do { mb_demoted_name <- lookupOccRn_maybe demoted_rdr - ; case mb_demoted_name of + then do { mb_demoted_gre <- lookupOccRn_maybe demoted_rdr + ; case mb_demoted_gre of Nothing -> unboundNameX looking_for rdr_name star_is_type_hints - Just demoted_name -> return $ greName demoted_name } + Just demoted_gre -> return $ greName demoted_gre} else do { -- We need to check if a data constructor of this name is -- in scope to give good error messages. However, we do -- not want to give an additional error if the data @@ -1242,18 +1240,26 @@ lookupOccRnX_maybe globalLookup wrapper rdr_name ; case res of { Nothing -> return Nothing ; Just nm -> - do { let gre = localVanillaGRE NoParent nm + -- Elements in the LocalRdrEnv are always Vanilla GREs + do { let gre = mkLocalVanillaGRE NoParent nm ; Just <$> wrapper gre } } } , globalLookup rdr_name ] lookupOccRn_maybe :: RdrName -> RnM (Maybe GlobalRdrElt) lookupOccRn_maybe = - lookupOccRnX_maybe (lookupGlobalOccRn_maybe $ IncludeFields WantNormal) return + lookupOccRnX_maybe + (lookupGlobalOccRn_maybe $ IncludeFields WantNormal) + return -- Used outside this module only by TH name reification (lookupName, lookupThName_maybe) -lookupSameOccRn_maybe :: RdrName -> RnM (Maybe GlobalRdrElt) +lookupSameOccRn_maybe :: RdrName -> RnM (Maybe Name) lookupSameOccRn_maybe = - lookupOccRnX_maybe (lookupGlobalOccRn_maybe SameOccName) return + lookupOccRnX_maybe + (get_name <$> lookupGlobalOccRn_maybe SameOccName) + (return . greName) + where + get_name :: RnM (Maybe GlobalRdrElt) -> RnM (Maybe Name) + get_name = fmap (fmap greName) -- | Look up a 'RdrName' used as a variable in an expression. -- @@ -1292,7 +1298,7 @@ lookupGlobalOccRn_maybe which_gres rdr_name = lookupExactOrOrig_maybe rdr_name id $ lookupGlobalOccRn_base which_gres rdr_name -lookupGlobalOccRn :: RdrName -> RnM GlobalRdrElt +lookupGlobalOccRn :: RdrName -> RnM Name -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global -- environment. Adds an error message if the RdrName is not in scope. -- You usually want to use "lookupOccRn" which also looks in the local @@ -1301,15 +1307,14 @@ lookupGlobalOccRn :: RdrName -> RnM GlobalRdrElt -- Used by exports_from_avail lookupGlobalOccRn = lookupGlobalOccRn' (IncludeFields WantNormal) -lookupGlobalOccRn' :: WhichGREs GREInfo -> RdrName -> RnM GlobalRdrElt +lookupGlobalOccRn' :: WhichGREs GREInfo -> RdrName -> RnM Name lookupGlobalOccRn' which_gres rdr_name = - lookupExactOrOrig rdr_name id $ do - mn <- lookupGlobalOccRn_base which_gres rdr_name - case mn of - Just n -> return n + lookupExactOrOrig rdr_name greName $ do + mb_gre <- lookupGlobalOccRn_base which_gres rdr_name + case mb_gre of + Just gre -> return (greName gre) Nothing -> do { traceRn "lookupGlobalOccRn" (ppr rdr_name) - ; nm <- unboundName (LF which_suggest WL_Global) rdr_name - ; return $ localVanillaGRE NoParent nm } + ; unboundName (LF which_suggest WL_Global) rdr_name } where which_suggest = case which_gres of IncludeFields WantBoth -> WL_RecField IncludeFields WantField -> WL_RecField @@ -1333,7 +1338,7 @@ lookupGlobalOccRn_base which_gres rdr_name = -- | Lookup a 'Name' in the 'GlobalRdrEnv', falling back to looking up -- in the type environment it if fails. -lookupGREInfo_GRE :: Name -> RnM GREInfo +lookupGREInfo_GRE :: Name -> RnM GREInfo lookupGREInfo_GRE name = do { rdr_env <- getGlobalRdrEnv ; case lookupGRE_Name rdr_env name of @@ -1740,7 +1745,7 @@ addUsedGRE warn_if_deprec gre = do { case warn_if_deprec of EnableDeprecationWarnings -> warnIfDeprecated gre DisableDeprecationWarnings -> return () - ; unless (isLocalGRE gre) $ + ; when (isImportedGRE gre) $ -- See Note [Using isImportedGRE in addUsedGRE] do { env <- getGblEnv -- Do not report the GREInfo (#23424) ; traceRn "addUsedGRE" (ppr $ greName gre) @@ -1758,7 +1763,22 @@ addUsedGREs gres (ppr $ map greName imp_gres) ; updTcRef (tcg_used_gres env) (imp_gres ++) } where - imp_gres = filterOut isLocalGRE gres + imp_gres = filter isImportedGRE gres + -- See Note [Using isImportedGRE in addUsedGRE] + +{- Note [Using isImportedGRE in addUsedGRE] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In addUsedGRE, we want to add any used imported GREs to the tcg_used_gres field, +so that we can emit appropriate warnings (see GHC.Rename.Names.warnUnusedImportDecls). + +We want to do this for GREs that were brought into scope through imports. As per +Note [GlobalRdrElt provenance] in GHC.Types.Name.Reader, this means we should +check that gre_imp is non-empty. Checking that gre_lcl is False is INCORRECT, +because we might have obtained the GRE by an Exact or Orig direct reference, +in which case we have both gre_lcl = False and gre_imp = emptyBag. + +Geting this wrong can lead to panics in e.g. bestImport, see #23240. +-} warnIfDeprecated :: GlobalRdrElt -> RnM () warnIfDeprecated gre@(GRE { gre_imp = iss }) ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -260,18 +260,20 @@ rnExpr (HsVar _ (L l v)) ; case mb_gre of { Nothing -> rnUnboundVar v ; Just gre -> - do { if | Just fl <- recFieldLabel <$> recFieldInfo_maybe gre + do { let nm = greName gre + info = gre_info gre + ; if | IAmRecField fld_info <- info -- Since GHC 9.4, such occurrences of record fields must be -- unambiguous. For ambiguous occurrences, we arbitrarily pick one -- matching GRE and add a name clash error -- (see lookupGlobalOccRn_overloaded, called by lookupExprOccRn). - -> do { let sel_name = flSelector fl + -> do { let sel_name = flSelector $ recFieldLabel fld_info ; this_mod <- getModule ; when (nameIsLocalOrFrom this_mod sel_name) $ checkThLocalName sel_name ; return (HsRecSel noExtField (FieldOcc sel_name (L l v) ), unitFV sel_name) } - | greName gre == nilDataConName + | nm == nilDataConName -- Treat [] as an ExplicitList, so that -- OverloadedLists works correctly -- Note [Empty lists] in GHC.Hs.Expr @@ -279,7 +281,7 @@ rnExpr (HsVar _ (L l v)) -> rnExpr (ExplicitList noAnn []) | otherwise - -> finishHsVar (L (na2la l) $ greName gre) + -> finishHsVar (L (na2la l) nm) }}} rnExpr (HsIPVar x v) ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -152,7 +152,7 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls, -- Excludes pattern-synonym binders -- They are already in scope traceRn "rnSrcDecls" (ppr id_bndrs) ; - tc_envs <- extendGlobalRdrEnvRn (map (localVanillaGRE NoParent) id_bndrs) local_fix_env ; + tc_envs <- extendGlobalRdrEnvRn (map (mkLocalVanillaGRE NoParent) id_bndrs) local_fix_env ; restoreEnvs tc_envs $ do { -- Now everything is in scope, as the remaining renaming assumes. @@ -2520,8 +2520,8 @@ extendPatSynEnv dup_fields_ok has_sel val_decls local_fix_env thing = do { ; let pat_syn_bndrs = concat [ conLikeName_Name name : map flSelector flds | (name, con_info) <- names_with_fls , let flds = conInfoFields con_info ] - ; let gres = map (localConLikeGRE NoParent) names_with_fls - ++ localFieldGREs NoParent names_with_fls + ; let gres = map (mkLocalConLikeGRE NoParent) names_with_fls + ++ mkLocalFieldGREs NoParent names_with_fls -- Recall Note [Parents] in GHC.Types.Name.Reader: -- -- pattern synonym constructors and their record fields have no parent ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -858,7 +858,7 @@ getLocalNonValBinders fixity_env -- declaration, not just the name new_simple :: LocatedN RdrName -> RnM GlobalRdrElt new_simple rdr_name = do { nm <- newTopSrcBinder rdr_name - ; return (localVanillaGRE NoParent nm) } + ; return (mkLocalVanillaGRE NoParent nm) } new_tc :: DuplicateRecordFields -> FieldSelectors -> LTyClDecl GhcPs -> RnM [GlobalRdrElt] @@ -871,13 +871,13 @@ getLocalNonValBinders fixity_env ; con_names_with_flds <- mapM (\(con,flds) -> (,flds) <$> newTopSrcBinder (l2n con)) cons_with_flds ; flds' <- mapM (newRecordFieldLabel dup_fields_ok has_sel $ map fst con_names_with_flds) flds ; mapM_ (add_dup_fld_errs flds') con_names_with_flds - ; let tc_gre = localTyConGRE (fmap (const tycon_name) tc_flav) tycon_name + ; let tc_gre = mkLocalTyConGRE (fmap (const tycon_name) tc_flav) tycon_name fld_env = mk_fld_env con_names_with_flds flds' - at_gres = zipWith (\ (_, at_flav) at_nm -> localTyConGRE (fmap (const tycon_name) at_flav) at_nm) + at_gres = zipWith (\ (_, at_flav) at_nm -> mkLocalTyConGRE (fmap (const tycon_name) at_flav) at_nm) at_bndrs at_names - sig_gres = map (localVanillaGRE (ParentIs tycon_name)) sig_names - con_gres = map (localConLikeGRE (ParentIs tycon_name)) fld_env - fld_gres = localFieldGREs (ParentIs tycon_name) fld_env + sig_gres = map (mkLocalVanillaGRE (ParentIs tycon_name)) sig_names + con_gres = map (mkLocalConLikeGRE (ParentIs tycon_name)) fld_env + fld_gres = mkLocalFieldGREs (ParentIs tycon_name) fld_env sub_gres = at_gres ++ sig_gres ++ con_gres ++ fld_gres ; traceRn "getLocalNonValBinders new_tc" $ vcat [ text "tycon:" <+> ppr tycon_name @@ -947,8 +947,8 @@ getLocalNonValBinders fixity_env ; flds' <- mapM (newRecordFieldLabel dup_fields_ok has_sel $ map fst sub_names) flds ; mapM_ (add_dup_fld_errs flds') sub_names ; let fld_env = mk_fld_env sub_names flds' - con_gres = map (localConLikeGRE (ParentIs main_name)) fld_env - field_gres = localFieldGREs (ParentIs main_name) fld_env + con_gres = map (mkLocalConLikeGRE (ParentIs main_name)) fld_env + field_gres = mkLocalFieldGREs (ParentIs main_name) fld_env -- NB: the data family name is not bound here, -- so we don't return a GlobalRdrElt for it here! ; return $ con_gres ++ field_gres } ===================================== compiler/GHC/Rename/Unbound.hs ===================================== @@ -105,10 +105,10 @@ mkUnboundNameRdr :: RdrName -> Name mkUnboundNameRdr rdr = mkUnboundName (rdrNameOcc rdr) mkUnboundGRE :: OccName -> GlobalRdrElt -mkUnboundGRE occ = localVanillaGRE NoParent $ mkUnboundName occ +mkUnboundGRE occ = mkLocalVanillaGRE NoParent $ mkUnboundName occ mkUnboundGRERdr :: RdrName -> GlobalRdrElt -mkUnboundGRERdr rdr = localVanillaGRE NoParent $ mkUnboundNameRdr rdr +mkUnboundGRERdr rdr = mkLocalVanillaGRE NoParent $ mkUnboundNameRdr rdr reportUnboundName' :: WhatLooking -> RdrName -> RnM Name reportUnboundName' what_look rdr = unboundName (LF what_look WL_Anywhere) rdr ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -611,7 +611,7 @@ instance Diagnostic TcRnMessage where | isRecordSelector i = "record selector" pp_category i = tyThingCategory i what_is = pp_category ty_thing - thing = ppr $ greOccName child + thing = ppr $ nameOccName child parents = map ppr parent_names TcRnConflictingExports occ child_gre1 ie1 child_gre2 ie2 -> mkSimpleDecorated $ ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -1559,7 +1559,7 @@ data TcRnMessage where -} TcRnExportedParentChildMismatch :: Name -- ^ parent -> TyThing - -> GlobalRdrElt -- ^ child + -> Name -- ^ child -> [Name] -> TcRnMessage {-| TcRnConflictingExports is an error that occurs when different identifiers that ===================================== compiler/GHC/Tc/Gen/Export.hs ===================================== @@ -520,14 +520,13 @@ lookupChildrenExport spec_parent rdr_items = mapAndReportM doOne rdr_items NameNotFound -> do { ub <- reportUnboundName unboundName ; let l = getLoc n - gre = localVanillaGRE NoParent ub + gre = mkLocalVanillaGRE NoParent ub ; return (L l (IEName noExtField (L (la2na l) ub)), gre)} - FoundChild child@(GRE { gre_par = par }) -> - do { checkPatSynParent spec_parent par child - ; let child_nm = greName child + FoundChild child@(GRE { gre_name = child_nm, gre_par = par }) -> + do { checkPatSynParent spec_parent par child_nm ; return (replaceLWrappedName n child_nm, child) } - IncorrectParent p c gs -> failWithDcErr p c gs + IncorrectParent p c gs -> failWithDcErr p (greName c) gs -- Note [Typing Pattern Synonym Exports] @@ -590,7 +589,7 @@ lookupChildrenExport spec_parent rdr_items = mapAndReportM doOne rdr_items checkPatSynParent :: Name -- ^ Alleged parent type constructor -- User wrote T( P, Q ) -> Parent -- The parent of P we discovered - -> GlobalRdrElt + -> Name -- ^ Either a -- a) Pattern Synonym Constructor -- b) A pattern synonym selector @@ -598,13 +597,12 @@ checkPatSynParent :: Name -- ^ Alleged parent type constructor checkPatSynParent _ (ParentIs {}) _ = return () -checkPatSynParent parent NoParent gre +checkPatSynParent parent NoParent nm | isUnboundName parent -- Avoid an error cascade = return () | otherwise = do { parent_ty_con <- tcLookupTyCon parent - ; let nm = greName gre ; mpat_syn_thing <- tcLookupGlobal nm -- 1. Check that the Id was actually from a thing associated with patsyns @@ -615,7 +613,7 @@ checkPatSynParent parent NoParent gre AConLike (PatSynCon p) -> handle_pat_syn (psErr p) parent_ty_con p - _ -> failWithDcErr parent gre [] } + _ -> failWithDcErr parent nm [] } where psErr = exportErrCtxt "pattern synonym" selErr = exportErrCtxt "pattern synonym record selector" @@ -736,9 +734,9 @@ addExportErrCtxt ie = addErrCtxt exportCtxt exportCtxt = text "In the export:" <+> ppr ie -failWithDcErr :: Name -> GlobalRdrElt -> [Name] -> TcM a +failWithDcErr :: Name -> Name -> [Name] -> TcM a failWithDcErr parent child parents = do - ty_thing <- tcLookupGlobal (greName child) + ty_thing <- tcLookupGlobal child failWithTc $ TcRnExportedParentChildMismatch parent ty_thing child parents ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1413,20 +1413,18 @@ disambiguateRecordBinds record_expr record_rho possible_parents rbnds res_ty lookupField :: FieldGlobalRdrElt -> LHsRecUpdField GhcRn GhcRn -> TcM (LHsRecUpdField GhcTc GhcRn) - lookupField fl (L l upd) + lookupField fld_gre (L l upd) = do { let L loc af = hfbLHS upd - rdr = ambiguousFieldOccRdrName af - mb_gre = pickGREs rdr [fl] - -- NB: this GRE can be 'Nothing' when in GHCi. - -- See test T10439. + lbl = ambiguousFieldOccRdrName af + mb_gre = pickGREs lbl [fld_gre] + -- NB: this GRE can be 'Nothing' when in GHCi. + -- See test T10439. -- Mark the record fields as used, now that we have disambiguated. -- There is no risk of duplicate deprecation warnings, as we have -- not marked the GREs as used previously. ; setSrcSpanA loc $ mapM_ (addUsedGRE EnableDeprecationWarnings) mb_gre - ; sel <- tcLookupId $ flSelector $ fieldGRELabel fl - ; let L loc af = hfbLHS upd - lbl = ambiguousFieldOccRdrName af + ; sel <- tcLookupId (greName fld_gre) ; return $ L l HsFieldBind { hfbAnn = hfbAnn upd , hfbLHS = L (l2l loc) $ Unambiguous sel (L (l2l loc) lbl) ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -1938,8 +1938,8 @@ lookupName :: Bool -- True <=> type namespace -- False <=> value namespace -> String -> TcM (Maybe TH.Name) lookupName is_type_name s - = do { mb_gre <- lookupSameOccRn_maybe rdr_name - ; return (fmap (reifyName . greName) mb_gre) } + = do { mb_nm <- lookupSameOccRn_maybe rdr_name + ; return (fmap reifyName mb_nm) } where th_name = TH.mkName s -- Parses M.x into a base of 'x' and a module of 'M' @@ -1999,15 +1999,12 @@ lookupThName_maybe :: TH.Name -> TcM (Maybe Name) lookupThName_maybe th_name = do { let guesses = thRdrNameGuesses th_name ; case guesses of - { [for_sure] -> get_name $ lookupSameOccRn_maybe for_sure + { [for_sure] -> lookupSameOccRn_maybe for_sure ; _ -> - do { names <- mapMaybeM (get_name . lookupOccRn_maybe) guesses + do { gres <- mapMaybeM lookupOccRn_maybe guesses -- Pick the first that works -- E.g. reify (mkName "A") will pick the class A in preference to the data constructor A - ; return (listToMaybe names) } } } - where - get_name :: TcM (Maybe GlobalRdrElt) -> TcM (Maybe Name) - get_name = fmap (fmap greName) + ; return (fmap greName $ listToMaybe gres) } } } tcLookupTh :: Name -> TcM TcTyThing -- This is a specialised version of GHC.Tc.Utils.Env.tcLookup; specialised mainly in that ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -512,6 +512,8 @@ data TcGblEnv -- See Note [Tracking unused binding and imports] tcg_dus :: DefUses, tcg_used_gres :: TcRef [GlobalRdrElt], + -- ^ INVARIANT: all these GREs were imported; that is, + -- they all have a non-empty gre_imp field. tcg_keep :: TcRef NameSet, tcg_th_used :: TcRef Bool, ===================================== compiler/GHC/Types/Name/Reader.hs ===================================== @@ -68,13 +68,13 @@ module GHC.Types.Name.Reader ( -- ** Global 'RdrName' mapping elements: 'GlobalRdrElt', 'Provenance', 'ImportSpec' GlobalRdrEltX(..), GlobalRdrElt, IfGlobalRdrElt, FieldGlobalRdrElt, greName, forceGlobalRdrEnv, hydrateGlobalRdrEnv, - isLocalGRE, isRecFldGRE, + isLocalGRE, isImportedGRE, isRecFldGRE, fieldGREInfo, isDuplicateRecFldGRE, isNoFieldSelectorGRE, isFieldSelectorGRE, unQualOK, qualSpecOK, unQualSpecOK, pprNameProvenance, - vanillaGRE, localVanillaGRE, localTyConGRE, - localConLikeGRE, localFieldGREs, + mkGRE, mkExactGRE, mkLocalGRE, mkLocalVanillaGRE, mkLocalTyConGRE, + mkLocalConLikeGRE, mkLocalFieldGREs, gresToNameSet, -- ** Shadowing @@ -526,7 +526,8 @@ type GlobalRdrEnvX info = OccEnv [GlobalRdrEltX info] -- | Global Reader Element -- --- An element of the 'GlobalRdrEnv'. +-- Something in scope in the renamer; usually a member of the 'GlobalRdrEnv'. +-- See Note [GlobalRdrElt provenance]. type GlobalRdrElt = GlobalRdrEltX GREInfo @@ -538,7 +539,8 @@ type IfGlobalRdrElt = GlobalRdrEltX () -- | Global Reader Element -- --- An element of the 'GlobalRdrEnv'. +-- Something in scope in the renamer; usually a member of the 'GlobalRdrEnv'. +-- See Note [GlobalRdrElt provenance]. -- -- Why do we parametrise over the 'gre_info' field? See Note [IfGlobalRdrEnv]. data GlobalRdrEltX info @@ -546,6 +548,8 @@ data GlobalRdrEltX info , gre_par :: !Parent -- ^ See Note [Parents] , gre_lcl :: !Bool -- ^ True <=> the thing was defined locally , gre_imp :: !(Bag ImportSpec) -- ^ In scope through these imports + -- See Note [GlobalRdrElt provenance] for the relation between gre_lcl and gre_imp. + , gre_info :: info -- ^ Information the renamer knows about this particular 'Name'. -- @@ -554,8 +558,7 @@ data GlobalRdrEltX info -- -- Note [Retrieving the GREInfo from interfaces] in GHC.Types.GREInfo. } deriving (Data) - -- INVARIANT: either gre_lcl = True or gre_imp is non-empty - -- See Note [GlobalRdrElt provenance] + {- Note [IfGlobalRdrEnv] ~~~~~~~~~~~~~~~~~~~~~~~~ @@ -623,16 +626,32 @@ hasParent p _ = p {- Note [GlobalRdrElt provenance] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The gre_lcl and gre_imp fields of a GlobalRdrElt describe its "provenance", -i.e. how the Name came to be in scope. It can be in scope two ways: - - gre_lcl = True: it is bound in this module - - gre_imp: a list of all the imports that brought it into scope +i.e. how the Name came to be in scope. It can be in scope in one of the following +three ways: + + A. The Name was locally bound, in the current module. + gre_lcl = True + + The renamer adds this Name to the GlobalRdrEnv after renaming the binding. + See the calls to "extendGlobalRdrEnvRn" in GHC.Rename.Module.rnSrcDecls. + + B. The Name was imported + gre_imp = Just imps <=> brought into scope by the imports "imps" + + The renamer adds this Name to the GlobalRdrEnv after processing the imports. + See GHC.Rename.Names.filterImports and GHC.Tc.Module.tcRnImports. -It's an INVARIANT that you have one or the other; that is, either -gre_lcl is True, or gre_imp is non-empty. + C. We followed an exact reference (i.e. an Exact or Orig RdrName) + gre_lcl = False, gre_imp = Nothing -It is just possible to have *both* if there is a module loop: a Name -is defined locally in A, and also brought into scope by importing a -module that SOURCE-imported A. Example (#7672): + In this case, we directly fetch a Name and its GREInfo from direct reference. + We don't add it to the GlobalRdrEnv. See "GHC.Rename.Env.lookupExactOrOrig". + +It is just about possible to have *both* gre_lcl = True and gre_imp = Just imps. +This can happen with module loops: a Name is defined locally in A, and also +brought into scope by importing a module that SOURCE-imported A. + +Example (#7672): A.hs-boot module A where data T @@ -710,42 +729,47 @@ those. For T that will mean we have That's why plusParent picks the "best" case. -} -vanillaGRE :: (Name -> Maybe ImportSpec) -> Parent -> Name -> GlobalRdrElt -vanillaGRE prov_fn par n = +mkGRE :: (Name -> Maybe ImportSpec) -> GREInfo -> Parent -> Name -> GlobalRdrElt +mkGRE prov_fn info par n = case prov_fn n of -- Nothing => bound locally -- Just is => imported from 'is' Nothing -> GRE { gre_name = n, gre_par = par , gre_lcl = True, gre_imp = emptyBag - , gre_info = Vanilla } + , gre_info = info } Just is -> GRE { gre_name = n, gre_par = par , gre_lcl = False, gre_imp = unitBag is - , gre_info = Vanilla } + , gre_info = info } + +mkExactGRE :: Name -> GREInfo -> GlobalRdrElt +mkExactGRE nm info = + GRE { gre_name = nm, gre_par = NoParent + , gre_lcl = False, gre_imp = emptyBag + , gre_info = info } -localVanillaGRE :: Parent -> Name -> GlobalRdrElt -localVanillaGRE = vanillaGRE (const Nothing) +mkLocalGRE :: GREInfo -> Parent -> Name -> GlobalRdrElt +mkLocalGRE = mkGRE (const Nothing) + +mkLocalVanillaGRE :: Parent -> Name -> GlobalRdrElt +mkLocalVanillaGRE = mkLocalGRE Vanilla -- | Create a local 'GlobalRdrElt' for a 'TyCon'. -localTyConGRE :: TyConFlavour Name +mkLocalTyConGRE :: TyConFlavour Name -> Name -> GlobalRdrElt -localTyConGRE flav nm = - ( localVanillaGRE par nm ) - { gre_info = IAmTyCon flav } +mkLocalTyConGRE flav nm = mkLocalGRE (IAmTyCon flav) par nm where par = case tyConFlavourAssoc_maybe flav of Nothing -> NoParent Just p -> ParentIs p -localConLikeGRE :: Parent -> (ConLikeName, ConInfo) -> GlobalRdrElt -localConLikeGRE p (con_nm, con_info) = - ( localVanillaGRE p $ conLikeName_Name con_nm ) - { gre_info = IAmConLike con_info } +mkLocalConLikeGRE :: Parent -> (ConLikeName, ConInfo) -> GlobalRdrElt +mkLocalConLikeGRE p (con_nm, con_info) = + mkLocalGRE (IAmConLike con_info) p (conLikeName_Name con_nm ) -localFieldGREs :: Parent -> [(ConLikeName, ConInfo)] -> [GlobalRdrElt] -localFieldGREs p cons = - [ ( localVanillaGRE p fld_nm ) - { gre_info = IAmRecField fld_info } +mkLocalFieldGREs :: Parent -> [(ConLikeName, ConInfo)] -> [GlobalRdrElt] +mkLocalFieldGREs p cons = + [ mkLocalGRE (IAmRecField fld_info) p fld_nm | (S.Arg fld_nm fl, fl_cons) <- flds , let fld_info = RecFieldInfo { recFieldLabel = fl , recFieldCons = fl_cons } ] @@ -1147,9 +1171,17 @@ getGRE_NameQualifier_maybes env name | lcl = Nothing | otherwise = Just $ map (is_as . is_decl) (bagToList iss) +-- | Is this 'GlobalRdrElt' defined locally? isLocalGRE :: GlobalRdrEltX info -> Bool isLocalGRE (GRE { gre_lcl = lcl }) = lcl +-- | Is this 'GlobalRdrElt' imported? +-- +-- Not just the negation of 'isLocalGRE', because it might be an Exact or +-- Orig name reference. See Note [GlobalRdrElt provenance]. +isImportedGRE :: GlobalRdrEltX info -> Bool +isImportedGRE (GRE { gre_imp = imps }) = not $ isEmptyBag imps + -- | Is this a record field GRE? -- -- Important: does /not/ consult the 'GreInfo' field. ===================================== compiler/GHC/Types/TyThing.hs ===================================== @@ -287,7 +287,7 @@ tyThingLocalGREs ty_thing = ATyCon t | Just c <- tyConClass_maybe t -> myself NoParent - : ( map (localVanillaGRE (ParentIs $ className c) . getName) (classMethods c) + : ( map (mkLocalVanillaGRE (ParentIs $ className c) . getName) (classMethods c) ++ map tc_GRE (classATs c) ) | otherwise -> let dcs = tyConDataCons t @@ -296,7 +296,7 @@ tyThingLocalGREs ty_thing = in myself NoParent : map (dc_GRE par) dcs ++ - localFieldGREs par + mkLocalFieldGREs par [ (mk_nm dc, con_info) | dc <- dcs , let con_info = conLikeConInfo (RealDataCon dc) ] @@ -308,7 +308,7 @@ tyThingLocalGREs ty_thing = RealDataCon dc -> ParentIs $ tyConName $ dataConTyCon dc in myself par : - localFieldGREs par + mkLocalFieldGREs par [(conLikeConLikeName con, conLikeConInfo con)] AnId id | RecSelId { sel_tycon = RecSelData tc } <- idDetails id @@ -318,17 +318,15 @@ tyThingLocalGREs ty_thing = _ -> [ myself NoParent ] where tc_GRE :: TyCon -> GlobalRdrElt - tc_GRE at = localTyConGRE + tc_GRE at = mkLocalTyConGRE (fmap tyConName $ tyConFlavour at) (tyConName at) dc_GRE :: Parent -> DataCon -> GlobalRdrElt dc_GRE par dc = let con_info = conLikeConInfo (RealDataCon dc) - in localConLikeGRE par (DataConName $ dataConName dc, con_info) + in mkLocalConLikeGRE par (DataConName $ dataConName dc, con_info) myself :: Parent -> GlobalRdrElt - myself p = - (localVanillaGRE p (getName ty_thing)) - { gre_info = tyThingGREInfo ty_thing } + myself p = mkLocalGRE (tyThingGREInfo ty_thing) p (getName ty_thing) -- | Obtain information pertinent to the renamer about a particular 'TyThing'. -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8e81f140c6e8297273ef20addbcf71be54fbe28e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8e81f140c6e8297273ef20addbcf71be54fbe28e You're receiving 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 Jun 1 14:57:50 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 01 Jun 2023 10:57:50 -0400 Subject: [Git][ghc/ghc][master] Use the one-shot trick for UM and RewriteM functors Message-ID: <6478b1ee5b0b8_16c02716fa82802693f8@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2 changed files: - compiler/GHC/Core/Unify.hs - compiler/GHC/Tc/Solver/Rewrite.hs Changes: ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -1430,13 +1430,16 @@ data UMState = UMState newtype UM a = UM' { unUM :: UMState -> UnifyResultM (UMState, a) } -- See Note [The one-shot state monad trick] in GHC.Utils.Monad - deriving (Functor) pattern UM :: (UMState -> UnifyResultM (UMState, a)) -> UM a -- See Note [The one-shot state monad trick] in GHC.Utils.Monad pattern UM m <- UM' m where UM m = UM' (oneShot m) +{-# COMPLETE UM #-} + +instance Functor UM where + fmap f (UM m) = UM (\s -> fmap (\(s', v) -> (s', f v)) (m s)) instance Applicative UM where pure a = UM (\s -> pure (s, a)) ===================================== compiler/GHC/Tc/Solver/Rewrite.hs ===================================== @@ -56,7 +56,6 @@ import qualified GHC.Data.List.Infinite as Inf -- | The 'RewriteM' monad is a wrapper around 'TcS' with a 'RewriteEnv' newtype RewriteM a = RewriteM { runRewriteM :: RewriteEnv -> TcS a } - deriving (Functor) -- | Smart constructor for 'RewriteM', as describe in Note [The one-shot state -- monad trick] in "GHC.Utils.Monad". @@ -73,6 +72,9 @@ instance Applicative RewriteM where pure x = mkRewriteM $ \_ -> pure x (<*>) = ap +instance Functor RewriteM where + fmap f (RewriteM x) = mkRewriteM $ \env -> fmap f (x env) + instance HasDynFlags RewriteM where getDynFlags = liftTcS getDynFlags View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5d415bfd1cd3894919bf07474846835aacb3a975 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5d415bfd1cd3894919bf07474846835aacb3a975 You're receiving 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 Jun 1 14:58:29 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 01 Jun 2023 10:58:29 -0400 Subject: [Git][ghc/ghc][master] Fix testsuite skipping Lint Message-ID: <6478b215cc1c9_16c02710b95158274715@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 1 changed file: - testsuite/driver/testlib.py Changes: ===================================== testsuite/driver/testlib.py ===================================== @@ -566,8 +566,10 @@ def _extra_files(name, opts, files): # collect_stats is used in the majority case when the metrics to be collected # are about the performance of the runtime code generated by the compiler. def collect_compiler_stats(metric='all',deviation=20): - setTestOpts(no_lint) - return lambda name, opts, m=metric, d=deviation: _collect_stats(name, opts, m,d, True) + def f(name, opts, m=metric, d=deviation): + no_lint(name, opts) + return _collect_stats(name, opts, m, d, True) + return f def collect_stats(metric='all', deviation=20): return lambda name, opts, m=metric, d=deviation: _collect_stats(name, opts, m, d) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2c38551ea42ef596ffdbed196c87207f64815582 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2c38551ea42ef596ffdbed196c87207f64815582 You're receiving 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 Jun 1 14:59:04 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 01 Jun 2023 10:59:04 -0400 Subject: [Git][ghc/ghc][master] Add testcases for already fixed #16432 Message-ID: <6478b23851465_16c02710b951442800b7@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - 1 changed file: - testsuite/tests/quantified-constraints/T23333.hs Changes: ===================================== testsuite/tests/quantified-constraints/T23333.hs ===================================== @@ -1,8 +1,25 @@ {-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE GADTs, DataKinds #-} module T23333 where +import Data.Kind +import Data.Coerce + foo1 :: (forall y. Bool ~ y) => z -> Bool foo1 x = not x foo2 :: (forall y. y ~ Bool) => z -> Bool foo2 x = not x + +-- Testcases from #16432 +t1 :: forall f b. (forall a. Coercible (f a) a) => b -> f b +t1 = coerce + +data U :: () -> Type where + MkU :: Int -> U '() + +t2 :: forall n res. (('()~n) => (Int~res)) => U n -> res +t2 (MkU n) = n + +t3 :: ((Bool~Bool) => (Char~res)) => res +t3 = 'a' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/00a1e50b65354f65f508408d171ec1af4045dd95 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/00a1e50b65354f65f508408d171ec1af4045dd95 You're receiving 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 Jun 1 15:19:20 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Thu, 01 Jun 2023 11:19:20 -0400 Subject: [Git][ghc/ghc][wip/js-th] JS: always recompile when TH is enabled (cf #23013) Message-ID: <6478b6f8f055a_16c0271726c9302810d5@gitlab.mail> Sylvain Henry pushed to branch wip/js-th at Glasgow Haskell Compiler / GHC Commits: 152719c7 by Sylvain Henry at 2023-06-01T17:24:40+02:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 8 changed files: - compiler/GHC/Driver/Main.hs - compiler/GHC/Iface/Recomp.hs - testsuite/tests/annotations/should_run/all.T - + testsuite/tests/driver/OneShotTH.stdout-javascript-unknown-ghcjs - + testsuite/tests/driver/fat-iface/fat010.stdout-javascript-unknown-ghcjs - + testsuite/tests/driver/recompHash/recompHash.stdout-javascript-unknown-ghcjs - + testsuite/tests/driver/recompNoTH/recompNoTH.stdout-javascript-unknown-ghcjs - + testsuite/tests/driver/th-new-test/th-new-test.stdout-javascript-unknown-ghcjs Changes: ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -261,6 +261,8 @@ import GHC.Utils.Misc import GHC.Utils.Logger import GHC.Utils.TmpFs +import qualified GHC.LanguageExtensions as LangExt + import GHC.Data.FastString import GHC.Data.Bag import GHC.Data.StringBuffer @@ -871,6 +873,15 @@ hscRecompStatus , IsBoot <- isBootSummary mod_summary -> do msg UpToDate return $ HscUpToDate checked_iface emptyHomeModInfoLinkable + + -- Always recompile with the JS backend when TH is enabled until + -- #23013 is fixed. + | ArchJavaScript <- platformArch (targetPlatform lcl_dflags) + , xopt LangExt.TemplateHaskell lcl_dflags + -> do + msg $ needsRecompileBecause THWithJS + return $ HscRecompNeeded $ Just $ mi_iface_hash $ mi_final_exts $ checked_iface + | otherwise -> do -- Do need linkable -- 1. Just check whether we have bytecode/object linkables and then ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -197,6 +197,7 @@ data RecompReason | MismatchedDynHiFile | ObjectsChanged | LibraryChanged + | THWithJS deriving (Eq) instance Outputable RecompReason where @@ -229,6 +230,7 @@ instance Outputable RecompReason where MismatchedDynHiFile -> text "Mismatched dynamic interface file" ObjectsChanged -> text "Objects changed" LibraryChanged -> text "Library changed" + THWithJS -> text "JS backend always recompiles modules using Template Haskell for now (#23013)" recompileRequired :: RecompileRequired -> Bool recompileRequired UpToDate = False ===================================== testsuite/tests/annotations/should_run/all.T ===================================== @@ -9,6 +9,9 @@ setTestOpts(when(fast(), skip)) test('annrun01', [extra_files(['Annrun01_Help.hs']), req_th, + js_broken(23013), # strangely, the workaround for #23013 triggers + # a call to an undefined FFI function in bytestring. + # Before, it was slow but not failing. when(js_arch(), compile_timeout_multiplier(5)), pre_cmd('$MAKE -s --no-print-directory config'), omit_ways(['dyn'] + prof_ways)], ===================================== testsuite/tests/driver/OneShotTH.stdout-javascript-unknown-ghcjs ===================================== ===================================== testsuite/tests/driver/fat-iface/fat010.stdout-javascript-unknown-ghcjs ===================================== @@ -0,0 +1,5 @@ +[1 of 3] Compiling THA +[2 of 3] Compiling THB +[3 of 3] Compiling THC +[1 of 3] Compiling THA [JS backend always recompiles modules using Template Haskell for now (#23013)] +[2 of 3] Compiling THB [Source file changed] ===================================== testsuite/tests/driver/recompHash/recompHash.stdout-javascript-unknown-ghcjs ===================================== @@ -0,0 +1,3 @@ +[1 of 2] Compiling B +[2 of 2] Compiling A +[2 of 2] Compiling A [JS backend always recompiles modules using Template Haskell for now (#23013)] ===================================== testsuite/tests/driver/recompNoTH/recompNoTH.stdout-javascript-unknown-ghcjs ===================================== @@ -0,0 +1,4 @@ +[1 of 2] Compiling B +[2 of 2] Compiling A +[1 of 2] Compiling B [Source file changed] +[2 of 2] Compiling A [JS backend always recompiles modules using Template Haskell for now (#23013)] ===================================== testsuite/tests/driver/th-new-test/th-new-test.stdout-javascript-unknown-ghcjs ===================================== @@ -0,0 +1,26 @@ +[1 of 6] Compiling B +[2 of 6] Compiling A +[3 of 6] Compiling D +[4 of 6] Compiling C +[5 of 6] Compiling Main +[6 of 6] Linking Main +[1 of 6] Compiling B [JS backend always recompiles modules using Template Haskell for now (#23013)] +[2 of 6] Compiling A [JS backend always recompiles modules using Template Haskell for now (#23013)] +[3 of 6] Compiling D [JS backend always recompiles modules using Template Haskell for now (#23013)] +[4 of 6] Compiling C [JS backend always recompiles modules using Template Haskell for now (#23013)] +[6 of 6] Linking Main [Objects changed] +[1 of 6] Compiling B [Source file changed] +[2 of 6] Compiling A [B[TH] changed] +[3 of 6] Compiling D [JS backend always recompiles modules using Template Haskell for now (#23013)] +[4 of 6] Compiling C [D[TH] changed] +[6 of 6] Linking Main [Objects changed] +[1 of 6] Compiling B [JS backend always recompiles modules using Template Haskell for now (#23013)] +[2 of 6] Compiling A [JS backend always recompiles modules using Template Haskell for now (#23013)] +[3 of 6] Compiling D [Source file changed] +[4 of 6] Compiling C [D[TH] changed] +[6 of 6] Linking Main [Objects changed] +[1 of 6] Compiling B [Source file changed] +[2 of 6] Compiling A [B[TH] changed] +[3 of 6] Compiling D [Source file changed] +[4 of 6] Compiling C [D[TH] changed] +[6 of 6] Linking Main [Objects changed] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/152719c701277de7ae14712dd6563ba99f6c70f2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/152719c701277de7ae14712dd6563ba99f6c70f2 You're receiving 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 Jun 1 16:15:45 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Thu, 01 Jun 2023 12:15:45 -0400 Subject: [Git][ghc/ghc][wip/haddock-mem-fixes] 19 commits: Restructure IPE buffer layout Message-ID: <6478c431a20b1_16c027180bdcb42887b3@gitlab.mail> Finley McIlwaine pushed to branch wip/haddock-mem-fixes at Glasgow Haskell Compiler / GHC Commits: f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - 340c70a8 by Finley McIlwaine at 2023-06-01T10:00:46-06:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Strictly evaluate some SrcSpans in mkDoc{Next,Prev} to avoid thunks - Strictly evaluate names in `rnHsDoc` to avoid retention of GlobalRdrEnv - Strictly evaluate fields of `IfaceTyConInfo` - Update haddock perf tests to be more accurate and force evaluation of renamed doc thunks using `-fwrite-interface` - Accept a higher increase (40%) in allocations in the renamer due to `-haddock`. - Update Haddock submodule to move over to initial implementation of hi-haddock, including the other memory performance gains recently added to haddock. - - - - - fbe48eed by Finley McIlwaine at 2023-06-01T10:00:46-06:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. Also bump haddock to latest dev commit. - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/Doc.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Stg/Lint.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Solver/Rewrite.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Types/Name/Reader.hs - compiler/GHC/Types/TyThing.hs - compiler/ghc.cabal.in The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c3fea031c98ea273ba2ff34b68511390b468791b...fbe48eed0b24187823844fbe6eb9ec08cdf615bf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c3fea031c98ea273ba2ff34b68511390b468791b...fbe48eed0b24187823844fbe6eb9ec08cdf615bf You're receiving 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 Jun 1 16:21:14 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 01 Jun 2023 12:21:14 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T22010 Message-ID: <6478c57a2f563_16c02717ee048c28937a@gitlab.mail> Jaro Reinders pushed new branch wip/T22010 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22010 You're receiving 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 Jun 1 16:39:38 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Thu, 01 Jun 2023 12:39:38 -0400 Subject: [Git][ghc/ghc][wip/expand-do] 19 commits: Restructure IPE buffer layout Message-ID: <6478c9cac53cf_16c0271827b52429173d@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - 7d14d9be by Apoorv Ingle at 2023-06-01T11:39:05-05:00 Fixes #18324 #23147 Expands do notation before typechecking using `HsExpansion` - Adds testcases T18324, T18324b, DoubleMatch Expands - Do statements - Monadic do statements - monadic fix blocks - make sure fail is used for pattern match failures in bind statments - Makes sure unused binds generate warnings - runs the pattern match check in generated lambda exprs to avoid getting suprious pattern match failures. c.f. pmcheck/should_compile/DoubleMatch.hs - PopSrcSpan in HsExpr to pop error context - Discards default monad fail alternatives that are spuriously generated - Make sure we check for generated loc span for checking if the (>>) is user written or expanded for /do/ purposes - - - - - 4a53ccf6 by Apoorv Ingle at 2023-06-01T11:39:06-05:00 - Add PopSrcSpan (XXExprGhcRn) in appropriate places while expanding statements - correct source spans displayed for warnDiscardedDoBindings - use `mkExpandStmt` to store original stmts along with expanded expr for using the right context for error message printing - improves error messages for applicative do - remove special case from isMatchContextPmChecked (long distance info is now properly propogated) - set correct src spans to statement expansions - Match ctxt while type checking HsLam is different if the lambda match is due to an expression generated from a do block - call tcExpr and not tcApp in PopSrcSpan so make sure impredicativity works fine - look into XExprs in tcInferAppHead_maybe for infering the type to make T18324 typecheck and run - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Stg/Lint.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/be6ecf94873df437026961022a31ec7068fabfc5...4a53ccf61d2ba5856ee1b4ca8ef108baef977c3a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/be6ecf94873df437026961022a31ec7068fabfc5...4a53ccf61d2ba5856ee1b4ca8ef108baef977c3a You're receiving 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 Jun 1 16:50:24 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 01 Jun 2023 12:50:24 -0400 Subject: [Git][ghc/ghc][wip/tc-lcl-env-refactor] 84 commits: base: Add test for #13660 Message-ID: <6478cc50695c7_16c027180bdcb4292251@gitlab.mail> Matthew Pickering pushed to branch wip/tc-lcl-env-refactor at Glasgow Haskell Compiler / GHC Commits: 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - 5d254dfb by Matthew Pickering at 2023-06-01T10:12:52+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.TcRef - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.TcIdSigInfo - GHC.Tc.Types.TcBinder - GHC.Tc.Types.TcTyThing - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - e735a2b3 by Matthew Pickering at 2023-06-01T10:13:38+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 36f345e3 by Matthew Pickering at 2023-06-01T10:13:39+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - c963f3f9 by Matthew Pickering at 2023-06-01T10:13:39+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - a2fc7ff5 by Matthew Pickering at 2023-06-01T10:14:15+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 990932f5 by Matthew Pickering at 2023-06-01T10:14:16+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 5b36a77e by Matthew Pickering at 2023-06-01T10:14:16+01:00 Remove unecessary SOURCE import - - - - - 9a887aa5 by Matthew Pickering at 2023-06-01T11:41:59+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCo/Compare.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/410d682208e32f506ebec66811d8f19286f6d641...9a887aa578a7b85197f1c12a1b0a0426c268df64 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/410d682208e32f506ebec66811d8f19286f6d641...9a887aa578a7b85197f1c12a1b0a0426c268df64 You're receiving 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 Jun 1 19:35:12 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 01 Jun 2023 15:35:12 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ghc-heap-prim Message-ID: <6478f2f0c28ba_16c0271827b538306946@gitlab.mail> Ben Gamari pushed new branch wip/ghc-heap-prim at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ghc-heap-prim You're receiving 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 Jun 1 20:02:33 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 01 Jun 2023 16:02:33 -0400 Subject: [Git][ghc/ghc][wip/ghc-heap-prim] ghc-heap: Support for PRIM and BLOCKING_QUEUE closures Message-ID: <6478f959d6ed5_16c0271827b5243091fc@gitlab.mail> Ben Gamari pushed to branch wip/ghc-heap-prim at Glasgow Haskell Compiler / GHC Commits: 95e9aaee by Ben Gamari at 2023-06-01T16:02:27-04:00 ghc-heap: Support for PRIM and BLOCKING_QUEUE closures - - - - - 2 changed files: - libraries/ghc-heap/GHC/Exts/Heap.hs - rts/Heap.c Changes: ===================================== libraries/ghc-heap/GHC/Exts/Heap.hs ===================================== @@ -317,8 +317,9 @@ getClosureDataFromHeapRepPrim getConDesc decodeCCS itbl heapRep pts = do _ -> fail $ "Expected at least 3 ptrs to MVAR, found " ++ show (length pts) - BLOCKING_QUEUE -> - pure $ OtherClosure itbl pts rawHeapWords + BLOCKING_QUEUE + | [_link, bh, _owner, msg] <- pts -> + pure $ BlockingQueueClosure itbl _link bh _owner msg WEAK -> case pts of pts0 : pts1 : pts2 : pts3 : rest -> pure $ WeakClosure ===================================== rts/Heap.c ===================================== @@ -245,6 +245,25 @@ StgWord collect_pointers(StgClosure *closure, StgClosure *ptrs[]) { // See the note in AP_STACK about the stack chunk. break; + case BLOCKING_QUEUE: + { + StgBlockingQueue *bq = (StgBlockingQueue *) closure; + ptrs[nptrs++] = bq->link; + ptrs[nptrs++] = bq->bh; + ptrs[nptrs++] = bq->owner; + ptrs[nptrs++] = bq->queue; + break; + } + + case PRIM: + { + StgInfoTable *itbl = get_itbl(closure); + for (int i=0; i < itbl->layout.ptrs; i++) { + ptrs[nptrs++] = closure->payload[i]; + } + break; + } + default: fprintf(stderr,"closurePtrs: Cannot handle type %s yet\n", closure_type_names[info->type]); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/95e9aaee75b6ba021f5ead29ccbc49b6f3bb3f14 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/95e9aaee75b6ba021f5ead29ccbc49b6f3bb3f14 You're receiving 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 Jun 1 21:10:38 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 01 Jun 2023 17:10:38 -0400 Subject: [Git][ghc/ghc][wip/ghc-heap-prim] ghc-heap: Support for PRIM and BLOCKING_QUEUE closures Message-ID: <6479094e5d837_16c0271827b52431092f@gitlab.mail> Ben Gamari pushed to branch wip/ghc-heap-prim at Glasgow Haskell Compiler / GHC Commits: fd585733 by Ben Gamari at 2023-06-01T17:10:33-04:00 ghc-heap: Support for PRIM and BLOCKING_QUEUE closures - - - - - 2 changed files: - libraries/ghc-heap/GHC/Exts/Heap.hs - rts/Heap.c Changes: ===================================== libraries/ghc-heap/GHC/Exts/Heap.hs ===================================== @@ -317,8 +317,9 @@ getClosureDataFromHeapRepPrim getConDesc decodeCCS itbl heapRep pts = do _ -> fail $ "Expected at least 3 ptrs to MVAR, found " ++ show (length pts) - BLOCKING_QUEUE -> - pure $ OtherClosure itbl pts rawHeapWords + BLOCKING_QUEUE + | [_link, bh, _owner, msg] <- pts -> + pure $ BlockingQueueClosure itbl _link bh _owner msg WEAK -> case pts of pts0 : pts1 : pts2 : pts3 : rest -> pure $ WeakClosure ===================================== rts/Heap.c ===================================== @@ -245,6 +245,25 @@ StgWord collect_pointers(StgClosure *closure, StgClosure *ptrs[]) { // See the note in AP_STACK about the stack chunk. break; + case BLOCKING_QUEUE: + { + StgBlockingQueue *bq = (StgBlockingQueue *) closure; + ptrs[nptrs++] = (StgClosure *) bq->link; + ptrs[nptrs++] = bq->bh; + ptrs[nptrs++] = (StgClosure *) bq->owner; + ptrs[nptrs++] = (StgClosure *) bq->queue; + break; + } + + case PRIM: + { + StgInfoTable *itbl = get_itbl(closure); + for (int i=0; i < itbl->layout.ptrs; i++) { + ptrs[nptrs++] = closure->payload[i]; + } + break; + } + default: fprintf(stderr,"closurePtrs: Cannot handle type %s yet\n", closure_type_names[info->type]); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fd585733bc7a5b2b70c78db0d75996a65c5a8eeb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fd585733bc7a5b2b70c78db0d75996a65c5a8eeb You're receiving 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 Jun 1 21:18:41 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 01 Jun 2023 17:18:41 -0400 Subject: [Git][ghc/ghc][wip/ghc-heap-prim] ghc-heap: Support for BLOCKING_QUEUE closures Message-ID: <64790b31c8da4_16c0271827b6783115e2@gitlab.mail> Ben Gamari pushed to branch wip/ghc-heap-prim at Glasgow Haskell Compiler / GHC Commits: eef90f25 by Ben Gamari at 2023-06-01T17:18:32-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - 2 changed files: - libraries/ghc-heap/GHC/Exts/Heap.hs - rts/Heap.c Changes: ===================================== libraries/ghc-heap/GHC/Exts/Heap.hs ===================================== @@ -317,8 +317,9 @@ getClosureDataFromHeapRepPrim getConDesc decodeCCS itbl heapRep pts = do _ -> fail $ "Expected at least 3 ptrs to MVAR, found " ++ show (length pts) - BLOCKING_QUEUE -> - pure $ OtherClosure itbl pts rawHeapWords + BLOCKING_QUEUE + | [_link, bh, _owner, msg] <- pts -> + pure $ BlockingQueueClosure itbl _link bh _owner msg WEAK -> case pts of pts0 : pts1 : pts2 : pts3 : rest -> pure $ WeakClosure ===================================== rts/Heap.c ===================================== @@ -245,6 +245,16 @@ StgWord collect_pointers(StgClosure *closure, StgClosure *ptrs[]) { // See the note in AP_STACK about the stack chunk. break; + case BLOCKING_QUEUE: + { + StgBlockingQueue *bq = (StgBlockingQueue *) closure; + ptrs[nptrs++] = (StgClosure *) bq->link; + ptrs[nptrs++] = bq->bh; + ptrs[nptrs++] = (StgClosure *) bq->owner; + ptrs[nptrs++] = (StgClosure *) bq->queue; + break; + } + default: fprintf(stderr,"closurePtrs: Cannot handle type %s yet\n", closure_type_names[info->type]); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eef90f25e8c7ee48471bc54184c8bb755219b152 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eef90f25e8c7ee48471bc54184c8bb755219b152 You're receiving 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 Jun 1 23:50:21 2023 From: gitlab at gitlab.haskell.org (sheaf (@sheaf)) Date: Thu, 01 Jun 2023 19:50:21 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/delete-zonk Message-ID: <64792ebd2c400_16c0271827b6783122f7@gitlab.mail> sheaf pushed new branch wip/delete-zonk at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/delete-zonk You're receiving 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 Jun 2 08:30:56 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 02 Jun 2023 04:30:56 -0400 Subject: [Git][ghc/ghc][wip/T22010] Word64 Unique; compiles but some TODOs left Message-ID: <6479a8c0ad8f3_16c027180bdcb43391c7@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: f83f8b41 by Jaro Reinders at 2023-06-02T10:30:36+02:00 Word64 Unique; compiles but some TODOs left - - - - - 25 changed files: - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - − compiler/GHC/Data/Word64Map/Internal/Debug.hs - − compiler/GHC/Data/Word64Map/Merge/Lazy.hs - − compiler/GHC/Data/Word64Map/Merge/Strict.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/StgToJS/Deps.hs - compiler/GHC/StgToJS/Ids.hs - compiler/GHC/StgToJS/Symbols.hs - compiler/GHC/StgToJS/Types.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Unique/Supply.hs - compiler/GHC/Types/Var/Env.hs - − compiler/GHC/Utils/Containers/Internal/BitQueue.hs - − compiler/GHC/Utils/Containers/Internal/Coercions.hs - − compiler/GHC/Utils/Containers/Internal/PtrEquality.hs - − compiler/GHC/Utils/Containers/Internal/State.hs - − compiler/GHC/Utils/Containers/Internal/StrictMaybe.hs - − compiler/GHC/Utils/Containers/Internal/TypeError.hs - compiler/ghc.cabal.in - libraries/ghci/GHCi/Message.hs - libraries/ghci/GHCi/Run.hs Changes: ===================================== compiler/GHC/Cmm/Sink.hs ===================================== @@ -22,6 +22,7 @@ import GHC.Platform import GHC.Types.Unique.FM import qualified Data.IntSet as IntSet +import qualified GHC.Data.Word64Set as Word64Set import Data.List (partition) import Data.Maybe @@ -175,7 +176,7 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- Annotate the middle nodes with the registers live *after* -- the node. This will help us decide whether we can inline -- an assignment in the current node or not. - live = IntSet.unions (map getLive succs) + live = Word64Set.unions (map getLive succs) live_middle = gen_killL platform last live ann_middles = annotate platform live_middle (blockToList middle) @@ -188,7 +189,7 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- one predecessor), so identify the join points and the set -- of registers live in them. (joins, nonjoins) = partition (`mapMember` join_pts) succs - live_in_joins = IntSet.unions (map getLive joins) + live_in_joins = Word64Set.unions (map getLive joins) -- We do not want to sink an assignment into multiple branches, -- so identify the set of registers live in multiple successors. @@ -215,7 +216,7 @@ cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks live_sets' | should_drop = live_sets | otherwise = map upd live_sets - upd set | r `elemLRegSet` set = set `IntSet.union` live_rhs + upd set | r `elemLRegSet` set = set `Word64Set.union` live_rhs | otherwise = set live_rhs = foldRegsUsed platform (flip insertLRegSet) emptyLRegSet rhs ===================================== compiler/GHC/CmmToAsm/Wasm/Asm.hs ===================================== @@ -15,6 +15,7 @@ import Data.ByteString.Builder import Data.Coerce import Data.Foldable import qualified Data.IntSet as IS +import qualified GHC.Data.Word64Set as WS import Data.Maybe import Data.Semigroup import GHC.Cmm @@ -181,9 +182,9 @@ asmTellSectionHeader :: Builder -> WasmAsmM () asmTellSectionHeader k = asmTellTabLine $ ".section " <> k <> ",\"\",@" asmTellDataSection :: - WasmTypeTag w -> IS.IntSet -> SymName -> DataSection -> WasmAsmM () + WasmTypeTag w -> WS.Word64Set -> SymName -> DataSection -> WasmAsmM () asmTellDataSection ty_word def_syms sym DataSection {..} = do - when (getKey (getUnique sym) `IS.member` def_syms) $ asmTellDefSym sym + when (getKey (getUnique sym) `WS.member` def_syms) $ asmTellDefSym sym asmTellSectionHeader sec_name asmTellAlign dataSectionAlignment asmTellTabLine asm_size @@ -420,12 +421,12 @@ asmTellWasmControl ty_word c = case c of asmTellFunc :: WasmTypeTag w -> - IS.IntSet -> + WS.Word64Set -> SymName -> (([SomeWasmType], [SomeWasmType]), FuncBody w) -> WasmAsmM () asmTellFunc ty_word def_syms sym (func_ty, FuncBody {..}) = do - when (getKey (getUnique sym) `IS.member` def_syms) $ asmTellDefSym sym + when (getKey (getUnique sym) `WS.member` def_syms) $ asmTellDefSym sym asmTellSectionHeader $ ".text." <> asm_sym asmTellLine $ asm_sym <> ":" asmTellFuncType sym func_ty ===================================== compiler/GHC/CmmToAsm/Wasm/FromCmm.hs ===================================== @@ -27,6 +27,7 @@ import qualified Data.ByteString as BS import Data.Foldable import Data.Functor import qualified Data.IntSet as IS +import qualified GHC.Data.Word64Set as WS import Data.Semigroup import Data.String import Data.Traversable @@ -1553,7 +1554,7 @@ onTopSym lbl = case sym_vis of SymDefault -> wasmModifyM $ \s -> s { defaultSyms = - IS.insert + WS.insert (getKey $ getUnique sym) $ defaultSyms s } ===================================== compiler/GHC/CmmToAsm/Wasm/Types.hs ===================================== @@ -53,6 +53,7 @@ import Data.ByteString (ByteString) import Data.Coerce import Data.Functor import qualified Data.IntSet as IS +import qualified GHC.Data.Word64Set as WS import Data.Kind import Data.String import Data.Type.Equality @@ -197,7 +198,7 @@ data DataSection = DataSection type SymMap = UniqMap SymName -- | No need to remember the symbols. -type SymSet = IS.IntSet +type SymSet = WS.Word64Set type GlobalInfo = (SymName, SomeWasmType) @@ -427,7 +428,7 @@ initialWasmCodeGenState platform us = WasmCodeGenState { wasmPlatform = platform, - defaultSyms = IS.empty, + defaultSyms = WS.empty, funcTypes = emptyUniqMap, funcBodies = emptyUniqMap, ===================================== compiler/GHC/Data/Word64Map/Internal/Debug.hs deleted ===================================== @@ -1,6 +0,0 @@ -module GHC.Data.Word64Map.Internal.Debug - ( showTree - , showTreeWith - ) where - -import GHC.Data.Word64Map.Internal ===================================== compiler/GHC/Data/Word64Map/Merge/Lazy.hs deleted ===================================== @@ -1,91 +0,0 @@ -{-# LANGUAGE CPP #-} -#if !defined(TESTING) && defined(__GLASGOW_HASKELL__) -{-# LANGUAGE Safe #-} -#endif - -#include "containers.h" - ------------------------------------------------------------------------------ --- | --- Module : Data.IntMap.Merge.Lazy --- Copyright : (c) wren romano 2016 --- License : BSD-style --- Maintainer : libraries at haskell.org --- Portability : portable --- --- This module defines an API for writing functions that merge two --- maps. The key functions are 'merge' and 'mergeA'. --- Each of these can be used with several different \"merge tactics\". --- --- The 'merge' and 'mergeA' functions are shared by --- the lazy and strict modules. Only the choice of merge tactics --- determines strictness. If you use 'Data.Map.Merge.Strict.mapMissing' --- from "Data.Map.Merge.Strict" then the results will be forced before --- they are inserted. If you use 'Data.Map.Merge.Lazy.mapMissing' from --- this module then they will not. --- --- == Efficiency note --- --- The 'Control.Category.Category', 'Applicative', and 'Monad' instances for --- 'WhenMissing' tactics are included because they are valid. However, they are --- inefficient in many cases and should usually be avoided. The instances --- for 'WhenMatched' tactics should not pose any major efficiency problems. --- --- @since 0.5.9 - -module GHC.Data.Int64Map.Merge.Lazy ( - -- ** Simple merge tactic types - SimpleWhenMissing - , SimpleWhenMatched - - -- ** General combining function - , merge - - -- *** @WhenMatched@ tactics - , zipWithMaybeMatched - , zipWithMatched - - -- *** @WhenMissing@ tactics - , mapMaybeMissing - , dropMissing - , preserveMissing - , mapMissing - , filterMissing - - -- ** Applicative merge tactic types - , WhenMissing - , WhenMatched - - -- ** Applicative general combining function - , mergeA - - -- *** @WhenMatched@ tactics - -- | The tactics described for 'merge' work for - -- 'mergeA' as well. Furthermore, the following - -- are available. - , zipWithMaybeAMatched - , zipWithAMatched - - -- *** @WhenMissing@ tactics - -- | The tactics described for 'merge' work for - -- 'mergeA' as well. Furthermore, the following - -- are available. - , traverseMaybeMissing - , traverseMissing - , filterAMissing - - -- *** Covariant maps for tactics - , mapWhenMissing - , mapWhenMatched - - -- *** Contravariant maps for tactics - , lmapWhenMissing - , contramapFirstWhenMatched - , contramapSecondWhenMatched - - -- *** Miscellaneous tactic functions - , runWhenMatched - , runWhenMissing - ) where - -import Data.IntMap.Internal ===================================== compiler/GHC/Data/Word64Map/Merge/Strict.hs deleted ===================================== @@ -1,218 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE BangPatterns #-} -#if !defined(TESTING) && defined(__GLASGOW_HASKELL__) -{-# LANGUAGE Trustworthy #-} -#endif - -#include "containers.h" - ------------------------------------------------------------------------------ --- | --- Module : Data.IntMap.Merge.Strict --- Copyright : (c) wren romano 2016 --- License : BSD-style --- Maintainer : libraries at haskell.org --- Portability : portable --- --- This module defines an API for writing functions that merge two --- maps. The key functions are 'merge' and 'mergeA'. --- Each of these can be used with several different \"merge tactics\". --- --- The 'merge' and 'mergeA' functions are shared by --- the lazy and strict modules. Only the choice of merge tactics --- determines strictness. If you use 'Data.Map.Merge.Strict.mapMissing' --- from this module then the results will be forced before they are --- inserted. If you use 'Data.Map.Merge.Lazy.mapMissing' from --- "Data.Map.Merge.Lazy" then they will not. --- --- == Efficiency note --- --- The 'Control.Category.Category', 'Applicative', and 'Monad' instances for --- 'WhenMissing' tactics are included because they are valid. However, they are --- inefficient in many cases and should usually be avoided. The instances --- for 'WhenMatched' tactics should not pose any major efficiency problems. --- --- @since 0.5.9 - -module GHC.Data.Int64Map.Merge.Strict ( - -- ** Simple merge tactic types - SimpleWhenMissing - , SimpleWhenMatched - - -- ** General combining function - , merge - - -- *** @WhenMatched@ tactics - , zipWithMaybeMatched - , zipWithMatched - - -- *** @WhenMissing@ tactics - , mapMaybeMissing - , dropMissing - , preserveMissing - , mapMissing - , filterMissing - - -- ** Applicative merge tactic types - , WhenMissing - , WhenMatched - - -- ** Applicative general combining function - , mergeA - - -- *** @WhenMatched@ tactics - -- | The tactics described for 'merge' work for - -- 'mergeA' as well. Furthermore, the following - -- are available. - , zipWithMaybeAMatched - , zipWithAMatched - - -- *** @WhenMissing@ tactics - -- | The tactics described for 'merge' work for - -- 'mergeA' as well. Furthermore, the following - -- are available. - , traverseMaybeMissing - , traverseMissing - , filterAMissing - - -- ** Covariant maps for tactics - , mapWhenMissing - , mapWhenMatched - - -- ** Miscellaneous functions on tactics - - , runWhenMatched - , runWhenMissing - ) where - -import Data.IntMap.Internal - ( SimpleWhenMissing - , SimpleWhenMatched - , merge - , dropMissing - , preserveMissing - , filterMissing - , WhenMissing (..) - , WhenMatched (..) - , mergeA - , filterAMissing - , runWhenMatched - , runWhenMissing - ) -import Data.IntMap.Strict.Internal -import Prelude hiding (filter, map, foldl, foldr) - --- | Map covariantly over a @'WhenMissing' f k x at . -mapWhenMissing :: Functor f => (a -> b) -> WhenMissing f x a -> WhenMissing f x b -mapWhenMissing f q = WhenMissing - { missingSubtree = fmap (map f) . missingSubtree q - , missingKey = \k x -> fmap (forceMaybe . fmap f) $ missingKey q k x} - --- | Map covariantly over a @'WhenMatched' f k x y at . -mapWhenMatched :: Functor f => (a -> b) -> WhenMatched f x y a -> WhenMatched f x y b -mapWhenMatched f q = WhenMatched - { matchedKey = \k x y -> fmap (forceMaybe . fmap f) $ runWhenMatched q k x y } - --- | When a key is found in both maps, apply a function to the --- key and values and maybe use the result in the merged map. --- --- @ --- zipWithMaybeMatched :: (k -> x -> y -> Maybe z) --- -> SimpleWhenMatched k x y z --- @ -zipWithMaybeMatched :: Applicative f - => (Key -> x -> y -> Maybe z) - -> WhenMatched f x y z -zipWithMaybeMatched f = WhenMatched $ - \k x y -> pure $! forceMaybe $! f k x y -{-# INLINE zipWithMaybeMatched #-} - --- | When a key is found in both maps, apply a function to the --- key and values, perform the resulting action, and maybe use --- the result in the merged map. --- --- This is the fundamental 'WhenMatched' tactic. -zipWithMaybeAMatched :: Applicative f - => (Key -> x -> y -> f (Maybe z)) - -> WhenMatched f x y z -zipWithMaybeAMatched f = WhenMatched $ - \ k x y -> forceMaybe <$> f k x y -{-# INLINE zipWithMaybeAMatched #-} - --- | When a key is found in both maps, apply a function to the --- key and values to produce an action and use its result in the merged map. -zipWithAMatched :: Applicative f - => (Key -> x -> y -> f z) - -> WhenMatched f x y z -zipWithAMatched f = WhenMatched $ - \ k x y -> (Just $!) <$> f k x y -{-# INLINE zipWithAMatched #-} - --- | When a key is found in both maps, apply a function to the --- key and values and use the result in the merged map. --- --- @ --- zipWithMatched :: (k -> x -> y -> z) --- -> SimpleWhenMatched k x y z --- @ -zipWithMatched :: Applicative f - => (Key -> x -> y -> z) -> WhenMatched f x y z -zipWithMatched f = WhenMatched $ - \k x y -> pure $! Just $! f k x y -{-# INLINE zipWithMatched #-} - --- | Map over the entries whose keys are missing from the other map, --- optionally removing some. This is the most powerful 'SimpleWhenMissing' --- tactic, but others are usually more efficient. --- --- @ --- mapMaybeMissing :: (k -> x -> Maybe y) -> SimpleWhenMissing k x y --- @ --- --- prop> mapMaybeMissing f = traverseMaybeMissing (\k x -> pure (f k x)) --- --- but @mapMaybeMissing@ uses fewer unnecessary 'Applicative' operations. -mapMaybeMissing :: Applicative f => (Key -> x -> Maybe y) -> WhenMissing f x y -mapMaybeMissing f = WhenMissing - { missingSubtree = \m -> pure $! mapMaybeWithKey f m - , missingKey = \k x -> pure $! forceMaybe $! f k x } -{-# INLINE mapMaybeMissing #-} - --- | Map over the entries whose keys are missing from the other map. --- --- @ --- mapMissing :: (k -> x -> y) -> SimpleWhenMissing k x y --- @ --- --- prop> mapMissing f = mapMaybeMissing (\k x -> Just $ f k x) --- --- but @mapMissing@ is somewhat faster. -mapMissing :: Applicative f => (Key -> x -> y) -> WhenMissing f x y -mapMissing f = WhenMissing - { missingSubtree = \m -> pure $! mapWithKey f m - , missingKey = \k x -> pure $! Just $! f k x } -{-# INLINE mapMissing #-} - --- | Traverse over the entries whose keys are missing from the other map, --- optionally producing values to put in the result. --- This is the most powerful 'WhenMissing' tactic, but others are usually --- more efficient. -traverseMaybeMissing :: Applicative f - => (Key -> x -> f (Maybe y)) -> WhenMissing f x y -traverseMaybeMissing f = WhenMissing - { missingSubtree = traverseMaybeWithKey f - , missingKey = \k x -> forceMaybe <$> f k x } -{-# INLINE traverseMaybeMissing #-} - --- | Traverse over the entries whose keys are missing from the other map. -traverseMissing :: Applicative f - => (Key -> x -> f y) -> WhenMissing f x y -traverseMissing f = WhenMissing - { missingSubtree = traverseWithKey f - , missingKey = \k x -> (Just $!) <$> f k x } -{-# INLINE traverseMissing #-} - -forceMaybe :: Maybe a -> Maybe a -forceMaybe Nothing = Nothing -forceMaybe m@(Just !_) = m -{-# INLINE forceMaybe #-} ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -156,6 +156,7 @@ import GHC.Types.Unique import GHC.Iface.Errors.Types import qualified Data.IntSet as I +import qualified GHC.Data.Word64Set as W -- ----------------------------------------------------------------------------- -- Loading the program @@ -2821,12 +2822,12 @@ See test "jspace" for an example which used to trigger this problem. -} -- See Note [ModuleNameSet, efficiency and space leaks] -type ModuleNameSet = M.Map UnitId I.IntSet +type ModuleNameSet = M.Map UnitId W.Word64Set addToModuleNameSet :: UnitId -> ModuleName -> ModuleNameSet -> ModuleNameSet addToModuleNameSet uid mn s = let k = (getKey $ getUnique $ mn) - in M.insertWith (I.union) uid (I.singleton k) s + in M.insertWith (W.union) uid (W.singleton k) s -- | Wait for some dependencies to finish and then read from the given MVar. wait_deps_hug :: MVar HomeUnitGraph -> [BuildResult] -> ReaderT MakeEnv (MaybeT IO) (HomeUnitGraph, ModuleNameSet) @@ -2837,7 +2838,7 @@ wait_deps_hug hug_var deps = do let -- Restrict to things which are in the transitive closure to avoid retaining -- reference to loop modules which have already been compiled by other threads. -- See Note [ModuleNameSet, efficiency and space leaks] - !new = udfmRestrictKeysSet (homeUnitEnv_hpt hme) (fromMaybe I.empty $ M.lookup uid module_deps) + !new = udfmRestrictKeysSet (homeUnitEnv_hpt hme) (fromMaybe W.empty $ M.lookup uid module_deps) in hme { homeUnitEnv_hpt = new } return (unitEnv_mapWithKey pruneHomeUnitEnv hug, module_deps) @@ -2852,7 +2853,7 @@ wait_deps (x:xs) = do Nothing -> return (hmis, new_deps) Just hmi -> return (hmi:hmis, new_deps) where - unionModuleNameSet = M.unionWith I.union + unionModuleNameSet = M.unionWith W.union -- Executing the pipelines ===================================== compiler/GHC/HsToCore/Foreign/JavaScript.hs ===================================== @@ -156,7 +156,7 @@ mkFExportJSBits platform c_nm maybe_target arg_htys res_hty is_IO_res_ty _cconv header_bits = maybe mempty idTag maybe_target idTag i = let (tag, u) = unpkUnique (getUnique i) - in CHeader (char tag <> int u) + in CHeader (char tag <> word (fromIntegral u)) fun_args | null arg_info = empty -- text "void" ===================================== compiler/GHC/StgToJS/Deps.hs ===================================== @@ -45,18 +45,19 @@ import Data.Map (Map) import qualified Data.Map as M import qualified Data.Set as S import qualified Data.IntSet as IS -import qualified Data.IntMap as IM -import Data.IntMap (IntMap) +import qualified GHC.Data.Word64Map as WM +import GHC.Data.Word64Map (Word64Map) import Data.Array import Data.Either +import Data.Word import Control.Monad import Control.Monad.Trans.Class import Control.Monad.Trans.State data DependencyDataCache = DDC - { ddcModule :: !(IntMap Unit) -- ^ Unique Module -> Unit - , ddcId :: !(IntMap Object.ExportedFun) -- ^ Unique Id -> Object.ExportedFun (only to other modules) + { ddcModule :: !(Word64Map Unit) -- ^ Unique Module -> Unit + , ddcId :: !(Word64Map Object.ExportedFun) -- ^ Unique Id -> Object.ExportedFun (only to other modules) , ddcOther :: !(Map OtherSymb Object.ExportedFun) } @@ -72,7 +73,7 @@ genDependencyData genDependencyData mod units = do -- [(blockindex, blockdeps, required, exported)] ds <- evalStateT (mapM (uncurry oneDep) blocks) - (DDC IM.empty IM.empty M.empty) + (DDC WM.empty WM.empty M.empty) return $ Object.Deps { depsModule = mod , depsRequired = IS.fromList [ n | (n, _, True, _) <- ds ] @@ -144,7 +145,7 @@ genDependencyData mod units = do in if m == mod then pprPanic "local id not found" (ppr m) else Left <$> do - mr <- gets (IM.lookup k . ddcId) + mr <- gets (WM.lookup k . ddcId) maybe addEntry return mr -- get the function for an OtherSymb from the cache, add it if necessary @@ -167,7 +168,7 @@ genDependencyData mod units = do -- lookup a dependency to another module, add to the id cache if there's -- an id key, otherwise add to other cache - lookupExternalFun :: Maybe Int + lookupExternalFun :: Maybe Word64 -> OtherSymb -> StateT DependencyDataCache G Object.ExportedFun lookupExternalFun mbIdKey od@(OtherSymb m idTxt) = do let mk = getKey . getUnique $ m @@ -175,17 +176,17 @@ genDependencyData mod units = do exp_fun = Object.ExportedFun m (LexicalFastString idTxt) addCache = do ms <- gets ddcModule - let !cache' = IM.insert mk mpk ms + let !cache' = WM.insert mk mpk ms modify (\s -> s { ddcModule = cache'}) pure exp_fun f <- do - mbm <- gets (IM.member mk . ddcModule) + mbm <- gets (WM.member mk . ddcModule) case mbm of False -> addCache True -> pure exp_fun case mbIdKey of Nothing -> modify (\s -> s { ddcOther = M.insert od f (ddcOther s) }) - Just k -> modify (\s -> s { ddcId = IM.insert k f (ddcId s) }) + Just k -> modify (\s -> s { ddcId = WM.insert k f (ddcId s) }) return f ===================================== compiler/GHC/StgToJS/Ids.hs ===================================== @@ -61,16 +61,18 @@ import qualified Control.Monad.Trans.State.Strict as State import qualified Data.Map as M import Data.Maybe import qualified Data.ByteString.Char8 as BSC +import Data.Word -- | Get fresh unique number -freshUnique :: G Int +freshUnique :: G Word64 freshUnique = do id_gen <- State.gets gsId liftIO $ do -- no need for atomicFetchAdd as we don't use threads in G v <- readFastMutInt id_gen writeFastMutInt id_gen (v+1) - pure v + -- TODO: depends on readFastMutWord64 + pure (undefined v) -- | Get fresh local Ident of the form: h$$unit:module_uniq freshIdent :: G Ident @@ -131,7 +133,7 @@ makeIdentForId i num id_type current_module = TxtI ident , if exported then mempty else let (c,u) = unpkUnique (getUnique i) - in mconcat [BSC.pack ['_',c,'_'], intBS u] + in mconcat [BSC.pack ['_',c,'_'], word64BS u] ] -- | Retrieve the cached Ident for the given Id if there is one. Otherwise make @@ -182,7 +184,7 @@ identsForId :: Id -> G [Ident] identsForId i = case typeSize (idType i) of 0 -> pure mempty 1 -> (:[]) <$> identForId i - s -> mapM (identForIdN i) [1..s] + s -> mapM (identForIdN i) [1 .. fromIntegral s] -- | Retrieve entry Ident for the given Id ===================================== compiler/GHC/StgToJS/Symbols.hs ===================================== @@ -8,6 +8,7 @@ module GHC.StgToJS.Symbols , mkFreshJsSymbol , mkRawSymbol , intBS + , word64BS ) where import GHC.Prelude @@ -15,16 +16,23 @@ import GHC.Prelude import GHC.Data.FastString import GHC.Unit.Module import Data.ByteString (ByteString) +import Data.Word (Word64) import qualified Data.ByteString.Char8 as BSC import qualified Data.ByteString.Builder as BSB import qualified Data.ByteString.Lazy as BSL -- | Hexadecimal representation of an int -- +-- Used for the sub indices. +intBS :: Int -> ByteString +intBS = word64BS . fromIntegral + +-- | Hexadecimal representation of a 64-bit word +-- -- Used for uniques. We could use base-62 as GHC usually does but this is likely -- faster. -intBS :: Int -> ByteString -intBS = BSL.toStrict . BSB.toLazyByteString . BSB.wordHex . fromIntegral +word64BS :: Word64 -> ByteString +word64BS = BSL.toStrict . BSB.toLazyByteString . BSB.word64Hex -- | Return z-encoded unit:module unitModuleStringZ :: Module -> ByteString @@ -66,12 +74,12 @@ mkJsSymbol :: Bool -> Module -> FastString -> FastString mkJsSymbol exported mod s = mkFastStringByteString (mkJsSymbolBS exported mod s) -- | Make JS symbol for given module and unique. -mkFreshJsSymbol :: Module -> Int -> FastString +mkFreshJsSymbol :: Module -> Word64 -> FastString mkFreshJsSymbol mod i = mkFastStringByteString $ mconcat [ hdd , unitModuleStringZ mod , BSC.pack "_" - , intBS i + , word64BS i ] -- | Make symbol "h$XYZ" or "h$$XYZ" ===================================== compiler/GHC/StgToJS/Types.hs ===================================== @@ -49,6 +49,7 @@ import Data.Set (Set) import qualified Data.ByteString as BS import Data.Monoid import Data.Typeable (Typeable) +import Data.Word import GHC.Generics (Generic) import Control.DeepSeq @@ -202,7 +203,7 @@ data IdType -- | Keys to differentiate Ident's in the ID Cache data IdKey - = IdKey !Int !Int !IdType + = IdKey !Word64 !Int !IdType deriving (Eq, Ord) -- | Some other symbol ===================================== compiler/GHC/ThToHs.hs ===================================== @@ -63,6 +63,7 @@ import Data.Foldable (for_) import Data.List.NonEmpty( NonEmpty (..), nonEmpty ) import qualified Data.List.NonEmpty as NE import Data.Maybe( catMaybes, isNothing ) +import Data.Word (Word64) import Language.Haskell.TH as TH hiding (sigP) import Language.Haskell.TH.Syntax as TH import Foreign.ForeignPtr @@ -2192,7 +2193,7 @@ mk_mod mod = mkModuleName (TH.modString mod) mk_pkg :: TH.PkgName -> Unit mk_pkg pkg = stringToUnit (TH.pkgString pkg) -mk_uniq :: Int -> Unique +mk_uniq :: Word64 -> Unique mk_uniq u = mkUniqueGrimily u {- ===================================== compiler/GHC/Types/Unique/Supply.hs ===================================== @@ -40,6 +40,7 @@ import GHC.IO import GHC.Utils.Monad import Control.Monad import Data.Char +import Data.Word import GHC.Exts( Ptr(..), noDuplicate#, oneShot ) #if MIN_VERSION_GLASGOW_HASKELL(9,1,0,0) import GHC.Exts( Int(..), word2Int#, fetchAddWordAddr#, plusWord#, readWordOffAddr# ) @@ -184,7 +185,7 @@ optimizations to be used. So it seems safe to depend on this fact. -- also manufacture an arbitrary number of further 'UniqueSupply' values, -- which will be distinct from the first and from all others. data UniqSupply - = MkSplitUniqSupply {-# UNPACK #-} !Int -- make the Unique with this + = MkSplitUniqSupply {-# UNPACK #-} !Word64 -- make the Unique with this UniqSupply UniqSupply -- when split => these two supplies @@ -206,7 +207,7 @@ mkSplitUniqSupply c = unsafeDupableInterleaveIO (IO mk_supply) where - !mask = ord c `unsafeShiftL` uNIQUE_BITS + !mask = fromIntegral (ord c) `unsafeShiftL` uNIQUE_BITS -- Here comes THE MAGIC: see Note [How the unique supply works] -- This is one of the most hammered bits in the whole compiler @@ -218,7 +219,8 @@ mkSplitUniqSupply c -- deferred IO computations case unIO (unsafeDupableInterleaveIO (IO mk_supply)) s2 of { (# s3, x #) -> case unIO (unsafeDupableInterleaveIO (IO mk_supply)) s3 of { (# s4, y #) -> - (# s4, MkSplitUniqSupply (mask .|. u) x y #) + -- FIXME: fill in the undefined + (# s4, MkSplitUniqSupply (mask .|. undefined u) x y #) }}}} #if !MIN_VERSION_GLASGOW_HASKELL(9,1,0,0) ===================================== compiler/GHC/Types/Var/Env.hs ===================================== @@ -79,6 +79,7 @@ module GHC.Types.Var.Env ( import GHC.Prelude import qualified Data.IntMap.Strict as IntMap -- TODO: Move this to UniqFM +import qualified GHC.Data.Word64Map.Strict as Word64Map -- TODO: Move this to UniqFM import GHC.Types.Name.Occurrence import GHC.Types.Name @@ -228,7 +229,7 @@ uniqAway' in_scope var -- introduce non-unique 'Unique's this way. See Note [Local uniques]. unsafeGetFreshLocalUnique :: InScopeSet -> Unique unsafeGetFreshLocalUnique (InScope set) - | Just (uniq,_) <- IntMap.lookupLT (getKey maxLocalUnique) (ufmToIntMap $ getUniqSet set) + | Just (uniq,_) <- Word64Map.lookupLT (getKey maxLocalUnique) (ufmToIntMap $ getUniqSet set) , let uniq' = mkLocalUnique uniq , not $ uniq' `ltUnique` minLocalUnique = incrUnique uniq' ===================================== compiler/GHC/Utils/Containers/Internal/BitQueue.hs deleted ===================================== @@ -1,121 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE BangPatterns #-} - -#include "containers.h" - ------------------------------------------------------------------------------ --- | --- Module : Utils.Containers.Internal.BitQueue --- Copyright : (c) David Feuer 2016 --- License : BSD-style --- Maintainer : libraries at haskell.org --- Portability : portable --- --- = WARNING --- --- This module is considered __internal__. --- --- The Package Versioning Policy __does not apply__. --- --- The contents of this module may change __in any way whatsoever__ --- and __without any warning__ between minor versions of this package. --- --- Authors importing this module are expected to track development --- closely. --- --- = Description --- --- An extremely light-weight, fast, and limited representation of a string of --- up to (2*WORDSIZE - 2) bits. In fact, there are two representations, --- misleadingly named bit queue builder and bit queue. The builder supports --- only `emptyQB`, creating an empty builder, and `snocQB`, enqueueing a bit. --- The bit queue builder is then turned into a bit queue using `buildQ`, after --- which bits can be removed one by one using `unconsQ`. If the size limit is --- exceeded, further operations will silently produce nonsense. ------------------------------------------------------------------------------ - -module Utils.Containers.Internal.BitQueue - ( BitQueue - , BitQueueB - , emptyQB - , snocQB - , buildQ - , unconsQ - , toListQ - ) where - -import Utils.Containers.Internal.BitUtil (shiftLL, shiftRL, wordSize) -import Data.Bits ((.|.), (.&.), testBit) -import Data.Bits (countTrailingZeros) - --- A bit queue builder. We represent a double word using two words --- because we don't currently have access to proper double words. -data BitQueueB = BQB {-# UNPACK #-} !Word - {-# UNPACK #-} !Word - -newtype BitQueue = BQ BitQueueB deriving Show - --- Intended for debugging. -instance Show BitQueueB where - show (BQB hi lo) = "BQ"++ - show (map (testBit hi) [(wordSize - 1),(wordSize - 2)..0] - ++ map (testBit lo) [(wordSize - 1),(wordSize - 2)..0]) - --- | Create an empty bit queue builder. This is represented as a single guard --- bit in the most significant position. -emptyQB :: BitQueueB -emptyQB = BQB (1 `shiftLL` (wordSize - 1)) 0 -{-# INLINE emptyQB #-} - --- Shift the double word to the right by one bit. -shiftQBR1 :: BitQueueB -> BitQueueB -shiftQBR1 (BQB hi lo) = BQB hi' lo' where - lo' = (lo `shiftRL` 1) .|. (hi `shiftLL` (wordSize - 1)) - hi' = hi `shiftRL` 1 -{-# INLINE shiftQBR1 #-} - --- | Enqueue a bit. This works by shifting the queue right one bit, --- then setting the most significant bit as requested. -{-# INLINE snocQB #-} -snocQB :: BitQueueB -> Bool -> BitQueueB -snocQB bq b = case shiftQBR1 bq of - BQB hi lo -> BQB (hi .|. (fromIntegral (fromEnum b) `shiftLL` (wordSize - 1))) lo - --- | Convert a bit queue builder to a bit queue. This shifts in a new --- guard bit on the left, and shifts right until the old guard bit falls --- off. -{-# INLINE buildQ #-} -buildQ :: BitQueueB -> BitQueue -buildQ (BQB hi 0) = BQ (BQB 0 lo') where - zeros = countTrailingZeros hi - lo' = ((hi `shiftRL` 1) .|. (1 `shiftLL` (wordSize - 1))) `shiftRL` zeros -buildQ (BQB hi lo) = BQ (BQB hi' lo') where - zeros = countTrailingZeros lo - lo1 = (lo `shiftRL` 1) .|. (hi `shiftLL` (wordSize - 1)) - hi1 = (hi `shiftRL` 1) .|. (1 `shiftLL` (wordSize - 1)) - lo' = (lo1 `shiftRL` zeros) .|. (hi1 `shiftLL` (wordSize - zeros)) - hi' = hi1 `shiftRL` zeros - --- Test if the queue is empty, which occurs when there's --- nothing left but a guard bit in the least significant --- place. -nullQ :: BitQueue -> Bool -nullQ (BQ (BQB 0 1)) = True -nullQ _ = False -{-# INLINE nullQ #-} - --- | Dequeue an element, or discover the queue is empty. -unconsQ :: BitQueue -> Maybe (Bool, BitQueue) -unconsQ q | nullQ q = Nothing -unconsQ (BQ bq@(BQB _ lo)) = Just (hd, BQ tl) - where - !hd = (lo .&. 1) /= 0 - !tl = shiftQBR1 bq -{-# INLINE unconsQ #-} - --- | Convert a bit queue to a list of bits by unconsing. --- This is used to test that the queue functions properly. -toListQ :: BitQueue -> [Bool] -toListQ bq = case unconsQ bq of - Nothing -> [] - Just (hd, tl) -> hd : toListQ tl ===================================== compiler/GHC/Utils/Containers/Internal/Coercions.hs deleted ===================================== @@ -1,44 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# OPTIONS_HADDOCK hide #-} - -#include "containers.h" - -module Utils.Containers.Internal.Coercions where - -#ifdef __GLASGOW_HASKELL__ -import Data.Coerce -#endif - -infixl 8 .# -#ifdef __GLASGOW_HASKELL__ -(.#) :: Coercible b a => (b -> c) -> (a -> b) -> a -> c -(.#) f _ = coerce f -#else -(.#) :: (b -> c) -> (a -> b) -> a -> c -(.#) = (.) -#endif -{-# INLINE (.#) #-} - -infix 9 .^# - --- | Coerce the second argument of a function. Conceptually, --- can be thought of as: --- --- @ --- (f .^# g) x y = f x (g y) --- @ --- --- However it is most useful when coercing the arguments to --- 'foldl': --- --- @ --- foldl f b . fmap g = foldl (f .^# g) b --- @ -#ifdef __GLASGOW_HASKELL__ -(.^#) :: Coercible c b => (a -> c -> d) -> (b -> c) -> (a -> b -> d) -(.^#) f _ = coerce f -#else -(.^#) :: (a -> c -> d) -> (b -> c) -> (a -> b -> d) -(f .^# g) x y = f x (g y) -#endif -{-# INLINE (.^#) #-} ===================================== compiler/GHC/Utils/Containers/Internal/PtrEquality.hs deleted ===================================== @@ -1,42 +0,0 @@ -{-# LANGUAGE CPP #-} -#ifdef __GLASGOW_HASKELL__ -{-# LANGUAGE MagicHash #-} -#endif - -{-# OPTIONS_HADDOCK hide #-} - --- | Really unsafe pointer equality -module Utils.Containers.Internal.PtrEquality (ptrEq, hetPtrEq) where - -#ifdef __GLASGOW_HASKELL__ -import GHC.Exts ( reallyUnsafePtrEquality# ) -import Unsafe.Coerce ( unsafeCoerce ) -import GHC.Exts ( Int#, isTrue# ) -#endif - --- | Checks if two pointers are equal. Yes means yes; --- no means maybe. The values should be forced to at least --- WHNF before comparison to get moderately reliable results. -ptrEq :: a -> a -> Bool - --- | Checks if two pointers are equal, without requiring --- them to have the same type. The values should be forced --- to at least WHNF before comparison to get moderately --- reliable results. -hetPtrEq :: a -> b -> Bool - -#ifdef __GLASGOW_HASKELL__ -ptrEq x y = isTrue# (reallyUnsafePtrEquality# x y) -hetPtrEq x y = isTrue# (unsafeCoerce (reallyUnsafePtrEquality# :: x -> x -> Int#) x y) - -#else --- Not GHC -ptrEq _ _ = False -hetPtrEq _ _ = False -#endif - -{-# INLINE ptrEq #-} -{-# INLINE hetPtrEq #-} - -infix 4 `ptrEq` -infix 4 `hetPtrEq` ===================================== compiler/GHC/Utils/Containers/Internal/State.hs deleted ===================================== @@ -1,36 +0,0 @@ -{-# LANGUAGE CPP #-} -#include "containers.h" -{-# OPTIONS_HADDOCK hide #-} - --- | A clone of Control.Monad.State.Strict. -module Utils.Containers.Internal.State where - -import Control.Monad (ap, liftM2) -import Control.Applicative (liftA) -import Utils.Containers.Internal.Prelude -import Prelude () - -newtype State s a = State {runState :: s -> (s, a)} - -instance Functor (State s) where - fmap = liftA - -instance Monad (State s) where - {-# INLINE return #-} - {-# INLINE (>>=) #-} - return = pure - m >>= k = State $ \ s -> case runState m s of - (s', x) -> runState (k x) s' - -instance Applicative (State s) where - {-# INLINE pure #-} - pure x = State $ \ s -> (s, x) - (<*>) = ap - m *> n = State $ \s -> case runState m s of - (s', _) -> runState n s' -#if MIN_VERSION_base(4,10,0) - liftA2 = liftM2 -#endif - -execState :: State s a -> s -> a -execState m x = snd (runState m x) ===================================== compiler/GHC/Utils/Containers/Internal/StrictMaybe.hs deleted ===================================== @@ -1,26 +0,0 @@ -{-# LANGUAGE CPP #-} - -#include "containers.h" - -{-# OPTIONS_HADDOCK hide #-} --- | Strict 'Maybe' - -module Utils.Containers.Internal.StrictMaybe (MaybeS (..), maybeS, toMaybe, toMaybeS) where - -data MaybeS a = NothingS | JustS !a - -instance Foldable MaybeS where - foldMap _ NothingS = mempty - foldMap f (JustS a) = f a - -maybeS :: r -> (a -> r) -> MaybeS a -> r -maybeS n _ NothingS = n -maybeS _ j (JustS a) = j a - -toMaybe :: MaybeS a -> Maybe a -toMaybe NothingS = Nothing -toMaybe (JustS a) = Just a - -toMaybeS :: Maybe a -> MaybeS a -toMaybeS Nothing = NothingS -toMaybeS (Just a) = JustS a ===================================== compiler/GHC/Utils/Containers/Internal/TypeError.hs deleted ===================================== @@ -1,44 +0,0 @@ -{-# LANGUAGE DataKinds, FlexibleInstances, FlexibleContexts, UndecidableInstances, - KindSignatures, TypeFamilies, CPP #-} - -#if !defined(TESTING) -{-# LANGUAGE Safe #-} -#endif - --- | Unsatisfiable constraints for functions being removed. - -module Utils.Containers.Internal.TypeError where -import GHC.TypeLits - --- | The constraint @Whoops s@ is unsatisfiable for every 'Symbol' @s at . Trying --- to use a function with a @Whoops s@ constraint will lead to a pretty type --- error explaining how to fix the problem. --- --- ==== Example --- --- @ --- oldFunction :: Whoops "oldFunction is gone now. Use newFunction." --- => Int -> IntMap a -> IntMap a --- @ -class Whoops (a :: Symbol) - -instance TypeError ('Text a) => Whoops a - --- Why don't we just use --- --- type Whoops a = TypeError ('Text a) ? --- --- When GHC sees the type signature of oldFunction, it will see that it --- has an unsatisfiable constraint and reject it out of hand. --- --- It seems possible to hack around that with a type family: --- --- type family Whoops a where --- Whoops a = TypeError ('Text a) --- --- but I don't really trust that to work reliably. What we actually --- do is pretty much guaranteed to work. Despite the fact that there --- is a totally polymorphic instance in scope, GHC will refrain from --- reducing the constraint because it knows someone could (theoretically) --- define an overlapping instance of Whoops. It doesn't commit to --- the polymorphic one until it has to, at the call site. ===================================== compiler/ghc.cabal.in ===================================== @@ -407,6 +407,13 @@ Library GHC.Data.TrieMap GHC.Data.Unboxed GHC.Data.UnionFind + GHC.Data.Word64Set + GHC.Data.Word64Set.Internal + GHC.Data.Word64Map + GHC.Data.Word64Map.Internal + GHC.Data.Word64Map.Lazy + GHC.Data.Word64Map.Strict + GHC.Data.Word64Map.Strict.Internal GHC.Driver.Backend GHC.Driver.Backend.Internal GHC.Driver.Backpack @@ -866,6 +873,9 @@ Library GHC.Utils.BufHandle GHC.Utils.CliOption GHC.Utils.Constants + GHC.Utils.Containers.Internal.Prelude + GHC.Utils.Containers.Internal.BitUtil + GHC.Utils.Containers.Internal.StrictPair GHC.Utils.Error GHC.Utils.Exception GHC.Utils.Fingerprint ===================================== libraries/ghci/GHCi/Message.hs ===================================== @@ -380,7 +380,7 @@ data EvalStatus_ a b | EvalBreak Bool HValueRef{- AP_STACK -} Int {- break index -} - Int {- uniq of ModuleName -} + Word64 {- uniq of ModuleName -} (RemoteRef (ResumeContext b)) (RemotePtr CostCentreStack) -- Cost centre stack deriving (Generic, Show) ===================================== libraries/ghci/GHCi/Run.hs ===================================== @@ -293,7 +293,7 @@ withBreakAction opts breakMVar statusMVar act resume_r <- mkRemoteRef resume apStack_r <- mkRemoteRef apStack ccs <- toRemotePtr <$> getCCSOf apStack - putMVar statusMVar $ EvalBreak is_exception apStack_r (I# ix#) (I# uniq#) resume_r ccs + putMVar statusMVar $ EvalBreak is_exception apStack_r (I# ix#) (undefined uniq#) resume_r ccs takeMVar breakMVar resetBreakAction stablePtr = do View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f83f8b4158ccabd02d4ef16b111c3e2f78738223 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f83f8b4158ccabd02d4ef16b111c3e2f78738223 You're receiving 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 Jun 2 08:50:09 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 02 Jun 2023 04:50:09 -0400 Subject: [Git][ghc/ghc][wip/T22010] Revert non-critical changes in StgToJS Message-ID: <6479ad41574bb_16c027241afd3c3431c4@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: c4634b0f by Jaro Reinders at 2023-06-02T10:50:04+02:00 Revert non-critical changes in StgToJS - - - - - 2 changed files: - compiler/GHC/StgToJS/Ids.hs - compiler/GHC/StgToJS/Symbols.hs Changes: ===================================== compiler/GHC/StgToJS/Ids.hs ===================================== @@ -61,18 +61,16 @@ import qualified Control.Monad.Trans.State.Strict as State import qualified Data.Map as M import Data.Maybe import qualified Data.ByteString.Char8 as BSC -import Data.Word -- | Get fresh unique number -freshUnique :: G Word64 +freshUnique :: G Int freshUnique = do id_gen <- State.gets gsId liftIO $ do -- no need for atomicFetchAdd as we don't use threads in G v <- readFastMutInt id_gen writeFastMutInt id_gen (v+1) - -- TODO: depends on readFastMutWord64 - pure (undefined v) + pure v -- | Get fresh local Ident of the form: h$$unit:module_uniq freshIdent :: G Ident ===================================== compiler/GHC/StgToJS/Symbols.hs ===================================== @@ -74,12 +74,12 @@ mkJsSymbol :: Bool -> Module -> FastString -> FastString mkJsSymbol exported mod s = mkFastStringByteString (mkJsSymbolBS exported mod s) -- | Make JS symbol for given module and unique. -mkFreshJsSymbol :: Module -> Word64 -> FastString +mkFreshJsSymbol :: Module -> Int -> FastString mkFreshJsSymbol mod i = mkFastStringByteString $ mconcat [ hdd , unitModuleStringZ mod , BSC.pack "_" - , word64BS i + , intBS i ] -- | Make symbol "h$XYZ" or "h$$XYZ" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c4634b0f4460096f74e0a84bfbd76b3045359366 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c4634b0f4460096f74e0a84bfbd76b3045359366 You're receiving 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 Jun 2 09:36:09 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 02 Jun 2023 05:36:09 -0400 Subject: [Git][ghc/ghc][wip/T22010] Small changes. Message-ID: <6479b809b795e_16c027191174e834735b@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: eefdf0bd by Jaro Reinders at 2023-06-02T11:35:57+02:00 Small changes. - - - - - 2 changed files: - compiler/GHC/StgToJS/Ids.hs - compiler/GHC/Types/Unique/Supply.hs Changes: ===================================== compiler/GHC/StgToJS/Ids.hs ===================================== @@ -182,7 +182,7 @@ identsForId :: Id -> G [Ident] identsForId i = case typeSize (idType i) of 0 -> pure mempty 1 -> (:[]) <$> identForId i - s -> mapM (identForIdN i) [1 .. fromIntegral s] + s -> mapM (identForIdN i) [1..s] -- | Retrieve entry Ident for the given Id ===================================== compiler/GHC/Types/Unique/Supply.hs ===================================== @@ -219,14 +219,13 @@ mkSplitUniqSupply c -- deferred IO computations case unIO (unsafeDupableInterleaveIO (IO mk_supply)) s2 of { (# s3, x #) -> case unIO (unsafeDupableInterleaveIO (IO mk_supply)) s3 of { (# s4, y #) -> - -- FIXME: fill in the undefined - (# s4, MkSplitUniqSupply (mask .|. undefined u) x y #) + (# s4, MkSplitUniqSupply (mask .|. u) x y #) }}}} #if !MIN_VERSION_GLASGOW_HASKELL(9,1,0,0) -foreign import ccall unsafe "genSym" genSym :: IO Int +foreign import ccall unsafe "genSym" genSym :: IO Word64 -- TODO: Word64 is a lie #else -genSym :: IO Int +genSym :: IO Word64 genSym = do let !mask = (1 `unsafeShiftL` uNIQUE_BITS) - 1 let !(Ptr counter) = ghc_unique_counter @@ -241,7 +240,7 @@ genSym = do -- (Note that if the increment isn't 1 we may miss this check) massert (u /= mask) #endif - return u + return (undefined u) #endif foreign import ccall unsafe "&ghc_unique_counter" ghc_unique_counter :: Ptr Word View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eefdf0bd0c26d811d2a95c427d69330b2ce386b1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eefdf0bd0c26d811d2a95c427d69330b2ce386b1 You're receiving 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 Jun 2 10:23:09 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 02 Jun 2023 06:23:09 -0400 Subject: [Git][ghc/ghc][wip/tc-lcl-env-refactor] 26 commits: Restructure IPE buffer layout Message-ID: <6479c30deae02_16c02717ee048c36546c@gitlab.mail> Matthew Pickering pushed to branch wip/tc-lcl-env-refactor at Glasgow Haskell Compiler / GHC Commits: f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - e23e1df4 by sheaf at 2023-06-01T23:50:19+00:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 8e8b564d by Matthew Pickering at 2023-06-02T11:20:31+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.TcRef - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.TcIdSigInfo - GHC.Tc.Types.TcBinder - GHC.Tc.Types.TcTyThing - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - b29e5e7b by Matthew Pickering at 2023-06-02T11:20:31+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 84393552 by Matthew Pickering at 2023-06-02T11:20:31+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 910e1bc2 by Matthew Pickering at 2023-06-02T11:20:31+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - bdd90dac by Matthew Pickering at 2023-06-02T11:20:31+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - ad217426 by Matthew Pickering at 2023-06-02T11:20:32+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 9baff8ef by Matthew Pickering at 2023-06-02T11:20:32+01:00 Remove unecessary SOURCE import - - - - - 0f1de86f by Matthew Pickering at 2023-06-02T11:20:32+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/Plugins.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Stg/Lint.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Hole/FitTypes.hs - − compiler/GHC/Tc/Errors/Hole/FitTypes.hs-boot - + compiler/GHC/Tc/Errors/Hole/Plugin.hs - + compiler/GHC/Tc/Errors/Hole/Plugin.hs-boot - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9a887aa578a7b85197f1c12a1b0a0426c268df64...0f1de86f4f351bad7e0efe8752bcb46ab57fc8f9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9a887aa578a7b85197f1c12a1b0a0426c268df64...0f1de86f4f351bad7e0efe8752bcb46ab57fc8f9 You're receiving 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 Jun 2 10:31:40 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 02 Jun 2023 06:31:40 -0400 Subject: [Git][ghc/ghc][wip/tc-lcl-env-refactor] 8 commits: Big TcLclEnv and CtLoc refactoring Message-ID: <6479c50c5927f_16c02717f1b12c367796@gitlab.mail> Matthew Pickering pushed to branch wip/tc-lcl-env-refactor at Glasgow Haskell Compiler / GHC Commits: 74fd4c82 by Matthew Pickering at 2023-06-02T11:29:33+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - e7b9a371 by Matthew Pickering at 2023-06-02T11:29:33+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - a7164dcd by Matthew Pickering at 2023-06-02T11:29:33+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 11e34237 by Matthew Pickering at 2023-06-02T11:29:33+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - f7f09fc5 by Matthew Pickering at 2023-06-02T11:29:33+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 407c05bc by Matthew Pickering at 2023-06-02T11:29:33+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 841b6a4c by Matthew Pickering at 2023-06-02T11:29:33+01:00 Remove unecessary SOURCE import - - - - - 3876b30d by Matthew Pickering at 2023-06-02T11:29:33+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 30 changed files: - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/Plugins.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Hole/FitTypes.hs - − compiler/GHC/Tc/Errors/Hole/FitTypes.hs-boot - + compiler/GHC/Tc/Errors/Hole/Plugin.hs - + compiler/GHC/Tc/Errors/Hole/Plugin.hs-boot - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - + compiler/GHC/Tc/Errors/Types/PromotionErr.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Solve.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0f1de86f4f351bad7e0efe8752bcb46ab57fc8f9...3876b30d3f6961119a78043649c118d3a7a456d2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0f1de86f4f351bad7e0efe8752bcb46ab57fc8f9...3876b30d3f6961119a78043649c118d3a7a456d2 You're receiving 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 Jun 2 10:38:00 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 02 Jun 2023 06:38:00 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Output Lint errors to stderr instead of stdout Message-ID: <6479c6884b0fc_16c0271827b52437107d@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - fb762c26 by Krzysztof Gogolewski at 2023-06-02T06:37:19-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 2e5ed7e9 by sheaf at 2023-06-02T06:37:20-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 27 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/JS/Optimizer.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Stg/Lint.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Solver/Rewrite.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/Types.hs - − compiler/GHC/Tc/Utils/Zonk.hs - compiler/GHC/Types/Name/Reader.hs - compiler/GHC/Types/TyThing.hs - testsuite/driver/testlib.py - testsuite/mk/boilerplate.mk - testsuite/tests/linters/notes.stdout - testsuite/tests/quantified-constraints/T23333.hs Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -302,6 +302,10 @@ path does not result in allocation in the hot path. This can be surprisingly impactful. Changing `lint_app` reduced allocations for one test program I was looking at by ~4%. +Note [MCInfo for Lint] +~~~~~~~~~~~~~~~~~~~~~~ +When printing a Lint message, use the MCInfo severity so that the +message is printed on stderr rather than stdout (#13342). ************************************************************************ * * @@ -425,7 +429,7 @@ displayLintResults :: Logger -> IO () displayLintResults logger display_warnings pp_what pp_pgm (warns, errs) | not (isEmptyBag errs) - = do { logMsg logger Err.MCDump noSrcSpan + = do { logMsg logger Err.MCInfo noSrcSpan -- See Note [MCInfo for Lint] $ withPprStyle defaultDumpStyle (vcat [ lint_banner "errors" pp_what, Err.pprMessageBag errs , text "*** Offending Program ***" @@ -436,9 +440,7 @@ displayLintResults logger display_warnings pp_what pp_pgm (warns, errs) | not (isEmptyBag warns) , log_enable_debug (logFlags logger) , display_warnings - -- If the Core linter encounters an error, output to stderr instead of - -- stdout (#13342) - = logMsg logger Err.MCInfo noSrcSpan + = logMsg logger Err.MCInfo noSrcSpan -- See Note [MCInfo for Lint] $ withPprStyle defaultDumpStyle (lint_banner "warnings" pp_what $$ Err.pprMessageBag (mapBag ($$ blankLine) warns)) ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -1430,13 +1430,16 @@ data UMState = UMState newtype UM a = UM' { unUM :: UMState -> UnifyResultM (UMState, a) } -- See Note [The one-shot state monad trick] in GHC.Utils.Monad - deriving (Functor) pattern UM :: (UMState -> UnifyResultM (UMState, a)) -> UM a -- See Note [The one-shot state monad trick] in GHC.Utils.Monad pattern UM m <- UM' m where UM m = UM' (oneShot m) +{-# COMPLETE UM #-} + +instance Functor UM where + fmap f (UM m) = UM (\s -> fmap (\(s', v) -> (s', f v)) (m s)) instance Applicative UM where pure a = UM (\s -> pure (s, a)) ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -105,7 +105,7 @@ codeOutput logger tmpfs llvm_config dflags unit_state this_mod filenm location g (const ()) $ do { case cmmLint (targetPlatform dflags) cmm of Just err -> do { logMsg logger - MCDump + MCInfo -- See Note [MCInfo for Lint] in "GHC.Core.Lint" noSrcSpan $ withPprStyle defaultDumpStyle err ; ghcExit logger 1 ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -114,7 +114,6 @@ import GHC.Types.Var as Var import GHC.Types.Var.Set import GHC.Types.Name import GHC.Types.Name.Env -import GHC.Types.Name.Set import GHC.Types.Id import GHC.Types.Id.Make import GHC.Types.Id.Info @@ -568,7 +567,7 @@ tcHiBootIface hsc_src mod then do { (_, hug) <- getEpsAndHug ; case lookupHugByModule mod hug of Just info | mi_boot (hm_iface info) == IsBoot - -> mkSelfBootInfo (hm_iface info) (hm_details info) + -> return $ SelfBoot { sb_mds = hm_details info } _ -> return NoSelfBoot } else do @@ -584,7 +583,7 @@ tcHiBootIface hsc_src mod ; case read_result of { Succeeded (iface, _path) -> do { tc_iface <- initIfaceTcRn $ typecheckIface iface - ; mkSelfBootInfo iface tc_iface } ; + ; return $ SelfBoot { sb_mds = tc_iface } } ; Failed err -> -- There was no hi-boot file. But if there is circularity in @@ -613,29 +612,6 @@ tcHiBootIface hsc_src mod need = text "Need the hi-boot interface for" <+> ppr mod <+> text "to compare against the Real Thing" -mkSelfBootInfo :: ModIface -> ModDetails -> TcRn SelfBootInfo -mkSelfBootInfo iface mds - = do -- NB: This is computed DIRECTLY from the ModIface rather - -- than from the ModDetails, so that we can query 'sb_tcs' - -- WITHOUT forcing the contents of the interface. - let tcs = map ifName - . filter isIfaceTyCon - . map snd - $ mi_decls iface - return $ SelfBoot { sb_mds = mds - , sb_tcs = mkNameSet tcs } - where - -- Returns @True@ if, when you call 'tcIfaceDecl' on - -- this 'IfaceDecl', an ATyCon would be returned. - -- NB: This code assumes that a TyCon cannot be implicit. - isIfaceTyCon IfaceId{} = False - isIfaceTyCon IfaceData{} = True - isIfaceTyCon IfaceSynonym{} = True - isIfaceTyCon IfaceFamily{} = True - isIfaceTyCon IfaceClass{} = True - isIfaceTyCon IfaceAxiom{} = False - isIfaceTyCon IfacePatSyn{} = False - {- ************************************************************************ * * ===================================== compiler/GHC/JS/Optimizer.hs ===================================== @@ -47,9 +47,8 @@ import GHC.JS.Syntax import Control.Arrow {- -Note [ Unsafe JavaScript Optimizations ] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - +Note [Unsafe JavaScript optimizations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ There are a number of optimizations that the JavaScript Backend performs that are not sound with respect to arbritrary JavaScript. We still perform these optimizations because we are not optimizing arbritrary javascript and under the ===================================== compiler/GHC/Rename/Env.hs ===================================== @@ -331,26 +331,26 @@ lookupExactOcc_either name -- 'RuntimeRep's (#17837) UnboxedTuple -> tyConArity tycon `div` 2 _ -> tyConArity tycon + ; let info = case thing of + ATyCon {} -> IAmTyCon $ TupleFlavour $ tupleSortBoxity tupleSort + _ -> IAmConLike $ mkConInfo tupArity [] ; checkTupSize tupArity - ; let gre = (localTyConGRE (TupleFlavour $ tupleSortBoxity tupleSort) name) - { gre_lcl = False } - ; return (Right gre) } + ; return $ Right $ mkExactGRE name info } | isExternalName name - = Right <$> lookupExternalExactGRE name + = do { info <- lookupExternalExactName name + ; return $ Right $ mkExactGRE name info } | otherwise = lookupLocalExactGRE name -lookupExternalExactGRE :: Name -> RnM GlobalRdrElt -lookupExternalExactGRE name +lookupExternalExactName :: Name -> RnM GREInfo +lookupExternalExactName name = do { thing <- case wiredInNameTyThing_maybe name of Just thing -> return thing _ -> tcLookupGlobal name - ; return $ - (localVanillaGRE NoParent name) - { gre_lcl = False, gre_info = tyThingGREInfo thing } } + ; return $ tyThingGREInfo thing } lookupLocalExactGRE :: Name -> RnM (Either NotInScopeError GlobalRdrElt) lookupLocalExactGRE name @@ -370,7 +370,7 @@ lookupLocalExactGRE name [] -> -- See Note [Splicing Exact names] do { lcl_env <- getLocalRdrEnv - ; let gre = localVanillaGRE NoParent name -- LocalRdrEnv only contains Vanilla things + ; let gre = mkLocalVanillaGRE NoParent name -- LocalRdrEnv only contains Vanilla things ; if name `inLocalRdrEnvScope` lcl_env then return (Right gre) else @@ -451,7 +451,7 @@ lookupExactOrOrig :: RdrName -> (GlobalRdrElt -> r) -> RnM r -> RnM r lookupExactOrOrig rdr_name res k = do { men <- lookupExactOrOrig_base rdr_name ; case men of - FoundExactOrOrig n -> return $ res n + FoundExactOrOrig gre -> return $ res gre ExactOrOrigError e -> do { addErr (mkTcRnNotInScope rdr_name e) ; return $ res (mkUnboundGRERdr rdr_name) } @@ -464,9 +464,9 @@ lookupExactOrOrig_maybe :: RdrName -> (Maybe GlobalRdrElt -> r) -> RnM r -> RnM lookupExactOrOrig_maybe rdr_name res k = do { men <- lookupExactOrOrig_base rdr_name ; case men of - FoundExactOrOrig n -> return (res (Just n)) - ExactOrOrigError _ -> return (res Nothing) - NotExactOrOrig -> k } + FoundExactOrOrig gre -> return (res (Just gre)) + ExactOrOrigError _ -> return (res Nothing) + NotExactOrOrig -> k } data ExactOrOrigResult = FoundExactOrOrig GlobalRdrElt @@ -490,15 +490,15 @@ lookupExactOrOrig_base rdr_name ; mb_gre <- if nameIsLocalOrFrom this_mod nm then lookupLocalExactGRE nm - else Right <$> lookupExternalExactGRE nm + else do { info <- lookupExternalExactName nm + ; return $ Right $ mkExactGRE nm info } ; return $ case mb_gre of Left err -> ExactOrOrigError err Right gre -> FoundExactOrOrig gre } | otherwise = return NotExactOrOrig where - cvtEither (Left e) = ExactOrOrigError e - cvtEither (Right n) = FoundExactOrOrig n - + cvtEither (Left e) = ExactOrOrigError e + cvtEither (Right gre) = FoundExactOrOrig gre {- Note [Errors in lookup functions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -561,7 +561,7 @@ lookupRecFieldOcc mb_con rdr_name ; Just nm -> return nm } } | otherwise -- Can't use the data constructor to disambiguate - = greName <$> lookupGlobalOccRn' (IncludeFields WantField) rdr_name + = lookupGlobalOccRn' (IncludeFields WantField) rdr_name -- This use of Global is right as we are looking up a selector, -- which can only be defined at the top level. @@ -851,18 +851,16 @@ lookupSubBndrOcc :: DeprecationWarnings -> RnM (Either NotInScopeError Name) -- Find all the things the rdr-name maps to -- and pick the one with the right parent name -lookupSubBndrOcc warn_if_deprec the_parent doc rdr_name = do - res <- - lookupExactOrOrig rdr_name FoundChild $ - -- This happens for built-in classes, see mod052 for example - lookupSubBndrOcc_helper True warn_if_deprec the_parent rdr_name - case res of - NameNotFound -> return (Left (UnknownSubordinate doc)) - FoundChild child -> return (Right $ greName child) - IncorrectParent {} - -- See [Mismatched class methods and associated type families] - -- in TcInstDecls. - -> return $ Left (UnknownSubordinate doc) +lookupSubBndrOcc warn_if_deprec the_parent doc rdr_name = + lookupExactOrOrig rdr_name (Right . greName) $ + -- This happens for built-in classes, see mod052 for example + do { child <- lookupSubBndrOcc_helper True warn_if_deprec the_parent rdr_name + ; return $ case child of + FoundChild g -> Right (greName g) + NameNotFound -> Left (UnknownSubordinate doc) + IncorrectParent {} -> Left (UnknownSubordinate doc) } + -- See [Mismatched class methods and associated type families] + -- in TcInstDecls. {- Note [Family instance binders] @@ -1107,10 +1105,10 @@ lookup_demoted rdr_name ; let is_star_type = if star_is_type then StarIsType else StarIsNotType star_is_type_hints = noStarIsTypeHints is_star_type rdr_name ; if data_kinds - then do { mb_demoted_name <- lookupOccRn_maybe demoted_rdr - ; case mb_demoted_name of + then do { mb_demoted_gre <- lookupOccRn_maybe demoted_rdr + ; case mb_demoted_gre of Nothing -> unboundNameX looking_for rdr_name star_is_type_hints - Just demoted_name -> return $ greName demoted_name } + Just demoted_gre -> return $ greName demoted_gre} else do { -- We need to check if a data constructor of this name is -- in scope to give good error messages. However, we do -- not want to give an additional error if the data @@ -1242,18 +1240,26 @@ lookupOccRnX_maybe globalLookup wrapper rdr_name ; case res of { Nothing -> return Nothing ; Just nm -> - do { let gre = localVanillaGRE NoParent nm + -- Elements in the LocalRdrEnv are always Vanilla GREs + do { let gre = mkLocalVanillaGRE NoParent nm ; Just <$> wrapper gre } } } , globalLookup rdr_name ] lookupOccRn_maybe :: RdrName -> RnM (Maybe GlobalRdrElt) lookupOccRn_maybe = - lookupOccRnX_maybe (lookupGlobalOccRn_maybe $ IncludeFields WantNormal) return + lookupOccRnX_maybe + (lookupGlobalOccRn_maybe $ IncludeFields WantNormal) + return -- Used outside this module only by TH name reification (lookupName, lookupThName_maybe) -lookupSameOccRn_maybe :: RdrName -> RnM (Maybe GlobalRdrElt) +lookupSameOccRn_maybe :: RdrName -> RnM (Maybe Name) lookupSameOccRn_maybe = - lookupOccRnX_maybe (lookupGlobalOccRn_maybe SameOccName) return + lookupOccRnX_maybe + (get_name <$> lookupGlobalOccRn_maybe SameOccName) + (return . greName) + where + get_name :: RnM (Maybe GlobalRdrElt) -> RnM (Maybe Name) + get_name = fmap (fmap greName) -- | Look up a 'RdrName' used as a variable in an expression. -- @@ -1292,7 +1298,7 @@ lookupGlobalOccRn_maybe which_gres rdr_name = lookupExactOrOrig_maybe rdr_name id $ lookupGlobalOccRn_base which_gres rdr_name -lookupGlobalOccRn :: RdrName -> RnM GlobalRdrElt +lookupGlobalOccRn :: RdrName -> RnM Name -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global -- environment. Adds an error message if the RdrName is not in scope. -- You usually want to use "lookupOccRn" which also looks in the local @@ -1301,15 +1307,14 @@ lookupGlobalOccRn :: RdrName -> RnM GlobalRdrElt -- Used by exports_from_avail lookupGlobalOccRn = lookupGlobalOccRn' (IncludeFields WantNormal) -lookupGlobalOccRn' :: WhichGREs GREInfo -> RdrName -> RnM GlobalRdrElt +lookupGlobalOccRn' :: WhichGREs GREInfo -> RdrName -> RnM Name lookupGlobalOccRn' which_gres rdr_name = - lookupExactOrOrig rdr_name id $ do - mn <- lookupGlobalOccRn_base which_gres rdr_name - case mn of - Just n -> return n + lookupExactOrOrig rdr_name greName $ do + mb_gre <- lookupGlobalOccRn_base which_gres rdr_name + case mb_gre of + Just gre -> return (greName gre) Nothing -> do { traceRn "lookupGlobalOccRn" (ppr rdr_name) - ; nm <- unboundName (LF which_suggest WL_Global) rdr_name - ; return $ localVanillaGRE NoParent nm } + ; unboundName (LF which_suggest WL_Global) rdr_name } where which_suggest = case which_gres of IncludeFields WantBoth -> WL_RecField IncludeFields WantField -> WL_RecField @@ -1333,7 +1338,7 @@ lookupGlobalOccRn_base which_gres rdr_name = -- | Lookup a 'Name' in the 'GlobalRdrEnv', falling back to looking up -- in the type environment it if fails. -lookupGREInfo_GRE :: Name -> RnM GREInfo +lookupGREInfo_GRE :: Name -> RnM GREInfo lookupGREInfo_GRE name = do { rdr_env <- getGlobalRdrEnv ; case lookupGRE_Name rdr_env name of @@ -1740,7 +1745,7 @@ addUsedGRE warn_if_deprec gre = do { case warn_if_deprec of EnableDeprecationWarnings -> warnIfDeprecated gre DisableDeprecationWarnings -> return () - ; unless (isLocalGRE gre) $ + ; when (isImportedGRE gre) $ -- See Note [Using isImportedGRE in addUsedGRE] do { env <- getGblEnv -- Do not report the GREInfo (#23424) ; traceRn "addUsedGRE" (ppr $ greName gre) @@ -1758,7 +1763,22 @@ addUsedGREs gres (ppr $ map greName imp_gres) ; updTcRef (tcg_used_gres env) (imp_gres ++) } where - imp_gres = filterOut isLocalGRE gres + imp_gres = filter isImportedGRE gres + -- See Note [Using isImportedGRE in addUsedGRE] + +{- Note [Using isImportedGRE in addUsedGRE] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In addUsedGRE, we want to add any used imported GREs to the tcg_used_gres field, +so that we can emit appropriate warnings (see GHC.Rename.Names.warnUnusedImportDecls). + +We want to do this for GREs that were brought into scope through imports. As per +Note [GlobalRdrElt provenance] in GHC.Types.Name.Reader, this means we should +check that gre_imp is non-empty. Checking that gre_lcl is False is INCORRECT, +because we might have obtained the GRE by an Exact or Orig direct reference, +in which case we have both gre_lcl = False and gre_imp = emptyBag. + +Geting this wrong can lead to panics in e.g. bestImport, see #23240. +-} warnIfDeprecated :: GlobalRdrElt -> RnM () warnIfDeprecated gre@(GRE { gre_imp = iss }) ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -260,18 +260,20 @@ rnExpr (HsVar _ (L l v)) ; case mb_gre of { Nothing -> rnUnboundVar v ; Just gre -> - do { if | Just fl <- recFieldLabel <$> recFieldInfo_maybe gre + do { let nm = greName gre + info = gre_info gre + ; if | IAmRecField fld_info <- info -- Since GHC 9.4, such occurrences of record fields must be -- unambiguous. For ambiguous occurrences, we arbitrarily pick one -- matching GRE and add a name clash error -- (see lookupGlobalOccRn_overloaded, called by lookupExprOccRn). - -> do { let sel_name = flSelector fl + -> do { let sel_name = flSelector $ recFieldLabel fld_info ; this_mod <- getModule ; when (nameIsLocalOrFrom this_mod sel_name) $ checkThLocalName sel_name ; return (HsRecSel noExtField (FieldOcc sel_name (L l v) ), unitFV sel_name) } - | greName gre == nilDataConName + | nm == nilDataConName -- Treat [] as an ExplicitList, so that -- OverloadedLists works correctly -- Note [Empty lists] in GHC.Hs.Expr @@ -279,7 +281,7 @@ rnExpr (HsVar _ (L l v)) -> rnExpr (ExplicitList noAnn []) | otherwise - -> finishHsVar (L (na2la l) $ greName gre) + -> finishHsVar (L (na2la l) nm) }}} rnExpr (HsIPVar x v) ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -152,7 +152,7 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls, -- Excludes pattern-synonym binders -- They are already in scope traceRn "rnSrcDecls" (ppr id_bndrs) ; - tc_envs <- extendGlobalRdrEnvRn (map (localVanillaGRE NoParent) id_bndrs) local_fix_env ; + tc_envs <- extendGlobalRdrEnvRn (map (mkLocalVanillaGRE NoParent) id_bndrs) local_fix_env ; restoreEnvs tc_envs $ do { -- Now everything is in scope, as the remaining renaming assumes. @@ -2520,8 +2520,8 @@ extendPatSynEnv dup_fields_ok has_sel val_decls local_fix_env thing = do { ; let pat_syn_bndrs = concat [ conLikeName_Name name : map flSelector flds | (name, con_info) <- names_with_fls , let flds = conInfoFields con_info ] - ; let gres = map (localConLikeGRE NoParent) names_with_fls - ++ localFieldGREs NoParent names_with_fls + ; let gres = map (mkLocalConLikeGRE NoParent) names_with_fls + ++ mkLocalFieldGREs NoParent names_with_fls -- Recall Note [Parents] in GHC.Types.Name.Reader: -- -- pattern synonym constructors and their record fields have no parent ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -858,7 +858,7 @@ getLocalNonValBinders fixity_env -- declaration, not just the name new_simple :: LocatedN RdrName -> RnM GlobalRdrElt new_simple rdr_name = do { nm <- newTopSrcBinder rdr_name - ; return (localVanillaGRE NoParent nm) } + ; return (mkLocalVanillaGRE NoParent nm) } new_tc :: DuplicateRecordFields -> FieldSelectors -> LTyClDecl GhcPs -> RnM [GlobalRdrElt] @@ -871,13 +871,13 @@ getLocalNonValBinders fixity_env ; con_names_with_flds <- mapM (\(con,flds) -> (,flds) <$> newTopSrcBinder (l2n con)) cons_with_flds ; flds' <- mapM (newRecordFieldLabel dup_fields_ok has_sel $ map fst con_names_with_flds) flds ; mapM_ (add_dup_fld_errs flds') con_names_with_flds - ; let tc_gre = localTyConGRE (fmap (const tycon_name) tc_flav) tycon_name + ; let tc_gre = mkLocalTyConGRE (fmap (const tycon_name) tc_flav) tycon_name fld_env = mk_fld_env con_names_with_flds flds' - at_gres = zipWith (\ (_, at_flav) at_nm -> localTyConGRE (fmap (const tycon_name) at_flav) at_nm) + at_gres = zipWith (\ (_, at_flav) at_nm -> mkLocalTyConGRE (fmap (const tycon_name) at_flav) at_nm) at_bndrs at_names - sig_gres = map (localVanillaGRE (ParentIs tycon_name)) sig_names - con_gres = map (localConLikeGRE (ParentIs tycon_name)) fld_env - fld_gres = localFieldGREs (ParentIs tycon_name) fld_env + sig_gres = map (mkLocalVanillaGRE (ParentIs tycon_name)) sig_names + con_gres = map (mkLocalConLikeGRE (ParentIs tycon_name)) fld_env + fld_gres = mkLocalFieldGREs (ParentIs tycon_name) fld_env sub_gres = at_gres ++ sig_gres ++ con_gres ++ fld_gres ; traceRn "getLocalNonValBinders new_tc" $ vcat [ text "tycon:" <+> ppr tycon_name @@ -947,8 +947,8 @@ getLocalNonValBinders fixity_env ; flds' <- mapM (newRecordFieldLabel dup_fields_ok has_sel $ map fst sub_names) flds ; mapM_ (add_dup_fld_errs flds') sub_names ; let fld_env = mk_fld_env sub_names flds' - con_gres = map (localConLikeGRE (ParentIs main_name)) fld_env - field_gres = localFieldGREs (ParentIs main_name) fld_env + con_gres = map (mkLocalConLikeGRE (ParentIs main_name)) fld_env + field_gres = mkLocalFieldGREs (ParentIs main_name) fld_env -- NB: the data family name is not bound here, -- so we don't return a GlobalRdrElt for it here! ; return $ con_gres ++ field_gres } ===================================== compiler/GHC/Rename/Unbound.hs ===================================== @@ -105,10 +105,10 @@ mkUnboundNameRdr :: RdrName -> Name mkUnboundNameRdr rdr = mkUnboundName (rdrNameOcc rdr) mkUnboundGRE :: OccName -> GlobalRdrElt -mkUnboundGRE occ = localVanillaGRE NoParent $ mkUnboundName occ +mkUnboundGRE occ = mkLocalVanillaGRE NoParent $ mkUnboundName occ mkUnboundGRERdr :: RdrName -> GlobalRdrElt -mkUnboundGRERdr rdr = localVanillaGRE NoParent $ mkUnboundNameRdr rdr +mkUnboundGRERdr rdr = mkLocalVanillaGRE NoParent $ mkUnboundNameRdr rdr reportUnboundName' :: WhatLooking -> RdrName -> RnM Name reportUnboundName' what_look rdr = unboundName (LF what_look WL_Anywhere) rdr ===================================== compiler/GHC/Stg/Lint.hs ===================================== @@ -149,7 +149,7 @@ lintStgTopBindings platform logger diag_opts opts extra_vars this_mod unarised w Nothing -> return () Just msg -> do - logMsg logger Err.MCDump noSrcSpan + logMsg logger Err.MCInfo noSrcSpan -- See Note [MCInfo for Lint] in "GHC.Core.Lint" $ withPprStyle defaultDumpStyle (vcat [ text "*** Stg Lint ErrMsgs: in" <+> text whodunit <+> text "***", ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -611,7 +611,7 @@ instance Diagnostic TcRnMessage where | isRecordSelector i = "record selector" pp_category i = tyThingCategory i what_is = pp_category ty_thing - thing = ppr $ greOccName child + thing = ppr $ nameOccName child parents = map ppr parent_names TcRnConflictingExports occ child_gre1 ie1 child_gre2 ie2 -> mkSimpleDecorated $ ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -1559,7 +1559,7 @@ data TcRnMessage where -} TcRnExportedParentChildMismatch :: Name -- ^ parent -> TyThing - -> GlobalRdrElt -- ^ child + -> Name -- ^ child -> [Name] -> TcRnMessage {-| TcRnConflictingExports is an error that occurs when different identifiers that ===================================== compiler/GHC/Tc/Gen/Export.hs ===================================== @@ -520,14 +520,13 @@ lookupChildrenExport spec_parent rdr_items = mapAndReportM doOne rdr_items NameNotFound -> do { ub <- reportUnboundName unboundName ; let l = getLoc n - gre = localVanillaGRE NoParent ub + gre = mkLocalVanillaGRE NoParent ub ; return (L l (IEName noExtField (L (la2na l) ub)), gre)} - FoundChild child@(GRE { gre_par = par }) -> - do { checkPatSynParent spec_parent par child - ; let child_nm = greName child + FoundChild child@(GRE { gre_name = child_nm, gre_par = par }) -> + do { checkPatSynParent spec_parent par child_nm ; return (replaceLWrappedName n child_nm, child) } - IncorrectParent p c gs -> failWithDcErr p c gs + IncorrectParent p c gs -> failWithDcErr p (greName c) gs -- Note [Typing Pattern Synonym Exports] @@ -590,7 +589,7 @@ lookupChildrenExport spec_parent rdr_items = mapAndReportM doOne rdr_items checkPatSynParent :: Name -- ^ Alleged parent type constructor -- User wrote T( P, Q ) -> Parent -- The parent of P we discovered - -> GlobalRdrElt + -> Name -- ^ Either a -- a) Pattern Synonym Constructor -- b) A pattern synonym selector @@ -598,13 +597,12 @@ checkPatSynParent :: Name -- ^ Alleged parent type constructor checkPatSynParent _ (ParentIs {}) _ = return () -checkPatSynParent parent NoParent gre +checkPatSynParent parent NoParent nm | isUnboundName parent -- Avoid an error cascade = return () | otherwise = do { parent_ty_con <- tcLookupTyCon parent - ; let nm = greName gre ; mpat_syn_thing <- tcLookupGlobal nm -- 1. Check that the Id was actually from a thing associated with patsyns @@ -615,7 +613,7 @@ checkPatSynParent parent NoParent gre AConLike (PatSynCon p) -> handle_pat_syn (psErr p) parent_ty_con p - _ -> failWithDcErr parent gre [] } + _ -> failWithDcErr parent nm [] } where psErr = exportErrCtxt "pattern synonym" selErr = exportErrCtxt "pattern synonym record selector" @@ -736,9 +734,9 @@ addExportErrCtxt ie = addErrCtxt exportCtxt exportCtxt = text "In the export:" <+> ppr ie -failWithDcErr :: Name -> GlobalRdrElt -> [Name] -> TcM a +failWithDcErr :: Name -> Name -> [Name] -> TcM a failWithDcErr parent child parents = do - ty_thing <- tcLookupGlobal (greName child) + ty_thing <- tcLookupGlobal child failWithTc $ TcRnExportedParentChildMismatch parent ty_thing child parents ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1413,20 +1413,18 @@ disambiguateRecordBinds record_expr record_rho possible_parents rbnds res_ty lookupField :: FieldGlobalRdrElt -> LHsRecUpdField GhcRn GhcRn -> TcM (LHsRecUpdField GhcTc GhcRn) - lookupField fl (L l upd) + lookupField fld_gre (L l upd) = do { let L loc af = hfbLHS upd - rdr = ambiguousFieldOccRdrName af - mb_gre = pickGREs rdr [fl] - -- NB: this GRE can be 'Nothing' when in GHCi. - -- See test T10439. + lbl = ambiguousFieldOccRdrName af + mb_gre = pickGREs lbl [fld_gre] + -- NB: this GRE can be 'Nothing' when in GHCi. + -- See test T10439. -- Mark the record fields as used, now that we have disambiguated. -- There is no risk of duplicate deprecation warnings, as we have -- not marked the GREs as used previously. ; setSrcSpanA loc $ mapM_ (addUsedGRE EnableDeprecationWarnings) mb_gre - ; sel <- tcLookupId $ flSelector $ fieldGRELabel fl - ; let L loc af = hfbLHS upd - lbl = ambiguousFieldOccRdrName af + ; sel <- tcLookupId (greName fld_gre) ; return $ L l HsFieldBind { hfbAnn = hfbAnn upd , hfbLHS = L (l2l loc) $ Unambiguous sel (L (l2l loc) lbl) ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -1938,8 +1938,8 @@ lookupName :: Bool -- True <=> type namespace -- False <=> value namespace -> String -> TcM (Maybe TH.Name) lookupName is_type_name s - = do { mb_gre <- lookupSameOccRn_maybe rdr_name - ; return (fmap (reifyName . greName) mb_gre) } + = do { mb_nm <- lookupSameOccRn_maybe rdr_name + ; return (fmap reifyName mb_nm) } where th_name = TH.mkName s -- Parses M.x into a base of 'x' and a module of 'M' @@ -1999,15 +1999,12 @@ lookupThName_maybe :: TH.Name -> TcM (Maybe Name) lookupThName_maybe th_name = do { let guesses = thRdrNameGuesses th_name ; case guesses of - { [for_sure] -> get_name $ lookupSameOccRn_maybe for_sure + { [for_sure] -> lookupSameOccRn_maybe for_sure ; _ -> - do { names <- mapMaybeM (get_name . lookupOccRn_maybe) guesses + do { gres <- mapMaybeM lookupOccRn_maybe guesses -- Pick the first that works -- E.g. reify (mkName "A") will pick the class A in preference to the data constructor A - ; return (listToMaybe names) } } } - where - get_name :: TcM (Maybe GlobalRdrElt) -> TcM (Maybe Name) - get_name = fmap (fmap greName) + ; return (fmap greName $ listToMaybe gres) } } } tcLookupTh :: Name -> TcM TcTyThing -- This is a specialised version of GHC.Tc.Utils.Env.tcLookup; specialised mainly in that ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -699,9 +699,6 @@ tcRnHsBootDecls boot_or_sig decls , hs_valds = XValBindsLR (NValBinds val_binds val_sigs) }) <- rnTopSrcDecls first_group - -- The empty list is for extra dependencies coming from .hs-boot files - -- See Note [Extra dependencies from .hs-boot files] in GHC.Rename.Module - ; (gbl_env, lie) <- setGblEnv tcg_env $ captureTopConstraints $ do { -- NB: setGblEnv **before** captureTopConstraints so that -- if the latter reports errors, it knows what's in scope ===================================== compiler/GHC/Tc/Solver/Rewrite.hs ===================================== @@ -56,7 +56,6 @@ import qualified GHC.Data.List.Infinite as Inf -- | The 'RewriteM' monad is a wrapper around 'TcS' with a 'RewriteEnv' newtype RewriteM a = RewriteM { runRewriteM :: RewriteEnv -> TcS a } - deriving (Functor) -- | Smart constructor for 'RewriteM', as describe in Note [The one-shot state -- monad trick] in "GHC.Utils.Monad". @@ -73,6 +72,9 @@ instance Applicative RewriteM where pure x = mkRewriteM $ \_ -> pure x (<*>) = ap +instance Functor RewriteM where + fmap f (RewriteM x) = mkRewriteM $ \env -> fmap f (x env) + instance HasDynFlags RewriteM where getDynFlags = liftTcS getDynFlags ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -5021,7 +5021,7 @@ checkValidRoleAnnots role_annots tc = whenIsJust role_annot_decl_maybe illegalRoleAnnotDecl -- Note [Missing role annotations warning] --- +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- We warn about missing role annotations for tycons -- 1. not type-classes: -- type classes are nominal by default, which is most conservative ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -512,6 +512,8 @@ data TcGblEnv -- See Note [Tracking unused binding and imports] tcg_dus :: DefUses, tcg_used_gres :: TcRef [GlobalRdrElt], + -- ^ INVARIANT: all these GREs were imported; that is, + -- they all have a non-empty gre_imp field. tcg_keep :: TcRef NameSet, tcg_th_used :: TcRef Bool, @@ -693,10 +695,7 @@ instance ContainsModule TcGblEnv where data SelfBootInfo = NoSelfBoot -- No corresponding hi-boot file | SelfBoot - { sb_mds :: ModDetails -- There was a hi-boot file, - , sb_tcs :: NameSet } -- defining these TyCons, --- What is sb_tcs used for? See Note [Extra dependencies from .hs-boot files] --- in GHC.Rename.Module + { sb_mds :: ModDetails } -- There was a hi-boot file bootExports :: SelfBootInfo -> NameSet bootExports boot = ===================================== compiler/GHC/Tc/Utils/Zonk.hs deleted ===================================== @@ -1,1938 +0,0 @@ - -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE TypeFamilies #-} - -{-# OPTIONS_GHC -Wno-incomplete-record-updates #-} - -{- -(c) The University of Glasgow 2006 -(c) The AQUA Project, Glasgow University, 1996-1998 - --} - --- | Specialisations of the @HsSyn@ syntax for the typechecker --- --- This module is an extension of @HsSyn@ syntax, for use in the type checker. -module GHC.Tc.Utils.Zonk ( - -- * Other HsSyn functions - mkHsDictLet, mkHsApp, - mkHsAppTy, mkHsCaseAlt, - tcShortCutLit, shortCutLit, hsOverLitName, - conLikeResTy, - - -- * re-exported from TcMonad - TcId, TcIdSet, - - -- * Zonking - -- | For a description of "zonking", see Note [What is zonking?] - -- in "GHC.Tc.Utils.TcMType" - zonkTopDecls, zonkTopExpr, zonkTopLExpr, - zonkTopBndrs, - ZonkEnv, ZonkFlexi(..), emptyZonkEnv, mkEmptyZonkEnv, initZonkEnv, - zonkTyVarBindersX, zonkTyVarBinderX, - zonkTyBndrs, zonkTyBndrsX, - zonkTcTypeToType, zonkTcTypeToTypeX, - zonkTcTypesToTypesX, zonkScaledTcTypesToTypesX, - zonkTyVarOcc, - zonkCoToCo, - zonkEvBinds, zonkTcEvBinds, - zonkTcMethInfoToMethInfoX, - lookupTyVarX - ) where - -import GHC.Prelude - -import GHC.Platform - -import GHC.Builtin.Types -import GHC.Builtin.Names - -import GHC.Hs - -import {-# SOURCE #-} GHC.Tc.Gen.Splice (runTopSplice) -import GHC.Tc.Utils.Monad -import GHC.Tc.TyCl.Build ( TcMethInfo, MethInfo ) -import GHC.Tc.Utils.TcType -import GHC.Tc.Utils.TcMType -import GHC.Tc.Utils.Env ( tcLookupGlobalOnly ) -import GHC.Tc.Types.Evidence -import GHC.Tc.Errors.Types - -import GHC.Core.TyCo.Ppr ( pprTyVar ) -import GHC.Core.TyCon -import GHC.Core.Type -import GHC.Core.Coercion -import GHC.Core.ConLike -import GHC.Core.DataCon - -import GHC.Utils.Outputable -import GHC.Utils.Misc -import GHC.Utils.Panic -import GHC.Utils.Panic.Plain - -import GHC.Core.Multiplicity -import GHC.Core -import GHC.Core.Predicate - -import GHC.Types.Name -import GHC.Types.Name.Env -import GHC.Types.Var -import GHC.Types.Var.Env -import GHC.Types.Id -import GHC.Types.TypeEnv -import GHC.Types.SourceText -import GHC.Types.Basic -import GHC.Types.SrcLoc -import GHC.Types.Unique.FM -import GHC.Types.TyThing -import GHC.Driver.DynFlags( getDynFlags, targetPlatform ) - -import GHC.Data.Maybe -import GHC.Data.Bag - -import Control.Monad -import Data.List ( partition ) -import Control.Arrow ( second ) - -{- ********************************************************************* -* * - Short-cuts for overloaded numeric literals -* * -********************************************************************* -} - --- Overloaded literals. Here mainly because it uses isIntTy etc - -{- Note [Short cut for overloaded literals] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -A literal like "3" means (fromInteger @ty (dNum :: Num ty) (3::Integer)). -But if we have a list like - [4,2,3,2,4,4,2]::[Int] -we use a lot of compile time and space generating and solving all those Num -constraints, and generating calls to fromInteger etc. Better just to cut to -the chase, and cough up an Int literal. Large collections of literals like this -sometimes appear in source files, so it's quite a worthwhile fix. - -So we try to take advantage of whatever nearby type information we have, -to short-cut the process for built-in types. We can do this in two places; - -* In the typechecker, when we are about to typecheck the literal. -* If that fails, in the desugarer, once we know the final type. --} - -tcShortCutLit :: HsOverLit GhcRn -> ExpRhoType -> TcM (Maybe (HsOverLit GhcTc)) -tcShortCutLit lit@(OverLit { ol_val = val, ol_ext = OverLitRn rebindable _}) exp_res_ty - | not rebindable - , Just res_ty <- checkingExpType_maybe exp_res_ty - = do { dflags <- getDynFlags - ; let platform = targetPlatform dflags - ; case shortCutLit platform val res_ty of - Just expr -> return $ Just $ - lit { ol_ext = OverLitTc False expr res_ty } - Nothing -> return Nothing } - | otherwise - = return Nothing - -shortCutLit :: Platform -> OverLitVal -> TcType -> Maybe (HsExpr GhcTc) -shortCutLit platform val res_ty - = case val of - HsIntegral int_lit -> go_integral int_lit - HsFractional frac_lit -> go_fractional frac_lit - HsIsString s src -> go_string s src - where - go_integral int@(IL src neg i) - | isIntTy res_ty && platformInIntRange platform i - = Just (HsLit noAnn (HsInt noExtField int)) - | isWordTy res_ty && platformInWordRange platform i - = Just (mkLit wordDataCon (HsWordPrim src i)) - | isIntegerTy res_ty - = Just (HsLit noAnn (HsInteger src i res_ty)) - | otherwise - = go_fractional (integralFractionalLit neg i) - -- The 'otherwise' case is important - -- Consider (3 :: Float). Syntactically it looks like an IntLit, - -- so we'll call shortCutIntLit, but of course it's a float - -- This can make a big difference for programs with a lot of - -- literals, compiled without -O - - go_fractional f - | isFloatTy res_ty && valueInRange = Just (mkLit floatDataCon (HsFloatPrim noExtField f)) - | isDoubleTy res_ty && valueInRange = Just (mkLit doubleDataCon (HsDoublePrim noExtField f)) - | otherwise = Nothing - where - valueInRange = - case f of - FL { fl_exp = e } -> (-100) <= e && e <= 100 - -- We limit short-cutting Fractional Literals to when their power of 10 - -- is less than 100, which ensures desugaring isn't slow. - - go_string src s - | isStringTy res_ty = Just (HsLit noAnn (HsString src s)) - | otherwise = Nothing - -mkLit :: DataCon -> HsLit GhcTc -> HsExpr GhcTc -mkLit con lit = HsApp noComments (nlHsDataCon con) (nlHsLit lit) - ------------------------------- -hsOverLitName :: OverLitVal -> Name --- Get the canonical 'fromX' name for a particular OverLitVal -hsOverLitName (HsIntegral {}) = fromIntegerName -hsOverLitName (HsFractional {}) = fromRationalName -hsOverLitName (HsIsString {}) = fromStringName - -{- -************************************************************************ -* * -\subsection[BackSubst-HsBinds]{Running a substitution over @HsBinds@} -* * -************************************************************************ - -The rest of the zonking is done *after* typechecking. -The main zonking pass runs over the bindings - - a) to convert TcTyVars to TyVars etc, dereferencing any bindings etc - b) convert unbound TcTyVar to Void - c) convert each TcId to an Id by zonking its type - -The type variables are converted by binding mutable tyvars to immutable ones -and then zonking as normal. - -The Ids are converted by binding them in the normal Tc envt; that -way we maintain sharing; eg an Id is zonked at its binding site and they -all occurrences of that Id point to the common zonked copy - -It's all pretty boring stuff, because HsSyn is such a large type, and -the environment manipulation is tiresome. --} - --- Confused by zonking? See Note [What is zonking?] in GHC.Tc.Utils.TcMType. - --- | See Note [The ZonkEnv] --- Confused by zonking? See Note [What is zonking?] in "GHC.Tc.Utils.TcMType". -data ZonkEnv -- See Note [The ZonkEnv] - = ZonkEnv { ze_flexi :: ZonkFlexi - , ze_tv_env :: TyCoVarEnv TyCoVar - , ze_id_env :: IdEnv Id - , ze_meta_tv_env :: TcRef (TyVarEnv Type) } - -{- Note [The ZonkEnv] -~~~~~~~~~~~~~~~~~~~~~ -* ze_flexi :: ZonkFlexi says what to do with a - unification variable that is still un-unified. - See Note [Un-unified unification variables] - -* ze_tv_env :: TyCoVarEnv TyCoVar promotes sharing. At a binding site - of a tyvar or covar, we zonk the kind right away and add a mapping - to the env. This prevents re-zonking the kind at every - occurrence. But this is *just* an optimisation. - -* ze_id_env : IdEnv Id promotes sharing among Ids, by making all - occurrences of the Id point to a single zonked copy, built at the - binding site. - - Unlike ze_tv_env, it is knot-tied: see extendIdZonkEnvRec. - In a mutually recursive group - rec { f = ...g...; g = ...f... } - we want the occurrence of g to point to the one zonked Id for g, - and the same for f. - - Because it is knot-tied, we must be careful to consult it lazily. - Specifically, zonkIdOcc is not monadic. - -* ze_meta_tv_env: see Note [Sharing when zonking to Type] - - -Notes: - * We must be careful never to put coercion variables (which are Ids, - after all) in the knot-tied ze_id_env, because coercions can - appear in types, and we sometimes inspect a zonked type in this - module. [Question: where, precisely?] - - * In zonkTyVarOcc we consult ze_tv_env in a monadic context, - a second reason that ze_tv_env can't be monadic. - - * An obvious suggestion would be to have one VarEnv Var to - replace both ze_id_env and ze_tv_env, but that doesn't work - because of the knot-tying stuff mentioned above. - -Note [Un-unified unification variables] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -What should we do if we find a Flexi unification variable? -There are three possibilities: - -* DefaultFlexi: this is the common case, in situations like - length @alpha ([] @alpha) - It really doesn't matter what type we choose for alpha. But - we must choose a type! We can't leave mutable unification - variables floating around: after typecheck is complete, every - type variable occurrence must have a binding site. - - So we default it to 'Any' of the right kind. - - All this works for both type and kind variables (indeed - the two are the same thing). - -* SkolemiseFlexi: is a special case for the LHS of RULES. - See Note [Zonking the LHS of a RULE] - -* RuntimeUnkFlexi: is a special case for the GHCi debugger. - It's a way to have a variable that is not a mutable - unification variable, but doesn't have a binding site - either. - -* NoFlexi: See Note [Error on unconstrained meta-variables] - in GHC.Tc.Utils.TcMType. This mode will panic on unfilled - meta-variables. --} - -data ZonkFlexi -- See Note [Un-unified unification variables] - = DefaultFlexi -- Default unbound unification variables to Any - | SkolemiseFlexi -- Skolemise unbound unification variables - -- See Note [Zonking the LHS of a RULE] - | RuntimeUnkFlexi -- Used in the GHCi debugger - | NoFlexi -- Panic on unfilled meta-variables - -- See Note [Error on unconstrained meta-variables] - -- in GHC.Tc.Utils.TcMType - -instance Outputable ZonkEnv where - ppr (ZonkEnv { ze_tv_env = tv_env - , ze_id_env = id_env }) - = text "ZE" <+> braces (vcat - [ text "ze_tv_env =" <+> ppr tv_env - , text "ze_id_env =" <+> ppr id_env ]) - --- The EvBinds have to already be zonked, but that's usually the case. -emptyZonkEnv :: TcM ZonkEnv -emptyZonkEnv = mkEmptyZonkEnv DefaultFlexi - -mkEmptyZonkEnv :: ZonkFlexi -> TcM ZonkEnv -mkEmptyZonkEnv flexi - = do { mtv_env_ref <- newTcRef emptyVarEnv - ; return (ZonkEnv { ze_flexi = flexi - , ze_tv_env = emptyVarEnv - , ze_id_env = emptyVarEnv - , ze_meta_tv_env = mtv_env_ref }) } - -initZonkEnv :: (ZonkEnv -> TcM b) -> TcM b -initZonkEnv thing_inside = do { ze <- mkEmptyZonkEnv DefaultFlexi - ; thing_inside ze } - --- | Extend the knot-tied environment. -extendIdZonkEnvRec :: ZonkEnv -> [Var] -> ZonkEnv -extendIdZonkEnvRec ze@(ZonkEnv { ze_id_env = id_env }) ids - -- NB: Don't look at the var to decide which env't to put it in. That - -- would end up knot-tying all the env'ts. - = ze { ze_id_env = extendVarEnvList id_env [(id,id) | id <- ids] } - -- Given coercion variables will actually end up here. That's OK though: - -- coercion variables are never looked up in the knot-tied env't, so zonking - -- them simply doesn't get optimised. No one gets hurt. An improvement (?) - -- would be to do SCC analysis in zonkEvBinds and then only knot-tie the - -- recursive groups. But perhaps the time it takes to do the analysis is - -- more than the savings. - -extendZonkEnv :: ZonkEnv -> [Var] -> ZonkEnv -extendZonkEnv ze@(ZonkEnv { ze_tv_env = tyco_env, ze_id_env = id_env }) vars - = ze { ze_tv_env = extendVarEnvList tyco_env [(tv,tv) | tv <- tycovars] - , ze_id_env = extendVarEnvList id_env [(id,id) | id <- ids] } - where - (tycovars, ids) = partition isTyCoVar vars - -extendIdZonkEnv :: ZonkEnv -> Var -> ZonkEnv -extendIdZonkEnv ze@(ZonkEnv { ze_id_env = id_env }) id - = ze { ze_id_env = extendVarEnv id_env id id } - -extendTyZonkEnv :: ZonkEnv -> TyVar -> ZonkEnv -extendTyZonkEnv ze@(ZonkEnv { ze_tv_env = ty_env }) tv - = ze { ze_tv_env = extendVarEnv ty_env tv tv } - -setZonkType :: ZonkEnv -> ZonkFlexi -> ZonkEnv -setZonkType ze flexi = ze { ze_flexi = flexi } - -zonkEnvIds :: ZonkEnv -> TypeEnv -zonkEnvIds (ZonkEnv { ze_id_env = id_env}) - = mkNameEnv [(getName id, AnId id) | id <- nonDetEltsUFM id_env] - -- It's OK to use nonDetEltsUFM here because we forget the ordering - -- immediately by creating a TypeEnv - -zonkLIdOcc :: ZonkEnv -> LocatedN TcId -> LocatedN Id -zonkLIdOcc env = fmap (zonkIdOcc env) - -zonkIdOcc :: ZonkEnv -> TcId -> Id --- Ids defined in this module should be in the envt; --- ignore others. (Actually, data constructors are also --- not LocalVars, even when locally defined, but that is fine.) --- (Also foreign-imported things aren't currently in the ZonkEnv; --- that's ok because they don't need zonking.) --- --- Actually, Template Haskell works in 'chunks' of declarations, and --- an earlier chunk won't be in the 'env' that the zonking phase --- carries around. Instead it'll be in the tcg_gbl_env, already fully --- zonked. There's no point in looking it up there (except for error --- checking), and it's not conveniently to hand; hence the simple --- 'orElse' case in the LocalVar branch. --- --- Even without template splices, in module Main, the checking of --- 'main' is done as a separate chunk. -zonkIdOcc (ZonkEnv { ze_id_env = id_env}) id - | isLocalVar id = lookupVarEnv id_env id `orElse` - id - | otherwise = id - -zonkIdOccs :: ZonkEnv -> [TcId] -> [Id] -zonkIdOccs env ids = map (zonkIdOcc env) ids - --- zonkIdBndr is used *after* typechecking to get the Id's type --- to its final form. The TyVarEnv give -zonkIdBndr :: ZonkEnv -> TcId -> TcM Id -zonkIdBndr env v - = do Scaled w' ty' <- zonkScaledTcTypeToTypeX env (idScaledType v) - return (setIdMult (setIdType v ty') w') - -zonkIdBndrs :: ZonkEnv -> [TcId] -> TcM [Id] -zonkIdBndrs env ids = mapM (zonkIdBndr env) ids - -zonkTopBndrs :: [TcId] -> TcM [Id] -zonkTopBndrs ids = initZonkEnv $ \ ze -> zonkIdBndrs ze ids - -zonkFieldOcc :: ZonkEnv -> FieldOcc GhcTc -> TcM (FieldOcc GhcTc) -zonkFieldOcc env (FieldOcc sel lbl) - = fmap ((flip FieldOcc) lbl) $ zonkIdBndr env sel - -zonkEvBndrsX :: ZonkEnv -> [EvVar] -> TcM (ZonkEnv, [Var]) -zonkEvBndrsX = mapAccumLM zonkEvBndrX - -zonkEvBndrX :: ZonkEnv -> EvVar -> TcM (ZonkEnv, EvVar) --- Works for dictionaries and coercions -zonkEvBndrX env var - = do { var' <- zonkEvBndr env var - ; return (extendZonkEnv env [var'], var') } - -zonkEvBndr :: ZonkEnv -> EvVar -> TcM EvVar --- Works for dictionaries and coercions --- Does not extend the ZonkEnv -zonkEvBndr env var - = updateIdTypeAndMultM ({-# SCC "zonkEvBndr_zonkTcTypeToType" #-} zonkTcTypeToTypeX env) var - -{- -zonkEvVarOcc :: ZonkEnv -> EvVar -> TcM EvTerm -zonkEvVarOcc env v - | isCoVar v - = EvCoercion <$> zonkCoVarOcc env v - | otherwise - = return (EvId $ zonkIdOcc env v) --} - -zonkCoreBndrX :: ZonkEnv -> Var -> TcM (ZonkEnv, Var) -zonkCoreBndrX env v - | isId v = do { v' <- zonkIdBndr env v - ; return (extendIdZonkEnv env v', v') } - | otherwise = zonkTyBndrX env v - -zonkCoreBndrsX :: ZonkEnv -> [Var] -> TcM (ZonkEnv, [Var]) -zonkCoreBndrsX = mapAccumLM zonkCoreBndrX - -zonkTyBndrs :: [TcTyVar] -> TcM (ZonkEnv, [TyVar]) -zonkTyBndrs tvs = initZonkEnv $ \ze -> zonkTyBndrsX ze tvs - -zonkTyBndrsX :: ZonkEnv -> [TcTyVar] -> TcM (ZonkEnv, [TyVar]) -zonkTyBndrsX = mapAccumLM zonkTyBndrX - -zonkTyBndrX :: ZonkEnv -> TcTyVar -> TcM (ZonkEnv, TyVar) --- This guarantees to return a TyVar (not a TcTyVar) --- then we add it to the envt, so all occurrences are replaced --- --- It does not clone: the new TyVar has the sane Name --- as the old one. This important when zonking the --- TyVarBndrs of a TyCon, whose Names may scope. -zonkTyBndrX env tv - = assertPpr (isImmutableTyVar tv) (ppr tv <+> dcolon <+> ppr (tyVarKind tv)) $ - do { ki <- zonkTcTypeToTypeX env (tyVarKind tv) - -- Internal names tidy up better, for iface files. - ; let tv' = mkTyVar (tyVarName tv) ki - ; return (extendTyZonkEnv env tv', tv') } - -zonkTyVarBindersX :: ZonkEnv -> [VarBndr TcTyVar vis] - -> TcM (ZonkEnv, [VarBndr TyVar vis]) -zonkTyVarBindersX = mapAccumLM zonkTyVarBinderX - -zonkTyVarBinderX :: ZonkEnv -> VarBndr TcTyVar vis - -> TcM (ZonkEnv, VarBndr TyVar vis) --- Takes a TcTyVar and guarantees to return a TyVar -zonkTyVarBinderX env (Bndr tv vis) - = do { (env', tv') <- zonkTyBndrX env tv - ; return (env', Bndr tv' vis) } - -zonkTopExpr :: HsExpr GhcTc -> TcM (HsExpr GhcTc) -zonkTopExpr e = initZonkEnv $ \ ze -> zonkExpr ze e - -zonkTopLExpr :: LHsExpr GhcTc -> TcM (LHsExpr GhcTc) -zonkTopLExpr e = initZonkEnv $ \ ze -> zonkLExpr ze e - -zonkTopDecls :: Bag EvBind - -> LHsBinds GhcTc - -> [LRuleDecl GhcTc] -> [LTcSpecPrag] - -> [LForeignDecl GhcTc] - -> TcM (TypeEnv, - Bag EvBind, - LHsBinds GhcTc, - [LForeignDecl GhcTc], - [LTcSpecPrag], - [LRuleDecl GhcTc]) -zonkTopDecls ev_binds binds rules imp_specs fords - = do { (env1, ev_binds') <- initZonkEnv $ \ ze -> zonkEvBinds ze ev_binds - ; (env2, binds') <- zonkRecMonoBinds env1 binds - -- Top level is implicitly recursive - ; rules' <- zonkRules env2 rules - ; specs' <- zonkLTcSpecPrags env2 imp_specs - ; fords' <- zonkForeignExports env2 fords - ; return (zonkEnvIds env2, ev_binds', binds', fords', specs', rules') } - ---------------------------------------------- -zonkLocalBinds :: ZonkEnv -> HsLocalBinds GhcTc - -> TcM (ZonkEnv, HsLocalBinds GhcTc) -zonkLocalBinds env (EmptyLocalBinds x) - = return (env, (EmptyLocalBinds x)) - -zonkLocalBinds _ (HsValBinds _ (ValBinds {})) - = panic "zonkLocalBinds" -- Not in typechecker output - -zonkLocalBinds env (HsValBinds x (XValBindsLR (NValBinds binds sigs))) - = do { (env1, new_binds) <- go env binds - ; return (env1, HsValBinds x (XValBindsLR (NValBinds new_binds sigs))) } - where - go env [] - = return (env, []) - go env ((r,b):bs) - = do { (env1, b') <- zonkRecMonoBinds env b - ; (env2, bs') <- go env1 bs - ; return (env2, (r,b'):bs') } - -zonkLocalBinds env (HsIPBinds x (IPBinds dict_binds binds )) = do - new_binds <- mapM (wrapLocMA zonk_ip_bind) binds - let - env1 = extendIdZonkEnvRec env - [ n | (L _ (IPBind n _ _)) <- new_binds] - (env2, new_dict_binds) <- zonkTcEvBinds env1 dict_binds - return (env2, HsIPBinds x (IPBinds new_dict_binds new_binds)) - where - zonk_ip_bind (IPBind dict_id n e) - = do dict_id' <- zonkIdBndr env dict_id - e' <- zonkLExpr env e - return (IPBind dict_id' n e') - ---------------------------------------------- -zonkRecMonoBinds :: ZonkEnv -> LHsBinds GhcTc -> TcM (ZonkEnv, LHsBinds GhcTc) -zonkRecMonoBinds env binds - = fixM (\ ~(_, new_binds) -> do - { let env1 = extendIdZonkEnvRec env (collectHsBindsBinders CollNoDictBinders new_binds) - ; binds' <- zonkMonoBinds env1 binds - ; return (env1, binds') }) - ---------------------------------------------- -zonkMonoBinds :: ZonkEnv -> LHsBinds GhcTc -> TcM (LHsBinds GhcTc) -zonkMonoBinds env binds = mapBagM (zonk_lbind env) binds - -zonk_lbind :: ZonkEnv -> LHsBind GhcTc -> TcM (LHsBind GhcTc) -zonk_lbind env = wrapLocMA (zonk_bind env) - -zonk_bind :: ZonkEnv -> HsBind GhcTc -> TcM (HsBind GhcTc) -zonk_bind env bind@(PatBind { pat_lhs = pat, pat_rhs = grhss - , pat_ext = (ty, ticks)}) - = do { (_env, new_pat) <- zonkPat env pat -- Env already extended - ; new_grhss <- zonkGRHSs env zonkLExpr grhss - ; new_ty <- zonkTcTypeToTypeX env ty - ; return (bind { pat_lhs = new_pat, pat_rhs = new_grhss - , pat_ext = (new_ty, ticks) }) } - -zonk_bind env (VarBind { var_ext = x - , var_id = var, var_rhs = expr }) - = do { new_var <- zonkIdBndr env var - ; new_expr <- zonkLExpr env expr - ; return (VarBind { var_ext = x - , var_id = new_var - , var_rhs = new_expr }) } - -zonk_bind env bind@(FunBind { fun_id = L loc var - , fun_matches = ms - , fun_ext = (co_fn, ticks) }) - = do { new_var <- zonkIdBndr env var - ; (env1, new_co_fn) <- zonkCoFn env co_fn - ; new_ms <- zonkMatchGroup env1 zonkLExpr ms - ; return (bind { fun_id = L loc new_var - , fun_matches = new_ms - , fun_ext = (new_co_fn, ticks) }) } - -zonk_bind env (XHsBindsLR (AbsBinds { abs_tvs = tyvars, abs_ev_vars = evs - , abs_ev_binds = ev_binds - , abs_exports = exports - , abs_binds = val_binds - , abs_sig = has_sig })) - = assert ( all isImmutableTyVar tyvars ) $ - do { (env0, new_tyvars) <- zonkTyBndrsX env tyvars - ; (env1, new_evs) <- zonkEvBndrsX env0 evs - ; (env2, new_ev_binds) <- zonkTcEvBinds_s env1 ev_binds - ; (new_val_bind, new_exports) <- fixM $ \ ~(new_val_binds, _) -> - do { let env3 = extendIdZonkEnvRec env2 $ - collectHsBindsBinders CollNoDictBinders new_val_binds - ; new_val_binds <- mapBagM (zonk_val_bind env3) val_binds - ; new_exports <- mapM (zonk_export env3) exports - ; return (new_val_binds, new_exports) } - ; return $ XHsBindsLR $ - AbsBinds { abs_tvs = new_tyvars, abs_ev_vars = new_evs - , abs_ev_binds = new_ev_binds - , abs_exports = new_exports, abs_binds = new_val_bind - , abs_sig = has_sig } } - where - zonk_val_bind env lbind - | has_sig - , (L loc bind@(FunBind { fun_id = (L mloc mono_id) - , fun_matches = ms - , fun_ext = (co_fn, ticks) })) <- lbind - = do { new_mono_id <- updateIdTypeAndMultM (zonkTcTypeToTypeX env) mono_id - -- Specifically /not/ zonkIdBndr; we do not want to - -- complain about a representation-polymorphic binder - ; (env', new_co_fn) <- zonkCoFn env co_fn - ; new_ms <- zonkMatchGroup env' zonkLExpr ms - ; return $ L loc $ - bind { fun_id = L mloc new_mono_id - , fun_matches = new_ms - , fun_ext = (new_co_fn, ticks) } } - | otherwise - = zonk_lbind env lbind -- The normal case - - zonk_export :: ZonkEnv -> ABExport -> TcM ABExport - zonk_export env (ABE{ abe_wrap = wrap - , abe_poly = poly_id - , abe_mono = mono_id - , abe_prags = prags }) - = do new_poly_id <- zonkIdBndr env poly_id - (_, new_wrap) <- zonkCoFn env wrap - new_prags <- zonkSpecPrags env prags - return (ABE{ abe_wrap = new_wrap - , abe_poly = new_poly_id - , abe_mono = zonkIdOcc env mono_id - , abe_prags = new_prags }) - -zonk_bind env (PatSynBind x bind@(PSB { psb_id = L loc id - , psb_args = details - , psb_def = lpat - , psb_dir = dir })) - = do { id' <- zonkIdBndr env id - ; (env1, lpat') <- zonkPat env lpat - ; details' <- zonkPatSynDetails env1 details - ; (_env2, dir') <- zonkPatSynDir env1 dir - ; return $ PatSynBind x $ - bind { psb_id = L loc id' - , psb_args = details' - , psb_def = lpat' - , psb_dir = dir' } } - -zonkPatSynDetails :: ZonkEnv - -> HsPatSynDetails GhcTc - -> TcM (HsPatSynDetails GhcTc) -zonkPatSynDetails env (PrefixCon _ as) - = pure $ PrefixCon noTypeArgs (map (zonkLIdOcc env) as) -zonkPatSynDetails env (InfixCon a1 a2) - = pure $ InfixCon (zonkLIdOcc env a1) (zonkLIdOcc env a2) -zonkPatSynDetails env (RecCon flds) - = RecCon <$> mapM (zonkPatSynField env) flds - -zonkPatSynField :: ZonkEnv -> RecordPatSynField GhcTc -> TcM (RecordPatSynField GhcTc) -zonkPatSynField env (RecordPatSynField x y) = - RecordPatSynField <$> zonkFieldOcc env x <*> pure (zonkLIdOcc env y) - -zonkPatSynDir :: ZonkEnv -> HsPatSynDir GhcTc - -> TcM (ZonkEnv, HsPatSynDir GhcTc) -zonkPatSynDir env Unidirectional = return (env, Unidirectional) -zonkPatSynDir env ImplicitBidirectional = return (env, ImplicitBidirectional) -zonkPatSynDir env (ExplicitBidirectional mg) = do - mg' <- zonkMatchGroup env zonkLExpr mg - return (env, ExplicitBidirectional mg') - -zonkSpecPrags :: ZonkEnv -> TcSpecPrags -> TcM TcSpecPrags -zonkSpecPrags _ IsDefaultMethod = return IsDefaultMethod -zonkSpecPrags env (SpecPrags ps) = do { ps' <- zonkLTcSpecPrags env ps - ; return (SpecPrags ps') } - -zonkLTcSpecPrags :: ZonkEnv -> [LTcSpecPrag] -> TcM [LTcSpecPrag] -zonkLTcSpecPrags env ps - = mapM zonk_prag ps - where - zonk_prag (L loc (SpecPrag id co_fn inl)) - = do { (_, co_fn') <- zonkCoFn env co_fn - ; return (L loc (SpecPrag (zonkIdOcc env id) co_fn' inl)) } - -{- -************************************************************************ -* * -\subsection[BackSubst-Match-GRHSs]{Match and GRHSs} -* * -************************************************************************ --} - -zonkMatchGroup :: Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ SrcAnn NoEpAnns - => ZonkEnv - -> (ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))) - -> MatchGroup GhcTc (LocatedA (body GhcTc)) - -> TcM (MatchGroup GhcTc (LocatedA (body GhcTc))) -zonkMatchGroup env zBody (MG { mg_alts = L l ms - , mg_ext = MatchGroupTc arg_tys res_ty origin - }) - = do { ms' <- mapM (zonkMatch env zBody) ms - ; arg_tys' <- zonkScaledTcTypesToTypesX env arg_tys - ; res_ty' <- zonkTcTypeToTypeX env res_ty - ; return (MG { mg_alts = L l ms' - , mg_ext = MatchGroupTc arg_tys' res_ty' origin - }) } - -zonkMatch :: Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ SrcAnn NoEpAnns - => ZonkEnv - -> (ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))) - -> LMatch GhcTc (LocatedA (body GhcTc)) - -> TcM (LMatch GhcTc (LocatedA (body GhcTc))) -zonkMatch env zBody (L loc match@(Match { m_pats = pats - , m_grhss = grhss })) - = do { (env1, new_pats) <- zonkPats env pats - ; new_grhss <- zonkGRHSs env1 zBody grhss - ; return (L loc (match { m_pats = new_pats, m_grhss = new_grhss })) } - -------------------------------------------------------------------------- -zonkGRHSs :: Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ SrcAnn NoEpAnns - => ZonkEnv - -> (ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))) - -> GRHSs GhcTc (LocatedA (body GhcTc)) - -> TcM (GRHSs GhcTc (LocatedA (body GhcTc))) - -zonkGRHSs env zBody (GRHSs x grhss binds) = do - (new_env, new_binds) <- zonkLocalBinds env binds - let - zonk_grhs (GRHS xx guarded rhs) - = do (env2, new_guarded) <- zonkStmts new_env zonkLExpr guarded - new_rhs <- zBody env2 rhs - return (GRHS xx new_guarded new_rhs) - new_grhss <- mapM (wrapLocMA zonk_grhs) grhss - return (GRHSs x new_grhss new_binds) - -{- -************************************************************************ -* * -\subsection[BackSubst-HsExpr]{Running a zonkitution over a TypeCheckedExpr} -* * -************************************************************************ --} - -zonkLExprs :: ZonkEnv -> [LHsExpr GhcTc] -> TcM [LHsExpr GhcTc] -zonkLExpr :: ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc) -zonkExpr :: ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc) - -zonkLExprs env exprs = mapM (zonkLExpr env) exprs -zonkLExpr env expr = wrapLocMA (zonkExpr env) expr - -zonkExpr env (HsVar x (L l id)) - = assertPpr (isNothing (isDataConId_maybe id)) (ppr id) $ - return (HsVar x (L l (zonkIdOcc env id))) - -zonkExpr env (HsUnboundVar her occ) - = do her' <- zonk_her her - return (HsUnboundVar her' occ) - where - zonk_her :: HoleExprRef -> TcM HoleExprRef - zonk_her (HER ref ty u) - = do updMutVarM ref (zonkEvTerm env) - ty' <- zonkTcTypeToTypeX env ty - return (HER ref ty' u) - -zonkExpr env (HsRecSel _ (FieldOcc v occ)) - = return (HsRecSel noExtField (FieldOcc (zonkIdOcc env v) occ)) - -zonkExpr _ (HsIPVar x _) = dataConCantHappen x - -zonkExpr _ (HsOverLabel x _ _) = dataConCantHappen x - -zonkExpr env (HsLit x (HsRat e f ty)) - = do new_ty <- zonkTcTypeToTypeX env ty - return (HsLit x (HsRat e f new_ty)) - -zonkExpr _ (HsLit x lit) - = return (HsLit x lit) - -zonkExpr env (HsOverLit x lit) - = do { lit' <- zonkOverLit env lit - ; return (HsOverLit x lit') } - -zonkExpr env (HsLam x matches) - = do new_matches <- zonkMatchGroup env zonkLExpr matches - return (HsLam x new_matches) - -zonkExpr env (HsLamCase x lc_variant matches) - = do new_matches <- zonkMatchGroup env zonkLExpr matches - return (HsLamCase x lc_variant new_matches) - -zonkExpr env (HsApp x e1 e2) - = do new_e1 <- zonkLExpr env e1 - new_e2 <- zonkLExpr env e2 - return (HsApp x new_e1 new_e2) - -zonkExpr env (HsAppType ty e at t) - = do new_e <- zonkLExpr env e - new_ty <- zonkTcTypeToTypeX env ty - return (HsAppType new_ty new_e at t) - -- NB: the type is an HsType; can't zonk that! - -zonkExpr env (HsTypedBracket hsb_tc body) - = (\x -> HsTypedBracket x body) <$> zonkBracket env hsb_tc - -zonkExpr env (HsUntypedBracket hsb_tc body) - = (\x -> HsUntypedBracket x body) <$> zonkBracket env hsb_tc - -zonkExpr env (HsTypedSplice s _) = runTopSplice s >>= zonkExpr env - -zonkExpr _ (HsUntypedSplice x _) = dataConCantHappen x - -zonkExpr _ (OpApp x _ _ _) = dataConCantHappen x - -zonkExpr env (NegApp x expr op) - = do (env', new_op) <- zonkSyntaxExpr env op - new_expr <- zonkLExpr env' expr - return (NegApp x new_expr new_op) - -zonkExpr env (HsPar x lpar e rpar) - = do new_e <- zonkLExpr env e - return (HsPar x lpar new_e rpar) - -zonkExpr _ (SectionL x _ _) = dataConCantHappen x -zonkExpr _ (SectionR x _ _) = dataConCantHappen x -zonkExpr env (ExplicitTuple x tup_args boxed) - = do { new_tup_args <- mapM zonk_tup_arg tup_args - ; return (ExplicitTuple x new_tup_args boxed) } - where - zonk_tup_arg (Present x e) = do { e' <- zonkLExpr env e - ; return (Present x e') } - zonk_tup_arg (Missing t) = do { t' <- zonkScaledTcTypeToTypeX env t - ; return (Missing t') } - - -zonkExpr env (ExplicitSum args alt arity expr) - = do new_args <- mapM (zonkTcTypeToTypeX env) args - new_expr <- zonkLExpr env expr - return (ExplicitSum new_args alt arity new_expr) - -zonkExpr env (HsCase x expr ms) - = do new_expr <- zonkLExpr env expr - new_ms <- zonkMatchGroup env zonkLExpr ms - return (HsCase x new_expr new_ms) - -zonkExpr env (HsIf x e1 e2 e3) - = do new_e1 <- zonkLExpr env e1 - new_e2 <- zonkLExpr env e2 - new_e3 <- zonkLExpr env e3 - return (HsIf x new_e1 new_e2 new_e3) - -zonkExpr env (HsMultiIf ty alts) - = do { alts' <- mapM (wrapLocMA zonk_alt) alts - ; ty' <- zonkTcTypeToTypeX env ty - ; return $ HsMultiIf ty' alts' } - where zonk_alt (GRHS x guard expr) - = do { (env', guard') <- zonkStmts env zonkLExpr guard - ; expr' <- zonkLExpr env' expr - ; return $ GRHS x guard' expr' } - -zonkExpr env (HsLet x tkLet binds tkIn expr) - = do (new_env, new_binds) <- zonkLocalBinds env binds - new_expr <- zonkLExpr new_env expr - return (HsLet x tkLet new_binds tkIn new_expr) - -zonkExpr env (HsDo ty do_or_lc (L l stmts)) - = do (_, new_stmts) <- zonkStmts env zonkLExpr stmts - new_ty <- zonkTcTypeToTypeX env ty - return (HsDo new_ty do_or_lc (L l new_stmts)) - -zonkExpr env (ExplicitList ty exprs) - = do new_ty <- zonkTcTypeToTypeX env ty - new_exprs <- zonkLExprs env exprs - return (ExplicitList new_ty new_exprs) - -zonkExpr env expr@(RecordCon { rcon_ext = con_expr, rcon_flds = rbinds }) - = do { new_con_expr <- zonkExpr env con_expr - ; new_rbinds <- zonkRecFields env rbinds - ; return (expr { rcon_ext = new_con_expr - , rcon_flds = new_rbinds }) } - -zonkExpr env (ExprWithTySig _ e ty) - = do { e' <- zonkLExpr env e - ; return (ExprWithTySig noExtField e' ty) } - -zonkExpr env (ArithSeq expr wit info) - = do (env1, new_wit) <- zonkWit env wit - new_expr <- zonkExpr env expr - new_info <- zonkArithSeq env1 info - return (ArithSeq new_expr new_wit new_info) - where zonkWit env Nothing = return (env, Nothing) - zonkWit env (Just fln) = second Just <$> zonkSyntaxExpr env fln - -zonkExpr env (HsPragE x prag expr) - = do new_expr <- zonkLExpr env expr - return (HsPragE x prag new_expr) - --- arrow notation extensions -zonkExpr env (HsProc x pat body) - = do { (env1, new_pat) <- zonkPat env pat - ; new_body <- zonkCmdTop env1 body - ; return (HsProc x new_pat new_body) } - --- StaticPointers extension -zonkExpr env (HsStatic (fvs, ty) expr) - = do new_ty <- zonkTcTypeToTypeX env ty - HsStatic (fvs, new_ty) <$> zonkLExpr env expr - -zonkExpr env (XExpr (WrapExpr (HsWrap co_fn expr))) - = do (env1, new_co_fn) <- zonkCoFn env co_fn - new_expr <- zonkExpr env1 expr - return (XExpr (WrapExpr (HsWrap new_co_fn new_expr))) - -zonkExpr env (XExpr (ExpansionExpr (HsExpanded a b))) - = XExpr . ExpansionExpr . HsExpanded a <$> zonkExpr env b - -zonkExpr env (XExpr (ConLikeTc con tvs tys)) - = XExpr . ConLikeTc con tvs <$> mapM zonk_scale tys - where - zonk_scale (Scaled m ty) = Scaled <$> zonkTcTypeToTypeX env m <*> pure ty - -- Only the multiplicity can contain unification variables - -- The tvs come straight from the data-con, and so are strictly redundant - -- See Wrinkles of Note [Typechecking data constructors] in GHC.Tc.Gen.Head - -zonkExpr _ (RecordUpd x _ _) = dataConCantHappen x -zonkExpr _ (HsGetField x _ _) = dataConCantHappen x -zonkExpr _ (HsProjection x _) = dataConCantHappen x -zonkExpr _ e@(XExpr (HsTick {})) = pprPanic "zonkExpr" (ppr e) -zonkExpr _ e@(XExpr (HsBinTick {})) = pprPanic "zonkExpr" (ppr e) - -------------------------------------------------------------------------- -{- -Note [Skolems in zonkSyntaxExpr] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider rebindable syntax with something like - - (>>=) :: (forall x. blah) -> (forall y. blah') -> blah'' - -The x and y become skolems that are in scope when type-checking the -arguments to the bind. This means that we must extend the ZonkEnv with -these skolems when zonking the arguments to the bind. But the skolems -are different between the two arguments, and so we should theoretically -carry around different environments to use for the different arguments. - -However, this becomes a logistical nightmare, especially in dealing with -the more exotic Stmt forms. So, we simplify by making the critical -assumption that the uniques of the skolems are different. (This assumption -is justified by the use of newUnique in GHC.Tc.Utils.TcMType.instSkolTyCoVarX.) -Now, we can safely just extend one environment. --} - --- See Note [Skolems in zonkSyntaxExpr] -zonkSyntaxExpr :: ZonkEnv -> SyntaxExpr GhcTc - -> TcM (ZonkEnv, SyntaxExpr GhcTc) -zonkSyntaxExpr env (SyntaxExprTc { syn_expr = expr - , syn_arg_wraps = arg_wraps - , syn_res_wrap = res_wrap }) - = do { (env0, res_wrap') <- zonkCoFn env res_wrap - ; expr' <- zonkExpr env0 expr - ; (env1, arg_wraps') <- mapAccumLM zonkCoFn env0 arg_wraps - ; return (env1, SyntaxExprTc { syn_expr = expr' - , syn_arg_wraps = arg_wraps' - , syn_res_wrap = res_wrap' }) } -zonkSyntaxExpr env NoSyntaxExprTc = return (env, NoSyntaxExprTc) - -------------------------------------------------------------------------- - -zonkLCmd :: ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc) -zonkCmd :: ZonkEnv -> HsCmd GhcTc -> TcM (HsCmd GhcTc) - -zonkLCmd env cmd = wrapLocMA (zonkCmd env) cmd - -zonkCmd env (XCmd (HsWrap w cmd)) - = do { (env1, w') <- zonkCoFn env w - ; cmd' <- zonkCmd env1 cmd - ; return (XCmd (HsWrap w' cmd')) } -zonkCmd env (HsCmdArrApp ty e1 e2 ho rl) - = do new_e1 <- zonkLExpr env e1 - new_e2 <- zonkLExpr env e2 - new_ty <- zonkTcTypeToTypeX env ty - return (HsCmdArrApp new_ty new_e1 new_e2 ho rl) - -zonkCmd env (HsCmdArrForm x op f fixity args) - = do new_op <- zonkLExpr env op - new_args <- mapM (zonkCmdTop env) args - return (HsCmdArrForm x new_op f fixity new_args) - -zonkCmd env (HsCmdApp x c e) - = do new_c <- zonkLCmd env c - new_e <- zonkLExpr env e - return (HsCmdApp x new_c new_e) - -zonkCmd env (HsCmdLam x matches) - = do new_matches <- zonkMatchGroup env zonkLCmd matches - return (HsCmdLam x new_matches) - -zonkCmd env (HsCmdPar x lpar c rpar) - = do new_c <- zonkLCmd env c - return (HsCmdPar x lpar new_c rpar) - -zonkCmd env (HsCmdCase x expr ms) - = do new_expr <- zonkLExpr env expr - new_ms <- zonkMatchGroup env zonkLCmd ms - return (HsCmdCase x new_expr new_ms) - -zonkCmd env (HsCmdLamCase x lc_variant ms) - = do new_ms <- zonkMatchGroup env zonkLCmd ms - return (HsCmdLamCase x lc_variant new_ms) - -zonkCmd env (HsCmdIf x eCond ePred cThen cElse) - = do { (env1, new_eCond) <- zonkSyntaxExpr env eCond - ; new_ePred <- zonkLExpr env1 ePred - ; new_cThen <- zonkLCmd env1 cThen - ; new_cElse <- zonkLCmd env1 cElse - ; return (HsCmdIf x new_eCond new_ePred new_cThen new_cElse) } - -zonkCmd env (HsCmdLet x tkLet binds tkIn cmd) - = do (new_env, new_binds) <- zonkLocalBinds env binds - new_cmd <- zonkLCmd new_env cmd - return (HsCmdLet x tkLet new_binds tkIn new_cmd) - -zonkCmd env (HsCmdDo ty (L l stmts)) - = do (_, new_stmts) <- zonkStmts env zonkLCmd stmts - new_ty <- zonkTcTypeToTypeX env ty - return (HsCmdDo new_ty (L l new_stmts)) - - - -zonkCmdTop :: ZonkEnv -> LHsCmdTop GhcTc -> TcM (LHsCmdTop GhcTc) -zonkCmdTop env cmd = wrapLocMA (zonk_cmd_top env) cmd - -zonk_cmd_top :: ZonkEnv -> HsCmdTop GhcTc -> TcM (HsCmdTop GhcTc) -zonk_cmd_top env (HsCmdTop (CmdTopTc stack_tys ty ids) cmd) - = do new_cmd <- zonkLCmd env cmd - new_stack_tys <- zonkTcTypeToTypeX env stack_tys - new_ty <- zonkTcTypeToTypeX env ty - new_ids <- mapSndM (zonkExpr env) ids - - massert (isLiftedTypeKind (typeKind new_stack_tys)) - -- desugarer assumes that this is not representation-polymorphic... - -- but indeed it should always be lifted due to the typing - -- rules for arrows - - return (HsCmdTop (CmdTopTc new_stack_tys new_ty new_ids) new_cmd) - -------------------------------------------------------------------------- -zonkCoFn :: ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper) -zonkCoFn env WpHole = return (env, WpHole) -zonkCoFn env (WpCompose c1 c2) = do { (env1, c1') <- zonkCoFn env c1 - ; (env2, c2') <- zonkCoFn env1 c2 - ; return (env2, WpCompose c1' c2') } -zonkCoFn env (WpFun c1 c2 t1) = do { (env1, c1') <- zonkCoFn env c1 - ; (env2, c2') <- zonkCoFn env1 c2 - ; t1' <- zonkScaledTcTypeToTypeX env2 t1 - ; return (env2, WpFun c1' c2' t1') } -zonkCoFn env (WpCast co) = do { co' <- zonkCoToCo env co - ; return (env, WpCast co') } -zonkCoFn env (WpEvLam ev) = do { (env', ev') <- zonkEvBndrX env ev - ; return (env', WpEvLam ev') } -zonkCoFn env (WpEvApp arg) = do { arg' <- zonkEvTerm env arg - ; return (env, WpEvApp arg') } -zonkCoFn env (WpTyLam tv) = assert (isImmutableTyVar tv) $ - do { (env', tv') <- zonkTyBndrX env tv - ; return (env', WpTyLam tv') } -zonkCoFn env (WpTyApp ty) = do { ty' <- zonkTcTypeToTypeX env ty - ; return (env, WpTyApp ty') } -zonkCoFn env (WpLet bs) = do { (env1, bs') <- zonkTcEvBinds env bs - ; return (env1, WpLet bs') } -zonkCoFn env (WpMultCoercion co) = do { co' <- zonkCoToCo env co - ; return (env, WpMultCoercion co') } - -------------------------------------------------------------------------- -zonkOverLit :: ZonkEnv -> HsOverLit GhcTc -> TcM (HsOverLit GhcTc) -zonkOverLit env lit@(OverLit {ol_ext = x at OverLitTc { ol_witness = e, ol_type = ty } }) - = do { ty' <- zonkTcTypeToTypeX env ty - ; e' <- zonkExpr env e - ; return (lit { ol_ext = x { ol_witness = e' - , ol_type = ty' } }) } - -------------------------------------------------------------------------- -zonkBracket :: ZonkEnv -> HsBracketTc -> TcM HsBracketTc -zonkBracket env (HsBracketTc hsb_thing ty wrap bs) - = do wrap' <- traverse zonkQuoteWrap wrap - bs' <- mapM (zonk_b env) bs - new_ty <- zonkTcTypeToTypeX env ty - return (HsBracketTc hsb_thing new_ty wrap' bs') - where - zonkQuoteWrap (QuoteWrapper ev ty) = do - let ev' = zonkIdOcc env ev - ty' <- zonkTcTypeToTypeX env ty - return (QuoteWrapper ev' ty') - - zonk_b env' (PendingTcSplice n e) = do e' <- zonkLExpr env' e - return (PendingTcSplice n e') - -------------------------------------------------------------------------- -zonkArithSeq :: ZonkEnv -> ArithSeqInfo GhcTc -> TcM (ArithSeqInfo GhcTc) - -zonkArithSeq env (From e) - = do new_e <- zonkLExpr env e - return (From new_e) - -zonkArithSeq env (FromThen e1 e2) - = do new_e1 <- zonkLExpr env e1 - new_e2 <- zonkLExpr env e2 - return (FromThen new_e1 new_e2) - -zonkArithSeq env (FromTo e1 e2) - = do new_e1 <- zonkLExpr env e1 - new_e2 <- zonkLExpr env e2 - return (FromTo new_e1 new_e2) - -zonkArithSeq env (FromThenTo e1 e2 e3) - = do new_e1 <- zonkLExpr env e1 - new_e2 <- zonkLExpr env e2 - new_e3 <- zonkLExpr env e3 - return (FromThenTo new_e1 new_e2 new_e3) - -------------------------------------------------------------------------- -zonkStmts :: Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))) ~ SrcSpanAnnA - => ZonkEnv - -> (ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))) - -> [LStmt GhcTc (LocatedA (body GhcTc))] - -> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (body GhcTc))]) -zonkStmts env _ [] = return (env, []) -zonkStmts env zBody (s:ss) = do { (env1, s') <- wrapLocSndMA (zonkStmt env zBody) s - ; (env2, ss') <- zonkStmts env1 zBody ss - ; return (env2, s' : ss') } - -zonkStmt :: Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))) ~ SrcSpanAnnA - => ZonkEnv - -> (ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))) - -> Stmt GhcTc (LocatedA (body GhcTc)) - -> TcM (ZonkEnv, Stmt GhcTc (LocatedA (body GhcTc))) -zonkStmt env _ (ParStmt bind_ty stmts_w_bndrs mzip_op bind_op) - = do { (env1, new_bind_op) <- zonkSyntaxExpr env bind_op - ; new_bind_ty <- zonkTcTypeToTypeX env1 bind_ty - ; new_stmts_w_bndrs <- mapM (zonk_branch env1) stmts_w_bndrs - ; let new_binders = [b | ParStmtBlock _ _ bs _ <- new_stmts_w_bndrs - , b <- bs] - env2 = extendIdZonkEnvRec env1 new_binders - ; new_mzip <- zonkExpr env2 mzip_op - ; return (env2 - , ParStmt new_bind_ty new_stmts_w_bndrs new_mzip new_bind_op)} - where - zonk_branch :: ZonkEnv -> ParStmtBlock GhcTc GhcTc - -> TcM (ParStmtBlock GhcTc GhcTc) - zonk_branch env1 (ParStmtBlock x stmts bndrs return_op) - = do { (env2, new_stmts) <- zonkStmts env1 zonkLExpr stmts - ; (env3, new_return) <- zonkSyntaxExpr env2 return_op - ; return (ParStmtBlock x new_stmts (zonkIdOccs env3 bndrs) - new_return) } - -zonkStmt env zBody (RecStmt { recS_stmts = L _ segStmts, recS_later_ids = lvs - , recS_rec_ids = rvs - , recS_ret_fn = ret_id, recS_mfix_fn = mfix_id - , recS_bind_fn = bind_id - , recS_ext = - RecStmtTc { recS_bind_ty = bind_ty - , recS_later_rets = later_rets - , recS_rec_rets = rec_rets - , recS_ret_ty = ret_ty} }) - = do { (env1, new_bind_id) <- zonkSyntaxExpr env bind_id - ; (env2, new_mfix_id) <- zonkSyntaxExpr env1 mfix_id - ; (env3, new_ret_id) <- zonkSyntaxExpr env2 ret_id - ; new_bind_ty <- zonkTcTypeToTypeX env3 bind_ty - ; new_rvs <- zonkIdBndrs env3 rvs - ; new_lvs <- zonkIdBndrs env3 lvs - ; new_ret_ty <- zonkTcTypeToTypeX env3 ret_ty - ; let env4 = extendIdZonkEnvRec env3 new_rvs - ; (env5, new_segStmts) <- zonkStmts env4 zBody segStmts - -- Zonk the ret-expressions in an envt that - -- has the polymorphic bindings in the envt - ; new_later_rets <- mapM (zonkExpr env5) later_rets - ; new_rec_rets <- mapM (zonkExpr env5) rec_rets - ; return (extendIdZonkEnvRec env3 new_lvs, -- Only the lvs are needed - RecStmt { recS_stmts = noLocA new_segStmts - , recS_later_ids = new_lvs - , recS_rec_ids = new_rvs, recS_ret_fn = new_ret_id - , recS_mfix_fn = new_mfix_id, recS_bind_fn = new_bind_id - , recS_ext = RecStmtTc - { recS_bind_ty = new_bind_ty - , recS_later_rets = new_later_rets - , recS_rec_rets = new_rec_rets - , recS_ret_ty = new_ret_ty } }) } - -zonkStmt env zBody (BodyStmt ty body then_op guard_op) - = do (env1, new_then_op) <- zonkSyntaxExpr env then_op - (env2, new_guard_op) <- zonkSyntaxExpr env1 guard_op - new_body <- zBody env2 body - new_ty <- zonkTcTypeToTypeX env2 ty - return (env2, BodyStmt new_ty new_body new_then_op new_guard_op) - -zonkStmt env zBody (LastStmt x body noret ret_op) - = do (env1, new_ret) <- zonkSyntaxExpr env ret_op - new_body <- zBody env1 body - return (env, LastStmt x new_body noret new_ret) - -zonkStmt env _ (TransStmt { trS_stmts = stmts, trS_bndrs = binderMap - , trS_by = by, trS_form = form, trS_using = using - , trS_ret = return_op, trS_bind = bind_op - , trS_ext = bind_arg_ty - , trS_fmap = liftM_op }) - = do { - ; (env1, bind_op') <- zonkSyntaxExpr env bind_op - ; bind_arg_ty' <- zonkTcTypeToTypeX env1 bind_arg_ty - ; (env2, stmts') <- zonkStmts env1 zonkLExpr stmts - ; by' <- traverse (zonkLExpr env2) by - ; using' <- zonkLExpr env2 using - - ; (env3, return_op') <- zonkSyntaxExpr env2 return_op - ; binderMap' <- mapM (zonkBinderMapEntry env3) binderMap - ; liftM_op' <- zonkExpr env3 liftM_op - ; let env3' = extendIdZonkEnvRec env3 (map snd binderMap') - ; return (env3', TransStmt { trS_stmts = stmts', trS_bndrs = binderMap' - , trS_by = by', trS_form = form, trS_using = using' - , trS_ret = return_op', trS_bind = bind_op' - , trS_ext = bind_arg_ty' - , trS_fmap = liftM_op' }) } - where - zonkBinderMapEntry env (oldBinder, newBinder) = do - let oldBinder' = zonkIdOcc env oldBinder - newBinder' <- zonkIdBndr env newBinder - return (oldBinder', newBinder') - -zonkStmt env _ (LetStmt x binds) - = do (env1, new_binds) <- zonkLocalBinds env binds - return (env1, LetStmt x new_binds) - -zonkStmt env zBody (BindStmt xbs pat body) - = do { (env1, new_bind) <- zonkSyntaxExpr env (xbstc_bindOp xbs) - ; new_w <- zonkTcTypeToTypeX env1 (xbstc_boundResultMult xbs) - ; new_bind_ty <- zonkTcTypeToTypeX env1 (xbstc_boundResultType xbs) - ; new_body <- zBody env1 body - ; (env2, new_pat) <- zonkPat env1 pat - ; new_fail <- case xbstc_failOp xbs of - Nothing -> return Nothing - Just f -> fmap (Just . snd) (zonkSyntaxExpr env1 f) - ; return ( env2 - , BindStmt (XBindStmtTc - { xbstc_bindOp = new_bind - , xbstc_boundResultType = new_bind_ty - , xbstc_boundResultMult = new_w - , xbstc_failOp = new_fail - }) - new_pat new_body) } - --- Scopes: join > ops (in reverse order) > pats (in forward order) --- > rest of stmts -zonkStmt env _zBody (ApplicativeStmt body_ty args mb_join) - = do { (env1, new_mb_join) <- zonk_join env mb_join - ; (env2, new_args) <- zonk_args env1 args - ; new_body_ty <- zonkTcTypeToTypeX env2 body_ty - ; return ( env2 - , ApplicativeStmt new_body_ty new_args new_mb_join) } - where - zonk_join env Nothing = return (env, Nothing) - zonk_join env (Just j) = second Just <$> zonkSyntaxExpr env j - - get_pat :: (SyntaxExpr GhcTc, ApplicativeArg GhcTc) -> LPat GhcTc - get_pat (_, ApplicativeArgOne _ pat _ _) = pat - get_pat (_, ApplicativeArgMany _ _ _ pat _) = pat - - replace_pat :: LPat GhcTc - -> (SyntaxExpr GhcTc, ApplicativeArg GhcTc) - -> (SyntaxExpr GhcTc, ApplicativeArg GhcTc) - replace_pat pat (op, ApplicativeArgOne fail_op _ a isBody) - = (op, ApplicativeArgOne fail_op pat a isBody) - replace_pat pat (op, ApplicativeArgMany x a b _ c) - = (op, ApplicativeArgMany x a b pat c) - - zonk_args env args - = do { (env1, new_args_rev) <- zonk_args_rev env (reverse args) - ; (env2, new_pats) <- zonkPats env1 (map get_pat args) - ; return (env2, zipWithEqual "zonkStmt" replace_pat - new_pats (reverse new_args_rev)) } - - -- these need to go backward, because if any operators are higher-rank, - -- later operators may introduce skolems that are in scope for earlier - -- arguments - zonk_args_rev env ((op, arg) : args) - = do { (env1, new_op) <- zonkSyntaxExpr env op - ; new_arg <- zonk_arg env1 arg - ; (env2, new_args) <- zonk_args_rev env1 args - ; return (env2, (new_op, new_arg) : new_args) } - zonk_args_rev env [] = return (env, []) - - zonk_arg env (ApplicativeArgOne fail_op pat expr isBody) - = do { new_expr <- zonkLExpr env expr - ; new_fail <- forM fail_op $ \old_fail -> - do { (_, fail') <- zonkSyntaxExpr env old_fail - ; return fail' - } - ; return (ApplicativeArgOne new_fail pat new_expr isBody) } - zonk_arg env (ApplicativeArgMany x stmts ret pat ctxt) - = do { (env1, new_stmts) <- zonkStmts env zonkLExpr stmts - ; new_ret <- zonkExpr env1 ret - ; return (ApplicativeArgMany x new_stmts new_ret pat ctxt) } - -------------------------------------------------------------------------- -zonkRecFields :: ZonkEnv -> HsRecordBinds GhcTc -> TcM (HsRecordBinds GhcTc) -zonkRecFields env (HsRecFields flds dd) - = do { flds' <- mapM zonk_rbind flds - ; return (HsRecFields flds' dd) } - where - zonk_rbind (L l fld) - = do { new_id <- wrapLocMA (zonkFieldOcc env) (hfbLHS fld) - ; new_expr <- zonkLExpr env (hfbRHS fld) - ; return (L l (fld { hfbLHS = new_id - , hfbRHS = new_expr })) } - -{- -************************************************************************ -* * -\subsection[BackSubst-Pats]{Patterns} -* * -************************************************************************ --} - -zonkPat :: ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc) --- Extend the environment as we go, because it's possible for one --- pattern to bind something that is used in another (inside or --- to the right) -zonkPat env pat = wrapLocSndMA (zonk_pat env) pat - -zonk_pat :: ZonkEnv -> Pat GhcTc -> TcM (ZonkEnv, Pat GhcTc) -zonk_pat env (ParPat x lpar p rpar) - = do { (env', p') <- zonkPat env p - ; return (env', ParPat x lpar p' rpar) } - -zonk_pat env (WildPat ty) - = do { ty' <- zonkTcTypeToTypeX env ty - ; return (env, WildPat ty') } - -zonk_pat env (VarPat x (L l v)) - = do { v' <- zonkIdBndr env v - ; return (extendIdZonkEnv env v', VarPat x (L l v')) } - -zonk_pat env (LazyPat x pat) - = do { (env', pat') <- zonkPat env pat - ; return (env', LazyPat x pat') } - -zonk_pat env (BangPat x pat) - = do { (env', pat') <- zonkPat env pat - ; return (env', BangPat x pat') } - -zonk_pat env (AsPat x (L loc v) at pat) - = do { v' <- zonkIdBndr env v - ; (env', pat') <- zonkPat (extendIdZonkEnv env v') pat - ; return (env', AsPat x (L loc v') at pat') } - -zonk_pat env (ViewPat ty expr pat) - = do { expr' <- zonkLExpr env expr - ; (env', pat') <- zonkPat env pat - ; ty' <- zonkTcTypeToTypeX env ty - ; return (env', ViewPat ty' expr' pat') } - -zonk_pat env (ListPat ty pats) - = do { ty' <- zonkTcTypeToTypeX env ty - ; (env', pats') <- zonkPats env pats - ; return (env', ListPat ty' pats') } - -zonk_pat env (TuplePat tys pats boxed) - = do { tys' <- mapM (zonkTcTypeToTypeX env) tys - ; (env', pats') <- zonkPats env pats - ; return (env', TuplePat tys' pats' boxed) } - -zonk_pat env (SumPat tys pat alt arity ) - = do { tys' <- mapM (zonkTcTypeToTypeX env) tys - ; (env', pat') <- zonkPat env pat - ; return (env', SumPat tys' pat' alt arity) } - -zonk_pat env p@(ConPat { pat_args = args - , pat_con_ext = p'@(ConPatTc - { cpt_tvs = tyvars - , cpt_dicts = evs - , cpt_binds = binds - , cpt_wrap = wrapper - , cpt_arg_tys = tys - }) - }) - = assert (all isImmutableTyVar tyvars) $ - do { new_tys <- mapM (zonkTcTypeToTypeX env) tys - ; (env0, new_tyvars) <- zonkTyBndrsX env tyvars - -- Must zonk the existential variables, because their - -- /kind/ need potential zonking. - -- cf typecheck/should_compile/tc221.hs - ; (env1, new_evs) <- zonkEvBndrsX env0 evs - ; (env2, new_binds) <- zonkTcEvBinds env1 binds - ; (env3, new_wrapper) <- zonkCoFn env2 wrapper - ; (env', new_args) <- zonkConStuff env3 args - ; pure ( env' - , p - { pat_args = new_args - , pat_con_ext = p' - { cpt_arg_tys = new_tys - , cpt_tvs = new_tyvars - , cpt_dicts = new_evs - , cpt_binds = new_binds - , cpt_wrap = new_wrapper - } - } - ) - } - -zonk_pat env (LitPat x lit) = return (env, LitPat x lit) - -zonk_pat env (SigPat ty pat hs_ty) - = do { ty' <- zonkTcTypeToTypeX env ty - ; (env', pat') <- zonkPat env pat - ; return (env', SigPat ty' pat' hs_ty) } - -zonk_pat env (NPat ty (L l lit) mb_neg eq_expr) - = do { (env1, eq_expr') <- zonkSyntaxExpr env eq_expr - ; (env2, mb_neg') <- case mb_neg of - Nothing -> return (env1, Nothing) - Just n -> second Just <$> zonkSyntaxExpr env1 n - - ; lit' <- zonkOverLit env2 lit - ; ty' <- zonkTcTypeToTypeX env2 ty - ; return (env2, NPat ty' (L l lit') mb_neg' eq_expr') } - -zonk_pat env (NPlusKPat ty (L loc n) (L l lit1) lit2 e1 e2) - = do { (env1, e1') <- zonkSyntaxExpr env e1 - ; (env2, e2') <- zonkSyntaxExpr env1 e2 - ; n' <- zonkIdBndr env2 n - ; lit1' <- zonkOverLit env2 lit1 - ; lit2' <- zonkOverLit env2 lit2 - ; ty' <- zonkTcTypeToTypeX env2 ty - ; return (extendIdZonkEnv env2 n', - NPlusKPat ty' (L loc n') (L l lit1') lit2' e1' e2') } -zonk_pat env (XPat ext) = case ext of - { ExpansionPat orig pat-> - do { (env, pat') <- zonk_pat env pat - ; return $ (env, XPat $ ExpansionPat orig pat') } - ; CoPat co_fn pat ty -> - do { (env', co_fn') <- zonkCoFn env co_fn - ; (env'', pat') <- zonkPat env' (noLocA pat) - ; ty' <- zonkTcTypeToTypeX env'' ty - ; return (env'', XPat $ CoPat co_fn' (unLoc pat') ty') - }} - -zonk_pat _ pat = pprPanic "zonk_pat" (ppr pat) - ---------------------------- -zonkConStuff :: ZonkEnv -> HsConPatDetails GhcTc - -> TcM (ZonkEnv, HsConPatDetails GhcTc) -zonkConStuff env (PrefixCon tyargs pats) - = do { (env', pats') <- zonkPats env pats - ; return (env', PrefixCon tyargs pats') } - -zonkConStuff env (InfixCon p1 p2) - = do { (env1, p1') <- zonkPat env p1 - ; (env', p2') <- zonkPat env1 p2 - ; return (env', InfixCon p1' p2') } - -zonkConStuff env (RecCon (HsRecFields rpats dd)) - = do { (env', pats') <- zonkPats env (map (hfbRHS . unLoc) rpats) - ; let rpats' = zipWith (\(L l rp) p' -> - L l (rp { hfbRHS = p' })) - rpats pats' - ; return (env', RecCon (HsRecFields rpats' dd)) } - -- Field selectors have declared types; hence no zonking - ---------------------------- -zonkPats :: ZonkEnv -> [LPat GhcTc] -> TcM (ZonkEnv, [LPat GhcTc]) -zonkPats env [] = return (env, []) -zonkPats env (pat:pats) = do { (env1, pat') <- zonkPat env pat - ; (env', pats') <- zonkPats env1 pats - ; return (env', pat':pats') } - -{- -************************************************************************ -* * -\subsection[BackSubst-Foreign]{Foreign exports} -* * -************************************************************************ --} - -zonkForeignExports :: ZonkEnv -> [LForeignDecl GhcTc] - -> TcM [LForeignDecl GhcTc] -zonkForeignExports env ls = mapM (wrapLocMA (zonkForeignExport env)) ls - -zonkForeignExport :: ZonkEnv -> ForeignDecl GhcTc -> TcM (ForeignDecl GhcTc) -zonkForeignExport env (ForeignExport { fd_name = i, fd_e_ext = co - , fd_fe = spec }) - = return (ForeignExport { fd_name = zonkLIdOcc env i - , fd_sig_ty = undefined, fd_e_ext = co - , fd_fe = spec }) -zonkForeignExport _ for_imp - = return for_imp -- Foreign imports don't need zonking - -zonkRules :: ZonkEnv -> [LRuleDecl GhcTc] -> TcM [LRuleDecl GhcTc] -zonkRules env rs = mapM (wrapLocMA (zonkRule env)) rs - -zonkRule :: ZonkEnv -> RuleDecl GhcTc -> TcM (RuleDecl GhcTc) -zonkRule env rule@(HsRule { rd_tmvs = tm_bndrs{-::[RuleBndr TcId]-} - , rd_lhs = lhs - , rd_rhs = rhs }) - = do { (env_inside, new_tm_bndrs) <- mapAccumLM zonk_tm_bndr env tm_bndrs - - ; let env_lhs = setZonkType env_inside SkolemiseFlexi - -- See Note [Zonking the LHS of a RULE] - - ; new_lhs <- zonkLExpr env_lhs lhs - ; new_rhs <- zonkLExpr env_inside rhs - - ; return $ rule { rd_tmvs = new_tm_bndrs - , rd_lhs = new_lhs - , rd_rhs = new_rhs } } - where - zonk_tm_bndr :: ZonkEnv -> LRuleBndr GhcTc -> TcM (ZonkEnv, LRuleBndr GhcTc) - zonk_tm_bndr env (L l (RuleBndr x (L loc v))) - = do { (env', v') <- zonk_it env v - ; return (env', L l (RuleBndr x (L loc v'))) } - zonk_tm_bndr _ (L _ (RuleBndrSig {})) = panic "zonk_tm_bndr RuleBndrSig" - - zonk_it env v - | isId v = do { v' <- zonkIdBndr env v - ; return (extendIdZonkEnvRec env [v'], v') } - | otherwise = assert (isImmutableTyVar v) - zonkTyBndrX env v - -- DV: used to be return (env,v) but that is plain - -- wrong because we may need to go inside the kind - -- of v and zonk there! - -{- -************************************************************************ -* * - Constraints and evidence -* * -************************************************************************ --} - -zonkEvTerm :: ZonkEnv -> EvTerm -> TcM EvTerm -zonkEvTerm env (EvExpr e) - = EvExpr <$> zonkCoreExpr env e -zonkEvTerm env (EvTypeable ty ev) - = EvTypeable <$> zonkTcTypeToTypeX env ty <*> zonkEvTypeable env ev -zonkEvTerm env (EvFun { et_tvs = tvs, et_given = evs - , et_binds = ev_binds, et_body = body_id }) - = do { (env0, new_tvs) <- zonkTyBndrsX env tvs - ; (env1, new_evs) <- zonkEvBndrsX env0 evs - ; (env2, new_ev_binds) <- zonkTcEvBinds env1 ev_binds - ; let new_body_id = zonkIdOcc env2 body_id - ; return (EvFun { et_tvs = new_tvs, et_given = new_evs - , et_binds = new_ev_binds, et_body = new_body_id }) } - -zonkCoreExpr :: ZonkEnv -> CoreExpr -> TcM CoreExpr -zonkCoreExpr env (Var v) - | isCoVar v - = Coercion <$> zonkCoVarOcc env v - | otherwise - = return (Var $ zonkIdOcc env v) -zonkCoreExpr _ (Lit l) - = return $ Lit l -zonkCoreExpr env (Coercion co) - = Coercion <$> zonkCoToCo env co -zonkCoreExpr env (Type ty) - = Type <$> zonkTcTypeToTypeX env ty - -zonkCoreExpr env (Cast e co) - = Cast <$> zonkCoreExpr env e <*> zonkCoToCo env co -zonkCoreExpr env (Tick t e) - = Tick t <$> zonkCoreExpr env e -- Do we need to zonk in ticks? - -zonkCoreExpr env (App e1 e2) - = App <$> zonkCoreExpr env e1 <*> zonkCoreExpr env e2 -zonkCoreExpr env (Lam v e) - = do { (env1, v') <- zonkCoreBndrX env v - ; Lam v' <$> zonkCoreExpr env1 e } -zonkCoreExpr env (Let bind e) - = do (env1, bind') <- zonkCoreBind env bind - Let bind'<$> zonkCoreExpr env1 e -zonkCoreExpr env (Case scrut b ty alts) - = do scrut' <- zonkCoreExpr env scrut - ty' <- zonkTcTypeToTypeX env ty - b' <- zonkIdBndr env b - let env1 = extendIdZonkEnv env b' - alts' <- mapM (zonkCoreAlt env1) alts - return $ Case scrut' b' ty' alts' - -zonkCoreAlt :: ZonkEnv -> CoreAlt -> TcM CoreAlt -zonkCoreAlt env (Alt dc bndrs rhs) - = do (env1, bndrs') <- zonkCoreBndrsX env bndrs - rhs' <- zonkCoreExpr env1 rhs - return $ Alt dc bndrs' rhs' - -zonkCoreBind :: ZonkEnv -> CoreBind -> TcM (ZonkEnv, CoreBind) -zonkCoreBind env (NonRec v e) - = do v' <- zonkIdBndr env v - e' <- zonkCoreExpr env e - let env1 = extendIdZonkEnv env v' - return (env1, NonRec v' e') -zonkCoreBind env (Rec pairs) - = do (env1, pairs') <- fixM go - return (env1, Rec pairs') - where - go ~(_, new_pairs) = do - let env1 = extendIdZonkEnvRec env (map fst new_pairs) - pairs' <- mapM (zonkCorePair env1) pairs - return (env1, pairs') - -zonkCorePair :: ZonkEnv -> (CoreBndr, CoreExpr) -> TcM (CoreBndr, CoreExpr) -zonkCorePair env (v,e) = (,) <$> zonkIdBndr env v <*> zonkCoreExpr env e - -zonkEvTypeable :: ZonkEnv -> EvTypeable -> TcM EvTypeable -zonkEvTypeable env (EvTypeableTyCon tycon e) - = do { e' <- mapM (zonkEvTerm env) e - ; return $ EvTypeableTyCon tycon e' } -zonkEvTypeable env (EvTypeableTyApp t1 t2) - = do { t1' <- zonkEvTerm env t1 - ; t2' <- zonkEvTerm env t2 - ; return (EvTypeableTyApp t1' t2') } -zonkEvTypeable env (EvTypeableTrFun tm t1 t2) - = do { tm' <- zonkEvTerm env tm - ; t1' <- zonkEvTerm env t1 - ; t2' <- zonkEvTerm env t2 - ; return (EvTypeableTrFun tm' t1' t2') } -zonkEvTypeable env (EvTypeableTyLit t1) - = do { t1' <- zonkEvTerm env t1 - ; return (EvTypeableTyLit t1') } - -zonkTcEvBinds_s :: ZonkEnv -> [TcEvBinds] -> TcM (ZonkEnv, [TcEvBinds]) -zonkTcEvBinds_s env bs = do { (env, bs') <- mapAccumLM zonk_tc_ev_binds env bs - ; return (env, [EvBinds (unionManyBags bs')]) } - -zonkTcEvBinds :: ZonkEnv -> TcEvBinds -> TcM (ZonkEnv, TcEvBinds) -zonkTcEvBinds env bs = do { (env', bs') <- zonk_tc_ev_binds env bs - ; return (env', EvBinds bs') } - -zonk_tc_ev_binds :: ZonkEnv -> TcEvBinds -> TcM (ZonkEnv, Bag EvBind) -zonk_tc_ev_binds env (TcEvBinds var) = zonkEvBindsVar env var -zonk_tc_ev_binds env (EvBinds bs) = zonkEvBinds env bs - -zonkEvBindsVar :: ZonkEnv -> EvBindsVar -> TcM (ZonkEnv, Bag EvBind) -zonkEvBindsVar env (EvBindsVar { ebv_binds = ref }) - = do { bs <- readMutVar ref - ; zonkEvBinds env (evBindMapBinds bs) } -zonkEvBindsVar env (CoEvBindsVar {}) = return (env, emptyBag) - -zonkEvBinds :: ZonkEnv -> Bag EvBind -> TcM (ZonkEnv, Bag EvBind) -zonkEvBinds env binds - = {-# SCC "zonkEvBinds" #-} - fixM (\ ~( _, new_binds) -> do - { let env1 = extendIdZonkEnvRec env (collect_ev_bndrs new_binds) - ; binds' <- mapBagM (zonkEvBind env1) binds - ; return (env1, binds') }) - where - collect_ev_bndrs :: Bag EvBind -> [EvVar] - collect_ev_bndrs = foldr add [] - add (EvBind { eb_lhs = var }) vars = var : vars - -zonkEvBind :: ZonkEnv -> EvBind -> TcM EvBind -zonkEvBind env bind@(EvBind { eb_lhs = var, eb_rhs = term }) - = do { var' <- {-# SCC "zonkEvBndr" #-} zonkEvBndr env var - - -- Optimise the common case of Refl coercions - -- See Note [Optimise coercion zonking] - -- This has a very big effect on some programs (eg #5030) - - ; term' <- case getEqPredTys_maybe (idType var') of - Just (r, ty1, ty2) | ty1 `eqType` ty2 - -> return (evCoercion (mkReflCo r ty1)) - _other -> zonkEvTerm env term - - ; return (bind { eb_lhs = var', eb_rhs = term' }) } - -{- Note [Optimise coercion zonking] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When optimising evidence binds we may come across situations where -a coercion looks like - cv = ReflCo ty -or cv1 = cv2 -where the type 'ty' is big. In such cases it is a waste of time to zonk both - * The variable on the LHS - * The coercion on the RHS -Rather, we can zonk the variable, and if its type is (ty ~ ty), we can just -use Refl on the right, ignoring the actual coercion on the RHS. - -This can have a very big effect, because the constraint solver sometimes does go -to a lot of effort to prove Refl! (Eg when solving 10+3 = 10+3; cf #5030) - - -************************************************************************ -* * - Zonking types -* * -************************************************************************ --} - -{- Note [Sharing when zonking to Type] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Problem: - - In GHC.Tc.Utils.TcMType.zonkTcTyVar, we short-circuit (Indirect ty) to - (Indirect zty), see Note [Sharing in zonking] in GHC.Tc.Utils.TcMType. But we - /can't/ do this when zonking a TcType to a Type (#15552, esp - comment:3). Suppose we have - - alpha -> alpha - where - alpha is already unified: - alpha := T{tc-tycon} Int -> Int - and T is knot-tied - - By "knot-tied" I mean that the occurrence of T is currently a TcTyCon, - but the global env contains a mapping "T" :-> T{knot-tied-tc}. See - Note [Type checking recursive type and class declarations] in - GHC.Tc.TyCl. - - Now we call zonkTcTypeToType on that (alpha -> alpha). If we follow - the same path as Note [Sharing in zonking] in GHC.Tc.Utils.TcMType, we'll - update alpha to - alpha := T{knot-tied-tc} Int -> Int - - But alas, if we encounter alpha for a /second/ time, we end up - looking at T{knot-tied-tc} and fall into a black hole. The whole - point of zonkTcTypeToType is that it produces a type full of - knot-tied tycons, and you must not look at the result!! - - To put it another way (zonkTcTypeToType . zonkTcTypeToType) is not - the same as zonkTcTypeToType. (If we distinguished TcType from - Type, this issue would have been a type error!) - -Solutions: (see #15552 for other variants) - -One possible solution is simply not to do the short-circuiting. -That has less sharing, but maybe sharing is rare. And indeed, -that usually turns out to be viable from a perf point of view - -But zonkTyVarOcc implements something a bit better - -* ZonkEnv contains ze_meta_tv_env, which maps - from a MetaTyVar (unification variable) - to a Type (not a TcType) - -* In zonkTyVarOcc, we check this map to see if we have zonked - this variable before. If so, use the previous answer; if not - zonk it, and extend the map. - -* The map is of course stateful, held in a TcRef. (That is unlike - the treatment of lexically-scoped variables in ze_tv_env and - ze_id_env.) - -* In zonkTyVarOcc we read the TcRef to look up the unification - variable: - - if we get a hit we use the zonked result; - - if not, in zonk_meta we see if the variable is `Indirect ty`, - zonk that, and update the map (in finish_meta) - But Nota Bene that the "update map" step must re-read the TcRef - (or, more precisely, use updTcRef) because the zonking of the - `Indirect ty` may have added lots of stuff to the map. See - #19668 for an example where this made an asymptotic difference! - -Is it worth the extra work of carrying ze_meta_tv_env? Some -non-systematic perf measurements suggest that compiler allocation is -reduced overall (by 0.5% or so) but compile time really doesn't -change. But in some cases it makes a HUGE difference: see test -T9198 and #19668. So yes, it seems worth it. --} - -zonkTyVarOcc :: HasDebugCallStack => ZonkEnv -> TcTyVar -> TcM Type -zonkTyVarOcc env@(ZonkEnv { ze_flexi = flexi - , ze_tv_env = tv_env - , ze_meta_tv_env = mtv_env_ref }) tv - | isTcTyVar tv - = case tcTyVarDetails tv of - SkolemTv {} -> lookup_in_tv_env - RuntimeUnk {} -> lookup_in_tv_env - MetaTv { mtv_ref = ref } - -> do { mtv_env <- readTcRef mtv_env_ref - -- See Note [Sharing when zonking to Type] - ; case lookupVarEnv mtv_env tv of - Just ty -> return ty - Nothing -> do { mtv_details <- readTcRef ref - ; zonk_meta ref mtv_details } } - | otherwise -- This should never really happen; - -- TyVars should not occur in the typechecker - = lookup_in_tv_env - - where - lookup_in_tv_env -- Look up in the env just as we do for Ids - = case lookupVarEnv tv_env tv of - Nothing -> -- TyVar/SkolemTv/RuntimeUnk that isn't in the ZonkEnv - -- This can happen for RuntimeUnk variables (which - -- should stay as RuntimeUnk), but I think it should - -- not happen for SkolemTv. - mkTyVarTy <$> updateTyVarKindM (zonkTcTypeToTypeX env) tv - - Just tv' -> return (mkTyVarTy tv') - - zonk_meta ref Flexi - = do { kind <- zonkTcTypeToTypeX env (tyVarKind tv) - ; ty <- commitFlexi flexi tv kind - ; writeMetaTyVarRef tv ref ty -- Belt and braces - ; finish_meta ty } - - zonk_meta _ (Indirect ty) - = do { zty <- zonkTcTypeToTypeX env ty - ; finish_meta zty } - - finish_meta ty - = do { updTcRef mtv_env_ref (\env -> extendVarEnv env tv ty) - ; return ty } - -lookupTyVarX :: ZonkEnv -> TcTyVar -> TyVar -lookupTyVarX (ZonkEnv { ze_tv_env = tv_env }) tv - = case lookupVarEnv tv_env tv of - Just tv -> tv - Nothing -> pprPanic "lookupTyVarOcc" (ppr tv $$ ppr tv_env) - -commitFlexi :: ZonkFlexi -> TcTyVar -> Kind -> TcM Type --- Only monadic so we can do tc-tracing -commitFlexi flexi tv zonked_kind - = case flexi of - SkolemiseFlexi -> return (mkTyVarTy (mkTyVar name zonked_kind)) - - DefaultFlexi - -- Normally, RuntimeRep variables are defaulted in TcMType.defaultTyVar - -- But that sees only type variables that appear in, say, an inferred type - -- Defaulting here in the zonker is needed to catch e.g. - -- y :: Bool - -- y = (\x -> True) undefined - -- We need *some* known RuntimeRep for the x and undefined, but no one - -- will choose it until we get here, in the zonker. - | isRuntimeRepTy zonked_kind - -> do { traceTc "Defaulting flexi tyvar to LiftedRep:" (pprTyVar tv) - ; return liftedRepTy } - | isLevityTy zonked_kind - -> do { traceTc "Defaulting flexi tyvar to Lifted:" (pprTyVar tv) - ; return liftedDataConTy } - | isMultiplicityTy zonked_kind - -> do { traceTc "Defaulting flexi tyvar to Many:" (pprTyVar tv) - ; return manyDataConTy } - | Just (ConcreteFRR origin) <- isConcreteTyVar_maybe tv - -> do { addErr $ TcRnCannotDefaultConcrete origin - ; return (anyTypeOfKind zonked_kind) } - | otherwise - -> do { traceTc "Defaulting flexi tyvar to Any:" (pprTyVar tv) - ; return (anyTypeOfKind zonked_kind) } - - RuntimeUnkFlexi - -> do { traceTc "Defaulting flexi tyvar to RuntimeUnk:" (pprTyVar tv) - ; return (mkTyVarTy (mkTcTyVar name zonked_kind RuntimeUnk)) } - -- This is where RuntimeUnks are born: - -- otherwise-unconstrained unification variables are - -- turned into RuntimeUnks as they leave the - -- typechecker's monad - - NoFlexi -> pprPanic "NoFlexi" (ppr tv <+> dcolon <+> ppr zonked_kind) - - where - name = tyVarName tv - -zonkCoVarOcc :: ZonkEnv -> CoVar -> TcM Coercion -zonkCoVarOcc (ZonkEnv { ze_tv_env = tyco_env }) cv - | Just cv' <- lookupVarEnv tyco_env cv -- don't look in the knot-tied env - = return $ mkCoVarCo cv' - | otherwise - = do { cv' <- zonkCoVar cv; return (mkCoVarCo cv') } - -zonkCoHole :: ZonkEnv -> CoercionHole -> TcM Coercion -zonkCoHole env hole@(CoercionHole { ch_ref = ref, ch_co_var = cv }) - = do { contents <- readTcRef ref - ; case contents of - Just co -> do { co' <- zonkCoToCo env co - ; checkCoercionHole cv co' } - - -- This next case should happen only in the presence of - -- (undeferred) type errors. Originally, I put in a panic - -- here, but that caused too many uses of `failIfErrsM`. - Nothing -> do { traceTc "Zonking unfilled coercion hole" (ppr hole) - ; cv' <- zonkCoVar cv - ; return $ mkCoVarCo cv' } } - -- This will be an out-of-scope variable, but keeping - -- this as a coercion hole led to #15787 - -zonk_tycomapper :: TyCoMapper ZonkEnv TcM -zonk_tycomapper = TyCoMapper - { tcm_tyvar = zonkTyVarOcc - , tcm_covar = zonkCoVarOcc - , tcm_hole = zonkCoHole - , tcm_tycobinder = \env tv _vis -> zonkTyBndrX env tv - , tcm_tycon = zonkTcTyConToTyCon } - --- Zonk a TyCon by changing a TcTyCon to a regular TyCon -zonkTcTyConToTyCon :: TcTyCon -> TcM TyCon -zonkTcTyConToTyCon tc - | isTcTyCon tc = do { thing <- tcLookupGlobalOnly (getName tc) - ; case thing of - ATyCon real_tc -> return real_tc - _ -> pprPanic "zonkTcTyCon" (ppr tc $$ ppr thing) } - | otherwise = return tc -- it's already zonked - --- Confused by zonking? See Note [What is zonking?] in GHC.Tc.Utils.TcMType. -zonkTcTypeToType :: TcType -> TcM Type -zonkTcTypeToType ty = initZonkEnv $ \ ze -> zonkTcTypeToTypeX ze ty - -zonkScaledTcTypeToTypeX :: ZonkEnv -> Scaled TcType -> TcM (Scaled TcType) -zonkScaledTcTypeToTypeX env (Scaled m ty) = Scaled <$> zonkTcTypeToTypeX env m - <*> zonkTcTypeToTypeX env ty - -zonkTcTypeToTypeX :: ZonkEnv -> TcType -> TcM Type -zonkTcTypesToTypesX :: ZonkEnv -> [TcType] -> TcM [Type] -zonkCoToCo :: ZonkEnv -> Coercion -> TcM Coercion -(zonkTcTypeToTypeX, zonkTcTypesToTypesX, zonkCoToCo, _) - = mapTyCoX zonk_tycomapper - -zonkScaledTcTypesToTypesX :: ZonkEnv -> [Scaled TcType] -> TcM [Scaled Type] -zonkScaledTcTypesToTypesX env scaled_tys = - mapM (zonkScaledTcTypeToTypeX env) scaled_tys - -zonkTcMethInfoToMethInfoX :: ZonkEnv -> TcMethInfo -> TcM MethInfo -zonkTcMethInfoToMethInfoX ze (name, ty, gdm_spec) - = do { ty' <- zonkTcTypeToTypeX ze ty - ; gdm_spec' <- zonk_gdm gdm_spec - ; return (name, ty', gdm_spec') } - where - zonk_gdm :: Maybe (DefMethSpec (SrcSpan, TcType)) - -> TcM (Maybe (DefMethSpec (SrcSpan, Type))) - zonk_gdm Nothing = return Nothing - zonk_gdm (Just VanillaDM) = return (Just VanillaDM) - zonk_gdm (Just (GenericDM (loc, ty))) - = do { ty' <- zonkTcTypeToTypeX ze ty - ; return (Just (GenericDM (loc, ty'))) } - ---------------------------------------- -{- Note [Zonking the LHS of a RULE] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -See also GHC.HsToCore.Binds Note [Free tyvars on rule LHS] - -We need to gather the type variables mentioned on the LHS so we can -quantify over them. Example: - data T a = C - - foo :: T a -> Int - foo C = 1 - - {-# RULES "myrule" foo C = 1 #-} - -After type checking the LHS becomes (foo alpha (C alpha)) and we do -not want to zap the unbound meta-tyvar 'alpha' to Any, because that -limits the applicability of the rule. Instead, we want to quantify -over it! - -We do this in two stages. - -* During zonking, we skolemise the TcTyVar 'alpha' to TyVar 'a'. We - do this by using zonkTvSkolemising as the UnboundTyVarZonker in the - ZonkEnv. (This is in fact the whole reason that the ZonkEnv has a - UnboundTyVarZonker.) - -* In GHC.HsToCore.Binds, we quantify over it. See GHC.HsToCore.Binds - Note [Free tyvars on rule LHS] - -Quantifying here is awkward because (a) the data type is big and (b) -finding the free type vars of an expression is necessarily monadic -operation. (consider /\a -> f @ b, where b is side-effected to a) --} ===================================== compiler/GHC/Types/Name/Reader.hs ===================================== @@ -68,13 +68,13 @@ module GHC.Types.Name.Reader ( -- ** Global 'RdrName' mapping elements: 'GlobalRdrElt', 'Provenance', 'ImportSpec' GlobalRdrEltX(..), GlobalRdrElt, IfGlobalRdrElt, FieldGlobalRdrElt, greName, forceGlobalRdrEnv, hydrateGlobalRdrEnv, - isLocalGRE, isRecFldGRE, + isLocalGRE, isImportedGRE, isRecFldGRE, fieldGREInfo, isDuplicateRecFldGRE, isNoFieldSelectorGRE, isFieldSelectorGRE, unQualOK, qualSpecOK, unQualSpecOK, pprNameProvenance, - vanillaGRE, localVanillaGRE, localTyConGRE, - localConLikeGRE, localFieldGREs, + mkGRE, mkExactGRE, mkLocalGRE, mkLocalVanillaGRE, mkLocalTyConGRE, + mkLocalConLikeGRE, mkLocalFieldGREs, gresToNameSet, -- ** Shadowing @@ -526,7 +526,8 @@ type GlobalRdrEnvX info = OccEnv [GlobalRdrEltX info] -- | Global Reader Element -- --- An element of the 'GlobalRdrEnv'. +-- Something in scope in the renamer; usually a member of the 'GlobalRdrEnv'. +-- See Note [GlobalRdrElt provenance]. type GlobalRdrElt = GlobalRdrEltX GREInfo @@ -538,7 +539,8 @@ type IfGlobalRdrElt = GlobalRdrEltX () -- | Global Reader Element -- --- An element of the 'GlobalRdrEnv'. +-- Something in scope in the renamer; usually a member of the 'GlobalRdrEnv'. +-- See Note [GlobalRdrElt provenance]. -- -- Why do we parametrise over the 'gre_info' field? See Note [IfGlobalRdrEnv]. data GlobalRdrEltX info @@ -546,6 +548,8 @@ data GlobalRdrEltX info , gre_par :: !Parent -- ^ See Note [Parents] , gre_lcl :: !Bool -- ^ True <=> the thing was defined locally , gre_imp :: !(Bag ImportSpec) -- ^ In scope through these imports + -- See Note [GlobalRdrElt provenance] for the relation between gre_lcl and gre_imp. + , gre_info :: info -- ^ Information the renamer knows about this particular 'Name'. -- @@ -554,8 +558,7 @@ data GlobalRdrEltX info -- -- Note [Retrieving the GREInfo from interfaces] in GHC.Types.GREInfo. } deriving (Data) - -- INVARIANT: either gre_lcl = True or gre_imp is non-empty - -- See Note [GlobalRdrElt provenance] + {- Note [IfGlobalRdrEnv] ~~~~~~~~~~~~~~~~~~~~~~~~ @@ -623,16 +626,32 @@ hasParent p _ = p {- Note [GlobalRdrElt provenance] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The gre_lcl and gre_imp fields of a GlobalRdrElt describe its "provenance", -i.e. how the Name came to be in scope. It can be in scope two ways: - - gre_lcl = True: it is bound in this module - - gre_imp: a list of all the imports that brought it into scope +i.e. how the Name came to be in scope. It can be in scope in one of the following +three ways: + + A. The Name was locally bound, in the current module. + gre_lcl = True + + The renamer adds this Name to the GlobalRdrEnv after renaming the binding. + See the calls to "extendGlobalRdrEnvRn" in GHC.Rename.Module.rnSrcDecls. + + B. The Name was imported + gre_imp = Just imps <=> brought into scope by the imports "imps" + + The renamer adds this Name to the GlobalRdrEnv after processing the imports. + See GHC.Rename.Names.filterImports and GHC.Tc.Module.tcRnImports. -It's an INVARIANT that you have one or the other; that is, either -gre_lcl is True, or gre_imp is non-empty. + C. We followed an exact reference (i.e. an Exact or Orig RdrName) + gre_lcl = False, gre_imp = Nothing -It is just possible to have *both* if there is a module loop: a Name -is defined locally in A, and also brought into scope by importing a -module that SOURCE-imported A. Example (#7672): + In this case, we directly fetch a Name and its GREInfo from direct reference. + We don't add it to the GlobalRdrEnv. See "GHC.Rename.Env.lookupExactOrOrig". + +It is just about possible to have *both* gre_lcl = True and gre_imp = Just imps. +This can happen with module loops: a Name is defined locally in A, and also +brought into scope by importing a module that SOURCE-imported A. + +Example (#7672): A.hs-boot module A where data T @@ -710,42 +729,47 @@ those. For T that will mean we have That's why plusParent picks the "best" case. -} -vanillaGRE :: (Name -> Maybe ImportSpec) -> Parent -> Name -> GlobalRdrElt -vanillaGRE prov_fn par n = +mkGRE :: (Name -> Maybe ImportSpec) -> GREInfo -> Parent -> Name -> GlobalRdrElt +mkGRE prov_fn info par n = case prov_fn n of -- Nothing => bound locally -- Just is => imported from 'is' Nothing -> GRE { gre_name = n, gre_par = par , gre_lcl = True, gre_imp = emptyBag - , gre_info = Vanilla } + , gre_info = info } Just is -> GRE { gre_name = n, gre_par = par , gre_lcl = False, gre_imp = unitBag is - , gre_info = Vanilla } + , gre_info = info } + +mkExactGRE :: Name -> GREInfo -> GlobalRdrElt +mkExactGRE nm info = + GRE { gre_name = nm, gre_par = NoParent + , gre_lcl = False, gre_imp = emptyBag + , gre_info = info } -localVanillaGRE :: Parent -> Name -> GlobalRdrElt -localVanillaGRE = vanillaGRE (const Nothing) +mkLocalGRE :: GREInfo -> Parent -> Name -> GlobalRdrElt +mkLocalGRE = mkGRE (const Nothing) + +mkLocalVanillaGRE :: Parent -> Name -> GlobalRdrElt +mkLocalVanillaGRE = mkLocalGRE Vanilla -- | Create a local 'GlobalRdrElt' for a 'TyCon'. -localTyConGRE :: TyConFlavour Name +mkLocalTyConGRE :: TyConFlavour Name -> Name -> GlobalRdrElt -localTyConGRE flav nm = - ( localVanillaGRE par nm ) - { gre_info = IAmTyCon flav } +mkLocalTyConGRE flav nm = mkLocalGRE (IAmTyCon flav) par nm where par = case tyConFlavourAssoc_maybe flav of Nothing -> NoParent Just p -> ParentIs p -localConLikeGRE :: Parent -> (ConLikeName, ConInfo) -> GlobalRdrElt -localConLikeGRE p (con_nm, con_info) = - ( localVanillaGRE p $ conLikeName_Name con_nm ) - { gre_info = IAmConLike con_info } +mkLocalConLikeGRE :: Parent -> (ConLikeName, ConInfo) -> GlobalRdrElt +mkLocalConLikeGRE p (con_nm, con_info) = + mkLocalGRE (IAmConLike con_info) p (conLikeName_Name con_nm ) -localFieldGREs :: Parent -> [(ConLikeName, ConInfo)] -> [GlobalRdrElt] -localFieldGREs p cons = - [ ( localVanillaGRE p fld_nm ) - { gre_info = IAmRecField fld_info } +mkLocalFieldGREs :: Parent -> [(ConLikeName, ConInfo)] -> [GlobalRdrElt] +mkLocalFieldGREs p cons = + [ mkLocalGRE (IAmRecField fld_info) p fld_nm | (S.Arg fld_nm fl, fl_cons) <- flds , let fld_info = RecFieldInfo { recFieldLabel = fl , recFieldCons = fl_cons } ] @@ -1147,9 +1171,17 @@ getGRE_NameQualifier_maybes env name | lcl = Nothing | otherwise = Just $ map (is_as . is_decl) (bagToList iss) +-- | Is this 'GlobalRdrElt' defined locally? isLocalGRE :: GlobalRdrEltX info -> Bool isLocalGRE (GRE { gre_lcl = lcl }) = lcl +-- | Is this 'GlobalRdrElt' imported? +-- +-- Not just the negation of 'isLocalGRE', because it might be an Exact or +-- Orig name reference. See Note [GlobalRdrElt provenance]. +isImportedGRE :: GlobalRdrEltX info -> Bool +isImportedGRE (GRE { gre_imp = imps }) = not $ isEmptyBag imps + -- | Is this a record field GRE? -- -- Important: does /not/ consult the 'GreInfo' field. ===================================== compiler/GHC/Types/TyThing.hs ===================================== @@ -287,7 +287,7 @@ tyThingLocalGREs ty_thing = ATyCon t | Just c <- tyConClass_maybe t -> myself NoParent - : ( map (localVanillaGRE (ParentIs $ className c) . getName) (classMethods c) + : ( map (mkLocalVanillaGRE (ParentIs $ className c) . getName) (classMethods c) ++ map tc_GRE (classATs c) ) | otherwise -> let dcs = tyConDataCons t @@ -296,7 +296,7 @@ tyThingLocalGREs ty_thing = in myself NoParent : map (dc_GRE par) dcs ++ - localFieldGREs par + mkLocalFieldGREs par [ (mk_nm dc, con_info) | dc <- dcs , let con_info = conLikeConInfo (RealDataCon dc) ] @@ -308,7 +308,7 @@ tyThingLocalGREs ty_thing = RealDataCon dc -> ParentIs $ tyConName $ dataConTyCon dc in myself par : - localFieldGREs par + mkLocalFieldGREs par [(conLikeConLikeName con, conLikeConInfo con)] AnId id | RecSelId { sel_tycon = RecSelData tc } <- idDetails id @@ -318,17 +318,15 @@ tyThingLocalGREs ty_thing = _ -> [ myself NoParent ] where tc_GRE :: TyCon -> GlobalRdrElt - tc_GRE at = localTyConGRE + tc_GRE at = mkLocalTyConGRE (fmap tyConName $ tyConFlavour at) (tyConName at) dc_GRE :: Parent -> DataCon -> GlobalRdrElt dc_GRE par dc = let con_info = conLikeConInfo (RealDataCon dc) - in localConLikeGRE par (DataConName $ dataConName dc, con_info) + in mkLocalConLikeGRE par (DataConName $ dataConName dc, con_info) myself :: Parent -> GlobalRdrElt - myself p = - (localVanillaGRE p (getName ty_thing)) - { gre_info = tyThingGREInfo ty_thing } + myself p = mkLocalGRE (tyThingGREInfo ty_thing) p (getName ty_thing) -- | Obtain information pertinent to the renamer about a particular 'TyThing'. -- ===================================== testsuite/driver/testlib.py ===================================== @@ -167,7 +167,7 @@ def stage1(name, opts): 'add your test to testsuite/tests/stage1 instead') # Note [Why is there no stage1 setup function?] -# +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # Presumably a stage1 setup function would signal that the stage1 # compiler should be used to compile a test. # @@ -566,8 +566,10 @@ def _extra_files(name, opts, files): # collect_stats is used in the majority case when the metrics to be collected # are about the performance of the runtime code generated by the compiler. def collect_compiler_stats(metric='all',deviation=20): - setTestOpts(no_lint) - return lambda name, opts, m=metric, d=deviation: _collect_stats(name, opts, m,d, True) + def f(name, opts, m=metric, d=deviation): + no_lint(name, opts) + return _collect_stats(name, opts, m, d, True) + return f def collect_stats(metric='all', deviation=20): return lambda name, opts, m=metric, d=deviation: _collect_stats(name, opts, m, d) ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -265,7 +265,7 @@ ifeq "$(findstring clean,$(MAKECMDGOALS))" "" endif # Note [WayFlags] -# +# ~~~~~~~~~~~~~~~ # Code that uses TemplateHaskell should either use -fexternal-interpreter, or # be built in the same way as the compiler (-prof, -dynamic or -static). # ===================================== testsuite/tests/linters/notes.stdout ===================================== @@ -15,7 +15,6 @@ ref compiler/GHC/Hs/Extension.hs:146:5: Note [Strict argument type constr ref compiler/GHC/Hs/Pat.hs:143:74: Note [Lifecycle of a splice] ref compiler/GHC/HsToCore/Pmc/Solver.hs:858:20: Note [COMPLETE sets on data families] ref compiler/GHC/HsToCore/Quote.hs:1476:7: Note [How brackets and nested splices are handled] -ref compiler/GHC/JS/Optimizer.hs:259:47: Note [Unsafe JavaScript optimizations] ref compiler/GHC/Stg/Unarise.hs:442:32: Note [Renaming during unarisation] ref compiler/GHC/StgToCmm.hs:106:18: Note [codegen-split-init] ref compiler/GHC/StgToCmm.hs:109:18: Note [pipeline-split-init] @@ -31,12 +30,8 @@ ref compiler/GHC/Tc/Gen/Splice.hs:531:35: Note [PendingRnSplice] ref compiler/GHC/Tc/Gen/Splice.hs:655:7: Note [How brackets and nested splices are handled] ref compiler/GHC/Tc/Gen/Splice.hs:888:11: Note [How brackets and nested splices are handled] ref compiler/GHC/Tc/Instance/Family.hs:474:35: Note [Constrained family instances] -ref compiler/GHC/Tc/Module.hs:711:15: Note [Extra dependencies from .hs-boot files] ref compiler/GHC/Tc/Solver/Rewrite.hs:1009:7: Note [Stability of rewriting] ref compiler/GHC/Tc/TyCl.hs:1130:6: Note [Unification variables need fresh Names] -ref compiler/GHC/Tc/TyCl.hs:4982:17: Note [Missing role annotations warning] -ref compiler/GHC/Tc/TyCl.hs:5008:3: Note [Missing role annotations warning] -ref compiler/GHC/Tc/Types.hs:692:33: Note [Extra dependencies from .hs-boot files] ref compiler/GHC/Tc/Types/Constraint.hs:226:34: Note [NonCanonical Semantics] ref compiler/GHC/Types/Demand.hs:302:25: Note [Preserving Boxity of results is rarely a win] ref compiler/GHC/Unit/Module/Deps.hs:81:13: Note [Structure of dep_boot_mods] @@ -47,10 +42,6 @@ ref docs/core-spec/core-spec.mng:177:6: Note [TyBinders] ref hadrian/src/Expression.hs:145:30: Note [Linking ghc-bin against threaded stage0 RTS] ref linters/lint-notes/Notes.hs:32:29: Note [" <> T.unpack x <> "] ref linters/lint-notes/Notes.hs:69:22: Note [...] -ref testsuite/config/ghc:276:10: Note [WayFlags] -ref testsuite/driver/testlib.py:165:10: Note [Why is there no stage1 setup function?] -ref testsuite/driver/testlib.py:169:2: Note [Why is there no stage1 setup function?] -ref testsuite/mk/boilerplate.mk:267:2: Note [WayFlags] ref testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.hs:30:27: Note [Extra TcS Untouchables] ref testsuite/tests/perf/should_run/all.T:8:6: Note [Solving from instances when interacting Dicts] ref testsuite/tests/polykinds/CuskFam.hs:16:11: Note [Unifying implicit CUSK variables] ===================================== testsuite/tests/quantified-constraints/T23333.hs ===================================== @@ -1,8 +1,25 @@ {-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE GADTs, DataKinds #-} module T23333 where +import Data.Kind +import Data.Coerce + foo1 :: (forall y. Bool ~ y) => z -> Bool foo1 x = not x foo2 :: (forall y. y ~ Bool) => z -> Bool foo2 x = not x + +-- Testcases from #16432 +t1 :: forall f b. (forall a. Coercible (f a) a) => b -> f b +t1 = coerce + +data U :: () -> Type where + MkU :: Int -> U '() + +t2 :: forall n res. (('()~n) => (Int~res)) => U n -> res +t2 (MkU n) = n + +t3 :: ((Bool~Bool) => (Char~res)) => res +t3 = 'a' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ae08b179de1e381d112dd1fbbba048bdc3ee8d1c...2e5ed7e90d4dcf069d42c6f8a0a46e0167570ff3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ae08b179de1e381d112dd1fbbba048bdc3ee8d1c...2e5ed7e90d4dcf069d42c6f8a0a46e0167570ff3 You're receiving 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 Jun 2 10:58:01 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 02 Jun 2023 06:58:01 -0400 Subject: [Git][ghc/ghc][wip/tc-lcl-env-refactor] 8 commits: Big TcLclEnv and CtLoc refactoring Message-ID: <6479cb391461_16c027180b823c379489@gitlab.mail> Matthew Pickering pushed to branch wip/tc-lcl-env-refactor at Glasgow Haskell Compiler / GHC Commits: aaa20974 by Matthew Pickering at 2023-06-02T11:57:52+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 737132db by Matthew Pickering at 2023-06-02T11:57:52+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - b7522705 by Matthew Pickering at 2023-06-02T11:57:52+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 76f46b26 by Matthew Pickering at 2023-06-02T11:57:52+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - 640a14bf by Matthew Pickering at 2023-06-02T11:57:52+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 3b6d538a by Matthew Pickering at 2023-06-02T11:57:52+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 384761a3 by Matthew Pickering at 2023-06-02T11:57:52+01:00 Remove unecessary SOURCE import - - - - - f3010ff0 by Matthew Pickering at 2023-06-02T11:57:52+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 30 changed files: - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/Plugins.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Hole/FitTypes.hs - − compiler/GHC/Tc/Errors/Hole/FitTypes.hs-boot - + compiler/GHC/Tc/Errors/Hole/Plugin.hs - + compiler/GHC/Tc/Errors/Hole/Plugin.hs-boot - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - + compiler/GHC/Tc/Errors/Types/PromotionErr.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Solve.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3876b30d3f6961119a78043649c118d3a7a456d2...f3010ff05dfab58b739c6e0d550cbefd5f610d45 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3876b30d3f6961119a78043649c118d3a7a456d2...f3010ff05dfab58b739c6e0d550cbefd5f610d45 You're receiving 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 Jun 2 11:26:29 2023 From: gitlab at gitlab.haskell.org (Torsten Schmits (@torsten.schmits)) Date: Fri, 02 Jun 2023 07:26:29 -0400 Subject: [Git][ghc/ghc][wip/torsten.schmits/23272] Filter out nontrivial substituted expressions in substTickish Message-ID: <6479d1e556d27_179783c37586950@gitlab.mail> Torsten Schmits pushed to branch wip/torsten.schmits/23272 at Glasgow Haskell Compiler / GHC Commits: 7f5b1397 by Torsten Schmits at 2023-06-02T13:26:21+02:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 5 changed files: - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Subst.hs - + testsuite/tests/simplCore/should_compile/T23272.hs - + testsuite/tests/simplCore/should_compile/T23272.script - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -64,7 +64,7 @@ import GHC.Builtin.PrimOps ( PrimOp (SeqOp) ) import GHC.Builtin.Types.Prim( realWorldStatePrimTy ) import GHC.Builtin.Names( runRWKey ) -import GHC.Data.Maybe ( isNothing, orElse ) +import GHC.Data.Maybe ( isNothing, orElse, mapMaybe ) import GHC.Data.FastString import GHC.Unit.Module ( moduleName ) import GHC.Utils.Outputable @@ -1436,7 +1436,7 @@ simplTick env tickish expr cont simplTickish env tickish | Breakpoint ext n ids <- tickish - = Breakpoint ext n (map (getDoneId . substId env) ids) + = Breakpoint ext n (mapMaybe (getDoneId . substId env) ids) | otherwise = tickish -- Push type application and coercion inside a tick @@ -1447,8 +1447,9 @@ simplTick env tickish expr cont where (inc,outc) = splitCont c splitCont other = (mkBoringStop (contHoleType other), other) - getDoneId (DoneId id) = id - getDoneId (DoneEx e _) = getIdFromTrivialExpr e -- Note [substTickish] in GHC.Core.Subst + getDoneId (DoneId id) = Just id + getDoneId (DoneEx (Var id) _) = Just id + getDoneId (DoneEx e _) = getIdFromTrivialExpr_maybe e -- Note [substTickish] in GHC.Core.Subst getDoneId other = pprPanic "getDoneId" (ppr other) -- Note [case-of-scc-of-case] ===================================== compiler/GHC/Core/Subst.hs ===================================== @@ -592,9 +592,10 @@ substDVarSet subst@(Subst _ _ tv_env cv_env) fvs ------------------ substTickish :: Subst -> CoreTickish -> CoreTickish substTickish subst (Breakpoint ext n ids) - = Breakpoint ext n (map do_one ids) + -- = Breakpoint ext n [i | Var i <- lookupIdSubst subst <$> ids] + = Breakpoint ext n (mapMaybe do_one ids) where - do_one = getIdFromTrivialExpr . lookupIdSubst subst + do_one = getIdFromTrivialExpr_maybe . lookupIdSubst subst substTickish _subst other = other {- Note [Substitute lazily] ===================================== testsuite/tests/simplCore/should_compile/T23272.hs ===================================== @@ -0,0 +1,9 @@ +module T23272 where + +class C a where +instance C () where + +bug :: (forall a. C a => a -> a) -> () +bug g = f () + where + f x = seq (g x) undefined ===================================== testsuite/tests/simplCore/should_compile/T23272.script ===================================== @@ -0,0 +1 @@ +:load T23272 ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -484,3 +484,5 @@ test('T23307a', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppres test('T23307b', normal, compile, ['-O']) test('T23307c', normal, compile, ['-O']) test('T23426', normal, compile, ['-O']) +test('T23272', [only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -O')], ghci_script, ['T23272.script']) +# test('T23272', normal, compile, ['-O -fbreak-points']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f5b1397bdf5f4b10b34b84efd893892f41e7bcb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f5b1397bdf5f4b10b34b84efd893892f41e7bcb You're receiving 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 Jun 2 11:30:52 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Fri, 02 Jun 2023 07:30:52 -0400 Subject: [Git][ghc/ghc][wip/or-pats] Play around with Match Message-ID: <6479d2ec2e4d_179783c5ddc70185@gitlab.mail> David pushed to branch wip/or-pats at Glasgow Haskell Compiler / GHC Commits: 20a338b1 by David Knothe at 2023-06-02T13:30:46+02:00 Play around with Match - - - - - 3 changed files: - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match.hs-boot - compiler/GHC/HsToCore/Match/Literal.hs Changes: ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -21,13 +21,15 @@ module GHC.HsToCore.Match ) where +import GHC.Stack import GHC.Prelude import GHC.Platform import Language.Haskell.Syntax.Basic (Boxity(..)) import {-#SOURCE#-} GHC.HsToCore.Expr (dsExpr) - +import Data.List (intercalate) +import Debug.Trace import GHC.Types.Basic ( Origin(..), isGenerated ) import GHC.Types.SourceText import GHC.Driver.DynFlags @@ -178,9 +180,20 @@ with External names (#13043). See also Note [Localise pattern binders] in GHC.HsToCore.Utils -} +-- input: equationInfo +-- output: do call to `match` (recursing into matchNew) but group the first var beforehand +-- for the call to match, construct a EqnInfo with only a single pattern and put the recursive call into the eqn_rhs. + +--matchNew :: [MatchId] +-- -> Type +-- -> [EquationInfo] +-- -> Dsm (MatchResult CoreExpr) + + + type MatchId = Id -- See Note [Match Ids] -match :: [MatchId] -- ^ Variables rep\'ing the exprs we\'re matching with +match :: HasCallStack => [MatchId] -- ^ Variables rep\'ing the exprs we\'re matching with -- ^ See Note [Match Ids] -- -- ^ Note that the Match Ids carry not only a name, but @@ -204,14 +217,22 @@ match (v:vs) ty eqns -- Eqns *can* be empty ; let platform = targetPlatform dflags -- Tidy the first pattern, generating -- auxiliary bindings if necessary + -- ; traceM ("tidy " ++ show (length eqns) ++ " " ++ (show . length . eqn_pats . head) eqns) ; (aux_binds, tidy_eqns) <- mapAndUnzipM (tidyEqnInfo v) eqns -- Group the equations and match each group in turn ; let grouped = groupEquations platform tidy_eqns + ; grouped' <- mapM (moveGroupVarsIntoRhs vs ty) grouped + + ; traceM ("Before moving: " ++ show (length grouped) ++ " groups:") + ; testPrint grouped + ; traceM ("After moving: " ++ show (length grouped') ++ " groups:") + ; testPrint grouped' + ; traceM "" -- print the view patterns that are commoned up to help debug - ; whenDOptM Opt_D_dump_view_pattern_commoning (debug grouped) + ; whenDOptM Opt_D_dump_view_pattern_commoning (debug grouped') - ; match_results <- match_groups grouped + ; match_results <- match_groups grouped' ; return $ foldr (.) id aux_binds <$> foldr1 combineMatchResults match_results } @@ -248,6 +269,15 @@ match (v:vs) ty eqns -- Eqns *can* be empty -- FIXME: we should also warn about view patterns that should be -- commoned up but are not + testPrint :: Applicative f => [NonEmpty (PatGroup, EquationInfo)] -> f () + testPrint groups = + traceM $ intercalate "\n" $ map + (\group -> intercalate " ; " $ map + (\(pg, eqn) -> (show pg ++ " " ++ (intercalate " " $ map (showSDocUnsafe . pprLPat . mklpat) (eqn_pats eqn)))) + (NEL.toList group)) + groups + mklpat pat = L noSrcSpanA pat + -- print some stuff to see what's getting grouped -- use -dppr-debug to see the resolution of overloaded literals debug eqns = @@ -267,10 +297,25 @@ matchEmpty var res_ty mk_seq fail = return $ mkWildCase (Var var) (idScaledType var) res_ty [Alt DEFAULT [] fail] +{- +f 1 2 3 = a +f 1 3 4 = b +f (1|2) 4 5 = c + +Eqn 1 2 3 -> a +Eqn 1 3 4 -> b +Eqn 1 -> $ +Eqn 2 -> $ +where $ = match 4 5 c + +match 1 -> [match {Eqn 2 3 a, Eqn 3 4 b}] +-} + + matchVariables :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) -- Real true variables, just like in matchVar, SLPJ p 94 -- No binding to do: they'll all be wildcards by now (done in tidy) -matchVariables (_ :| vars) ty eqns = match vars ty $ NEL.toList $ shiftEqns eqns +matchVariables (_ :| vars) ty eqns = return (eqn_rhs (NEL.head eqns)) -- match vars ty $ NEL.toList $ shiftEqns eqns matchBangs :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) matchBangs (var :| vars) ty eqns @@ -408,7 +453,29 @@ only these which can be assigned a PatternGroup (see patGroup). -} -tidyEqnInfo :: Id -> EquationInfo +moveGroupVarsIntoRhs :: HasCallStack => [Id] -> Type -> NonEmpty (PatGroup, EquationInfo) -> DsM (NonEmpty (PatGroup, EquationInfo)) +moveGroupVarsIntoRhs vs ty group = do + if (length . eqn_pats . snd . NEL.head) group == 1 + then return group + else do + let rest = NEL.map (\(_, eqn) -> eqn { eqn_pats = tail (eqn_pats eqn) }) group + rhs <- match vs ty (NEL.toList rest) + let (gp, eq) = NEL.head group + return $ NEL.singleton (gp, EqnInfo { eqn_pats = [head (eqn_pats eq)], eqn_orig = eqn_orig eq, eqn_rhs = rhs }) + --return $ NEL.map (\(gp, eqn) -> (gp, eqn { eqn_pats = [head (eqn_pats eqn)], eqn_rhs = combineMatchResults rhs (eqn_rhs eqn) })) group + +{- +moveVarsIntoRhs :: HasCallStack => [Id] -> Type -> EquationInfo -> DsM EquationInfo +moveVarsIntoRhs vs ty eqn + | length (eqn_pats eqn) == 0 = fail "argh" + | length (eqn_pats eqn) == 1 = do pure eqn + | otherwise = do + let eq' = eqn { eqn_pats = tail (eqn_pats eqn) } + rhs <- match vs ty [eq'] + return eqn { eqn_pats = [head (eqn_pats eqn)], eqn_rhs = combineMatchResults rhs (eqn_rhs eqn) } +-} + +tidyEqnInfo :: HasCallStack => Id -> EquationInfo -> DsM (DsWrapper, EquationInfo) -- DsM'd because of internal call to dsLHsBinds -- and mkSelectorBinds. @@ -1004,6 +1071,14 @@ data PatGroup Type -- the Type is the type of p (equivalently, the result type of e) | PgOr -- Or pattern +instance Show PatGroup where + show PgAny = "PgAny" + show (PgCon _) = "PgCon" + show (PgLit _) = "PgLit" + show (PgView _ _) = "PgView" + show PgOr = "PgOr" + show _ = "PgOther" + {- Note [Don't use Literal for PgN] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Previously we had, as PatGroup constructors ===================================== compiler/GHC/HsToCore/Match.hs-boot ===================================== @@ -1,5 +1,6 @@ module GHC.HsToCore.Match where +import GHC.Stack (HasCallStack) import GHC.Prelude import GHC.Types.Var ( Id ) import GHC.Tc.Utils.TcType ( Type ) @@ -8,7 +9,7 @@ import GHC.Core ( CoreExpr ) import GHC.Hs ( LPat, HsMatchContext, MatchGroup, LHsExpr ) import GHC.Hs.Extension ( GhcTc, GhcRn ) -match :: [Id] +match :: HasCallStack => [Id] -> Type -> [EquationInfo] -> DsM (MatchResult CoreExpr) ===================================== compiler/GHC/HsToCore/Match/Literal.hs ===================================== @@ -629,8 +629,7 @@ matchLiterals (var :| vars) ty sub_groups = do { dflags <- getDynFlags ; let platform = targetPlatform dflags ; let LitPat _ hs_lit = firstPat firstEqn - ; match_result <- match vars ty (NEL.toList $ shiftEqns eqns) - ; return (hsLitKey platform hs_lit, match_result) } + ; return (hsLitKey platform hs_lit, eqn_rhs firstEqn) } wrap_str_guard :: Id -> (Literal,MatchResult CoreExpr) -> DsM (MatchResult CoreExpr) -- Equality check for string literals View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/20a338b132d1f66bff193192aa65d40f2a90b900 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/20a338b132d1f66bff193192aa65d40f2a90b900 You're receiving 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 Jun 2 12:38:58 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 02 Jun 2023 08:38:58 -0400 Subject: [Git][ghc/ghc][wip/T22010] Fix genSym & add fetchAddWord64Addr Message-ID: <6479e2e2d9545_179783c5ddc76188@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: b28a1da8 by Jaro Reinders at 2023-06-02T14:38:44+02:00 Fix genSym & add fetchAddWord64Addr - - - - - 9 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Driver/CmdLine.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/Types/Unique/Supply.hs - compiler/cbits/genSym.c - rts/include/stg/SMP.h Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -2576,6 +2576,14 @@ primop FetchAddAddrOp_Word "fetchAddWordAddr#" GenPrimOp with has_side_effects = True can_fail = True +primop FetchAddAddrOp_Word64 "fetchAddWord64Addr#" GenPrimOp + Addr# -> Word64# -> State# s -> (# State# s, Word64# #) + {Given an address, and a value to add, + atomically add the value to the element. Returns the value of the + element before the operation. Implies a full memory barrier.} + with has_side_effects = True + can_fail = True + primop FetchSubAddrOp_Word "fetchSubWordAddr#" GenPrimOp Addr# -> Word# -> State# s -> (# State# s, Word# #) {Given an address, and a value to subtract, ===================================== compiler/GHC/Driver/CmdLine.hs ===================================== @@ -37,6 +37,7 @@ import GHC.Utils.Outputable (text) import Data.Function import Data.List (sortBy, intercalate, stripPrefix) +import Data.Word import GHC.ResponseFile import Control.Exception (IOException, catch) @@ -75,7 +76,7 @@ hoistFlag f (Flag a b c) = Flag a (go b) c go (OptPrefix k) = OptPrefix (\s -> go2 (k s)) go (OptIntSuffix k) = OptIntSuffix (\n -> go2 (k n)) go (IntSuffix k) = IntSuffix (\n -> go2 (k n)) - go (WordSuffix k) = WordSuffix (\s -> go2 (k s)) + go (Word64Suffix k) = Word64Suffix (\s -> go2 (k s)) go (FloatSuffix k) = FloatSuffix (\s -> go2 (k s)) go (PassFlag k) = PassFlag (\s -> go2 (k s)) go (AnySuffix k) = AnySuffix (\s -> go2 (k s)) @@ -98,7 +99,7 @@ data OptKind m -- Suppose the flag is -f | OptPrefix (String -> EwM m ()) -- -f or -farg (i.e. the arg is optional) | OptIntSuffix (Maybe Int -> EwM m ()) -- -f or -f=n; pass n to fn | IntSuffix (Int -> EwM m ()) -- -f or -f=n; pass n to fn - | WordSuffix (Word -> EwM m ()) -- -f or -f=n; pass n to fn + | Word64Suffix (Word64 -> EwM m ()) -- -f or -f=n; pass n to fn | FloatSuffix (Float -> EwM m ()) -- -f or -f=n; pass n to fn | PassFlag (String -> EwM m ()) -- -f; pass "-f" fn | AnySuffix (String -> EwM m ()) -- -f or -farg; pass entire "-farg" to fn @@ -240,7 +241,7 @@ processOneArg opt_kind rest arg args IntSuffix f | Just n <- parseInt rest_no_eq -> Right (f n, args) | otherwise -> Left ("malformed integer argument in " ++ dash_arg) - WordSuffix f | Just n <- parseWord rest_no_eq -> Right (f n, args) + Word64Suffix f | Just n <- parseWord64 rest_no_eq -> Right (f n, args) | otherwise -> Left ("malformed natural argument in " ++ dash_arg) FloatSuffix f | Just n <- parseFloat rest_no_eq -> Right (f n, args) @@ -269,7 +270,7 @@ arg_ok (Prefix _) _ _ = True -- Missing argument checked for in p -- to improve error message (#12625) arg_ok (OptIntSuffix _) _ _ = True arg_ok (IntSuffix _) _ _ = True -arg_ok (WordSuffix _) _ _ = True +arg_ok (Word64Suffix _) _ _ = True arg_ok (FloatSuffix _) _ _ = True arg_ok (OptPrefix _) _ _ = True arg_ok (PassFlag _) rest _ = null rest @@ -285,8 +286,8 @@ parseInt s = case reads s of ((n,""):_) -> Just n _ -> Nothing -parseWord :: String -> Maybe Word -parseWord s = case reads s of +parseWord64 :: String -> Maybe Word64 +parseWord64 s = case reads s of ((n,""):_) -> Just n _ -> Nothing ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -117,6 +117,7 @@ import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Trans.Reader (ReaderT) import Control.Monad.Trans.Writer (WriterT) import Data.IORef +import Data.Word import System.IO import System.IO.Error (catchIOError) import System.Environment (lookupEnv) @@ -449,7 +450,7 @@ data DynFlags = DynFlags { maxErrors :: Maybe Int, -- | Unique supply configuration for testing build determinism - initialUnique :: Word, + initialUnique :: Word64, uniqueIncrement :: Int, -- 'Int' because it can be used to test uniques in decreasing order. ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -276,6 +276,7 @@ import Data.List (intercalate, sortBy) import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map import qualified Data.Set as Set +import Data.Word import System.FilePath import Text.ParserCombinators.ReadP hiding (char) import Text.ParserCombinators.ReadP as R @@ -957,8 +958,8 @@ add_dep_message (OptIntSuffix f) message = OptIntSuffix $ \oi -> f oi >> deprecate message add_dep_message (IntSuffix f) message = IntSuffix $ \i -> f i >> deprecate message -add_dep_message (WordSuffix f) message = - WordSuffix $ \i -> f i >> deprecate message +add_dep_message (Word64Suffix f) message = + Word64Suffix $ \i -> f i >> deprecate message add_dep_message (FloatSuffix f) message = FloatSuffix $ \fl -> f fl >> deprecate message add_dep_message (PassFlag f) message = @@ -1735,7 +1736,7 @@ dynamic_flags_deps = [ , make_ord_flag defGhcFlag "fmax-inline-memset-insns" (intSuffix (\n d -> d { maxInlineMemsetInsns = n })) , make_ord_flag defGhcFlag "dinitial-unique" - (wordSuffix (\n d -> d { initialUnique = n })) + (word64Suffix (\n d -> d { initialUnique = n })) , make_ord_flag defGhcFlag "dunique-increment" (intSuffix (\n d -> d { uniqueIncrement = n })) @@ -2960,8 +2961,8 @@ intSuffix fn = IntSuffix (\n -> upd (fn n)) intSuffixM :: (Int -> DynFlags -> DynP DynFlags) -> OptKind (CmdLineP DynFlags) intSuffixM fn = IntSuffix (\n -> updM (fn n)) -wordSuffix :: (Word -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags) -wordSuffix fn = WordSuffix (\n -> upd (fn n)) +word64Suffix :: (Word64 -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags) +word64Suffix fn = Word64Suffix (\n -> upd (fn n)) floatSuffix :: (Float -> DynFlags -> DynFlags) -> OptKind (CmdLineP DynFlags) floatSuffix fn = FloatSuffix (\n -> upd (fn n)) ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -821,6 +821,8 @@ emitPrimOp cfg primop = FetchAddAddrOp_Word -> \[addr, n] -> opIntoRegs $ \[res] -> doAtomicAddrRMW res AMO_Add addr (bWord platform) n + FetchAddAddrOp_Word64 -> \[addr, n] -> opIntoRegs $ \[res] -> + doAtomicAddrRMW res AMO_Add addr b64 n FetchSubAddrOp_Word -> \[addr, n] -> opIntoRegs $ \[res] -> doAtomicAddrRMW res AMO_Sub addr (bWord platform) n FetchAndAddrOp_Word -> \[addr, n] -> opIntoRegs $ \[res] -> ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -1043,6 +1043,8 @@ genPrim prof bound ty op = case op of CasAddrOp_Word64 -> \[rh,rl] [a,o,oh,ol,nh,nl] -> PrimInline $ casOp2 read_u64 write_u64 (rh,rl) a o (oh,ol) (nh,nl) FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v + -- TODO: + -- FetchAddAddrOp_Word64 -> \[rh,rl] [a,i,oh,ol,nh,nl] -> PrimInline $ appT [rh,rl] "h$hs_fetchAddWord64Addr" [a,i,oh,ol,nh,nl] FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v FetchAndAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BAnd r a o v FetchNandAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr ((BNot .) . BAnd) r a o v ===================================== compiler/GHC/Types/Unique/Supply.hs ===================================== @@ -42,10 +42,18 @@ import Control.Monad import Data.Char import Data.Word import GHC.Exts( Ptr(..), noDuplicate#, oneShot ) +import Foreign.Storable +import GHC.Word (Word64(..)) + +#include "MachDeps.h" + #if MIN_VERSION_GLASGOW_HASKELL(9,1,0,0) -import GHC.Exts( Int(..), word2Int#, fetchAddWordAddr#, plusWord#, readWordOffAddr# ) +#if WORD_SIZE_IN_BITS < 64 +import GHC.Exts( fetchAddWord64Addr#, plusWord64#, readWord64OffAddr# ) +#else +import GHC.Exts( fetchAddWordAddr#, plusWord#, readWordOffAddr# ) +#endif #endif -import Foreign.Storable #include "Unique.h" @@ -223,30 +231,37 @@ mkSplitUniqSupply c }}}} #if !MIN_VERSION_GLASGOW_HASKELL(9,1,0,0) -foreign import ccall unsafe "genSym" genSym :: IO Word64 -- TODO: Word64 is a lie +foreign import ccall unsafe "genSym" genSym :: IO Word64 #else genSym :: IO Word64 genSym = do let !mask = (1 `unsafeShiftL` uNIQUE_BITS) - 1 let !(Ptr counter) = ghc_unique_counter let !(Ptr inc_ptr) = ghc_unique_inc +#if WORD_SIZE_IN_BITS < 64 + u <- IO $ \s0 -> case readWord64OffAddr# inc_ptr 0# s0 of + (# s1, inc #) -> case fetchAddWord64Addr# counter inc s1 of + (# s2, val #) -> + let !u = W64# (val `plusWord64#` inc) .&. mask +#else u <- IO $ \s0 -> case readWordOffAddr# inc_ptr 0# s0 of (# s1, inc #) -> case fetchAddWordAddr# counter inc s1 of (# s2, val #) -> - let !u = I# (word2Int# (val `plusWord#` inc)) .&. mask + let !u = W64# (val `plusWord#` inc) .&. mask +#endif in (# s2, u #) #if defined(DEBUG) -- Uh oh! We will overflow next time a unique is requested. -- (Note that if the increment isn't 1 we may miss this check) massert (u /= mask) #endif - return (undefined u) + return u #endif -foreign import ccall unsafe "&ghc_unique_counter" ghc_unique_counter :: Ptr Word +foreign import ccall unsafe "&ghc_unique_counter" ghc_unique_counter :: Ptr Word64 foreign import ccall unsafe "&ghc_unique_inc" ghc_unique_inc :: Ptr Int -initUniqSupply :: Word -> Int -> IO () +initUniqSupply :: Word64 -> Int -> IO () initUniqSupply counter inc = do poke ghc_unique_counter counter poke ghc_unique_inc inc @@ -254,7 +269,7 @@ initUniqSupply counter inc = do uniqFromMask :: Char -> IO Unique uniqFromMask !mask = do { uqNum <- genSym - ; return $! mkUnique mask uqNum } + ; return $! mkUnique64 mask uqNum } {-# NOINLINE uniqFromMask #-} -- We'll unbox everything, but we don't want to inline it splitUniqSupply :: UniqSupply -> (UniqSupply, UniqSupply) ===================================== compiler/cbits/genSym.c ===================================== @@ -10,15 +10,15 @@ // The CPP is thus about the RTS version GHC is linked against, and not the // version of the GHC being built. #if !MIN_VERSION_GLASGOW_HASKELL(9,3,0,0) -HsInt ghc_unique_counter = 0; +HsWord64 ghc_unique_counter = 0; HsInt ghc_unique_inc = 1; #endif -#define UNIQUE_BITS (sizeof (HsInt) * 8 - UNIQUE_TAG_BITS) +#define UNIQUE_BITS (sizeof (HsWord64) * 8 - UNIQUE_TAG_BITS) #define UNIQUE_MASK ((1ULL << UNIQUE_BITS) - 1) -HsInt genSym(void) { - HsInt u = atomic_inc((StgWord *)&ghc_unique_counter, ghc_unique_inc) & UNIQUE_MASK; +HsWord64 genSym(void) { + HsWord64 u = atomic_inc64((StgWord *)&ghc_unique_counter, ghc_unique_inc) & UNIQUE_MASK; // Uh oh! We will overflow next time a unique is requested. ASSERT(u != UNIQUE_MASK); return u; ===================================== rts/include/stg/SMP.h ===================================== @@ -87,6 +87,15 @@ EXTERN_INLINE StgWord cas_seq_cst_relaxed(StgVolatilePtr p, StgWord o, StgWord n EXTERN_INLINE StgWord atomic_inc(StgVolatilePtr p, StgWord n); +/* + * Atomic 64-bit addition of by the provided quantity + * + * atomic_inc64(p, n) { + * return ((*p) += n); + * } + */ +EXTERN_INLINE StgWord64 atomic_inc64(StgVolatilePtr p, StgWord64 n); + /* * Atomic decrement * @@ -430,6 +439,16 @@ atomic_inc(StgVolatilePtr p, StgWord incr) #endif } +EXTERN_INLINE StgWord64 +atomic_inc64(StgVolatilePtr p, StgWord64 incr) +{ +#if defined(HAVE_C11_ATOMICS) + return __atomic_add_fetch(p, incr, __ATOMIC_SEQ_CST); +#else + return __sync_add_and_fetch(p, incr); +#endif +} + EXTERN_INLINE StgWord atomic_dec(StgVolatilePtr p) { @@ -659,6 +678,14 @@ atomic_inc(StgVolatilePtr p, StgWord incr) } +EXTERN_INLINE StgWord atomic_inc64(StgVolatilePtr p, StgWord64 incr); +EXTERN_INLINE StgWord64 +atomic_inc64(StgVolatilePtr p, StgWord64 incr) +{ + return ((*p) += incr); +} + + INLINE_HEADER StgWord atomic_dec(StgVolatilePtr p) { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b28a1da8b92cf2d5cde4faeec273702b20615364 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b28a1da8b92cf2d5cde4faeec273702b20615364 You're receiving 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 Jun 2 12:47:45 2023 From: gitlab at gitlab.haskell.org (Torsten Schmits (@torsten.schmits)) Date: Fri, 02 Jun 2023 08:47:45 -0400 Subject: [Git][ghc/ghc][wip/torsten.schmits/23272] Filter out nontrivial substituted expressions in substTickish Message-ID: <6479e4f1158de_179783c3a00878e8@gitlab.mail> Torsten Schmits pushed to branch wip/torsten.schmits/23272 at Glasgow Haskell Compiler / GHC Commits: e3e5c6c7 by Torsten Schmits at 2023-06-02T14:47:15+02:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 6 changed files: - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Subst.hs - testsuite/tests/ghci/scripts/T8042recomp.script - + testsuite/tests/simplCore/should_compile/T23272.hs - + testsuite/tests/simplCore/should_compile/T23272.script - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -64,7 +64,7 @@ import GHC.Builtin.PrimOps ( PrimOp (SeqOp) ) import GHC.Builtin.Types.Prim( realWorldStatePrimTy ) import GHC.Builtin.Names( runRWKey ) -import GHC.Data.Maybe ( isNothing, orElse ) +import GHC.Data.Maybe ( isNothing, orElse, mapMaybe ) import GHC.Data.FastString import GHC.Unit.Module ( moduleName ) import GHC.Utils.Outputable @@ -1436,7 +1436,7 @@ simplTick env tickish expr cont simplTickish env tickish | Breakpoint ext n ids <- tickish - = Breakpoint ext n (map (getDoneId . substId env) ids) + = Breakpoint ext n (mapMaybe (getDoneId . substId env) ids) | otherwise = tickish -- Push type application and coercion inside a tick @@ -1447,8 +1447,9 @@ simplTick env tickish expr cont where (inc,outc) = splitCont c splitCont other = (mkBoringStop (contHoleType other), other) - getDoneId (DoneId id) = id - getDoneId (DoneEx e _) = getIdFromTrivialExpr e -- Note [substTickish] in GHC.Core.Subst + getDoneId (DoneId id) = Just id + getDoneId (DoneEx (Var id) _) = Just id + getDoneId (DoneEx e _) = getIdFromTrivialExpr_maybe e -- Note [substTickish] in GHC.Core.Subst getDoneId other = pprPanic "getDoneId" (ppr other) -- Note [case-of-scc-of-case] ===================================== compiler/GHC/Core/Subst.hs ===================================== @@ -592,9 +592,10 @@ substDVarSet subst@(Subst _ _ tv_env cv_env) fvs ------------------ substTickish :: Subst -> CoreTickish -> CoreTickish substTickish subst (Breakpoint ext n ids) - = Breakpoint ext n (map do_one ids) + -- = Breakpoint ext n [i | Var i <- lookupIdSubst subst <$> ids] + = Breakpoint ext n (mapMaybe do_one ids) where - do_one = getIdFromTrivialExpr . lookupIdSubst subst + do_one = getIdFromTrivialExpr_maybe . lookupIdSubst subst substTickish _subst other = other {- Note [Substitute lazily] ===================================== testsuite/tests/ghci/scripts/T8042recomp.script ===================================== @@ -1,7 +1,7 @@ :set -v1 System.IO.writeFile "T8042B.hs" "module T8042B where { fooB = \"T8042B\"; }" System.IO.writeFile "T8042A.hs" "module T8042A where { import T8042B; run = putStrLn fooB }" -:set -fobject-code +:set -fobject-code -fbreak-points :load T8042A :load *T8042A :break run ===================================== testsuite/tests/simplCore/should_compile/T23272.hs ===================================== @@ -0,0 +1,9 @@ +module T23272 where + +class C a where +instance C () where + +bug :: (forall a. C a => a -> a) -> () +bug g = f () + where + f x = seq (g x) undefined ===================================== testsuite/tests/simplCore/should_compile/T23272.script ===================================== @@ -0,0 +1 @@ +:load T23272 ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -484,3 +484,5 @@ test('T23307a', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppres test('T23307b', normal, compile, ['-O']) test('T23307c', normal, compile, ['-O']) test('T23426', normal, compile, ['-O']) +test('T23272', [only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -O')], ghci_script, ['T23272.script']) +# test('T23272', normal, compile, ['-O -fbreak-points']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e3e5c6c79860f80859876625d5ec25c46b784601 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e3e5c6c79860f80859876625d5ec25c46b784601 You're receiving 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 Jun 2 12:56:00 2023 From: gitlab at gitlab.haskell.org (Torsten Schmits (@torsten.schmits)) Date: Fri, 02 Jun 2023 08:56:00 -0400 Subject: [Git][ghc/ghc][wip/torsten.schmits/23272] Filter out nontrivial substituted expressions in substTickish Message-ID: <6479e6e09b8e6_179783c3744882fe@gitlab.mail> Torsten Schmits pushed to branch wip/torsten.schmits/23272 at Glasgow Haskell Compiler / GHC Commits: e961d9ff by Torsten Schmits at 2023-06-02T14:50:47+02:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 6 changed files: - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Subst.hs - testsuite/tests/ghci/scripts/T8042recomp.script - + testsuite/tests/simplCore/should_compile/T23272.hs - + testsuite/tests/simplCore/should_compile/T23272.script - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -64,7 +64,7 @@ import GHC.Builtin.PrimOps ( PrimOp (SeqOp) ) import GHC.Builtin.Types.Prim( realWorldStatePrimTy ) import GHC.Builtin.Names( runRWKey ) -import GHC.Data.Maybe ( isNothing, orElse ) +import GHC.Data.Maybe ( isNothing, orElse, mapMaybe ) import GHC.Data.FastString import GHC.Unit.Module ( moduleName ) import GHC.Utils.Outputable @@ -1436,7 +1436,7 @@ simplTick env tickish expr cont simplTickish env tickish | Breakpoint ext n ids <- tickish - = Breakpoint ext n (map (getDoneId . substId env) ids) + = Breakpoint ext n (mapMaybe (getDoneId . substId env) ids) | otherwise = tickish -- Push type application and coercion inside a tick @@ -1447,8 +1447,9 @@ simplTick env tickish expr cont where (inc,outc) = splitCont c splitCont other = (mkBoringStop (contHoleType other), other) - getDoneId (DoneId id) = id - getDoneId (DoneEx e _) = getIdFromTrivialExpr e -- Note [substTickish] in GHC.Core.Subst + getDoneId (DoneId id) = Just id + getDoneId (DoneEx (Var id) _) = Just id + getDoneId (DoneEx e _) = getIdFromTrivialExpr_maybe e -- Note [substTickish] in GHC.Core.Subst getDoneId other = pprPanic "getDoneId" (ppr other) -- Note [case-of-scc-of-case] ===================================== compiler/GHC/Core/Subst.hs ===================================== @@ -592,9 +592,10 @@ substDVarSet subst@(Subst _ _ tv_env cv_env) fvs ------------------ substTickish :: Subst -> CoreTickish -> CoreTickish substTickish subst (Breakpoint ext n ids) - = Breakpoint ext n (map do_one ids) + -- = Breakpoint ext n [i | Var i <- lookupIdSubst subst <$> ids] + = Breakpoint ext n (mapMaybe do_one ids) where - do_one = getIdFromTrivialExpr . lookupIdSubst subst + do_one = getIdFromTrivialExpr_maybe . lookupIdSubst subst substTickish _subst other = other {- Note [Substitute lazily] ===================================== testsuite/tests/ghci/scripts/T8042recomp.script ===================================== @@ -1,7 +1,7 @@ :set -v1 System.IO.writeFile "T8042B.hs" "module T8042B where { fooB = \"T8042B\"; }" System.IO.writeFile "T8042A.hs" "module T8042A where { import T8042B; run = putStrLn fooB }" -:set -fobject-code +:set -fobject-code -fbreak-points :load T8042A :load *T8042A :break run ===================================== testsuite/tests/simplCore/should_compile/T23272.hs ===================================== @@ -0,0 +1,9 @@ +module T23272 where + +class C a where +instance C () where + +bug :: (forall a. C a => a -> a) -> () +bug g = f () + where + f x = seq (g x) undefined ===================================== testsuite/tests/simplCore/should_compile/T23272.script ===================================== @@ -0,0 +1 @@ +:load T23272 ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -484,3 +484,4 @@ test('T23307a', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppres test('T23307b', normal, compile, ['-O']) test('T23307c', normal, compile, ['-O']) test('T23426', normal, compile, ['-O']) +test('T23272', [only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -O')], ghci_script, ['T23272.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e961d9ff83ab391fbf2980f830fbf3ecbfc15866 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e961d9ff83ab391fbf2980f830fbf3ecbfc15866 You're receiving 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 Jun 2 12:57:24 2023 From: gitlab at gitlab.haskell.org (Torsten Schmits (@torsten.schmits)) Date: Fri, 02 Jun 2023 08:57:24 -0400 Subject: [Git][ghc/ghc][wip/torsten.schmits/23272] Filter out nontrivial substituted expressions in substTickish Message-ID: <6479e734d4464_179783c376c886bd@gitlab.mail> Torsten Schmits pushed to branch wip/torsten.schmits/23272 at Glasgow Haskell Compiler / GHC Commits: 32d304dc by Torsten Schmits at 2023-06-02T14:57:00+02:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 5 changed files: - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Subst.hs - + testsuite/tests/simplCore/should_compile/T23272.hs - + testsuite/tests/simplCore/should_compile/T23272.script - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -64,7 +64,7 @@ import GHC.Builtin.PrimOps ( PrimOp (SeqOp) ) import GHC.Builtin.Types.Prim( realWorldStatePrimTy ) import GHC.Builtin.Names( runRWKey ) -import GHC.Data.Maybe ( isNothing, orElse ) +import GHC.Data.Maybe ( isNothing, orElse, mapMaybe ) import GHC.Data.FastString import GHC.Unit.Module ( moduleName ) import GHC.Utils.Outputable @@ -1436,7 +1436,7 @@ simplTick env tickish expr cont simplTickish env tickish | Breakpoint ext n ids <- tickish - = Breakpoint ext n (map (getDoneId . substId env) ids) + = Breakpoint ext n (mapMaybe (getDoneId . substId env) ids) | otherwise = tickish -- Push type application and coercion inside a tick @@ -1447,8 +1447,9 @@ simplTick env tickish expr cont where (inc,outc) = splitCont c splitCont other = (mkBoringStop (contHoleType other), other) - getDoneId (DoneId id) = id - getDoneId (DoneEx e _) = getIdFromTrivialExpr e -- Note [substTickish] in GHC.Core.Subst + getDoneId (DoneId id) = Just id + getDoneId (DoneEx (Var id) _) = Just id + getDoneId (DoneEx e _) = getIdFromTrivialExpr_maybe e -- Note [substTickish] in GHC.Core.Subst getDoneId other = pprPanic "getDoneId" (ppr other) -- Note [case-of-scc-of-case] ===================================== compiler/GHC/Core/Subst.hs ===================================== @@ -592,9 +592,10 @@ substDVarSet subst@(Subst _ _ tv_env cv_env) fvs ------------------ substTickish :: Subst -> CoreTickish -> CoreTickish substTickish subst (Breakpoint ext n ids) - = Breakpoint ext n (map do_one ids) + -- = Breakpoint ext n [i | Var i <- lookupIdSubst subst <$> ids] + = Breakpoint ext n (mapMaybe do_one ids) where - do_one = getIdFromTrivialExpr . lookupIdSubst subst + do_one = getIdFromTrivialExpr_maybe . lookupIdSubst subst substTickish _subst other = other {- Note [Substitute lazily] ===================================== testsuite/tests/simplCore/should_compile/T23272.hs ===================================== @@ -0,0 +1,9 @@ +module T23272 where + +class C a where +instance C () where + +bug :: (forall a. C a => a -> a) -> () +bug g = f () + where + f x = seq (g x) undefined ===================================== testsuite/tests/simplCore/should_compile/T23272.script ===================================== @@ -0,0 +1 @@ +:load T23272 ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -484,3 +484,4 @@ test('T23307a', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppres test('T23307b', normal, compile, ['-O']) test('T23307c', normal, compile, ['-O']) test('T23426', normal, compile, ['-O']) +test('T23272', [only_ways(['ghci']), extra_hc_opts('-fno-unoptimized-core-for-interpreter -O')], ghci_script, ['T23272.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/32d304dce9933623e2c53e81d32950f7649478fe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/32d304dce9933623e2c53e81d32950f7649478fe You're receiving 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 Jun 2 13:07:44 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 02 Jun 2023 09:07:44 -0400 Subject: [Git][ghc/ghc][master] cleanup: Remove unused field from SelfBoot Message-ID: <6479e9a0e2151_179783c39ec931a3@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 8 changed files: - compiler/GHC/IfaceToCore.hs - compiler/GHC/JS/Optimizer.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/Types.hs - testsuite/driver/testlib.py - testsuite/mk/boilerplate.mk - testsuite/tests/linters/notes.stdout Changes: ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -114,7 +114,6 @@ import GHC.Types.Var as Var import GHC.Types.Var.Set import GHC.Types.Name import GHC.Types.Name.Env -import GHC.Types.Name.Set import GHC.Types.Id import GHC.Types.Id.Make import GHC.Types.Id.Info @@ -568,7 +567,7 @@ tcHiBootIface hsc_src mod then do { (_, hug) <- getEpsAndHug ; case lookupHugByModule mod hug of Just info | mi_boot (hm_iface info) == IsBoot - -> mkSelfBootInfo (hm_iface info) (hm_details info) + -> return $ SelfBoot { sb_mds = hm_details info } _ -> return NoSelfBoot } else do @@ -584,7 +583,7 @@ tcHiBootIface hsc_src mod ; case read_result of { Succeeded (iface, _path) -> do { tc_iface <- initIfaceTcRn $ typecheckIface iface - ; mkSelfBootInfo iface tc_iface } ; + ; return $ SelfBoot { sb_mds = tc_iface } } ; Failed err -> -- There was no hi-boot file. But if there is circularity in @@ -613,29 +612,6 @@ tcHiBootIface hsc_src mod need = text "Need the hi-boot interface for" <+> ppr mod <+> text "to compare against the Real Thing" -mkSelfBootInfo :: ModIface -> ModDetails -> TcRn SelfBootInfo -mkSelfBootInfo iface mds - = do -- NB: This is computed DIRECTLY from the ModIface rather - -- than from the ModDetails, so that we can query 'sb_tcs' - -- WITHOUT forcing the contents of the interface. - let tcs = map ifName - . filter isIfaceTyCon - . map snd - $ mi_decls iface - return $ SelfBoot { sb_mds = mds - , sb_tcs = mkNameSet tcs } - where - -- Returns @True@ if, when you call 'tcIfaceDecl' on - -- this 'IfaceDecl', an ATyCon would be returned. - -- NB: This code assumes that a TyCon cannot be implicit. - isIfaceTyCon IfaceId{} = False - isIfaceTyCon IfaceData{} = True - isIfaceTyCon IfaceSynonym{} = True - isIfaceTyCon IfaceFamily{} = True - isIfaceTyCon IfaceClass{} = True - isIfaceTyCon IfaceAxiom{} = False - isIfaceTyCon IfacePatSyn{} = False - {- ************************************************************************ * * ===================================== compiler/GHC/JS/Optimizer.hs ===================================== @@ -47,9 +47,8 @@ import GHC.JS.Syntax import Control.Arrow {- -Note [ Unsafe JavaScript Optimizations ] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - +Note [Unsafe JavaScript optimizations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ There are a number of optimizations that the JavaScript Backend performs that are not sound with respect to arbritrary JavaScript. We still perform these optimizations because we are not optimizing arbritrary javascript and under the ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -699,9 +699,6 @@ tcRnHsBootDecls boot_or_sig decls , hs_valds = XValBindsLR (NValBinds val_binds val_sigs) }) <- rnTopSrcDecls first_group - -- The empty list is for extra dependencies coming from .hs-boot files - -- See Note [Extra dependencies from .hs-boot files] in GHC.Rename.Module - ; (gbl_env, lie) <- setGblEnv tcg_env $ captureTopConstraints $ do { -- NB: setGblEnv **before** captureTopConstraints so that -- if the latter reports errors, it knows what's in scope ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -5021,7 +5021,7 @@ checkValidRoleAnnots role_annots tc = whenIsJust role_annot_decl_maybe illegalRoleAnnotDecl -- Note [Missing role annotations warning] --- +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- We warn about missing role annotations for tycons -- 1. not type-classes: -- type classes are nominal by default, which is most conservative ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -695,10 +695,7 @@ instance ContainsModule TcGblEnv where data SelfBootInfo = NoSelfBoot -- No corresponding hi-boot file | SelfBoot - { sb_mds :: ModDetails -- There was a hi-boot file, - , sb_tcs :: NameSet } -- defining these TyCons, --- What is sb_tcs used for? See Note [Extra dependencies from .hs-boot files] --- in GHC.Rename.Module + { sb_mds :: ModDetails } -- There was a hi-boot file bootExports :: SelfBootInfo -> NameSet bootExports boot = ===================================== testsuite/driver/testlib.py ===================================== @@ -167,7 +167,7 @@ def stage1(name, opts): 'add your test to testsuite/tests/stage1 instead') # Note [Why is there no stage1 setup function?] -# +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # Presumably a stage1 setup function would signal that the stage1 # compiler should be used to compile a test. # ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -265,7 +265,7 @@ ifeq "$(findstring clean,$(MAKECMDGOALS))" "" endif # Note [WayFlags] -# +# ~~~~~~~~~~~~~~~ # Code that uses TemplateHaskell should either use -fexternal-interpreter, or # be built in the same way as the compiler (-prof, -dynamic or -static). # ===================================== testsuite/tests/linters/notes.stdout ===================================== @@ -15,7 +15,6 @@ ref compiler/GHC/Hs/Extension.hs:146:5: Note [Strict argument type constr ref compiler/GHC/Hs/Pat.hs:143:74: Note [Lifecycle of a splice] ref compiler/GHC/HsToCore/Pmc/Solver.hs:858:20: Note [COMPLETE sets on data families] ref compiler/GHC/HsToCore/Quote.hs:1476:7: Note [How brackets and nested splices are handled] -ref compiler/GHC/JS/Optimizer.hs:259:47: Note [Unsafe JavaScript optimizations] ref compiler/GHC/Stg/Unarise.hs:442:32: Note [Renaming during unarisation] ref compiler/GHC/StgToCmm.hs:106:18: Note [codegen-split-init] ref compiler/GHC/StgToCmm.hs:109:18: Note [pipeline-split-init] @@ -31,12 +30,8 @@ ref compiler/GHC/Tc/Gen/Splice.hs:531:35: Note [PendingRnSplice] ref compiler/GHC/Tc/Gen/Splice.hs:655:7: Note [How brackets and nested splices are handled] ref compiler/GHC/Tc/Gen/Splice.hs:888:11: Note [How brackets and nested splices are handled] ref compiler/GHC/Tc/Instance/Family.hs:474:35: Note [Constrained family instances] -ref compiler/GHC/Tc/Module.hs:711:15: Note [Extra dependencies from .hs-boot files] ref compiler/GHC/Tc/Solver/Rewrite.hs:1009:7: Note [Stability of rewriting] ref compiler/GHC/Tc/TyCl.hs:1130:6: Note [Unification variables need fresh Names] -ref compiler/GHC/Tc/TyCl.hs:4982:17: Note [Missing role annotations warning] -ref compiler/GHC/Tc/TyCl.hs:5008:3: Note [Missing role annotations warning] -ref compiler/GHC/Tc/Types.hs:692:33: Note [Extra dependencies from .hs-boot files] ref compiler/GHC/Tc/Types/Constraint.hs:226:34: Note [NonCanonical Semantics] ref compiler/GHC/Types/Demand.hs:302:25: Note [Preserving Boxity of results is rarely a win] ref compiler/GHC/Unit/Module/Deps.hs:81:13: Note [Structure of dep_boot_mods] @@ -47,10 +42,6 @@ ref docs/core-spec/core-spec.mng:177:6: Note [TyBinders] ref hadrian/src/Expression.hs:145:30: Note [Linking ghc-bin against threaded stage0 RTS] ref linters/lint-notes/Notes.hs:32:29: Note [" <> T.unpack x <> "] ref linters/lint-notes/Notes.hs:69:22: Note [...] -ref testsuite/config/ghc:276:10: Note [WayFlags] -ref testsuite/driver/testlib.py:165:10: Note [Why is there no stage1 setup function?] -ref testsuite/driver/testlib.py:169:2: Note [Why is there no stage1 setup function?] -ref testsuite/mk/boilerplate.mk:267:2: Note [WayFlags] ref testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.hs:30:27: Note [Extra TcS Untouchables] ref testsuite/tests/perf/should_run/all.T:8:6: Note [Solving from instances when interacting Dicts] ref testsuite/tests/polykinds/CuskFam.hs:16:11: Note [Unifying implicit CUSK variables] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f6e060ccc37effcc28acc76d841ad364b009cce7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f6e060ccc37effcc28acc76d841ad364b009cce7 You're receiving 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 Jun 2 13:08:36 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 02 Jun 2023 09:08:36 -0400 Subject: [Git][ghc/ghc][master] Delete GHC.Tc.Utils.Zonk Message-ID: <6479e9d472e24_179783c3a0096529@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 1 changed file: - − compiler/GHC/Tc/Utils/Zonk.hs Changes: ===================================== compiler/GHC/Tc/Utils/Zonk.hs deleted ===================================== @@ -1,1938 +0,0 @@ - -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE TypeFamilies #-} - -{-# OPTIONS_GHC -Wno-incomplete-record-updates #-} - -{- -(c) The University of Glasgow 2006 -(c) The AQUA Project, Glasgow University, 1996-1998 - --} - --- | Specialisations of the @HsSyn@ syntax for the typechecker --- --- This module is an extension of @HsSyn@ syntax, for use in the type checker. -module GHC.Tc.Utils.Zonk ( - -- * Other HsSyn functions - mkHsDictLet, mkHsApp, - mkHsAppTy, mkHsCaseAlt, - tcShortCutLit, shortCutLit, hsOverLitName, - conLikeResTy, - - -- * re-exported from TcMonad - TcId, TcIdSet, - - -- * Zonking - -- | For a description of "zonking", see Note [What is zonking?] - -- in "GHC.Tc.Utils.TcMType" - zonkTopDecls, zonkTopExpr, zonkTopLExpr, - zonkTopBndrs, - ZonkEnv, ZonkFlexi(..), emptyZonkEnv, mkEmptyZonkEnv, initZonkEnv, - zonkTyVarBindersX, zonkTyVarBinderX, - zonkTyBndrs, zonkTyBndrsX, - zonkTcTypeToType, zonkTcTypeToTypeX, - zonkTcTypesToTypesX, zonkScaledTcTypesToTypesX, - zonkTyVarOcc, - zonkCoToCo, - zonkEvBinds, zonkTcEvBinds, - zonkTcMethInfoToMethInfoX, - lookupTyVarX - ) where - -import GHC.Prelude - -import GHC.Platform - -import GHC.Builtin.Types -import GHC.Builtin.Names - -import GHC.Hs - -import {-# SOURCE #-} GHC.Tc.Gen.Splice (runTopSplice) -import GHC.Tc.Utils.Monad -import GHC.Tc.TyCl.Build ( TcMethInfo, MethInfo ) -import GHC.Tc.Utils.TcType -import GHC.Tc.Utils.TcMType -import GHC.Tc.Utils.Env ( tcLookupGlobalOnly ) -import GHC.Tc.Types.Evidence -import GHC.Tc.Errors.Types - -import GHC.Core.TyCo.Ppr ( pprTyVar ) -import GHC.Core.TyCon -import GHC.Core.Type -import GHC.Core.Coercion -import GHC.Core.ConLike -import GHC.Core.DataCon - -import GHC.Utils.Outputable -import GHC.Utils.Misc -import GHC.Utils.Panic -import GHC.Utils.Panic.Plain - -import GHC.Core.Multiplicity -import GHC.Core -import GHC.Core.Predicate - -import GHC.Types.Name -import GHC.Types.Name.Env -import GHC.Types.Var -import GHC.Types.Var.Env -import GHC.Types.Id -import GHC.Types.TypeEnv -import GHC.Types.SourceText -import GHC.Types.Basic -import GHC.Types.SrcLoc -import GHC.Types.Unique.FM -import GHC.Types.TyThing -import GHC.Driver.DynFlags( getDynFlags, targetPlatform ) - -import GHC.Data.Maybe -import GHC.Data.Bag - -import Control.Monad -import Data.List ( partition ) -import Control.Arrow ( second ) - -{- ********************************************************************* -* * - Short-cuts for overloaded numeric literals -* * -********************************************************************* -} - --- Overloaded literals. Here mainly because it uses isIntTy etc - -{- Note [Short cut for overloaded literals] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -A literal like "3" means (fromInteger @ty (dNum :: Num ty) (3::Integer)). -But if we have a list like - [4,2,3,2,4,4,2]::[Int] -we use a lot of compile time and space generating and solving all those Num -constraints, and generating calls to fromInteger etc. Better just to cut to -the chase, and cough up an Int literal. Large collections of literals like this -sometimes appear in source files, so it's quite a worthwhile fix. - -So we try to take advantage of whatever nearby type information we have, -to short-cut the process for built-in types. We can do this in two places; - -* In the typechecker, when we are about to typecheck the literal. -* If that fails, in the desugarer, once we know the final type. --} - -tcShortCutLit :: HsOverLit GhcRn -> ExpRhoType -> TcM (Maybe (HsOverLit GhcTc)) -tcShortCutLit lit@(OverLit { ol_val = val, ol_ext = OverLitRn rebindable _}) exp_res_ty - | not rebindable - , Just res_ty <- checkingExpType_maybe exp_res_ty - = do { dflags <- getDynFlags - ; let platform = targetPlatform dflags - ; case shortCutLit platform val res_ty of - Just expr -> return $ Just $ - lit { ol_ext = OverLitTc False expr res_ty } - Nothing -> return Nothing } - | otherwise - = return Nothing - -shortCutLit :: Platform -> OverLitVal -> TcType -> Maybe (HsExpr GhcTc) -shortCutLit platform val res_ty - = case val of - HsIntegral int_lit -> go_integral int_lit - HsFractional frac_lit -> go_fractional frac_lit - HsIsString s src -> go_string s src - where - go_integral int@(IL src neg i) - | isIntTy res_ty && platformInIntRange platform i - = Just (HsLit noAnn (HsInt noExtField int)) - | isWordTy res_ty && platformInWordRange platform i - = Just (mkLit wordDataCon (HsWordPrim src i)) - | isIntegerTy res_ty - = Just (HsLit noAnn (HsInteger src i res_ty)) - | otherwise - = go_fractional (integralFractionalLit neg i) - -- The 'otherwise' case is important - -- Consider (3 :: Float). Syntactically it looks like an IntLit, - -- so we'll call shortCutIntLit, but of course it's a float - -- This can make a big difference for programs with a lot of - -- literals, compiled without -O - - go_fractional f - | isFloatTy res_ty && valueInRange = Just (mkLit floatDataCon (HsFloatPrim noExtField f)) - | isDoubleTy res_ty && valueInRange = Just (mkLit doubleDataCon (HsDoublePrim noExtField f)) - | otherwise = Nothing - where - valueInRange = - case f of - FL { fl_exp = e } -> (-100) <= e && e <= 100 - -- We limit short-cutting Fractional Literals to when their power of 10 - -- is less than 100, which ensures desugaring isn't slow. - - go_string src s - | isStringTy res_ty = Just (HsLit noAnn (HsString src s)) - | otherwise = Nothing - -mkLit :: DataCon -> HsLit GhcTc -> HsExpr GhcTc -mkLit con lit = HsApp noComments (nlHsDataCon con) (nlHsLit lit) - ------------------------------- -hsOverLitName :: OverLitVal -> Name --- Get the canonical 'fromX' name for a particular OverLitVal -hsOverLitName (HsIntegral {}) = fromIntegerName -hsOverLitName (HsFractional {}) = fromRationalName -hsOverLitName (HsIsString {}) = fromStringName - -{- -************************************************************************ -* * -\subsection[BackSubst-HsBinds]{Running a substitution over @HsBinds@} -* * -************************************************************************ - -The rest of the zonking is done *after* typechecking. -The main zonking pass runs over the bindings - - a) to convert TcTyVars to TyVars etc, dereferencing any bindings etc - b) convert unbound TcTyVar to Void - c) convert each TcId to an Id by zonking its type - -The type variables are converted by binding mutable tyvars to immutable ones -and then zonking as normal. - -The Ids are converted by binding them in the normal Tc envt; that -way we maintain sharing; eg an Id is zonked at its binding site and they -all occurrences of that Id point to the common zonked copy - -It's all pretty boring stuff, because HsSyn is such a large type, and -the environment manipulation is tiresome. --} - --- Confused by zonking? See Note [What is zonking?] in GHC.Tc.Utils.TcMType. - --- | See Note [The ZonkEnv] --- Confused by zonking? See Note [What is zonking?] in "GHC.Tc.Utils.TcMType". -data ZonkEnv -- See Note [The ZonkEnv] - = ZonkEnv { ze_flexi :: ZonkFlexi - , ze_tv_env :: TyCoVarEnv TyCoVar - , ze_id_env :: IdEnv Id - , ze_meta_tv_env :: TcRef (TyVarEnv Type) } - -{- Note [The ZonkEnv] -~~~~~~~~~~~~~~~~~~~~~ -* ze_flexi :: ZonkFlexi says what to do with a - unification variable that is still un-unified. - See Note [Un-unified unification variables] - -* ze_tv_env :: TyCoVarEnv TyCoVar promotes sharing. At a binding site - of a tyvar or covar, we zonk the kind right away and add a mapping - to the env. This prevents re-zonking the kind at every - occurrence. But this is *just* an optimisation. - -* ze_id_env : IdEnv Id promotes sharing among Ids, by making all - occurrences of the Id point to a single zonked copy, built at the - binding site. - - Unlike ze_tv_env, it is knot-tied: see extendIdZonkEnvRec. - In a mutually recursive group - rec { f = ...g...; g = ...f... } - we want the occurrence of g to point to the one zonked Id for g, - and the same for f. - - Because it is knot-tied, we must be careful to consult it lazily. - Specifically, zonkIdOcc is not monadic. - -* ze_meta_tv_env: see Note [Sharing when zonking to Type] - - -Notes: - * We must be careful never to put coercion variables (which are Ids, - after all) in the knot-tied ze_id_env, because coercions can - appear in types, and we sometimes inspect a zonked type in this - module. [Question: where, precisely?] - - * In zonkTyVarOcc we consult ze_tv_env in a monadic context, - a second reason that ze_tv_env can't be monadic. - - * An obvious suggestion would be to have one VarEnv Var to - replace both ze_id_env and ze_tv_env, but that doesn't work - because of the knot-tying stuff mentioned above. - -Note [Un-unified unification variables] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -What should we do if we find a Flexi unification variable? -There are three possibilities: - -* DefaultFlexi: this is the common case, in situations like - length @alpha ([] @alpha) - It really doesn't matter what type we choose for alpha. But - we must choose a type! We can't leave mutable unification - variables floating around: after typecheck is complete, every - type variable occurrence must have a binding site. - - So we default it to 'Any' of the right kind. - - All this works for both type and kind variables (indeed - the two are the same thing). - -* SkolemiseFlexi: is a special case for the LHS of RULES. - See Note [Zonking the LHS of a RULE] - -* RuntimeUnkFlexi: is a special case for the GHCi debugger. - It's a way to have a variable that is not a mutable - unification variable, but doesn't have a binding site - either. - -* NoFlexi: See Note [Error on unconstrained meta-variables] - in GHC.Tc.Utils.TcMType. This mode will panic on unfilled - meta-variables. --} - -data ZonkFlexi -- See Note [Un-unified unification variables] - = DefaultFlexi -- Default unbound unification variables to Any - | SkolemiseFlexi -- Skolemise unbound unification variables - -- See Note [Zonking the LHS of a RULE] - | RuntimeUnkFlexi -- Used in the GHCi debugger - | NoFlexi -- Panic on unfilled meta-variables - -- See Note [Error on unconstrained meta-variables] - -- in GHC.Tc.Utils.TcMType - -instance Outputable ZonkEnv where - ppr (ZonkEnv { ze_tv_env = tv_env - , ze_id_env = id_env }) - = text "ZE" <+> braces (vcat - [ text "ze_tv_env =" <+> ppr tv_env - , text "ze_id_env =" <+> ppr id_env ]) - --- The EvBinds have to already be zonked, but that's usually the case. -emptyZonkEnv :: TcM ZonkEnv -emptyZonkEnv = mkEmptyZonkEnv DefaultFlexi - -mkEmptyZonkEnv :: ZonkFlexi -> TcM ZonkEnv -mkEmptyZonkEnv flexi - = do { mtv_env_ref <- newTcRef emptyVarEnv - ; return (ZonkEnv { ze_flexi = flexi - , ze_tv_env = emptyVarEnv - , ze_id_env = emptyVarEnv - , ze_meta_tv_env = mtv_env_ref }) } - -initZonkEnv :: (ZonkEnv -> TcM b) -> TcM b -initZonkEnv thing_inside = do { ze <- mkEmptyZonkEnv DefaultFlexi - ; thing_inside ze } - --- | Extend the knot-tied environment. -extendIdZonkEnvRec :: ZonkEnv -> [Var] -> ZonkEnv -extendIdZonkEnvRec ze@(ZonkEnv { ze_id_env = id_env }) ids - -- NB: Don't look at the var to decide which env't to put it in. That - -- would end up knot-tying all the env'ts. - = ze { ze_id_env = extendVarEnvList id_env [(id,id) | id <- ids] } - -- Given coercion variables will actually end up here. That's OK though: - -- coercion variables are never looked up in the knot-tied env't, so zonking - -- them simply doesn't get optimised. No one gets hurt. An improvement (?) - -- would be to do SCC analysis in zonkEvBinds and then only knot-tie the - -- recursive groups. But perhaps the time it takes to do the analysis is - -- more than the savings. - -extendZonkEnv :: ZonkEnv -> [Var] -> ZonkEnv -extendZonkEnv ze@(ZonkEnv { ze_tv_env = tyco_env, ze_id_env = id_env }) vars - = ze { ze_tv_env = extendVarEnvList tyco_env [(tv,tv) | tv <- tycovars] - , ze_id_env = extendVarEnvList id_env [(id,id) | id <- ids] } - where - (tycovars, ids) = partition isTyCoVar vars - -extendIdZonkEnv :: ZonkEnv -> Var -> ZonkEnv -extendIdZonkEnv ze@(ZonkEnv { ze_id_env = id_env }) id - = ze { ze_id_env = extendVarEnv id_env id id } - -extendTyZonkEnv :: ZonkEnv -> TyVar -> ZonkEnv -extendTyZonkEnv ze@(ZonkEnv { ze_tv_env = ty_env }) tv - = ze { ze_tv_env = extendVarEnv ty_env tv tv } - -setZonkType :: ZonkEnv -> ZonkFlexi -> ZonkEnv -setZonkType ze flexi = ze { ze_flexi = flexi } - -zonkEnvIds :: ZonkEnv -> TypeEnv -zonkEnvIds (ZonkEnv { ze_id_env = id_env}) - = mkNameEnv [(getName id, AnId id) | id <- nonDetEltsUFM id_env] - -- It's OK to use nonDetEltsUFM here because we forget the ordering - -- immediately by creating a TypeEnv - -zonkLIdOcc :: ZonkEnv -> LocatedN TcId -> LocatedN Id -zonkLIdOcc env = fmap (zonkIdOcc env) - -zonkIdOcc :: ZonkEnv -> TcId -> Id --- Ids defined in this module should be in the envt; --- ignore others. (Actually, data constructors are also --- not LocalVars, even when locally defined, but that is fine.) --- (Also foreign-imported things aren't currently in the ZonkEnv; --- that's ok because they don't need zonking.) --- --- Actually, Template Haskell works in 'chunks' of declarations, and --- an earlier chunk won't be in the 'env' that the zonking phase --- carries around. Instead it'll be in the tcg_gbl_env, already fully --- zonked. There's no point in looking it up there (except for error --- checking), and it's not conveniently to hand; hence the simple --- 'orElse' case in the LocalVar branch. --- --- Even without template splices, in module Main, the checking of --- 'main' is done as a separate chunk. -zonkIdOcc (ZonkEnv { ze_id_env = id_env}) id - | isLocalVar id = lookupVarEnv id_env id `orElse` - id - | otherwise = id - -zonkIdOccs :: ZonkEnv -> [TcId] -> [Id] -zonkIdOccs env ids = map (zonkIdOcc env) ids - --- zonkIdBndr is used *after* typechecking to get the Id's type --- to its final form. The TyVarEnv give -zonkIdBndr :: ZonkEnv -> TcId -> TcM Id -zonkIdBndr env v - = do Scaled w' ty' <- zonkScaledTcTypeToTypeX env (idScaledType v) - return (setIdMult (setIdType v ty') w') - -zonkIdBndrs :: ZonkEnv -> [TcId] -> TcM [Id] -zonkIdBndrs env ids = mapM (zonkIdBndr env) ids - -zonkTopBndrs :: [TcId] -> TcM [Id] -zonkTopBndrs ids = initZonkEnv $ \ ze -> zonkIdBndrs ze ids - -zonkFieldOcc :: ZonkEnv -> FieldOcc GhcTc -> TcM (FieldOcc GhcTc) -zonkFieldOcc env (FieldOcc sel lbl) - = fmap ((flip FieldOcc) lbl) $ zonkIdBndr env sel - -zonkEvBndrsX :: ZonkEnv -> [EvVar] -> TcM (ZonkEnv, [Var]) -zonkEvBndrsX = mapAccumLM zonkEvBndrX - -zonkEvBndrX :: ZonkEnv -> EvVar -> TcM (ZonkEnv, EvVar) --- Works for dictionaries and coercions -zonkEvBndrX env var - = do { var' <- zonkEvBndr env var - ; return (extendZonkEnv env [var'], var') } - -zonkEvBndr :: ZonkEnv -> EvVar -> TcM EvVar --- Works for dictionaries and coercions --- Does not extend the ZonkEnv -zonkEvBndr env var - = updateIdTypeAndMultM ({-# SCC "zonkEvBndr_zonkTcTypeToType" #-} zonkTcTypeToTypeX env) var - -{- -zonkEvVarOcc :: ZonkEnv -> EvVar -> TcM EvTerm -zonkEvVarOcc env v - | isCoVar v - = EvCoercion <$> zonkCoVarOcc env v - | otherwise - = return (EvId $ zonkIdOcc env v) --} - -zonkCoreBndrX :: ZonkEnv -> Var -> TcM (ZonkEnv, Var) -zonkCoreBndrX env v - | isId v = do { v' <- zonkIdBndr env v - ; return (extendIdZonkEnv env v', v') } - | otherwise = zonkTyBndrX env v - -zonkCoreBndrsX :: ZonkEnv -> [Var] -> TcM (ZonkEnv, [Var]) -zonkCoreBndrsX = mapAccumLM zonkCoreBndrX - -zonkTyBndrs :: [TcTyVar] -> TcM (ZonkEnv, [TyVar]) -zonkTyBndrs tvs = initZonkEnv $ \ze -> zonkTyBndrsX ze tvs - -zonkTyBndrsX :: ZonkEnv -> [TcTyVar] -> TcM (ZonkEnv, [TyVar]) -zonkTyBndrsX = mapAccumLM zonkTyBndrX - -zonkTyBndrX :: ZonkEnv -> TcTyVar -> TcM (ZonkEnv, TyVar) --- This guarantees to return a TyVar (not a TcTyVar) --- then we add it to the envt, so all occurrences are replaced --- --- It does not clone: the new TyVar has the sane Name --- as the old one. This important when zonking the --- TyVarBndrs of a TyCon, whose Names may scope. -zonkTyBndrX env tv - = assertPpr (isImmutableTyVar tv) (ppr tv <+> dcolon <+> ppr (tyVarKind tv)) $ - do { ki <- zonkTcTypeToTypeX env (tyVarKind tv) - -- Internal names tidy up better, for iface files. - ; let tv' = mkTyVar (tyVarName tv) ki - ; return (extendTyZonkEnv env tv', tv') } - -zonkTyVarBindersX :: ZonkEnv -> [VarBndr TcTyVar vis] - -> TcM (ZonkEnv, [VarBndr TyVar vis]) -zonkTyVarBindersX = mapAccumLM zonkTyVarBinderX - -zonkTyVarBinderX :: ZonkEnv -> VarBndr TcTyVar vis - -> TcM (ZonkEnv, VarBndr TyVar vis) --- Takes a TcTyVar and guarantees to return a TyVar -zonkTyVarBinderX env (Bndr tv vis) - = do { (env', tv') <- zonkTyBndrX env tv - ; return (env', Bndr tv' vis) } - -zonkTopExpr :: HsExpr GhcTc -> TcM (HsExpr GhcTc) -zonkTopExpr e = initZonkEnv $ \ ze -> zonkExpr ze e - -zonkTopLExpr :: LHsExpr GhcTc -> TcM (LHsExpr GhcTc) -zonkTopLExpr e = initZonkEnv $ \ ze -> zonkLExpr ze e - -zonkTopDecls :: Bag EvBind - -> LHsBinds GhcTc - -> [LRuleDecl GhcTc] -> [LTcSpecPrag] - -> [LForeignDecl GhcTc] - -> TcM (TypeEnv, - Bag EvBind, - LHsBinds GhcTc, - [LForeignDecl GhcTc], - [LTcSpecPrag], - [LRuleDecl GhcTc]) -zonkTopDecls ev_binds binds rules imp_specs fords - = do { (env1, ev_binds') <- initZonkEnv $ \ ze -> zonkEvBinds ze ev_binds - ; (env2, binds') <- zonkRecMonoBinds env1 binds - -- Top level is implicitly recursive - ; rules' <- zonkRules env2 rules - ; specs' <- zonkLTcSpecPrags env2 imp_specs - ; fords' <- zonkForeignExports env2 fords - ; return (zonkEnvIds env2, ev_binds', binds', fords', specs', rules') } - ---------------------------------------------- -zonkLocalBinds :: ZonkEnv -> HsLocalBinds GhcTc - -> TcM (ZonkEnv, HsLocalBinds GhcTc) -zonkLocalBinds env (EmptyLocalBinds x) - = return (env, (EmptyLocalBinds x)) - -zonkLocalBinds _ (HsValBinds _ (ValBinds {})) - = panic "zonkLocalBinds" -- Not in typechecker output - -zonkLocalBinds env (HsValBinds x (XValBindsLR (NValBinds binds sigs))) - = do { (env1, new_binds) <- go env binds - ; return (env1, HsValBinds x (XValBindsLR (NValBinds new_binds sigs))) } - where - go env [] - = return (env, []) - go env ((r,b):bs) - = do { (env1, b') <- zonkRecMonoBinds env b - ; (env2, bs') <- go env1 bs - ; return (env2, (r,b'):bs') } - -zonkLocalBinds env (HsIPBinds x (IPBinds dict_binds binds )) = do - new_binds <- mapM (wrapLocMA zonk_ip_bind) binds - let - env1 = extendIdZonkEnvRec env - [ n | (L _ (IPBind n _ _)) <- new_binds] - (env2, new_dict_binds) <- zonkTcEvBinds env1 dict_binds - return (env2, HsIPBinds x (IPBinds new_dict_binds new_binds)) - where - zonk_ip_bind (IPBind dict_id n e) - = do dict_id' <- zonkIdBndr env dict_id - e' <- zonkLExpr env e - return (IPBind dict_id' n e') - ---------------------------------------------- -zonkRecMonoBinds :: ZonkEnv -> LHsBinds GhcTc -> TcM (ZonkEnv, LHsBinds GhcTc) -zonkRecMonoBinds env binds - = fixM (\ ~(_, new_binds) -> do - { let env1 = extendIdZonkEnvRec env (collectHsBindsBinders CollNoDictBinders new_binds) - ; binds' <- zonkMonoBinds env1 binds - ; return (env1, binds') }) - ---------------------------------------------- -zonkMonoBinds :: ZonkEnv -> LHsBinds GhcTc -> TcM (LHsBinds GhcTc) -zonkMonoBinds env binds = mapBagM (zonk_lbind env) binds - -zonk_lbind :: ZonkEnv -> LHsBind GhcTc -> TcM (LHsBind GhcTc) -zonk_lbind env = wrapLocMA (zonk_bind env) - -zonk_bind :: ZonkEnv -> HsBind GhcTc -> TcM (HsBind GhcTc) -zonk_bind env bind@(PatBind { pat_lhs = pat, pat_rhs = grhss - , pat_ext = (ty, ticks)}) - = do { (_env, new_pat) <- zonkPat env pat -- Env already extended - ; new_grhss <- zonkGRHSs env zonkLExpr grhss - ; new_ty <- zonkTcTypeToTypeX env ty - ; return (bind { pat_lhs = new_pat, pat_rhs = new_grhss - , pat_ext = (new_ty, ticks) }) } - -zonk_bind env (VarBind { var_ext = x - , var_id = var, var_rhs = expr }) - = do { new_var <- zonkIdBndr env var - ; new_expr <- zonkLExpr env expr - ; return (VarBind { var_ext = x - , var_id = new_var - , var_rhs = new_expr }) } - -zonk_bind env bind@(FunBind { fun_id = L loc var - , fun_matches = ms - , fun_ext = (co_fn, ticks) }) - = do { new_var <- zonkIdBndr env var - ; (env1, new_co_fn) <- zonkCoFn env co_fn - ; new_ms <- zonkMatchGroup env1 zonkLExpr ms - ; return (bind { fun_id = L loc new_var - , fun_matches = new_ms - , fun_ext = (new_co_fn, ticks) }) } - -zonk_bind env (XHsBindsLR (AbsBinds { abs_tvs = tyvars, abs_ev_vars = evs - , abs_ev_binds = ev_binds - , abs_exports = exports - , abs_binds = val_binds - , abs_sig = has_sig })) - = assert ( all isImmutableTyVar tyvars ) $ - do { (env0, new_tyvars) <- zonkTyBndrsX env tyvars - ; (env1, new_evs) <- zonkEvBndrsX env0 evs - ; (env2, new_ev_binds) <- zonkTcEvBinds_s env1 ev_binds - ; (new_val_bind, new_exports) <- fixM $ \ ~(new_val_binds, _) -> - do { let env3 = extendIdZonkEnvRec env2 $ - collectHsBindsBinders CollNoDictBinders new_val_binds - ; new_val_binds <- mapBagM (zonk_val_bind env3) val_binds - ; new_exports <- mapM (zonk_export env3) exports - ; return (new_val_binds, new_exports) } - ; return $ XHsBindsLR $ - AbsBinds { abs_tvs = new_tyvars, abs_ev_vars = new_evs - , abs_ev_binds = new_ev_binds - , abs_exports = new_exports, abs_binds = new_val_bind - , abs_sig = has_sig } } - where - zonk_val_bind env lbind - | has_sig - , (L loc bind@(FunBind { fun_id = (L mloc mono_id) - , fun_matches = ms - , fun_ext = (co_fn, ticks) })) <- lbind - = do { new_mono_id <- updateIdTypeAndMultM (zonkTcTypeToTypeX env) mono_id - -- Specifically /not/ zonkIdBndr; we do not want to - -- complain about a representation-polymorphic binder - ; (env', new_co_fn) <- zonkCoFn env co_fn - ; new_ms <- zonkMatchGroup env' zonkLExpr ms - ; return $ L loc $ - bind { fun_id = L mloc new_mono_id - , fun_matches = new_ms - , fun_ext = (new_co_fn, ticks) } } - | otherwise - = zonk_lbind env lbind -- The normal case - - zonk_export :: ZonkEnv -> ABExport -> TcM ABExport - zonk_export env (ABE{ abe_wrap = wrap - , abe_poly = poly_id - , abe_mono = mono_id - , abe_prags = prags }) - = do new_poly_id <- zonkIdBndr env poly_id - (_, new_wrap) <- zonkCoFn env wrap - new_prags <- zonkSpecPrags env prags - return (ABE{ abe_wrap = new_wrap - , abe_poly = new_poly_id - , abe_mono = zonkIdOcc env mono_id - , abe_prags = new_prags }) - -zonk_bind env (PatSynBind x bind@(PSB { psb_id = L loc id - , psb_args = details - , psb_def = lpat - , psb_dir = dir })) - = do { id' <- zonkIdBndr env id - ; (env1, lpat') <- zonkPat env lpat - ; details' <- zonkPatSynDetails env1 details - ; (_env2, dir') <- zonkPatSynDir env1 dir - ; return $ PatSynBind x $ - bind { psb_id = L loc id' - , psb_args = details' - , psb_def = lpat' - , psb_dir = dir' } } - -zonkPatSynDetails :: ZonkEnv - -> HsPatSynDetails GhcTc - -> TcM (HsPatSynDetails GhcTc) -zonkPatSynDetails env (PrefixCon _ as) - = pure $ PrefixCon noTypeArgs (map (zonkLIdOcc env) as) -zonkPatSynDetails env (InfixCon a1 a2) - = pure $ InfixCon (zonkLIdOcc env a1) (zonkLIdOcc env a2) -zonkPatSynDetails env (RecCon flds) - = RecCon <$> mapM (zonkPatSynField env) flds - -zonkPatSynField :: ZonkEnv -> RecordPatSynField GhcTc -> TcM (RecordPatSynField GhcTc) -zonkPatSynField env (RecordPatSynField x y) = - RecordPatSynField <$> zonkFieldOcc env x <*> pure (zonkLIdOcc env y) - -zonkPatSynDir :: ZonkEnv -> HsPatSynDir GhcTc - -> TcM (ZonkEnv, HsPatSynDir GhcTc) -zonkPatSynDir env Unidirectional = return (env, Unidirectional) -zonkPatSynDir env ImplicitBidirectional = return (env, ImplicitBidirectional) -zonkPatSynDir env (ExplicitBidirectional mg) = do - mg' <- zonkMatchGroup env zonkLExpr mg - return (env, ExplicitBidirectional mg') - -zonkSpecPrags :: ZonkEnv -> TcSpecPrags -> TcM TcSpecPrags -zonkSpecPrags _ IsDefaultMethod = return IsDefaultMethod -zonkSpecPrags env (SpecPrags ps) = do { ps' <- zonkLTcSpecPrags env ps - ; return (SpecPrags ps') } - -zonkLTcSpecPrags :: ZonkEnv -> [LTcSpecPrag] -> TcM [LTcSpecPrag] -zonkLTcSpecPrags env ps - = mapM zonk_prag ps - where - zonk_prag (L loc (SpecPrag id co_fn inl)) - = do { (_, co_fn') <- zonkCoFn env co_fn - ; return (L loc (SpecPrag (zonkIdOcc env id) co_fn' inl)) } - -{- -************************************************************************ -* * -\subsection[BackSubst-Match-GRHSs]{Match and GRHSs} -* * -************************************************************************ --} - -zonkMatchGroup :: Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ SrcAnn NoEpAnns - => ZonkEnv - -> (ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))) - -> MatchGroup GhcTc (LocatedA (body GhcTc)) - -> TcM (MatchGroup GhcTc (LocatedA (body GhcTc))) -zonkMatchGroup env zBody (MG { mg_alts = L l ms - , mg_ext = MatchGroupTc arg_tys res_ty origin - }) - = do { ms' <- mapM (zonkMatch env zBody) ms - ; arg_tys' <- zonkScaledTcTypesToTypesX env arg_tys - ; res_ty' <- zonkTcTypeToTypeX env res_ty - ; return (MG { mg_alts = L l ms' - , mg_ext = MatchGroupTc arg_tys' res_ty' origin - }) } - -zonkMatch :: Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ SrcAnn NoEpAnns - => ZonkEnv - -> (ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))) - -> LMatch GhcTc (LocatedA (body GhcTc)) - -> TcM (LMatch GhcTc (LocatedA (body GhcTc))) -zonkMatch env zBody (L loc match@(Match { m_pats = pats - , m_grhss = grhss })) - = do { (env1, new_pats) <- zonkPats env pats - ; new_grhss <- zonkGRHSs env1 zBody grhss - ; return (L loc (match { m_pats = new_pats, m_grhss = new_grhss })) } - -------------------------------------------------------------------------- -zonkGRHSs :: Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ SrcAnn NoEpAnns - => ZonkEnv - -> (ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))) - -> GRHSs GhcTc (LocatedA (body GhcTc)) - -> TcM (GRHSs GhcTc (LocatedA (body GhcTc))) - -zonkGRHSs env zBody (GRHSs x grhss binds) = do - (new_env, new_binds) <- zonkLocalBinds env binds - let - zonk_grhs (GRHS xx guarded rhs) - = do (env2, new_guarded) <- zonkStmts new_env zonkLExpr guarded - new_rhs <- zBody env2 rhs - return (GRHS xx new_guarded new_rhs) - new_grhss <- mapM (wrapLocMA zonk_grhs) grhss - return (GRHSs x new_grhss new_binds) - -{- -************************************************************************ -* * -\subsection[BackSubst-HsExpr]{Running a zonkitution over a TypeCheckedExpr} -* * -************************************************************************ --} - -zonkLExprs :: ZonkEnv -> [LHsExpr GhcTc] -> TcM [LHsExpr GhcTc] -zonkLExpr :: ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc) -zonkExpr :: ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc) - -zonkLExprs env exprs = mapM (zonkLExpr env) exprs -zonkLExpr env expr = wrapLocMA (zonkExpr env) expr - -zonkExpr env (HsVar x (L l id)) - = assertPpr (isNothing (isDataConId_maybe id)) (ppr id) $ - return (HsVar x (L l (zonkIdOcc env id))) - -zonkExpr env (HsUnboundVar her occ) - = do her' <- zonk_her her - return (HsUnboundVar her' occ) - where - zonk_her :: HoleExprRef -> TcM HoleExprRef - zonk_her (HER ref ty u) - = do updMutVarM ref (zonkEvTerm env) - ty' <- zonkTcTypeToTypeX env ty - return (HER ref ty' u) - -zonkExpr env (HsRecSel _ (FieldOcc v occ)) - = return (HsRecSel noExtField (FieldOcc (zonkIdOcc env v) occ)) - -zonkExpr _ (HsIPVar x _) = dataConCantHappen x - -zonkExpr _ (HsOverLabel x _ _) = dataConCantHappen x - -zonkExpr env (HsLit x (HsRat e f ty)) - = do new_ty <- zonkTcTypeToTypeX env ty - return (HsLit x (HsRat e f new_ty)) - -zonkExpr _ (HsLit x lit) - = return (HsLit x lit) - -zonkExpr env (HsOverLit x lit) - = do { lit' <- zonkOverLit env lit - ; return (HsOverLit x lit') } - -zonkExpr env (HsLam x matches) - = do new_matches <- zonkMatchGroup env zonkLExpr matches - return (HsLam x new_matches) - -zonkExpr env (HsLamCase x lc_variant matches) - = do new_matches <- zonkMatchGroup env zonkLExpr matches - return (HsLamCase x lc_variant new_matches) - -zonkExpr env (HsApp x e1 e2) - = do new_e1 <- zonkLExpr env e1 - new_e2 <- zonkLExpr env e2 - return (HsApp x new_e1 new_e2) - -zonkExpr env (HsAppType ty e at t) - = do new_e <- zonkLExpr env e - new_ty <- zonkTcTypeToTypeX env ty - return (HsAppType new_ty new_e at t) - -- NB: the type is an HsType; can't zonk that! - -zonkExpr env (HsTypedBracket hsb_tc body) - = (\x -> HsTypedBracket x body) <$> zonkBracket env hsb_tc - -zonkExpr env (HsUntypedBracket hsb_tc body) - = (\x -> HsUntypedBracket x body) <$> zonkBracket env hsb_tc - -zonkExpr env (HsTypedSplice s _) = runTopSplice s >>= zonkExpr env - -zonkExpr _ (HsUntypedSplice x _) = dataConCantHappen x - -zonkExpr _ (OpApp x _ _ _) = dataConCantHappen x - -zonkExpr env (NegApp x expr op) - = do (env', new_op) <- zonkSyntaxExpr env op - new_expr <- zonkLExpr env' expr - return (NegApp x new_expr new_op) - -zonkExpr env (HsPar x lpar e rpar) - = do new_e <- zonkLExpr env e - return (HsPar x lpar new_e rpar) - -zonkExpr _ (SectionL x _ _) = dataConCantHappen x -zonkExpr _ (SectionR x _ _) = dataConCantHappen x -zonkExpr env (ExplicitTuple x tup_args boxed) - = do { new_tup_args <- mapM zonk_tup_arg tup_args - ; return (ExplicitTuple x new_tup_args boxed) } - where - zonk_tup_arg (Present x e) = do { e' <- zonkLExpr env e - ; return (Present x e') } - zonk_tup_arg (Missing t) = do { t' <- zonkScaledTcTypeToTypeX env t - ; return (Missing t') } - - -zonkExpr env (ExplicitSum args alt arity expr) - = do new_args <- mapM (zonkTcTypeToTypeX env) args - new_expr <- zonkLExpr env expr - return (ExplicitSum new_args alt arity new_expr) - -zonkExpr env (HsCase x expr ms) - = do new_expr <- zonkLExpr env expr - new_ms <- zonkMatchGroup env zonkLExpr ms - return (HsCase x new_expr new_ms) - -zonkExpr env (HsIf x e1 e2 e3) - = do new_e1 <- zonkLExpr env e1 - new_e2 <- zonkLExpr env e2 - new_e3 <- zonkLExpr env e3 - return (HsIf x new_e1 new_e2 new_e3) - -zonkExpr env (HsMultiIf ty alts) - = do { alts' <- mapM (wrapLocMA zonk_alt) alts - ; ty' <- zonkTcTypeToTypeX env ty - ; return $ HsMultiIf ty' alts' } - where zonk_alt (GRHS x guard expr) - = do { (env', guard') <- zonkStmts env zonkLExpr guard - ; expr' <- zonkLExpr env' expr - ; return $ GRHS x guard' expr' } - -zonkExpr env (HsLet x tkLet binds tkIn expr) - = do (new_env, new_binds) <- zonkLocalBinds env binds - new_expr <- zonkLExpr new_env expr - return (HsLet x tkLet new_binds tkIn new_expr) - -zonkExpr env (HsDo ty do_or_lc (L l stmts)) - = do (_, new_stmts) <- zonkStmts env zonkLExpr stmts - new_ty <- zonkTcTypeToTypeX env ty - return (HsDo new_ty do_or_lc (L l new_stmts)) - -zonkExpr env (ExplicitList ty exprs) - = do new_ty <- zonkTcTypeToTypeX env ty - new_exprs <- zonkLExprs env exprs - return (ExplicitList new_ty new_exprs) - -zonkExpr env expr@(RecordCon { rcon_ext = con_expr, rcon_flds = rbinds }) - = do { new_con_expr <- zonkExpr env con_expr - ; new_rbinds <- zonkRecFields env rbinds - ; return (expr { rcon_ext = new_con_expr - , rcon_flds = new_rbinds }) } - -zonkExpr env (ExprWithTySig _ e ty) - = do { e' <- zonkLExpr env e - ; return (ExprWithTySig noExtField e' ty) } - -zonkExpr env (ArithSeq expr wit info) - = do (env1, new_wit) <- zonkWit env wit - new_expr <- zonkExpr env expr - new_info <- zonkArithSeq env1 info - return (ArithSeq new_expr new_wit new_info) - where zonkWit env Nothing = return (env, Nothing) - zonkWit env (Just fln) = second Just <$> zonkSyntaxExpr env fln - -zonkExpr env (HsPragE x prag expr) - = do new_expr <- zonkLExpr env expr - return (HsPragE x prag new_expr) - --- arrow notation extensions -zonkExpr env (HsProc x pat body) - = do { (env1, new_pat) <- zonkPat env pat - ; new_body <- zonkCmdTop env1 body - ; return (HsProc x new_pat new_body) } - --- StaticPointers extension -zonkExpr env (HsStatic (fvs, ty) expr) - = do new_ty <- zonkTcTypeToTypeX env ty - HsStatic (fvs, new_ty) <$> zonkLExpr env expr - -zonkExpr env (XExpr (WrapExpr (HsWrap co_fn expr))) - = do (env1, new_co_fn) <- zonkCoFn env co_fn - new_expr <- zonkExpr env1 expr - return (XExpr (WrapExpr (HsWrap new_co_fn new_expr))) - -zonkExpr env (XExpr (ExpansionExpr (HsExpanded a b))) - = XExpr . ExpansionExpr . HsExpanded a <$> zonkExpr env b - -zonkExpr env (XExpr (ConLikeTc con tvs tys)) - = XExpr . ConLikeTc con tvs <$> mapM zonk_scale tys - where - zonk_scale (Scaled m ty) = Scaled <$> zonkTcTypeToTypeX env m <*> pure ty - -- Only the multiplicity can contain unification variables - -- The tvs come straight from the data-con, and so are strictly redundant - -- See Wrinkles of Note [Typechecking data constructors] in GHC.Tc.Gen.Head - -zonkExpr _ (RecordUpd x _ _) = dataConCantHappen x -zonkExpr _ (HsGetField x _ _) = dataConCantHappen x -zonkExpr _ (HsProjection x _) = dataConCantHappen x -zonkExpr _ e@(XExpr (HsTick {})) = pprPanic "zonkExpr" (ppr e) -zonkExpr _ e@(XExpr (HsBinTick {})) = pprPanic "zonkExpr" (ppr e) - -------------------------------------------------------------------------- -{- -Note [Skolems in zonkSyntaxExpr] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider rebindable syntax with something like - - (>>=) :: (forall x. blah) -> (forall y. blah') -> blah'' - -The x and y become skolems that are in scope when type-checking the -arguments to the bind. This means that we must extend the ZonkEnv with -these skolems when zonking the arguments to the bind. But the skolems -are different between the two arguments, and so we should theoretically -carry around different environments to use for the different arguments. - -However, this becomes a logistical nightmare, especially in dealing with -the more exotic Stmt forms. So, we simplify by making the critical -assumption that the uniques of the skolems are different. (This assumption -is justified by the use of newUnique in GHC.Tc.Utils.TcMType.instSkolTyCoVarX.) -Now, we can safely just extend one environment. --} - --- See Note [Skolems in zonkSyntaxExpr] -zonkSyntaxExpr :: ZonkEnv -> SyntaxExpr GhcTc - -> TcM (ZonkEnv, SyntaxExpr GhcTc) -zonkSyntaxExpr env (SyntaxExprTc { syn_expr = expr - , syn_arg_wraps = arg_wraps - , syn_res_wrap = res_wrap }) - = do { (env0, res_wrap') <- zonkCoFn env res_wrap - ; expr' <- zonkExpr env0 expr - ; (env1, arg_wraps') <- mapAccumLM zonkCoFn env0 arg_wraps - ; return (env1, SyntaxExprTc { syn_expr = expr' - , syn_arg_wraps = arg_wraps' - , syn_res_wrap = res_wrap' }) } -zonkSyntaxExpr env NoSyntaxExprTc = return (env, NoSyntaxExprTc) - -------------------------------------------------------------------------- - -zonkLCmd :: ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc) -zonkCmd :: ZonkEnv -> HsCmd GhcTc -> TcM (HsCmd GhcTc) - -zonkLCmd env cmd = wrapLocMA (zonkCmd env) cmd - -zonkCmd env (XCmd (HsWrap w cmd)) - = do { (env1, w') <- zonkCoFn env w - ; cmd' <- zonkCmd env1 cmd - ; return (XCmd (HsWrap w' cmd')) } -zonkCmd env (HsCmdArrApp ty e1 e2 ho rl) - = do new_e1 <- zonkLExpr env e1 - new_e2 <- zonkLExpr env e2 - new_ty <- zonkTcTypeToTypeX env ty - return (HsCmdArrApp new_ty new_e1 new_e2 ho rl) - -zonkCmd env (HsCmdArrForm x op f fixity args) - = do new_op <- zonkLExpr env op - new_args <- mapM (zonkCmdTop env) args - return (HsCmdArrForm x new_op f fixity new_args) - -zonkCmd env (HsCmdApp x c e) - = do new_c <- zonkLCmd env c - new_e <- zonkLExpr env e - return (HsCmdApp x new_c new_e) - -zonkCmd env (HsCmdLam x matches) - = do new_matches <- zonkMatchGroup env zonkLCmd matches - return (HsCmdLam x new_matches) - -zonkCmd env (HsCmdPar x lpar c rpar) - = do new_c <- zonkLCmd env c - return (HsCmdPar x lpar new_c rpar) - -zonkCmd env (HsCmdCase x expr ms) - = do new_expr <- zonkLExpr env expr - new_ms <- zonkMatchGroup env zonkLCmd ms - return (HsCmdCase x new_expr new_ms) - -zonkCmd env (HsCmdLamCase x lc_variant ms) - = do new_ms <- zonkMatchGroup env zonkLCmd ms - return (HsCmdLamCase x lc_variant new_ms) - -zonkCmd env (HsCmdIf x eCond ePred cThen cElse) - = do { (env1, new_eCond) <- zonkSyntaxExpr env eCond - ; new_ePred <- zonkLExpr env1 ePred - ; new_cThen <- zonkLCmd env1 cThen - ; new_cElse <- zonkLCmd env1 cElse - ; return (HsCmdIf x new_eCond new_ePred new_cThen new_cElse) } - -zonkCmd env (HsCmdLet x tkLet binds tkIn cmd) - = do (new_env, new_binds) <- zonkLocalBinds env binds - new_cmd <- zonkLCmd new_env cmd - return (HsCmdLet x tkLet new_binds tkIn new_cmd) - -zonkCmd env (HsCmdDo ty (L l stmts)) - = do (_, new_stmts) <- zonkStmts env zonkLCmd stmts - new_ty <- zonkTcTypeToTypeX env ty - return (HsCmdDo new_ty (L l new_stmts)) - - - -zonkCmdTop :: ZonkEnv -> LHsCmdTop GhcTc -> TcM (LHsCmdTop GhcTc) -zonkCmdTop env cmd = wrapLocMA (zonk_cmd_top env) cmd - -zonk_cmd_top :: ZonkEnv -> HsCmdTop GhcTc -> TcM (HsCmdTop GhcTc) -zonk_cmd_top env (HsCmdTop (CmdTopTc stack_tys ty ids) cmd) - = do new_cmd <- zonkLCmd env cmd - new_stack_tys <- zonkTcTypeToTypeX env stack_tys - new_ty <- zonkTcTypeToTypeX env ty - new_ids <- mapSndM (zonkExpr env) ids - - massert (isLiftedTypeKind (typeKind new_stack_tys)) - -- desugarer assumes that this is not representation-polymorphic... - -- but indeed it should always be lifted due to the typing - -- rules for arrows - - return (HsCmdTop (CmdTopTc new_stack_tys new_ty new_ids) new_cmd) - -------------------------------------------------------------------------- -zonkCoFn :: ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper) -zonkCoFn env WpHole = return (env, WpHole) -zonkCoFn env (WpCompose c1 c2) = do { (env1, c1') <- zonkCoFn env c1 - ; (env2, c2') <- zonkCoFn env1 c2 - ; return (env2, WpCompose c1' c2') } -zonkCoFn env (WpFun c1 c2 t1) = do { (env1, c1') <- zonkCoFn env c1 - ; (env2, c2') <- zonkCoFn env1 c2 - ; t1' <- zonkScaledTcTypeToTypeX env2 t1 - ; return (env2, WpFun c1' c2' t1') } -zonkCoFn env (WpCast co) = do { co' <- zonkCoToCo env co - ; return (env, WpCast co') } -zonkCoFn env (WpEvLam ev) = do { (env', ev') <- zonkEvBndrX env ev - ; return (env', WpEvLam ev') } -zonkCoFn env (WpEvApp arg) = do { arg' <- zonkEvTerm env arg - ; return (env, WpEvApp arg') } -zonkCoFn env (WpTyLam tv) = assert (isImmutableTyVar tv) $ - do { (env', tv') <- zonkTyBndrX env tv - ; return (env', WpTyLam tv') } -zonkCoFn env (WpTyApp ty) = do { ty' <- zonkTcTypeToTypeX env ty - ; return (env, WpTyApp ty') } -zonkCoFn env (WpLet bs) = do { (env1, bs') <- zonkTcEvBinds env bs - ; return (env1, WpLet bs') } -zonkCoFn env (WpMultCoercion co) = do { co' <- zonkCoToCo env co - ; return (env, WpMultCoercion co') } - -------------------------------------------------------------------------- -zonkOverLit :: ZonkEnv -> HsOverLit GhcTc -> TcM (HsOverLit GhcTc) -zonkOverLit env lit@(OverLit {ol_ext = x at OverLitTc { ol_witness = e, ol_type = ty } }) - = do { ty' <- zonkTcTypeToTypeX env ty - ; e' <- zonkExpr env e - ; return (lit { ol_ext = x { ol_witness = e' - , ol_type = ty' } }) } - -------------------------------------------------------------------------- -zonkBracket :: ZonkEnv -> HsBracketTc -> TcM HsBracketTc -zonkBracket env (HsBracketTc hsb_thing ty wrap bs) - = do wrap' <- traverse zonkQuoteWrap wrap - bs' <- mapM (zonk_b env) bs - new_ty <- zonkTcTypeToTypeX env ty - return (HsBracketTc hsb_thing new_ty wrap' bs') - where - zonkQuoteWrap (QuoteWrapper ev ty) = do - let ev' = zonkIdOcc env ev - ty' <- zonkTcTypeToTypeX env ty - return (QuoteWrapper ev' ty') - - zonk_b env' (PendingTcSplice n e) = do e' <- zonkLExpr env' e - return (PendingTcSplice n e') - -------------------------------------------------------------------------- -zonkArithSeq :: ZonkEnv -> ArithSeqInfo GhcTc -> TcM (ArithSeqInfo GhcTc) - -zonkArithSeq env (From e) - = do new_e <- zonkLExpr env e - return (From new_e) - -zonkArithSeq env (FromThen e1 e2) - = do new_e1 <- zonkLExpr env e1 - new_e2 <- zonkLExpr env e2 - return (FromThen new_e1 new_e2) - -zonkArithSeq env (FromTo e1 e2) - = do new_e1 <- zonkLExpr env e1 - new_e2 <- zonkLExpr env e2 - return (FromTo new_e1 new_e2) - -zonkArithSeq env (FromThenTo e1 e2 e3) - = do new_e1 <- zonkLExpr env e1 - new_e2 <- zonkLExpr env e2 - new_e3 <- zonkLExpr env e3 - return (FromThenTo new_e1 new_e2 new_e3) - -------------------------------------------------------------------------- -zonkStmts :: Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))) ~ SrcSpanAnnA - => ZonkEnv - -> (ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))) - -> [LStmt GhcTc (LocatedA (body GhcTc))] - -> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (body GhcTc))]) -zonkStmts env _ [] = return (env, []) -zonkStmts env zBody (s:ss) = do { (env1, s') <- wrapLocSndMA (zonkStmt env zBody) s - ; (env2, ss') <- zonkStmts env1 zBody ss - ; return (env2, s' : ss') } - -zonkStmt :: Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))) ~ SrcSpanAnnA - => ZonkEnv - -> (ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))) - -> Stmt GhcTc (LocatedA (body GhcTc)) - -> TcM (ZonkEnv, Stmt GhcTc (LocatedA (body GhcTc))) -zonkStmt env _ (ParStmt bind_ty stmts_w_bndrs mzip_op bind_op) - = do { (env1, new_bind_op) <- zonkSyntaxExpr env bind_op - ; new_bind_ty <- zonkTcTypeToTypeX env1 bind_ty - ; new_stmts_w_bndrs <- mapM (zonk_branch env1) stmts_w_bndrs - ; let new_binders = [b | ParStmtBlock _ _ bs _ <- new_stmts_w_bndrs - , b <- bs] - env2 = extendIdZonkEnvRec env1 new_binders - ; new_mzip <- zonkExpr env2 mzip_op - ; return (env2 - , ParStmt new_bind_ty new_stmts_w_bndrs new_mzip new_bind_op)} - where - zonk_branch :: ZonkEnv -> ParStmtBlock GhcTc GhcTc - -> TcM (ParStmtBlock GhcTc GhcTc) - zonk_branch env1 (ParStmtBlock x stmts bndrs return_op) - = do { (env2, new_stmts) <- zonkStmts env1 zonkLExpr stmts - ; (env3, new_return) <- zonkSyntaxExpr env2 return_op - ; return (ParStmtBlock x new_stmts (zonkIdOccs env3 bndrs) - new_return) } - -zonkStmt env zBody (RecStmt { recS_stmts = L _ segStmts, recS_later_ids = lvs - , recS_rec_ids = rvs - , recS_ret_fn = ret_id, recS_mfix_fn = mfix_id - , recS_bind_fn = bind_id - , recS_ext = - RecStmtTc { recS_bind_ty = bind_ty - , recS_later_rets = later_rets - , recS_rec_rets = rec_rets - , recS_ret_ty = ret_ty} }) - = do { (env1, new_bind_id) <- zonkSyntaxExpr env bind_id - ; (env2, new_mfix_id) <- zonkSyntaxExpr env1 mfix_id - ; (env3, new_ret_id) <- zonkSyntaxExpr env2 ret_id - ; new_bind_ty <- zonkTcTypeToTypeX env3 bind_ty - ; new_rvs <- zonkIdBndrs env3 rvs - ; new_lvs <- zonkIdBndrs env3 lvs - ; new_ret_ty <- zonkTcTypeToTypeX env3 ret_ty - ; let env4 = extendIdZonkEnvRec env3 new_rvs - ; (env5, new_segStmts) <- zonkStmts env4 zBody segStmts - -- Zonk the ret-expressions in an envt that - -- has the polymorphic bindings in the envt - ; new_later_rets <- mapM (zonkExpr env5) later_rets - ; new_rec_rets <- mapM (zonkExpr env5) rec_rets - ; return (extendIdZonkEnvRec env3 new_lvs, -- Only the lvs are needed - RecStmt { recS_stmts = noLocA new_segStmts - , recS_later_ids = new_lvs - , recS_rec_ids = new_rvs, recS_ret_fn = new_ret_id - , recS_mfix_fn = new_mfix_id, recS_bind_fn = new_bind_id - , recS_ext = RecStmtTc - { recS_bind_ty = new_bind_ty - , recS_later_rets = new_later_rets - , recS_rec_rets = new_rec_rets - , recS_ret_ty = new_ret_ty } }) } - -zonkStmt env zBody (BodyStmt ty body then_op guard_op) - = do (env1, new_then_op) <- zonkSyntaxExpr env then_op - (env2, new_guard_op) <- zonkSyntaxExpr env1 guard_op - new_body <- zBody env2 body - new_ty <- zonkTcTypeToTypeX env2 ty - return (env2, BodyStmt new_ty new_body new_then_op new_guard_op) - -zonkStmt env zBody (LastStmt x body noret ret_op) - = do (env1, new_ret) <- zonkSyntaxExpr env ret_op - new_body <- zBody env1 body - return (env, LastStmt x new_body noret new_ret) - -zonkStmt env _ (TransStmt { trS_stmts = stmts, trS_bndrs = binderMap - , trS_by = by, trS_form = form, trS_using = using - , trS_ret = return_op, trS_bind = bind_op - , trS_ext = bind_arg_ty - , trS_fmap = liftM_op }) - = do { - ; (env1, bind_op') <- zonkSyntaxExpr env bind_op - ; bind_arg_ty' <- zonkTcTypeToTypeX env1 bind_arg_ty - ; (env2, stmts') <- zonkStmts env1 zonkLExpr stmts - ; by' <- traverse (zonkLExpr env2) by - ; using' <- zonkLExpr env2 using - - ; (env3, return_op') <- zonkSyntaxExpr env2 return_op - ; binderMap' <- mapM (zonkBinderMapEntry env3) binderMap - ; liftM_op' <- zonkExpr env3 liftM_op - ; let env3' = extendIdZonkEnvRec env3 (map snd binderMap') - ; return (env3', TransStmt { trS_stmts = stmts', trS_bndrs = binderMap' - , trS_by = by', trS_form = form, trS_using = using' - , trS_ret = return_op', trS_bind = bind_op' - , trS_ext = bind_arg_ty' - , trS_fmap = liftM_op' }) } - where - zonkBinderMapEntry env (oldBinder, newBinder) = do - let oldBinder' = zonkIdOcc env oldBinder - newBinder' <- zonkIdBndr env newBinder - return (oldBinder', newBinder') - -zonkStmt env _ (LetStmt x binds) - = do (env1, new_binds) <- zonkLocalBinds env binds - return (env1, LetStmt x new_binds) - -zonkStmt env zBody (BindStmt xbs pat body) - = do { (env1, new_bind) <- zonkSyntaxExpr env (xbstc_bindOp xbs) - ; new_w <- zonkTcTypeToTypeX env1 (xbstc_boundResultMult xbs) - ; new_bind_ty <- zonkTcTypeToTypeX env1 (xbstc_boundResultType xbs) - ; new_body <- zBody env1 body - ; (env2, new_pat) <- zonkPat env1 pat - ; new_fail <- case xbstc_failOp xbs of - Nothing -> return Nothing - Just f -> fmap (Just . snd) (zonkSyntaxExpr env1 f) - ; return ( env2 - , BindStmt (XBindStmtTc - { xbstc_bindOp = new_bind - , xbstc_boundResultType = new_bind_ty - , xbstc_boundResultMult = new_w - , xbstc_failOp = new_fail - }) - new_pat new_body) } - --- Scopes: join > ops (in reverse order) > pats (in forward order) --- > rest of stmts -zonkStmt env _zBody (ApplicativeStmt body_ty args mb_join) - = do { (env1, new_mb_join) <- zonk_join env mb_join - ; (env2, new_args) <- zonk_args env1 args - ; new_body_ty <- zonkTcTypeToTypeX env2 body_ty - ; return ( env2 - , ApplicativeStmt new_body_ty new_args new_mb_join) } - where - zonk_join env Nothing = return (env, Nothing) - zonk_join env (Just j) = second Just <$> zonkSyntaxExpr env j - - get_pat :: (SyntaxExpr GhcTc, ApplicativeArg GhcTc) -> LPat GhcTc - get_pat (_, ApplicativeArgOne _ pat _ _) = pat - get_pat (_, ApplicativeArgMany _ _ _ pat _) = pat - - replace_pat :: LPat GhcTc - -> (SyntaxExpr GhcTc, ApplicativeArg GhcTc) - -> (SyntaxExpr GhcTc, ApplicativeArg GhcTc) - replace_pat pat (op, ApplicativeArgOne fail_op _ a isBody) - = (op, ApplicativeArgOne fail_op pat a isBody) - replace_pat pat (op, ApplicativeArgMany x a b _ c) - = (op, ApplicativeArgMany x a b pat c) - - zonk_args env args - = do { (env1, new_args_rev) <- zonk_args_rev env (reverse args) - ; (env2, new_pats) <- zonkPats env1 (map get_pat args) - ; return (env2, zipWithEqual "zonkStmt" replace_pat - new_pats (reverse new_args_rev)) } - - -- these need to go backward, because if any operators are higher-rank, - -- later operators may introduce skolems that are in scope for earlier - -- arguments - zonk_args_rev env ((op, arg) : args) - = do { (env1, new_op) <- zonkSyntaxExpr env op - ; new_arg <- zonk_arg env1 arg - ; (env2, new_args) <- zonk_args_rev env1 args - ; return (env2, (new_op, new_arg) : new_args) } - zonk_args_rev env [] = return (env, []) - - zonk_arg env (ApplicativeArgOne fail_op pat expr isBody) - = do { new_expr <- zonkLExpr env expr - ; new_fail <- forM fail_op $ \old_fail -> - do { (_, fail') <- zonkSyntaxExpr env old_fail - ; return fail' - } - ; return (ApplicativeArgOne new_fail pat new_expr isBody) } - zonk_arg env (ApplicativeArgMany x stmts ret pat ctxt) - = do { (env1, new_stmts) <- zonkStmts env zonkLExpr stmts - ; new_ret <- zonkExpr env1 ret - ; return (ApplicativeArgMany x new_stmts new_ret pat ctxt) } - -------------------------------------------------------------------------- -zonkRecFields :: ZonkEnv -> HsRecordBinds GhcTc -> TcM (HsRecordBinds GhcTc) -zonkRecFields env (HsRecFields flds dd) - = do { flds' <- mapM zonk_rbind flds - ; return (HsRecFields flds' dd) } - where - zonk_rbind (L l fld) - = do { new_id <- wrapLocMA (zonkFieldOcc env) (hfbLHS fld) - ; new_expr <- zonkLExpr env (hfbRHS fld) - ; return (L l (fld { hfbLHS = new_id - , hfbRHS = new_expr })) } - -{- -************************************************************************ -* * -\subsection[BackSubst-Pats]{Patterns} -* * -************************************************************************ --} - -zonkPat :: ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc) --- Extend the environment as we go, because it's possible for one --- pattern to bind something that is used in another (inside or --- to the right) -zonkPat env pat = wrapLocSndMA (zonk_pat env) pat - -zonk_pat :: ZonkEnv -> Pat GhcTc -> TcM (ZonkEnv, Pat GhcTc) -zonk_pat env (ParPat x lpar p rpar) - = do { (env', p') <- zonkPat env p - ; return (env', ParPat x lpar p' rpar) } - -zonk_pat env (WildPat ty) - = do { ty' <- zonkTcTypeToTypeX env ty - ; return (env, WildPat ty') } - -zonk_pat env (VarPat x (L l v)) - = do { v' <- zonkIdBndr env v - ; return (extendIdZonkEnv env v', VarPat x (L l v')) } - -zonk_pat env (LazyPat x pat) - = do { (env', pat') <- zonkPat env pat - ; return (env', LazyPat x pat') } - -zonk_pat env (BangPat x pat) - = do { (env', pat') <- zonkPat env pat - ; return (env', BangPat x pat') } - -zonk_pat env (AsPat x (L loc v) at pat) - = do { v' <- zonkIdBndr env v - ; (env', pat') <- zonkPat (extendIdZonkEnv env v') pat - ; return (env', AsPat x (L loc v') at pat') } - -zonk_pat env (ViewPat ty expr pat) - = do { expr' <- zonkLExpr env expr - ; (env', pat') <- zonkPat env pat - ; ty' <- zonkTcTypeToTypeX env ty - ; return (env', ViewPat ty' expr' pat') } - -zonk_pat env (ListPat ty pats) - = do { ty' <- zonkTcTypeToTypeX env ty - ; (env', pats') <- zonkPats env pats - ; return (env', ListPat ty' pats') } - -zonk_pat env (TuplePat tys pats boxed) - = do { tys' <- mapM (zonkTcTypeToTypeX env) tys - ; (env', pats') <- zonkPats env pats - ; return (env', TuplePat tys' pats' boxed) } - -zonk_pat env (SumPat tys pat alt arity ) - = do { tys' <- mapM (zonkTcTypeToTypeX env) tys - ; (env', pat') <- zonkPat env pat - ; return (env', SumPat tys' pat' alt arity) } - -zonk_pat env p@(ConPat { pat_args = args - , pat_con_ext = p'@(ConPatTc - { cpt_tvs = tyvars - , cpt_dicts = evs - , cpt_binds = binds - , cpt_wrap = wrapper - , cpt_arg_tys = tys - }) - }) - = assert (all isImmutableTyVar tyvars) $ - do { new_tys <- mapM (zonkTcTypeToTypeX env) tys - ; (env0, new_tyvars) <- zonkTyBndrsX env tyvars - -- Must zonk the existential variables, because their - -- /kind/ need potential zonking. - -- cf typecheck/should_compile/tc221.hs - ; (env1, new_evs) <- zonkEvBndrsX env0 evs - ; (env2, new_binds) <- zonkTcEvBinds env1 binds - ; (env3, new_wrapper) <- zonkCoFn env2 wrapper - ; (env', new_args) <- zonkConStuff env3 args - ; pure ( env' - , p - { pat_args = new_args - , pat_con_ext = p' - { cpt_arg_tys = new_tys - , cpt_tvs = new_tyvars - , cpt_dicts = new_evs - , cpt_binds = new_binds - , cpt_wrap = new_wrapper - } - } - ) - } - -zonk_pat env (LitPat x lit) = return (env, LitPat x lit) - -zonk_pat env (SigPat ty pat hs_ty) - = do { ty' <- zonkTcTypeToTypeX env ty - ; (env', pat') <- zonkPat env pat - ; return (env', SigPat ty' pat' hs_ty) } - -zonk_pat env (NPat ty (L l lit) mb_neg eq_expr) - = do { (env1, eq_expr') <- zonkSyntaxExpr env eq_expr - ; (env2, mb_neg') <- case mb_neg of - Nothing -> return (env1, Nothing) - Just n -> second Just <$> zonkSyntaxExpr env1 n - - ; lit' <- zonkOverLit env2 lit - ; ty' <- zonkTcTypeToTypeX env2 ty - ; return (env2, NPat ty' (L l lit') mb_neg' eq_expr') } - -zonk_pat env (NPlusKPat ty (L loc n) (L l lit1) lit2 e1 e2) - = do { (env1, e1') <- zonkSyntaxExpr env e1 - ; (env2, e2') <- zonkSyntaxExpr env1 e2 - ; n' <- zonkIdBndr env2 n - ; lit1' <- zonkOverLit env2 lit1 - ; lit2' <- zonkOverLit env2 lit2 - ; ty' <- zonkTcTypeToTypeX env2 ty - ; return (extendIdZonkEnv env2 n', - NPlusKPat ty' (L loc n') (L l lit1') lit2' e1' e2') } -zonk_pat env (XPat ext) = case ext of - { ExpansionPat orig pat-> - do { (env, pat') <- zonk_pat env pat - ; return $ (env, XPat $ ExpansionPat orig pat') } - ; CoPat co_fn pat ty -> - do { (env', co_fn') <- zonkCoFn env co_fn - ; (env'', pat') <- zonkPat env' (noLocA pat) - ; ty' <- zonkTcTypeToTypeX env'' ty - ; return (env'', XPat $ CoPat co_fn' (unLoc pat') ty') - }} - -zonk_pat _ pat = pprPanic "zonk_pat" (ppr pat) - ---------------------------- -zonkConStuff :: ZonkEnv -> HsConPatDetails GhcTc - -> TcM (ZonkEnv, HsConPatDetails GhcTc) -zonkConStuff env (PrefixCon tyargs pats) - = do { (env', pats') <- zonkPats env pats - ; return (env', PrefixCon tyargs pats') } - -zonkConStuff env (InfixCon p1 p2) - = do { (env1, p1') <- zonkPat env p1 - ; (env', p2') <- zonkPat env1 p2 - ; return (env', InfixCon p1' p2') } - -zonkConStuff env (RecCon (HsRecFields rpats dd)) - = do { (env', pats') <- zonkPats env (map (hfbRHS . unLoc) rpats) - ; let rpats' = zipWith (\(L l rp) p' -> - L l (rp { hfbRHS = p' })) - rpats pats' - ; return (env', RecCon (HsRecFields rpats' dd)) } - -- Field selectors have declared types; hence no zonking - ---------------------------- -zonkPats :: ZonkEnv -> [LPat GhcTc] -> TcM (ZonkEnv, [LPat GhcTc]) -zonkPats env [] = return (env, []) -zonkPats env (pat:pats) = do { (env1, pat') <- zonkPat env pat - ; (env', pats') <- zonkPats env1 pats - ; return (env', pat':pats') } - -{- -************************************************************************ -* * -\subsection[BackSubst-Foreign]{Foreign exports} -* * -************************************************************************ --} - -zonkForeignExports :: ZonkEnv -> [LForeignDecl GhcTc] - -> TcM [LForeignDecl GhcTc] -zonkForeignExports env ls = mapM (wrapLocMA (zonkForeignExport env)) ls - -zonkForeignExport :: ZonkEnv -> ForeignDecl GhcTc -> TcM (ForeignDecl GhcTc) -zonkForeignExport env (ForeignExport { fd_name = i, fd_e_ext = co - , fd_fe = spec }) - = return (ForeignExport { fd_name = zonkLIdOcc env i - , fd_sig_ty = undefined, fd_e_ext = co - , fd_fe = spec }) -zonkForeignExport _ for_imp - = return for_imp -- Foreign imports don't need zonking - -zonkRules :: ZonkEnv -> [LRuleDecl GhcTc] -> TcM [LRuleDecl GhcTc] -zonkRules env rs = mapM (wrapLocMA (zonkRule env)) rs - -zonkRule :: ZonkEnv -> RuleDecl GhcTc -> TcM (RuleDecl GhcTc) -zonkRule env rule@(HsRule { rd_tmvs = tm_bndrs{-::[RuleBndr TcId]-} - , rd_lhs = lhs - , rd_rhs = rhs }) - = do { (env_inside, new_tm_bndrs) <- mapAccumLM zonk_tm_bndr env tm_bndrs - - ; let env_lhs = setZonkType env_inside SkolemiseFlexi - -- See Note [Zonking the LHS of a RULE] - - ; new_lhs <- zonkLExpr env_lhs lhs - ; new_rhs <- zonkLExpr env_inside rhs - - ; return $ rule { rd_tmvs = new_tm_bndrs - , rd_lhs = new_lhs - , rd_rhs = new_rhs } } - where - zonk_tm_bndr :: ZonkEnv -> LRuleBndr GhcTc -> TcM (ZonkEnv, LRuleBndr GhcTc) - zonk_tm_bndr env (L l (RuleBndr x (L loc v))) - = do { (env', v') <- zonk_it env v - ; return (env', L l (RuleBndr x (L loc v'))) } - zonk_tm_bndr _ (L _ (RuleBndrSig {})) = panic "zonk_tm_bndr RuleBndrSig" - - zonk_it env v - | isId v = do { v' <- zonkIdBndr env v - ; return (extendIdZonkEnvRec env [v'], v') } - | otherwise = assert (isImmutableTyVar v) - zonkTyBndrX env v - -- DV: used to be return (env,v) but that is plain - -- wrong because we may need to go inside the kind - -- of v and zonk there! - -{- -************************************************************************ -* * - Constraints and evidence -* * -************************************************************************ --} - -zonkEvTerm :: ZonkEnv -> EvTerm -> TcM EvTerm -zonkEvTerm env (EvExpr e) - = EvExpr <$> zonkCoreExpr env e -zonkEvTerm env (EvTypeable ty ev) - = EvTypeable <$> zonkTcTypeToTypeX env ty <*> zonkEvTypeable env ev -zonkEvTerm env (EvFun { et_tvs = tvs, et_given = evs - , et_binds = ev_binds, et_body = body_id }) - = do { (env0, new_tvs) <- zonkTyBndrsX env tvs - ; (env1, new_evs) <- zonkEvBndrsX env0 evs - ; (env2, new_ev_binds) <- zonkTcEvBinds env1 ev_binds - ; let new_body_id = zonkIdOcc env2 body_id - ; return (EvFun { et_tvs = new_tvs, et_given = new_evs - , et_binds = new_ev_binds, et_body = new_body_id }) } - -zonkCoreExpr :: ZonkEnv -> CoreExpr -> TcM CoreExpr -zonkCoreExpr env (Var v) - | isCoVar v - = Coercion <$> zonkCoVarOcc env v - | otherwise - = return (Var $ zonkIdOcc env v) -zonkCoreExpr _ (Lit l) - = return $ Lit l -zonkCoreExpr env (Coercion co) - = Coercion <$> zonkCoToCo env co -zonkCoreExpr env (Type ty) - = Type <$> zonkTcTypeToTypeX env ty - -zonkCoreExpr env (Cast e co) - = Cast <$> zonkCoreExpr env e <*> zonkCoToCo env co -zonkCoreExpr env (Tick t e) - = Tick t <$> zonkCoreExpr env e -- Do we need to zonk in ticks? - -zonkCoreExpr env (App e1 e2) - = App <$> zonkCoreExpr env e1 <*> zonkCoreExpr env e2 -zonkCoreExpr env (Lam v e) - = do { (env1, v') <- zonkCoreBndrX env v - ; Lam v' <$> zonkCoreExpr env1 e } -zonkCoreExpr env (Let bind e) - = do (env1, bind') <- zonkCoreBind env bind - Let bind'<$> zonkCoreExpr env1 e -zonkCoreExpr env (Case scrut b ty alts) - = do scrut' <- zonkCoreExpr env scrut - ty' <- zonkTcTypeToTypeX env ty - b' <- zonkIdBndr env b - let env1 = extendIdZonkEnv env b' - alts' <- mapM (zonkCoreAlt env1) alts - return $ Case scrut' b' ty' alts' - -zonkCoreAlt :: ZonkEnv -> CoreAlt -> TcM CoreAlt -zonkCoreAlt env (Alt dc bndrs rhs) - = do (env1, bndrs') <- zonkCoreBndrsX env bndrs - rhs' <- zonkCoreExpr env1 rhs - return $ Alt dc bndrs' rhs' - -zonkCoreBind :: ZonkEnv -> CoreBind -> TcM (ZonkEnv, CoreBind) -zonkCoreBind env (NonRec v e) - = do v' <- zonkIdBndr env v - e' <- zonkCoreExpr env e - let env1 = extendIdZonkEnv env v' - return (env1, NonRec v' e') -zonkCoreBind env (Rec pairs) - = do (env1, pairs') <- fixM go - return (env1, Rec pairs') - where - go ~(_, new_pairs) = do - let env1 = extendIdZonkEnvRec env (map fst new_pairs) - pairs' <- mapM (zonkCorePair env1) pairs - return (env1, pairs') - -zonkCorePair :: ZonkEnv -> (CoreBndr, CoreExpr) -> TcM (CoreBndr, CoreExpr) -zonkCorePair env (v,e) = (,) <$> zonkIdBndr env v <*> zonkCoreExpr env e - -zonkEvTypeable :: ZonkEnv -> EvTypeable -> TcM EvTypeable -zonkEvTypeable env (EvTypeableTyCon tycon e) - = do { e' <- mapM (zonkEvTerm env) e - ; return $ EvTypeableTyCon tycon e' } -zonkEvTypeable env (EvTypeableTyApp t1 t2) - = do { t1' <- zonkEvTerm env t1 - ; t2' <- zonkEvTerm env t2 - ; return (EvTypeableTyApp t1' t2') } -zonkEvTypeable env (EvTypeableTrFun tm t1 t2) - = do { tm' <- zonkEvTerm env tm - ; t1' <- zonkEvTerm env t1 - ; t2' <- zonkEvTerm env t2 - ; return (EvTypeableTrFun tm' t1' t2') } -zonkEvTypeable env (EvTypeableTyLit t1) - = do { t1' <- zonkEvTerm env t1 - ; return (EvTypeableTyLit t1') } - -zonkTcEvBinds_s :: ZonkEnv -> [TcEvBinds] -> TcM (ZonkEnv, [TcEvBinds]) -zonkTcEvBinds_s env bs = do { (env, bs') <- mapAccumLM zonk_tc_ev_binds env bs - ; return (env, [EvBinds (unionManyBags bs')]) } - -zonkTcEvBinds :: ZonkEnv -> TcEvBinds -> TcM (ZonkEnv, TcEvBinds) -zonkTcEvBinds env bs = do { (env', bs') <- zonk_tc_ev_binds env bs - ; return (env', EvBinds bs') } - -zonk_tc_ev_binds :: ZonkEnv -> TcEvBinds -> TcM (ZonkEnv, Bag EvBind) -zonk_tc_ev_binds env (TcEvBinds var) = zonkEvBindsVar env var -zonk_tc_ev_binds env (EvBinds bs) = zonkEvBinds env bs - -zonkEvBindsVar :: ZonkEnv -> EvBindsVar -> TcM (ZonkEnv, Bag EvBind) -zonkEvBindsVar env (EvBindsVar { ebv_binds = ref }) - = do { bs <- readMutVar ref - ; zonkEvBinds env (evBindMapBinds bs) } -zonkEvBindsVar env (CoEvBindsVar {}) = return (env, emptyBag) - -zonkEvBinds :: ZonkEnv -> Bag EvBind -> TcM (ZonkEnv, Bag EvBind) -zonkEvBinds env binds - = {-# SCC "zonkEvBinds" #-} - fixM (\ ~( _, new_binds) -> do - { let env1 = extendIdZonkEnvRec env (collect_ev_bndrs new_binds) - ; binds' <- mapBagM (zonkEvBind env1) binds - ; return (env1, binds') }) - where - collect_ev_bndrs :: Bag EvBind -> [EvVar] - collect_ev_bndrs = foldr add [] - add (EvBind { eb_lhs = var }) vars = var : vars - -zonkEvBind :: ZonkEnv -> EvBind -> TcM EvBind -zonkEvBind env bind@(EvBind { eb_lhs = var, eb_rhs = term }) - = do { var' <- {-# SCC "zonkEvBndr" #-} zonkEvBndr env var - - -- Optimise the common case of Refl coercions - -- See Note [Optimise coercion zonking] - -- This has a very big effect on some programs (eg #5030) - - ; term' <- case getEqPredTys_maybe (idType var') of - Just (r, ty1, ty2) | ty1 `eqType` ty2 - -> return (evCoercion (mkReflCo r ty1)) - _other -> zonkEvTerm env term - - ; return (bind { eb_lhs = var', eb_rhs = term' }) } - -{- Note [Optimise coercion zonking] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When optimising evidence binds we may come across situations where -a coercion looks like - cv = ReflCo ty -or cv1 = cv2 -where the type 'ty' is big. In such cases it is a waste of time to zonk both - * The variable on the LHS - * The coercion on the RHS -Rather, we can zonk the variable, and if its type is (ty ~ ty), we can just -use Refl on the right, ignoring the actual coercion on the RHS. - -This can have a very big effect, because the constraint solver sometimes does go -to a lot of effort to prove Refl! (Eg when solving 10+3 = 10+3; cf #5030) - - -************************************************************************ -* * - Zonking types -* * -************************************************************************ --} - -{- Note [Sharing when zonking to Type] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Problem: - - In GHC.Tc.Utils.TcMType.zonkTcTyVar, we short-circuit (Indirect ty) to - (Indirect zty), see Note [Sharing in zonking] in GHC.Tc.Utils.TcMType. But we - /can't/ do this when zonking a TcType to a Type (#15552, esp - comment:3). Suppose we have - - alpha -> alpha - where - alpha is already unified: - alpha := T{tc-tycon} Int -> Int - and T is knot-tied - - By "knot-tied" I mean that the occurrence of T is currently a TcTyCon, - but the global env contains a mapping "T" :-> T{knot-tied-tc}. See - Note [Type checking recursive type and class declarations] in - GHC.Tc.TyCl. - - Now we call zonkTcTypeToType on that (alpha -> alpha). If we follow - the same path as Note [Sharing in zonking] in GHC.Tc.Utils.TcMType, we'll - update alpha to - alpha := T{knot-tied-tc} Int -> Int - - But alas, if we encounter alpha for a /second/ time, we end up - looking at T{knot-tied-tc} and fall into a black hole. The whole - point of zonkTcTypeToType is that it produces a type full of - knot-tied tycons, and you must not look at the result!! - - To put it another way (zonkTcTypeToType . zonkTcTypeToType) is not - the same as zonkTcTypeToType. (If we distinguished TcType from - Type, this issue would have been a type error!) - -Solutions: (see #15552 for other variants) - -One possible solution is simply not to do the short-circuiting. -That has less sharing, but maybe sharing is rare. And indeed, -that usually turns out to be viable from a perf point of view - -But zonkTyVarOcc implements something a bit better - -* ZonkEnv contains ze_meta_tv_env, which maps - from a MetaTyVar (unification variable) - to a Type (not a TcType) - -* In zonkTyVarOcc, we check this map to see if we have zonked - this variable before. If so, use the previous answer; if not - zonk it, and extend the map. - -* The map is of course stateful, held in a TcRef. (That is unlike - the treatment of lexically-scoped variables in ze_tv_env and - ze_id_env.) - -* In zonkTyVarOcc we read the TcRef to look up the unification - variable: - - if we get a hit we use the zonked result; - - if not, in zonk_meta we see if the variable is `Indirect ty`, - zonk that, and update the map (in finish_meta) - But Nota Bene that the "update map" step must re-read the TcRef - (or, more precisely, use updTcRef) because the zonking of the - `Indirect ty` may have added lots of stuff to the map. See - #19668 for an example where this made an asymptotic difference! - -Is it worth the extra work of carrying ze_meta_tv_env? Some -non-systematic perf measurements suggest that compiler allocation is -reduced overall (by 0.5% or so) but compile time really doesn't -change. But in some cases it makes a HUGE difference: see test -T9198 and #19668. So yes, it seems worth it. --} - -zonkTyVarOcc :: HasDebugCallStack => ZonkEnv -> TcTyVar -> TcM Type -zonkTyVarOcc env@(ZonkEnv { ze_flexi = flexi - , ze_tv_env = tv_env - , ze_meta_tv_env = mtv_env_ref }) tv - | isTcTyVar tv - = case tcTyVarDetails tv of - SkolemTv {} -> lookup_in_tv_env - RuntimeUnk {} -> lookup_in_tv_env - MetaTv { mtv_ref = ref } - -> do { mtv_env <- readTcRef mtv_env_ref - -- See Note [Sharing when zonking to Type] - ; case lookupVarEnv mtv_env tv of - Just ty -> return ty - Nothing -> do { mtv_details <- readTcRef ref - ; zonk_meta ref mtv_details } } - | otherwise -- This should never really happen; - -- TyVars should not occur in the typechecker - = lookup_in_tv_env - - where - lookup_in_tv_env -- Look up in the env just as we do for Ids - = case lookupVarEnv tv_env tv of - Nothing -> -- TyVar/SkolemTv/RuntimeUnk that isn't in the ZonkEnv - -- This can happen for RuntimeUnk variables (which - -- should stay as RuntimeUnk), but I think it should - -- not happen for SkolemTv. - mkTyVarTy <$> updateTyVarKindM (zonkTcTypeToTypeX env) tv - - Just tv' -> return (mkTyVarTy tv') - - zonk_meta ref Flexi - = do { kind <- zonkTcTypeToTypeX env (tyVarKind tv) - ; ty <- commitFlexi flexi tv kind - ; writeMetaTyVarRef tv ref ty -- Belt and braces - ; finish_meta ty } - - zonk_meta _ (Indirect ty) - = do { zty <- zonkTcTypeToTypeX env ty - ; finish_meta zty } - - finish_meta ty - = do { updTcRef mtv_env_ref (\env -> extendVarEnv env tv ty) - ; return ty } - -lookupTyVarX :: ZonkEnv -> TcTyVar -> TyVar -lookupTyVarX (ZonkEnv { ze_tv_env = tv_env }) tv - = case lookupVarEnv tv_env tv of - Just tv -> tv - Nothing -> pprPanic "lookupTyVarOcc" (ppr tv $$ ppr tv_env) - -commitFlexi :: ZonkFlexi -> TcTyVar -> Kind -> TcM Type --- Only monadic so we can do tc-tracing -commitFlexi flexi tv zonked_kind - = case flexi of - SkolemiseFlexi -> return (mkTyVarTy (mkTyVar name zonked_kind)) - - DefaultFlexi - -- Normally, RuntimeRep variables are defaulted in TcMType.defaultTyVar - -- But that sees only type variables that appear in, say, an inferred type - -- Defaulting here in the zonker is needed to catch e.g. - -- y :: Bool - -- y = (\x -> True) undefined - -- We need *some* known RuntimeRep for the x and undefined, but no one - -- will choose it until we get here, in the zonker. - | isRuntimeRepTy zonked_kind - -> do { traceTc "Defaulting flexi tyvar to LiftedRep:" (pprTyVar tv) - ; return liftedRepTy } - | isLevityTy zonked_kind - -> do { traceTc "Defaulting flexi tyvar to Lifted:" (pprTyVar tv) - ; return liftedDataConTy } - | isMultiplicityTy zonked_kind - -> do { traceTc "Defaulting flexi tyvar to Many:" (pprTyVar tv) - ; return manyDataConTy } - | Just (ConcreteFRR origin) <- isConcreteTyVar_maybe tv - -> do { addErr $ TcRnCannotDefaultConcrete origin - ; return (anyTypeOfKind zonked_kind) } - | otherwise - -> do { traceTc "Defaulting flexi tyvar to Any:" (pprTyVar tv) - ; return (anyTypeOfKind zonked_kind) } - - RuntimeUnkFlexi - -> do { traceTc "Defaulting flexi tyvar to RuntimeUnk:" (pprTyVar tv) - ; return (mkTyVarTy (mkTcTyVar name zonked_kind RuntimeUnk)) } - -- This is where RuntimeUnks are born: - -- otherwise-unconstrained unification variables are - -- turned into RuntimeUnks as they leave the - -- typechecker's monad - - NoFlexi -> pprPanic "NoFlexi" (ppr tv <+> dcolon <+> ppr zonked_kind) - - where - name = tyVarName tv - -zonkCoVarOcc :: ZonkEnv -> CoVar -> TcM Coercion -zonkCoVarOcc (ZonkEnv { ze_tv_env = tyco_env }) cv - | Just cv' <- lookupVarEnv tyco_env cv -- don't look in the knot-tied env - = return $ mkCoVarCo cv' - | otherwise - = do { cv' <- zonkCoVar cv; return (mkCoVarCo cv') } - -zonkCoHole :: ZonkEnv -> CoercionHole -> TcM Coercion -zonkCoHole env hole@(CoercionHole { ch_ref = ref, ch_co_var = cv }) - = do { contents <- readTcRef ref - ; case contents of - Just co -> do { co' <- zonkCoToCo env co - ; checkCoercionHole cv co' } - - -- This next case should happen only in the presence of - -- (undeferred) type errors. Originally, I put in a panic - -- here, but that caused too many uses of `failIfErrsM`. - Nothing -> do { traceTc "Zonking unfilled coercion hole" (ppr hole) - ; cv' <- zonkCoVar cv - ; return $ mkCoVarCo cv' } } - -- This will be an out-of-scope variable, but keeping - -- this as a coercion hole led to #15787 - -zonk_tycomapper :: TyCoMapper ZonkEnv TcM -zonk_tycomapper = TyCoMapper - { tcm_tyvar = zonkTyVarOcc - , tcm_covar = zonkCoVarOcc - , tcm_hole = zonkCoHole - , tcm_tycobinder = \env tv _vis -> zonkTyBndrX env tv - , tcm_tycon = zonkTcTyConToTyCon } - --- Zonk a TyCon by changing a TcTyCon to a regular TyCon -zonkTcTyConToTyCon :: TcTyCon -> TcM TyCon -zonkTcTyConToTyCon tc - | isTcTyCon tc = do { thing <- tcLookupGlobalOnly (getName tc) - ; case thing of - ATyCon real_tc -> return real_tc - _ -> pprPanic "zonkTcTyCon" (ppr tc $$ ppr thing) } - | otherwise = return tc -- it's already zonked - --- Confused by zonking? See Note [What is zonking?] in GHC.Tc.Utils.TcMType. -zonkTcTypeToType :: TcType -> TcM Type -zonkTcTypeToType ty = initZonkEnv $ \ ze -> zonkTcTypeToTypeX ze ty - -zonkScaledTcTypeToTypeX :: ZonkEnv -> Scaled TcType -> TcM (Scaled TcType) -zonkScaledTcTypeToTypeX env (Scaled m ty) = Scaled <$> zonkTcTypeToTypeX env m - <*> zonkTcTypeToTypeX env ty - -zonkTcTypeToTypeX :: ZonkEnv -> TcType -> TcM Type -zonkTcTypesToTypesX :: ZonkEnv -> [TcType] -> TcM [Type] -zonkCoToCo :: ZonkEnv -> Coercion -> TcM Coercion -(zonkTcTypeToTypeX, zonkTcTypesToTypesX, zonkCoToCo, _) - = mapTyCoX zonk_tycomapper - -zonkScaledTcTypesToTypesX :: ZonkEnv -> [Scaled TcType] -> TcM [Scaled Type] -zonkScaledTcTypesToTypesX env scaled_tys = - mapM (zonkScaledTcTypeToTypeX env) scaled_tys - -zonkTcMethInfoToMethInfoX :: ZonkEnv -> TcMethInfo -> TcM MethInfo -zonkTcMethInfoToMethInfoX ze (name, ty, gdm_spec) - = do { ty' <- zonkTcTypeToTypeX ze ty - ; gdm_spec' <- zonk_gdm gdm_spec - ; return (name, ty', gdm_spec') } - where - zonk_gdm :: Maybe (DefMethSpec (SrcSpan, TcType)) - -> TcM (Maybe (DefMethSpec (SrcSpan, Type))) - zonk_gdm Nothing = return Nothing - zonk_gdm (Just VanillaDM) = return (Just VanillaDM) - zonk_gdm (Just (GenericDM (loc, ty))) - = do { ty' <- zonkTcTypeToTypeX ze ty - ; return (Just (GenericDM (loc, ty'))) } - ---------------------------------------- -{- Note [Zonking the LHS of a RULE] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -See also GHC.HsToCore.Binds Note [Free tyvars on rule LHS] - -We need to gather the type variables mentioned on the LHS so we can -quantify over them. Example: - data T a = C - - foo :: T a -> Int - foo C = 1 - - {-# RULES "myrule" foo C = 1 #-} - -After type checking the LHS becomes (foo alpha (C alpha)) and we do -not want to zap the unbound meta-tyvar 'alpha' to Any, because that -limits the applicability of the rule. Instead, we want to quantify -over it! - -We do this in two stages. - -* During zonking, we skolemise the TcTyVar 'alpha' to TyVar 'a'. We - do this by using zonkTvSkolemising as the UnboundTyVarZonker in the - ZonkEnv. (This is in fact the whole reason that the ZonkEnv has a - UnboundTyVarZonker.) - -* In GHC.HsToCore.Binds, we quantify over it. See GHC.HsToCore.Binds - Note [Free tyvars on rule LHS] - -Quantifying here is awkward because (a) the data type is big and (b) -finding the free type vars of an expression is necessarily monadic -operation. (consider /\a -> f @ b, where b is side-effected to a) --} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/82eacab6b0a714ea63c911cd332bc6fdf7ec960e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/82eacab6b0a714ea63c911cd332bc6fdf7ec960e You're receiving 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 Jun 2 13:39:25 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Fri, 02 Jun 2023 09:39:25 -0400 Subject: [Git][ghc/ghc][wip/expand-do] generate incomplete uni patterns warnings if the origin context is a generated do expansion Message-ID: <6479f10de89ae_1797833fa2d8411192f@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: b8040095 by Apoorv Ingle at 2023-06-02T08:39:15-05:00 generate incomplete uni patterns warnings if the origin context is a generated do expansion - - - - - 3 changed files: - compiler/GHC/HsToCore/Match.hs - + compiler/GHC/Tc/Gen/.#Expr.hs - compiler/GHC/Tc/Gen/Match.hs Changes: ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -28,7 +28,7 @@ import Language.Haskell.Syntax.Basic (Boxity(..)) import {-#SOURCE#-} GHC.HsToCore.Expr (dsExpr) -import GHC.Types.Basic ( Origin(..), isGenerated ) +import GHC.Types.Basic ( Origin(..), isGenerated, isDoExpansionGenerated ) import GHC.Types.SourceText import GHC.Driver.DynFlags import GHC.Hs @@ -830,7 +830,7 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches' , eqn_rhs = match_result } } discard_warnings_if_generated orig = - if isGenerated orig + if isGenerated orig && not (isDoExpansionGenerated orig) -- better abstraction? then discardWarningsDs else id ===================================== compiler/GHC/Tc/Gen/.#Expr.hs ===================================== @@ -0,0 +1 @@ +aningle at CS-M030.71606 \ No newline at end of file ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1344,7 +1344,7 @@ expand_do_stmts do_or_lc ((L _ (ApplicativeStmt _ args mb_join)): lstmts) = , app_arg_pattern = pat@(L loc _) , arg_expr = rhs }) = - return ((pat, mb_fail_op), wrapGenSpan (mkExpandedStmt (L loc (BindStmt xbsn pat rhs)) rhs)) + return ((pat, mb_fail_op), L loc (mkExpandedStmt (L loc (BindStmt xbsn pat rhs)) rhs)) do_arg (ApplicativeArgMany _ stmts ret pat ctxt) = do { expr <- expand_do_stmts ctxt $ stmts ++ [wrapGenSpan $ mkLastStmt (wrapGenSpan ret)] ; return ((pat, Nothing), expr) } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b804009505e9aa7c06ee6d48af3a7d691267d888 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b804009505e9aa7c06ee6d48af3a7d691267d888 You're receiving 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 Jun 2 13:53:24 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Fri, 02 Jun 2023 09:53:24 -0400 Subject: [Git][ghc/ghc][wip/expand-do] use the correct bind operator for qualified rebindable rec do expansions Message-ID: <6479f454491d1_179783c3758116277@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 65df79ab by Apoorv Ingle at 2023-06-02T08:53:16-05:00 use the correct bind operator for qualified rebindable rec do expansions - - - - - 1 changed file: - compiler/GHC/Tc/Gen/Match.hs Changes: ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -43,7 +43,7 @@ import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcSyntaxOp, tcInferRho, tcInferRhoNC , tcCheckMonoExpr, tcCheckMonoExprNC , tcCheckPolyExpr ) -import GHC.Rename.Utils ( bindLocalNames, genHsApp, genLHsVar, wrapGenSpan ) +import GHC.Rename.Utils ( bindLocalNames, genHsApp, wrapGenSpan ) import GHC.Tc.Errors.Types import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Env @@ -67,7 +67,6 @@ import GHC.Hs import GHC.Builtin.Types import GHC.Builtin.Types.Prim -import GHC.Builtin.Names (bindMName) import GHC.Utils.Outputable import GHC.Utils.Panic @@ -1271,6 +1270,7 @@ expand_do_stmts do_or_lc ((L do_loc (RecStmt { recS_stmts = L stmts_loc rec_stmts , recS_later_ids = later_ids -- forward referenced local ids , recS_rec_ids = local_ids -- ids referenced outside of the rec block + , recS_bind_fn = SyntaxExprRn bind_fun -- the (>>=) expr , recS_mfix_fn = SyntaxExprRn mfix_fun -- the `mfix` expr , recS_ret_fn = SyntaxExprRn return_fun -- the `return` expr -- use it explicitly @@ -1286,7 +1286,7 @@ expand_do_stmts do_or_lc -- ; return (local_only_ids ++ later_ids) } )) -- (\ [ local_only_ids ++ later_ids ] -> stmts') do expand_stmts <- expand_do_stmts do_or_lc lstmts - return $ mkHsApps (genLHsVar bindMName) -- (Prelude.>>=) + return $ mkHsApps (wrapGenSpan bind_fun) -- (>>=) [ (wrapGenSpan mfix_fun) `mkHsApp` mfix_expr -- (mfix (do block)) , mkHsLamDoExp [ mkBigLHsVarPatTup all_ids ] -- (\ x -> (genPopSrcSpanExpr expand_stmts) -- stmts') View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/65df79ab5c13e2abc80f260930b2083e90325225 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/65df79ab5c13e2abc80f260930b2083e90325225 You're receiving 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 Jun 2 14:09:58 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Fri, 02 Jun 2023 10:09:58 -0400 Subject: [Git][ghc/ghc][wip/or-pats] Play around with Match Message-ID: <6479f836d5677_1797833fa285c11678@gitlab.mail> David pushed to branch wip/or-pats at Glasgow Haskell Compiler / GHC Commits: 3f8bb183 by David Knothe at 2023-06-02T16:09:47+02:00 Play around with Match - - - - - 3 changed files: - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match.hs-boot - compiler/GHC/HsToCore/Match/Literal.hs Changes: ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -21,13 +21,15 @@ module GHC.HsToCore.Match ) where +import GHC.Stack import GHC.Prelude import GHC.Platform import Language.Haskell.Syntax.Basic (Boxity(..)) import {-#SOURCE#-} GHC.HsToCore.Expr (dsExpr) - +import Data.List (intercalate) +import Debug.Trace import GHC.Types.Basic ( Origin(..), isGenerated ) import GHC.Types.SourceText import GHC.Driver.DynFlags @@ -178,9 +180,20 @@ with External names (#13043). See also Note [Localise pattern binders] in GHC.HsToCore.Utils -} +-- input: equationInfo +-- output: do call to `match` (recursing into matchNew) but group the first var beforehand +-- for the call to match, construct a EqnInfo with only a single pattern and put the recursive call into the eqn_rhs. + +--matchNew :: [MatchId] +-- -> Type +-- -> [EquationInfo] +-- -> Dsm (MatchResult CoreExpr) + + + type MatchId = Id -- See Note [Match Ids] -match :: [MatchId] -- ^ Variables rep\'ing the exprs we\'re matching with +match :: HasCallStack => [MatchId] -- ^ Variables rep\'ing the exprs we\'re matching with -- ^ See Note [Match Ids] -- -- ^ Note that the Match Ids carry not only a name, but @@ -204,14 +217,22 @@ match (v:vs) ty eqns -- Eqns *can* be empty ; let platform = targetPlatform dflags -- Tidy the first pattern, generating -- auxiliary bindings if necessary + -- ; traceM ("tidy " ++ show (length eqns) ++ " " ++ (show . length . eqn_pats . head) eqns) ; (aux_binds, tidy_eqns) <- mapAndUnzipM (tidyEqnInfo v) eqns -- Group the equations and match each group in turn ; let grouped = groupEquations platform tidy_eqns + ; grouped' <- mapM (moveGroupVarsIntoRhs vs ty) grouped + + ; traceM ("Before moving: " ++ show (length grouped) ++ " groups:") + ; testPrint grouped + ; traceM ("After moving: " ++ show (length grouped') ++ " groups:") + ; testPrint grouped' + ; traceM "" -- print the view patterns that are commoned up to help debug - ; whenDOptM Opt_D_dump_view_pattern_commoning (debug grouped) + ; whenDOptM Opt_D_dump_view_pattern_commoning (debug grouped') - ; match_results <- match_groups grouped + ; match_results <- match_groups grouped' ; return $ foldr (.) id aux_binds <$> foldr1 combineMatchResults match_results } @@ -248,6 +269,15 @@ match (v:vs) ty eqns -- Eqns *can* be empty -- FIXME: we should also warn about view patterns that should be -- commoned up but are not + testPrint :: Applicative f => [NonEmpty (PatGroup, EquationInfo)] -> f () + testPrint groups = + traceM $ intercalate "\n" $ map + (\group -> intercalate " ; " $ map + (\(pg, eqn) -> (show pg ++ " " ++ (intercalate " " $ map (showSDocUnsafe . pprLPat . mklpat) (eqn_pats eqn)))) + (NEL.toList group)) + groups + mklpat pat = L noSrcSpanA pat + -- print some stuff to see what's getting grouped -- use -dppr-debug to see the resolution of overloaded literals debug eqns = @@ -267,10 +297,25 @@ matchEmpty var res_ty mk_seq fail = return $ mkWildCase (Var var) (idScaledType var) res_ty [Alt DEFAULT [] fail] +{- +f 1 2 3 = a +f 1 3 4 = b +f (1|2) 4 5 = c + +Eqn 1 2 3 -> a +Eqn 1 3 4 -> b +Eqn 1 -> $ +Eqn 2 -> $ +where $ = match 4 5 c + +match 1 -> [match {Eqn 2 3 a, Eqn 3 4 b}] +-} + + matchVariables :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) -- Real true variables, just like in matchVar, SLPJ p 94 -- No binding to do: they'll all be wildcards by now (done in tidy) -matchVariables (_ :| vars) ty eqns = match vars ty $ NEL.toList $ shiftEqns eqns +matchVariables (_ :| vars) ty eqns = return (eqn_rhs (NEL.head eqns)) -- match vars ty $ NEL.toList $ shiftEqns eqns matchBangs :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) matchBangs (var :| vars) ty eqns @@ -408,7 +453,29 @@ only these which can be assigned a PatternGroup (see patGroup). -} -tidyEqnInfo :: Id -> EquationInfo +moveGroupVarsIntoRhs :: HasCallStack => [Id] -> Type -> NonEmpty (PatGroup, EquationInfo) -> DsM (NonEmpty (PatGroup, EquationInfo)) +moveGroupVarsIntoRhs vs ty group = do + if (length . eqn_pats . snd . NEL.head) group == 1 + then return group + else do + let rest = NEL.map (\(_, eqn) -> eqn { eqn_pats = tail (eqn_pats eqn) }) group + rhs <- match vs ty (NEL.toList rest) + let (gp, eq) = NEL.head group + return $ NEL.singleton (gp, EqnInfo { eqn_pats = [head (eqn_pats eq)], eqn_orig = eqn_orig eq, eqn_rhs = rhs }) + --return $ NEL.map (\(gp, eqn) -> (gp, eqn { eqn_pats = [head (eqn_pats eqn)], eqn_rhs = combineMatchResults rhs (eqn_rhs eqn) })) group + +{- +moveVarsIntoRhs :: HasCallStack => [Id] -> Type -> EquationInfo -> DsM EquationInfo +moveVarsIntoRhs vs ty eqn + | length (eqn_pats eqn) == 0 = fail "argh" + | length (eqn_pats eqn) == 1 = do pure eqn + | otherwise = do + let eq' = eqn { eqn_pats = tail (eqn_pats eqn) } + rhs <- match vs ty [eq'] + return eqn { eqn_pats = [head (eqn_pats eqn)], eqn_rhs = combineMatchResults rhs (eqn_rhs eqn) } +-} + +tidyEqnInfo :: HasCallStack => Id -> EquationInfo -> DsM (DsWrapper, EquationInfo) -- DsM'd because of internal call to dsLHsBinds -- and mkSelectorBinds. @@ -1004,6 +1071,14 @@ data PatGroup Type -- the Type is the type of p (equivalently, the result type of e) | PgOr -- Or pattern +instance Show PatGroup where + show PgAny = "PgAny" + show (PgCon _) = "PgCon" + show (PgLit _) = "PgLit" + show (PgView _ _) = "PgView" + show PgOr = "PgOr" + show _ = "PgOther" + {- Note [Don't use Literal for PgN] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Previously we had, as PatGroup constructors ===================================== compiler/GHC/HsToCore/Match.hs-boot ===================================== @@ -1,5 +1,6 @@ module GHC.HsToCore.Match where +import GHC.Stack (HasCallStack) import GHC.Prelude import GHC.Types.Var ( Id ) import GHC.Tc.Utils.TcType ( Type ) @@ -8,7 +9,7 @@ import GHC.Core ( CoreExpr ) import GHC.Hs ( LPat, HsMatchContext, MatchGroup, LHsExpr ) import GHC.Hs.Extension ( GhcTc, GhcRn ) -match :: [Id] +match :: HasCallStack => [Id] -> Type -> [EquationInfo] -> DsM (MatchResult CoreExpr) ===================================== compiler/GHC/HsToCore/Match/Literal.hs ===================================== @@ -609,7 +609,7 @@ matchLiterals :: NonEmpty Id -> NonEmpty (NonEmpty EquationInfo) -- ^ All PgLits -> DsM (MatchResult CoreExpr) -matchLiterals (var :| vars) ty sub_groups +matchLiterals (var :| _) ty sub_groups = do { -- Deal with each group ; alts <- mapM match_group sub_groups @@ -625,12 +625,11 @@ matchLiterals (var :| vars) ty sub_groups } where match_group :: NonEmpty EquationInfo -> DsM (Literal, MatchResult CoreExpr) - match_group eqns@(firstEqn :| _) + match_group (firstEqn :| _) = do { dflags <- getDynFlags ; let platform = targetPlatform dflags ; let LitPat _ hs_lit = firstPat firstEqn - ; match_result <- match vars ty (NEL.toList $ shiftEqns eqns) - ; return (hsLitKey platform hs_lit, match_result) } + ; return (hsLitKey platform hs_lit, eqn_rhs firstEqn) } wrap_str_guard :: Id -> (Literal,MatchResult CoreExpr) -> DsM (MatchResult CoreExpr) -- Equality check for string literals View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3f8bb1835d0b13294a589eff78db62a6215625b1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3f8bb1835d0b13294a589eff78db62a6215625b1 You're receiving 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 Jun 2 15:24:01 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 02 Jun 2023 11:24:01 -0400 Subject: [Git][ghc/ghc][wip/T22010] Convert dominators to Word64 Message-ID: <647a099174387_1797833fa2870129127@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 426bb3ad by Jaro Reinders at 2023-06-02T17:23:48+02:00 Convert dominators to Word64 - - - - - 3 changed files: - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs Changes: ===================================== compiler/GHC/Cmm/Dominators.hs ===================================== @@ -28,6 +28,7 @@ import qualified Data.Tree as Tree import qualified Data.IntMap.Strict as IM import qualified Data.IntSet as IS +import Data.Word import qualified GHC.CmmToAsm.CFG.Dominators as LT @@ -41,6 +42,10 @@ import GHC.Cmm import GHC.Utils.Outputable( Outputable(..), text, int, hcat, (<+>)) import GHC.Utils.Misc import GHC.Utils.Panic +import GHC.Data.Word64Map (Word64Map) +import GHC.Data.Word64Set (Word64Set) +import qualified GHC.Data.Word64Map as WM +import qualified GHC.Data.Word64Set as WS -- | =Dominator sets @@ -132,30 +137,31 @@ graphWithDominators :: forall node . graphWithDominators g = GraphWithDominators (reachable rpblocks g) dmap rpmap where rpblocks = revPostorderFrom (graphMap g) (g_entry g) rplabels' = map entryLabel rpblocks - rplabels :: Array Int Label + rplabels :: Array Word64 Label rplabels = listArray bounds rplabels' rpmap :: LabelMap RPNum rpmap = mapFromList $ zipWith kvpair rpblocks [0..] where kvpair block i = (entryLabel block, RPNum i) - labelIndex :: Label -> Int + labelIndex :: Label -> Word64 labelIndex = flip findLabelIn imap - where imap :: LabelMap Int + where imap :: LabelMap Word64 imap = mapFromList $ zip rplabels' [0..] blockIndex = labelIndex . entryLabel - bounds = (0, length rpblocks - 1) + bounds :: (Word64, Word64) + bounds = (0, fromIntegral (length rpblocks - 1)) - ltGraph :: [Block node C C] -> LT.Graph - ltGraph [] = IM.empty + ltGraph :: [Block node C C] -> Word64Map Word64Set + ltGraph [] = WM.empty ltGraph (block:blocks) = - IM.insert + WM.insert (blockIndex block) - (IS.fromList $ map labelIndex $ successors block) + (WS.fromList $ map labelIndex $ successors block) (ltGraph blocks) - idom_array :: Array Int LT.Node + idom_array :: Array Word64 Word64 idom_array = array bounds $ LT.idom (0, ltGraph rpblocks) domSet 0 = EntryNode ===================================== compiler/GHC/CmmToAsm/CFG.hs ===================================== @@ -858,7 +858,7 @@ loopInfo cfg root = LoopInfo { liBackEdges = backEdges rooted = ( fromBlockId root , toWord64Map $ fmap toWord64Set graph) :: (Word64, Word64Map Word64Set) -- FIXME: Convert domTree to use Word64Map/Set too. - tree = fmap toBlockId $ undefined Dom.domTree rooted :: Tree BlockId + tree = fmap toBlockId $ Dom.domTree rooted :: Tree BlockId -- Map from Nodes to their dominators domMap :: LabelMap LabelSet ===================================== compiler/GHC/CmmToAsm/CFG/Dominators.hs ===================================== @@ -61,6 +61,11 @@ import Data.Array.ST import Data.Array.Base (unsafeNewArray_ ,unsafeWrite,unsafeRead) +import GHC.Data.Word64Set (Word64Set) +import qualified GHC.Data.Word64Set as WS +import GHC.Data.Word64Map (Word64Map) +import qualified GHC.Data.Word64Map as WM +import Data.Word ----------------------------------------------------------------------------- @@ -68,23 +73,23 @@ type Node = Int type Path = [Node] type Edge = (Node,Node) type Graph = IntMap IntSet -type Rooted = (Node, Graph) +type Rooted = (Word64, Word64Map Word64Set) ----------------------------------------------------------------------------- -- | /Dominators/. -- Complexity as for @idom@ -dom :: Rooted -> [(Node, Path)] +dom :: Rooted -> [(Word64, [Word64])] dom = ancestors . domTree -- | /Post-dominators/. -- Complexity as for @idom at . -pdom :: Rooted -> [(Node, Path)] +pdom :: Rooted -> [(Word64, [Word64])] pdom = ancestors . pdomTree -- | /Dominator tree/. -- Complexity as for @idom at . -domTree :: Rooted -> Tree Node +domTree :: Rooted -> Tree Word64 domTree a@(r,_) = let is = filter ((/=r).fst) (idom a) tg = fromEdges (fmap swap is) @@ -92,7 +97,7 @@ domTree a@(r,_) = -- | /Post-dominator tree/. -- Complexity as for @idom at . -pdomTree :: Rooted -> Tree Node +pdomTree :: Rooted -> Tree Word64 pdomTree a@(r,_) = let is = filter ((/=r).fst) (ipdom a) tg = fromEdges (fmap swap is) @@ -105,29 +110,29 @@ pdomTree a@(r,_) = -- This Complexity bound assumes /O(1)/ indexing. Since we're -- using @IntMap@, it has an additional /lg |V|/ factor -- somewhere in there. I'm not sure where. -idom :: Rooted -> [(Node,Node)] +idom :: Rooted -> [(Word64,Word64)] idom rg = runST (evalS idomM =<< initEnv (pruneReach rg)) -- | /Immediate post-dominators/. -- Complexity as for @idom at . -ipdom :: Rooted -> [(Node,Node)] -ipdom rg = runST (evalS idomM =<< initEnv (pruneReach (second predG rg))) +ipdom :: Rooted -> [(Word64,Word64)] +ipdom rg = runST (evalS idomM =<< initEnv (pruneReach (second predGW rg))) ----------------------------------------------------------------------------- -- | /Post-dominated depth-first search/. -pddfs :: Rooted -> [Node] +pddfs :: Rooted -> [Word64] pddfs = reverse . rpddfs -- | /Reverse post-dominated depth-first search/. -rpddfs :: Rooted -> [Node] +rpddfs :: Rooted -> [Word64] rpddfs = concat . levels . pdomTree ----------------------------------------------------------------------------- type Dom s a = S s (Env s) a type NodeSet = IntSet -type NodeMap a = IntMap a +type NodeMap a = Word64Map a data Env s = Env {succE :: !Graph ,predE :: !Graph @@ -144,11 +149,11 @@ data Env s = Env ,sdnoE :: {-# UNPACK #-}!(Arr s Int) ,sizeE :: {-# UNPACK #-}!(Arr s Int) ,domE :: {-# UNPACK #-}!(Arr s Node) - ,rnE :: {-# UNPACK #-}!(Arr s Node)} + ,rnE :: {-# UNPACK #-}!(Arr s Word64)} ----------------------------------------------------------------------------- -idomM :: Dom s [(Node,Node)] +idomM :: Dom s [(Word64,Word64)] idomM = do dfsDom =<< rootM n <- gets dfsE @@ -296,7 +301,7 @@ initEnv (r0,g0) = do -- Graph renumbered to indices from 1 to |V| let (g,rnmap) = renum 1 g0 pred = predG g -- reverse graph - root = rnmap IM.! r0 -- renamed root + root = rnmap WM.! r0 -- renamed root n = IM.size g ns = [0..n] m = n+1 @@ -304,9 +309,9 @@ initEnv (r0,g0) = do let bucket = IM.fromList (zip ns (repeat mempty)) - rna <- newI m + rna <- newW m writes rna (fmap swap - (IM.toList rnmap)) + (WM.toList rnmap)) doms <- newI m sdno <- newI m @@ -347,7 +352,7 @@ initEnv (r0,g0) = do ,bucketE = bucket ,domE = doms}) -fromEnv :: Dom s [(Node,Node)] +fromEnv :: Dom s [(Word64,Word64)] fromEnv = do dom <- gets domE rn <- gets rnE @@ -422,6 +427,9 @@ new n = unsafeNewArray_ (0,n-1) newI :: Int -> ST s (Arr s Int) newI = new +newW :: Int -> ST s (Arr s Word64) +newW = new + writes :: (MArray (A s) a (ST s)) => Arr s a -> [(Int,a)] -> ST s () writes a xs = forM_ xs (\(i,x) -> (a.=x) i) @@ -430,11 +438,11 @@ writes a xs = forM_ xs (\(i,x) -> (a.=x) i) (!) :: Monoid a => IntMap a -> Int -> a (!) g n = maybe mempty id (IM.lookup n g) -fromAdj :: [(Node, [Node])] -> Graph -fromAdj = IM.fromList . fmap (second IS.fromList) +fromAdj :: [(Word64, [Word64])] -> Word64Map Word64Set +fromAdj = WM.fromList . fmap (second WS.fromList) -fromEdges :: [Edge] -> Graph -fromEdges = collectI IS.union fst (IS.singleton . snd) +fromEdges :: [(Word64,Word64)] -> Word64Map Word64Set +fromEdges = collectW WS.union fst (WS.singleton . snd) toAdj :: Graph -> [(Node, [Node])] toAdj = fmap (second IS.toList) . IM.toList @@ -451,15 +459,24 @@ predG g = IM.unionWith IS.union (go g) g0 m (IS.toList a)) +predGW :: Word64Map Word64Set -> Word64Map Word64Set +predGW g = WM.unionWith WS.union (go g) g0 + where g0 = fmap (const mempty) g + go = flip WM.foldrWithKey mempty (\i a m -> + foldl' (\m p -> WM.insertWith mappend p + (WS.singleton i) m) + m + (WS.toList a)) + pruneReach :: Rooted -> Rooted pruneReach (r,g) = (r,g2) where is = reachable (maybe mempty id - . flip IM.lookup g) $ r - g2 = IM.fromList - . fmap (second (IS.filter (`IS.member`is))) - . filter ((`IS.member`is) . fst) - . IM.toList $ g + . flip WM.lookup g) $ r + g2 = WM.fromList + . fmap (second (WS.filter (`WS.member`is))) + . filter ((`WS.member`is) . fst) + . WM.toList $ g tip :: Tree a -> (a, [Tree a]) tip (Node a ts) = (a, ts) @@ -476,21 +493,21 @@ ancestors = go [] in p acc' xs ++ concatMap (go acc') xs p is = fmap (flip (,) is . rootLabel) -asGraph :: Tree Node -> Rooted +asGraph :: Tree Word64 -> Rooted asGraph t@(Node a _) = let g = go t in (a, fromAdj g) where go (Node a ts) = let as = (fst . unzip . fmap tip) ts in (a, as) : concatMap go ts -asTree :: Rooted -> Tree Node -asTree (r,g) = let go a = Node a (fmap go ((IS.toList . f) a)) - f = (g !) +asTree :: Rooted -> Tree Word64 +asTree (r,g) = let go a = Node a (fmap go ((WS.toList . f) a)) + f = (g WM.!) in go r -reachable :: (Node -> NodeSet) -> (Node -> NodeSet) -reachable f a = go (IS.singleton a) a +reachable :: (Word64 -> Word64Set) -> (Word64 -> Word64Set) +reachable f a = go (WS.singleton a) a where go seen a = let s = f a - as = IS.toList (s `IS.difference` seen) - in foldl' go (s `IS.union` seen) as + as = WS.toList (s `WS.difference` seen) + in foldl' go (s `WS.union` seen) as collectI :: (c -> c -> c) -> (a -> Int) -> (a -> c) -> [a] -> IntMap c @@ -499,17 +516,24 @@ collectI (<>) f g (f a) (g a) m) mempty +collectW :: (c -> c -> c) + -> (a -> Word64) -> (a -> c) -> [a] -> Word64Map c +collectW (<>) f g + = foldl' (\m a -> WM.insertWith (<>) + (f a) + (g a) m) mempty + -- | renum n g: Rename all nodes -- -- Gives nodes sequential names starting at n. -- Returns the new graph and a mapping. -- (renamed, old -> new) -renum :: Int -> Graph -> (Graph, NodeMap Node) +renum :: Node -> Word64Map Word64Set -> (Graph, NodeMap Node) renum from = (\(_,m,g)->(g,m)) - . IM.foldrWithKey + . WM.foldrWithKey (\i ss (!n,!env,!new)-> let (j,n2,env2) = go n env i - (n3,env3,ss2) = IS.fold + (n3,env3,ss2) = WS.fold (\k (!n,!env,!new)-> case go n env k of (l,n2,env2)-> (n2,env2,l `IS.insert` new)) @@ -518,12 +542,12 @@ renum from = (\(_,m,g)->(g,m)) in (n3,env3,new2)) (from,mempty,mempty) where go :: Int -> NodeMap Node - -> Node + -> Word64 -> (Node,Int,NodeMap Node) go !n !env i = - case IM.lookup i env of + case WM.lookup i env of Just j -> (j,n,env) - Nothing -> (n,n+1,IM.insert i n env) + Nothing -> (n,n+1,WM.insert i n env) ----------------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/426bb3ad0fac1f31bd5950b7276f7d02ff6e7618 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/426bb3ad0fac1f31bd5950b7276f7d02ff6e7618 You're receiving 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 Jun 2 15:38:23 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 02 Jun 2023 11:38:23 -0400 Subject: [Git][ghc/ghc][wip/tc-lcl-env-refactor] 10 commits: cleanup: Remove unused field from SelfBoot Message-ID: <647a0cef6228c_1797833fa2d84137689@gitlab.mail> Matthew Pickering pushed to branch wip/tc-lcl-env-refactor at Glasgow Haskell Compiler / GHC Commits: f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - e9f4af93 by Matthew Pickering at 2023-06-02T16:33:02+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 50490fa7 by Matthew Pickering at 2023-06-02T16:33:02+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 0eccb169 by Matthew Pickering at 2023-06-02T16:33:02+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 51555de5 by Matthew Pickering at 2023-06-02T16:33:02+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - c28e8474 by Matthew Pickering at 2023-06-02T16:33:02+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - a149fe35 by Matthew Pickering at 2023-06-02T16:33:02+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - c177a5ec by Matthew Pickering at 2023-06-02T16:33:02+01:00 Remove unecessary SOURCE import - - - - - 46d1de48 by Matthew Pickering at 2023-06-02T16:33:02+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 30 changed files: - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/JS/Optimizer.hs - compiler/GHC/Plugins.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Hole/FitTypes.hs - − compiler/GHC/Tc/Errors/Hole/FitTypes.hs-boot - + compiler/GHC/Tc/Errors/Hole/Plugin.hs - + compiler/GHC/Tc/Errors/Hole/Plugin.hs-boot - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - + compiler/GHC/Tc/Errors/Types/PromotionErr.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Solver.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f3010ff05dfab58b739c6e0d550cbefd5f610d45...46d1de4824bfcc9d8ab1ca6396fd097554eab7e9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f3010ff05dfab58b739c6e0d550cbefd5f610d45...46d1de4824bfcc9d8ab1ca6396fd097554eab7e9 You're receiving 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 Jun 2 21:43:24 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 02 Jun 2023 17:43:24 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: cleanup: Remove unused field from SelfBoot Message-ID: <647a627c71ac7_1797833fa2c44185338@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - fbfa3525 by Ben Gamari at 2023-06-02T17:42:38-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - 9b465f32 by Sylvain Henry at 2023-06-02T17:42:49-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - 21 changed files: - compiler/GHC/IfaceToCore.hs - compiler/GHC/JS/Make.hs - compiler/GHC/JS/Optimizer.hs - compiler/GHC/JS/Ppr.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Closure.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Linker/Opt.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/Types.hs - − compiler/GHC/Tc/Utils/Zonk.hs - libraries/base/GHC/IO/Handle/Types.hs-boot - testsuite/driver/testlib.py - testsuite/mk/boilerplate.mk - + testsuite/tests/javascript/T22455.hs - + testsuite/tests/javascript/T22455.stdout - testsuite/tests/javascript/all.T - testsuite/tests/linters/notes.stdout Changes: ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -114,7 +114,6 @@ import GHC.Types.Var as Var import GHC.Types.Var.Set import GHC.Types.Name import GHC.Types.Name.Env -import GHC.Types.Name.Set import GHC.Types.Id import GHC.Types.Id.Make import GHC.Types.Id.Info @@ -568,7 +567,7 @@ tcHiBootIface hsc_src mod then do { (_, hug) <- getEpsAndHug ; case lookupHugByModule mod hug of Just info | mi_boot (hm_iface info) == IsBoot - -> mkSelfBootInfo (hm_iface info) (hm_details info) + -> return $ SelfBoot { sb_mds = hm_details info } _ -> return NoSelfBoot } else do @@ -584,7 +583,7 @@ tcHiBootIface hsc_src mod ; case read_result of { Succeeded (iface, _path) -> do { tc_iface <- initIfaceTcRn $ typecheckIface iface - ; mkSelfBootInfo iface tc_iface } ; + ; return $ SelfBoot { sb_mds = tc_iface } } ; Failed err -> -- There was no hi-boot file. But if there is circularity in @@ -613,29 +612,6 @@ tcHiBootIface hsc_src mod need = text "Need the hi-boot interface for" <+> ppr mod <+> text "to compare against the Real Thing" -mkSelfBootInfo :: ModIface -> ModDetails -> TcRn SelfBootInfo -mkSelfBootInfo iface mds - = do -- NB: This is computed DIRECTLY from the ModIface rather - -- than from the ModDetails, so that we can query 'sb_tcs' - -- WITHOUT forcing the contents of the interface. - let tcs = map ifName - . filter isIfaceTyCon - . map snd - $ mi_decls iface - return $ SelfBoot { sb_mds = mds - , sb_tcs = mkNameSet tcs } - where - -- Returns @True@ if, when you call 'tcIfaceDecl' on - -- this 'IfaceDecl', an ATyCon would be returned. - -- NB: This code assumes that a TyCon cannot be implicit. - isIfaceTyCon IfaceId{} = False - isIfaceTyCon IfaceData{} = True - isIfaceTyCon IfaceSynonym{} = True - isIfaceTyCon IfaceFamily{} = True - isIfaceTyCon IfaceClass{} = True - isIfaceTyCon IfaceAxiom{} = False - isIfaceTyCon IfacePatSyn{} = False - {- ************************************************************************ * * ===================================== compiler/GHC/JS/Make.hs ===================================== @@ -83,7 +83,7 @@ module GHC.JS.Make -- $intro_funcs , var , jString - , jLam, jFunction, jVar, jFor, jForNoDecl, jForIn, jForEachIn, jTryCatchFinally + , jLam, jFun, jFunction, jVar, jFor, jForNoDecl, jForIn, jForEachIn, jTryCatchFinally -- * Combinators -- $combinators , (||=), (|=), (.==.), (.===.), (.!=.), (.!==.), (.!) @@ -249,6 +249,15 @@ jLam f = ValExpr . UnsatVal . IS $ do (block,is) <- runIdentSupply $ toSat_ f [] return $ JFunc is block +-- | Create a new function. The result is a 'GHC.JS.Syntax.JStat'. +-- Usage: +-- +-- > jFun fun_name $ \x -> ... +jFun :: ToSat a => Ident -> a -> JStat +jFun n f = UnsatBlock . IS $ do + (block,is) <- runIdentSupply $ toSat_ f [] + return $ FuncStat n is block + -- | Introduce a new variable into scope for the duration -- of the enclosed expression. The result is a block statement. -- Usage: ===================================== compiler/GHC/JS/Optimizer.hs ===================================== @@ -47,9 +47,8 @@ import GHC.JS.Syntax import Control.Arrow {- -Note [ Unsafe JavaScript Optimizations ] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - +Note [Unsafe JavaScript optimizations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ There are a number of optimizations that the JavaScript Backend performs that are not sound with respect to arbritrary JavaScript. We still perform these optimizations because we are not optimizing arbritrary javascript and under the ===================================== compiler/GHC/JS/Ppr.hs ===================================== @@ -60,7 +60,6 @@ module GHC.JS.Ppr , jsToDoc , pprStringLit , interSemi - , addSemi , braceNest , hangBrace ) @@ -138,15 +137,25 @@ instance JsToDoc [JStat] where jsToDocR r = jcat . map (addSemi . jsToDocR r) defRenderJsS :: JsRender doc => RenderJs doc -> JStat -> doc defRenderJsS r = \case - IfStat cond x y -> hangBrace (text "if" <+?> parens (jsToDocR r cond)) - (jnest $ optBlock r x) - <+?> mbElse + IfStat cond x y -> jcat + [ hangBrace (text "if" <+?> parens (jsToDocR r cond)) (optBlock r x) + , mbElse + ] where mbElse | y == BlockStat [] = empty - | otherwise = hangBrace (text "else") (jnest $ optBlock r y) + | otherwise = hangBrace (text "else") (optBlock r y) DeclStat x Nothing -> text "var" <+> jsToDocR r x + -- special treatment for functions, otherwise there is too much left padding + -- (more than the length of the expression assigned to). E.g. + -- + -- var long_variable_name = (function() + -- { + -- ... + -- }); + -- + DeclStat x (Just (ValExpr f@(JFunc {}))) -> jhang (text "var" <+> jsToDocR r x <+?> char '=') (jsToDocR r f) DeclStat x (Just e) -> text "var" <+> jsToDocR r x <+?> char '=' <+?> jsToDocR r e - WhileStat False p b -> hangBrace (text "while" <+?> parens (jsToDocR r p)) (jnest $ optBlock r b) - WhileStat True p b -> hangBrace (text "do") (jnest $ optBlock r b) <+?> text "while" <+?> parens (jsToDocR r p) + WhileStat False p b -> hangBrace (text "while" <+?> parens (jsToDocR r p)) (optBlock r b) + WhileStat True p b -> hangBrace (text "do") (optBlock r b) <+?> text "while" <+?> parens (jsToDocR r p) BreakStat l -> addSemi $ maybe (text "break") (\(LexicalFastString s) -> (text "break" <+> ftext s)) l ContinueStat l -> addSemi $ maybe (text "continue") (\(LexicalFastString s) -> (text "continue" <+> ftext s)) l LabelStat (LexicalFastString l) s -> ftext l <> char ':' $$$ printBS s @@ -154,10 +163,10 @@ defRenderJsS r = \case printBS (BlockStat ss) = interSemi $ map (jsToDocR r) ss printBS x = jsToDocR r x - ForStat init p s1 sb -> hangBrace (text "for" <+?> parens forCond) (jnest $ optBlock r sb) + ForStat init p s1 sb -> hangBrace (text "for" <+?> parens forCond) (optBlock r sb) where forCond = jsToDocR r init <> semi <+?> jsToDocR r p <> semi <+?> parens (jsToDocR r s1) - ForInStat each i e b -> hangBrace (text txt <+?> parens (jsToDocR r i <+> text "in" <+> jsToDocR r e)) (jnest $ optBlock r b) + ForInStat each i e b -> hangBrace (text txt <+?> parens (jsToDocR r i <+> text "in" <+> jsToDocR r e)) (optBlock r b) where txt | each = "for each" | otherwise = "for" SwitchStat e l d -> hangBrace (text "switch" <+?> parens (jsToDocR r e)) cases @@ -168,33 +177,35 @@ defRenderJsS r = \case ApplStat e es -> jsToDocR r e <> (parens . foldl' (<+?>) empty . punctuate comma $ map (jsToDocR r) es) FuncStat i is b -> hangBrace (text "function" <+> jsToDocR r i <> parens (foldl' (<+?>) empty . punctuate comma . map (jsToDocR r) $ is)) - (jnest $ optBlock r b) + (optBlock r b) TryStat s i s1 s2 -> hangBrace (text "try") (jsToDocR r s) <+?> mbCatch <+?> mbFinally where mbCatch | s1 == BlockStat [] = empty - | otherwise = hangBrace (text "catch" <+?> parens (jsToDocR r i)) (jnest $ optBlock r s1) + | otherwise = hangBrace (text "catch" <+?> parens (jsToDocR r i)) (optBlock r s1) mbFinally | s2 == BlockStat [] = empty - | otherwise = hangBrace (text "finally") (jnest $ optBlock r s2) + | otherwise = hangBrace (text "finally") (optBlock r s2) AssignStat i op x -> case x of -- special treatment for functions, otherwise there is too much left padding -- (more than the length of the expression assigned to). E.g. -- - -- var long_variable_name = (function() + -- long_variable_name = (function() -- { -- ... -- }); -- - ValExpr (JFunc is b) -> jsToDocR r i <> ftext (aOpText op) <> text " function" <> parens (foldl' (<+?>) empty . punctuate comma . map (jsToDocR r) $ is) <> braceNest (jsToDocR r b) - _ -> jsToDocR r i <+?> ftext (aOpText op) <+?> jsToDocR r x + ValExpr f@(JFunc {}) -> jhang (jsToDocR r i <> ftext (aOpText op)) (jsToDocR r f) + _ -> jsToDocR r i <+?> ftext (aOpText op) <+?> jsToDocR r x UOpStat op x | isPre op && isAlphaOp op -> ftext (uOpText op) <+> optParens r x | isPre op -> ftext (uOpText op) <+> optParens r x | otherwise -> optParens r x <+> ftext (uOpText op) BlockStat xs -> jsToDocR r xs +-- | Remove one Block layering if we know we already have braces around the +-- statement optBlock :: JsRender doc => RenderJs doc -> JStat -> doc optBlock r x = case x of BlockStat{} -> jsToDocR r x - _ -> addSemi $ jsToDocR r x + _ -> addSemi (jsToDocR r x) optParens :: JsRender doc => RenderJs doc -> JExpr -> doc optParens r x = case x of @@ -338,9 +349,6 @@ encodeJsonChar = \case interSemi :: JsRender doc => [doc] -> doc interSemi = foldl ($$$) empty . punctuateFinal semi semi -addSemi :: IsLine doc => doc -> doc -addSemi x = x <> semi <> char '\n' - -- | The structure `{body}`, optionally indented over multiple lines {-# INLINE braceNest #-} braceNest :: JsRender doc => doc -> doc @@ -349,7 +357,11 @@ braceNest x = lbrace $$$ jnest x $$$ rbrace -- | The structure `hdr {body}`, optionally indented over multiple lines {-# INLINE hangBrace #-} hangBrace :: JsRender doc => doc -> doc -> doc -hangBrace hdr body = hdr <+?> braceNest body +hangBrace hdr body = jcat [ hdr <> char ' ' <> char '{', jnest body, char '}' ] + +{-# INLINE jhang #-} +jhang :: JsRender doc => doc -> doc -> doc +jhang hdr body = jcat [ hdr, jnest body] -- | JsRender controls the differences in whitespace between HLine and SDoc. -- Generally, this involves the indentation and newlines in the human-readable @@ -365,16 +377,21 @@ class IsLine doc => JsRender doc where jcat :: [doc] -> doc -- | Optionally indent the following jnest :: doc -> doc + -- | Append semi-colon (and line-break in HLine mode) + addSemi :: doc -> doc instance JsRender SDoc where (<+?>) = (<+>) {-# INLINE (<+?>) #-} - ($$$) = ($$) + ($$$) = ($+$) {-# INLINE ($$$) #-} jcat = vcat {-# INLINE jcat #-} jnest = nest 2 {-# INLINE jnest #-} + addSemi x = x <> semi + {-# INLINE addSemi #-} + instance JsRender HLine where (<+?>) = (<>) @@ -385,3 +402,6 @@ instance JsRender HLine where {-# INLINE jcat #-} jnest = id {-# INLINE jnest #-} + addSemi x = x <> semi <> char '\n' + -- we add a line-break to avoid issues with lines too long in minified outputs + {-# INLINE addSemi #-} ===================================== compiler/GHC/StgToJS/Apply.hs ===================================== @@ -590,7 +590,7 @@ genericStackApply cfg = closure info body -- genericFastApply :: StgToJSConfig -> JStat genericFastApply s = - TxtI "h$ap_gen_fast" ||= jLam \tag -> jVar \c -> + jFun (TxtI "h$ap_gen_fast") \tag -> jVar \c -> [traceRts s (jString "h$ap_gen_fast: " + tag) , c |= closureEntry r1 , SwitchStat (entryClosureType c) @@ -802,12 +802,12 @@ stackApply s fun_name nargs nvars = -- h$ap_n_r_fast is entered if a function of unknown arity is called, n -- arguments are already in r registers fastApply :: StgToJSConfig -> FastString -> Int -> Int -> JStat -fastApply s fun_name nargs nvars = func ||= body0 +fastApply s fun_name nargs nvars = body0 where -- special case for h$ap_0_0_fast body0 = if nargs == 0 && nvars == 0 - then jLam (enter s r1) - else toJExpr (JFunc myFunArgs body) + then jFun func (enter s r1) + else FuncStat func myFunArgs body func = TxtI fun_name @@ -875,7 +875,7 @@ fastApply s fun_name nargs nvars = func ||= body0 zeroApply :: StgToJSConfig -> JStat zeroApply s = mconcat - [ TxtI "h$e" ||= jLam (\c -> (r1 |= c) <> enter s c) + [ jFun (TxtI "h$e") (\c -> (r1 |= c) <> enter s c) ] -- carefully enter a closure that might be a thunk or a function @@ -973,13 +973,13 @@ selectors s = mkSel :: FastString -> (JExpr -> JExpr) -> JStat mkSel name sel = mconcat - [TxtI createName ||= jLam \r -> mconcat + [jFun (TxtI createName) \r -> mconcat [ traceRts s (toJExpr ("selector create: " <> name <> " for ") + (r .^ "alloc")) , ifS (isThunk r .||. isBlackhole r) (returnS (app "h$mkSelThunk" [r, toJExpr (v entryName), toJExpr (v resName)])) (returnS (sel r)) ] - , TxtI resName ||= jLam \r -> mconcat + , jFun (TxtI resName) \r -> mconcat [ traceRts s (toJExpr ("selector result: " <> name <> " for ") + (r .^ "alloc")) , returnS (sel r) ] @@ -1106,7 +1106,7 @@ papGen cfg = -- general utilities -- move the first n registers, starting at R2, m places up (do not use with negative m) moveRegs2 :: JStat -moveRegs2 = TxtI "h$moveRegs2" ||= jLam moveSwitch +moveRegs2 = jFun (TxtI "h$moveRegs2") moveSwitch where moveSwitch n m = SwitchStat ((n .<<. 8) .|. m) switchCases (defaultCase n m) -- fast cases ===================================== compiler/GHC/StgToJS/Closure.hs ===================================== @@ -116,7 +116,7 @@ setObjInfo debug obj t name fields a size regs static closure :: ClosureInfo -- ^ object being info'd see @ciVar@ in @ClosureInfo@ -> JStat -- ^ rhs -> JStat -closure ci body = (ciVar ci ||= jLam body) `mappend` closureInfoStat False ci +closure ci body = (jFun (ciVar ci) body) `mappend` closureInfoStat False ci conClosure :: Ident -> FastString -> CILayout -> Int -> JStat conClosure symbol name layout constr = ===================================== compiler/GHC/StgToJS/CodeGen.hs ===================================== @@ -366,4 +366,4 @@ genToplevelRhs i rhs = case rhs of sr) ccId <- costCentreStackLbl cc emitStatic idt static ccId - return $ (eid ||= toJExpr (JFunc [] (ll <> upd <> setcc <> body))) + return $ (FuncStat eid [] (ll <> upd <> setcc <> body)) ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -198,12 +198,7 @@ link lc_cfg cfg logger unit_env out _include units objFiles jsFiles isRootFun ex -- link generated RTS parts into rts.js unless (lcNoRts lc_cfg) $ do withFile (out "rts.js") WriteMode $ \h -> do - if csPrettyRender cfg - then printSDoc defaultJsContext (Ppr.PageMode True) h (rtsDeclsText $$ rtsText cfg) - else do - bh <- newBufHandle h - bPutHDoc bh defaultJsContext (line rtsDeclsText $$ line (rtsText cfg)) - bFlush bh + void $ hPutJS (csPrettyRender cfg) h (rts cfg) -- link dependencies' JS files into lib.js withBinaryFile (out "lib.js") WriteMode $ \h -> do @@ -307,6 +302,24 @@ data CompactedModuleCode = CompactedModuleCode , cmc_exports :: !B.ByteString -- ^ rendered exports } +-- | Output JS statements and return the output size in bytes. +hPutJS :: Bool -> Handle -> Sat.JStat -> IO Integer +hPutJS render_pretty h = \case + Sat.BlockStat [] -> pure 0 + x -> do + before <- hTell h + if render_pretty + then do + printSDoc defaultJsContext (Ppr.PageMode True) h (pretty render_pretty x) + else do + bh <- newBufHandle h + bPutHDoc bh defaultJsContext (line $ pretty render_pretty x) + bFlush bh + -- Append an empty line to correctly end the file in a newline + hPutChar h '\n' + after <- hTell h + pure $! (after - before) + -- | Link modules and pretty-print them into the given Handle renderLinker :: Handle @@ -321,18 +334,7 @@ renderLinker h render_pretty mods jsFiles = do let putBS = B.hPut h - putJS x = do - before <- hTell h - if render_pretty - then do - printSDoc defaultJsContext (Ppr.PageMode True) h (pretty x) - else do - bh <- newBufHandle h - -- Append an empty line to correctly end the file in a newline - bPutHDoc bh defaultJsContext ((line $ pretty x) $$ empty) - bFlush bh - after <- hTell h - pure $! (after - before) + putJS = hPutJS render_pretty h --------------------------------------------------------- -- Pretty-print JavaScript code for all the dependencies. ===================================== compiler/GHC/StgToJS/Linker/Opt.hs ===================================== @@ -20,7 +20,7 @@ ----------------------------------------------------------------------------- module GHC.StgToJS.Linker.Opt ( pretty - , ghcjsRenderJs + , optRenderJs ) where @@ -39,11 +39,17 @@ import Data.List (sortOn) import Data.Char (isAlpha,isDigit,ord) import qualified Data.ByteString.Short as SBS -pretty :: JsRender doc => JStat -> doc -pretty = jsToDocR ghcjsRenderJs - -ghcjsRenderJs :: RenderJs doc -ghcjsRenderJs = defaultRenderJs +pretty :: JsRender doc => Bool -> JStat -> doc +pretty render_pretty = \case + BlockStat [] -> empty + s | render_pretty -> jsToDocR defaultRenderJs [s] + | otherwise -> jsToDocR optRenderJs [s] + -- render as a list of statements to ensure that + -- semicolons are added. + +-- | Render JS with code size minimization enabled +optRenderJs :: RenderJs doc +optRenderJs = defaultRenderJs { renderJsV = ghcjsRenderJsV , renderJsS = ghcjsRenderJsS , renderJsI = ghcjsRenderJsI ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -1,7 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} - -{-# OPTIONS_GHC -O0 #-} +{-# LANGUAGE BlockArguments #-} ----------------------------------------------------------------------------- -- | @@ -24,7 +23,11 @@ -- ----------------------------------------------------------------------------- -module GHC.StgToJS.Rts.Rts where +module GHC.StgToJS.Rts.Rts + ( rts + , assignRegs + ) +where import GHC.Prelude @@ -42,11 +45,8 @@ import GHC.StgToJS.Regs import GHC.StgToJS.Types import GHC.StgToJS.Stack -import GHC.StgToJS.Linker.Opt - import GHC.Data.FastString import GHC.Types.Unique.Map -import GHC.JS.Ppr import Data.Array import Data.Monoid @@ -56,8 +56,8 @@ import qualified Data.Bits as Bits -- | The garbageCollector resets registers and result variables. garbageCollector :: JStat garbageCollector = - mconcat [ TxtI "h$resetRegisters" ||= jLam (mconcat $ map resetRegister [minBound..maxBound]) - , TxtI "h$resetResultVars" ||= jLam (mconcat $ map resetResultVar [minBound..maxBound]) + mconcat [ jFun (TxtI "h$resetRegisters") (mconcat $ map resetRegister [minBound..maxBound]) + , jFun (TxtI "h$resetResultVars") (mconcat $ map resetResultVar [minBound..maxBound]) ] -- | Reset the register 'r' in JS Land. Note that this "resets" by setting the @@ -233,8 +233,8 @@ declRegs = -- | JS payload to define getters and setters on the registers. regGettersSetters :: JStat regGettersSetters = - mconcat [ TxtI "h$getReg" ||= jLam (\n -> SwitchStat n getRegCases mempty) - , TxtI "h$setReg" ||= jLam (\n v -> SwitchStat n (setRegCases v) mempty) + mconcat [ jFun (TxtI "h$getReg") (\n -> SwitchStat n getRegCases mempty) + , jFun (TxtI "h$setReg") (\n v -> SwitchStat n (setRegCases v) mempty) ] where getRegCases = @@ -292,17 +292,16 @@ closureTypes = mconcat (map mkClosureType (enumFromTo minBound maxBound)) <> clo mkClosureType c = let s = TxtI . mkFastString $ "h$" ++ map toUpper (show c) ++ "_CLOSURE" in s ||= toJExpr c closureTypeName :: JStat - closureTypeName = - TxtI "h$closureTypeName" ||= jLam (\c -> - mconcat (map (ifCT c) [minBound..maxBound]) - <> returnS (jString "InvalidClosureType")) + closureTypeName = jFun (TxtI "h$closureTypeName") \c -> + mconcat (map (ifCT c) [minBound..maxBound]) + <> returnS (jString "InvalidClosureType") ifCT :: JExpr -> ClosureType -> JStat ifCT arg ct = jwhenS (arg .===. toJExpr ct) (returnS (toJExpr (show ct))) -- | JS payload declaring the RTS functions. -rtsDecls :: Sat.JStat -rtsDecls = satJStat (Just "h$RTSD") $ +rtsDecls :: JStat +rtsDecls = mconcat [ TxtI "h$currentThread" ||= null_ -- thread state object for current thread , TxtI "h$stack" ||= null_ -- stack for the current thread , TxtI "h$sp" ||= 0 -- stack pointer for the current thread @@ -315,17 +314,12 @@ rtsDecls = satJStat (Just "h$RTSD") $ , declRegs , declRets] --- | print the embedded RTS to a String -rtsText :: forall doc. JsRender doc => StgToJSConfig -> doc -rtsText = pretty @doc . jsOptimize . rts - --- | print the RTS declarations to a String. -rtsDeclsText :: forall doc. JsRender doc => doc -rtsDeclsText = pretty @doc . jsOptimize $ rtsDecls - --- | Wrapper over the RTS to guarentee saturation, see 'GHC.JS.Transform' +-- | Generated RTS code rts :: StgToJSConfig -> Sat.JStat -rts = satJStat (Just "h$RTS") . rts' +rts cfg = jsOptimize $ satJStat (Just "h$RTS") $ mconcat + [ rtsDecls + , rts' cfg + ] -- | JS Payload which defines the embedded RTS. rts' :: StgToJSConfig -> JStat @@ -349,8 +343,8 @@ rts' s = , TxtI "h$vt_rtsobj" ||= toJExpr RtsObjV , TxtI "h$vt_obj" ||= toJExpr ObjV , TxtI "h$vt_arr" ||= toJExpr ArrV - , TxtI "h$bh" ||= jLam (bhStats s True) - , TxtI "h$bh_lne" ||= jLam (\x frameSize -> bhLneStats s x frameSize) + , jFun (TxtI "h$bh") (bhStats s True) + , jFun (TxtI "h$bh_lne") (\x frameSize -> bhLneStats s x frameSize) , closure (ClosureInfo (TxtI "h$blackhole") (CIRegs 0 []) "blackhole" (CILayoutUnknown 2) CIBlackhole mempty) (appS "throw" [jString "oops: entered black hole"]) , closure (ClosureInfo (TxtI "h$blackholeTrap") (CIRegs 0 []) "blackhole" (CILayoutUnknown 2) CIThunk mempty) ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -699,9 +699,6 @@ tcRnHsBootDecls boot_or_sig decls , hs_valds = XValBindsLR (NValBinds val_binds val_sigs) }) <- rnTopSrcDecls first_group - -- The empty list is for extra dependencies coming from .hs-boot files - -- See Note [Extra dependencies from .hs-boot files] in GHC.Rename.Module - ; (gbl_env, lie) <- setGblEnv tcg_env $ captureTopConstraints $ do { -- NB: setGblEnv **before** captureTopConstraints so that -- if the latter reports errors, it knows what's in scope ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -5021,7 +5021,7 @@ checkValidRoleAnnots role_annots tc = whenIsJust role_annot_decl_maybe illegalRoleAnnotDecl -- Note [Missing role annotations warning] --- +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- We warn about missing role annotations for tycons -- 1. not type-classes: -- type classes are nominal by default, which is most conservative ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -695,10 +695,7 @@ instance ContainsModule TcGblEnv where data SelfBootInfo = NoSelfBoot -- No corresponding hi-boot file | SelfBoot - { sb_mds :: ModDetails -- There was a hi-boot file, - , sb_tcs :: NameSet } -- defining these TyCons, --- What is sb_tcs used for? See Note [Extra dependencies from .hs-boot files] --- in GHC.Rename.Module + { sb_mds :: ModDetails } -- There was a hi-boot file bootExports :: SelfBootInfo -> NameSet bootExports boot = ===================================== compiler/GHC/Tc/Utils/Zonk.hs deleted ===================================== @@ -1,1938 +0,0 @@ - -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE TypeFamilies #-} - -{-# OPTIONS_GHC -Wno-incomplete-record-updates #-} - -{- -(c) The University of Glasgow 2006 -(c) The AQUA Project, Glasgow University, 1996-1998 - --} - --- | Specialisations of the @HsSyn@ syntax for the typechecker --- --- This module is an extension of @HsSyn@ syntax, for use in the type checker. -module GHC.Tc.Utils.Zonk ( - -- * Other HsSyn functions - mkHsDictLet, mkHsApp, - mkHsAppTy, mkHsCaseAlt, - tcShortCutLit, shortCutLit, hsOverLitName, - conLikeResTy, - - -- * re-exported from TcMonad - TcId, TcIdSet, - - -- * Zonking - -- | For a description of "zonking", see Note [What is zonking?] - -- in "GHC.Tc.Utils.TcMType" - zonkTopDecls, zonkTopExpr, zonkTopLExpr, - zonkTopBndrs, - ZonkEnv, ZonkFlexi(..), emptyZonkEnv, mkEmptyZonkEnv, initZonkEnv, - zonkTyVarBindersX, zonkTyVarBinderX, - zonkTyBndrs, zonkTyBndrsX, - zonkTcTypeToType, zonkTcTypeToTypeX, - zonkTcTypesToTypesX, zonkScaledTcTypesToTypesX, - zonkTyVarOcc, - zonkCoToCo, - zonkEvBinds, zonkTcEvBinds, - zonkTcMethInfoToMethInfoX, - lookupTyVarX - ) where - -import GHC.Prelude - -import GHC.Platform - -import GHC.Builtin.Types -import GHC.Builtin.Names - -import GHC.Hs - -import {-# SOURCE #-} GHC.Tc.Gen.Splice (runTopSplice) -import GHC.Tc.Utils.Monad -import GHC.Tc.TyCl.Build ( TcMethInfo, MethInfo ) -import GHC.Tc.Utils.TcType -import GHC.Tc.Utils.TcMType -import GHC.Tc.Utils.Env ( tcLookupGlobalOnly ) -import GHC.Tc.Types.Evidence -import GHC.Tc.Errors.Types - -import GHC.Core.TyCo.Ppr ( pprTyVar ) -import GHC.Core.TyCon -import GHC.Core.Type -import GHC.Core.Coercion -import GHC.Core.ConLike -import GHC.Core.DataCon - -import GHC.Utils.Outputable -import GHC.Utils.Misc -import GHC.Utils.Panic -import GHC.Utils.Panic.Plain - -import GHC.Core.Multiplicity -import GHC.Core -import GHC.Core.Predicate - -import GHC.Types.Name -import GHC.Types.Name.Env -import GHC.Types.Var -import GHC.Types.Var.Env -import GHC.Types.Id -import GHC.Types.TypeEnv -import GHC.Types.SourceText -import GHC.Types.Basic -import GHC.Types.SrcLoc -import GHC.Types.Unique.FM -import GHC.Types.TyThing -import GHC.Driver.DynFlags( getDynFlags, targetPlatform ) - -import GHC.Data.Maybe -import GHC.Data.Bag - -import Control.Monad -import Data.List ( partition ) -import Control.Arrow ( second ) - -{- ********************************************************************* -* * - Short-cuts for overloaded numeric literals -* * -********************************************************************* -} - --- Overloaded literals. Here mainly because it uses isIntTy etc - -{- Note [Short cut for overloaded literals] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -A literal like "3" means (fromInteger @ty (dNum :: Num ty) (3::Integer)). -But if we have a list like - [4,2,3,2,4,4,2]::[Int] -we use a lot of compile time and space generating and solving all those Num -constraints, and generating calls to fromInteger etc. Better just to cut to -the chase, and cough up an Int literal. Large collections of literals like this -sometimes appear in source files, so it's quite a worthwhile fix. - -So we try to take advantage of whatever nearby type information we have, -to short-cut the process for built-in types. We can do this in two places; - -* In the typechecker, when we are about to typecheck the literal. -* If that fails, in the desugarer, once we know the final type. --} - -tcShortCutLit :: HsOverLit GhcRn -> ExpRhoType -> TcM (Maybe (HsOverLit GhcTc)) -tcShortCutLit lit@(OverLit { ol_val = val, ol_ext = OverLitRn rebindable _}) exp_res_ty - | not rebindable - , Just res_ty <- checkingExpType_maybe exp_res_ty - = do { dflags <- getDynFlags - ; let platform = targetPlatform dflags - ; case shortCutLit platform val res_ty of - Just expr -> return $ Just $ - lit { ol_ext = OverLitTc False expr res_ty } - Nothing -> return Nothing } - | otherwise - = return Nothing - -shortCutLit :: Platform -> OverLitVal -> TcType -> Maybe (HsExpr GhcTc) -shortCutLit platform val res_ty - = case val of - HsIntegral int_lit -> go_integral int_lit - HsFractional frac_lit -> go_fractional frac_lit - HsIsString s src -> go_string s src - where - go_integral int@(IL src neg i) - | isIntTy res_ty && platformInIntRange platform i - = Just (HsLit noAnn (HsInt noExtField int)) - | isWordTy res_ty && platformInWordRange platform i - = Just (mkLit wordDataCon (HsWordPrim src i)) - | isIntegerTy res_ty - = Just (HsLit noAnn (HsInteger src i res_ty)) - | otherwise - = go_fractional (integralFractionalLit neg i) - -- The 'otherwise' case is important - -- Consider (3 :: Float). Syntactically it looks like an IntLit, - -- so we'll call shortCutIntLit, but of course it's a float - -- This can make a big difference for programs with a lot of - -- literals, compiled without -O - - go_fractional f - | isFloatTy res_ty && valueInRange = Just (mkLit floatDataCon (HsFloatPrim noExtField f)) - | isDoubleTy res_ty && valueInRange = Just (mkLit doubleDataCon (HsDoublePrim noExtField f)) - | otherwise = Nothing - where - valueInRange = - case f of - FL { fl_exp = e } -> (-100) <= e && e <= 100 - -- We limit short-cutting Fractional Literals to when their power of 10 - -- is less than 100, which ensures desugaring isn't slow. - - go_string src s - | isStringTy res_ty = Just (HsLit noAnn (HsString src s)) - | otherwise = Nothing - -mkLit :: DataCon -> HsLit GhcTc -> HsExpr GhcTc -mkLit con lit = HsApp noComments (nlHsDataCon con) (nlHsLit lit) - ------------------------------- -hsOverLitName :: OverLitVal -> Name --- Get the canonical 'fromX' name for a particular OverLitVal -hsOverLitName (HsIntegral {}) = fromIntegerName -hsOverLitName (HsFractional {}) = fromRationalName -hsOverLitName (HsIsString {}) = fromStringName - -{- -************************************************************************ -* * -\subsection[BackSubst-HsBinds]{Running a substitution over @HsBinds@} -* * -************************************************************************ - -The rest of the zonking is done *after* typechecking. -The main zonking pass runs over the bindings - - a) to convert TcTyVars to TyVars etc, dereferencing any bindings etc - b) convert unbound TcTyVar to Void - c) convert each TcId to an Id by zonking its type - -The type variables are converted by binding mutable tyvars to immutable ones -and then zonking as normal. - -The Ids are converted by binding them in the normal Tc envt; that -way we maintain sharing; eg an Id is zonked at its binding site and they -all occurrences of that Id point to the common zonked copy - -It's all pretty boring stuff, because HsSyn is such a large type, and -the environment manipulation is tiresome. --} - --- Confused by zonking? See Note [What is zonking?] in GHC.Tc.Utils.TcMType. - --- | See Note [The ZonkEnv] --- Confused by zonking? See Note [What is zonking?] in "GHC.Tc.Utils.TcMType". -data ZonkEnv -- See Note [The ZonkEnv] - = ZonkEnv { ze_flexi :: ZonkFlexi - , ze_tv_env :: TyCoVarEnv TyCoVar - , ze_id_env :: IdEnv Id - , ze_meta_tv_env :: TcRef (TyVarEnv Type) } - -{- Note [The ZonkEnv] -~~~~~~~~~~~~~~~~~~~~~ -* ze_flexi :: ZonkFlexi says what to do with a - unification variable that is still un-unified. - See Note [Un-unified unification variables] - -* ze_tv_env :: TyCoVarEnv TyCoVar promotes sharing. At a binding site - of a tyvar or covar, we zonk the kind right away and add a mapping - to the env. This prevents re-zonking the kind at every - occurrence. But this is *just* an optimisation. - -* ze_id_env : IdEnv Id promotes sharing among Ids, by making all - occurrences of the Id point to a single zonked copy, built at the - binding site. - - Unlike ze_tv_env, it is knot-tied: see extendIdZonkEnvRec. - In a mutually recursive group - rec { f = ...g...; g = ...f... } - we want the occurrence of g to point to the one zonked Id for g, - and the same for f. - - Because it is knot-tied, we must be careful to consult it lazily. - Specifically, zonkIdOcc is not monadic. - -* ze_meta_tv_env: see Note [Sharing when zonking to Type] - - -Notes: - * We must be careful never to put coercion variables (which are Ids, - after all) in the knot-tied ze_id_env, because coercions can - appear in types, and we sometimes inspect a zonked type in this - module. [Question: where, precisely?] - - * In zonkTyVarOcc we consult ze_tv_env in a monadic context, - a second reason that ze_tv_env can't be monadic. - - * An obvious suggestion would be to have one VarEnv Var to - replace both ze_id_env and ze_tv_env, but that doesn't work - because of the knot-tying stuff mentioned above. - -Note [Un-unified unification variables] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -What should we do if we find a Flexi unification variable? -There are three possibilities: - -* DefaultFlexi: this is the common case, in situations like - length @alpha ([] @alpha) - It really doesn't matter what type we choose for alpha. But - we must choose a type! We can't leave mutable unification - variables floating around: after typecheck is complete, every - type variable occurrence must have a binding site. - - So we default it to 'Any' of the right kind. - - All this works for both type and kind variables (indeed - the two are the same thing). - -* SkolemiseFlexi: is a special case for the LHS of RULES. - See Note [Zonking the LHS of a RULE] - -* RuntimeUnkFlexi: is a special case for the GHCi debugger. - It's a way to have a variable that is not a mutable - unification variable, but doesn't have a binding site - either. - -* NoFlexi: See Note [Error on unconstrained meta-variables] - in GHC.Tc.Utils.TcMType. This mode will panic on unfilled - meta-variables. --} - -data ZonkFlexi -- See Note [Un-unified unification variables] - = DefaultFlexi -- Default unbound unification variables to Any - | SkolemiseFlexi -- Skolemise unbound unification variables - -- See Note [Zonking the LHS of a RULE] - | RuntimeUnkFlexi -- Used in the GHCi debugger - | NoFlexi -- Panic on unfilled meta-variables - -- See Note [Error on unconstrained meta-variables] - -- in GHC.Tc.Utils.TcMType - -instance Outputable ZonkEnv where - ppr (ZonkEnv { ze_tv_env = tv_env - , ze_id_env = id_env }) - = text "ZE" <+> braces (vcat - [ text "ze_tv_env =" <+> ppr tv_env - , text "ze_id_env =" <+> ppr id_env ]) - --- The EvBinds have to already be zonked, but that's usually the case. -emptyZonkEnv :: TcM ZonkEnv -emptyZonkEnv = mkEmptyZonkEnv DefaultFlexi - -mkEmptyZonkEnv :: ZonkFlexi -> TcM ZonkEnv -mkEmptyZonkEnv flexi - = do { mtv_env_ref <- newTcRef emptyVarEnv - ; return (ZonkEnv { ze_flexi = flexi - , ze_tv_env = emptyVarEnv - , ze_id_env = emptyVarEnv - , ze_meta_tv_env = mtv_env_ref }) } - -initZonkEnv :: (ZonkEnv -> TcM b) -> TcM b -initZonkEnv thing_inside = do { ze <- mkEmptyZonkEnv DefaultFlexi - ; thing_inside ze } - --- | Extend the knot-tied environment. -extendIdZonkEnvRec :: ZonkEnv -> [Var] -> ZonkEnv -extendIdZonkEnvRec ze@(ZonkEnv { ze_id_env = id_env }) ids - -- NB: Don't look at the var to decide which env't to put it in. That - -- would end up knot-tying all the env'ts. - = ze { ze_id_env = extendVarEnvList id_env [(id,id) | id <- ids] } - -- Given coercion variables will actually end up here. That's OK though: - -- coercion variables are never looked up in the knot-tied env't, so zonking - -- them simply doesn't get optimised. No one gets hurt. An improvement (?) - -- would be to do SCC analysis in zonkEvBinds and then only knot-tie the - -- recursive groups. But perhaps the time it takes to do the analysis is - -- more than the savings. - -extendZonkEnv :: ZonkEnv -> [Var] -> ZonkEnv -extendZonkEnv ze@(ZonkEnv { ze_tv_env = tyco_env, ze_id_env = id_env }) vars - = ze { ze_tv_env = extendVarEnvList tyco_env [(tv,tv) | tv <- tycovars] - , ze_id_env = extendVarEnvList id_env [(id,id) | id <- ids] } - where - (tycovars, ids) = partition isTyCoVar vars - -extendIdZonkEnv :: ZonkEnv -> Var -> ZonkEnv -extendIdZonkEnv ze@(ZonkEnv { ze_id_env = id_env }) id - = ze { ze_id_env = extendVarEnv id_env id id } - -extendTyZonkEnv :: ZonkEnv -> TyVar -> ZonkEnv -extendTyZonkEnv ze@(ZonkEnv { ze_tv_env = ty_env }) tv - = ze { ze_tv_env = extendVarEnv ty_env tv tv } - -setZonkType :: ZonkEnv -> ZonkFlexi -> ZonkEnv -setZonkType ze flexi = ze { ze_flexi = flexi } - -zonkEnvIds :: ZonkEnv -> TypeEnv -zonkEnvIds (ZonkEnv { ze_id_env = id_env}) - = mkNameEnv [(getName id, AnId id) | id <- nonDetEltsUFM id_env] - -- It's OK to use nonDetEltsUFM here because we forget the ordering - -- immediately by creating a TypeEnv - -zonkLIdOcc :: ZonkEnv -> LocatedN TcId -> LocatedN Id -zonkLIdOcc env = fmap (zonkIdOcc env) - -zonkIdOcc :: ZonkEnv -> TcId -> Id --- Ids defined in this module should be in the envt; --- ignore others. (Actually, data constructors are also --- not LocalVars, even when locally defined, but that is fine.) --- (Also foreign-imported things aren't currently in the ZonkEnv; --- that's ok because they don't need zonking.) --- --- Actually, Template Haskell works in 'chunks' of declarations, and --- an earlier chunk won't be in the 'env' that the zonking phase --- carries around. Instead it'll be in the tcg_gbl_env, already fully --- zonked. There's no point in looking it up there (except for error --- checking), and it's not conveniently to hand; hence the simple --- 'orElse' case in the LocalVar branch. --- --- Even without template splices, in module Main, the checking of --- 'main' is done as a separate chunk. -zonkIdOcc (ZonkEnv { ze_id_env = id_env}) id - | isLocalVar id = lookupVarEnv id_env id `orElse` - id - | otherwise = id - -zonkIdOccs :: ZonkEnv -> [TcId] -> [Id] -zonkIdOccs env ids = map (zonkIdOcc env) ids - --- zonkIdBndr is used *after* typechecking to get the Id's type --- to its final form. The TyVarEnv give -zonkIdBndr :: ZonkEnv -> TcId -> TcM Id -zonkIdBndr env v - = do Scaled w' ty' <- zonkScaledTcTypeToTypeX env (idScaledType v) - return (setIdMult (setIdType v ty') w') - -zonkIdBndrs :: ZonkEnv -> [TcId] -> TcM [Id] -zonkIdBndrs env ids = mapM (zonkIdBndr env) ids - -zonkTopBndrs :: [TcId] -> TcM [Id] -zonkTopBndrs ids = initZonkEnv $ \ ze -> zonkIdBndrs ze ids - -zonkFieldOcc :: ZonkEnv -> FieldOcc GhcTc -> TcM (FieldOcc GhcTc) -zonkFieldOcc env (FieldOcc sel lbl) - = fmap ((flip FieldOcc) lbl) $ zonkIdBndr env sel - -zonkEvBndrsX :: ZonkEnv -> [EvVar] -> TcM (ZonkEnv, [Var]) -zonkEvBndrsX = mapAccumLM zonkEvBndrX - -zonkEvBndrX :: ZonkEnv -> EvVar -> TcM (ZonkEnv, EvVar) --- Works for dictionaries and coercions -zonkEvBndrX env var - = do { var' <- zonkEvBndr env var - ; return (extendZonkEnv env [var'], var') } - -zonkEvBndr :: ZonkEnv -> EvVar -> TcM EvVar --- Works for dictionaries and coercions --- Does not extend the ZonkEnv -zonkEvBndr env var - = updateIdTypeAndMultM ({-# SCC "zonkEvBndr_zonkTcTypeToType" #-} zonkTcTypeToTypeX env) var - -{- -zonkEvVarOcc :: ZonkEnv -> EvVar -> TcM EvTerm -zonkEvVarOcc env v - | isCoVar v - = EvCoercion <$> zonkCoVarOcc env v - | otherwise - = return (EvId $ zonkIdOcc env v) --} - -zonkCoreBndrX :: ZonkEnv -> Var -> TcM (ZonkEnv, Var) -zonkCoreBndrX env v - | isId v = do { v' <- zonkIdBndr env v - ; return (extendIdZonkEnv env v', v') } - | otherwise = zonkTyBndrX env v - -zonkCoreBndrsX :: ZonkEnv -> [Var] -> TcM (ZonkEnv, [Var]) -zonkCoreBndrsX = mapAccumLM zonkCoreBndrX - -zonkTyBndrs :: [TcTyVar] -> TcM (ZonkEnv, [TyVar]) -zonkTyBndrs tvs = initZonkEnv $ \ze -> zonkTyBndrsX ze tvs - -zonkTyBndrsX :: ZonkEnv -> [TcTyVar] -> TcM (ZonkEnv, [TyVar]) -zonkTyBndrsX = mapAccumLM zonkTyBndrX - -zonkTyBndrX :: ZonkEnv -> TcTyVar -> TcM (ZonkEnv, TyVar) --- This guarantees to return a TyVar (not a TcTyVar) --- then we add it to the envt, so all occurrences are replaced --- --- It does not clone: the new TyVar has the sane Name --- as the old one. This important when zonking the --- TyVarBndrs of a TyCon, whose Names may scope. -zonkTyBndrX env tv - = assertPpr (isImmutableTyVar tv) (ppr tv <+> dcolon <+> ppr (tyVarKind tv)) $ - do { ki <- zonkTcTypeToTypeX env (tyVarKind tv) - -- Internal names tidy up better, for iface files. - ; let tv' = mkTyVar (tyVarName tv) ki - ; return (extendTyZonkEnv env tv', tv') } - -zonkTyVarBindersX :: ZonkEnv -> [VarBndr TcTyVar vis] - -> TcM (ZonkEnv, [VarBndr TyVar vis]) -zonkTyVarBindersX = mapAccumLM zonkTyVarBinderX - -zonkTyVarBinderX :: ZonkEnv -> VarBndr TcTyVar vis - -> TcM (ZonkEnv, VarBndr TyVar vis) --- Takes a TcTyVar and guarantees to return a TyVar -zonkTyVarBinderX env (Bndr tv vis) - = do { (env', tv') <- zonkTyBndrX env tv - ; return (env', Bndr tv' vis) } - -zonkTopExpr :: HsExpr GhcTc -> TcM (HsExpr GhcTc) -zonkTopExpr e = initZonkEnv $ \ ze -> zonkExpr ze e - -zonkTopLExpr :: LHsExpr GhcTc -> TcM (LHsExpr GhcTc) -zonkTopLExpr e = initZonkEnv $ \ ze -> zonkLExpr ze e - -zonkTopDecls :: Bag EvBind - -> LHsBinds GhcTc - -> [LRuleDecl GhcTc] -> [LTcSpecPrag] - -> [LForeignDecl GhcTc] - -> TcM (TypeEnv, - Bag EvBind, - LHsBinds GhcTc, - [LForeignDecl GhcTc], - [LTcSpecPrag], - [LRuleDecl GhcTc]) -zonkTopDecls ev_binds binds rules imp_specs fords - = do { (env1, ev_binds') <- initZonkEnv $ \ ze -> zonkEvBinds ze ev_binds - ; (env2, binds') <- zonkRecMonoBinds env1 binds - -- Top level is implicitly recursive - ; rules' <- zonkRules env2 rules - ; specs' <- zonkLTcSpecPrags env2 imp_specs - ; fords' <- zonkForeignExports env2 fords - ; return (zonkEnvIds env2, ev_binds', binds', fords', specs', rules') } - ---------------------------------------------- -zonkLocalBinds :: ZonkEnv -> HsLocalBinds GhcTc - -> TcM (ZonkEnv, HsLocalBinds GhcTc) -zonkLocalBinds env (EmptyLocalBinds x) - = return (env, (EmptyLocalBinds x)) - -zonkLocalBinds _ (HsValBinds _ (ValBinds {})) - = panic "zonkLocalBinds" -- Not in typechecker output - -zonkLocalBinds env (HsValBinds x (XValBindsLR (NValBinds binds sigs))) - = do { (env1, new_binds) <- go env binds - ; return (env1, HsValBinds x (XValBindsLR (NValBinds new_binds sigs))) } - where - go env [] - = return (env, []) - go env ((r,b):bs) - = do { (env1, b') <- zonkRecMonoBinds env b - ; (env2, bs') <- go env1 bs - ; return (env2, (r,b'):bs') } - -zonkLocalBinds env (HsIPBinds x (IPBinds dict_binds binds )) = do - new_binds <- mapM (wrapLocMA zonk_ip_bind) binds - let - env1 = extendIdZonkEnvRec env - [ n | (L _ (IPBind n _ _)) <- new_binds] - (env2, new_dict_binds) <- zonkTcEvBinds env1 dict_binds - return (env2, HsIPBinds x (IPBinds new_dict_binds new_binds)) - where - zonk_ip_bind (IPBind dict_id n e) - = do dict_id' <- zonkIdBndr env dict_id - e' <- zonkLExpr env e - return (IPBind dict_id' n e') - ---------------------------------------------- -zonkRecMonoBinds :: ZonkEnv -> LHsBinds GhcTc -> TcM (ZonkEnv, LHsBinds GhcTc) -zonkRecMonoBinds env binds - = fixM (\ ~(_, new_binds) -> do - { let env1 = extendIdZonkEnvRec env (collectHsBindsBinders CollNoDictBinders new_binds) - ; binds' <- zonkMonoBinds env1 binds - ; return (env1, binds') }) - ---------------------------------------------- -zonkMonoBinds :: ZonkEnv -> LHsBinds GhcTc -> TcM (LHsBinds GhcTc) -zonkMonoBinds env binds = mapBagM (zonk_lbind env) binds - -zonk_lbind :: ZonkEnv -> LHsBind GhcTc -> TcM (LHsBind GhcTc) -zonk_lbind env = wrapLocMA (zonk_bind env) - -zonk_bind :: ZonkEnv -> HsBind GhcTc -> TcM (HsBind GhcTc) -zonk_bind env bind@(PatBind { pat_lhs = pat, pat_rhs = grhss - , pat_ext = (ty, ticks)}) - = do { (_env, new_pat) <- zonkPat env pat -- Env already extended - ; new_grhss <- zonkGRHSs env zonkLExpr grhss - ; new_ty <- zonkTcTypeToTypeX env ty - ; return (bind { pat_lhs = new_pat, pat_rhs = new_grhss - , pat_ext = (new_ty, ticks) }) } - -zonk_bind env (VarBind { var_ext = x - , var_id = var, var_rhs = expr }) - = do { new_var <- zonkIdBndr env var - ; new_expr <- zonkLExpr env expr - ; return (VarBind { var_ext = x - , var_id = new_var - , var_rhs = new_expr }) } - -zonk_bind env bind@(FunBind { fun_id = L loc var - , fun_matches = ms - , fun_ext = (co_fn, ticks) }) - = do { new_var <- zonkIdBndr env var - ; (env1, new_co_fn) <- zonkCoFn env co_fn - ; new_ms <- zonkMatchGroup env1 zonkLExpr ms - ; return (bind { fun_id = L loc new_var - , fun_matches = new_ms - , fun_ext = (new_co_fn, ticks) }) } - -zonk_bind env (XHsBindsLR (AbsBinds { abs_tvs = tyvars, abs_ev_vars = evs - , abs_ev_binds = ev_binds - , abs_exports = exports - , abs_binds = val_binds - , abs_sig = has_sig })) - = assert ( all isImmutableTyVar tyvars ) $ - do { (env0, new_tyvars) <- zonkTyBndrsX env tyvars - ; (env1, new_evs) <- zonkEvBndrsX env0 evs - ; (env2, new_ev_binds) <- zonkTcEvBinds_s env1 ev_binds - ; (new_val_bind, new_exports) <- fixM $ \ ~(new_val_binds, _) -> - do { let env3 = extendIdZonkEnvRec env2 $ - collectHsBindsBinders CollNoDictBinders new_val_binds - ; new_val_binds <- mapBagM (zonk_val_bind env3) val_binds - ; new_exports <- mapM (zonk_export env3) exports - ; return (new_val_binds, new_exports) } - ; return $ XHsBindsLR $ - AbsBinds { abs_tvs = new_tyvars, abs_ev_vars = new_evs - , abs_ev_binds = new_ev_binds - , abs_exports = new_exports, abs_binds = new_val_bind - , abs_sig = has_sig } } - where - zonk_val_bind env lbind - | has_sig - , (L loc bind@(FunBind { fun_id = (L mloc mono_id) - , fun_matches = ms - , fun_ext = (co_fn, ticks) })) <- lbind - = do { new_mono_id <- updateIdTypeAndMultM (zonkTcTypeToTypeX env) mono_id - -- Specifically /not/ zonkIdBndr; we do not want to - -- complain about a representation-polymorphic binder - ; (env', new_co_fn) <- zonkCoFn env co_fn - ; new_ms <- zonkMatchGroup env' zonkLExpr ms - ; return $ L loc $ - bind { fun_id = L mloc new_mono_id - , fun_matches = new_ms - , fun_ext = (new_co_fn, ticks) } } - | otherwise - = zonk_lbind env lbind -- The normal case - - zonk_export :: ZonkEnv -> ABExport -> TcM ABExport - zonk_export env (ABE{ abe_wrap = wrap - , abe_poly = poly_id - , abe_mono = mono_id - , abe_prags = prags }) - = do new_poly_id <- zonkIdBndr env poly_id - (_, new_wrap) <- zonkCoFn env wrap - new_prags <- zonkSpecPrags env prags - return (ABE{ abe_wrap = new_wrap - , abe_poly = new_poly_id - , abe_mono = zonkIdOcc env mono_id - , abe_prags = new_prags }) - -zonk_bind env (PatSynBind x bind@(PSB { psb_id = L loc id - , psb_args = details - , psb_def = lpat - , psb_dir = dir })) - = do { id' <- zonkIdBndr env id - ; (env1, lpat') <- zonkPat env lpat - ; details' <- zonkPatSynDetails env1 details - ; (_env2, dir') <- zonkPatSynDir env1 dir - ; return $ PatSynBind x $ - bind { psb_id = L loc id' - , psb_args = details' - , psb_def = lpat' - , psb_dir = dir' } } - -zonkPatSynDetails :: ZonkEnv - -> HsPatSynDetails GhcTc - -> TcM (HsPatSynDetails GhcTc) -zonkPatSynDetails env (PrefixCon _ as) - = pure $ PrefixCon noTypeArgs (map (zonkLIdOcc env) as) -zonkPatSynDetails env (InfixCon a1 a2) - = pure $ InfixCon (zonkLIdOcc env a1) (zonkLIdOcc env a2) -zonkPatSynDetails env (RecCon flds) - = RecCon <$> mapM (zonkPatSynField env) flds - -zonkPatSynField :: ZonkEnv -> RecordPatSynField GhcTc -> TcM (RecordPatSynField GhcTc) -zonkPatSynField env (RecordPatSynField x y) = - RecordPatSynField <$> zonkFieldOcc env x <*> pure (zonkLIdOcc env y) - -zonkPatSynDir :: ZonkEnv -> HsPatSynDir GhcTc - -> TcM (ZonkEnv, HsPatSynDir GhcTc) -zonkPatSynDir env Unidirectional = return (env, Unidirectional) -zonkPatSynDir env ImplicitBidirectional = return (env, ImplicitBidirectional) -zonkPatSynDir env (ExplicitBidirectional mg) = do - mg' <- zonkMatchGroup env zonkLExpr mg - return (env, ExplicitBidirectional mg') - -zonkSpecPrags :: ZonkEnv -> TcSpecPrags -> TcM TcSpecPrags -zonkSpecPrags _ IsDefaultMethod = return IsDefaultMethod -zonkSpecPrags env (SpecPrags ps) = do { ps' <- zonkLTcSpecPrags env ps - ; return (SpecPrags ps') } - -zonkLTcSpecPrags :: ZonkEnv -> [LTcSpecPrag] -> TcM [LTcSpecPrag] -zonkLTcSpecPrags env ps - = mapM zonk_prag ps - where - zonk_prag (L loc (SpecPrag id co_fn inl)) - = do { (_, co_fn') <- zonkCoFn env co_fn - ; return (L loc (SpecPrag (zonkIdOcc env id) co_fn' inl)) } - -{- -************************************************************************ -* * -\subsection[BackSubst-Match-GRHSs]{Match and GRHSs} -* * -************************************************************************ --} - -zonkMatchGroup :: Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ SrcAnn NoEpAnns - => ZonkEnv - -> (ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))) - -> MatchGroup GhcTc (LocatedA (body GhcTc)) - -> TcM (MatchGroup GhcTc (LocatedA (body GhcTc))) -zonkMatchGroup env zBody (MG { mg_alts = L l ms - , mg_ext = MatchGroupTc arg_tys res_ty origin - }) - = do { ms' <- mapM (zonkMatch env zBody) ms - ; arg_tys' <- zonkScaledTcTypesToTypesX env arg_tys - ; res_ty' <- zonkTcTypeToTypeX env res_ty - ; return (MG { mg_alts = L l ms' - , mg_ext = MatchGroupTc arg_tys' res_ty' origin - }) } - -zonkMatch :: Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ SrcAnn NoEpAnns - => ZonkEnv - -> (ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))) - -> LMatch GhcTc (LocatedA (body GhcTc)) - -> TcM (LMatch GhcTc (LocatedA (body GhcTc))) -zonkMatch env zBody (L loc match@(Match { m_pats = pats - , m_grhss = grhss })) - = do { (env1, new_pats) <- zonkPats env pats - ; new_grhss <- zonkGRHSs env1 zBody grhss - ; return (L loc (match { m_pats = new_pats, m_grhss = new_grhss })) } - -------------------------------------------------------------------------- -zonkGRHSs :: Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ SrcAnn NoEpAnns - => ZonkEnv - -> (ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))) - -> GRHSs GhcTc (LocatedA (body GhcTc)) - -> TcM (GRHSs GhcTc (LocatedA (body GhcTc))) - -zonkGRHSs env zBody (GRHSs x grhss binds) = do - (new_env, new_binds) <- zonkLocalBinds env binds - let - zonk_grhs (GRHS xx guarded rhs) - = do (env2, new_guarded) <- zonkStmts new_env zonkLExpr guarded - new_rhs <- zBody env2 rhs - return (GRHS xx new_guarded new_rhs) - new_grhss <- mapM (wrapLocMA zonk_grhs) grhss - return (GRHSs x new_grhss new_binds) - -{- -************************************************************************ -* * -\subsection[BackSubst-HsExpr]{Running a zonkitution over a TypeCheckedExpr} -* * -************************************************************************ --} - -zonkLExprs :: ZonkEnv -> [LHsExpr GhcTc] -> TcM [LHsExpr GhcTc] -zonkLExpr :: ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc) -zonkExpr :: ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc) - -zonkLExprs env exprs = mapM (zonkLExpr env) exprs -zonkLExpr env expr = wrapLocMA (zonkExpr env) expr - -zonkExpr env (HsVar x (L l id)) - = assertPpr (isNothing (isDataConId_maybe id)) (ppr id) $ - return (HsVar x (L l (zonkIdOcc env id))) - -zonkExpr env (HsUnboundVar her occ) - = do her' <- zonk_her her - return (HsUnboundVar her' occ) - where - zonk_her :: HoleExprRef -> TcM HoleExprRef - zonk_her (HER ref ty u) - = do updMutVarM ref (zonkEvTerm env) - ty' <- zonkTcTypeToTypeX env ty - return (HER ref ty' u) - -zonkExpr env (HsRecSel _ (FieldOcc v occ)) - = return (HsRecSel noExtField (FieldOcc (zonkIdOcc env v) occ)) - -zonkExpr _ (HsIPVar x _) = dataConCantHappen x - -zonkExpr _ (HsOverLabel x _ _) = dataConCantHappen x - -zonkExpr env (HsLit x (HsRat e f ty)) - = do new_ty <- zonkTcTypeToTypeX env ty - return (HsLit x (HsRat e f new_ty)) - -zonkExpr _ (HsLit x lit) - = return (HsLit x lit) - -zonkExpr env (HsOverLit x lit) - = do { lit' <- zonkOverLit env lit - ; return (HsOverLit x lit') } - -zonkExpr env (HsLam x matches) - = do new_matches <- zonkMatchGroup env zonkLExpr matches - return (HsLam x new_matches) - -zonkExpr env (HsLamCase x lc_variant matches) - = do new_matches <- zonkMatchGroup env zonkLExpr matches - return (HsLamCase x lc_variant new_matches) - -zonkExpr env (HsApp x e1 e2) - = do new_e1 <- zonkLExpr env e1 - new_e2 <- zonkLExpr env e2 - return (HsApp x new_e1 new_e2) - -zonkExpr env (HsAppType ty e at t) - = do new_e <- zonkLExpr env e - new_ty <- zonkTcTypeToTypeX env ty - return (HsAppType new_ty new_e at t) - -- NB: the type is an HsType; can't zonk that! - -zonkExpr env (HsTypedBracket hsb_tc body) - = (\x -> HsTypedBracket x body) <$> zonkBracket env hsb_tc - -zonkExpr env (HsUntypedBracket hsb_tc body) - = (\x -> HsUntypedBracket x body) <$> zonkBracket env hsb_tc - -zonkExpr env (HsTypedSplice s _) = runTopSplice s >>= zonkExpr env - -zonkExpr _ (HsUntypedSplice x _) = dataConCantHappen x - -zonkExpr _ (OpApp x _ _ _) = dataConCantHappen x - -zonkExpr env (NegApp x expr op) - = do (env', new_op) <- zonkSyntaxExpr env op - new_expr <- zonkLExpr env' expr - return (NegApp x new_expr new_op) - -zonkExpr env (HsPar x lpar e rpar) - = do new_e <- zonkLExpr env e - return (HsPar x lpar new_e rpar) - -zonkExpr _ (SectionL x _ _) = dataConCantHappen x -zonkExpr _ (SectionR x _ _) = dataConCantHappen x -zonkExpr env (ExplicitTuple x tup_args boxed) - = do { new_tup_args <- mapM zonk_tup_arg tup_args - ; return (ExplicitTuple x new_tup_args boxed) } - where - zonk_tup_arg (Present x e) = do { e' <- zonkLExpr env e - ; return (Present x e') } - zonk_tup_arg (Missing t) = do { t' <- zonkScaledTcTypeToTypeX env t - ; return (Missing t') } - - -zonkExpr env (ExplicitSum args alt arity expr) - = do new_args <- mapM (zonkTcTypeToTypeX env) args - new_expr <- zonkLExpr env expr - return (ExplicitSum new_args alt arity new_expr) - -zonkExpr env (HsCase x expr ms) - = do new_expr <- zonkLExpr env expr - new_ms <- zonkMatchGroup env zonkLExpr ms - return (HsCase x new_expr new_ms) - -zonkExpr env (HsIf x e1 e2 e3) - = do new_e1 <- zonkLExpr env e1 - new_e2 <- zonkLExpr env e2 - new_e3 <- zonkLExpr env e3 - return (HsIf x new_e1 new_e2 new_e3) - -zonkExpr env (HsMultiIf ty alts) - = do { alts' <- mapM (wrapLocMA zonk_alt) alts - ; ty' <- zonkTcTypeToTypeX env ty - ; return $ HsMultiIf ty' alts' } - where zonk_alt (GRHS x guard expr) - = do { (env', guard') <- zonkStmts env zonkLExpr guard - ; expr' <- zonkLExpr env' expr - ; return $ GRHS x guard' expr' } - -zonkExpr env (HsLet x tkLet binds tkIn expr) - = do (new_env, new_binds) <- zonkLocalBinds env binds - new_expr <- zonkLExpr new_env expr - return (HsLet x tkLet new_binds tkIn new_expr) - -zonkExpr env (HsDo ty do_or_lc (L l stmts)) - = do (_, new_stmts) <- zonkStmts env zonkLExpr stmts - new_ty <- zonkTcTypeToTypeX env ty - return (HsDo new_ty do_or_lc (L l new_stmts)) - -zonkExpr env (ExplicitList ty exprs) - = do new_ty <- zonkTcTypeToTypeX env ty - new_exprs <- zonkLExprs env exprs - return (ExplicitList new_ty new_exprs) - -zonkExpr env expr@(RecordCon { rcon_ext = con_expr, rcon_flds = rbinds }) - = do { new_con_expr <- zonkExpr env con_expr - ; new_rbinds <- zonkRecFields env rbinds - ; return (expr { rcon_ext = new_con_expr - , rcon_flds = new_rbinds }) } - -zonkExpr env (ExprWithTySig _ e ty) - = do { e' <- zonkLExpr env e - ; return (ExprWithTySig noExtField e' ty) } - -zonkExpr env (ArithSeq expr wit info) - = do (env1, new_wit) <- zonkWit env wit - new_expr <- zonkExpr env expr - new_info <- zonkArithSeq env1 info - return (ArithSeq new_expr new_wit new_info) - where zonkWit env Nothing = return (env, Nothing) - zonkWit env (Just fln) = second Just <$> zonkSyntaxExpr env fln - -zonkExpr env (HsPragE x prag expr) - = do new_expr <- zonkLExpr env expr - return (HsPragE x prag new_expr) - --- arrow notation extensions -zonkExpr env (HsProc x pat body) - = do { (env1, new_pat) <- zonkPat env pat - ; new_body <- zonkCmdTop env1 body - ; return (HsProc x new_pat new_body) } - --- StaticPointers extension -zonkExpr env (HsStatic (fvs, ty) expr) - = do new_ty <- zonkTcTypeToTypeX env ty - HsStatic (fvs, new_ty) <$> zonkLExpr env expr - -zonkExpr env (XExpr (WrapExpr (HsWrap co_fn expr))) - = do (env1, new_co_fn) <- zonkCoFn env co_fn - new_expr <- zonkExpr env1 expr - return (XExpr (WrapExpr (HsWrap new_co_fn new_expr))) - -zonkExpr env (XExpr (ExpansionExpr (HsExpanded a b))) - = XExpr . ExpansionExpr . HsExpanded a <$> zonkExpr env b - -zonkExpr env (XExpr (ConLikeTc con tvs tys)) - = XExpr . ConLikeTc con tvs <$> mapM zonk_scale tys - where - zonk_scale (Scaled m ty) = Scaled <$> zonkTcTypeToTypeX env m <*> pure ty - -- Only the multiplicity can contain unification variables - -- The tvs come straight from the data-con, and so are strictly redundant - -- See Wrinkles of Note [Typechecking data constructors] in GHC.Tc.Gen.Head - -zonkExpr _ (RecordUpd x _ _) = dataConCantHappen x -zonkExpr _ (HsGetField x _ _) = dataConCantHappen x -zonkExpr _ (HsProjection x _) = dataConCantHappen x -zonkExpr _ e@(XExpr (HsTick {})) = pprPanic "zonkExpr" (ppr e) -zonkExpr _ e@(XExpr (HsBinTick {})) = pprPanic "zonkExpr" (ppr e) - -------------------------------------------------------------------------- -{- -Note [Skolems in zonkSyntaxExpr] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider rebindable syntax with something like - - (>>=) :: (forall x. blah) -> (forall y. blah') -> blah'' - -The x and y become skolems that are in scope when type-checking the -arguments to the bind. This means that we must extend the ZonkEnv with -these skolems when zonking the arguments to the bind. But the skolems -are different between the two arguments, and so we should theoretically -carry around different environments to use for the different arguments. - -However, this becomes a logistical nightmare, especially in dealing with -the more exotic Stmt forms. So, we simplify by making the critical -assumption that the uniques of the skolems are different. (This assumption -is justified by the use of newUnique in GHC.Tc.Utils.TcMType.instSkolTyCoVarX.) -Now, we can safely just extend one environment. --} - --- See Note [Skolems in zonkSyntaxExpr] -zonkSyntaxExpr :: ZonkEnv -> SyntaxExpr GhcTc - -> TcM (ZonkEnv, SyntaxExpr GhcTc) -zonkSyntaxExpr env (SyntaxExprTc { syn_expr = expr - , syn_arg_wraps = arg_wraps - , syn_res_wrap = res_wrap }) - = do { (env0, res_wrap') <- zonkCoFn env res_wrap - ; expr' <- zonkExpr env0 expr - ; (env1, arg_wraps') <- mapAccumLM zonkCoFn env0 arg_wraps - ; return (env1, SyntaxExprTc { syn_expr = expr' - , syn_arg_wraps = arg_wraps' - , syn_res_wrap = res_wrap' }) } -zonkSyntaxExpr env NoSyntaxExprTc = return (env, NoSyntaxExprTc) - -------------------------------------------------------------------------- - -zonkLCmd :: ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc) -zonkCmd :: ZonkEnv -> HsCmd GhcTc -> TcM (HsCmd GhcTc) - -zonkLCmd env cmd = wrapLocMA (zonkCmd env) cmd - -zonkCmd env (XCmd (HsWrap w cmd)) - = do { (env1, w') <- zonkCoFn env w - ; cmd' <- zonkCmd env1 cmd - ; return (XCmd (HsWrap w' cmd')) } -zonkCmd env (HsCmdArrApp ty e1 e2 ho rl) - = do new_e1 <- zonkLExpr env e1 - new_e2 <- zonkLExpr env e2 - new_ty <- zonkTcTypeToTypeX env ty - return (HsCmdArrApp new_ty new_e1 new_e2 ho rl) - -zonkCmd env (HsCmdArrForm x op f fixity args) - = do new_op <- zonkLExpr env op - new_args <- mapM (zonkCmdTop env) args - return (HsCmdArrForm x new_op f fixity new_args) - -zonkCmd env (HsCmdApp x c e) - = do new_c <- zonkLCmd env c - new_e <- zonkLExpr env e - return (HsCmdApp x new_c new_e) - -zonkCmd env (HsCmdLam x matches) - = do new_matches <- zonkMatchGroup env zonkLCmd matches - return (HsCmdLam x new_matches) - -zonkCmd env (HsCmdPar x lpar c rpar) - = do new_c <- zonkLCmd env c - return (HsCmdPar x lpar new_c rpar) - -zonkCmd env (HsCmdCase x expr ms) - = do new_expr <- zonkLExpr env expr - new_ms <- zonkMatchGroup env zonkLCmd ms - return (HsCmdCase x new_expr new_ms) - -zonkCmd env (HsCmdLamCase x lc_variant ms) - = do new_ms <- zonkMatchGroup env zonkLCmd ms - return (HsCmdLamCase x lc_variant new_ms) - -zonkCmd env (HsCmdIf x eCond ePred cThen cElse) - = do { (env1, new_eCond) <- zonkSyntaxExpr env eCond - ; new_ePred <- zonkLExpr env1 ePred - ; new_cThen <- zonkLCmd env1 cThen - ; new_cElse <- zonkLCmd env1 cElse - ; return (HsCmdIf x new_eCond new_ePred new_cThen new_cElse) } - -zonkCmd env (HsCmdLet x tkLet binds tkIn cmd) - = do (new_env, new_binds) <- zonkLocalBinds env binds - new_cmd <- zonkLCmd new_env cmd - return (HsCmdLet x tkLet new_binds tkIn new_cmd) - -zonkCmd env (HsCmdDo ty (L l stmts)) - = do (_, new_stmts) <- zonkStmts env zonkLCmd stmts - new_ty <- zonkTcTypeToTypeX env ty - return (HsCmdDo new_ty (L l new_stmts)) - - - -zonkCmdTop :: ZonkEnv -> LHsCmdTop GhcTc -> TcM (LHsCmdTop GhcTc) -zonkCmdTop env cmd = wrapLocMA (zonk_cmd_top env) cmd - -zonk_cmd_top :: ZonkEnv -> HsCmdTop GhcTc -> TcM (HsCmdTop GhcTc) -zonk_cmd_top env (HsCmdTop (CmdTopTc stack_tys ty ids) cmd) - = do new_cmd <- zonkLCmd env cmd - new_stack_tys <- zonkTcTypeToTypeX env stack_tys - new_ty <- zonkTcTypeToTypeX env ty - new_ids <- mapSndM (zonkExpr env) ids - - massert (isLiftedTypeKind (typeKind new_stack_tys)) - -- desugarer assumes that this is not representation-polymorphic... - -- but indeed it should always be lifted due to the typing - -- rules for arrows - - return (HsCmdTop (CmdTopTc new_stack_tys new_ty new_ids) new_cmd) - -------------------------------------------------------------------------- -zonkCoFn :: ZonkEnv -> HsWrapper -> TcM (ZonkEnv, HsWrapper) -zonkCoFn env WpHole = return (env, WpHole) -zonkCoFn env (WpCompose c1 c2) = do { (env1, c1') <- zonkCoFn env c1 - ; (env2, c2') <- zonkCoFn env1 c2 - ; return (env2, WpCompose c1' c2') } -zonkCoFn env (WpFun c1 c2 t1) = do { (env1, c1') <- zonkCoFn env c1 - ; (env2, c2') <- zonkCoFn env1 c2 - ; t1' <- zonkScaledTcTypeToTypeX env2 t1 - ; return (env2, WpFun c1' c2' t1') } -zonkCoFn env (WpCast co) = do { co' <- zonkCoToCo env co - ; return (env, WpCast co') } -zonkCoFn env (WpEvLam ev) = do { (env', ev') <- zonkEvBndrX env ev - ; return (env', WpEvLam ev') } -zonkCoFn env (WpEvApp arg) = do { arg' <- zonkEvTerm env arg - ; return (env, WpEvApp arg') } -zonkCoFn env (WpTyLam tv) = assert (isImmutableTyVar tv) $ - do { (env', tv') <- zonkTyBndrX env tv - ; return (env', WpTyLam tv') } -zonkCoFn env (WpTyApp ty) = do { ty' <- zonkTcTypeToTypeX env ty - ; return (env, WpTyApp ty') } -zonkCoFn env (WpLet bs) = do { (env1, bs') <- zonkTcEvBinds env bs - ; return (env1, WpLet bs') } -zonkCoFn env (WpMultCoercion co) = do { co' <- zonkCoToCo env co - ; return (env, WpMultCoercion co') } - -------------------------------------------------------------------------- -zonkOverLit :: ZonkEnv -> HsOverLit GhcTc -> TcM (HsOverLit GhcTc) -zonkOverLit env lit@(OverLit {ol_ext = x at OverLitTc { ol_witness = e, ol_type = ty } }) - = do { ty' <- zonkTcTypeToTypeX env ty - ; e' <- zonkExpr env e - ; return (lit { ol_ext = x { ol_witness = e' - , ol_type = ty' } }) } - -------------------------------------------------------------------------- -zonkBracket :: ZonkEnv -> HsBracketTc -> TcM HsBracketTc -zonkBracket env (HsBracketTc hsb_thing ty wrap bs) - = do wrap' <- traverse zonkQuoteWrap wrap - bs' <- mapM (zonk_b env) bs - new_ty <- zonkTcTypeToTypeX env ty - return (HsBracketTc hsb_thing new_ty wrap' bs') - where - zonkQuoteWrap (QuoteWrapper ev ty) = do - let ev' = zonkIdOcc env ev - ty' <- zonkTcTypeToTypeX env ty - return (QuoteWrapper ev' ty') - - zonk_b env' (PendingTcSplice n e) = do e' <- zonkLExpr env' e - return (PendingTcSplice n e') - -------------------------------------------------------------------------- -zonkArithSeq :: ZonkEnv -> ArithSeqInfo GhcTc -> TcM (ArithSeqInfo GhcTc) - -zonkArithSeq env (From e) - = do new_e <- zonkLExpr env e - return (From new_e) - -zonkArithSeq env (FromThen e1 e2) - = do new_e1 <- zonkLExpr env e1 - new_e2 <- zonkLExpr env e2 - return (FromThen new_e1 new_e2) - -zonkArithSeq env (FromTo e1 e2) - = do new_e1 <- zonkLExpr env e1 - new_e2 <- zonkLExpr env e2 - return (FromTo new_e1 new_e2) - -zonkArithSeq env (FromThenTo e1 e2 e3) - = do new_e1 <- zonkLExpr env e1 - new_e2 <- zonkLExpr env e2 - new_e3 <- zonkLExpr env e3 - return (FromThenTo new_e1 new_e2 new_e3) - -------------------------------------------------------------------------- -zonkStmts :: Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))) ~ SrcSpanAnnA - => ZonkEnv - -> (ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))) - -> [LStmt GhcTc (LocatedA (body GhcTc))] - -> TcM (ZonkEnv, [LStmt GhcTc (LocatedA (body GhcTc))]) -zonkStmts env _ [] = return (env, []) -zonkStmts env zBody (s:ss) = do { (env1, s') <- wrapLocSndMA (zonkStmt env zBody) s - ; (env2, ss') <- zonkStmts env1 zBody ss - ; return (env2, s' : ss') } - -zonkStmt :: Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))) ~ SrcSpanAnnA - => ZonkEnv - -> (ZonkEnv -> LocatedA (body GhcTc) -> TcM (LocatedA (body GhcTc))) - -> Stmt GhcTc (LocatedA (body GhcTc)) - -> TcM (ZonkEnv, Stmt GhcTc (LocatedA (body GhcTc))) -zonkStmt env _ (ParStmt bind_ty stmts_w_bndrs mzip_op bind_op) - = do { (env1, new_bind_op) <- zonkSyntaxExpr env bind_op - ; new_bind_ty <- zonkTcTypeToTypeX env1 bind_ty - ; new_stmts_w_bndrs <- mapM (zonk_branch env1) stmts_w_bndrs - ; let new_binders = [b | ParStmtBlock _ _ bs _ <- new_stmts_w_bndrs - , b <- bs] - env2 = extendIdZonkEnvRec env1 new_binders - ; new_mzip <- zonkExpr env2 mzip_op - ; return (env2 - , ParStmt new_bind_ty new_stmts_w_bndrs new_mzip new_bind_op)} - where - zonk_branch :: ZonkEnv -> ParStmtBlock GhcTc GhcTc - -> TcM (ParStmtBlock GhcTc GhcTc) - zonk_branch env1 (ParStmtBlock x stmts bndrs return_op) - = do { (env2, new_stmts) <- zonkStmts env1 zonkLExpr stmts - ; (env3, new_return) <- zonkSyntaxExpr env2 return_op - ; return (ParStmtBlock x new_stmts (zonkIdOccs env3 bndrs) - new_return) } - -zonkStmt env zBody (RecStmt { recS_stmts = L _ segStmts, recS_later_ids = lvs - , recS_rec_ids = rvs - , recS_ret_fn = ret_id, recS_mfix_fn = mfix_id - , recS_bind_fn = bind_id - , recS_ext = - RecStmtTc { recS_bind_ty = bind_ty - , recS_later_rets = later_rets - , recS_rec_rets = rec_rets - , recS_ret_ty = ret_ty} }) - = do { (env1, new_bind_id) <- zonkSyntaxExpr env bind_id - ; (env2, new_mfix_id) <- zonkSyntaxExpr env1 mfix_id - ; (env3, new_ret_id) <- zonkSyntaxExpr env2 ret_id - ; new_bind_ty <- zonkTcTypeToTypeX env3 bind_ty - ; new_rvs <- zonkIdBndrs env3 rvs - ; new_lvs <- zonkIdBndrs env3 lvs - ; new_ret_ty <- zonkTcTypeToTypeX env3 ret_ty - ; let env4 = extendIdZonkEnvRec env3 new_rvs - ; (env5, new_segStmts) <- zonkStmts env4 zBody segStmts - -- Zonk the ret-expressions in an envt that - -- has the polymorphic bindings in the envt - ; new_later_rets <- mapM (zonkExpr env5) later_rets - ; new_rec_rets <- mapM (zonkExpr env5) rec_rets - ; return (extendIdZonkEnvRec env3 new_lvs, -- Only the lvs are needed - RecStmt { recS_stmts = noLocA new_segStmts - , recS_later_ids = new_lvs - , recS_rec_ids = new_rvs, recS_ret_fn = new_ret_id - , recS_mfix_fn = new_mfix_id, recS_bind_fn = new_bind_id - , recS_ext = RecStmtTc - { recS_bind_ty = new_bind_ty - , recS_later_rets = new_later_rets - , recS_rec_rets = new_rec_rets - , recS_ret_ty = new_ret_ty } }) } - -zonkStmt env zBody (BodyStmt ty body then_op guard_op) - = do (env1, new_then_op) <- zonkSyntaxExpr env then_op - (env2, new_guard_op) <- zonkSyntaxExpr env1 guard_op - new_body <- zBody env2 body - new_ty <- zonkTcTypeToTypeX env2 ty - return (env2, BodyStmt new_ty new_body new_then_op new_guard_op) - -zonkStmt env zBody (LastStmt x body noret ret_op) - = do (env1, new_ret) <- zonkSyntaxExpr env ret_op - new_body <- zBody env1 body - return (env, LastStmt x new_body noret new_ret) - -zonkStmt env _ (TransStmt { trS_stmts = stmts, trS_bndrs = binderMap - , trS_by = by, trS_form = form, trS_using = using - , trS_ret = return_op, trS_bind = bind_op - , trS_ext = bind_arg_ty - , trS_fmap = liftM_op }) - = do { - ; (env1, bind_op') <- zonkSyntaxExpr env bind_op - ; bind_arg_ty' <- zonkTcTypeToTypeX env1 bind_arg_ty - ; (env2, stmts') <- zonkStmts env1 zonkLExpr stmts - ; by' <- traverse (zonkLExpr env2) by - ; using' <- zonkLExpr env2 using - - ; (env3, return_op') <- zonkSyntaxExpr env2 return_op - ; binderMap' <- mapM (zonkBinderMapEntry env3) binderMap - ; liftM_op' <- zonkExpr env3 liftM_op - ; let env3' = extendIdZonkEnvRec env3 (map snd binderMap') - ; return (env3', TransStmt { trS_stmts = stmts', trS_bndrs = binderMap' - , trS_by = by', trS_form = form, trS_using = using' - , trS_ret = return_op', trS_bind = bind_op' - , trS_ext = bind_arg_ty' - , trS_fmap = liftM_op' }) } - where - zonkBinderMapEntry env (oldBinder, newBinder) = do - let oldBinder' = zonkIdOcc env oldBinder - newBinder' <- zonkIdBndr env newBinder - return (oldBinder', newBinder') - -zonkStmt env _ (LetStmt x binds) - = do (env1, new_binds) <- zonkLocalBinds env binds - return (env1, LetStmt x new_binds) - -zonkStmt env zBody (BindStmt xbs pat body) - = do { (env1, new_bind) <- zonkSyntaxExpr env (xbstc_bindOp xbs) - ; new_w <- zonkTcTypeToTypeX env1 (xbstc_boundResultMult xbs) - ; new_bind_ty <- zonkTcTypeToTypeX env1 (xbstc_boundResultType xbs) - ; new_body <- zBody env1 body - ; (env2, new_pat) <- zonkPat env1 pat - ; new_fail <- case xbstc_failOp xbs of - Nothing -> return Nothing - Just f -> fmap (Just . snd) (zonkSyntaxExpr env1 f) - ; return ( env2 - , BindStmt (XBindStmtTc - { xbstc_bindOp = new_bind - , xbstc_boundResultType = new_bind_ty - , xbstc_boundResultMult = new_w - , xbstc_failOp = new_fail - }) - new_pat new_body) } - --- Scopes: join > ops (in reverse order) > pats (in forward order) --- > rest of stmts -zonkStmt env _zBody (ApplicativeStmt body_ty args mb_join) - = do { (env1, new_mb_join) <- zonk_join env mb_join - ; (env2, new_args) <- zonk_args env1 args - ; new_body_ty <- zonkTcTypeToTypeX env2 body_ty - ; return ( env2 - , ApplicativeStmt new_body_ty new_args new_mb_join) } - where - zonk_join env Nothing = return (env, Nothing) - zonk_join env (Just j) = second Just <$> zonkSyntaxExpr env j - - get_pat :: (SyntaxExpr GhcTc, ApplicativeArg GhcTc) -> LPat GhcTc - get_pat (_, ApplicativeArgOne _ pat _ _) = pat - get_pat (_, ApplicativeArgMany _ _ _ pat _) = pat - - replace_pat :: LPat GhcTc - -> (SyntaxExpr GhcTc, ApplicativeArg GhcTc) - -> (SyntaxExpr GhcTc, ApplicativeArg GhcTc) - replace_pat pat (op, ApplicativeArgOne fail_op _ a isBody) - = (op, ApplicativeArgOne fail_op pat a isBody) - replace_pat pat (op, ApplicativeArgMany x a b _ c) - = (op, ApplicativeArgMany x a b pat c) - - zonk_args env args - = do { (env1, new_args_rev) <- zonk_args_rev env (reverse args) - ; (env2, new_pats) <- zonkPats env1 (map get_pat args) - ; return (env2, zipWithEqual "zonkStmt" replace_pat - new_pats (reverse new_args_rev)) } - - -- these need to go backward, because if any operators are higher-rank, - -- later operators may introduce skolems that are in scope for earlier - -- arguments - zonk_args_rev env ((op, arg) : args) - = do { (env1, new_op) <- zonkSyntaxExpr env op - ; new_arg <- zonk_arg env1 arg - ; (env2, new_args) <- zonk_args_rev env1 args - ; return (env2, (new_op, new_arg) : new_args) } - zonk_args_rev env [] = return (env, []) - - zonk_arg env (ApplicativeArgOne fail_op pat expr isBody) - = do { new_expr <- zonkLExpr env expr - ; new_fail <- forM fail_op $ \old_fail -> - do { (_, fail') <- zonkSyntaxExpr env old_fail - ; return fail' - } - ; return (ApplicativeArgOne new_fail pat new_expr isBody) } - zonk_arg env (ApplicativeArgMany x stmts ret pat ctxt) - = do { (env1, new_stmts) <- zonkStmts env zonkLExpr stmts - ; new_ret <- zonkExpr env1 ret - ; return (ApplicativeArgMany x new_stmts new_ret pat ctxt) } - -------------------------------------------------------------------------- -zonkRecFields :: ZonkEnv -> HsRecordBinds GhcTc -> TcM (HsRecordBinds GhcTc) -zonkRecFields env (HsRecFields flds dd) - = do { flds' <- mapM zonk_rbind flds - ; return (HsRecFields flds' dd) } - where - zonk_rbind (L l fld) - = do { new_id <- wrapLocMA (zonkFieldOcc env) (hfbLHS fld) - ; new_expr <- zonkLExpr env (hfbRHS fld) - ; return (L l (fld { hfbLHS = new_id - , hfbRHS = new_expr })) } - -{- -************************************************************************ -* * -\subsection[BackSubst-Pats]{Patterns} -* * -************************************************************************ --} - -zonkPat :: ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc) --- Extend the environment as we go, because it's possible for one --- pattern to bind something that is used in another (inside or --- to the right) -zonkPat env pat = wrapLocSndMA (zonk_pat env) pat - -zonk_pat :: ZonkEnv -> Pat GhcTc -> TcM (ZonkEnv, Pat GhcTc) -zonk_pat env (ParPat x lpar p rpar) - = do { (env', p') <- zonkPat env p - ; return (env', ParPat x lpar p' rpar) } - -zonk_pat env (WildPat ty) - = do { ty' <- zonkTcTypeToTypeX env ty - ; return (env, WildPat ty') } - -zonk_pat env (VarPat x (L l v)) - = do { v' <- zonkIdBndr env v - ; return (extendIdZonkEnv env v', VarPat x (L l v')) } - -zonk_pat env (LazyPat x pat) - = do { (env', pat') <- zonkPat env pat - ; return (env', LazyPat x pat') } - -zonk_pat env (BangPat x pat) - = do { (env', pat') <- zonkPat env pat - ; return (env', BangPat x pat') } - -zonk_pat env (AsPat x (L loc v) at pat) - = do { v' <- zonkIdBndr env v - ; (env', pat') <- zonkPat (extendIdZonkEnv env v') pat - ; return (env', AsPat x (L loc v') at pat') } - -zonk_pat env (ViewPat ty expr pat) - = do { expr' <- zonkLExpr env expr - ; (env', pat') <- zonkPat env pat - ; ty' <- zonkTcTypeToTypeX env ty - ; return (env', ViewPat ty' expr' pat') } - -zonk_pat env (ListPat ty pats) - = do { ty' <- zonkTcTypeToTypeX env ty - ; (env', pats') <- zonkPats env pats - ; return (env', ListPat ty' pats') } - -zonk_pat env (TuplePat tys pats boxed) - = do { tys' <- mapM (zonkTcTypeToTypeX env) tys - ; (env', pats') <- zonkPats env pats - ; return (env', TuplePat tys' pats' boxed) } - -zonk_pat env (SumPat tys pat alt arity ) - = do { tys' <- mapM (zonkTcTypeToTypeX env) tys - ; (env', pat') <- zonkPat env pat - ; return (env', SumPat tys' pat' alt arity) } - -zonk_pat env p@(ConPat { pat_args = args - , pat_con_ext = p'@(ConPatTc - { cpt_tvs = tyvars - , cpt_dicts = evs - , cpt_binds = binds - , cpt_wrap = wrapper - , cpt_arg_tys = tys - }) - }) - = assert (all isImmutableTyVar tyvars) $ - do { new_tys <- mapM (zonkTcTypeToTypeX env) tys - ; (env0, new_tyvars) <- zonkTyBndrsX env tyvars - -- Must zonk the existential variables, because their - -- /kind/ need potential zonking. - -- cf typecheck/should_compile/tc221.hs - ; (env1, new_evs) <- zonkEvBndrsX env0 evs - ; (env2, new_binds) <- zonkTcEvBinds env1 binds - ; (env3, new_wrapper) <- zonkCoFn env2 wrapper - ; (env', new_args) <- zonkConStuff env3 args - ; pure ( env' - , p - { pat_args = new_args - , pat_con_ext = p' - { cpt_arg_tys = new_tys - , cpt_tvs = new_tyvars - , cpt_dicts = new_evs - , cpt_binds = new_binds - , cpt_wrap = new_wrapper - } - } - ) - } - -zonk_pat env (LitPat x lit) = return (env, LitPat x lit) - -zonk_pat env (SigPat ty pat hs_ty) - = do { ty' <- zonkTcTypeToTypeX env ty - ; (env', pat') <- zonkPat env pat - ; return (env', SigPat ty' pat' hs_ty) } - -zonk_pat env (NPat ty (L l lit) mb_neg eq_expr) - = do { (env1, eq_expr') <- zonkSyntaxExpr env eq_expr - ; (env2, mb_neg') <- case mb_neg of - Nothing -> return (env1, Nothing) - Just n -> second Just <$> zonkSyntaxExpr env1 n - - ; lit' <- zonkOverLit env2 lit - ; ty' <- zonkTcTypeToTypeX env2 ty - ; return (env2, NPat ty' (L l lit') mb_neg' eq_expr') } - -zonk_pat env (NPlusKPat ty (L loc n) (L l lit1) lit2 e1 e2) - = do { (env1, e1') <- zonkSyntaxExpr env e1 - ; (env2, e2') <- zonkSyntaxExpr env1 e2 - ; n' <- zonkIdBndr env2 n - ; lit1' <- zonkOverLit env2 lit1 - ; lit2' <- zonkOverLit env2 lit2 - ; ty' <- zonkTcTypeToTypeX env2 ty - ; return (extendIdZonkEnv env2 n', - NPlusKPat ty' (L loc n') (L l lit1') lit2' e1' e2') } -zonk_pat env (XPat ext) = case ext of - { ExpansionPat orig pat-> - do { (env, pat') <- zonk_pat env pat - ; return $ (env, XPat $ ExpansionPat orig pat') } - ; CoPat co_fn pat ty -> - do { (env', co_fn') <- zonkCoFn env co_fn - ; (env'', pat') <- zonkPat env' (noLocA pat) - ; ty' <- zonkTcTypeToTypeX env'' ty - ; return (env'', XPat $ CoPat co_fn' (unLoc pat') ty') - }} - -zonk_pat _ pat = pprPanic "zonk_pat" (ppr pat) - ---------------------------- -zonkConStuff :: ZonkEnv -> HsConPatDetails GhcTc - -> TcM (ZonkEnv, HsConPatDetails GhcTc) -zonkConStuff env (PrefixCon tyargs pats) - = do { (env', pats') <- zonkPats env pats - ; return (env', PrefixCon tyargs pats') } - -zonkConStuff env (InfixCon p1 p2) - = do { (env1, p1') <- zonkPat env p1 - ; (env', p2') <- zonkPat env1 p2 - ; return (env', InfixCon p1' p2') } - -zonkConStuff env (RecCon (HsRecFields rpats dd)) - = do { (env', pats') <- zonkPats env (map (hfbRHS . unLoc) rpats) - ; let rpats' = zipWith (\(L l rp) p' -> - L l (rp { hfbRHS = p' })) - rpats pats' - ; return (env', RecCon (HsRecFields rpats' dd)) } - -- Field selectors have declared types; hence no zonking - ---------------------------- -zonkPats :: ZonkEnv -> [LPat GhcTc] -> TcM (ZonkEnv, [LPat GhcTc]) -zonkPats env [] = return (env, []) -zonkPats env (pat:pats) = do { (env1, pat') <- zonkPat env pat - ; (env', pats') <- zonkPats env1 pats - ; return (env', pat':pats') } - -{- -************************************************************************ -* * -\subsection[BackSubst-Foreign]{Foreign exports} -* * -************************************************************************ --} - -zonkForeignExports :: ZonkEnv -> [LForeignDecl GhcTc] - -> TcM [LForeignDecl GhcTc] -zonkForeignExports env ls = mapM (wrapLocMA (zonkForeignExport env)) ls - -zonkForeignExport :: ZonkEnv -> ForeignDecl GhcTc -> TcM (ForeignDecl GhcTc) -zonkForeignExport env (ForeignExport { fd_name = i, fd_e_ext = co - , fd_fe = spec }) - = return (ForeignExport { fd_name = zonkLIdOcc env i - , fd_sig_ty = undefined, fd_e_ext = co - , fd_fe = spec }) -zonkForeignExport _ for_imp - = return for_imp -- Foreign imports don't need zonking - -zonkRules :: ZonkEnv -> [LRuleDecl GhcTc] -> TcM [LRuleDecl GhcTc] -zonkRules env rs = mapM (wrapLocMA (zonkRule env)) rs - -zonkRule :: ZonkEnv -> RuleDecl GhcTc -> TcM (RuleDecl GhcTc) -zonkRule env rule@(HsRule { rd_tmvs = tm_bndrs{-::[RuleBndr TcId]-} - , rd_lhs = lhs - , rd_rhs = rhs }) - = do { (env_inside, new_tm_bndrs) <- mapAccumLM zonk_tm_bndr env tm_bndrs - - ; let env_lhs = setZonkType env_inside SkolemiseFlexi - -- See Note [Zonking the LHS of a RULE] - - ; new_lhs <- zonkLExpr env_lhs lhs - ; new_rhs <- zonkLExpr env_inside rhs - - ; return $ rule { rd_tmvs = new_tm_bndrs - , rd_lhs = new_lhs - , rd_rhs = new_rhs } } - where - zonk_tm_bndr :: ZonkEnv -> LRuleBndr GhcTc -> TcM (ZonkEnv, LRuleBndr GhcTc) - zonk_tm_bndr env (L l (RuleBndr x (L loc v))) - = do { (env', v') <- zonk_it env v - ; return (env', L l (RuleBndr x (L loc v'))) } - zonk_tm_bndr _ (L _ (RuleBndrSig {})) = panic "zonk_tm_bndr RuleBndrSig" - - zonk_it env v - | isId v = do { v' <- zonkIdBndr env v - ; return (extendIdZonkEnvRec env [v'], v') } - | otherwise = assert (isImmutableTyVar v) - zonkTyBndrX env v - -- DV: used to be return (env,v) but that is plain - -- wrong because we may need to go inside the kind - -- of v and zonk there! - -{- -************************************************************************ -* * - Constraints and evidence -* * -************************************************************************ --} - -zonkEvTerm :: ZonkEnv -> EvTerm -> TcM EvTerm -zonkEvTerm env (EvExpr e) - = EvExpr <$> zonkCoreExpr env e -zonkEvTerm env (EvTypeable ty ev) - = EvTypeable <$> zonkTcTypeToTypeX env ty <*> zonkEvTypeable env ev -zonkEvTerm env (EvFun { et_tvs = tvs, et_given = evs - , et_binds = ev_binds, et_body = body_id }) - = do { (env0, new_tvs) <- zonkTyBndrsX env tvs - ; (env1, new_evs) <- zonkEvBndrsX env0 evs - ; (env2, new_ev_binds) <- zonkTcEvBinds env1 ev_binds - ; let new_body_id = zonkIdOcc env2 body_id - ; return (EvFun { et_tvs = new_tvs, et_given = new_evs - , et_binds = new_ev_binds, et_body = new_body_id }) } - -zonkCoreExpr :: ZonkEnv -> CoreExpr -> TcM CoreExpr -zonkCoreExpr env (Var v) - | isCoVar v - = Coercion <$> zonkCoVarOcc env v - | otherwise - = return (Var $ zonkIdOcc env v) -zonkCoreExpr _ (Lit l) - = return $ Lit l -zonkCoreExpr env (Coercion co) - = Coercion <$> zonkCoToCo env co -zonkCoreExpr env (Type ty) - = Type <$> zonkTcTypeToTypeX env ty - -zonkCoreExpr env (Cast e co) - = Cast <$> zonkCoreExpr env e <*> zonkCoToCo env co -zonkCoreExpr env (Tick t e) - = Tick t <$> zonkCoreExpr env e -- Do we need to zonk in ticks? - -zonkCoreExpr env (App e1 e2) - = App <$> zonkCoreExpr env e1 <*> zonkCoreExpr env e2 -zonkCoreExpr env (Lam v e) - = do { (env1, v') <- zonkCoreBndrX env v - ; Lam v' <$> zonkCoreExpr env1 e } -zonkCoreExpr env (Let bind e) - = do (env1, bind') <- zonkCoreBind env bind - Let bind'<$> zonkCoreExpr env1 e -zonkCoreExpr env (Case scrut b ty alts) - = do scrut' <- zonkCoreExpr env scrut - ty' <- zonkTcTypeToTypeX env ty - b' <- zonkIdBndr env b - let env1 = extendIdZonkEnv env b' - alts' <- mapM (zonkCoreAlt env1) alts - return $ Case scrut' b' ty' alts' - -zonkCoreAlt :: ZonkEnv -> CoreAlt -> TcM CoreAlt -zonkCoreAlt env (Alt dc bndrs rhs) - = do (env1, bndrs') <- zonkCoreBndrsX env bndrs - rhs' <- zonkCoreExpr env1 rhs - return $ Alt dc bndrs' rhs' - -zonkCoreBind :: ZonkEnv -> CoreBind -> TcM (ZonkEnv, CoreBind) -zonkCoreBind env (NonRec v e) - = do v' <- zonkIdBndr env v - e' <- zonkCoreExpr env e - let env1 = extendIdZonkEnv env v' - return (env1, NonRec v' e') -zonkCoreBind env (Rec pairs) - = do (env1, pairs') <- fixM go - return (env1, Rec pairs') - where - go ~(_, new_pairs) = do - let env1 = extendIdZonkEnvRec env (map fst new_pairs) - pairs' <- mapM (zonkCorePair env1) pairs - return (env1, pairs') - -zonkCorePair :: ZonkEnv -> (CoreBndr, CoreExpr) -> TcM (CoreBndr, CoreExpr) -zonkCorePair env (v,e) = (,) <$> zonkIdBndr env v <*> zonkCoreExpr env e - -zonkEvTypeable :: ZonkEnv -> EvTypeable -> TcM EvTypeable -zonkEvTypeable env (EvTypeableTyCon tycon e) - = do { e' <- mapM (zonkEvTerm env) e - ; return $ EvTypeableTyCon tycon e' } -zonkEvTypeable env (EvTypeableTyApp t1 t2) - = do { t1' <- zonkEvTerm env t1 - ; t2' <- zonkEvTerm env t2 - ; return (EvTypeableTyApp t1' t2') } -zonkEvTypeable env (EvTypeableTrFun tm t1 t2) - = do { tm' <- zonkEvTerm env tm - ; t1' <- zonkEvTerm env t1 - ; t2' <- zonkEvTerm env t2 - ; return (EvTypeableTrFun tm' t1' t2') } -zonkEvTypeable env (EvTypeableTyLit t1) - = do { t1' <- zonkEvTerm env t1 - ; return (EvTypeableTyLit t1') } - -zonkTcEvBinds_s :: ZonkEnv -> [TcEvBinds] -> TcM (ZonkEnv, [TcEvBinds]) -zonkTcEvBinds_s env bs = do { (env, bs') <- mapAccumLM zonk_tc_ev_binds env bs - ; return (env, [EvBinds (unionManyBags bs')]) } - -zonkTcEvBinds :: ZonkEnv -> TcEvBinds -> TcM (ZonkEnv, TcEvBinds) -zonkTcEvBinds env bs = do { (env', bs') <- zonk_tc_ev_binds env bs - ; return (env', EvBinds bs') } - -zonk_tc_ev_binds :: ZonkEnv -> TcEvBinds -> TcM (ZonkEnv, Bag EvBind) -zonk_tc_ev_binds env (TcEvBinds var) = zonkEvBindsVar env var -zonk_tc_ev_binds env (EvBinds bs) = zonkEvBinds env bs - -zonkEvBindsVar :: ZonkEnv -> EvBindsVar -> TcM (ZonkEnv, Bag EvBind) -zonkEvBindsVar env (EvBindsVar { ebv_binds = ref }) - = do { bs <- readMutVar ref - ; zonkEvBinds env (evBindMapBinds bs) } -zonkEvBindsVar env (CoEvBindsVar {}) = return (env, emptyBag) - -zonkEvBinds :: ZonkEnv -> Bag EvBind -> TcM (ZonkEnv, Bag EvBind) -zonkEvBinds env binds - = {-# SCC "zonkEvBinds" #-} - fixM (\ ~( _, new_binds) -> do - { let env1 = extendIdZonkEnvRec env (collect_ev_bndrs new_binds) - ; binds' <- mapBagM (zonkEvBind env1) binds - ; return (env1, binds') }) - where - collect_ev_bndrs :: Bag EvBind -> [EvVar] - collect_ev_bndrs = foldr add [] - add (EvBind { eb_lhs = var }) vars = var : vars - -zonkEvBind :: ZonkEnv -> EvBind -> TcM EvBind -zonkEvBind env bind@(EvBind { eb_lhs = var, eb_rhs = term }) - = do { var' <- {-# SCC "zonkEvBndr" #-} zonkEvBndr env var - - -- Optimise the common case of Refl coercions - -- See Note [Optimise coercion zonking] - -- This has a very big effect on some programs (eg #5030) - - ; term' <- case getEqPredTys_maybe (idType var') of - Just (r, ty1, ty2) | ty1 `eqType` ty2 - -> return (evCoercion (mkReflCo r ty1)) - _other -> zonkEvTerm env term - - ; return (bind { eb_lhs = var', eb_rhs = term' }) } - -{- Note [Optimise coercion zonking] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When optimising evidence binds we may come across situations where -a coercion looks like - cv = ReflCo ty -or cv1 = cv2 -where the type 'ty' is big. In such cases it is a waste of time to zonk both - * The variable on the LHS - * The coercion on the RHS -Rather, we can zonk the variable, and if its type is (ty ~ ty), we can just -use Refl on the right, ignoring the actual coercion on the RHS. - -This can have a very big effect, because the constraint solver sometimes does go -to a lot of effort to prove Refl! (Eg when solving 10+3 = 10+3; cf #5030) - - -************************************************************************ -* * - Zonking types -* * -************************************************************************ --} - -{- Note [Sharing when zonking to Type] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Problem: - - In GHC.Tc.Utils.TcMType.zonkTcTyVar, we short-circuit (Indirect ty) to - (Indirect zty), see Note [Sharing in zonking] in GHC.Tc.Utils.TcMType. But we - /can't/ do this when zonking a TcType to a Type (#15552, esp - comment:3). Suppose we have - - alpha -> alpha - where - alpha is already unified: - alpha := T{tc-tycon} Int -> Int - and T is knot-tied - - By "knot-tied" I mean that the occurrence of T is currently a TcTyCon, - but the global env contains a mapping "T" :-> T{knot-tied-tc}. See - Note [Type checking recursive type and class declarations] in - GHC.Tc.TyCl. - - Now we call zonkTcTypeToType on that (alpha -> alpha). If we follow - the same path as Note [Sharing in zonking] in GHC.Tc.Utils.TcMType, we'll - update alpha to - alpha := T{knot-tied-tc} Int -> Int - - But alas, if we encounter alpha for a /second/ time, we end up - looking at T{knot-tied-tc} and fall into a black hole. The whole - point of zonkTcTypeToType is that it produces a type full of - knot-tied tycons, and you must not look at the result!! - - To put it another way (zonkTcTypeToType . zonkTcTypeToType) is not - the same as zonkTcTypeToType. (If we distinguished TcType from - Type, this issue would have been a type error!) - -Solutions: (see #15552 for other variants) - -One possible solution is simply not to do the short-circuiting. -That has less sharing, but maybe sharing is rare. And indeed, -that usually turns out to be viable from a perf point of view - -But zonkTyVarOcc implements something a bit better - -* ZonkEnv contains ze_meta_tv_env, which maps - from a MetaTyVar (unification variable) - to a Type (not a TcType) - -* In zonkTyVarOcc, we check this map to see if we have zonked - this variable before. If so, use the previous answer; if not - zonk it, and extend the map. - -* The map is of course stateful, held in a TcRef. (That is unlike - the treatment of lexically-scoped variables in ze_tv_env and - ze_id_env.) - -* In zonkTyVarOcc we read the TcRef to look up the unification - variable: - - if we get a hit we use the zonked result; - - if not, in zonk_meta we see if the variable is `Indirect ty`, - zonk that, and update the map (in finish_meta) - But Nota Bene that the "update map" step must re-read the TcRef - (or, more precisely, use updTcRef) because the zonking of the - `Indirect ty` may have added lots of stuff to the map. See - #19668 for an example where this made an asymptotic difference! - -Is it worth the extra work of carrying ze_meta_tv_env? Some -non-systematic perf measurements suggest that compiler allocation is -reduced overall (by 0.5% or so) but compile time really doesn't -change. But in some cases it makes a HUGE difference: see test -T9198 and #19668. So yes, it seems worth it. --} - -zonkTyVarOcc :: HasDebugCallStack => ZonkEnv -> TcTyVar -> TcM Type -zonkTyVarOcc env@(ZonkEnv { ze_flexi = flexi - , ze_tv_env = tv_env - , ze_meta_tv_env = mtv_env_ref }) tv - | isTcTyVar tv - = case tcTyVarDetails tv of - SkolemTv {} -> lookup_in_tv_env - RuntimeUnk {} -> lookup_in_tv_env - MetaTv { mtv_ref = ref } - -> do { mtv_env <- readTcRef mtv_env_ref - -- See Note [Sharing when zonking to Type] - ; case lookupVarEnv mtv_env tv of - Just ty -> return ty - Nothing -> do { mtv_details <- readTcRef ref - ; zonk_meta ref mtv_details } } - | otherwise -- This should never really happen; - -- TyVars should not occur in the typechecker - = lookup_in_tv_env - - where - lookup_in_tv_env -- Look up in the env just as we do for Ids - = case lookupVarEnv tv_env tv of - Nothing -> -- TyVar/SkolemTv/RuntimeUnk that isn't in the ZonkEnv - -- This can happen for RuntimeUnk variables (which - -- should stay as RuntimeUnk), but I think it should - -- not happen for SkolemTv. - mkTyVarTy <$> updateTyVarKindM (zonkTcTypeToTypeX env) tv - - Just tv' -> return (mkTyVarTy tv') - - zonk_meta ref Flexi - = do { kind <- zonkTcTypeToTypeX env (tyVarKind tv) - ; ty <- commitFlexi flexi tv kind - ; writeMetaTyVarRef tv ref ty -- Belt and braces - ; finish_meta ty } - - zonk_meta _ (Indirect ty) - = do { zty <- zonkTcTypeToTypeX env ty - ; finish_meta zty } - - finish_meta ty - = do { updTcRef mtv_env_ref (\env -> extendVarEnv env tv ty) - ; return ty } - -lookupTyVarX :: ZonkEnv -> TcTyVar -> TyVar -lookupTyVarX (ZonkEnv { ze_tv_env = tv_env }) tv - = case lookupVarEnv tv_env tv of - Just tv -> tv - Nothing -> pprPanic "lookupTyVarOcc" (ppr tv $$ ppr tv_env) - -commitFlexi :: ZonkFlexi -> TcTyVar -> Kind -> TcM Type --- Only monadic so we can do tc-tracing -commitFlexi flexi tv zonked_kind - = case flexi of - SkolemiseFlexi -> return (mkTyVarTy (mkTyVar name zonked_kind)) - - DefaultFlexi - -- Normally, RuntimeRep variables are defaulted in TcMType.defaultTyVar - -- But that sees only type variables that appear in, say, an inferred type - -- Defaulting here in the zonker is needed to catch e.g. - -- y :: Bool - -- y = (\x -> True) undefined - -- We need *some* known RuntimeRep for the x and undefined, but no one - -- will choose it until we get here, in the zonker. - | isRuntimeRepTy zonked_kind - -> do { traceTc "Defaulting flexi tyvar to LiftedRep:" (pprTyVar tv) - ; return liftedRepTy } - | isLevityTy zonked_kind - -> do { traceTc "Defaulting flexi tyvar to Lifted:" (pprTyVar tv) - ; return liftedDataConTy } - | isMultiplicityTy zonked_kind - -> do { traceTc "Defaulting flexi tyvar to Many:" (pprTyVar tv) - ; return manyDataConTy } - | Just (ConcreteFRR origin) <- isConcreteTyVar_maybe tv - -> do { addErr $ TcRnCannotDefaultConcrete origin - ; return (anyTypeOfKind zonked_kind) } - | otherwise - -> do { traceTc "Defaulting flexi tyvar to Any:" (pprTyVar tv) - ; return (anyTypeOfKind zonked_kind) } - - RuntimeUnkFlexi - -> do { traceTc "Defaulting flexi tyvar to RuntimeUnk:" (pprTyVar tv) - ; return (mkTyVarTy (mkTcTyVar name zonked_kind RuntimeUnk)) } - -- This is where RuntimeUnks are born: - -- otherwise-unconstrained unification variables are - -- turned into RuntimeUnks as they leave the - -- typechecker's monad - - NoFlexi -> pprPanic "NoFlexi" (ppr tv <+> dcolon <+> ppr zonked_kind) - - where - name = tyVarName tv - -zonkCoVarOcc :: ZonkEnv -> CoVar -> TcM Coercion -zonkCoVarOcc (ZonkEnv { ze_tv_env = tyco_env }) cv - | Just cv' <- lookupVarEnv tyco_env cv -- don't look in the knot-tied env - = return $ mkCoVarCo cv' - | otherwise - = do { cv' <- zonkCoVar cv; return (mkCoVarCo cv') } - -zonkCoHole :: ZonkEnv -> CoercionHole -> TcM Coercion -zonkCoHole env hole@(CoercionHole { ch_ref = ref, ch_co_var = cv }) - = do { contents <- readTcRef ref - ; case contents of - Just co -> do { co' <- zonkCoToCo env co - ; checkCoercionHole cv co' } - - -- This next case should happen only in the presence of - -- (undeferred) type errors. Originally, I put in a panic - -- here, but that caused too many uses of `failIfErrsM`. - Nothing -> do { traceTc "Zonking unfilled coercion hole" (ppr hole) - ; cv' <- zonkCoVar cv - ; return $ mkCoVarCo cv' } } - -- This will be an out-of-scope variable, but keeping - -- this as a coercion hole led to #15787 - -zonk_tycomapper :: TyCoMapper ZonkEnv TcM -zonk_tycomapper = TyCoMapper - { tcm_tyvar = zonkTyVarOcc - , tcm_covar = zonkCoVarOcc - , tcm_hole = zonkCoHole - , tcm_tycobinder = \env tv _vis -> zonkTyBndrX env tv - , tcm_tycon = zonkTcTyConToTyCon } - --- Zonk a TyCon by changing a TcTyCon to a regular TyCon -zonkTcTyConToTyCon :: TcTyCon -> TcM TyCon -zonkTcTyConToTyCon tc - | isTcTyCon tc = do { thing <- tcLookupGlobalOnly (getName tc) - ; case thing of - ATyCon real_tc -> return real_tc - _ -> pprPanic "zonkTcTyCon" (ppr tc $$ ppr thing) } - | otherwise = return tc -- it's already zonked - --- Confused by zonking? See Note [What is zonking?] in GHC.Tc.Utils.TcMType. -zonkTcTypeToType :: TcType -> TcM Type -zonkTcTypeToType ty = initZonkEnv $ \ ze -> zonkTcTypeToTypeX ze ty - -zonkScaledTcTypeToTypeX :: ZonkEnv -> Scaled TcType -> TcM (Scaled TcType) -zonkScaledTcTypeToTypeX env (Scaled m ty) = Scaled <$> zonkTcTypeToTypeX env m - <*> zonkTcTypeToTypeX env ty - -zonkTcTypeToTypeX :: ZonkEnv -> TcType -> TcM Type -zonkTcTypesToTypesX :: ZonkEnv -> [TcType] -> TcM [Type] -zonkCoToCo :: ZonkEnv -> Coercion -> TcM Coercion -(zonkTcTypeToTypeX, zonkTcTypesToTypesX, zonkCoToCo, _) - = mapTyCoX zonk_tycomapper - -zonkScaledTcTypesToTypesX :: ZonkEnv -> [Scaled TcType] -> TcM [Scaled Type] -zonkScaledTcTypesToTypesX env scaled_tys = - mapM (zonkScaledTcTypeToTypeX env) scaled_tys - -zonkTcMethInfoToMethInfoX :: ZonkEnv -> TcMethInfo -> TcM MethInfo -zonkTcMethInfoToMethInfoX ze (name, ty, gdm_spec) - = do { ty' <- zonkTcTypeToTypeX ze ty - ; gdm_spec' <- zonk_gdm gdm_spec - ; return (name, ty', gdm_spec') } - where - zonk_gdm :: Maybe (DefMethSpec (SrcSpan, TcType)) - -> TcM (Maybe (DefMethSpec (SrcSpan, Type))) - zonk_gdm Nothing = return Nothing - zonk_gdm (Just VanillaDM) = return (Just VanillaDM) - zonk_gdm (Just (GenericDM (loc, ty))) - = do { ty' <- zonkTcTypeToTypeX ze ty - ; return (Just (GenericDM (loc, ty'))) } - ---------------------------------------- -{- Note [Zonking the LHS of a RULE] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -See also GHC.HsToCore.Binds Note [Free tyvars on rule LHS] - -We need to gather the type variables mentioned on the LHS so we can -quantify over them. Example: - data T a = C - - foo :: T a -> Int - foo C = 1 - - {-# RULES "myrule" foo C = 1 #-} - -After type checking the LHS becomes (foo alpha (C alpha)) and we do -not want to zap the unbound meta-tyvar 'alpha' to Any, because that -limits the applicability of the rule. Instead, we want to quantify -over it! - -We do this in two stages. - -* During zonking, we skolemise the TcTyVar 'alpha' to TyVar 'a'. We - do this by using zonkTvSkolemising as the UnboundTyVarZonker in the - ZonkEnv. (This is in fact the whole reason that the ZonkEnv has a - UnboundTyVarZonker.) - -* In GHC.HsToCore.Binds, we quantify over it. See GHC.HsToCore.Binds - Note [Free tyvars on rule LHS] - -Quantifying here is awkward because (a) the data type is big and (b) -finding the free type vars of an expression is necessarily monadic -operation. (consider /\a -> f @ b, where b is side-effected to a) --} ===================================== libraries/base/GHC/IO/Handle/Types.hs-boot ===================================== @@ -2,4 +2,7 @@ module GHC.IO.Handle.Types ( Handle ) where +-- See Note [Depend on GHC.Num.Integer] in GHC.Base +import GHC.Types () + data Handle ===================================== testsuite/driver/testlib.py ===================================== @@ -167,7 +167,7 @@ def stage1(name, opts): 'add your test to testsuite/tests/stage1 instead') # Note [Why is there no stage1 setup function?] -# +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # Presumably a stage1 setup function would signal that the stage1 # compiler should be used to compile a test. # ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -265,7 +265,7 @@ ifeq "$(findstring clean,$(MAKECMDGOALS))" "" endif # Note [WayFlags] -# +# ~~~~~~~~~~~~~~~ # Code that uses TemplateHaskell should either use -fexternal-interpreter, or # be built in the same way as the compiler (-prof, -dynamic or -static). # ===================================== testsuite/tests/javascript/T22455.hs ===================================== @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = putStrLn "Hello World" ===================================== testsuite/tests/javascript/T22455.stdout ===================================== @@ -0,0 +1 @@ +Hello World ===================================== testsuite/tests/javascript/all.T ===================================== @@ -17,3 +17,4 @@ test('js-callback04', js_skip, compile_and_run, ['']) test('js-callback05', js_skip, compile_and_run, ['']) test('T23346', normal, compile_and_run, ['']) +test('T22455', normal, compile_and_run, ['-ddisable-js-minifier']) ===================================== testsuite/tests/linters/notes.stdout ===================================== @@ -15,7 +15,6 @@ ref compiler/GHC/Hs/Extension.hs:146:5: Note [Strict argument type constr ref compiler/GHC/Hs/Pat.hs:143:74: Note [Lifecycle of a splice] ref compiler/GHC/HsToCore/Pmc/Solver.hs:858:20: Note [COMPLETE sets on data families] ref compiler/GHC/HsToCore/Quote.hs:1476:7: Note [How brackets and nested splices are handled] -ref compiler/GHC/JS/Optimizer.hs:259:47: Note [Unsafe JavaScript optimizations] ref compiler/GHC/Stg/Unarise.hs:442:32: Note [Renaming during unarisation] ref compiler/GHC/StgToCmm.hs:106:18: Note [codegen-split-init] ref compiler/GHC/StgToCmm.hs:109:18: Note [pipeline-split-init] @@ -31,12 +30,8 @@ ref compiler/GHC/Tc/Gen/Splice.hs:531:35: Note [PendingRnSplice] ref compiler/GHC/Tc/Gen/Splice.hs:655:7: Note [How brackets and nested splices are handled] ref compiler/GHC/Tc/Gen/Splice.hs:888:11: Note [How brackets and nested splices are handled] ref compiler/GHC/Tc/Instance/Family.hs:474:35: Note [Constrained family instances] -ref compiler/GHC/Tc/Module.hs:711:15: Note [Extra dependencies from .hs-boot files] ref compiler/GHC/Tc/Solver/Rewrite.hs:1009:7: Note [Stability of rewriting] ref compiler/GHC/Tc/TyCl.hs:1130:6: Note [Unification variables need fresh Names] -ref compiler/GHC/Tc/TyCl.hs:4982:17: Note [Missing role annotations warning] -ref compiler/GHC/Tc/TyCl.hs:5008:3: Note [Missing role annotations warning] -ref compiler/GHC/Tc/Types.hs:692:33: Note [Extra dependencies from .hs-boot files] ref compiler/GHC/Tc/Types/Constraint.hs:226:34: Note [NonCanonical Semantics] ref compiler/GHC/Types/Demand.hs:302:25: Note [Preserving Boxity of results is rarely a win] ref compiler/GHC/Unit/Module/Deps.hs:81:13: Note [Structure of dep_boot_mods] @@ -47,10 +42,6 @@ ref docs/core-spec/core-spec.mng:177:6: Note [TyBinders] ref hadrian/src/Expression.hs:145:30: Note [Linking ghc-bin against threaded stage0 RTS] ref linters/lint-notes/Notes.hs:32:29: Note [" <> T.unpack x <> "] ref linters/lint-notes/Notes.hs:69:22: Note [...] -ref testsuite/config/ghc:276:10: Note [WayFlags] -ref testsuite/driver/testlib.py:165:10: Note [Why is there no stage1 setup function?] -ref testsuite/driver/testlib.py:169:2: Note [Why is there no stage1 setup function?] -ref testsuite/mk/boilerplate.mk:267:2: Note [WayFlags] ref testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.hs:30:27: Note [Extra TcS Untouchables] ref testsuite/tests/perf/should_run/all.T:8:6: Note [Solving from instances when interacting Dicts] ref testsuite/tests/polykinds/CuskFam.hs:16:11: Note [Unifying implicit CUSK variables] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2e5ed7e90d4dcf069d42c6f8a0a46e0167570ff3...9b465f325220bd7e9415461309911a3d58932901 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2e5ed7e90d4dcf069d42c6f8a0a46e0167570ff3...9b465f325220bd7e9415461309911a3d58932901 You're receiving 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 Jun 3 01:03:23 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 02 Jun 2023 21:03:23 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: base: Add build-order import of GHC.Types in GHC.IO.Handle.Types Message-ID: <647a915ba0775_179783115a76a02151e7@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: c544c735 by Ben Gamari at 2023-06-02T21:03:12-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f442f113 by Sylvain Henry at 2023-06-02T21:03:15-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - 12 changed files: - compiler/GHC/JS/Make.hs - compiler/GHC/JS/Ppr.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Closure.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Linker/Opt.hs - compiler/GHC/StgToJS/Rts/Rts.hs - libraries/base/GHC/IO/Handle/Types.hs-boot - + testsuite/tests/javascript/T22455.hs - + testsuite/tests/javascript/T22455.stdout - testsuite/tests/javascript/all.T Changes: ===================================== compiler/GHC/JS/Make.hs ===================================== @@ -83,7 +83,7 @@ module GHC.JS.Make -- $intro_funcs , var , jString - , jLam, jFunction, jVar, jFor, jForNoDecl, jForIn, jForEachIn, jTryCatchFinally + , jLam, jFun, jFunction, jVar, jFor, jForNoDecl, jForIn, jForEachIn, jTryCatchFinally -- * Combinators -- $combinators , (||=), (|=), (.==.), (.===.), (.!=.), (.!==.), (.!) @@ -249,6 +249,15 @@ jLam f = ValExpr . UnsatVal . IS $ do (block,is) <- runIdentSupply $ toSat_ f [] return $ JFunc is block +-- | Create a new function. The result is a 'GHC.JS.Syntax.JStat'. +-- Usage: +-- +-- > jFun fun_name $ \x -> ... +jFun :: ToSat a => Ident -> a -> JStat +jFun n f = UnsatBlock . IS $ do + (block,is) <- runIdentSupply $ toSat_ f [] + return $ FuncStat n is block + -- | Introduce a new variable into scope for the duration -- of the enclosed expression. The result is a block statement. -- Usage: ===================================== compiler/GHC/JS/Ppr.hs ===================================== @@ -60,7 +60,6 @@ module GHC.JS.Ppr , jsToDoc , pprStringLit , interSemi - , addSemi , braceNest , hangBrace ) @@ -138,15 +137,25 @@ instance JsToDoc [JStat] where jsToDocR r = jcat . map (addSemi . jsToDocR r) defRenderJsS :: JsRender doc => RenderJs doc -> JStat -> doc defRenderJsS r = \case - IfStat cond x y -> hangBrace (text "if" <+?> parens (jsToDocR r cond)) - (jnest $ optBlock r x) - <+?> mbElse + IfStat cond x y -> jcat + [ hangBrace (text "if" <+?> parens (jsToDocR r cond)) (optBlock r x) + , mbElse + ] where mbElse | y == BlockStat [] = empty - | otherwise = hangBrace (text "else") (jnest $ optBlock r y) + | otherwise = hangBrace (text "else") (optBlock r y) DeclStat x Nothing -> text "var" <+> jsToDocR r x + -- special treatment for functions, otherwise there is too much left padding + -- (more than the length of the expression assigned to). E.g. + -- + -- var long_variable_name = (function() + -- { + -- ... + -- }); + -- + DeclStat x (Just (ValExpr f@(JFunc {}))) -> jhang (text "var" <+> jsToDocR r x <+?> char '=') (jsToDocR r f) DeclStat x (Just e) -> text "var" <+> jsToDocR r x <+?> char '=' <+?> jsToDocR r e - WhileStat False p b -> hangBrace (text "while" <+?> parens (jsToDocR r p)) (jnest $ optBlock r b) - WhileStat True p b -> hangBrace (text "do") (jnest $ optBlock r b) <+?> text "while" <+?> parens (jsToDocR r p) + WhileStat False p b -> hangBrace (text "while" <+?> parens (jsToDocR r p)) (optBlock r b) + WhileStat True p b -> hangBrace (text "do") (optBlock r b) <+?> text "while" <+?> parens (jsToDocR r p) BreakStat l -> addSemi $ maybe (text "break") (\(LexicalFastString s) -> (text "break" <+> ftext s)) l ContinueStat l -> addSemi $ maybe (text "continue") (\(LexicalFastString s) -> (text "continue" <+> ftext s)) l LabelStat (LexicalFastString l) s -> ftext l <> char ':' $$$ printBS s @@ -154,10 +163,10 @@ defRenderJsS r = \case printBS (BlockStat ss) = interSemi $ map (jsToDocR r) ss printBS x = jsToDocR r x - ForStat init p s1 sb -> hangBrace (text "for" <+?> parens forCond) (jnest $ optBlock r sb) + ForStat init p s1 sb -> hangBrace (text "for" <+?> parens forCond) (optBlock r sb) where forCond = jsToDocR r init <> semi <+?> jsToDocR r p <> semi <+?> parens (jsToDocR r s1) - ForInStat each i e b -> hangBrace (text txt <+?> parens (jsToDocR r i <+> text "in" <+> jsToDocR r e)) (jnest $ optBlock r b) + ForInStat each i e b -> hangBrace (text txt <+?> parens (jsToDocR r i <+> text "in" <+> jsToDocR r e)) (optBlock r b) where txt | each = "for each" | otherwise = "for" SwitchStat e l d -> hangBrace (text "switch" <+?> parens (jsToDocR r e)) cases @@ -168,33 +177,35 @@ defRenderJsS r = \case ApplStat e es -> jsToDocR r e <> (parens . foldl' (<+?>) empty . punctuate comma $ map (jsToDocR r) es) FuncStat i is b -> hangBrace (text "function" <+> jsToDocR r i <> parens (foldl' (<+?>) empty . punctuate comma . map (jsToDocR r) $ is)) - (jnest $ optBlock r b) + (optBlock r b) TryStat s i s1 s2 -> hangBrace (text "try") (jsToDocR r s) <+?> mbCatch <+?> mbFinally where mbCatch | s1 == BlockStat [] = empty - | otherwise = hangBrace (text "catch" <+?> parens (jsToDocR r i)) (jnest $ optBlock r s1) + | otherwise = hangBrace (text "catch" <+?> parens (jsToDocR r i)) (optBlock r s1) mbFinally | s2 == BlockStat [] = empty - | otherwise = hangBrace (text "finally") (jnest $ optBlock r s2) + | otherwise = hangBrace (text "finally") (optBlock r s2) AssignStat i op x -> case x of -- special treatment for functions, otherwise there is too much left padding -- (more than the length of the expression assigned to). E.g. -- - -- var long_variable_name = (function() + -- long_variable_name = (function() -- { -- ... -- }); -- - ValExpr (JFunc is b) -> jsToDocR r i <> ftext (aOpText op) <> text " function" <> parens (foldl' (<+?>) empty . punctuate comma . map (jsToDocR r) $ is) <> braceNest (jsToDocR r b) - _ -> jsToDocR r i <+?> ftext (aOpText op) <+?> jsToDocR r x + ValExpr f@(JFunc {}) -> jhang (jsToDocR r i <> ftext (aOpText op)) (jsToDocR r f) + _ -> jsToDocR r i <+?> ftext (aOpText op) <+?> jsToDocR r x UOpStat op x | isPre op && isAlphaOp op -> ftext (uOpText op) <+> optParens r x | isPre op -> ftext (uOpText op) <+> optParens r x | otherwise -> optParens r x <+> ftext (uOpText op) BlockStat xs -> jsToDocR r xs +-- | Remove one Block layering if we know we already have braces around the +-- statement optBlock :: JsRender doc => RenderJs doc -> JStat -> doc optBlock r x = case x of BlockStat{} -> jsToDocR r x - _ -> addSemi $ jsToDocR r x + _ -> addSemi (jsToDocR r x) optParens :: JsRender doc => RenderJs doc -> JExpr -> doc optParens r x = case x of @@ -338,9 +349,6 @@ encodeJsonChar = \case interSemi :: JsRender doc => [doc] -> doc interSemi = foldl ($$$) empty . punctuateFinal semi semi -addSemi :: IsLine doc => doc -> doc -addSemi x = x <> semi <> char '\n' - -- | The structure `{body}`, optionally indented over multiple lines {-# INLINE braceNest #-} braceNest :: JsRender doc => doc -> doc @@ -349,7 +357,11 @@ braceNest x = lbrace $$$ jnest x $$$ rbrace -- | The structure `hdr {body}`, optionally indented over multiple lines {-# INLINE hangBrace #-} hangBrace :: JsRender doc => doc -> doc -> doc -hangBrace hdr body = hdr <+?> braceNest body +hangBrace hdr body = jcat [ hdr <> char ' ' <> char '{', jnest body, char '}' ] + +{-# INLINE jhang #-} +jhang :: JsRender doc => doc -> doc -> doc +jhang hdr body = jcat [ hdr, jnest body] -- | JsRender controls the differences in whitespace between HLine and SDoc. -- Generally, this involves the indentation and newlines in the human-readable @@ -365,16 +377,21 @@ class IsLine doc => JsRender doc where jcat :: [doc] -> doc -- | Optionally indent the following jnest :: doc -> doc + -- | Append semi-colon (and line-break in HLine mode) + addSemi :: doc -> doc instance JsRender SDoc where (<+?>) = (<+>) {-# INLINE (<+?>) #-} - ($$$) = ($$) + ($$$) = ($+$) {-# INLINE ($$$) #-} jcat = vcat {-# INLINE jcat #-} jnest = nest 2 {-# INLINE jnest #-} + addSemi x = x <> semi + {-# INLINE addSemi #-} + instance JsRender HLine where (<+?>) = (<>) @@ -385,3 +402,6 @@ instance JsRender HLine where {-# INLINE jcat #-} jnest = id {-# INLINE jnest #-} + addSemi x = x <> semi <> char '\n' + -- we add a line-break to avoid issues with lines too long in minified outputs + {-# INLINE addSemi #-} ===================================== compiler/GHC/StgToJS/Apply.hs ===================================== @@ -590,7 +590,7 @@ genericStackApply cfg = closure info body -- genericFastApply :: StgToJSConfig -> JStat genericFastApply s = - TxtI "h$ap_gen_fast" ||= jLam \tag -> jVar \c -> + jFun (TxtI "h$ap_gen_fast") \tag -> jVar \c -> [traceRts s (jString "h$ap_gen_fast: " + tag) , c |= closureEntry r1 , SwitchStat (entryClosureType c) @@ -802,12 +802,12 @@ stackApply s fun_name nargs nvars = -- h$ap_n_r_fast is entered if a function of unknown arity is called, n -- arguments are already in r registers fastApply :: StgToJSConfig -> FastString -> Int -> Int -> JStat -fastApply s fun_name nargs nvars = func ||= body0 +fastApply s fun_name nargs nvars = body0 where -- special case for h$ap_0_0_fast body0 = if nargs == 0 && nvars == 0 - then jLam (enter s r1) - else toJExpr (JFunc myFunArgs body) + then jFun func (enter s r1) + else FuncStat func myFunArgs body func = TxtI fun_name @@ -875,7 +875,7 @@ fastApply s fun_name nargs nvars = func ||= body0 zeroApply :: StgToJSConfig -> JStat zeroApply s = mconcat - [ TxtI "h$e" ||= jLam (\c -> (r1 |= c) <> enter s c) + [ jFun (TxtI "h$e") (\c -> (r1 |= c) <> enter s c) ] -- carefully enter a closure that might be a thunk or a function @@ -973,13 +973,13 @@ selectors s = mkSel :: FastString -> (JExpr -> JExpr) -> JStat mkSel name sel = mconcat - [TxtI createName ||= jLam \r -> mconcat + [jFun (TxtI createName) \r -> mconcat [ traceRts s (toJExpr ("selector create: " <> name <> " for ") + (r .^ "alloc")) , ifS (isThunk r .||. isBlackhole r) (returnS (app "h$mkSelThunk" [r, toJExpr (v entryName), toJExpr (v resName)])) (returnS (sel r)) ] - , TxtI resName ||= jLam \r -> mconcat + , jFun (TxtI resName) \r -> mconcat [ traceRts s (toJExpr ("selector result: " <> name <> " for ") + (r .^ "alloc")) , returnS (sel r) ] @@ -1106,7 +1106,7 @@ papGen cfg = -- general utilities -- move the first n registers, starting at R2, m places up (do not use with negative m) moveRegs2 :: JStat -moveRegs2 = TxtI "h$moveRegs2" ||= jLam moveSwitch +moveRegs2 = jFun (TxtI "h$moveRegs2") moveSwitch where moveSwitch n m = SwitchStat ((n .<<. 8) .|. m) switchCases (defaultCase n m) -- fast cases ===================================== compiler/GHC/StgToJS/Closure.hs ===================================== @@ -116,7 +116,7 @@ setObjInfo debug obj t name fields a size regs static closure :: ClosureInfo -- ^ object being info'd see @ciVar@ in @ClosureInfo@ -> JStat -- ^ rhs -> JStat -closure ci body = (ciVar ci ||= jLam body) `mappend` closureInfoStat False ci +closure ci body = (jFun (ciVar ci) body) `mappend` closureInfoStat False ci conClosure :: Ident -> FastString -> CILayout -> Int -> JStat conClosure symbol name layout constr = ===================================== compiler/GHC/StgToJS/CodeGen.hs ===================================== @@ -366,4 +366,4 @@ genToplevelRhs i rhs = case rhs of sr) ccId <- costCentreStackLbl cc emitStatic idt static ccId - return $ (eid ||= toJExpr (JFunc [] (ll <> upd <> setcc <> body))) + return $ (FuncStat eid [] (ll <> upd <> setcc <> body)) ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -198,12 +198,7 @@ link lc_cfg cfg logger unit_env out _include units objFiles jsFiles isRootFun ex -- link generated RTS parts into rts.js unless (lcNoRts lc_cfg) $ do withFile (out "rts.js") WriteMode $ \h -> do - if csPrettyRender cfg - then printSDoc defaultJsContext (Ppr.PageMode True) h (rtsDeclsText $$ rtsText cfg) - else do - bh <- newBufHandle h - bPutHDoc bh defaultJsContext (line rtsDeclsText $$ line (rtsText cfg)) - bFlush bh + void $ hPutJS (csPrettyRender cfg) h (rts cfg) -- link dependencies' JS files into lib.js withBinaryFile (out "lib.js") WriteMode $ \h -> do @@ -307,6 +302,24 @@ data CompactedModuleCode = CompactedModuleCode , cmc_exports :: !B.ByteString -- ^ rendered exports } +-- | Output JS statements and return the output size in bytes. +hPutJS :: Bool -> Handle -> Sat.JStat -> IO Integer +hPutJS render_pretty h = \case + Sat.BlockStat [] -> pure 0 + x -> do + before <- hTell h + if render_pretty + then do + printSDoc defaultJsContext (Ppr.PageMode True) h (pretty render_pretty x) + else do + bh <- newBufHandle h + bPutHDoc bh defaultJsContext (line $ pretty render_pretty x) + bFlush bh + -- Append an empty line to correctly end the file in a newline + hPutChar h '\n' + after <- hTell h + pure $! (after - before) + -- | Link modules and pretty-print them into the given Handle renderLinker :: Handle @@ -321,18 +334,7 @@ renderLinker h render_pretty mods jsFiles = do let putBS = B.hPut h - putJS x = do - before <- hTell h - if render_pretty - then do - printSDoc defaultJsContext (Ppr.PageMode True) h (pretty x) - else do - bh <- newBufHandle h - -- Append an empty line to correctly end the file in a newline - bPutHDoc bh defaultJsContext ((line $ pretty x) $$ empty) - bFlush bh - after <- hTell h - pure $! (after - before) + putJS = hPutJS render_pretty h --------------------------------------------------------- -- Pretty-print JavaScript code for all the dependencies. ===================================== compiler/GHC/StgToJS/Linker/Opt.hs ===================================== @@ -20,7 +20,7 @@ ----------------------------------------------------------------------------- module GHC.StgToJS.Linker.Opt ( pretty - , ghcjsRenderJs + , optRenderJs ) where @@ -39,11 +39,17 @@ import Data.List (sortOn) import Data.Char (isAlpha,isDigit,ord) import qualified Data.ByteString.Short as SBS -pretty :: JsRender doc => JStat -> doc -pretty = jsToDocR ghcjsRenderJs - -ghcjsRenderJs :: RenderJs doc -ghcjsRenderJs = defaultRenderJs +pretty :: JsRender doc => Bool -> JStat -> doc +pretty render_pretty = \case + BlockStat [] -> empty + s | render_pretty -> jsToDocR defaultRenderJs [s] + | otherwise -> jsToDocR optRenderJs [s] + -- render as a list of statements to ensure that + -- semicolons are added. + +-- | Render JS with code size minimization enabled +optRenderJs :: RenderJs doc +optRenderJs = defaultRenderJs { renderJsV = ghcjsRenderJsV , renderJsS = ghcjsRenderJsS , renderJsI = ghcjsRenderJsI ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -1,7 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} - -{-# OPTIONS_GHC -O0 #-} +{-# LANGUAGE BlockArguments #-} ----------------------------------------------------------------------------- -- | @@ -24,7 +23,11 @@ -- ----------------------------------------------------------------------------- -module GHC.StgToJS.Rts.Rts where +module GHC.StgToJS.Rts.Rts + ( rts + , assignRegs + ) +where import GHC.Prelude @@ -42,11 +45,8 @@ import GHC.StgToJS.Regs import GHC.StgToJS.Types import GHC.StgToJS.Stack -import GHC.StgToJS.Linker.Opt - import GHC.Data.FastString import GHC.Types.Unique.Map -import GHC.JS.Ppr import Data.Array import Data.Monoid @@ -56,8 +56,8 @@ import qualified Data.Bits as Bits -- | The garbageCollector resets registers and result variables. garbageCollector :: JStat garbageCollector = - mconcat [ TxtI "h$resetRegisters" ||= jLam (mconcat $ map resetRegister [minBound..maxBound]) - , TxtI "h$resetResultVars" ||= jLam (mconcat $ map resetResultVar [minBound..maxBound]) + mconcat [ jFun (TxtI "h$resetRegisters") (mconcat $ map resetRegister [minBound..maxBound]) + , jFun (TxtI "h$resetResultVars") (mconcat $ map resetResultVar [minBound..maxBound]) ] -- | Reset the register 'r' in JS Land. Note that this "resets" by setting the @@ -233,8 +233,8 @@ declRegs = -- | JS payload to define getters and setters on the registers. regGettersSetters :: JStat regGettersSetters = - mconcat [ TxtI "h$getReg" ||= jLam (\n -> SwitchStat n getRegCases mempty) - , TxtI "h$setReg" ||= jLam (\n v -> SwitchStat n (setRegCases v) mempty) + mconcat [ jFun (TxtI "h$getReg") (\n -> SwitchStat n getRegCases mempty) + , jFun (TxtI "h$setReg") (\n v -> SwitchStat n (setRegCases v) mempty) ] where getRegCases = @@ -292,17 +292,16 @@ closureTypes = mconcat (map mkClosureType (enumFromTo minBound maxBound)) <> clo mkClosureType c = let s = TxtI . mkFastString $ "h$" ++ map toUpper (show c) ++ "_CLOSURE" in s ||= toJExpr c closureTypeName :: JStat - closureTypeName = - TxtI "h$closureTypeName" ||= jLam (\c -> - mconcat (map (ifCT c) [minBound..maxBound]) - <> returnS (jString "InvalidClosureType")) + closureTypeName = jFun (TxtI "h$closureTypeName") \c -> + mconcat (map (ifCT c) [minBound..maxBound]) + <> returnS (jString "InvalidClosureType") ifCT :: JExpr -> ClosureType -> JStat ifCT arg ct = jwhenS (arg .===. toJExpr ct) (returnS (toJExpr (show ct))) -- | JS payload declaring the RTS functions. -rtsDecls :: Sat.JStat -rtsDecls = satJStat (Just "h$RTSD") $ +rtsDecls :: JStat +rtsDecls = mconcat [ TxtI "h$currentThread" ||= null_ -- thread state object for current thread , TxtI "h$stack" ||= null_ -- stack for the current thread , TxtI "h$sp" ||= 0 -- stack pointer for the current thread @@ -315,17 +314,12 @@ rtsDecls = satJStat (Just "h$RTSD") $ , declRegs , declRets] --- | print the embedded RTS to a String -rtsText :: forall doc. JsRender doc => StgToJSConfig -> doc -rtsText = pretty @doc . jsOptimize . rts - --- | print the RTS declarations to a String. -rtsDeclsText :: forall doc. JsRender doc => doc -rtsDeclsText = pretty @doc . jsOptimize $ rtsDecls - --- | Wrapper over the RTS to guarentee saturation, see 'GHC.JS.Transform' +-- | Generated RTS code rts :: StgToJSConfig -> Sat.JStat -rts = satJStat (Just "h$RTS") . rts' +rts cfg = jsOptimize $ satJStat (Just "h$RTS") $ mconcat + [ rtsDecls + , rts' cfg + ] -- | JS Payload which defines the embedded RTS. rts' :: StgToJSConfig -> JStat @@ -349,8 +343,8 @@ rts' s = , TxtI "h$vt_rtsobj" ||= toJExpr RtsObjV , TxtI "h$vt_obj" ||= toJExpr ObjV , TxtI "h$vt_arr" ||= toJExpr ArrV - , TxtI "h$bh" ||= jLam (bhStats s True) - , TxtI "h$bh_lne" ||= jLam (\x frameSize -> bhLneStats s x frameSize) + , jFun (TxtI "h$bh") (bhStats s True) + , jFun (TxtI "h$bh_lne") (\x frameSize -> bhLneStats s x frameSize) , closure (ClosureInfo (TxtI "h$blackhole") (CIRegs 0 []) "blackhole" (CILayoutUnknown 2) CIBlackhole mempty) (appS "throw" [jString "oops: entered black hole"]) , closure (ClosureInfo (TxtI "h$blackholeTrap") (CIRegs 0 []) "blackhole" (CILayoutUnknown 2) CIThunk mempty) ===================================== libraries/base/GHC/IO/Handle/Types.hs-boot ===================================== @@ -2,4 +2,7 @@ module GHC.IO.Handle.Types ( Handle ) where +-- See Note [Depend on GHC.Num.Integer] in GHC.Base +import GHC.Types () + data Handle ===================================== testsuite/tests/javascript/T22455.hs ===================================== @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = putStrLn "Hello World" ===================================== testsuite/tests/javascript/T22455.stdout ===================================== @@ -0,0 +1 @@ +Hello World ===================================== testsuite/tests/javascript/all.T ===================================== @@ -17,3 +17,4 @@ test('js-callback04', js_skip, compile_and_run, ['']) test('js-callback05', js_skip, compile_and_run, ['']) test('T23346', normal, compile_and_run, ['']) +test('T22455', normal, compile_and_run, ['-ddisable-js-minifier']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9b465f325220bd7e9415461309911a3d58932901...f442f113eba70491eeb21636485e2dd480d7c2b0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9b465f325220bd7e9415461309911a3d58932901...f442f113eba70491eeb21636485e2dd480d7c2b0 You're receiving 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 Jun 3 03:53:40 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 02 Jun 2023 23:53:40 -0400 Subject: [Git][ghc/ghc][master] base: Add build-order import of GHC.Types in GHC.IO.Handle.Types Message-ID: <647ab944b48a6_17978339016382383c9@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - 1 changed file: - libraries/base/GHC/IO/Handle/Types.hs-boot Changes: ===================================== libraries/base/GHC/IO/Handle/Types.hs-boot ===================================== @@ -2,4 +2,7 @@ module GHC.IO.Handle.Types ( Handle ) where +-- See Note [Depend on GHC.Num.Integer] in GHC.Base +import GHC.Types () + data Handle View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4a4eb761ffb9c691eb53e95137273457cda4486d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4a4eb761ffb9c691eb53e95137273457cda4486d You're receiving 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 Jun 3 03:54:24 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 02 Jun 2023 23:54:24 -0400 Subject: [Git][ghc/ghc][master] JS: fix and enhance non-minimized code generation (#22455) Message-ID: <647ab97062268_179783ef75e78241427@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - 11 changed files: - compiler/GHC/JS/Make.hs - compiler/GHC/JS/Ppr.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Closure.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Linker/Opt.hs - compiler/GHC/StgToJS/Rts/Rts.hs - + testsuite/tests/javascript/T22455.hs - + testsuite/tests/javascript/T22455.stdout - testsuite/tests/javascript/all.T Changes: ===================================== compiler/GHC/JS/Make.hs ===================================== @@ -83,7 +83,7 @@ module GHC.JS.Make -- $intro_funcs , var , jString - , jLam, jFunction, jVar, jFor, jForNoDecl, jForIn, jForEachIn, jTryCatchFinally + , jLam, jFun, jFunction, jVar, jFor, jForNoDecl, jForIn, jForEachIn, jTryCatchFinally -- * Combinators -- $combinators , (||=), (|=), (.==.), (.===.), (.!=.), (.!==.), (.!) @@ -249,6 +249,15 @@ jLam f = ValExpr . UnsatVal . IS $ do (block,is) <- runIdentSupply $ toSat_ f [] return $ JFunc is block +-- | Create a new function. The result is a 'GHC.JS.Syntax.JStat'. +-- Usage: +-- +-- > jFun fun_name $ \x -> ... +jFun :: ToSat a => Ident -> a -> JStat +jFun n f = UnsatBlock . IS $ do + (block,is) <- runIdentSupply $ toSat_ f [] + return $ FuncStat n is block + -- | Introduce a new variable into scope for the duration -- of the enclosed expression. The result is a block statement. -- Usage: ===================================== compiler/GHC/JS/Ppr.hs ===================================== @@ -60,7 +60,6 @@ module GHC.JS.Ppr , jsToDoc , pprStringLit , interSemi - , addSemi , braceNest , hangBrace ) @@ -138,15 +137,25 @@ instance JsToDoc [JStat] where jsToDocR r = jcat . map (addSemi . jsToDocR r) defRenderJsS :: JsRender doc => RenderJs doc -> JStat -> doc defRenderJsS r = \case - IfStat cond x y -> hangBrace (text "if" <+?> parens (jsToDocR r cond)) - (jnest $ optBlock r x) - <+?> mbElse + IfStat cond x y -> jcat + [ hangBrace (text "if" <+?> parens (jsToDocR r cond)) (optBlock r x) + , mbElse + ] where mbElse | y == BlockStat [] = empty - | otherwise = hangBrace (text "else") (jnest $ optBlock r y) + | otherwise = hangBrace (text "else") (optBlock r y) DeclStat x Nothing -> text "var" <+> jsToDocR r x + -- special treatment for functions, otherwise there is too much left padding + -- (more than the length of the expression assigned to). E.g. + -- + -- var long_variable_name = (function() + -- { + -- ... + -- }); + -- + DeclStat x (Just (ValExpr f@(JFunc {}))) -> jhang (text "var" <+> jsToDocR r x <+?> char '=') (jsToDocR r f) DeclStat x (Just e) -> text "var" <+> jsToDocR r x <+?> char '=' <+?> jsToDocR r e - WhileStat False p b -> hangBrace (text "while" <+?> parens (jsToDocR r p)) (jnest $ optBlock r b) - WhileStat True p b -> hangBrace (text "do") (jnest $ optBlock r b) <+?> text "while" <+?> parens (jsToDocR r p) + WhileStat False p b -> hangBrace (text "while" <+?> parens (jsToDocR r p)) (optBlock r b) + WhileStat True p b -> hangBrace (text "do") (optBlock r b) <+?> text "while" <+?> parens (jsToDocR r p) BreakStat l -> addSemi $ maybe (text "break") (\(LexicalFastString s) -> (text "break" <+> ftext s)) l ContinueStat l -> addSemi $ maybe (text "continue") (\(LexicalFastString s) -> (text "continue" <+> ftext s)) l LabelStat (LexicalFastString l) s -> ftext l <> char ':' $$$ printBS s @@ -154,10 +163,10 @@ defRenderJsS r = \case printBS (BlockStat ss) = interSemi $ map (jsToDocR r) ss printBS x = jsToDocR r x - ForStat init p s1 sb -> hangBrace (text "for" <+?> parens forCond) (jnest $ optBlock r sb) + ForStat init p s1 sb -> hangBrace (text "for" <+?> parens forCond) (optBlock r sb) where forCond = jsToDocR r init <> semi <+?> jsToDocR r p <> semi <+?> parens (jsToDocR r s1) - ForInStat each i e b -> hangBrace (text txt <+?> parens (jsToDocR r i <+> text "in" <+> jsToDocR r e)) (jnest $ optBlock r b) + ForInStat each i e b -> hangBrace (text txt <+?> parens (jsToDocR r i <+> text "in" <+> jsToDocR r e)) (optBlock r b) where txt | each = "for each" | otherwise = "for" SwitchStat e l d -> hangBrace (text "switch" <+?> parens (jsToDocR r e)) cases @@ -168,33 +177,35 @@ defRenderJsS r = \case ApplStat e es -> jsToDocR r e <> (parens . foldl' (<+?>) empty . punctuate comma $ map (jsToDocR r) es) FuncStat i is b -> hangBrace (text "function" <+> jsToDocR r i <> parens (foldl' (<+?>) empty . punctuate comma . map (jsToDocR r) $ is)) - (jnest $ optBlock r b) + (optBlock r b) TryStat s i s1 s2 -> hangBrace (text "try") (jsToDocR r s) <+?> mbCatch <+?> mbFinally where mbCatch | s1 == BlockStat [] = empty - | otherwise = hangBrace (text "catch" <+?> parens (jsToDocR r i)) (jnest $ optBlock r s1) + | otherwise = hangBrace (text "catch" <+?> parens (jsToDocR r i)) (optBlock r s1) mbFinally | s2 == BlockStat [] = empty - | otherwise = hangBrace (text "finally") (jnest $ optBlock r s2) + | otherwise = hangBrace (text "finally") (optBlock r s2) AssignStat i op x -> case x of -- special treatment for functions, otherwise there is too much left padding -- (more than the length of the expression assigned to). E.g. -- - -- var long_variable_name = (function() + -- long_variable_name = (function() -- { -- ... -- }); -- - ValExpr (JFunc is b) -> jsToDocR r i <> ftext (aOpText op) <> text " function" <> parens (foldl' (<+?>) empty . punctuate comma . map (jsToDocR r) $ is) <> braceNest (jsToDocR r b) - _ -> jsToDocR r i <+?> ftext (aOpText op) <+?> jsToDocR r x + ValExpr f@(JFunc {}) -> jhang (jsToDocR r i <> ftext (aOpText op)) (jsToDocR r f) + _ -> jsToDocR r i <+?> ftext (aOpText op) <+?> jsToDocR r x UOpStat op x | isPre op && isAlphaOp op -> ftext (uOpText op) <+> optParens r x | isPre op -> ftext (uOpText op) <+> optParens r x | otherwise -> optParens r x <+> ftext (uOpText op) BlockStat xs -> jsToDocR r xs +-- | Remove one Block layering if we know we already have braces around the +-- statement optBlock :: JsRender doc => RenderJs doc -> JStat -> doc optBlock r x = case x of BlockStat{} -> jsToDocR r x - _ -> addSemi $ jsToDocR r x + _ -> addSemi (jsToDocR r x) optParens :: JsRender doc => RenderJs doc -> JExpr -> doc optParens r x = case x of @@ -338,9 +349,6 @@ encodeJsonChar = \case interSemi :: JsRender doc => [doc] -> doc interSemi = foldl ($$$) empty . punctuateFinal semi semi -addSemi :: IsLine doc => doc -> doc -addSemi x = x <> semi <> char '\n' - -- | The structure `{body}`, optionally indented over multiple lines {-# INLINE braceNest #-} braceNest :: JsRender doc => doc -> doc @@ -349,7 +357,11 @@ braceNest x = lbrace $$$ jnest x $$$ rbrace -- | The structure `hdr {body}`, optionally indented over multiple lines {-# INLINE hangBrace #-} hangBrace :: JsRender doc => doc -> doc -> doc -hangBrace hdr body = hdr <+?> braceNest body +hangBrace hdr body = jcat [ hdr <> char ' ' <> char '{', jnest body, char '}' ] + +{-# INLINE jhang #-} +jhang :: JsRender doc => doc -> doc -> doc +jhang hdr body = jcat [ hdr, jnest body] -- | JsRender controls the differences in whitespace between HLine and SDoc. -- Generally, this involves the indentation and newlines in the human-readable @@ -365,16 +377,21 @@ class IsLine doc => JsRender doc where jcat :: [doc] -> doc -- | Optionally indent the following jnest :: doc -> doc + -- | Append semi-colon (and line-break in HLine mode) + addSemi :: doc -> doc instance JsRender SDoc where (<+?>) = (<+>) {-# INLINE (<+?>) #-} - ($$$) = ($$) + ($$$) = ($+$) {-# INLINE ($$$) #-} jcat = vcat {-# INLINE jcat #-} jnest = nest 2 {-# INLINE jnest #-} + addSemi x = x <> semi + {-# INLINE addSemi #-} + instance JsRender HLine where (<+?>) = (<>) @@ -385,3 +402,6 @@ instance JsRender HLine where {-# INLINE jcat #-} jnest = id {-# INLINE jnest #-} + addSemi x = x <> semi <> char '\n' + -- we add a line-break to avoid issues with lines too long in minified outputs + {-# INLINE addSemi #-} ===================================== compiler/GHC/StgToJS/Apply.hs ===================================== @@ -590,7 +590,7 @@ genericStackApply cfg = closure info body -- genericFastApply :: StgToJSConfig -> JStat genericFastApply s = - TxtI "h$ap_gen_fast" ||= jLam \tag -> jVar \c -> + jFun (TxtI "h$ap_gen_fast") \tag -> jVar \c -> [traceRts s (jString "h$ap_gen_fast: " + tag) , c |= closureEntry r1 , SwitchStat (entryClosureType c) @@ -802,12 +802,12 @@ stackApply s fun_name nargs nvars = -- h$ap_n_r_fast is entered if a function of unknown arity is called, n -- arguments are already in r registers fastApply :: StgToJSConfig -> FastString -> Int -> Int -> JStat -fastApply s fun_name nargs nvars = func ||= body0 +fastApply s fun_name nargs nvars = body0 where -- special case for h$ap_0_0_fast body0 = if nargs == 0 && nvars == 0 - then jLam (enter s r1) - else toJExpr (JFunc myFunArgs body) + then jFun func (enter s r1) + else FuncStat func myFunArgs body func = TxtI fun_name @@ -875,7 +875,7 @@ fastApply s fun_name nargs nvars = func ||= body0 zeroApply :: StgToJSConfig -> JStat zeroApply s = mconcat - [ TxtI "h$e" ||= jLam (\c -> (r1 |= c) <> enter s c) + [ jFun (TxtI "h$e") (\c -> (r1 |= c) <> enter s c) ] -- carefully enter a closure that might be a thunk or a function @@ -973,13 +973,13 @@ selectors s = mkSel :: FastString -> (JExpr -> JExpr) -> JStat mkSel name sel = mconcat - [TxtI createName ||= jLam \r -> mconcat + [jFun (TxtI createName) \r -> mconcat [ traceRts s (toJExpr ("selector create: " <> name <> " for ") + (r .^ "alloc")) , ifS (isThunk r .||. isBlackhole r) (returnS (app "h$mkSelThunk" [r, toJExpr (v entryName), toJExpr (v resName)])) (returnS (sel r)) ] - , TxtI resName ||= jLam \r -> mconcat + , jFun (TxtI resName) \r -> mconcat [ traceRts s (toJExpr ("selector result: " <> name <> " for ") + (r .^ "alloc")) , returnS (sel r) ] @@ -1106,7 +1106,7 @@ papGen cfg = -- general utilities -- move the first n registers, starting at R2, m places up (do not use with negative m) moveRegs2 :: JStat -moveRegs2 = TxtI "h$moveRegs2" ||= jLam moveSwitch +moveRegs2 = jFun (TxtI "h$moveRegs2") moveSwitch where moveSwitch n m = SwitchStat ((n .<<. 8) .|. m) switchCases (defaultCase n m) -- fast cases ===================================== compiler/GHC/StgToJS/Closure.hs ===================================== @@ -116,7 +116,7 @@ setObjInfo debug obj t name fields a size regs static closure :: ClosureInfo -- ^ object being info'd see @ciVar@ in @ClosureInfo@ -> JStat -- ^ rhs -> JStat -closure ci body = (ciVar ci ||= jLam body) `mappend` closureInfoStat False ci +closure ci body = (jFun (ciVar ci) body) `mappend` closureInfoStat False ci conClosure :: Ident -> FastString -> CILayout -> Int -> JStat conClosure symbol name layout constr = ===================================== compiler/GHC/StgToJS/CodeGen.hs ===================================== @@ -366,4 +366,4 @@ genToplevelRhs i rhs = case rhs of sr) ccId <- costCentreStackLbl cc emitStatic idt static ccId - return $ (eid ||= toJExpr (JFunc [] (ll <> upd <> setcc <> body))) + return $ (FuncStat eid [] (ll <> upd <> setcc <> body)) ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -198,12 +198,7 @@ link lc_cfg cfg logger unit_env out _include units objFiles jsFiles isRootFun ex -- link generated RTS parts into rts.js unless (lcNoRts lc_cfg) $ do withFile (out "rts.js") WriteMode $ \h -> do - if csPrettyRender cfg - then printSDoc defaultJsContext (Ppr.PageMode True) h (rtsDeclsText $$ rtsText cfg) - else do - bh <- newBufHandle h - bPutHDoc bh defaultJsContext (line rtsDeclsText $$ line (rtsText cfg)) - bFlush bh + void $ hPutJS (csPrettyRender cfg) h (rts cfg) -- link dependencies' JS files into lib.js withBinaryFile (out "lib.js") WriteMode $ \h -> do @@ -307,6 +302,24 @@ data CompactedModuleCode = CompactedModuleCode , cmc_exports :: !B.ByteString -- ^ rendered exports } +-- | Output JS statements and return the output size in bytes. +hPutJS :: Bool -> Handle -> Sat.JStat -> IO Integer +hPutJS render_pretty h = \case + Sat.BlockStat [] -> pure 0 + x -> do + before <- hTell h + if render_pretty + then do + printSDoc defaultJsContext (Ppr.PageMode True) h (pretty render_pretty x) + else do + bh <- newBufHandle h + bPutHDoc bh defaultJsContext (line $ pretty render_pretty x) + bFlush bh + -- Append an empty line to correctly end the file in a newline + hPutChar h '\n' + after <- hTell h + pure $! (after - before) + -- | Link modules and pretty-print them into the given Handle renderLinker :: Handle @@ -321,18 +334,7 @@ renderLinker h render_pretty mods jsFiles = do let putBS = B.hPut h - putJS x = do - before <- hTell h - if render_pretty - then do - printSDoc defaultJsContext (Ppr.PageMode True) h (pretty x) - else do - bh <- newBufHandle h - -- Append an empty line to correctly end the file in a newline - bPutHDoc bh defaultJsContext ((line $ pretty x) $$ empty) - bFlush bh - after <- hTell h - pure $! (after - before) + putJS = hPutJS render_pretty h --------------------------------------------------------- -- Pretty-print JavaScript code for all the dependencies. ===================================== compiler/GHC/StgToJS/Linker/Opt.hs ===================================== @@ -20,7 +20,7 @@ ----------------------------------------------------------------------------- module GHC.StgToJS.Linker.Opt ( pretty - , ghcjsRenderJs + , optRenderJs ) where @@ -39,11 +39,17 @@ import Data.List (sortOn) import Data.Char (isAlpha,isDigit,ord) import qualified Data.ByteString.Short as SBS -pretty :: JsRender doc => JStat -> doc -pretty = jsToDocR ghcjsRenderJs - -ghcjsRenderJs :: RenderJs doc -ghcjsRenderJs = defaultRenderJs +pretty :: JsRender doc => Bool -> JStat -> doc +pretty render_pretty = \case + BlockStat [] -> empty + s | render_pretty -> jsToDocR defaultRenderJs [s] + | otherwise -> jsToDocR optRenderJs [s] + -- render as a list of statements to ensure that + -- semicolons are added. + +-- | Render JS with code size minimization enabled +optRenderJs :: RenderJs doc +optRenderJs = defaultRenderJs { renderJsV = ghcjsRenderJsV , renderJsS = ghcjsRenderJsS , renderJsI = ghcjsRenderJsI ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -1,7 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} - -{-# OPTIONS_GHC -O0 #-} +{-# LANGUAGE BlockArguments #-} ----------------------------------------------------------------------------- -- | @@ -24,7 +23,11 @@ -- ----------------------------------------------------------------------------- -module GHC.StgToJS.Rts.Rts where +module GHC.StgToJS.Rts.Rts + ( rts + , assignRegs + ) +where import GHC.Prelude @@ -42,11 +45,8 @@ import GHC.StgToJS.Regs import GHC.StgToJS.Types import GHC.StgToJS.Stack -import GHC.StgToJS.Linker.Opt - import GHC.Data.FastString import GHC.Types.Unique.Map -import GHC.JS.Ppr import Data.Array import Data.Monoid @@ -56,8 +56,8 @@ import qualified Data.Bits as Bits -- | The garbageCollector resets registers and result variables. garbageCollector :: JStat garbageCollector = - mconcat [ TxtI "h$resetRegisters" ||= jLam (mconcat $ map resetRegister [minBound..maxBound]) - , TxtI "h$resetResultVars" ||= jLam (mconcat $ map resetResultVar [minBound..maxBound]) + mconcat [ jFun (TxtI "h$resetRegisters") (mconcat $ map resetRegister [minBound..maxBound]) + , jFun (TxtI "h$resetResultVars") (mconcat $ map resetResultVar [minBound..maxBound]) ] -- | Reset the register 'r' in JS Land. Note that this "resets" by setting the @@ -233,8 +233,8 @@ declRegs = -- | JS payload to define getters and setters on the registers. regGettersSetters :: JStat regGettersSetters = - mconcat [ TxtI "h$getReg" ||= jLam (\n -> SwitchStat n getRegCases mempty) - , TxtI "h$setReg" ||= jLam (\n v -> SwitchStat n (setRegCases v) mempty) + mconcat [ jFun (TxtI "h$getReg") (\n -> SwitchStat n getRegCases mempty) + , jFun (TxtI "h$setReg") (\n v -> SwitchStat n (setRegCases v) mempty) ] where getRegCases = @@ -292,17 +292,16 @@ closureTypes = mconcat (map mkClosureType (enumFromTo minBound maxBound)) <> clo mkClosureType c = let s = TxtI . mkFastString $ "h$" ++ map toUpper (show c) ++ "_CLOSURE" in s ||= toJExpr c closureTypeName :: JStat - closureTypeName = - TxtI "h$closureTypeName" ||= jLam (\c -> - mconcat (map (ifCT c) [minBound..maxBound]) - <> returnS (jString "InvalidClosureType")) + closureTypeName = jFun (TxtI "h$closureTypeName") \c -> + mconcat (map (ifCT c) [minBound..maxBound]) + <> returnS (jString "InvalidClosureType") ifCT :: JExpr -> ClosureType -> JStat ifCT arg ct = jwhenS (arg .===. toJExpr ct) (returnS (toJExpr (show ct))) -- | JS payload declaring the RTS functions. -rtsDecls :: Sat.JStat -rtsDecls = satJStat (Just "h$RTSD") $ +rtsDecls :: JStat +rtsDecls = mconcat [ TxtI "h$currentThread" ||= null_ -- thread state object for current thread , TxtI "h$stack" ||= null_ -- stack for the current thread , TxtI "h$sp" ||= 0 -- stack pointer for the current thread @@ -315,17 +314,12 @@ rtsDecls = satJStat (Just "h$RTSD") $ , declRegs , declRets] --- | print the embedded RTS to a String -rtsText :: forall doc. JsRender doc => StgToJSConfig -> doc -rtsText = pretty @doc . jsOptimize . rts - --- | print the RTS declarations to a String. -rtsDeclsText :: forall doc. JsRender doc => doc -rtsDeclsText = pretty @doc . jsOptimize $ rtsDecls - --- | Wrapper over the RTS to guarentee saturation, see 'GHC.JS.Transform' +-- | Generated RTS code rts :: StgToJSConfig -> Sat.JStat -rts = satJStat (Just "h$RTS") . rts' +rts cfg = jsOptimize $ satJStat (Just "h$RTS") $ mconcat + [ rtsDecls + , rts' cfg + ] -- | JS Payload which defines the embedded RTS. rts' :: StgToJSConfig -> JStat @@ -349,8 +343,8 @@ rts' s = , TxtI "h$vt_rtsobj" ||= toJExpr RtsObjV , TxtI "h$vt_obj" ||= toJExpr ObjV , TxtI "h$vt_arr" ||= toJExpr ArrV - , TxtI "h$bh" ||= jLam (bhStats s True) - , TxtI "h$bh_lne" ||= jLam (\x frameSize -> bhLneStats s x frameSize) + , jFun (TxtI "h$bh") (bhStats s True) + , jFun (TxtI "h$bh_lne") (\x frameSize -> bhLneStats s x frameSize) , closure (ClosureInfo (TxtI "h$blackhole") (CIRegs 0 []) "blackhole" (CILayoutUnknown 2) CIBlackhole mempty) (appS "throw" [jString "oops: entered black hole"]) , closure (ClosureInfo (TxtI "h$blackholeTrap") (CIRegs 0 []) "blackhole" (CILayoutUnknown 2) CIThunk mempty) ===================================== testsuite/tests/javascript/T22455.hs ===================================== @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = putStrLn "Hello World" ===================================== testsuite/tests/javascript/T22455.stdout ===================================== @@ -0,0 +1 @@ +Hello World ===================================== testsuite/tests/javascript/all.T ===================================== @@ -17,3 +17,4 @@ test('js-callback04', js_skip, compile_and_run, ['']) test('js-callback05', js_skip, compile_and_run, ['']) test('T23346', normal, compile_and_run, ['']) +test('T22455', normal, compile_and_run, ['-ddisable-js-minifier']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f53ac0ae30adf699dae02131bcece8be074d9737 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f53ac0ae30adf699dae02131bcece8be074d9737 You're receiving 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 Jun 3 13:29:08 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 03 Jun 2023 09:29:08 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: base: Add build-order import of GHC.Types in GHC.IO.Handle.Types Message-ID: <647b4024d9ca3_17978315f86af0296031@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - e4827476 by Andrey Mokhov at 2023-06-03T09:28:55-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b022caf1 by Bodigrim at 2023-06-03T09:28:59-04:00 Elaborate on performance properties of Data.List.++ - - - - - 14 changed files: - compiler/GHC/JS/Make.hs - compiler/GHC/JS/Ppr.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Closure.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Linker/Opt.hs - compiler/GHC/StgToJS/Rts/Rts.hs - hadrian/src/Hadrian/Utilities.hs - libraries/base/GHC/Base.hs - libraries/base/GHC/IO/Handle/Types.hs-boot - + testsuite/tests/javascript/T22455.hs - + testsuite/tests/javascript/T22455.stdout - testsuite/tests/javascript/all.T Changes: ===================================== compiler/GHC/JS/Make.hs ===================================== @@ -83,7 +83,7 @@ module GHC.JS.Make -- $intro_funcs , var , jString - , jLam, jFunction, jVar, jFor, jForNoDecl, jForIn, jForEachIn, jTryCatchFinally + , jLam, jFun, jFunction, jVar, jFor, jForNoDecl, jForIn, jForEachIn, jTryCatchFinally -- * Combinators -- $combinators , (||=), (|=), (.==.), (.===.), (.!=.), (.!==.), (.!) @@ -249,6 +249,15 @@ jLam f = ValExpr . UnsatVal . IS $ do (block,is) <- runIdentSupply $ toSat_ f [] return $ JFunc is block +-- | Create a new function. The result is a 'GHC.JS.Syntax.JStat'. +-- Usage: +-- +-- > jFun fun_name $ \x -> ... +jFun :: ToSat a => Ident -> a -> JStat +jFun n f = UnsatBlock . IS $ do + (block,is) <- runIdentSupply $ toSat_ f [] + return $ FuncStat n is block + -- | Introduce a new variable into scope for the duration -- of the enclosed expression. The result is a block statement. -- Usage: ===================================== compiler/GHC/JS/Ppr.hs ===================================== @@ -60,7 +60,6 @@ module GHC.JS.Ppr , jsToDoc , pprStringLit , interSemi - , addSemi , braceNest , hangBrace ) @@ -138,15 +137,25 @@ instance JsToDoc [JStat] where jsToDocR r = jcat . map (addSemi . jsToDocR r) defRenderJsS :: JsRender doc => RenderJs doc -> JStat -> doc defRenderJsS r = \case - IfStat cond x y -> hangBrace (text "if" <+?> parens (jsToDocR r cond)) - (jnest $ optBlock r x) - <+?> mbElse + IfStat cond x y -> jcat + [ hangBrace (text "if" <+?> parens (jsToDocR r cond)) (optBlock r x) + , mbElse + ] where mbElse | y == BlockStat [] = empty - | otherwise = hangBrace (text "else") (jnest $ optBlock r y) + | otherwise = hangBrace (text "else") (optBlock r y) DeclStat x Nothing -> text "var" <+> jsToDocR r x + -- special treatment for functions, otherwise there is too much left padding + -- (more than the length of the expression assigned to). E.g. + -- + -- var long_variable_name = (function() + -- { + -- ... + -- }); + -- + DeclStat x (Just (ValExpr f@(JFunc {}))) -> jhang (text "var" <+> jsToDocR r x <+?> char '=') (jsToDocR r f) DeclStat x (Just e) -> text "var" <+> jsToDocR r x <+?> char '=' <+?> jsToDocR r e - WhileStat False p b -> hangBrace (text "while" <+?> parens (jsToDocR r p)) (jnest $ optBlock r b) - WhileStat True p b -> hangBrace (text "do") (jnest $ optBlock r b) <+?> text "while" <+?> parens (jsToDocR r p) + WhileStat False p b -> hangBrace (text "while" <+?> parens (jsToDocR r p)) (optBlock r b) + WhileStat True p b -> hangBrace (text "do") (optBlock r b) <+?> text "while" <+?> parens (jsToDocR r p) BreakStat l -> addSemi $ maybe (text "break") (\(LexicalFastString s) -> (text "break" <+> ftext s)) l ContinueStat l -> addSemi $ maybe (text "continue") (\(LexicalFastString s) -> (text "continue" <+> ftext s)) l LabelStat (LexicalFastString l) s -> ftext l <> char ':' $$$ printBS s @@ -154,10 +163,10 @@ defRenderJsS r = \case printBS (BlockStat ss) = interSemi $ map (jsToDocR r) ss printBS x = jsToDocR r x - ForStat init p s1 sb -> hangBrace (text "for" <+?> parens forCond) (jnest $ optBlock r sb) + ForStat init p s1 sb -> hangBrace (text "for" <+?> parens forCond) (optBlock r sb) where forCond = jsToDocR r init <> semi <+?> jsToDocR r p <> semi <+?> parens (jsToDocR r s1) - ForInStat each i e b -> hangBrace (text txt <+?> parens (jsToDocR r i <+> text "in" <+> jsToDocR r e)) (jnest $ optBlock r b) + ForInStat each i e b -> hangBrace (text txt <+?> parens (jsToDocR r i <+> text "in" <+> jsToDocR r e)) (optBlock r b) where txt | each = "for each" | otherwise = "for" SwitchStat e l d -> hangBrace (text "switch" <+?> parens (jsToDocR r e)) cases @@ -168,33 +177,35 @@ defRenderJsS r = \case ApplStat e es -> jsToDocR r e <> (parens . foldl' (<+?>) empty . punctuate comma $ map (jsToDocR r) es) FuncStat i is b -> hangBrace (text "function" <+> jsToDocR r i <> parens (foldl' (<+?>) empty . punctuate comma . map (jsToDocR r) $ is)) - (jnest $ optBlock r b) + (optBlock r b) TryStat s i s1 s2 -> hangBrace (text "try") (jsToDocR r s) <+?> mbCatch <+?> mbFinally where mbCatch | s1 == BlockStat [] = empty - | otherwise = hangBrace (text "catch" <+?> parens (jsToDocR r i)) (jnest $ optBlock r s1) + | otherwise = hangBrace (text "catch" <+?> parens (jsToDocR r i)) (optBlock r s1) mbFinally | s2 == BlockStat [] = empty - | otherwise = hangBrace (text "finally") (jnest $ optBlock r s2) + | otherwise = hangBrace (text "finally") (optBlock r s2) AssignStat i op x -> case x of -- special treatment for functions, otherwise there is too much left padding -- (more than the length of the expression assigned to). E.g. -- - -- var long_variable_name = (function() + -- long_variable_name = (function() -- { -- ... -- }); -- - ValExpr (JFunc is b) -> jsToDocR r i <> ftext (aOpText op) <> text " function" <> parens (foldl' (<+?>) empty . punctuate comma . map (jsToDocR r) $ is) <> braceNest (jsToDocR r b) - _ -> jsToDocR r i <+?> ftext (aOpText op) <+?> jsToDocR r x + ValExpr f@(JFunc {}) -> jhang (jsToDocR r i <> ftext (aOpText op)) (jsToDocR r f) + _ -> jsToDocR r i <+?> ftext (aOpText op) <+?> jsToDocR r x UOpStat op x | isPre op && isAlphaOp op -> ftext (uOpText op) <+> optParens r x | isPre op -> ftext (uOpText op) <+> optParens r x | otherwise -> optParens r x <+> ftext (uOpText op) BlockStat xs -> jsToDocR r xs +-- | Remove one Block layering if we know we already have braces around the +-- statement optBlock :: JsRender doc => RenderJs doc -> JStat -> doc optBlock r x = case x of BlockStat{} -> jsToDocR r x - _ -> addSemi $ jsToDocR r x + _ -> addSemi (jsToDocR r x) optParens :: JsRender doc => RenderJs doc -> JExpr -> doc optParens r x = case x of @@ -338,9 +349,6 @@ encodeJsonChar = \case interSemi :: JsRender doc => [doc] -> doc interSemi = foldl ($$$) empty . punctuateFinal semi semi -addSemi :: IsLine doc => doc -> doc -addSemi x = x <> semi <> char '\n' - -- | The structure `{body}`, optionally indented over multiple lines {-# INLINE braceNest #-} braceNest :: JsRender doc => doc -> doc @@ -349,7 +357,11 @@ braceNest x = lbrace $$$ jnest x $$$ rbrace -- | The structure `hdr {body}`, optionally indented over multiple lines {-# INLINE hangBrace #-} hangBrace :: JsRender doc => doc -> doc -> doc -hangBrace hdr body = hdr <+?> braceNest body +hangBrace hdr body = jcat [ hdr <> char ' ' <> char '{', jnest body, char '}' ] + +{-# INLINE jhang #-} +jhang :: JsRender doc => doc -> doc -> doc +jhang hdr body = jcat [ hdr, jnest body] -- | JsRender controls the differences in whitespace between HLine and SDoc. -- Generally, this involves the indentation and newlines in the human-readable @@ -365,16 +377,21 @@ class IsLine doc => JsRender doc where jcat :: [doc] -> doc -- | Optionally indent the following jnest :: doc -> doc + -- | Append semi-colon (and line-break in HLine mode) + addSemi :: doc -> doc instance JsRender SDoc where (<+?>) = (<+>) {-# INLINE (<+?>) #-} - ($$$) = ($$) + ($$$) = ($+$) {-# INLINE ($$$) #-} jcat = vcat {-# INLINE jcat #-} jnest = nest 2 {-# INLINE jnest #-} + addSemi x = x <> semi + {-# INLINE addSemi #-} + instance JsRender HLine where (<+?>) = (<>) @@ -385,3 +402,6 @@ instance JsRender HLine where {-# INLINE jcat #-} jnest = id {-# INLINE jnest #-} + addSemi x = x <> semi <> char '\n' + -- we add a line-break to avoid issues with lines too long in minified outputs + {-# INLINE addSemi #-} ===================================== compiler/GHC/StgToJS/Apply.hs ===================================== @@ -590,7 +590,7 @@ genericStackApply cfg = closure info body -- genericFastApply :: StgToJSConfig -> JStat genericFastApply s = - TxtI "h$ap_gen_fast" ||= jLam \tag -> jVar \c -> + jFun (TxtI "h$ap_gen_fast") \tag -> jVar \c -> [traceRts s (jString "h$ap_gen_fast: " + tag) , c |= closureEntry r1 , SwitchStat (entryClosureType c) @@ -802,12 +802,12 @@ stackApply s fun_name nargs nvars = -- h$ap_n_r_fast is entered if a function of unknown arity is called, n -- arguments are already in r registers fastApply :: StgToJSConfig -> FastString -> Int -> Int -> JStat -fastApply s fun_name nargs nvars = func ||= body0 +fastApply s fun_name nargs nvars = body0 where -- special case for h$ap_0_0_fast body0 = if nargs == 0 && nvars == 0 - then jLam (enter s r1) - else toJExpr (JFunc myFunArgs body) + then jFun func (enter s r1) + else FuncStat func myFunArgs body func = TxtI fun_name @@ -875,7 +875,7 @@ fastApply s fun_name nargs nvars = func ||= body0 zeroApply :: StgToJSConfig -> JStat zeroApply s = mconcat - [ TxtI "h$e" ||= jLam (\c -> (r1 |= c) <> enter s c) + [ jFun (TxtI "h$e") (\c -> (r1 |= c) <> enter s c) ] -- carefully enter a closure that might be a thunk or a function @@ -973,13 +973,13 @@ selectors s = mkSel :: FastString -> (JExpr -> JExpr) -> JStat mkSel name sel = mconcat - [TxtI createName ||= jLam \r -> mconcat + [jFun (TxtI createName) \r -> mconcat [ traceRts s (toJExpr ("selector create: " <> name <> " for ") + (r .^ "alloc")) , ifS (isThunk r .||. isBlackhole r) (returnS (app "h$mkSelThunk" [r, toJExpr (v entryName), toJExpr (v resName)])) (returnS (sel r)) ] - , TxtI resName ||= jLam \r -> mconcat + , jFun (TxtI resName) \r -> mconcat [ traceRts s (toJExpr ("selector result: " <> name <> " for ") + (r .^ "alloc")) , returnS (sel r) ] @@ -1106,7 +1106,7 @@ papGen cfg = -- general utilities -- move the first n registers, starting at R2, m places up (do not use with negative m) moveRegs2 :: JStat -moveRegs2 = TxtI "h$moveRegs2" ||= jLam moveSwitch +moveRegs2 = jFun (TxtI "h$moveRegs2") moveSwitch where moveSwitch n m = SwitchStat ((n .<<. 8) .|. m) switchCases (defaultCase n m) -- fast cases ===================================== compiler/GHC/StgToJS/Closure.hs ===================================== @@ -116,7 +116,7 @@ setObjInfo debug obj t name fields a size regs static closure :: ClosureInfo -- ^ object being info'd see @ciVar@ in @ClosureInfo@ -> JStat -- ^ rhs -> JStat -closure ci body = (ciVar ci ||= jLam body) `mappend` closureInfoStat False ci +closure ci body = (jFun (ciVar ci) body) `mappend` closureInfoStat False ci conClosure :: Ident -> FastString -> CILayout -> Int -> JStat conClosure symbol name layout constr = ===================================== compiler/GHC/StgToJS/CodeGen.hs ===================================== @@ -366,4 +366,4 @@ genToplevelRhs i rhs = case rhs of sr) ccId <- costCentreStackLbl cc emitStatic idt static ccId - return $ (eid ||= toJExpr (JFunc [] (ll <> upd <> setcc <> body))) + return $ (FuncStat eid [] (ll <> upd <> setcc <> body)) ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -198,12 +198,7 @@ link lc_cfg cfg logger unit_env out _include units objFiles jsFiles isRootFun ex -- link generated RTS parts into rts.js unless (lcNoRts lc_cfg) $ do withFile (out "rts.js") WriteMode $ \h -> do - if csPrettyRender cfg - then printSDoc defaultJsContext (Ppr.PageMode True) h (rtsDeclsText $$ rtsText cfg) - else do - bh <- newBufHandle h - bPutHDoc bh defaultJsContext (line rtsDeclsText $$ line (rtsText cfg)) - bFlush bh + void $ hPutJS (csPrettyRender cfg) h (rts cfg) -- link dependencies' JS files into lib.js withBinaryFile (out "lib.js") WriteMode $ \h -> do @@ -307,6 +302,24 @@ data CompactedModuleCode = CompactedModuleCode , cmc_exports :: !B.ByteString -- ^ rendered exports } +-- | Output JS statements and return the output size in bytes. +hPutJS :: Bool -> Handle -> Sat.JStat -> IO Integer +hPutJS render_pretty h = \case + Sat.BlockStat [] -> pure 0 + x -> do + before <- hTell h + if render_pretty + then do + printSDoc defaultJsContext (Ppr.PageMode True) h (pretty render_pretty x) + else do + bh <- newBufHandle h + bPutHDoc bh defaultJsContext (line $ pretty render_pretty x) + bFlush bh + -- Append an empty line to correctly end the file in a newline + hPutChar h '\n' + after <- hTell h + pure $! (after - before) + -- | Link modules and pretty-print them into the given Handle renderLinker :: Handle @@ -321,18 +334,7 @@ renderLinker h render_pretty mods jsFiles = do let putBS = B.hPut h - putJS x = do - before <- hTell h - if render_pretty - then do - printSDoc defaultJsContext (Ppr.PageMode True) h (pretty x) - else do - bh <- newBufHandle h - -- Append an empty line to correctly end the file in a newline - bPutHDoc bh defaultJsContext ((line $ pretty x) $$ empty) - bFlush bh - after <- hTell h - pure $! (after - before) + putJS = hPutJS render_pretty h --------------------------------------------------------- -- Pretty-print JavaScript code for all the dependencies. ===================================== compiler/GHC/StgToJS/Linker/Opt.hs ===================================== @@ -20,7 +20,7 @@ ----------------------------------------------------------------------------- module GHC.StgToJS.Linker.Opt ( pretty - , ghcjsRenderJs + , optRenderJs ) where @@ -39,11 +39,17 @@ import Data.List (sortOn) import Data.Char (isAlpha,isDigit,ord) import qualified Data.ByteString.Short as SBS -pretty :: JsRender doc => JStat -> doc -pretty = jsToDocR ghcjsRenderJs - -ghcjsRenderJs :: RenderJs doc -ghcjsRenderJs = defaultRenderJs +pretty :: JsRender doc => Bool -> JStat -> doc +pretty render_pretty = \case + BlockStat [] -> empty + s | render_pretty -> jsToDocR defaultRenderJs [s] + | otherwise -> jsToDocR optRenderJs [s] + -- render as a list of statements to ensure that + -- semicolons are added. + +-- | Render JS with code size minimization enabled +optRenderJs :: RenderJs doc +optRenderJs = defaultRenderJs { renderJsV = ghcjsRenderJsV , renderJsS = ghcjsRenderJsS , renderJsI = ghcjsRenderJsI ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -1,7 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} - -{-# OPTIONS_GHC -O0 #-} +{-# LANGUAGE BlockArguments #-} ----------------------------------------------------------------------------- -- | @@ -24,7 +23,11 @@ -- ----------------------------------------------------------------------------- -module GHC.StgToJS.Rts.Rts where +module GHC.StgToJS.Rts.Rts + ( rts + , assignRegs + ) +where import GHC.Prelude @@ -42,11 +45,8 @@ import GHC.StgToJS.Regs import GHC.StgToJS.Types import GHC.StgToJS.Stack -import GHC.StgToJS.Linker.Opt - import GHC.Data.FastString import GHC.Types.Unique.Map -import GHC.JS.Ppr import Data.Array import Data.Monoid @@ -56,8 +56,8 @@ import qualified Data.Bits as Bits -- | The garbageCollector resets registers and result variables. garbageCollector :: JStat garbageCollector = - mconcat [ TxtI "h$resetRegisters" ||= jLam (mconcat $ map resetRegister [minBound..maxBound]) - , TxtI "h$resetResultVars" ||= jLam (mconcat $ map resetResultVar [minBound..maxBound]) + mconcat [ jFun (TxtI "h$resetRegisters") (mconcat $ map resetRegister [minBound..maxBound]) + , jFun (TxtI "h$resetResultVars") (mconcat $ map resetResultVar [minBound..maxBound]) ] -- | Reset the register 'r' in JS Land. Note that this "resets" by setting the @@ -233,8 +233,8 @@ declRegs = -- | JS payload to define getters and setters on the registers. regGettersSetters :: JStat regGettersSetters = - mconcat [ TxtI "h$getReg" ||= jLam (\n -> SwitchStat n getRegCases mempty) - , TxtI "h$setReg" ||= jLam (\n v -> SwitchStat n (setRegCases v) mempty) + mconcat [ jFun (TxtI "h$getReg") (\n -> SwitchStat n getRegCases mempty) + , jFun (TxtI "h$setReg") (\n v -> SwitchStat n (setRegCases v) mempty) ] where getRegCases = @@ -292,17 +292,16 @@ closureTypes = mconcat (map mkClosureType (enumFromTo minBound maxBound)) <> clo mkClosureType c = let s = TxtI . mkFastString $ "h$" ++ map toUpper (show c) ++ "_CLOSURE" in s ||= toJExpr c closureTypeName :: JStat - closureTypeName = - TxtI "h$closureTypeName" ||= jLam (\c -> - mconcat (map (ifCT c) [minBound..maxBound]) - <> returnS (jString "InvalidClosureType")) + closureTypeName = jFun (TxtI "h$closureTypeName") \c -> + mconcat (map (ifCT c) [minBound..maxBound]) + <> returnS (jString "InvalidClosureType") ifCT :: JExpr -> ClosureType -> JStat ifCT arg ct = jwhenS (arg .===. toJExpr ct) (returnS (toJExpr (show ct))) -- | JS payload declaring the RTS functions. -rtsDecls :: Sat.JStat -rtsDecls = satJStat (Just "h$RTSD") $ +rtsDecls :: JStat +rtsDecls = mconcat [ TxtI "h$currentThread" ||= null_ -- thread state object for current thread , TxtI "h$stack" ||= null_ -- stack for the current thread , TxtI "h$sp" ||= 0 -- stack pointer for the current thread @@ -315,17 +314,12 @@ rtsDecls = satJStat (Just "h$RTSD") $ , declRegs , declRets] --- | print the embedded RTS to a String -rtsText :: forall doc. JsRender doc => StgToJSConfig -> doc -rtsText = pretty @doc . jsOptimize . rts - --- | print the RTS declarations to a String. -rtsDeclsText :: forall doc. JsRender doc => doc -rtsDeclsText = pretty @doc . jsOptimize $ rtsDecls - --- | Wrapper over the RTS to guarentee saturation, see 'GHC.JS.Transform' +-- | Generated RTS code rts :: StgToJSConfig -> Sat.JStat -rts = satJStat (Just "h$RTS") . rts' +rts cfg = jsOptimize $ satJStat (Just "h$RTS") $ mconcat + [ rtsDecls + , rts' cfg + ] -- | JS Payload which defines the embedded RTS. rts' :: StgToJSConfig -> JStat @@ -349,8 +343,8 @@ rts' s = , TxtI "h$vt_rtsobj" ||= toJExpr RtsObjV , TxtI "h$vt_obj" ||= toJExpr ObjV , TxtI "h$vt_arr" ||= toJExpr ArrV - , TxtI "h$bh" ||= jLam (bhStats s True) - , TxtI "h$bh_lne" ||= jLam (\x frameSize -> bhLneStats s x frameSize) + , jFun (TxtI "h$bh") (bhStats s True) + , jFun (TxtI "h$bh_lne") (\x frameSize -> bhLneStats s x frameSize) , closure (ClosureInfo (TxtI "h$blackhole") (CIRegs 0 []) "blackhole" (CILayoutUnknown 2) CIBlackhole mempty) (appS "throw" [jString "oops: entered black hole"]) , closure (ClosureInfo (TxtI "h$blackholeTrap") (CIRegs 0 []) "blackhole" (CILayoutUnknown 2) CIThunk mempty) ===================================== hadrian/src/Hadrian/Utilities.hs ===================================== @@ -574,22 +574,36 @@ renderCreateFileLink linkTarget link' = do where link = unifyPath link' +-- | Render a multiline string, prefixing the first line with a header. +renderMultiLineString :: String -> String -> [String] +renderMultiLineString header string = + [ linePrefix index ++ line | (index, line) <- zip [0..] (lines string) ] + where + linePrefix :: Int -> String + linePrefix index + | index == 0 = header + | otherwise = replicate (length header) ' ' + +-- | Render a (possibly multiline) synopsis, making sure it ends with a dot. +renderSynopsis :: String -> String -> [String] +renderSynopsis header synopsis + | null synopsis = [] + | otherwise = renderMultiLineString header (endWithADot synopsis) + where + endWithADot :: String -> String + endWithADot s = dropWhileEnd isPunctuation s ++ "." + -- | Render the successful build of a program. renderProgram :: String -> String -> String -> String renderProgram name bin synopsis = renderBox $ - [ "Successfully built program " ++ name - , "Executable: " ++ bin ] ++ - [ "Program synopsis: " ++ endWithADot synopsis | not (null synopsis) ] + [ "Successfully built program " ++ name, "Executable: " ++ bin ] ++ + renderSynopsis "Program synopsis: " synopsis -- | Render the successful build of a library. renderLibrary :: String -> String -> String -> String renderLibrary name lib synopsis = renderBox $ - [ "Successfully built library " ++ name - , "Library: " ++ lib ] ++ - [ "Library synopsis: " ++ endWithADot synopsis | not (null synopsis) ] - -endWithADot :: String -> String -endWithADot s = dropWhileEnd isPunctuation s ++ "." + [ "Successfully built library " ++ name, "Library: " ++ lib ] ++ + renderSynopsis "Library synopsis: " synopsis -- | Render the given set of lines in an ASCII box. The minimum width and -- whether to use Unicode symbols are hardcoded in the function's body. ===================================== libraries/base/GHC/Base.hs ===================================== @@ -1461,8 +1461,13 @@ The rules for map work like this. -- -- If the first list is not finite, the result is the first list. -- --- WARNING: This function takes linear time in the number of elements of the --- first list. +-- This function takes linear time in the number of elements of the +-- __first__ list. Thus it is better to associate repeated +-- applications of '(++)' to the right (which is the default behaviour): +-- @xs ++ (ys ++ zs)@ or simply @xs ++ ys ++ zs@, but not @(xs ++ ys) ++ zs at . +-- For the same reason 'Data.List.concat' @=@ 'Data.List.foldr' '(++)' @[]@ +-- has linear performance, while 'Data.List.foldl' '(++)' @[]@ is prone +-- to quadratic slowdown. (++) :: [a] -> [a] -> [a] {-# NOINLINE [2] (++) #-} ===================================== libraries/base/GHC/IO/Handle/Types.hs-boot ===================================== @@ -2,4 +2,7 @@ module GHC.IO.Handle.Types ( Handle ) where +-- See Note [Depend on GHC.Num.Integer] in GHC.Base +import GHC.Types () + data Handle ===================================== testsuite/tests/javascript/T22455.hs ===================================== @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = putStrLn "Hello World" ===================================== testsuite/tests/javascript/T22455.stdout ===================================== @@ -0,0 +1 @@ +Hello World ===================================== testsuite/tests/javascript/all.T ===================================== @@ -17,3 +17,4 @@ test('js-callback04', js_skip, compile_and_run, ['']) test('js-callback05', js_skip, compile_and_run, ['']) test('T23346', normal, compile_and_run, ['']) +test('T22455', normal, compile_and_run, ['-ddisable-js-minifier']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f442f113eba70491eeb21636485e2dd480d7c2b0...b022caf1b80442c58cdb6ca97913b442d923d92a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f442f113eba70491eeb21636485e2dd480d7c2b0...b022caf1b80442c58cdb6ca97913b442d923d92a You're receiving 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 Jun 3 15:59:24 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 03 Jun 2023 11:59:24 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: [hadrian] Fix multiline synopsis rendering Message-ID: <647b635c9bca8_1d329dc376c56576@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 484139a4 by Andrey Mokhov at 2023-06-03T11:59:17-04:00 [hadrian] Fix multiline synopsis rendering - - - - - 77fb0aab by Bodigrim at 2023-06-03T11:59:19-04:00 Elaborate on performance properties of Data.List.++ - - - - - 2 changed files: - hadrian/src/Hadrian/Utilities.hs - libraries/base/GHC/Base.hs Changes: ===================================== hadrian/src/Hadrian/Utilities.hs ===================================== @@ -574,22 +574,36 @@ renderCreateFileLink linkTarget link' = do where link = unifyPath link' +-- | Render a multiline string, prefixing the first line with a header. +renderMultiLineString :: String -> String -> [String] +renderMultiLineString header string = + [ linePrefix index ++ line | (index, line) <- zip [0..] (lines string) ] + where + linePrefix :: Int -> String + linePrefix index + | index == 0 = header + | otherwise = replicate (length header) ' ' + +-- | Render a (possibly multiline) synopsis, making sure it ends with a dot. +renderSynopsis :: String -> String -> [String] +renderSynopsis header synopsis + | null synopsis = [] + | otherwise = renderMultiLineString header (endWithADot synopsis) + where + endWithADot :: String -> String + endWithADot s = dropWhileEnd isPunctuation s ++ "." + -- | Render the successful build of a program. renderProgram :: String -> String -> String -> String renderProgram name bin synopsis = renderBox $ - [ "Successfully built program " ++ name - , "Executable: " ++ bin ] ++ - [ "Program synopsis: " ++ endWithADot synopsis | not (null synopsis) ] + [ "Successfully built program " ++ name, "Executable: " ++ bin ] ++ + renderSynopsis "Program synopsis: " synopsis -- | Render the successful build of a library. renderLibrary :: String -> String -> String -> String renderLibrary name lib synopsis = renderBox $ - [ "Successfully built library " ++ name - , "Library: " ++ lib ] ++ - [ "Library synopsis: " ++ endWithADot synopsis | not (null synopsis) ] - -endWithADot :: String -> String -endWithADot s = dropWhileEnd isPunctuation s ++ "." + [ "Successfully built library " ++ name, "Library: " ++ lib ] ++ + renderSynopsis "Library synopsis: " synopsis -- | Render the given set of lines in an ASCII box. The minimum width and -- whether to use Unicode symbols are hardcoded in the function's body. ===================================== libraries/base/GHC/Base.hs ===================================== @@ -1461,8 +1461,13 @@ The rules for map work like this. -- -- If the first list is not finite, the result is the first list. -- --- WARNING: This function takes linear time in the number of elements of the --- first list. +-- This function takes linear time in the number of elements of the +-- __first__ list. Thus it is better to associate repeated +-- applications of '(++)' to the right (which is the default behaviour): +-- @xs ++ (ys ++ zs)@ or simply @xs ++ ys ++ zs@, but not @(xs ++ ys) ++ zs at . +-- For the same reason 'Data.List.concat' @=@ 'Data.List.foldr' '(++)' @[]@ +-- has linear performance, while 'Data.List.foldl' '(++)' @[]@ is prone +-- to quadratic slowdown. (++) :: [a] -> [a] -> [a] {-# NOINLINE [2] (++) #-} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b022caf1b80442c58cdb6ca97913b442d923d92a...77fb0aab9dc8fc73d2d2966d91b360beea3ee621 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b022caf1b80442c58cdb6ca97913b442d923d92a...77fb0aab9dc8fc73d2d2966d91b360beea3ee621 You're receiving 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 Jun 3 18:49:44 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 03 Jun 2023 14:49:44 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: [hadrian] Fix multiline synopsis rendering Message-ID: <647b8b48dcd3_1d329dc37a8688ac@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 412ea34a by Andrey Mokhov at 2023-06-03T14:49:37-04:00 [hadrian] Fix multiline synopsis rendering - - - - - 079586c7 by Bodigrim at 2023-06-03T14:49:39-04:00 Elaborate on performance properties of Data.List.++ - - - - - 2 changed files: - hadrian/src/Hadrian/Utilities.hs - libraries/base/GHC/Base.hs Changes: ===================================== hadrian/src/Hadrian/Utilities.hs ===================================== @@ -574,22 +574,36 @@ renderCreateFileLink linkTarget link' = do where link = unifyPath link' +-- | Render a multiline string, prefixing the first line with a header. +renderMultiLineString :: String -> String -> [String] +renderMultiLineString header string = + [ linePrefix index ++ line | (index, line) <- zip [0..] (lines string) ] + where + linePrefix :: Int -> String + linePrefix index + | index == 0 = header + | otherwise = replicate (length header) ' ' + +-- | Render a (possibly multiline) synopsis, making sure it ends with a dot. +renderSynopsis :: String -> String -> [String] +renderSynopsis header synopsis + | null synopsis = [] + | otherwise = renderMultiLineString header (endWithADot synopsis) + where + endWithADot :: String -> String + endWithADot s = dropWhileEnd isPunctuation s ++ "." + -- | Render the successful build of a program. renderProgram :: String -> String -> String -> String renderProgram name bin synopsis = renderBox $ - [ "Successfully built program " ++ name - , "Executable: " ++ bin ] ++ - [ "Program synopsis: " ++ endWithADot synopsis | not (null synopsis) ] + [ "Successfully built program " ++ name, "Executable: " ++ bin ] ++ + renderSynopsis "Program synopsis: " synopsis -- | Render the successful build of a library. renderLibrary :: String -> String -> String -> String renderLibrary name lib synopsis = renderBox $ - [ "Successfully built library " ++ name - , "Library: " ++ lib ] ++ - [ "Library synopsis: " ++ endWithADot synopsis | not (null synopsis) ] - -endWithADot :: String -> String -endWithADot s = dropWhileEnd isPunctuation s ++ "." + [ "Successfully built library " ++ name, "Library: " ++ lib ] ++ + renderSynopsis "Library synopsis: " synopsis -- | Render the given set of lines in an ASCII box. The minimum width and -- whether to use Unicode symbols are hardcoded in the function's body. ===================================== libraries/base/GHC/Base.hs ===================================== @@ -1461,8 +1461,13 @@ The rules for map work like this. -- -- If the first list is not finite, the result is the first list. -- --- WARNING: This function takes linear time in the number of elements of the --- first list. +-- This function takes linear time in the number of elements of the +-- __first__ list. Thus it is better to associate repeated +-- applications of '(++)' to the right (which is the default behaviour): +-- @xs ++ (ys ++ zs)@ or simply @xs ++ ys ++ zs@, but not @(xs ++ ys) ++ zs at . +-- For the same reason 'Data.List.concat' @=@ 'Data.List.foldr' '(++)' @[]@ +-- has linear performance, while 'Data.List.foldl' '(++)' @[]@ is prone +-- to quadratic slowdown. (++) :: [a] -> [a] -> [a] {-# NOINLINE [2] (++) #-} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/77fb0aab9dc8fc73d2d2966d91b360beea3ee621...079586c7ca8f2645033a29568e471eae12896642 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/77fb0aab9dc8fc73d2d2966d91b360beea3ee621...079586c7ca8f2645033a29568e471eae12896642 You're receiving 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 Jun 3 20:43:41 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Sat, 03 Jun 2023 16:43:41 -0400 Subject: [Git][ghc/ghc][wip/int-index/decl-invis-binders] 33 commits: Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) Message-ID: <647ba5fd23bf7_1d329dc374482169@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/decl-invis-binders at Glasgow Haskell Compiler / GHC Commits: 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - 3a7f337b by Vladislav Zavialov at 2023-06-03T22:41:57+02: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/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/JS/Make.hs - compiler/GHC/JS/Optimizer.hs - compiler/GHC/JS/Ppr.hs - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4a92480c0b1ed2ede04470b6c5e4c8f2c2a178d8...3a7f337b43ddd0b88edb18fa13d59fa06dee1018 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4a92480c0b1ed2ede04470b6c5e4c8f2c2a178d8...3a7f337b43ddd0b88edb18fa13d59fa06dee1018 You're receiving 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 Jun 3 20:50:01 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 03 Jun 2023 16:50:01 -0400 Subject: [Git][ghc/ghc][master] [hadrian] Fix multiline synopsis rendering Message-ID: <647ba7795ec08_1d329dc37808643c@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - 1 changed file: - hadrian/src/Hadrian/Utilities.hs Changes: ===================================== hadrian/src/Hadrian/Utilities.hs ===================================== @@ -574,22 +574,36 @@ renderCreateFileLink linkTarget link' = do where link = unifyPath link' +-- | Render a multiline string, prefixing the first line with a header. +renderMultiLineString :: String -> String -> [String] +renderMultiLineString header string = + [ linePrefix index ++ line | (index, line) <- zip [0..] (lines string) ] + where + linePrefix :: Int -> String + linePrefix index + | index == 0 = header + | otherwise = replicate (length header) ' ' + +-- | Render a (possibly multiline) synopsis, making sure it ends with a dot. +renderSynopsis :: String -> String -> [String] +renderSynopsis header synopsis + | null synopsis = [] + | otherwise = renderMultiLineString header (endWithADot synopsis) + where + endWithADot :: String -> String + endWithADot s = dropWhileEnd isPunctuation s ++ "." + -- | Render the successful build of a program. renderProgram :: String -> String -> String -> String renderProgram name bin synopsis = renderBox $ - [ "Successfully built program " ++ name - , "Executable: " ++ bin ] ++ - [ "Program synopsis: " ++ endWithADot synopsis | not (null synopsis) ] + [ "Successfully built program " ++ name, "Executable: " ++ bin ] ++ + renderSynopsis "Program synopsis: " synopsis -- | Render the successful build of a library. renderLibrary :: String -> String -> String -> String renderLibrary name lib synopsis = renderBox $ - [ "Successfully built library " ++ name - , "Library: " ++ lib ] ++ - [ "Library synopsis: " ++ endWithADot synopsis | not (null synopsis) ] - -endWithADot :: String -> String -endWithADot s = dropWhileEnd isPunctuation s ++ "." + [ "Successfully built library " ++ name, "Library: " ++ lib ] ++ + renderSynopsis "Library synopsis: " synopsis -- | Render the given set of lines in an ASCII box. The minimum width and -- whether to use Unicode symbols are hardcoded in the function's body. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f7744e8e48362879ba4fae226763cfc7db1bdecb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f7744e8e48362879ba4fae226763cfc7db1bdecb You're receiving 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 Jun 3 20:50:39 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 03 Jun 2023 16:50:39 -0400 Subject: [Git][ghc/ghc][master] Elaborate on performance properties of Data.List.++ Message-ID: <647ba79f932ff_1d329dc379489978@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 1 changed file: - libraries/base/GHC/Base.hs Changes: ===================================== libraries/base/GHC/Base.hs ===================================== @@ -1461,8 +1461,13 @@ The rules for map work like this. -- -- If the first list is not finite, the result is the first list. -- --- WARNING: This function takes linear time in the number of elements of the --- first list. +-- This function takes linear time in the number of elements of the +-- __first__ list. Thus it is better to associate repeated +-- applications of '(++)' to the right (which is the default behaviour): +-- @xs ++ (ys ++ zs)@ or simply @xs ++ ys ++ zs@, but not @(xs ++ ys) ++ zs at . +-- For the same reason 'Data.List.concat' @=@ 'Data.List.foldr' '(++)' @[]@ +-- has linear performance, while 'Data.List.foldl' '(++)' @[]@ is prone +-- to quadratic slowdown. (++) :: [a] -> [a] -> [a] {-# NOINLINE [2] (++) #-} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b2c745db6a817993dcef03551243a2fd2b3ea756 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b2c745db6a817993dcef03551243a2fd2b3ea756 You're receiving 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 Jun 3 23:17:44 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Sat, 03 Jun 2023 19:17:44 -0400 Subject: [Git][ghc/ghc][wip/int-index/decl-invis-binders] Invisible binders in type declarations (#22560) Message-ID: <647bca18b3055_1d329d7acc3749791d@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/decl-invis-binders at Glasgow Haskell Compiler / GHC Commits: 325cb566 by Vladislav Zavialov at 2023-06-04T01:15:54+02: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: - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Quote.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/Splice.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Zonk/TcType.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/Language/Haskell/Syntax/Type.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/exts/primitives.rst - docs/users_guide/exts/type_abstractions.rst - libraries/ghci/GHCi/TH/Binary.hs - libraries/template-haskell/Language/Haskell/TH.hs - libraries/template-haskell/Language/Haskell/TH/Lib.hs - libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs - libraries/template-haskell/Language/Haskell/TH/Ppr.hs - 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/-/commit/325cb5662da144d2eec9980fa90f7762d3fd2f57 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/325cb5662da144d2eec9980fa90f7762d3fd2f57 You're receiving 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 Jun 4 05:46:57 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Sun, 04 Jun 2023 01:46:57 -0400 Subject: [Git][ghc/ghc][wip/int-index/decl-invis-binders] Invisible binders in type declarations (#22560) Message-ID: <647c2551731bb_1d329d7acc2fc1133d0@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/decl-invis-binders at Glasgow Haskell Compiler / GHC Commits: c403d849 by Vladislav Zavialov at 2023-06-04T07:45:28+02: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: - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Quote.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/Splice.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Zonk/TcType.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/Language/Haskell/Syntax/Type.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/exts/primitives.rst - docs/users_guide/exts/type_abstractions.rst - libraries/ghci/GHCi/TH/Binary.hs - libraries/template-haskell/Language/Haskell/TH.hs - libraries/template-haskell/Language/Haskell/TH/Lib.hs - libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs - libraries/template-haskell/Language/Haskell/TH/Ppr.hs - 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/-/commit/c403d849450b9f3275cf3cc23ecf655aacdbcf51 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c403d849450b9f3275cf3cc23ecf655aacdbcf51 You're receiving 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 Jun 4 09:31:28 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Sun, 04 Jun 2023 05:31:28 -0400 Subject: [Git][ghc/ghc][wip/T20138] CSE: Combine identical LitAlts Message-ID: <647c59f0d5443_1d329d790e6e011859@gitlab.mail> Sebastian Graf pushed to branch wip/T20138 at Glasgow Haskell Compiler / GHC Commits: 8072fe6d by Sebastian Graf at 2023-06-04T11:19:11+02:00 CSE: Combine identical LitAlts - - - - - 4 changed files: - compiler/GHC/Core/Opt/CSE.hs - + testsuite/tests/simplCore/should_compile/T20138.hs - + testsuite/tests/simplCore/should_compile/T20138.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/CSE.hs ===================================== @@ -17,7 +17,7 @@ import GHC.Types.Id ( Id, idType, idHasRules, zapStableUnfolding , isJoinId, isJoinId_maybe, idUnfolding ) import GHC.Core.Utils ( mkAltExpr , exprIsTickedString - , stripTicksE, stripTicksT, mkTicks ) + , stripTicksE, stripTicksT, mkTicks, exprIsTrivial ) import GHC.Core.FVs ( exprFreeVars ) import GHC.Core.Type ( tyConAppArgs ) import GHC.Core @@ -702,7 +702,7 @@ cseExpr :: CSEnv -> InExpr -> OutExpr cseExpr env (Type t) = Type (substTyUnchecked (csEnvSubst env) t) cseExpr env (Coercion c) = Coercion (substCo (csEnvSubst env) c) cseExpr _ (Lit lit) = Lit lit -cseExpr env (Var v) = lookupSubst env v +cseExpr env (Var v) = cseVar env v cseExpr env (App f a) = App (cseExpr env f) (tryForCSE env a) cseExpr env (Tick t e) = Tick t (cseExpr env e) cseExpr env (Cast e co) = Cast (tryForCSE env e) (substCo (csEnvSubst env) co) @@ -712,6 +712,16 @@ cseExpr env (Let bind e) = let (env', bind') = cseBind NotTopLevel env in Let bind' (cseExpr env' e) cseExpr env (Case e bndr ty alts) = cseCase env e bndr ty alts +cseVar :: CSEnv -> InVar -> OutExpr +cseVar env v + | isId v, let unf = idUnfolding v + , Just tmpl <- maybeUnfoldingTemplate unf + , let e = tryForCSE env tmpl + , exprIsTrivial e + = e + | otherwise + = lookupSubst env v + cseCase :: CSEnv -> InExpr -> InId -> InType -> [InAlt] -> OutExpr cseCase env scrut bndr ty alts = Case scrut1 bndr3 ty' $ @@ -735,17 +745,14 @@ cseCase env scrut bndr ty alts arg_tys = tyConAppArgs (idType bndr3) -- See Note [CSE for case alternatives] - cse_alt (Alt (DataAlt con) args rhs) - = Alt (DataAlt con) args' (tryForCSE new_env rhs) - where - (env', args') = addBinders alt_env args - new_env = extendCSEnv env' con_expr con_target - con_expr = mkAltExpr (DataAlt con) args' arg_tys - - cse_alt (Alt con args rhs) - = Alt con args' (tryForCSE env' rhs) + cse_alt (Alt alt_con args rhs) + = Alt alt_con args' (tryForCSE new_env rhs) where (env', args') = addBinders alt_env args + new_env + | DEFAULT <- alt_con = alt_env + | otherwise = extendCSEnv env' con_expr con_target + con_expr = mkAltExpr alt_con args' arg_tys combineAlts :: [OutAlt] -> [OutAlt] -- See Note [Combine case alternatives] ===================================== testsuite/tests/simplCore/should_compile/T20138.hs ===================================== @@ -0,0 +1,22 @@ +module T20138 where + +f :: Int -> Int +f n = case n of + 2 -> n + n -> n + +g :: Int -> Int +g n = case n of + 2 -> 2 + n -> n + +h :: Int -> Int +h n = case n of + 2 -> maxBound + n -> n + +data O = O !Ordering + +k :: O -> O +k (O LT) = O LT +k (O o) = O o ===================================== testsuite/tests/simplCore/should_compile/T20138.stderr ===================================== @@ -0,0 +1,118 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 85, types: 37, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 6, types: 2, coercions: 0, joins: 0/0} +T20138.$WO :: Ordering %1 -> O +T20138.$WO + = \ (conrep :: Ordering) -> + case conrep of conrep1 { __DEFAULT -> T20138.O conrep1 } + +-- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0} +f :: Int -> Int +f = \ (n :: Int) -> n + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T20138.g1 :: Int +T20138.g1 = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0} +g :: Int -> Int +g = \ (n :: Int) -> n + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T20138.k1 :: O +T20138.k1 = T20138.O GHC.Types.LT + +-- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0} +k :: O -> O +k = \ (ds :: O) -> ds + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T20138.$trModule4 :: GHC.Prim.Addr# +T20138.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T20138.$trModule3 :: GHC.Types.TrName +T20138.$trModule3 = GHC.Types.TrNameS T20138.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T20138.$trModule2 :: GHC.Prim.Addr# +T20138.$trModule2 = "T20138"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T20138.$trModule1 :: GHC.Types.TrName +T20138.$trModule1 = GHC.Types.TrNameS T20138.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T20138.$trModule :: GHC.Types.Module +T20138.$trModule + = GHC.Types.Module T20138.$trModule3 T20138.$trModule1 + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep :: GHC.Types.KindRep +$krep + = GHC.Types.KindRepTyConApp + GHC.Types.$tcOrdering (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T20138.$tcO2 :: GHC.Prim.Addr# +T20138.$tcO2 = "O"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T20138.$tcO1 :: GHC.Types.TrName +T20138.$tcO1 = GHC.Types.TrNameS T20138.$tcO2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T20138.$tcO :: GHC.Types.TyCon +T20138.$tcO + = GHC.Types.TyCon + 1145581556550476387#Word64 + 1434093014026668163#Word64 + T20138.$trModule + T20138.$tcO1 + 0# + GHC.Types.krep$* + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep1 :: GHC.Types.KindRep +$krep1 + = GHC.Types.KindRepTyConApp + T20138.$tcO (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T20138.$tc'O1 :: GHC.Types.KindRep +T20138.$tc'O1 = GHC.Types.KindRepFun $krep $krep1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T20138.$tc'O3 :: GHC.Prim.Addr# +T20138.$tc'O3 = "'O"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T20138.$tc'O2 :: GHC.Types.TrName +T20138.$tc'O2 = GHC.Types.TrNameS T20138.$tc'O3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T20138.$tc'O :: GHC.Types.TyCon +T20138.$tc'O + = GHC.Types.TyCon + 12109796057866694799#Word64 + 5332816606609293872#Word64 + T20138.$trModule + T20138.$tc'O2 + 0# + T20138.$tc'O1 + +-- RHS size: {terms: 10, types: 4, coercions: 0, joins: 0/0} +h :: Int -> Int +h = \ (n :: Int) -> + case n of wild { GHC.Types.I# ds -> + case ds of { + __DEFAULT -> wild; + 2# -> GHC.Base.maxInt + } + } + + + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -368,6 +368,7 @@ test('T19780', normal, compile, ['-O2']) test('T19794', normal, compile, ['-O']) test('T19890', [ grep_errmsg(r'= T19890.foo1') ], compile, ['-O -ddump-simpl']) test('T20125', [ grep_errmsg(r'= T20125.MkT') ], compile, ['-O -ddump-simpl -dsuppress-uniques']) +test('T20138', [ grep_errmsg(r'(^g|^k|maxInt)') ], compile, ['-O -ddump-simpl -dsuppress-uniques -dsuppress-idinfo']) test('T20143', [ grep_errmsg(r'unsafeEqualityProof') ], compile, ['-O -ddump-simpl -dsuppress-uniques']) test('T20174', normal, compile, ['']) test('T16373', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8072fe6ddc9996dd0dab61c3392c1b1d81d6a713 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8072fe6ddc9996dd0dab61c3392c1b1d81d6a713 You're receiving 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 Jun 4 19:59:15 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Sun, 04 Jun 2023 15:59:15 -0400 Subject: [Git][ghc/ghc][wip/T20138] 3 commits: CSE: Combine identical LitAlts Message-ID: <647ced1329318_1d329d73eb4241716e5@gitlab.mail> Sebastian Graf pushed to branch wip/T20138 at Glasgow Haskell Compiler / GHC Commits: 0d0a9023 by Sebastian Graf at 2023-06-04T20:18:45+02:00 CSE: Combine identical LitAlts - - - - - d58369da by Sebastian Graf at 2023-06-04T21:58:52+02:00 Revert the changes to CSE - - - - - b2312393 by Sebastian Graf at 2023-06-04T21:59:00+02:00 Improve the Simplifier instead - - - - - 5 changed files: - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Utils.hs - + testsuite/tests/simplCore/should_compile/T20138.hs - + testsuite/tests/simplCore/should_compile/T20138.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -2300,7 +2300,7 @@ prepareAlts scrut case_bndr alts -- The multiplicity on case_bndr's is the multiplicity of the -- case expression The newly introduced patterns in -- refineDefaultAlt must be scaled by this multiplicity - (yes3, idcs3, alts3) = combineIdenticalAlts idcs1 alts2 + (yes3, idcs3, alts3) = combineIdenticalAlts scrut case_bndr idcs1 alts2 -- "idcs" stands for "impossible default data constructors" -- i.e. the constructors that can't match the default case ; when yes2 $ tick (FillInCaseDefault case_bndr) ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -109,7 +109,7 @@ import GHC.Utils.Misc import Data.ByteString ( ByteString ) import Data.Function ( on ) -import Data.List ( sort, sortBy, partition, zipWith4, mapAccumL ) +import Data.List ( sort, sortBy, partition, zipWith4, mapAccumL, (\\) ) import Data.Ord ( comparing ) import qualified Data.Set as Set import GHC.Types.RepType (isZeroBitTy) @@ -952,14 +952,16 @@ missed the first one.) -} -combineIdenticalAlts :: [AltCon] -- Constructors that cannot match DEFAULT +combineIdenticalAlts :: CoreExpr -- Scrutinee + -> Id -- Case binder + -> [AltCon] -- Constructors that cannot match DEFAULT -> [CoreAlt] -> (Bool, -- True <=> something happened [AltCon], -- New constructors that cannot match DEFAULT [CoreAlt]) -- New alternatives -- See Note [Combine identical alternatives] -- True <=> we did some combining, result is a single DEFAULT alternative -combineIdenticalAlts imposs_deflt_cons (Alt con1 bndrs1 rhs1 : rest_alts) +combineIdenticalAlts scrut case_bndr imposs_deflt_cons (Alt con1 bndrs1 rhs1 : rest_alts) | all isDeadBinder bndrs1 -- Remember the default , not (null elim_rest) -- alternative comes first = (True, imposs_deflt_cons', deflt_alt : filtered_rest) @@ -974,12 +976,18 @@ combineIdenticalAlts imposs_deflt_cons (Alt con1 bndrs1 rhs1 : rest_alts) DEFAULT -> [] _ -> [con1] - cheapEqTicked e1 e2 = cheapEqExpr' tickishFloatable e1 e2 - identical_to_alt1 (Alt _con bndrs rhs) - = all isDeadBinder bndrs && rhs `cheapEqTicked` rhs1 + + identical_to_alt1 (Alt con bndrs rhs) + = all isDeadBinder bndrs && cheapEqAlts unfs rhs rhs1 + where + unfs + | DEFAULT <- con = emptyVarEnv + | otherwise = mkVarEnv [ (v,mkAltExpr con bndrs arg_tys) | v <- subst_bndrs ] + subst_bndrs = (case_bndr : [ scrut_var | Var scrut_var <- [scrut] ]) Data.List.\\ bndrs1 + arg_tys = tyConAppArgs (idType case_bndr) tickss = map (\(Alt _ _ rhs) -> stripTicksT tickishFloatable rhs) elim_rest -combineIdenticalAlts imposs_cons alts +combineIdenticalAlts _ _ imposs_cons alts = (False, imposs_cons, alts) -- Scales the multiplicity of the binders of a list of case alternatives. That @@ -993,6 +1001,36 @@ scaleAltsBy w alts = map scaleAlt alts scaleBndr :: CoreBndr -> CoreBndr scaleBndr b = scaleVarBy w b +-- | Cheap expression equality test comparing to the (soon to be) DEFAULT RHS. +-- The IdEnv contains unfoldings to be applied in the DEFAULT RHS that express +-- local equalities that hold in the RHS we try to equate to +cheapEqAlts :: IdEnv CoreExpr -> CoreExpr -> CoreExpr -> Bool +cheapEqAlts unf_env rhs default_rhs + = go rhs default_rhs + where + go (Var v1) (Var v2) = v1 == v2 + go e1 (Var v2) + | Just unf <- lookupVarEnv unf_env v2 -- only need to expand the case binder in the DEFAULT alt + = go e1 unf + | Just unf <- get_unf v2 = go e1 unf + go (Var v1) e2 + | Just unf <- get_unf v1 = go unf e2 + + go (Lit lit1) (Lit lit2) = lit1 == lit2 + go (Type t1) (Type t2) = t1 `eqType` t2 + go (Coercion c1) (Coercion c2) = c1 `eqCoercion` c2 + go (App f1 a1) (App f2 a2) = f1 `go` f2 && a1 `go` a2 + go (Cast e1 t1) (Cast e2 t2) = e1 `go` e2 && t1 `eqCoercion` t2 + + go (Tick t1 e1) e2 | tickishFloatable t1 = go e1 e2 + go e1 (Tick t2 e2) | tickishFloatable t2 = go e1 e2 + go (Tick t1 e1) (Tick t2 e2) = t1 == t2 && e1 `go` e2 + + go _ _ = False + + get_unf :: Var -> Maybe CoreExpr + get_unf v | isId v = expandUnfolding_maybe (idUnfolding v) + | otherwise = Nothing {- ********************************************************************* * * ===================================== testsuite/tests/simplCore/should_compile/T20138.hs ===================================== @@ -0,0 +1,22 @@ +module T20138 where + +f :: Int -> Int +f n = case n of + 2 -> n + n -> n + +g :: Int -> Int +g n = case n of + 2 -> 2 + n -> n + +h :: Int -> Int +h n = case n of + 2 -> maxBound + n -> n + +data O = O !Ordering + +k :: O -> O +k (O LT) = O LT +k (O o) = O o ===================================== testsuite/tests/simplCore/should_compile/T20138.stderr ===================================== @@ -0,0 +1,118 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 85, types: 37, coercions: 0, joins: 0/0} + +-- RHS size: {terms: 6, types: 2, coercions: 0, joins: 0/0} +T20138.$WO :: Ordering %1 -> O +T20138.$WO + = \ (conrep :: Ordering) -> + case conrep of conrep1 { __DEFAULT -> T20138.O conrep1 } + +-- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0} +f :: Int -> Int +f = \ (n :: Int) -> n + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T20138.g1 :: Int +T20138.g1 = GHC.Types.I# 2# + +-- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0} +g :: Int -> Int +g = \ (n :: Int) -> n + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T20138.k1 :: O +T20138.k1 = T20138.O GHC.Types.LT + +-- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0} +k :: O -> O +k = \ (ds :: O) -> ds + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T20138.$trModule4 :: GHC.Prim.Addr# +T20138.$trModule4 = "main"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T20138.$trModule3 :: GHC.Types.TrName +T20138.$trModule3 = GHC.Types.TrNameS T20138.$trModule4 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T20138.$trModule2 :: GHC.Prim.Addr# +T20138.$trModule2 = "T20138"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T20138.$trModule1 :: GHC.Types.TrName +T20138.$trModule1 = GHC.Types.TrNameS T20138.$trModule2 + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T20138.$trModule :: GHC.Types.Module +T20138.$trModule + = GHC.Types.Module T20138.$trModule3 T20138.$trModule1 + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep :: GHC.Types.KindRep +$krep + = GHC.Types.KindRepTyConApp + GHC.Types.$tcOrdering (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T20138.$tcO2 :: GHC.Prim.Addr# +T20138.$tcO2 = "O"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T20138.$tcO1 :: GHC.Types.TrName +T20138.$tcO1 = GHC.Types.TrNameS T20138.$tcO2 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T20138.$tcO :: GHC.Types.TyCon +T20138.$tcO + = GHC.Types.TyCon + 1145581556550476387#Word64 + 1434093014026668163#Word64 + T20138.$trModule + T20138.$tcO1 + 0# + GHC.Types.krep$* + +-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} +$krep1 :: GHC.Types.KindRep +$krep1 + = GHC.Types.KindRepTyConApp + T20138.$tcO (GHC.Types.[] @GHC.Types.KindRep) + +-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} +T20138.$tc'O1 :: GHC.Types.KindRep +T20138.$tc'O1 = GHC.Types.KindRepFun $krep $krep1 + +-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} +T20138.$tc'O3 :: GHC.Prim.Addr# +T20138.$tc'O3 = "'O"# + +-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} +T20138.$tc'O2 :: GHC.Types.TrName +T20138.$tc'O2 = GHC.Types.TrNameS T20138.$tc'O3 + +-- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} +T20138.$tc'O :: GHC.Types.TyCon +T20138.$tc'O + = GHC.Types.TyCon + 12109796057866694799#Word64 + 5332816606609293872#Word64 + T20138.$trModule + T20138.$tc'O2 + 0# + T20138.$tc'O1 + +-- RHS size: {terms: 10, types: 4, coercions: 0, joins: 0/0} +h :: Int -> Int +h = \ (n :: Int) -> + case n of wild { GHC.Types.I# ds -> + case ds of { + __DEFAULT -> wild; + 2# -> GHC.Base.maxInt + } + } + + + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -368,6 +368,7 @@ test('T19780', normal, compile, ['-O2']) test('T19794', normal, compile, ['-O']) test('T19890', [ grep_errmsg(r'= T19890.foo1') ], compile, ['-O -ddump-simpl']) test('T20125', [ grep_errmsg(r'= T20125.MkT') ], compile, ['-O -ddump-simpl -dsuppress-uniques']) +test('T20138', [ grep_errmsg(r'(^g|^k|maxInt)') ], compile, ['-O -ddump-simpl -dsuppress-uniques -dsuppress-idinfo']) test('T20143', [ grep_errmsg(r'unsafeEqualityProof') ], compile, ['-O -ddump-simpl -dsuppress-uniques']) test('T20174', normal, compile, ['']) test('T16373', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8072fe6ddc9996dd0dab61c3392c1b1d81d6a713...b23123936ae3b935c2ae097ecabc79abe11153e4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8072fe6ddc9996dd0dab61c3392c1b1d81d6a713...b23123936ae3b935c2ae097ecabc79abe11153e4 You're receiving 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 Jun 5 07:59:58 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 05 Jun 2023 03:59:58 -0400 Subject: [Git][ghc/ghc][wip/tc-lcl-env-refactor] 12 commits: base: Add build-order import of GHC.Types in GHC.IO.Handle.Types Message-ID: <647d95fe17b7c_1d329d27191f3c2222b3@gitlab.mail> Matthew Pickering pushed to branch wip/tc-lcl-env-refactor at Glasgow Haskell Compiler / GHC Commits: 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 2382313d by Matthew Pickering at 2023-06-05T07:59:53+00:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 7823bb3f by Matthew Pickering at 2023-06-05T07:59:53+00:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - cc08424a by Matthew Pickering at 2023-06-05T07:59:53+00:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - e5a154fc by Matthew Pickering at 2023-06-05T07:59:53+00:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - 7fa5a237 by Matthew Pickering at 2023-06-05T07:59:53+00:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 45c68176 by Matthew Pickering at 2023-06-05T07:59:53+00:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - fb457141 by Matthew Pickering at 2023-06-05T07:59:53+00:00 Remove unecessary SOURCE import - - - - - 88887ea9 by Matthew Pickering at 2023-06-05T07:59:53+00:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 30 changed files: - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/JS/Make.hs - compiler/GHC/JS/Ppr.hs - compiler/GHC/Plugins.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Closure.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Linker/Opt.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Hole/FitTypes.hs - − compiler/GHC/Tc/Errors/Hole/FitTypes.hs-boot - + compiler/GHC/Tc/Errors/Hole/Plugin.hs - + compiler/GHC/Tc/Errors/Hole/Plugin.hs-boot - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - + compiler/GHC/Tc/Errors/Types/PromotionErr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/46d1de4824bfcc9d8ab1ca6396fd097554eab7e9...88887ea9e52aa10ab3f53dd6b8c5a30a70eab207 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/46d1de4824bfcc9d8ab1ca6396fd097554eab7e9...88887ea9e52aa10ab3f53dd6b8c5a30a70eab207 You're receiving 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 Jun 5 08:23:48 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 05 Jun 2023 04:23:48 -0400 Subject: [Git][ghc/ghc][wip/T22010] Fix dominators and uniqsupply Message-ID: <647d9b94ca9e8_1d329d1e16e72022624@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: d87fe61f by Jaro Reinders at 2023-06-05T10:23:36+02:00 Fix dominators and uniqsupply - - - - - 2 changed files: - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/Types/Unique/Supply.hs Changes: ===================================== compiler/GHC/CmmToAsm/CFG/Dominators.hs ===================================== @@ -500,8 +500,10 @@ asGraph t@(Node a _) = let g = go t in (a, fromAdj g) asTree :: Rooted -> Tree Word64 asTree (r,g) = let go a = Node a (fmap go ((WS.toList . f) a)) - f = (g WM.!) + f = (g !) in go r + where (!) g n = maybe mempty id (WM.lookup n g) + reachable :: (Word64 -> Word64Set) -> (Word64 -> Word64Set) reachable f a = go (WS.singleton a) a ===================================== compiler/GHC/Types/Unique/Supply.hs ===================================== @@ -43,15 +43,14 @@ import Data.Char import Data.Word import GHC.Exts( Ptr(..), noDuplicate#, oneShot ) import Foreign.Storable -import GHC.Word (Word64(..)) #include "MachDeps.h" #if MIN_VERSION_GLASGOW_HASKELL(9,1,0,0) -#if WORD_SIZE_IN_BITS < 64 -import GHC.Exts( fetchAddWord64Addr#, plusWord64#, readWord64OffAddr# ) -#else +import GHC.Word( Word64(..) ) import GHC.Exts( fetchAddWordAddr#, plusWord#, readWordOffAddr# ) +#if MIN_VERSION_GLASGOW_HASKELL(9,4,0,0) && WORD_SIZE_IN_BITS == 64 +import GHC.Exts( wordToWord64# ) #endif #endif @@ -230,7 +229,7 @@ mkSplitUniqSupply c (# s4, MkSplitUniqSupply (mask .|. u) x y #) }}}} -#if !MIN_VERSION_GLASGOW_HASKELL(9,1,0,0) +#if !MIN_VERSION_GLASGOW_HASKELL(9,1,0,0) || WORD_SIZE_IN_BITS != 64 foreign import ccall unsafe "genSym" genSym :: IO Word64 #else genSym :: IO Word64 @@ -238,16 +237,13 @@ genSym = do let !mask = (1 `unsafeShiftL` uNIQUE_BITS) - 1 let !(Ptr counter) = ghc_unique_counter let !(Ptr inc_ptr) = ghc_unique_inc -#if WORD_SIZE_IN_BITS < 64 - u <- IO $ \s0 -> case readWord64OffAddr# inc_ptr 0# s0 of - (# s1, inc #) -> case fetchAddWord64Addr# counter inc s1 of - (# s2, val #) -> - let !u = W64# (val `plusWord64#` inc) .&. mask -#else u <- IO $ \s0 -> case readWordOffAddr# inc_ptr 0# s0 of (# s1, inc #) -> case fetchAddWordAddr# counter inc s1 of (# s2, val #) -> +#if !MIN_VERSION_GLASGOW_HASKELL(9,3,0,0) let !u = W64# (val `plusWord#` inc) .&. mask +#else + let !u = W64# (wordToWord64# (val `plusWord#` inc)) .&. mask #endif in (# s2, u #) #if defined(DEBUG) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d87fe61fc42ad227bb0d74016364e215d4966deb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d87fe61fc42ad227bb0d74016364e215d4966deb You're receiving 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 Jun 5 09:03:06 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 05 Jun 2023 05:03:06 -0400 Subject: [Git][ghc/ghc][wip/T22010] Remove broken fetchAddWord64Addr Message-ID: <647da4cadc297_1d329d7acc37423052f@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 0ee19a05 by Jaro Reinders at 2023-06-05T11:02:52+02:00 Remove broken fetchAddWord64Addr - - - - - 4 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Prim.hs - rts/RtsSymbols.c Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -2576,14 +2576,6 @@ primop FetchAddAddrOp_Word "fetchAddWordAddr#" GenPrimOp with has_side_effects = True can_fail = True -primop FetchAddAddrOp_Word64 "fetchAddWord64Addr#" GenPrimOp - Addr# -> Word64# -> State# s -> (# State# s, Word64# #) - {Given an address, and a value to add, - atomically add the value to the element. Returns the value of the - element before the operation. Implies a full memory barrier.} - with has_side_effects = True - can_fail = True - primop FetchSubAddrOp_Word "fetchSubWordAddr#" GenPrimOp Addr# -> Word# -> State# s -> (# State# s, Word# #) {Given an address, and a value to subtract, ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -821,8 +821,6 @@ emitPrimOp cfg primop = FetchAddAddrOp_Word -> \[addr, n] -> opIntoRegs $ \[res] -> doAtomicAddrRMW res AMO_Add addr (bWord platform) n - FetchAddAddrOp_Word64 -> \[addr, n] -> opIntoRegs $ \[res] -> - doAtomicAddrRMW res AMO_Add addr b64 n FetchSubAddrOp_Word -> \[addr, n] -> opIntoRegs $ \[res] -> doAtomicAddrRMW res AMO_Sub addr (bWord platform) n FetchAndAddrOp_Word -> \[addr, n] -> opIntoRegs $ \[res] -> ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -1043,8 +1043,6 @@ genPrim prof bound ty op = case op of CasAddrOp_Word64 -> \[rh,rl] [a,o,oh,ol,nh,nl] -> PrimInline $ casOp2 read_u64 write_u64 (rh,rl) a o (oh,ol) (nh,nl) FetchAddAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Add r a o v - -- TODO: - -- FetchAddAddrOp_Word64 -> \[rh,rl] [a,i,oh,ol,nh,nl] -> PrimInline $ appT [rh,rl] "h$hs_fetchAddWord64Addr" [a,i,oh,ol,nh,nl] FetchSubAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr Sub r a o v FetchAndAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr BAnd r a o v FetchNandAddrOp_Word -> \[r] [a,o,v] -> PrimInline $ fetchOpAddr ((BNot .) . BAnd) r a o v ===================================== rts/RtsSymbols.c ===================================== @@ -902,6 +902,7 @@ extern char **environ; SymI_HasProto(stopHeapProfTimer) \ SymI_HasProto(requestHeapCensus) \ SymI_HasProto(atomic_inc) \ + SymI_HasProto(atomic_inc64) \ SymI_HasProto(atomic_dec) \ SymI_HasProto(hs_spt_lookup) \ SymI_HasProto(hs_spt_insert) \ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0ee19a050094e6baf8399646cfcd1f81032c24f3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0ee19a050094e6baf8399646cfcd1f81032c24f3 You're receiving 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 Jun 5 09:05:00 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 05 Jun 2023 05:05:00 -0400 Subject: [Git][ghc/ghc][wip/T22010] Remove redundant imports Message-ID: <647da53cc3f9a_1d329d30235c78231115@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 7299fad1 by Jaro Reinders at 2023-06-05T11:04:54+02:00 Remove redundant imports - - - - - 2 changed files: - compiler/GHC/Data/FastMutInt.hs - compiler/GHC/Driver/Make.hs Changes: ===================================== compiler/GHC/Data/FastMutInt.hs ===================================== @@ -16,7 +16,6 @@ module GHC.Data.FastMutInt( import GHC.Prelude.Basic import GHC.Base -import GHC.Word data FastMutInt = FastMutInt !(MutableByteArray# RealWorld) ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -155,7 +155,6 @@ import GHC.Types.Unique.DFM (udfmRestrictKeysSet) import GHC.Types.Unique import GHC.Iface.Errors.Types -import qualified Data.IntSet as I import qualified GHC.Data.Word64Set as W -- ----------------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7299fad14b3475010b61d43dac88554320b578bb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7299fad14b3475010b61d43dac88554320b578bb You're receiving 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 Jun 5 09:29:07 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 05 Jun 2023 05:29:07 -0400 Subject: [Git][ghc/ghc][wip/T22010] Remove more redundant imports Message-ID: <647daae3a9aa0_1d329d7acc2fc23324e@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 1d10a68e by Jaro Reinders at 2023-06-05T11:28:59+02:00 Remove more redundant imports - - - - - 2 changed files: - compiler/GHC/Data/FastString.hs - compiler/GHC/Types/Var.hs Changes: ===================================== compiler/GHC/Data/FastString.hs ===================================== @@ -150,7 +150,6 @@ import GHC.Conc.Sync (sharedCAF) import GHC.Base (unpackCString#,unpackNBytes#) #endif import GHC.Exts -import GHC.Word import GHC.IO -- | Gives the Modified UTF-8 encoded bytes corresponding to a 'FastString' ===================================== compiler/GHC/Types/Var.hs ===================================== @@ -117,7 +117,7 @@ import {-# SOURCE #-} GHC.Types.Id.Info( IdDetails, IdInfo, coVarDetails, isCo import {-# SOURCE #-} GHC.Builtin.Types ( manyDataConTy ) import GHC.Types.Name hiding (varName) import GHC.Types.Unique ( Uniquable, Unique, getKey, getUnique - , mkUniqueGrimily, nonDetCmpUnique ) + , nonDetCmpUnique ) import GHC.Types.Basic( TypeOrConstraint(..) ) import GHC.Utils.Misc import GHC.Utils.Binary View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1d10a68ee35862ea85a7e0e836bfdc3034923144 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1d10a68ee35862ea85a7e0e836bfdc3034923144 You're receiving 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 Jun 5 09:52:30 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 05 Jun 2023 05:52:30 -0400 Subject: [Git][ghc/ghc][wip/T22010] Fix even more redundant imports Message-ID: <647db05ed58e8_1d329d7acc2fc23407e@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 221eef28 by Jaro Reinders at 2023-06-05T11:52:21+02:00 Fix even more redundant imports - - - - - 6 changed files: - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/Types/Var/Env.hs Changes: ===================================== compiler/GHC/Cmm/Dominators.hs ===================================== @@ -26,8 +26,6 @@ import Data.Array.IArray import Data.Foldable() import qualified Data.Tree as Tree -import qualified Data.IntMap.Strict as IM -import qualified Data.IntSet as IS import Data.Word import qualified GHC.CmmToAsm.CFG.Dominators as LT ===================================== compiler/GHC/Cmm/Sink.hs ===================================== @@ -21,7 +21,6 @@ import GHC.Platform.Regs import GHC.Platform import GHC.Types.Unique.FM -import qualified Data.IntSet as IntSet import qualified GHC.Data.Word64Set as Word64Set import Data.List (partition) import Data.Maybe ===================================== compiler/GHC/CmmToAsm/Wasm/Asm.hs ===================================== @@ -14,7 +14,6 @@ import qualified Data.ByteString as BS import Data.ByteString.Builder import Data.Coerce import Data.Foldable -import qualified Data.IntSet as IS import qualified GHC.Data.Word64Set as WS import Data.Maybe import Data.Semigroup ===================================== compiler/GHC/CmmToAsm/Wasm/FromCmm.hs ===================================== @@ -26,7 +26,6 @@ import Control.Monad import qualified Data.ByteString as BS import Data.Foldable import Data.Functor -import qualified Data.IntSet as IS import qualified GHC.Data.Word64Set as WS import Data.Semigroup import Data.String ===================================== compiler/GHC/CmmToAsm/Wasm/Types.hs ===================================== @@ -52,7 +52,6 @@ import Control.Applicative import Data.ByteString (ByteString) import Data.Coerce import Data.Functor -import qualified Data.IntSet as IS import qualified GHC.Data.Word64Set as WS import Data.Kind import Data.String ===================================== compiler/GHC/Types/Var/Env.hs ===================================== @@ -78,7 +78,6 @@ module GHC.Types.Var.Env ( ) where import GHC.Prelude -import qualified Data.IntMap.Strict as IntMap -- TODO: Move this to UniqFM import qualified GHC.Data.Word64Map.Strict as Word64Map -- TODO: Move this to UniqFM import GHC.Types.Name.Occurrence View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/221eef2810fc94715f6716d8293c7af4f8062f09 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/221eef2810fc94715f6716d8293c7af4f8062f09 You're receiving 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 Jun 5 10:38:32 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Mon, 05 Jun 2023 06:38:32 -0400 Subject: [Git][ghc/ghc][wip/or-pats] Play around with Match Message-ID: <647dbb28e79b_1d329d790e70824242b@gitlab.mail> David pushed to branch wip/or-pats at Glasgow Haskell Compiler / GHC Commits: 5cf5a428 by David Knothe at 2023-06-05T12:38:24+02:00 Play around with Match - - - - - 3 changed files: - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match.hs-boot - compiler/GHC/HsToCore/Match/Literal.hs Changes: ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -21,13 +21,15 @@ module GHC.HsToCore.Match ) where +import GHC.Stack import GHC.Prelude import GHC.Platform import Language.Haskell.Syntax.Basic (Boxity(..)) import {-#SOURCE#-} GHC.HsToCore.Expr (dsExpr) - +import Data.List (intercalate) +import Debug.Trace import GHC.Types.Basic ( Origin(..), isGenerated ) import GHC.Types.SourceText import GHC.Driver.DynFlags @@ -178,9 +180,20 @@ with External names (#13043). See also Note [Localise pattern binders] in GHC.HsToCore.Utils -} +-- input: equationInfo +-- output: do call to `match` (recursing into matchNew) but group the first var beforehand +-- for the call to match, construct a EqnInfo with only a single pattern and put the recursive call into the eqn_rhs. + +--matchNew :: [MatchId] +-- -> Type +-- -> [EquationInfo] +-- -> Dsm (MatchResult CoreExpr) + + + type MatchId = Id -- See Note [Match Ids] -match :: [MatchId] -- ^ Variables rep\'ing the exprs we\'re matching with +match :: HasCallStack => [MatchId] -- ^ Variables rep\'ing the exprs we\'re matching with -- ^ See Note [Match Ids] -- -- ^ Note that the Match Ids carry not only a name, but @@ -204,14 +217,22 @@ match (v:vs) ty eqns -- Eqns *can* be empty ; let platform = targetPlatform dflags -- Tidy the first pattern, generating -- auxiliary bindings if necessary + -- ; traceM ("tidy " ++ show (length eqns) ++ " " ++ (show . length . eqn_pats . head) eqns) ; (aux_binds, tidy_eqns) <- mapAndUnzipM (tidyEqnInfo v) eqns -- Group the equations and match each group in turn ; let grouped = groupEquations platform tidy_eqns + ; grouped' <- mapM (moveGroupVarsIntoRhs vs ty) grouped + + ; traceM ("Before moving: " ++ show (length grouped) ++ " groups:") + ; testPrint grouped + ; traceM ("After moving: " ++ show (length grouped') ++ " groups:") + ; testPrint grouped' + ; traceM "" -- print the view patterns that are commoned up to help debug - ; whenDOptM Opt_D_dump_view_pattern_commoning (debug grouped) + ; whenDOptM Opt_D_dump_view_pattern_commoning (debug grouped') - ; match_results <- match_groups grouped + ; match_results <- match_groups grouped' ; return $ foldr (.) id aux_binds <$> foldr1 combineMatchResults match_results } @@ -248,6 +269,15 @@ match (v:vs) ty eqns -- Eqns *can* be empty -- FIXME: we should also warn about view patterns that should be -- commoned up but are not + testPrint :: Applicative f => [NonEmpty (PatGroup, EquationInfo)] -> f () + testPrint groups = + traceM $ intercalate "\n" $ map + (\group -> intercalate " ; " $ map + (\(pg, eqn) -> (show pg ++ " " ++ (intercalate " " $ map (showSDocUnsafe . pprLPat . mklpat) (eqn_pats eqn)))) + (NEL.toList group)) + groups + mklpat pat = L noSrcSpanA pat + -- print some stuff to see what's getting grouped -- use -dppr-debug to see the resolution of overloaded literals debug eqns = @@ -267,10 +297,25 @@ matchEmpty var res_ty mk_seq fail = return $ mkWildCase (Var var) (idScaledType var) res_ty [Alt DEFAULT [] fail] +{- +f 1 2 3 = a +f 1 3 4 = b +f (1|2) 4 5 = c + +Eqn 1 2 3 -> a +Eqn 1 3 4 -> b +Eqn 1 -> $ +Eqn 2 -> $ +where $ = match 4 5 c + +match 1 -> [match {Eqn 2 3 a, Eqn 3 4 b}] +-} + + matchVariables :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) -- Real true variables, just like in matchVar, SLPJ p 94 -- No binding to do: they'll all be wildcards by now (done in tidy) -matchVariables (_ :| vars) ty eqns = match vars ty $ NEL.toList $ shiftEqns eqns +matchVariables _ _ eqns = return (eqn_rhs (NEL.head eqns)) -- match vars ty $ NEL.toList $ shiftEqns eqns matchBangs :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) matchBangs (var :| vars) ty eqns @@ -408,7 +453,29 @@ only these which can be assigned a PatternGroup (see patGroup). -} -tidyEqnInfo :: Id -> EquationInfo +moveGroupVarsIntoRhs :: HasCallStack => [Id] -> Type -> NonEmpty (PatGroup, EquationInfo) -> DsM (NonEmpty (PatGroup, EquationInfo)) +moveGroupVarsIntoRhs vs ty group = do + if (length . eqn_pats . snd . NEL.head) group == 1 + then return group + else do + let rest = NEL.map (\(_, eqn) -> eqn { eqn_pats = tail (eqn_pats eqn) }) group + rhs <- match vs ty (NEL.toList rest) + let (gp, eq) = NEL.head group + return $ NEL.singleton (gp, EqnInfo { eqn_pats = [head (eqn_pats eq)], eqn_orig = eqn_orig eq, eqn_rhs = rhs }) + --return $ NEL.map (\(gp, eqn) -> (gp, eqn { eqn_pats = [head (eqn_pats eqn)], eqn_rhs = combineMatchResults rhs (eqn_rhs eqn) })) group + +{- +moveVarsIntoRhs :: HasCallStack => [Id] -> Type -> EquationInfo -> DsM EquationInfo +moveVarsIntoRhs vs ty eqn + | length (eqn_pats eqn) == 0 = fail "argh" + | length (eqn_pats eqn) == 1 = do pure eqn + | otherwise = do + let eq' = eqn { eqn_pats = tail (eqn_pats eqn) } + rhs <- match vs ty [eq'] + return eqn { eqn_pats = [head (eqn_pats eqn)], eqn_rhs = combineMatchResults rhs (eqn_rhs eqn) } +-} + +tidyEqnInfo :: HasCallStack => Id -> EquationInfo -> DsM (DsWrapper, EquationInfo) -- DsM'd because of internal call to dsLHsBinds -- and mkSelectorBinds. @@ -1004,6 +1071,14 @@ data PatGroup Type -- the Type is the type of p (equivalently, the result type of e) | PgOr -- Or pattern +instance Show PatGroup where + show PgAny = "PgAny" + show (PgCon _) = "PgCon" + show (PgLit _) = "PgLit" + show (PgView _ _) = "PgView" + show PgOr = "PgOr" + show _ = "PgOther" + {- Note [Don't use Literal for PgN] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Previously we had, as PatGroup constructors ===================================== compiler/GHC/HsToCore/Match.hs-boot ===================================== @@ -1,5 +1,6 @@ module GHC.HsToCore.Match where +import GHC.Stack (HasCallStack) import GHC.Prelude import GHC.Types.Var ( Id ) import GHC.Tc.Utils.TcType ( Type ) @@ -8,7 +9,7 @@ import GHC.Core ( CoreExpr ) import GHC.Hs ( LPat, HsMatchContext, MatchGroup, LHsExpr ) import GHC.Hs.Extension ( GhcTc, GhcRn ) -match :: [Id] +match :: HasCallStack => [Id] -> Type -> [EquationInfo] -> DsM (MatchResult CoreExpr) ===================================== compiler/GHC/HsToCore/Match/Literal.hs ===================================== @@ -609,7 +609,7 @@ matchLiterals :: NonEmpty Id -> NonEmpty (NonEmpty EquationInfo) -- ^ All PgLits -> DsM (MatchResult CoreExpr) -matchLiterals (var :| vars) ty sub_groups +matchLiterals (var :| _) ty sub_groups = do { -- Deal with each group ; alts <- mapM match_group sub_groups @@ -625,12 +625,11 @@ matchLiterals (var :| vars) ty sub_groups } where match_group :: NonEmpty EquationInfo -> DsM (Literal, MatchResult CoreExpr) - match_group eqns@(firstEqn :| _) + match_group (firstEqn :| _) = do { dflags <- getDynFlags ; let platform = targetPlatform dflags ; let LitPat _ hs_lit = firstPat firstEqn - ; match_result <- match vars ty (NEL.toList $ shiftEqns eqns) - ; return (hsLitKey platform hs_lit, match_result) } + ; return (hsLitKey platform hs_lit, eqn_rhs firstEqn) } wrap_str_guard :: Id -> (Literal,MatchResult CoreExpr) -> DsM (MatchResult CoreExpr) -- Equality check for string literals View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5cf5a4288751fe9ab6e3450b020c364f3d58ab96 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5cf5a4288751fe9ab6e3450b020c364f3d58ab96 You're receiving 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 Jun 5 10:46:41 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 05 Jun 2023 06:46:41 -0400 Subject: [Git][ghc/ghc][wip/tc-lcl-env-refactor] 8 commits: Big TcLclEnv and CtLoc refactoring Message-ID: <647dbd11f2bd2_1d329d2c6f77882449b@gitlab.mail> Matthew Pickering pushed to branch wip/tc-lcl-env-refactor at Glasgow Haskell Compiler / GHC Commits: 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 30 changed files: - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/Plugins.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Hole/FitTypes.hs - − compiler/GHC/Tc/Errors/Hole/FitTypes.hs-boot - + compiler/GHC/Tc/Errors/Hole/Plugin.hs - + compiler/GHC/Tc/Errors/Hole/Plugin.hs-boot - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - + compiler/GHC/Tc/Errors/Types/PromotionErr.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Solve.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/88887ea9e52aa10ab3f53dd6b8c5a30a70eab207...698d160cb5dec68c0aa27920bbd7f03a312e4760 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/88887ea9e52aa10ab3f53dd6b8c5a30a70eab207...698d160cb5dec68c0aa27920bbd7f03a312e4760 You're receiving 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 Jun 5 11:27:25 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Mon, 05 Jun 2023 07:27:25 -0400 Subject: [Git][ghc/ghc][wip/T23309] 160 commits: base: Export GHC.Conc.Sync.fromThreadId Message-ID: <647dc69db4822_1d329d2c6f77882527bd@gitlab.mail> Ryan Scott pushed to branch wip/T23309 at Glasgow Haskell Compiler / GHC Commits: 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 0cc394b4 by Ryan Scott at 2023-06-05T07:26:47-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 35d7aee2 by Ryan Scott at 2023-06-05T07:26:53-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - 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/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d2013f4dac3890aa67a8ec6b3b9b7999ca61dca8...35d7aee26a52a36f67ac411a8916bfa9883e305b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d2013f4dac3890aa67a8ec6b3b9b7999ca61dca8...35d7aee26a52a36f67ac411a8916bfa9883e305b You're receiving 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 Jun 5 12:09:38 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 05 Jun 2023 08:09:38 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 3 commits: ghc-toolchain: Toolchain Selection Message-ID: <647dd0827aa3a_1d329d30f385382701f0@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 4fbd1e68 by Rodrigo Mesquita at 2023-06-05T11:58:29+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b480f4ab1514ac0a4fc957db199d1a0279. Revert get_arm_isa deletion from 74f03f243d08aa910d39cdd9dadb976e9386283a As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error - - - - - 520fd392 by Rodrigo Mesquita at 2023-06-05T12:05:07+01:00 configure: Revert ripping out of toolchain selection logic - - - - - 0335bea7 by Rodrigo Mesquita at 2023-06-05T13:09:28+01:00 configure: Create toolchain target file - - - - - 30 changed files: - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/SysTools.hs - compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - + default.target.in - distrib/configure.ac.in - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Cc.hs - hadrian/src/Settings/Builders/DeriveConstants.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0867fd34b691ae3dd357bdeb4df956ffe4571162...0335bea7824ed39ec6f42973003f16614c2143d2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0867fd34b691ae3dd357bdeb4df956ffe4571162...0335bea7824ed39ec6f42973003f16614c2143d2 You're receiving 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 Jun 5 12:17:21 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Mon, 05 Jun 2023 08:17:21 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/modern-STV-extension-shuffling] 22 commits: Restructure IPE buffer layout Message-ID: <647dd251ae67d_1d329d30f38538270626@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/modern-STV-extension-shuffling at Glasgow Haskell Compiler / GHC Commits: f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - 22f32ab7 by Andrei Borzenkov at 2023-06-05T16:17:08+04:00 Extension shuffling (#23291) Where introduced 3 new extensions: - PatternSignatures - ExtendedForAllScope - MethodTypeVariables Tasks of ScopedTypeVariables extension were distributed between PatternSignatures, ExtendedForAllScope and MethodTypeVariables according to the proposal. Now ScopedTypeVaribles only implies these three exntesions. Was introduced one new warning option: -Wpattern-signature-binds It warns when pattern signature binds into scope new type variable. For example: f (a :: t) = ... - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/JS/Make.hs - compiler/GHC/JS/Optimizer.hs - compiler/GHC/JS/Ppr.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Unbound.hs - compiler/GHC/Stg/Lint.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Closure.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/StgToJS/Linker/Opt.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Generate.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5dd3c909f87d5e66874da5c1fb8dacd4833bdcc7...22f32ab784c9ed956a6960ffb7502433ec30af7a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5dd3c909f87d5e66874da5c1fb8dacd4833bdcc7...22f32ab784c9ed956a6960ffb7502433ec30af7a You're receiving 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 Jun 5 12:26:22 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 05 Jun 2023 08:26:22 -0400 Subject: [Git][ghc/ghc][wip/T22010] 2 commits: Make GHCi work with 64-bit uniques Message-ID: <647dd46e26c90_1d329d790e7082739ec@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: c962ef3b by Jaro Reinders at 2023-06-05T14:17:37+02:00 Make GHCi work with 64-bit uniques - - - - - 4cea7411 by Jaro Reinders at 2023-06-05T14:26:10+02:00 Remove unused top-level bindings and fix linter errors - - - - - 3 changed files: - compiler/GHC/CmmToAsm/CFG/Dominators.hs - libraries/ghci/GHCi/Run.hs - testsuite/tests/linters/notes.stdout Changes: ===================================== compiler/GHC/CmmToAsm/CFG/Dominators.hs ===================================== @@ -131,7 +131,6 @@ rpddfs = concat . levels . pdomTree ----------------------------------------------------------------------------- type Dom s a = S s (Env s) a -type NodeSet = IntSet type NodeMap a = Word64Map a data Env s = Env {succE :: !Graph @@ -511,13 +510,6 @@ reachable f a = go (WS.singleton a) a as = WS.toList (s `WS.difference` seen) in foldl' go (s `WS.union` seen) as -collectI :: (c -> c -> c) - -> (a -> Int) -> (a -> c) -> [a] -> IntMap c -collectI (<>) f g - = foldl' (\m a -> IM.insertWith (<>) - (f a) - (g a) m) mempty - collectW :: (c -> c -> c) -> (a -> Word64) -> (a -> c) -> [a] -> Word64Map c collectW (<>) f g ===================================== libraries/ghci/GHCi/Run.hs ===================================== @@ -40,6 +40,7 @@ import GHC.Conc.Sync import GHC.IO hiding ( bracket ) import System.Mem.Weak ( deRefWeak ) import Unsafe.Coerce +import GHC.Word -- ----------------------------------------------------------------------------- -- Implement messages @@ -293,7 +294,11 @@ withBreakAction opts breakMVar statusMVar act resume_r <- mkRemoteRef resume apStack_r <- mkRemoteRef apStack ccs <- toRemotePtr <$> getCCSOf apStack - putMVar statusMVar $ EvalBreak is_exception apStack_r (I# ix#) (undefined uniq#) resume_r ccs +#if !MIN_VERSION_GLASGOW_HASKELL(9,3,0,0) || WORD_SIZE_IN_BITS < 64 + putMVar statusMVar $ EvalBreak is_exception apStack_r (I# ix#) (W64# uniq#) resume_r ccs +#else + putMVar statusMVar $ EvalBreak is_exception apStack_r (I# ix#) (W64# (word64ToWord# uniq#)) resume_r ccs +#endif takeMVar breakMVar resetBreakAction stablePtr = do @@ -342,7 +347,7 @@ resetStepFlag = poke stepFlag 0 type BreakpointCallback = Int# -- the breakpoint index - -> Int# -- the module uniq + -> Word64# -- the module uniq -> Bool -- exception? -> HValue -- the AP_STACK, or exception -> IO () ===================================== testsuite/tests/linters/notes.stdout ===================================== @@ -6,6 +6,8 @@ ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:4018:8: Note [Lambda-boun ref compiler/GHC/Core/Opt/Simplify/Utils.hs:1343:37: Note [Gentle mode] ref compiler/GHC/Core/Opt/Specialise.hs:1765:29: Note [Arity decrease] ref compiler/GHC/Core/TyCo/Rep.hs:1565:31: Note [What prevents a constraint from floating] +ref compiler/GHC/Data/Word64Map/Internal.hs:330:7: Note [ Template Haskell Dependencies ] +ref compiler/GHC/Data/Word64Set/Internal.hs:226:7: Note [ Template Haskell Dependencies ] ref compiler/GHC/Driver/DynFlags.hs:1245:49: Note [Eta-reduction in -O0] ref compiler/GHC/Driver/Main.hs:1762:34: Note [simpleTidyPgm - mkBootModDetailsTc] ref compiler/GHC/Hs/Expr.hs:194:63: Note [Pending Splices] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/221eef2810fc94715f6716d8293c7af4f8062f09...4cea741119d81b8d4b43e4dfb8344a8c13cb26ab -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/221eef2810fc94715f6716d8293c7af4f8062f09...4cea741119d81b8d4b43e4dfb8344a8c13cb26ab You're receiving 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 Jun 5 12:58:33 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 05 Jun 2023 08:58:33 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 2 commits: configure: Revert ripping out of toolchain selection logic Message-ID: <647ddbf9ee1e3_1d329d24afd628274753@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 8efbe321 by Rodrigo Mesquita at 2023-06-05T13:13:16+01:00 configure: Revert ripping out of toolchain selection logic - - - - - 605b5a2a by Rodrigo Mesquita at 2023-06-05T13:58:19+01:00 configure: Create and validate toolchain target file - - - - - 30 changed files: - configure.ac - + default.target.in - distrib/configure.ac.in - + m4/check_for_gold_t22266.m4 - + m4/check_ld_copy_bug.m4 - + m4/find_ld.m4 - + m4/find_merge_objects.m4 - m4/fp_cpp_cmd_with_args.m4 - + m4/fp_find_nm.m4 - + m4/fp_gcc_supports_no_pie.m4 - + m4/fp_gcc_supports_via_c_flags.m4 - + m4/fp_gcc_version.m4 - m4/fp_hs_cpp_cmd_with_args.m4 - + m4/fp_prog_ar.m4 - + m4/fp_prog_ar_args.m4 - + m4/fp_prog_ar_is_gnu.m4 - + m4/fp_prog_ar_needs_ranlib.m4 - + m4/fp_prog_ar_supports_atfile.m4 - + m4/fp_prog_ar_supports_dash_l.m4 - + m4/fp_prog_ld_filelist.m4 - + m4/fp_prog_ld_flag.m4 - + m4/fp_prog_ld_is_gnu.m4 - + m4/fp_prog_ld_no_compact_unwind.m4 - m4/fp_settings.m4 - m4/fp_setup_windows_toolchain.m4 - m4/fptools_set_haskell_platform_vars.m4 - m4/fptools_set_platform_vars.m4 - + m4/ghc_adjustors_method.m4 - + m4/ghc_tables_next_to_code.m4 - m4/ghc_toolchain.m4 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0335bea7824ed39ec6f42973003f16614c2143d2...605b5a2a665159f5da1f849a75f035fbc281590d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0335bea7824ed39ec6f42973003f16614c2143d2...605b5a2a665159f5da1f849a75f035fbc281590d You're receiving 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 Jun 5 13:46:59 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 05 Jun 2023 09:46:59 -0400 Subject: [Git][ghc/ghc][wip/T22010] Remove ignored haddock comment. Message-ID: <647de75318a16_1d329d24afd6282889d7@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 3e317213 by Jaro Reinders at 2023-06-05T15:46:46+02:00 Remove ignored haddock comment. - - - - - 1 changed file: - compiler/GHC/Data/Word64Map/Internal.hs Changes: ===================================== compiler/GHC/Data/Word64Map/Internal.hs ===================================== @@ -2085,7 +2085,7 @@ mergeA subdoubleton k1 k2 (Just y1) (Just y2) = link k1 (Tip k1 y1) k2 (Tip k2 y2) {-# INLINE subdoubleton #-} - -- | A variant of 'link_' which makes sure to execute side-effects + -- A variant of 'link_' which makes sure to execute side-effects -- in the right order. linkA :: Applicative f View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3e31721327a7c3c7d95eafb00715ef5852c84314 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3e31721327a7c3c7d95eafb00715ef5852c84314 You're receiving 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 Jun 5 14:22:23 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 05 Jun 2023 10:22:23 -0400 Subject: [Git][ghc/ghc][wip/T22010] Try to fix atomic_inc64 Message-ID: <647def9f3e1f3_1d329d27191f3c2913cd@gitlab.mail> Spam detection software, running on the system "mail.haskell.org", has identified this incoming email as possible spam. The original message has been attached to this so you can view it (if it isn't spam) or label similar future email. If you have any questions, see @@CONTACT_ADDRESS@@ for details. Content preview: Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 0474e923 by Jaro Reinders at 2023-06-05T16:22:11+02:00 Try to fix atomic_inc64 - - - - - [...] Content analysis details: (6.1 points, 5.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- -0.0 T_RP_MATCHES_RCVD Envelope sender domain matches handover relay domain 1.1 URI_HEX URI: URI hostname has long hexadecimal sequence 5.0 UNWANTED_LANGUAGE_BODY BODY: Message written in an undesired language 0.0 HTML_MESSAGE BODY: HTML included in message -0.0 BAYES_20 BODY: Bayes spam probability is 5 to 20% [score: 0.1313] 0.0 T_DKIM_INVALID DKIM-Signature header exists but is not valid The original message was not completely plain text, and may be unsafe to open with some email clients; in particular, it may contain a virus, or confirm that your address can receive spam. If you wish to view it, it may be safer to save it to a file and open it with an editor. -------------- next part -------------- An embedded message was scrubbed... From: "Jaro Reinders (@Noughtmare)" Subject: [Git][ghc/ghc][wip/T22010] Try to fix atomic_inc64 Date: Mon, 05 Jun 2023 10:22:23 -0400 Size: 32003 URL: From gitlab at gitlab.haskell.org Mon Jun 5 16:44:25 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 05 Jun 2023 12:44:25 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/t23454 Message-ID: <647e10e9a7229_1d329d30f0b4703134e3@gitlab.mail> Matthew Pickering pushed new branch wip/t23454 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/t23454 You're receiving 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 Jun 5 16:46:10 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 05 Jun 2023 12:46:10 -0400 Subject: [Git][ghc/ghc][wip/t23454] Add role annotations to SNat, SSymbol and SChar Message-ID: <647e1152b61d2_1d329d30f38538314060@gitlab.mail> Matthew Pickering pushed to branch wip/t23454 at Glasgow Haskell Compiler / GHC Commits: 530e6dc1 by Matthew Pickering at 2023-06-05T17:45:19+01:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. Fixes #23454 - - - - - 5 changed files: - libraries/base/GHC/TypeLits.hs - libraries/base/GHC/TypeNats.hs - + libraries/base/tests/T23454.hs - + libraries/base/tests/T23454.stderr - libraries/base/tests/all.T Changes: ===================================== libraries/base/GHC/TypeLits.hs ===================================== @@ -15,6 +15,7 @@ {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE RoleAnnotations #-} {-| GHC's @DataKinds@ language extension lifts data constructors, natural @@ -340,6 +341,7 @@ withSomeSNat n k -- -- @since 4.18.0.0 newtype SSymbol (s :: Symbol) = UnsafeSSymbol String +type role SSymbol nominal -- | A explicitly bidirectional pattern synonym relating an 'SSymbol' to a -- 'KnownSymbol' constraint. @@ -442,6 +444,7 @@ withSomeSSymbol s k = k (UnsafeSSymbol s) -- -- @since 4.18.0.0 newtype SChar (s :: Char) = UnsafeSChar Char +type role SChar nominal -- | A explicitly bidirectional pattern synonym relating an 'SChar' to a -- 'KnownChar' constraint. ===================================== libraries/base/GHC/TypeNats.hs ===================================== @@ -16,6 +16,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE RoleAnnotations #-} {-| This module is an internal GHC module. It declares the constants used in the implementation of type-level natural numbers. The programmer interface @@ -345,6 +346,8 @@ cmpNat x y = case compare (natVal x) (natVal y) of -- @since 4.18.0.0 newtype SNat (n :: Nat) = UnsafeSNat Natural +type role SNat nominal + -- | A explicitly bidirectional pattern synonym relating an 'SNat' to a -- 'KnownNat' constraint. -- ===================================== libraries/base/tests/T23454.hs ===================================== @@ -0,0 +1,27 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} + +module T23454 where + +import Data.Coerce (coerce) +import Data.Kind (Type) +import Data.Type.Equality +import GHC.TypeNats + +bogus :: forall a b . KnownNat a => a :~: b +bogus = case testEquality (SNat @a) (coerce (SNat @a) :: SNat b) of + Just r -> r + Nothing -> error "bug fixed" + +type G :: Nat -> Type -> Type -> Type +type family G n s t where + G 0 s _ = s + G _ _ t = t + +newtype N n s t = MkN { unN :: G n s t } + +oops :: forall b s t . N 0 s t -> N b s t +oops x = gcastWith (bogus @0 @b) x + +unsafeCoerce :: s -> t +unsafeCoerce x = unN (oops @1 (MkN x)) ===================================== libraries/base/tests/T23454.stderr ===================================== @@ -0,0 +1,21 @@ + +T23454.hs:12:38: 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: + bogus :: forall (a :: Nat) (b :: Nat). KnownNat a => a :~: b + at T23454.hs:11:1-43 + ‘b’ is a rigid type variable bound by + the type signature for: + bogus :: forall (a :: Nat) (b :: Nat). KnownNat a => a :~: b + at T23454.hs:11:1-43 + • In the second argument of ‘testEquality’, namely + ‘(coerce (SNat @a) :: SNat b)’ + In the expression: + testEquality (SNat @a) (coerce (SNat @a) :: SNat b) + In the expression: + case testEquality (SNat @a) (coerce (SNat @a) :: SNat b) of + Just r -> r + Nothing -> error "bug fixed" + • Relevant bindings include + bogus :: a :~: b (bound at T23454.hs:12:1) ===================================== libraries/base/tests/all.T ===================================== @@ -300,3 +300,4 @@ test('listThreads1', normal, compile_and_run, ['']) test('inits1tails1', normal, compile_and_run, ['']) test('CLC149', normal, compile, ['']) test('AtomicSwapIORef', normal, compile_and_run, ['']) +test('T23454', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/530e6dc19ab116fd96f7107f38440b402f70c086 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/530e6dc19ab116fd96f7107f38440b402f70c086 You're receiving 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 Jun 5 16:46:42 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 05 Jun 2023 12:46:42 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] configure: Create and validate toolchain target file Message-ID: <647e11724b353_1d329d30f0b470314268@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 8ae926d8 by Rodrigo Mesquita at 2023-06-05T17:46:33+01:00 configure: Create and validate toolchain target file - - - - - 5 changed files: - configure.ac - + default.target.in - m4/ghc_toolchain.m4 - + m4/prep_target_file.m4 - utils/ghc-toolchain/Main.hs Changes: ===================================== configure.ac ===================================== @@ -646,7 +646,6 @@ dnl CONF_CC_OPTS_STAGE[012] accordingly. FP_CC_SUPPORTS_TARGET([$CC_STAGE0], [CONF_CC_OPTS_STAGE0], [CONF_CXX_OPTS_STAGE0], [CONF_GCC_LINKER_OPTS_STAGE0]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINKER_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINKER_OPTS_STAGE2]) -FIND_GHC_TOOLCHAIN # CPP, CPPFLAGS # --with-cpp/-with-cpp-flags @@ -1170,6 +1169,11 @@ checkMake380() { checkMake380 make checkMake380 gmake +# Toolchain target files +PREP_TARGET_FILE +FIND_GHC_TOOLCHAIN +VALIDATE_GHC_TOOLCHAIN + AC_CONFIG_FILES( [ mk/project.mk hadrian/cfg/system.config @@ -1178,6 +1182,7 @@ AC_CONFIG_FILES( hadrian/ghci-stack docs/users_guide/ghc_config.py distrib/configure.ac + default.target ]) dnl Create the VERSION file, satisfying #22322. ===================================== default.target.in ===================================== @@ -0,0 +1 @@ +Target {tgtArchOs = ArchOS {archOS_arch = @HostArch_CPP@, archOS_OS = @HostOS_CPP@}, tgtSupportsGnuNonexecStack = @TargetHasGnuNonexecStackBool@, tgtSupportsSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbolsBool@, tgtSupportsIdentDirective = @TargetHasIdentDirectiveBool@, tgtWordSize = WS at TargetWordSize@, tgtEndianness = LittleEndian, tgtSymbolsHaveLeadingUnderscore = @LeadingUnderscoreBool@, tgtLlvmTarget = "@HostPlatform@", tgtUnregisterised = @UnregisterisedBool@, tgtTablesNextToCode = @TablesNextToCodeBool@, tgtUseLibffiForAdjustors = @UseLibffiForAdjustorsBool@, tgtCCompiler = Cc {ccProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @SettingsCCompilerFlagsList@}}, tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@SettingsCxxCompilerCommand@", prgFlags = @SettingsCxxCompilerFlagsList@}}, tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@CPPCmd@", prgFlags = @CPPArgsList@}}, tgtHsCPreprocessor = HsCpp {hsCppProgram = Program {prgPath = "@HaskellCPPCmd@", prgFlags = @HaskellCPPArgsList@}}, tgtCCompilerLink = CcLink {ccLinkProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @SettingsCCompilerLinkFlagsList@}, ccLinkSupportsNoPie = @SettingsCCompilerSupportsNoPieBool@, ccLinkSupportsCompactUnwind = @LdHasNoCompactUnwindBool@, ccLinkSupportsFilelist = @LdHasFilelistBool@, ccLinkSupportsResponseFiles = @LdSupportsResponseFilesBool@, ccLinkIsGnu = @LdIsGNULdBool@}, tgtAr = Ar {arMkArchive = Program {prgPath = "@AR@", prgFlags = @ArArgsList@}, arIsGnu = False, arSupportsAtFile = @ArSupportsAtFileBool@, arSupportsDashL = @ArSupportsDashLBool@, arNeedsRanlib = False}, tgtRanlib = @REAL_RANLIB_CMD@, tgtNm = Nm {nmProgram = Program {prgPath = "@NmCmd@", prgFlags = []}}, tgtMergeObjs = Just (MergeObjs {mergeObjsProgram = Program {prgPath = "@SettingsMergeObjectsCommand@", prgFlags = @SettingsMergeObjectsFlagsList@}}), tgtDllwrap = Nothing, tgtWindres = Nothing} ===================================== m4/ghc_toolchain.m4 ===================================== @@ -66,8 +66,21 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], ) $A.diffable + cat $B | tr ' ' '\n' > $B.diffable + diff_output=`diff "$A.diffable" "$B.diffable" 2>&1` + if test -z "$diff_output"; then + true + else + AC_MSG_WARN([Differences found between $A and $B: $diff_output]) + fi +]) ===================================== m4/prep_target_file.m4 ===================================== @@ -0,0 +1,71 @@ +# PREP_BOOLEAN +# ============ +# +# Issue a substitution with True/False of [$1Bool] when $1 has YES/NO value +# $1 = boolean variable to substitute +AC_DEFUN([PREP_BOOLEAN],[ + case "$$1" in + YES) + $1Bool=True + ;; + NO) + $1Bool=False + ;; + *) + AC_MSG_ERROR([Expecting YES/NO but got $$1 in $1]) + ;; + esac + AC_SUBST([$1Bool]) +]) + +# PREP_LIST +# ============ +# +# Issue a substitution with ["list","of","args"] of [$1List] when $1 is a +# space-separated list of args +# $1 = list variable to substitute +dnl In autoconf, '@<:@' stands for '[', and '@:>@' for ']'. +AC_DEFUN([PREP_LIST],[ + TMP_ARR=($$1) + $1List="@<:@" + if test -z "$TMP_ARR"; then + true + else + $1List="${$1List}\"${TMP_ARR@<:@0@:>@}\"" + for arg in "${TMP_ARR@<:@@@:>@:1}" + do + $1List="${$1List},\"$arg\"" + done + fi + $1List="${$1List}@:>@" + AC_SUBST([$1List]) + unset TMP_ARR +]) + +# Eventually: PREP_BUILD_TARGET_FILE, PREP_HOST_TARGET_FILE, PREP_TARGET_TARGET_FILE +# Prepares required substitutions to generate the target file +AC_DEFUN([PREP_TARGET_FILE],[ + PREP_BOOLEAN([LdSupportsResponseFiles]) + PREP_BOOLEAN([TargetHasGnuNonexecStack]) + PREP_BOOLEAN([LeadingUnderscore]) + PREP_BOOLEAN([ArSupportsAtFile]) + PREP_BOOLEAN([ArSupportsDashL]) + PREP_BOOLEAN([TargetHasIdentDirective]) + PREP_BOOLEAN([SettingsCCompilerSupportsNoPie]) + PREP_BOOLEAN([LdHasFilelist]) + PREP_BOOLEAN([LdIsGNULd]) + PREP_BOOLEAN([LdHasNoCompactUnwind]) + PREP_BOOLEAN([TargetHasSubsectionsViaSymbols]) + PREP_BOOLEAN([Unregisterised]) + PREP_BOOLEAN([TablesNextToCode]) + PREP_BOOLEAN([UseLibffiForAdjustors]) + PREP_LIST([SettingsMergeObjectsFlags]) + PREP_LIST([ArArgs]) + PREP_LIST([SettingsCCompilerLinkFlags]) + PREP_LIST([HaskellCPPArgs]) + PREP_LIST([CPPArgs]) + PREP_LIST([SettingsCxxCompilerFlags]) + PREP_LIST([SettingsCCompilerFlags]) +]) + +AC_DEFUN() ===================================== utils/ghc-toolchain/Main.hs ===================================== @@ -216,7 +216,9 @@ run :: Opts -> M () run opts = do tgt <- mkTarget opts logDebug $ "Final Target: " ++ show tgt - writeFile "default.target" (show tgt) + let file = "default.ghc-toolchain.target" + writeFile file (show tgt) + appendFile file "\n" -- eol optional :: M a -> M (Maybe a) optional k = fmap Just k <|> pure Nothing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8ae926d85b86770b3d0971c52a70e92e80acf4df -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8ae926d85b86770b3d0971c52a70e92e80acf4df You're receiving 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 Jun 5 16:58:42 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 05 Jun 2023 12:58:42 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] configure: Create and validate toolchain target file Message-ID: <647e144210b7_1d329d790e70832367e@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: f2b47a59 by Rodrigo Mesquita at 2023-06-05T17:58:23+01:00 configure: Create and validate toolchain target file - - - - - 5 changed files: - configure.ac - + default.target.in - m4/ghc_toolchain.m4 - + m4/prep_target_file.m4 - utils/ghc-toolchain/Main.hs Changes: ===================================== configure.ac ===================================== @@ -646,7 +646,6 @@ dnl CONF_CC_OPTS_STAGE[012] accordingly. FP_CC_SUPPORTS_TARGET([$CC_STAGE0], [CONF_CC_OPTS_STAGE0], [CONF_CXX_OPTS_STAGE0], [CONF_GCC_LINKER_OPTS_STAGE0]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINKER_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINKER_OPTS_STAGE2]) -FIND_GHC_TOOLCHAIN # CPP, CPPFLAGS # --with-cpp/-with-cpp-flags @@ -1170,6 +1169,11 @@ checkMake380() { checkMake380 make checkMake380 gmake +# Toolchain target files +PREP_TARGET_FILE +FIND_GHC_TOOLCHAIN +VALIDATE_GHC_TOOLCHAIN + AC_CONFIG_FILES( [ mk/project.mk hadrian/cfg/system.config @@ -1178,6 +1182,7 @@ AC_CONFIG_FILES( hadrian/ghci-stack docs/users_guide/ghc_config.py distrib/configure.ac + default.target ]) dnl Create the VERSION file, satisfying #22322. ===================================== default.target.in ===================================== @@ -0,0 +1 @@ +Target {tgtArchOs = ArchOS {archOS_arch = @HostArch_CPP@, archOS_OS = @HostOS_CPP@}, tgtSupportsGnuNonexecStack = @TargetHasGnuNonexecStackBool@, tgtSupportsSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbolsBool@, tgtSupportsIdentDirective = @TargetHasIdentDirectiveBool@, tgtWordSize = WS at TargetWordSize@, tgtEndianness = LittleEndian, tgtSymbolsHaveLeadingUnderscore = @LeadingUnderscoreBool@, tgtLlvmTarget = "@HostPlatform@", tgtUnregisterised = @UnregisterisedBool@, tgtTablesNextToCode = @TablesNextToCodeBool@, tgtUseLibffiForAdjustors = @UseLibffiForAdjustorsBool@, tgtCCompiler = Cc {ccProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @SettingsCCompilerFlagsList@}}, tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@SettingsCxxCompilerCommand@", prgFlags = @SettingsCxxCompilerFlagsList@}}, tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@CPPCmd@", prgFlags = @CONF_CPP_OPTS_STAGE1List@}}, tgtHsCPreprocessor = HsCpp {hsCppProgram = Program {prgPath = "@HaskellCPPCmd@", prgFlags = @HaskellCPPArgsList@}}, tgtCCompilerLink = CcLink {ccLinkProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @SettingsCCompilerLinkFlagsList@}, ccLinkSupportsNoPie = @SettingsCCompilerSupportsNoPieBool@, ccLinkSupportsCompactUnwind = @LdHasNoCompactUnwindBool@, ccLinkSupportsFilelist = @LdHasFilelistBool@, ccLinkSupportsResponseFiles = @LdSupportsResponseFilesBool@, ccLinkIsGnu = @LdIsGNULdBool@}, tgtAr = Ar {arMkArchive = Program {prgPath = "@AR@", prgFlags = @ArArgsList@}, arIsGnu = False, arSupportsAtFile = @ArSupportsAtFileBool@, arSupportsDashL = @ArSupportsDashLBool@, arNeedsRanlib = False}, tgtRanlib = @REAL_RANLIB_CMD@, tgtNm = Nm {nmProgram = Program {prgPath = "@NmCmd@", prgFlags = []}}, tgtMergeObjs = Just (MergeObjs {mergeObjsProgram = Program {prgPath = "@SettingsMergeObjectsCommand@", prgFlags = @SettingsMergeObjectsFlagsList@}}), tgtDllwrap = Nothing, tgtWindres = Nothing} ===================================== m4/ghc_toolchain.m4 ===================================== @@ -66,8 +66,21 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], ) $A.diffable + cat $B | tr ' ' '\n' > $B.diffable + diff_output=`diff "$A.diffable" "$B.diffable" 2>&1` + if test -z "$diff_output"; then + true + else + AC_MSG_WARN([Differences found between $A and $B: $diff_output]) + fi +]) ===================================== m4/prep_target_file.m4 ===================================== @@ -0,0 +1,71 @@ +# PREP_BOOLEAN +# ============ +# +# Issue a substitution with True/False of [$1Bool] when $1 has YES/NO value +# $1 = boolean variable to substitute +AC_DEFUN([PREP_BOOLEAN],[ + case "$$1" in + YES) + $1Bool=True + ;; + NO) + $1Bool=False + ;; + *) + AC_MSG_ERROR([Expecting YES/NO but got $$1 in $1]) + ;; + esac + AC_SUBST([$1Bool]) +]) + +# PREP_LIST +# ============ +# +# Issue a substitution with ["list","of","args"] of [$1List] when $1 is a +# space-separated list of args +# $1 = list variable to substitute +dnl In autoconf, '@<:@' stands for '[', and '@:>@' for ']'. +AC_DEFUN([PREP_LIST],[ + TMP_ARR=($$1) + $1List="@<:@" + if test -z "$TMP_ARR"; then + true + else + $1List="${$1List}\"${TMP_ARR@<:@0@:>@}\"" + for arg in "${TMP_ARR@<:@@@:>@:1}" + do + $1List="${$1List},\"$arg\"" + done + fi + $1List="${$1List}@:>@" + AC_SUBST([$1List]) + unset TMP_ARR +]) + +# Eventually: PREP_BUILD_TARGET_FILE, PREP_HOST_TARGET_FILE, PREP_TARGET_TARGET_FILE +# Prepares required substitutions to generate the target file +AC_DEFUN([PREP_TARGET_FILE],[ + PREP_BOOLEAN([LdSupportsResponseFiles]) + PREP_BOOLEAN([TargetHasGnuNonexecStack]) + PREP_BOOLEAN([LeadingUnderscore]) + PREP_BOOLEAN([ArSupportsAtFile]) + PREP_BOOLEAN([ArSupportsDashL]) + PREP_BOOLEAN([TargetHasIdentDirective]) + PREP_BOOLEAN([SettingsCCompilerSupportsNoPie]) + PREP_BOOLEAN([LdHasFilelist]) + PREP_BOOLEAN([LdIsGNULd]) + PREP_BOOLEAN([LdHasNoCompactUnwind]) + PREP_BOOLEAN([TargetHasSubsectionsViaSymbols]) + PREP_BOOLEAN([Unregisterised]) + PREP_BOOLEAN([TablesNextToCode]) + PREP_BOOLEAN([UseLibffiForAdjustors]) + PREP_LIST([SettingsMergeObjectsFlags]) + PREP_LIST([ArArgs]) + PREP_LIST([SettingsCCompilerLinkFlags]) + PREP_LIST([HaskellCPPArgs]) + PREP_LIST([CONF_CPP_OPTS_STAGE1]) + PREP_LIST([SettingsCxxCompilerFlags]) + PREP_LIST([SettingsCCompilerFlags]) +]) + +AC_DEFUN() ===================================== utils/ghc-toolchain/Main.hs ===================================== @@ -216,7 +216,9 @@ run :: Opts -> M () run opts = do tgt <- mkTarget opts logDebug $ "Final Target: " ++ show tgt - writeFile "default.target" (show tgt) + let file = "default.ghc-toolchain.target" + writeFile file (show tgt) + appendFile file "\n" -- eol optional :: M a -> M (Maybe a) optional k = fmap Just k <|> pure Nothing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f2b47a59bcc5fe3f9b17d6321d9a9e7ee062d8dc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f2b47a59bcc5fe3f9b17d6321d9a9e7ee062d8dc You're receiving 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 Jun 5 16:59:28 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 05 Jun 2023 12:59:28 -0400 Subject: [Git][ghc/ghc][wip/t23454] Add role annotations to SNat, SSymbol and SChar Message-ID: <647e14702e62f_1d329d3383c2b8324133@gitlab.mail> Matthew Pickering pushed to branch wip/t23454 at Glasgow Haskell Compiler / GHC Commits: 5988803e by Matthew Pickering at 2023-06-05T17:59:15+01:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. Fixes #23454 - - - - - 5 changed files: - libraries/base/GHC/TypeLits.hs - libraries/base/GHC/TypeNats.hs - + libraries/base/tests/T23454.hs - + libraries/base/tests/T23454.stderr - libraries/base/tests/all.T Changes: ===================================== libraries/base/GHC/TypeLits.hs ===================================== @@ -15,6 +15,7 @@ {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE RoleAnnotations #-} {-| GHC's @DataKinds@ language extension lifts data constructors, natural @@ -340,6 +341,7 @@ withSomeSNat n k -- -- @since 4.18.0.0 newtype SSymbol (s :: Symbol) = UnsafeSSymbol String +type role SSymbol nominal -- | A explicitly bidirectional pattern synonym relating an 'SSymbol' to a -- 'KnownSymbol' constraint. @@ -442,6 +444,7 @@ withSomeSSymbol s k = k (UnsafeSSymbol s) -- -- @since 4.18.0.0 newtype SChar (s :: Char) = UnsafeSChar Char +type role SChar nominal -- | A explicitly bidirectional pattern synonym relating an 'SChar' to a -- 'KnownChar' constraint. ===================================== libraries/base/GHC/TypeNats.hs ===================================== @@ -16,6 +16,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE RoleAnnotations #-} {-| This module is an internal GHC module. It declares the constants used in the implementation of type-level natural numbers. The programmer interface @@ -344,6 +345,7 @@ cmpNat x y = case compare (natVal x) (natVal y) of -- -- @since 4.18.0.0 newtype SNat (n :: Nat) = UnsafeSNat Natural +type role SNat nominal -- | A explicitly bidirectional pattern synonym relating an 'SNat' to a -- 'KnownNat' constraint. ===================================== libraries/base/tests/T23454.hs ===================================== @@ -0,0 +1,27 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} + +module T23454 where + +import Data.Coerce (coerce) +import Data.Kind (Type) +import Data.Type.Equality +import GHC.TypeNats + +bogus :: forall a b . KnownNat a => a :~: b +bogus = case testEquality (SNat @a) (coerce (SNat @a) :: SNat b) of + Just r -> r + Nothing -> error "bug fixed" + +type G :: Nat -> Type -> Type -> Type +type family G n s t where + G 0 s _ = s + G _ _ t = t + +newtype N n s t = MkN { unN :: G n s t } + +oops :: forall b s t . N 0 s t -> N b s t +oops x = gcastWith (bogus @0 @b) x + +unsafeCoerce :: s -> t +unsafeCoerce x = unN (oops @1 (MkN x)) ===================================== libraries/base/tests/T23454.stderr ===================================== @@ -0,0 +1,21 @@ + +T23454.hs:12:38: 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: + bogus :: forall (a :: Nat) (b :: Nat). KnownNat a => a :~: b + at T23454.hs:11:1-43 + ‘b’ is a rigid type variable bound by + the type signature for: + bogus :: forall (a :: Nat) (b :: Nat). KnownNat a => a :~: b + at T23454.hs:11:1-43 + • In the second argument of ‘testEquality’, namely + ‘(coerce (SNat @a) :: SNat b)’ + In the expression: + testEquality (SNat @a) (coerce (SNat @a) :: SNat b) + In the expression: + case testEquality (SNat @a) (coerce (SNat @a) :: SNat b) of + Just r -> r + Nothing -> error "bug fixed" + • Relevant bindings include + bogus :: a :~: b (bound at T23454.hs:12:1) ===================================== libraries/base/tests/all.T ===================================== @@ -300,3 +300,4 @@ test('listThreads1', normal, compile_and_run, ['']) test('inits1tails1', normal, compile_and_run, ['']) test('CLC149', normal, compile, ['']) test('AtomicSwapIORef', normal, compile_and_run, ['']) +test('T23454', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5988803eb2d823cb95c0fbfd7f175f61761620b3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5988803eb2d823cb95c0fbfd7f175f61761620b3 You're receiving 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 Jun 5 17:08:49 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Mon, 05 Jun 2023 13:08:49 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/modern-STV-extension-shuffling] Extension shuffling (#23291) Message-ID: <647e16a12d723_1d329d790e708330153@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/modern-STV-extension-shuffling at Glasgow Haskell Compiler / GHC Commits: 899e625f by Andrei Borzenkov at 2023-06-05T21:08:33+04:00 Extension shuffling (#23291) Where introduced 3 new extensions: - PatternSignatures - ExtendedForAllScope - MethodTypeVariables Tasks of ScopedTypeVariables extension were distributed between PatternSignatures, ExtendedForAllScope and MethodTypeVariables according to the proposal. Now ScopedTypeVaribles only implies these three exntesions. Was introduced one new warning option: -Wpattern-signature-binds It warns when pattern signature binds into scope new type variable. For example: f (a :: t) = ... - - - - - 30 changed files: - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/expected-undocumented-flags.txt - docs/users_guide/exts/explicit_forall.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/scoped_type_variables.rst - docs/users_guide/exts/type_abstractions.rst - docs/users_guide/using-warnings.rst - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - testsuite/tests/driver/T4437.hs - testsuite/tests/rename/should_fail/T11663.stderr - + testsuite/tests/rename/should_fail/WPatternSigBinds.hs - + testsuite/tests/rename/should_fail/WPatternSigBinds.stderr - testsuite/tests/rename/should_fail/all.T - testsuite/tests/showIface/DocsInHiFile1.stdout - testsuite/tests/showIface/DocsInHiFileTH.stdout - testsuite/tests/showIface/HaddockIssue849.stdout - testsuite/tests/showIface/HaddockOpts.stdout The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/899e625ffbbb9d3bf62887f2d707f68eb3dd2b0d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/899e625ffbbb9d3bf62887f2d707f68eb3dd2b0d You're receiving 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 Jun 5 17:10:05 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 05 Jun 2023 13:10:05 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 11 commits: [hadrian] Fix multiline synopsis rendering Message-ID: <647e16eddb503_1d329d24afd62833616a@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 080d54a5 by sheaf at 2023-06-05T13:10:02-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 30 changed files: - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/Plugins.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Hole/FitTypes.hs - − compiler/GHC/Tc/Errors/Hole/FitTypes.hs-boot - + compiler/GHC/Tc/Errors/Hole/Plugin.hs - + compiler/GHC/Tc/Errors/Hole/Plugin.hs-boot - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - + compiler/GHC/Tc/Errors/Types/PromotionErr.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Match.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/079586c7ca8f2645033a29568e471eae12896642...080d54a5b14d788d53bc98d5905e090489e78686 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/079586c7ca8f2645033a29568e471eae12896642...080d54a5b14d788d53bc98d5905e090489e78686 You're receiving 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 Jun 5 17:23:12 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 05 Jun 2023 13:23:12 -0400 Subject: [Git][ghc/ghc][wip/expand-do] trying out changes to heralds Message-ID: <647e1a00613c8_1d329d3383c2b8343171@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 7bcf73a6 by Apoorv Ingle at 2023-06-05T12:22:57-05:00 trying out changes to heralds - - - - - 8 changed files: - compiler/GHC/Rename/Expr.hs - − compiler/GHC/Tc/Gen/.#Expr.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Instantiate.hs - testsuite/tests/deSugar/should_compile/T3263-2.hs Changes: ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -191,6 +191,25 @@ but several have a little bit of special treatment: in which an updated field has a higher-rank type. See Wrinkle [Using IdSig] in Note [Record Updates] in GHC.Tc.Gen.Expr. +* HsDo: We expand HsDo statements in GHC.Tc.Expr + as we need to check for pattern irrefutability + which is dependent on the type constructor details available in TcM and not Rn monad + + - For example, a user written code: + + do x <- e1 + g x + return (f x) + + is expanded to (roughly) + + (>>=) e1 + (\ x -> (>>) (g x) + (return (f x))) + + See Note [Expanding HsDo with HsExpansion] in Ghc.Tc.Gen.Match for more details + + Note [Overloaded labels] ~~~~~~~~~~~~~~~~~~~~~~~~ For overloaded labels, note that we /only/ apply `fromLabel` to the ===================================== compiler/GHC/Tc/Gen/.#Expr.hs deleted ===================================== @@ -1 +0,0 @@ -aningle at CS-M030.71606 \ No newline at end of file ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -216,8 +216,7 @@ tcExpr (XExpr (ExpandedStmt (HsExpanded stmt expr))) res_ty , text "expr:" <+> ppr expr , text "res_ty" <+> ppr res_ty ]) - ; addErrCtxt (pprStmtInCtxt @Renamed @Renamed @Renamed (HsDoStmt (DoExpr Nothing)) (unLoc stmt)) $ - tcExpr (unLoc expr) res_ty + ; tcExpr (unLoc expr) res_ty } @@ -280,7 +279,7 @@ tcExpr (HsLam _ match) res_ty = do { (wrap, match') <- tcMatchLambda herald match_ctxt match res_ty ; return (mkHsWrap wrap (HsLam noExtField match')) } where - match_ctxt = MC { mc_what = case mg_ext match of + match_ctxt = MC { mc_what = case mg_ext match of -- refactor this for a better place. Generated DoExpansion -> StmtCtxt (HsDoStmt (DoExpr Nothing)) -- Either this lambda expr was generated by expanding a do block _ -> LambdaExpr ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -981,12 +981,13 @@ tcInferOverLit lit@(OverLit { ol_val = val -- the (3 :: Integer) is returned by mkOverLit -- Ditto the string literal "foo" to (fromString ("foo" :: String)) do { hs_lit <- mkOverLit val + ; hs_lit_rn <- mkOverLitRn val ; from_id <- tcLookupId from_name ; (wrap1, from_ty) <- topInstantiate (LiteralOrigin lit) (idType from_id) ; let thing = NameThing from_name mb_thing = Just thing - herald = ExpectedFunTyArg thing (HsLit noAnn hs_lit) + herald = ExpectedFunTyArg thing (HsLit noAnn hs_lit_rn) ; (wrap2, sarg_ty, res_ty) <- matchActualFunTySigma herald mb_thing (1, []) from_ty @@ -1469,6 +1470,7 @@ addExprCtxt :: HsExpr GhcRn -> TcRn a -> TcRn a addExprCtxt e thing_inside = case e of HsUnboundVar {} -> thing_inside + XExpr (PopSrcSpan (L _ e)) -> addExprCtxt e thing_inside _ -> addErrCtxt (exprCtxt e) thing_inside -- The HsUnboundVar special case addresses situations like -- f x = _ ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1405,34 +1405,34 @@ mk_fail_lexpr pat lexpr (Just (SyntaxExprRn fail_op)) = mk_fail_lexpr _ _ _ = pprPanic "mk_fail_lexpr: impossible happened" empty -{- Note [Desugaring Do with HsExpansion] +{- Note [Expanding HsDo with HsExpansion] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We expand do blocks before typechecking it rather than after type checking it using the -HsExpansion mechanism similar to HsIf expansions for rebindable syntax. +HsExpansions similar to HsIf expansions for rebindable syntax. +The main reason to implement this is to make impredicatively typed expression statements typechec in do blocks. +(#18324 and #23147). +The challenge is to make sure we generate proper error messages with correct caret diagonstics Consider a do expression written in by the user -f = {l0} do {l1} p <- {l1'}e1 - {l2} g p - {l3} return {l3'}p + f = {l0} do {l1} p <- {l1'}e1 + {l2} g p + {l3} return {l3'}p The {l1} etc are location/source span information stored in the AST, {g1} are compiler generated source spans The expanded version (performed by expand_do_stmts) looks as follows: -f = {g1} (>>=) ({l1'} e1) (\ p -> - {g2} (>>) ({l2} g p) - ({l3} return p) - ) + f = {g1} (>>=) ({l1'} e1) (\ p -> + {g2} (>>) ({l2} g p) + ({l3} return p)) The points to consider are: 1. Generating appropriate type error messages that blame the correct source spans 2. Generate appropriate warnings for discarded results, eg. say g p :: m Int 3. Decorate an expression a fail block if the pattern match is irrefutable -Things get a bit tricky with QuickLook involved that decomposes the applications -to perform an impredicativity check. TODO expand using examples ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -1332,12 +1332,10 @@ data ExpectedFunTyOrigin -- -- Test cases for representation-polymorphism checks: -- RepPolyApp - | forall (p :: Pass) - . (OutputableBndrId p) - => ExpectedFunTyArg + | ExpectedFunTyArg !TypedThing -- ^ function - !(HsExpr (GhcPass p)) + !(HsExpr GhcRn) -- ^ argument -- | Ensure that a function defined by equations indeed has a function type @@ -1380,11 +1378,18 @@ pprExpectedFunTyOrigin funTy_origin i = ExpectedFunTyViewPat expr -> vcat [ the_arg_of <+> text "the view pattern" , nest 2 (ppr expr) ] - ExpectedFunTyArg fun arg -> - sep [ text "The argument" - , quotes (ppr arg) - , text "of" - , quotes (ppr fun) ] + ExpectedFunTyArg fun arg -> case arg of + XExpr (PopSrcSpan (L _ (XExpr (ExpandedStmt (HsExpanded {}))))) -> + vcat [ sep [ the_arg_of + , text "the rebindable syntax operator" + , quotes (ppr fun) + ] + , nest 2 (text "arising from a do stmt") + ] + _ -> sep [ text "The argument" + , quotes (ppr arg) + , text "of" + , quotes (ppr fun) ] ExpectedFunTyMatches fun (MG { mg_alts = L _ alts }) | null alts -> the_arg_of <+> quotes (ppr fun) ===================================== compiler/GHC/Tc/Utils/Instantiate.hs ===================================== @@ -25,7 +25,7 @@ module GHC.Tc.Utils.Instantiate ( tcInstInvisibleTyBindersN, tcInstInvisibleTyBinders, tcInstInvisibleTyBinder, - newOverloadedLit, mkOverLit, + newOverloadedLit, mkOverLit, mkOverLitRn, newClsInst, newFamInst, tcGetInsts, tcGetInstEnvs, getOverlapFlag, @@ -698,6 +698,19 @@ mkOverLit (HsFractional r) mkOverLit (HsIsString src s) = return (HsString src s) +mkOverLitRn ::OverLitVal -> TcM (HsLit GhcRn) +mkOverLitRn (HsIntegral i) + = do { integer_ty <- tcMetaTy integerTyConName + ; return (HsInteger (il_text i) + (il_value i) integer_ty) } + +mkOverLitRn (HsFractional r) + = do { rat_ty <- tcMetaTy rationalTyConName + ; return (HsRat noExtField r rat_ty) } + +mkOverLitRn (HsIsString src s) = return (HsString src s) + + {- ************************************************************************ * * ===================================== testsuite/tests/deSugar/should_compile/T3263-2.hs ===================================== @@ -31,7 +31,6 @@ t5 = do _ <- return (return 10 :: m Int) return 10 - -- Warning t6 :: forall m. MonadFix m => m Int t6 = mdo View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7bcf73a6ad424964d811dbc20684f03bd147b344 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7bcf73a6ad424964d811dbc20684f03bd147b344 You're receiving 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 Jun 5 17:53:12 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 05 Jun 2023 13:53:12 -0400 Subject: [Git][ghc/ghc][wip/expand-do] trying out changes to heralds Message-ID: <647e21086f1c4_1d329d30f38538349567@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 265cc4fd by Apoorv Ingle at 2023-06-05T12:53:04-05:00 trying out changes to heralds - - - - - 9 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Rename/Expr.hs - − compiler/GHC/Tc/Gen/.#Expr.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Instantiate.hs - testsuite/tests/deSugar/should_compile/T3263-2.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -463,7 +463,7 @@ data XXExprGhcRn {-# UNPACK #-} !(LHsExpr GhcRn) -- Placeholder for identifying generated source locations in GhcRn phase -- Should not presist post typechecking - -- Note [Desugaring Do with HsExpansion] in GHC.Tc.Gen.Match + -- Note [Expanding HsDo with HsExpansion] in GHC.Tc.Gen.Match -- | Wrap a located expression with a PopSrcExpr mkPopSrcSpanExpr :: LHsExpr GhcRn -> HsExpr GhcRn ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -191,6 +191,25 @@ but several have a little bit of special treatment: in which an updated field has a higher-rank type. See Wrinkle [Using IdSig] in Note [Record Updates] in GHC.Tc.Gen.Expr. +* HsDo: We expand HsDo statements in GHC.Tc.Expr + as we need to check for pattern irrefutability + which is dependent on the type constructor details available in TcM and not Rn monad + + - For example, a user written code: + + do x <- e1 + g x + return (f x) + + is expanded to (roughly) + + (>>=) e1 + (\ x -> (>>) (g x) + (return (f x))) + + See Note [Expanding HsDo with HsExpansion] in Ghc.Tc.Gen.Match for more details + + Note [Overloaded labels] ~~~~~~~~~~~~~~~~~~~~~~~~ For overloaded labels, note that we /only/ apply `fromLabel` to the ===================================== compiler/GHC/Tc/Gen/.#Expr.hs deleted ===================================== @@ -1 +0,0 @@ -aningle at CS-M030.71606 \ No newline at end of file ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -216,8 +216,7 @@ tcExpr (XExpr (ExpandedStmt (HsExpanded stmt expr))) res_ty , text "expr:" <+> ppr expr , text "res_ty" <+> ppr res_ty ]) - ; addErrCtxt (pprStmtInCtxt @Renamed @Renamed @Renamed (HsDoStmt (DoExpr Nothing)) (unLoc stmt)) $ - tcExpr (unLoc expr) res_ty + ; tcExpr (unLoc expr) res_ty } @@ -280,7 +279,7 @@ tcExpr (HsLam _ match) res_ty = do { (wrap, match') <- tcMatchLambda herald match_ctxt match res_ty ; return (mkHsWrap wrap (HsLam noExtField match')) } where - match_ctxt = MC { mc_what = case mg_ext match of + match_ctxt = MC { mc_what = case mg_ext match of -- refactor this for a better place. Generated DoExpansion -> StmtCtxt (HsDoStmt (DoExpr Nothing)) -- Either this lambda expr was generated by expanding a do block _ -> LambdaExpr ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -981,12 +981,13 @@ tcInferOverLit lit@(OverLit { ol_val = val -- the (3 :: Integer) is returned by mkOverLit -- Ditto the string literal "foo" to (fromString ("foo" :: String)) do { hs_lit <- mkOverLit val + ; hs_lit_rn <- mkOverLitRn val ; from_id <- tcLookupId from_name ; (wrap1, from_ty) <- topInstantiate (LiteralOrigin lit) (idType from_id) ; let thing = NameThing from_name mb_thing = Just thing - herald = ExpectedFunTyArg thing (HsLit noAnn hs_lit) + herald = ExpectedFunTyArg thing (HsLit noAnn hs_lit_rn) ; (wrap2, sarg_ty, res_ty) <- matchActualFunTySigma herald mb_thing (1, []) from_ty @@ -1469,6 +1470,7 @@ addExprCtxt :: HsExpr GhcRn -> TcRn a -> TcRn a addExprCtxt e thing_inside = case e of HsUnboundVar {} -> thing_inside + XExpr (PopSrcSpan (L _ e)) -> addExprCtxt e thing_inside _ -> addErrCtxt (exprCtxt e) thing_inside -- The HsUnboundVar special case addresses situations like -- f x = _ ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1405,34 +1405,34 @@ mk_fail_lexpr pat lexpr (Just (SyntaxExprRn fail_op)) = mk_fail_lexpr _ _ _ = pprPanic "mk_fail_lexpr: impossible happened" empty -{- Note [Desugaring Do with HsExpansion] +{- Note [Expanding HsDo with HsExpansion] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We expand do blocks before typechecking it rather than after type checking it using the -HsExpansion mechanism similar to HsIf expansions for rebindable syntax. +HsExpansions similar to HsIf expansions for rebindable syntax. +The main reason to implement this is to make impredicatively typed expression statements typechec in do blocks. +(#18324 and #23147). +The challenge is to make sure we generate proper error messages with correct caret diagonstics Consider a do expression written in by the user -f = {l0} do {l1} p <- {l1'}e1 - {l2} g p - {l3} return {l3'}p + f = {l0} do {l1} p <- {l1'}e1 + {l2} g p + {l3} return {l3'}p The {l1} etc are location/source span information stored in the AST, {g1} are compiler generated source spans The expanded version (performed by expand_do_stmts) looks as follows: -f = {g1} (>>=) ({l1'} e1) (\ p -> - {g2} (>>) ({l2} g p) - ({l3} return p) - ) + f = {g1} (>>=) ({l1'} e1) (\ p -> + {g2} (>>) ({l2} g p) + ({l3} return p)) The points to consider are: 1. Generating appropriate type error messages that blame the correct source spans 2. Generate appropriate warnings for discarded results, eg. say g p :: m Int 3. Decorate an expression a fail block if the pattern match is irrefutable -Things get a bit tricky with QuickLook involved that decomposes the applications -to perform an impredicativity check. TODO expand using examples ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -1332,12 +1332,10 @@ data ExpectedFunTyOrigin -- -- Test cases for representation-polymorphism checks: -- RepPolyApp - | forall (p :: Pass) - . (OutputableBndrId p) - => ExpectedFunTyArg + | ExpectedFunTyArg !TypedThing -- ^ function - !(HsExpr (GhcPass p)) + !(HsExpr GhcRn) -- ^ argument -- | Ensure that a function defined by equations indeed has a function type @@ -1380,11 +1378,18 @@ pprExpectedFunTyOrigin funTy_origin i = ExpectedFunTyViewPat expr -> vcat [ the_arg_of <+> text "the view pattern" , nest 2 (ppr expr) ] - ExpectedFunTyArg fun arg -> - sep [ text "The argument" - , quotes (ppr arg) - , text "of" - , quotes (ppr fun) ] + ExpectedFunTyArg fun arg -> case arg of + XExpr (PopSrcSpan (L _ (XExpr (ExpandedStmt (HsExpanded {}))))) -> + vcat [ sep [ the_arg_of + , text "the rebindable syntax operator" + , quotes (ppr fun) + ] + , nest 2 (text "arising from a do stmt") + ] + _ -> sep [ text "The argument" + , quotes (ppr arg) + , text "of" + , quotes (ppr fun) ] ExpectedFunTyMatches fun (MG { mg_alts = L _ alts }) | null alts -> the_arg_of <+> quotes (ppr fun) ===================================== compiler/GHC/Tc/Utils/Instantiate.hs ===================================== @@ -25,7 +25,7 @@ module GHC.Tc.Utils.Instantiate ( tcInstInvisibleTyBindersN, tcInstInvisibleTyBinders, tcInstInvisibleTyBinder, - newOverloadedLit, mkOverLit, + newOverloadedLit, mkOverLit, mkOverLitRn, newClsInst, newFamInst, tcGetInsts, tcGetInstEnvs, getOverlapFlag, @@ -698,6 +698,19 @@ mkOverLit (HsFractional r) mkOverLit (HsIsString src s) = return (HsString src s) +mkOverLitRn ::OverLitVal -> TcM (HsLit GhcRn) +mkOverLitRn (HsIntegral i) + = do { integer_ty <- tcMetaTy integerTyConName + ; return (HsInteger (il_text i) + (il_value i) integer_ty) } + +mkOverLitRn (HsFractional r) + = do { rat_ty <- tcMetaTy rationalTyConName + ; return (HsRat noExtField r rat_ty) } + +mkOverLitRn (HsIsString src s) = return (HsString src s) + + {- ************************************************************************ * * ===================================== testsuite/tests/deSugar/should_compile/T3263-2.hs ===================================== @@ -31,7 +31,6 @@ t5 = do _ <- return (return 10 :: m Int) return 10 - -- Warning t6 :: forall m. MonadFix m => m Int t6 = mdo View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/265cc4fd5cab792f22121bdafdc047e13fb1f374 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/265cc4fd5cab792f22121bdafdc047e13fb1f374 You're receiving 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 Jun 5 17:55:09 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Mon, 05 Jun 2023 13:55:09 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/modern-STV-extension-shuffling] Extension shuffling (#23291) Message-ID: <647e217d48043_1d329d24afd6283502e@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/modern-STV-extension-shuffling at Glasgow Haskell Compiler / GHC Commits: cd320be1 by Andrei Borzenkov at 2023-06-05T21:49:53+04:00 Extension shuffling (#23291) Where introduced 3 new extensions: - PatternSignatures - ExtendedForAllScope - MethodTypeVariables Tasks of ScopedTypeVariables extension were distributed between PatternSignatures, ExtendedForAllScope and MethodTypeVariables according to the proposal. Now ScopedTypeVaribles only implies these three exntesions. - - - - - 29 changed files: - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - docs/users_guide/expected-undocumented-flags.txt - docs/users_guide/exts/explicit_forall.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/scoped_type_variables.rst - docs/users_guide/exts/type_abstractions.rst - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - testsuite/tests/driver/T4437.hs - testsuite/tests/rename/should_fail/T11663.stderr - testsuite/tests/showIface/DocsInHiFile1.stdout - testsuite/tests/showIface/DocsInHiFileTH.stdout - testsuite/tests/showIface/HaddockIssue849.stdout - testsuite/tests/showIface/HaddockOpts.stdout - testsuite/tests/showIface/LanguageExts.stdout - testsuite/tests/showIface/MagicHashInHaddocks.stdout - testsuite/tests/showIface/NoExportList.stdout - testsuite/tests/showIface/PragmaDocs.stdout - testsuite/tests/showIface/ReExports.stdout - testsuite/tests/typecheck/should_fail/PatSynExistential.stderr Changes: ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -1372,7 +1372,7 @@ languageExtensions (Just Haskell2010) LangExt.DoAndIfThenElse, LangExt.FieldSelectors, LangExt.RelaxedPolyRec, - LangExt.DeepSubsumption ] + LangExt.DeepSubsumption] languageExtensions (Just GHC2021) = [LangExt.ImplicitPrelude, @@ -1418,12 +1418,15 @@ languageExtensions (Just GHC2021) LangExt.RankNTypes, LangExt.ScopedTypeVariables, LangExt.TypeAbstractions, -- implied by ScopedTypeVariables according to GHC Proposal #448 "Modern Scoped Type Variables" + LangExt.PatternSignatures, -- implied by ScopedTypeVariables according to ^ + LangExt.MethodTypeVariables, -- implied by ScopedTypeVariables according to ^ + LangExt.ExtendedForAllScope, -- implied by ScopedTypeVariables according to ^ + LangExt.TypeSynonymInstances, LangExt.StandaloneDeriving, LangExt.StandaloneKindSignatures, LangExt.TupleSections, LangExt.TypeApplications, - LangExt.TypeOperators, - LangExt.TypeSynonymInstances] + LangExt.TypeOperators] ways :: DynFlags -> Ways ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2673,8 +2673,9 @@ xFlagsDeps = [ flagSpec "ParallelListComp" LangExt.ParallelListComp, flagSpec "PartialTypeSignatures" LangExt.PartialTypeSignatures, flagSpec "PatternGuards" LangExt.PatternGuards, - depFlagSpec' "PatternSignatures" LangExt.ScopedTypeVariables - (deprecatedForExtension "ScopedTypeVariables"), + flagSpec "PatternSignatures" LangExt.PatternSignatures, + flagSpec "MethodTypeVariables" LangExt.MethodTypeVariables, + flagSpec "ExtendedForAllScope" LangExt.ExtendedForAllScope, flagSpec "PatternSynonyms" LangExt.PatternSynonyms, flagSpec "PolyKinds" LangExt.PolyKinds, flagSpec "PolymorphicComponents" LangExt.RankNTypes, @@ -2767,6 +2768,9 @@ impliedXFlags -- In accordance with GHC Proposal #448 "Modern Scoped Type Variables" , (LangExt.ScopedTypeVariables, turnOn, LangExt.TypeAbstractions) + , (LangExt.ScopedTypeVariables, turnOn, LangExt.PatternSignatures) + , (LangExt.ScopedTypeVariables, turnOn, LangExt.MethodTypeVariables) + , (LangExt.ScopedTypeVariables, turnOn, LangExt.ExtendedForAllScope) , (LangExt.RebindableSyntax, turnOff, LangExt.ImplicitPrelude) -- NB: turn off! ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -819,9 +819,9 @@ enabled. For example, the following will be rejected: instance (Eq a => Show (Maybe a)) where ... This restriction is partly motivated by an unusual quirk of instance -declarations. Namely, if ScopedTypeVariables is enabled, then the type -variables from the top of an instance will scope over the bodies of the -instance methods, /even if the type variables are implicitly quantified/. +declarations. Namely, if MethodTypeVariables (implied by ScopedTypeVariables) is enabled, +then the type variables from the top of an instance will scope over the bodies +of the instance methods, /even if the type variables are implicitly quantified/. For example, GHC will accept the following: instance Monoid a => Monoid (Identity a) where @@ -841,20 +841,20 @@ Somewhat surprisingly, old versions of GHC would accept the instance above. Even though the `forall` only quantifies `a`, the outermost parentheses mean that the `forall` is nested, and per the forall-or-nothing rule, this means that implicit quantification would occur. Therefore, the `a` is explicitly -bound and the `b` is implicitly bound. Moreover, ScopedTypeVariables would -bring /both/ sorts of type variables into scope over the body of `m`. +bound and the `b` is implicitly bound. Moreover, MethodTypeVariables +would bring /both/ sorts of type variables into scope over the body of `m`. How utterly confusing! To avoid this sort of confusion, we simply disallow nested `forall`s in instance types, which makes things like the instance above become illegal. For the sake of consistency, we also disallow nested contexts, even though they -don't have the same strange interaction with ScopedTypeVariables. +don't have the same strange interaction with MethodTypeVariables. Just as we forbid nested `forall`s and contexts in normal instance declarations, we also forbid them in SPECIALISE instance pragmas (#18455). -Unlike normal instance declarations, ScopedTypeVariables don't have any impact -on SPECIALISE instance pragmas, but we use the same validity checks for -SPECIALISE instance pragmas anyway to be consistent. +Unlike normal instance declarations, MethodTypeVariables +don't have any impact on SPECIALISE instance pragmas, but we use the same +validity checks for SPECIALISE instance pragmas anyway to be consistent. ----- -- Wrinkle: Derived instances @@ -863,7 +863,7 @@ SPECIALISE instance pragmas anyway to be consistent. `deriving` clauses and standalone `deriving` declarations also permit bringing type variables into scope, either through explicit or implicit quantification. Unlike in the tops of instance declarations, however, one does not need to -enable ScopedTypeVariables for this to take effect. +enable MethodTypeVariables for this to take effect. Just as GHC forbids nested `forall`s in the top of instance declarations, it also forbids them in types involved with `deriving`: ===================================== compiler/GHC/Rename/Bind.hs ===================================== @@ -519,7 +519,7 @@ rnBind sig_fn bind@(FunBind { fun_id = name -- invariant: no free vars here when it's a FunBind = do { let plain_name = unLoc name - ; (matches', rhs_fvs) <- bindSigTyVarsFV (sig_fn plain_name) $ + ; (matches', rhs_fvs) <- bindSigTyVarsFVExtended (sig_fn plain_name) $ -- bindSigTyVars tests for LangExt.ScopedTyVars rnMatchGroup (mkPrefixFunRhs name) rnLExpr matches @@ -726,7 +726,7 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name ; unless pattern_synonym_ok (addErr TcRnIllegalPatternSynonymDecl) ; let scoped_tvs = sig_fn name - ; ((pat', details'), fvs1) <- bindSigTyVarsFV scoped_tvs $ + ; ((pat', details'), fvs1) <- bindSigTyVarsFVExtended scoped_tvs $ rnPat PatSyn pat $ \pat' -> -- We check the 'RdrName's instead of the 'Name's -- so that the binding locations are reported @@ -763,7 +763,7 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name Unidirectional -> return (Unidirectional, emptyFVs) ImplicitBidirectional -> return (ImplicitBidirectional, emptyFVs) ExplicitBidirectional mg -> - do { (mg', fvs) <- bindSigTyVarsFV scoped_tvs $ + do { (mg', fvs) <- bindSigTyVarsFVExtended scoped_tvs $ rnMatchGroup (mkPrefixFunRhs (L l name)) rnLExpr mg ; return (ExplicitBidirectional mg', fvs) } @@ -920,7 +920,8 @@ rnMethodBinds is_cls_decl cls ktv_names binds sigs -- Rename the bindings RHSs. Again there's an issue about whether the -- type variables from the class/instance head are in scope. -- Answer no in Haskell 2010, but yes if you have -XScopedTypeVariables - ; (binds'', bind_fvs) <- bindSigTyVarsFV ktv_names $ + -- or -XMethodTypeVariables + ; (binds'', bind_fvs) <- bindSigTyVarsFVMethod ktv_names $ do { binds_w_dus <- mapBagM (rnLBind (mkScopedTvFn other_sigs')) binds' ; let bind_fvs = foldr (\(_,_,fv1) fv2 -> fv1 `plusFV` fv2) emptyFVs binds_w_dus ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -523,7 +523,7 @@ rnExpr (HsRecSel x _) = dataConCantHappen x rnExpr (ExprWithTySig _ expr pty) = do { (pty', fvTy) <- rnHsSigWcType ExprWithTySigCtx pty - ; (expr', fvExpr) <- bindSigTyVarsFV (hsWcScopedTvs pty') $ + ; (expr', fvExpr) <- bindSigTyVarsFVExtended (hsWcScopedTvs pty') $ rnLExpr expr ; return (ExprWithTySig noExtField expr' pty', fvExpr `plusFV` fvTy) } ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -31,7 +31,8 @@ module GHC.Rename.HsType ( -- Binding related stuff bindHsOuterTyVarBndrs, bindHsForAllTelescope, bindLHsTyVarBndr, bindLHsTyVarBndrs, WarnUnusedForalls(..), - rnImplicitTvOccs, bindSigTyVarsFV, bindHsQTyVars, + rnImplicitTvOccs, bindSigTyVarsFVExtended, bindSigTyVarsFVMethod, + bindHsQTyVars, FreeKiTyVars, filterInScopeM, extractHsTyRdrTyVars, extractHsTyRdrTyVarsKindVars, extractHsTysRdrTyVars, extractRdrKindSigVars, @@ -150,14 +151,14 @@ rnHsPatSigType :: HsPatSigTypeScoping -> (HsPatSigType GhcRn -> RnM (a, FreeVars)) -> RnM (a, FreeVars) -- Used for --- - Pattern type signatures, which are only allowed with ScopedTypeVariables +-- - Pattern type signatures, which are only allowed with PatternSignatures -- - Signatures on binders in a RULE, which are allowed even if --- ScopedTypeVariables isn't enabled +-- PatternSignatures isn't enabled -- Wildcards are allowed -- -- See Note [Pattern signature binders and scoping] in GHC.Hs.Type rnHsPatSigType scoping ctx sig_ty thing_inside - = do { ty_sig_okay <- xoptM LangExt.ScopedTypeVariables + = do { ty_sig_okay <- xoptM LangExt.PatternSignatures ; checkErr ty_sig_okay (unexpectedPatSigTypeErr sig_ty) ; free_vars <- filterInScopeM (extractHsTyRdrTyVars pat_sig_ty) ; (nwc_rdrs', tv_rdrs) <- partition_nwcs free_vars @@ -900,18 +901,27 @@ notInKinds _ _ = return () * * ***************************************************** -} -bindSigTyVarsFV :: [Name] - -> RnM (a, FreeVars) - -> RnM (a, FreeVars) +bindSigTyVarsFVExtended, bindSigTyVarsFVMethod :: [Name] + -> RnM (a, FreeVars) + -> RnM (a, FreeVars) -- Used just before renaming the defn of a function -- with a separate type signature, to bring its tyvars into scope --- With no -XScopedTypeVariables, this is a no-op -bindSigTyVarsFV tvs thing_inside - = do { scoped_tyvars <- xoptM LangExt.ScopedTypeVariables - ; if not scoped_tyvars then - thing_inside - else - bindLocalNamesFV tvs thing_inside } +-- With no -XExtendedForAllScope/-XMethodTypeVariables, this is a no-op +(bindSigTyVarsFVExtended, bindSigTyVarsFVMethod) + = ( bindSigTyVarsFVIfEnabled LangExt.ExtendedForAllScope + , bindSigTyVarsFVIfEnabled LangExt.MethodTypeVariables + ) + where + bindSigTyVarsFVIfEnabled :: LangExt.Extension + -> [Name] + -> RnM (a, FreeVars) + -> RnM (a, FreeVars) + bindSigTyVarsFVIfEnabled lang_ext tvs thing_inside + = do { can_tyvars_be_in_scope <- xoptM lang_ext + ; if can_tyvars_be_in_scope then + bindLocalNamesFV tvs thing_inside + else + thing_inside } --------------- bindHsQTyVars :: forall a b. ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -198,7 +198,7 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls, -- (H) Rename Everything else - (rn_rule_decls, src_fvs2) <- setXOptM LangExt.ScopedTypeVariables $ + (rn_rule_decls, src_fvs2) <- setXOptM LangExt.PatternSignatures $ rnList rnHsRuleDecls rule_decls ; -- Inside RULES, scoped type variables are on (rn_foreign_decls, src_fvs3) <- rnList rnHsForeignDecl foreign_decls ; ===================================== compiler/GHC/Tc/Deriv.hs ===================================== @@ -273,7 +273,9 @@ renameDeriv inst_infos bagBinds setXOptM LangExt.EmptyCase $ -- Derived decls (for empty types) can have -- case x of {} - setXOptM LangExt.ScopedTypeVariables $ + setXOptM LangExt.MethodTypeVariables $ + setXOptM LangExt.PatternSignatures $ + setXOptM LangExt.ExtendedForAllScope $ setXOptM LangExt.KindSignatures $ -- Derived decls (for newtype-deriving) can use ScopedTypeVariables & -- KindSignatures ===================================== compiler/GHC/Tc/Deriv/Generate.hs ===================================== @@ -1875,9 +1875,9 @@ of the method. For example, recall: join In the example above, it is imperative that the `a` in the instance signature -for `join` scope over the body of `join` by way of ScopedTypeVariables. -This might sound obvious, but note that in gen_Newtype_binds, which is -responsible for generating the code above, the type in `join`'s instance +for `join` scope over the body of `join` by way of ExtendedForallScope (implied +by ScopedTypeVariables). This might sound obvious, but note that in gen_Newtype_binds, +which is responsible for generating the code above, the type in `join`'s instance signature is given as a Core type, whereas gen_Newtype_binds will eventually produce HsBinds (i.e., source Haskell) that is renamed and typechecked. We must ensure that `a` is in scope over the body of `join` during renaming ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1637,9 +1637,7 @@ instance Diagnostic TcRnMessage where nest 4 (text "in the section:" <+> quotes (ppr section))] TcRnUnexpectedPatSigType ty - -> mkSimpleDecorated $ - hang (text "Illegal type signature:" <+> quotes (ppr ty)) - 2 (text "Type signatures are only allowed in patterns with ScopedTypeVariables") + -> mkSimpleDecorated $ text "Illegal type signature:" <+> quotes (ppr ty) TcRnIllegalKindSignature ty -> mkSimpleDecorated $ text "Illegal kind signature:" <+> quotes (ppr ty) @@ -3011,7 +3009,7 @@ instance Diagnostic TcRnMessage where TcRnSectionPrecedenceError{} -> noHints TcRnUnexpectedPatSigType{} - -> [suggestExtension LangExt.ScopedTypeVariables] + -> [suggestExtension LangExt.PatternSignatures] TcRnIllegalKindSignature{} -> [suggestExtension LangExt.KindSignatures] TcRnUnusedQuantifiedTypeVar{} ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -2381,7 +2381,7 @@ data TcRnMessage where -> TcRnMessage {-| TcRnUnexpectedPatSigType is an error occurring when there is - a type signature in a pattern without -XScopedTypeVariables extension + a type signature in a pattern without -XPatternSignatures extension Examples: f (a :: Bool) = ... ===================================== docs/users_guide/expected-undocumented-flags.txt ===================================== @@ -14,7 +14,6 @@ -XMonomorphismRestriction -XParallelArrays -XPatternGuards --XPatternSignatures -XPolymorphicComponents -XRecordPuns -XRelaxedLayout ===================================== docs/users_guide/exts/explicit_forall.rst ===================================== @@ -114,7 +114,7 @@ The ``forall``-or-nothing rule takes effect in the following places: Notes: -- :ref:`pattern-type-sigs` are a notable example of a place where +- :extension:`PatternSignatures` are a notable example of a place where types do *not* obey the ``forall``-or-nothing rule. For example, GHC will accept the following: :: ===================================== docs/users_guide/exts/gadt.rst ===================================== @@ -194,7 +194,7 @@ also sets :extension:`GADTSyntax` and :extension:`MonoLocalBinds`. In the function clause for ``g``, GHC first checks ``MkF``, the outermost pattern, followed by the inner ``Nothing`` pattern. This outside-in order - can interact somewhat counterintuitively with :ref:`pattern-type-sigs`. + can interact somewhat counterintuitively with :extension:`PatternSignatures`. Consider the following variation of ``g``: :: g2 :: F a a -> a ===================================== docs/users_guide/exts/scoped_type_variables.rst ===================================== @@ -6,9 +6,13 @@ Lexically scoped type variables =============================== .. extension:: ScopedTypeVariables - :shortdesc: Enable lexically-scoped type variables. + :shortdesc: Enable lexically-scoped type variables everywhere. - :implies: :extension:`ExplicitForAll` + :implies: :extension:`ExplicitForAll`, + :extension:`PatternSignatures`, + :extension:`ExtendedForAllScope`, + :extension:`MethodTypeVariables`, + :extension:`TypeAbstractions` :since: 6.8.1 @@ -26,7 +30,7 @@ Lexically scoped type variables To trigger those forms of :extension:`ScopedTypeVariables`, the ``forall`` must appear against the top-level signature (or outer expression) but *not* against nested signatures referring to the same type variables. - Explicit ``forall`` is not always required -- see :ref:`pattern signature equivalent ` for the example in this section, or :ref:`pattern-type-sigs`. + Explicit ``forall`` is not always required -- see :ref:`pattern signature equivalent ` for the example in this section, or :extension:`PatternSignatures`. GHC supports *lexically scoped type variables*, without which some type signatures are simply impossible to write. For example: :: @@ -48,7 +52,7 @@ possible to do so. .. _pattern-equiv-form: -An equivalent form for that example, avoiding explicit ``forall`` uses :ref:`pattern-type-sigs`: :: +An equivalent form for that example, avoiding explicit ``forall`` uses :extension:`PatternSignatures`: :: f :: [a] -> [a] f (xs :: [aa]) = xs ++ ys @@ -84,9 +88,9 @@ A *lexically scoped type variable* can be bound by: - An expression type signature (:ref:`exp-type-sigs`) -- A pattern type signature (:ref:`pattern-type-sigs`) +- A pattern type signature (:extension:`PatternSignatures`) -- Class and instance declarations (:ref:`cls-inst-scoped-tyvars`) +- Class and instance declarations (:extension:`MethodTypeVariables`) In Haskell, a programmer-written type signature is implicitly quantified over its free type variables (`Section @@ -100,14 +104,31 @@ scope is *not* universally quantified. For example, if type variable (e :: b -> b) means (e :: forall b. b->b) (e :: a -> b) means (e :: forall b. a->b) +Extended ForAll Scope +===================== + +.. extension:: ExtendedForAllScope + :shortdesc: Enable lexically-scoped type variables in function bindings, + pattern synonyms and expression type signatures. + + :since: 9.8.1 + + :implied by: :extension:`ScopedTypeVariables` + + :status: Included in :extension:`GHC2021` + + Enable lexical scoping of type variables explicitly introduced with + a ``forall`` in function bindings, pattern synonyms and expression type signatures. + .. _decl-type-sigs: Declaration type signatures --------------------------- -A declaration type signature that has *explicit* quantification (using -``forall``) brings into scope the explicitly-quantified type variables, -in the definition of the named function. For example: :: +When :extension:`ExtendedForAllScope` is enabled, a declaration type signature +that has *explicit* quantification (using ``forall``) brings into scope the +explicitly-quantified type variables, in the definition of the named function. +For example: :: f :: forall a. [a] -> [a] f (x:xs) = xs ++ [ x :: a ] @@ -171,9 +192,9 @@ This only happens if: Expression type signatures -------------------------- -An expression type signature that has *explicit* quantification (using -``forall``) brings into scope the explicitly-quantified type variables, -in the annotated expression. For example: :: +When :extension:`ExtendedForAllScope` is enabled, an expression type signature +that has *explicit* quantification (using ``forall``) brings into scope the +explicitly-quantified type variables, in the annotated expression. For example: :: f = runST ( (op >>= \(x :: STRef s Int) -> g x) :: forall s. ST s Bool ) @@ -181,13 +202,22 @@ Here, the type signature ``forall s. ST s Bool`` brings the type variable ``s`` into scope, in the annotated expression ``(op >>= \(x :: STRef s Int) -> g x)``. -.. _pattern-type-sigs: +Pattern Signatures +================== + +.. extension:: PatternSignatures + :shortdesc: Allow type signatures in patterns. -Pattern type signatures ------------------------ + :since: 9.8.1 -A type signature may occur in any pattern; this is a *pattern type -signature*. For example: :: + :implied by: :extension:`ScopedTypeVariables` + + :status: Included in :extension:`GHC2021` + + Allow type signatures and type variable bindings in patterns. + +When :extension:`PatternSignatures` is enabled, a type signature may occur +in any pattern; this is a *pattern type signature*. For example: :: -- f and g assume that 'a' is already in scope f = \(x::Int, y::a) -> x @@ -259,12 +289,21 @@ they are both legal whether or not ``a`` is already in scope. They differ in that *if* ``a`` is already in scope, the signature constrains the pattern, rather than the pattern binding the variable. -.. _cls-inst-scoped-tyvars: +Method Type Variables +===================== + +.. extension:: MethodTypeVariables + :shortdesc: Enable lexically-scoped type variables in class and instance declarations. + + :since: 9.8.1 + + :implied by: :extension:`ScopedTypeVariables` + + :status: Included in :extension:`GHC2021` -Class and instance declarations -------------------------------- + Enable lexical scoping of type variables explicitly introduced by class and instance heads. -:extension:`ScopedTypeVariables` allow the type variables bound by the top of a +:extension:`MethodTypeVariables` allow the type variables bound by the top of a ``class`` or ``instance`` declaration to scope over the methods defined in the ``where`` part. Unlike :ref:`decl-type-sigs`, type variables from class and instance declarations can be lexically scoped without an explicit ``forall`` @@ -286,11 +325,11 @@ declaration; see :ref:`explicit-foralls`). For example: :: instance forall b. C b => C [b] where op xs = reverse (head (xs :: [[b]])) -While :extension:`ScopedTypeVariables` is required for type variables from the +While :extension:`MethodTypeVariables` is required for type variables from the top of a class or instance declaration to scope over the /bodies/ of the methods, it is not required for the type variables to scope over the /type signatures/ of the methods. For example, the following will be accepted without -explicitly enabling :extension:`ScopedTypeVariables`: :: +explicitly enabling :extension:`MethodTypeVariables`: :: class D a where m :: [a] -> a @@ -302,11 +341,11 @@ explicitly enabling :extension:`ScopedTypeVariables`: :: Note that writing ``m :: [a] -> [a]`` requires the use of the :extension:`InstanceSigs` extension. -Similarly, :extension:`ScopedTypeVariables` is not required for type variables +Similarly, :extension:`MethodTypeVariables` is not required for type variables from the top of the class or instance declaration to scope over associated type families, which only requires the :extension:`TypeFamilies` extension. For instance, the following will be accepted without explicitly enabling -:extension:`ScopedTypeVariables`: :: +:extension:`MethodTypeVariables`: :: class E a where type T a ===================================== docs/users_guide/exts/type_abstractions.rst ===================================== @@ -6,6 +6,8 @@ Type abstractions :since: 9.8.1 + :implied by: :extension:`ScopedTypeVariables` + :status: Partially implemented Allow the use of type abstraction syntax. ===================================== libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs ===================================== @@ -153,6 +153,9 @@ data Extension | OverloadedRecordUpdate | TypeAbstractions | ExtendedLiterals + | PatternSignatures + | ExtendedForAllScope + | MethodTypeVariables deriving (Eq, Enum, Show, Generic, Bounded) -- 'Ord' and 'Bounded' are provided for GHC API users (see discussions -- in https://gitlab.haskell.org/ghc/ghc/merge_requests/2707 and ===================================== testsuite/tests/driver/T4437.hs ===================================== @@ -38,7 +38,9 @@ check title expected got expectedGhcOnlyExtensions :: [String] expectedGhcOnlyExtensions = [ "TypeAbstractions", - "ExtendedLiterals" + "ExtendedLiterals", + "MethodTypeVariables", + "ExtendedForAllScope" ] expectedCabalOnlyExtensions :: [String] ===================================== testsuite/tests/rename/should_fail/T11663.stderr ===================================== @@ -1,20 +1,16 @@ T11663.hs:6:12: error: [GHC-74097] Illegal type signature: ‘Int’ - Type signatures are only allowed in patterns with ScopedTypeVariables - Suggested fix: Perhaps you intended to use ScopedTypeVariables + Suggested fix: Perhaps you intended to use PatternSignatures T11663.hs:7:9: error: [GHC-74097] Illegal type signature: ‘Int’ - Type signatures are only allowed in patterns with ScopedTypeVariables - Suggested fix: Perhaps you intended to use ScopedTypeVariables + Suggested fix: Perhaps you intended to use PatternSignatures T11663.hs:8:22: error: [GHC-74097] Illegal type signature: ‘Int’ - Type signatures are only allowed in patterns with ScopedTypeVariables - Suggested fix: Perhaps you intended to use ScopedTypeVariables + Suggested fix: Perhaps you intended to use PatternSignatures T11663.hs:9:32: error: [GHC-74097] Illegal type signature: ‘Int’ - Type signatures are only allowed in patterns with ScopedTypeVariables - Suggested fix: Perhaps you intended to use ScopedTypeVariables + Suggested fix: Perhaps you intended to use PatternSignatures ===================================== testsuite/tests/showIface/DocsInHiFile1.stdout ===================================== @@ -144,5 +144,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/DocsInHiFileTH.stdout ===================================== @@ -287,5 +287,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/HaddockIssue849.stdout ===================================== @@ -67,5 +67,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/HaddockOpts.stdout ===================================== @@ -59,5 +59,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/LanguageExts.stdout ===================================== @@ -23,4 +23,3 @@ docs: CUSKs FieldSelectors extensible fields: - ===================================== testsuite/tests/showIface/MagicHashInHaddocks.stdout ===================================== @@ -69,5 +69,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/NoExportList.stdout ===================================== @@ -95,5 +95,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/PragmaDocs.stdout ===================================== @@ -69,5 +69,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/ReExports.stdout ===================================== @@ -66,5 +66,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/typecheck/should_fail/PatSynExistential.stderr ===================================== @@ -1,4 +1,5 @@ -PatSynExistential.hs:6:1: [GHC-33973] - The result type of the signature for ‘P’, namely ‘x -> Maybe x’ + +PatSynExistential.hs:6:1: error: [GHC-33973] + • The result type of the signature for ‘P’, namely ‘x -> Maybe x’ mentions existential type variable ‘x’ - In the declaration for pattern synonym ‘P’ + • In the declaration for pattern synonym ‘P’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cd320be18678b57de9aaf296cad40bcf4a848f85 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cd320be18678b57de9aaf296cad40bcf4a848f85 You're receiving 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 Jun 5 17:55:26 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Mon, 05 Jun 2023 13:55:26 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/sand-witch/modern-STV-add-warning Message-ID: <647e218ee3fe6_1d329d7acc2fc351271@gitlab.mail> Andrei Borzenkov pushed new branch wip/sand-witch/modern-STV-add-warning at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sand-witch/modern-STV-add-warning You're receiving 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 Jun 5 18:11:09 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Mon, 05 Jun 2023 14:11:09 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/modern-STV-extension-shuffling] Extension shuffling (#23291) Message-ID: <647e253dbf199_1d329d2c6f7788360298@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/modern-STV-extension-shuffling at Glasgow Haskell Compiler / GHC Commits: 6049702e by Andrei Borzenkov at 2023-06-05T22:10:53+04:00 Extension shuffling (#23291) Where introduced 3 new extensions: - PatternSignatures - ExtendedForAllScope - MethodTypeVariables Tasks of ScopedTypeVariables extension were distributed between PatternSignatures, ExtendedForAllScope and MethodTypeVariables according to the proposal. Now ScopedTypeVaribles only implies these three exntesions. - - - - - 30 changed files: - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/expected-undocumented-flags.txt - docs/users_guide/exts/explicit_forall.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/scoped_type_variables.rst - docs/users_guide/exts/type_abstractions.rst - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - testsuite/tests/driver/T4437.hs - testsuite/tests/rename/should_fail/T11663.stderr - testsuite/tests/showIface/DocsInHiFile1.stdout - testsuite/tests/showIface/DocsInHiFileTH.stdout - testsuite/tests/showIface/HaddockIssue849.stdout - testsuite/tests/showIface/HaddockOpts.stdout - testsuite/tests/showIface/LanguageExts.stdout - testsuite/tests/showIface/MagicHashInHaddocks.stdout - testsuite/tests/showIface/NoExportList.stdout - testsuite/tests/showIface/PragmaDocs.stdout - testsuite/tests/showIface/ReExports.stdout - testsuite/tests/typecheck/should_fail/PatSynExistential.stderr Changes: ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -1372,7 +1372,7 @@ languageExtensions (Just Haskell2010) LangExt.DoAndIfThenElse, LangExt.FieldSelectors, LangExt.RelaxedPolyRec, - LangExt.DeepSubsumption ] + LangExt.DeepSubsumption] languageExtensions (Just GHC2021) = [LangExt.ImplicitPrelude, @@ -1418,12 +1418,15 @@ languageExtensions (Just GHC2021) LangExt.RankNTypes, LangExt.ScopedTypeVariables, LangExt.TypeAbstractions, -- implied by ScopedTypeVariables according to GHC Proposal #448 "Modern Scoped Type Variables" + LangExt.PatternSignatures, -- implied by ScopedTypeVariables according to ^ + LangExt.MethodTypeVariables, -- implied by ScopedTypeVariables according to ^ + LangExt.ExtendedForAllScope, -- implied by ScopedTypeVariables according to ^ + LangExt.TypeSynonymInstances, LangExt.StandaloneDeriving, LangExt.StandaloneKindSignatures, LangExt.TupleSections, LangExt.TypeApplications, - LangExt.TypeOperators, - LangExt.TypeSynonymInstances] + LangExt.TypeOperators] ways :: DynFlags -> Ways ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2673,8 +2673,9 @@ xFlagsDeps = [ flagSpec "ParallelListComp" LangExt.ParallelListComp, flagSpec "PartialTypeSignatures" LangExt.PartialTypeSignatures, flagSpec "PatternGuards" LangExt.PatternGuards, - depFlagSpec' "PatternSignatures" LangExt.ScopedTypeVariables - (deprecatedForExtension "ScopedTypeVariables"), + flagSpec "PatternSignatures" LangExt.PatternSignatures, + flagSpec "MethodTypeVariables" LangExt.MethodTypeVariables, + flagSpec "ExtendedForAllScope" LangExt.ExtendedForAllScope, flagSpec "PatternSynonyms" LangExt.PatternSynonyms, flagSpec "PolyKinds" LangExt.PolyKinds, flagSpec "PolymorphicComponents" LangExt.RankNTypes, @@ -2767,6 +2768,9 @@ impliedXFlags -- In accordance with GHC Proposal #448 "Modern Scoped Type Variables" , (LangExt.ScopedTypeVariables, turnOn, LangExt.TypeAbstractions) + , (LangExt.ScopedTypeVariables, turnOn, LangExt.PatternSignatures) + , (LangExt.ScopedTypeVariables, turnOn, LangExt.MethodTypeVariables) + , (LangExt.ScopedTypeVariables, turnOn, LangExt.ExtendedForAllScope) , (LangExt.RebindableSyntax, turnOff, LangExt.ImplicitPrelude) -- NB: turn off! ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -819,9 +819,9 @@ enabled. For example, the following will be rejected: instance (Eq a => Show (Maybe a)) where ... This restriction is partly motivated by an unusual quirk of instance -declarations. Namely, if ScopedTypeVariables is enabled, then the type -variables from the top of an instance will scope over the bodies of the -instance methods, /even if the type variables are implicitly quantified/. +declarations. Namely, if MethodTypeVariables (implied by ScopedTypeVariables) is enabled, +then the type variables from the top of an instance will scope over the bodies +of the instance methods, /even if the type variables are implicitly quantified/. For example, GHC will accept the following: instance Monoid a => Monoid (Identity a) where @@ -841,20 +841,20 @@ Somewhat surprisingly, old versions of GHC would accept the instance above. Even though the `forall` only quantifies `a`, the outermost parentheses mean that the `forall` is nested, and per the forall-or-nothing rule, this means that implicit quantification would occur. Therefore, the `a` is explicitly -bound and the `b` is implicitly bound. Moreover, ScopedTypeVariables would -bring /both/ sorts of type variables into scope over the body of `m`. +bound and the `b` is implicitly bound. Moreover, MethodTypeVariables +would bring /both/ sorts of type variables into scope over the body of `m`. How utterly confusing! To avoid this sort of confusion, we simply disallow nested `forall`s in instance types, which makes things like the instance above become illegal. For the sake of consistency, we also disallow nested contexts, even though they -don't have the same strange interaction with ScopedTypeVariables. +don't have the same strange interaction with MethodTypeVariables. Just as we forbid nested `forall`s and contexts in normal instance declarations, we also forbid them in SPECIALISE instance pragmas (#18455). -Unlike normal instance declarations, ScopedTypeVariables don't have any impact -on SPECIALISE instance pragmas, but we use the same validity checks for -SPECIALISE instance pragmas anyway to be consistent. +Unlike normal instance declarations, MethodTypeVariables +don't have any impact on SPECIALISE instance pragmas, but we use the same +validity checks for SPECIALISE instance pragmas anyway to be consistent. ----- -- Wrinkle: Derived instances @@ -863,7 +863,7 @@ SPECIALISE instance pragmas anyway to be consistent. `deriving` clauses and standalone `deriving` declarations also permit bringing type variables into scope, either through explicit or implicit quantification. Unlike in the tops of instance declarations, however, one does not need to -enable ScopedTypeVariables for this to take effect. +enable MethodTypeVariables for this to take effect. Just as GHC forbids nested `forall`s in the top of instance declarations, it also forbids them in types involved with `deriving`: ===================================== compiler/GHC/Rename/Bind.hs ===================================== @@ -519,7 +519,7 @@ rnBind sig_fn bind@(FunBind { fun_id = name -- invariant: no free vars here when it's a FunBind = do { let plain_name = unLoc name - ; (matches', rhs_fvs) <- bindSigTyVarsFV (sig_fn plain_name) $ + ; (matches', rhs_fvs) <- bindSigTyVarsFVExtended (sig_fn plain_name) $ -- bindSigTyVars tests for LangExt.ScopedTyVars rnMatchGroup (mkPrefixFunRhs name) rnLExpr matches @@ -726,7 +726,7 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name ; unless pattern_synonym_ok (addErr TcRnIllegalPatternSynonymDecl) ; let scoped_tvs = sig_fn name - ; ((pat', details'), fvs1) <- bindSigTyVarsFV scoped_tvs $ + ; ((pat', details'), fvs1) <- bindSigTyVarsFVExtended scoped_tvs $ rnPat PatSyn pat $ \pat' -> -- We check the 'RdrName's instead of the 'Name's -- so that the binding locations are reported @@ -763,7 +763,7 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name Unidirectional -> return (Unidirectional, emptyFVs) ImplicitBidirectional -> return (ImplicitBidirectional, emptyFVs) ExplicitBidirectional mg -> - do { (mg', fvs) <- bindSigTyVarsFV scoped_tvs $ + do { (mg', fvs) <- bindSigTyVarsFVExtended scoped_tvs $ rnMatchGroup (mkPrefixFunRhs (L l name)) rnLExpr mg ; return (ExplicitBidirectional mg', fvs) } @@ -920,7 +920,8 @@ rnMethodBinds is_cls_decl cls ktv_names binds sigs -- Rename the bindings RHSs. Again there's an issue about whether the -- type variables from the class/instance head are in scope. -- Answer no in Haskell 2010, but yes if you have -XScopedTypeVariables - ; (binds'', bind_fvs) <- bindSigTyVarsFV ktv_names $ + -- or -XMethodTypeVariables + ; (binds'', bind_fvs) <- bindSigTyVarsFVMethod ktv_names $ do { binds_w_dus <- mapBagM (rnLBind (mkScopedTvFn other_sigs')) binds' ; let bind_fvs = foldr (\(_,_,fv1) fv2 -> fv1 `plusFV` fv2) emptyFVs binds_w_dus ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -523,7 +523,7 @@ rnExpr (HsRecSel x _) = dataConCantHappen x rnExpr (ExprWithTySig _ expr pty) = do { (pty', fvTy) <- rnHsSigWcType ExprWithTySigCtx pty - ; (expr', fvExpr) <- bindSigTyVarsFV (hsWcScopedTvs pty') $ + ; (expr', fvExpr) <- bindSigTyVarsFVExtended (hsWcScopedTvs pty') $ rnLExpr expr ; return (ExprWithTySig noExtField expr' pty', fvExpr `plusFV` fvTy) } ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -31,7 +31,8 @@ module GHC.Rename.HsType ( -- Binding related stuff bindHsOuterTyVarBndrs, bindHsForAllTelescope, bindLHsTyVarBndr, bindLHsTyVarBndrs, WarnUnusedForalls(..), - rnImplicitTvOccs, bindSigTyVarsFV, bindHsQTyVars, + rnImplicitTvOccs, bindSigTyVarsFVExtended, bindSigTyVarsFVMethod, + bindHsQTyVars, FreeKiTyVars, filterInScopeM, extractHsTyRdrTyVars, extractHsTyRdrTyVarsKindVars, extractHsTysRdrTyVars, extractRdrKindSigVars, @@ -150,14 +151,14 @@ rnHsPatSigType :: HsPatSigTypeScoping -> (HsPatSigType GhcRn -> RnM (a, FreeVars)) -> RnM (a, FreeVars) -- Used for --- - Pattern type signatures, which are only allowed with ScopedTypeVariables +-- - Pattern type signatures, which are only allowed with PatternSignatures -- - Signatures on binders in a RULE, which are allowed even if --- ScopedTypeVariables isn't enabled +-- PatternSignatures isn't enabled -- Wildcards are allowed -- -- See Note [Pattern signature binders and scoping] in GHC.Hs.Type rnHsPatSigType scoping ctx sig_ty thing_inside - = do { ty_sig_okay <- xoptM LangExt.ScopedTypeVariables + = do { ty_sig_okay <- xoptM LangExt.PatternSignatures ; checkErr ty_sig_okay (unexpectedPatSigTypeErr sig_ty) ; free_vars <- filterInScopeM (extractHsTyRdrTyVars pat_sig_ty) ; (nwc_rdrs', tv_rdrs) <- partition_nwcs free_vars @@ -900,18 +901,27 @@ notInKinds _ _ = return () * * ***************************************************** -} -bindSigTyVarsFV :: [Name] - -> RnM (a, FreeVars) - -> RnM (a, FreeVars) +bindSigTyVarsFVExtended, bindSigTyVarsFVMethod :: [Name] + -> RnM (a, FreeVars) + -> RnM (a, FreeVars) -- Used just before renaming the defn of a function -- with a separate type signature, to bring its tyvars into scope --- With no -XScopedTypeVariables, this is a no-op -bindSigTyVarsFV tvs thing_inside - = do { scoped_tyvars <- xoptM LangExt.ScopedTypeVariables - ; if not scoped_tyvars then - thing_inside - else - bindLocalNamesFV tvs thing_inside } +-- With no -XExtendedForAllScope/-XMethodTypeVariables, this is a no-op +(bindSigTyVarsFVExtended, bindSigTyVarsFVMethod) + = ( bindSigTyVarsFVIfEnabled LangExt.ExtendedForAllScope + , bindSigTyVarsFVIfEnabled LangExt.MethodTypeVariables + ) + where + bindSigTyVarsFVIfEnabled :: LangExt.Extension + -> [Name] + -> RnM (a, FreeVars) + -> RnM (a, FreeVars) + bindSigTyVarsFVIfEnabled lang_ext tvs thing_inside + = do { can_tyvars_be_in_scope <- xoptM lang_ext + ; if can_tyvars_be_in_scope then + bindLocalNamesFV tvs thing_inside + else + thing_inside } --------------- bindHsQTyVars :: forall a b. ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -198,7 +198,7 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls, -- (H) Rename Everything else - (rn_rule_decls, src_fvs2) <- setXOptM LangExt.ScopedTypeVariables $ + (rn_rule_decls, src_fvs2) <- setXOptM LangExt.PatternSignatures $ rnList rnHsRuleDecls rule_decls ; -- Inside RULES, scoped type variables are on (rn_foreign_decls, src_fvs3) <- rnList rnHsForeignDecl foreign_decls ; ===================================== compiler/GHC/Tc/Deriv.hs ===================================== @@ -273,7 +273,9 @@ renameDeriv inst_infos bagBinds setXOptM LangExt.EmptyCase $ -- Derived decls (for empty types) can have -- case x of {} - setXOptM LangExt.ScopedTypeVariables $ + setXOptM LangExt.MethodTypeVariables $ + setXOptM LangExt.PatternSignatures $ + setXOptM LangExt.ExtendedForAllScope $ setXOptM LangExt.KindSignatures $ -- Derived decls (for newtype-deriving) can use ScopedTypeVariables & -- KindSignatures ===================================== compiler/GHC/Tc/Deriv/Generate.hs ===================================== @@ -1875,9 +1875,9 @@ of the method. For example, recall: join In the example above, it is imperative that the `a` in the instance signature -for `join` scope over the body of `join` by way of ScopedTypeVariables. -This might sound obvious, but note that in gen_Newtype_binds, which is -responsible for generating the code above, the type in `join`'s instance +for `join` scope over the body of `join` by way of ExtendedForallScope (implied +by ScopedTypeVariables). This might sound obvious, but note that in gen_Newtype_binds, +which is responsible for generating the code above, the type in `join`'s instance signature is given as a Core type, whereas gen_Newtype_binds will eventually produce HsBinds (i.e., source Haskell) that is renamed and typechecked. We must ensure that `a` is in scope over the body of `join` during renaming ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1637,9 +1637,7 @@ instance Diagnostic TcRnMessage where nest 4 (text "in the section:" <+> quotes (ppr section))] TcRnUnexpectedPatSigType ty - -> mkSimpleDecorated $ - hang (text "Illegal type signature:" <+> quotes (ppr ty)) - 2 (text "Type signatures are only allowed in patterns with ScopedTypeVariables") + -> mkSimpleDecorated $ text "Illegal type signature:" <+> quotes (ppr ty) TcRnIllegalKindSignature ty -> mkSimpleDecorated $ text "Illegal kind signature:" <+> quotes (ppr ty) @@ -3011,7 +3009,7 @@ instance Diagnostic TcRnMessage where TcRnSectionPrecedenceError{} -> noHints TcRnUnexpectedPatSigType{} - -> [suggestExtension LangExt.ScopedTypeVariables] + -> [suggestExtension LangExt.PatternSignatures] TcRnIllegalKindSignature{} -> [suggestExtension LangExt.KindSignatures] TcRnUnusedQuantifiedTypeVar{} ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -2381,7 +2381,7 @@ data TcRnMessage where -> TcRnMessage {-| TcRnUnexpectedPatSigType is an error occurring when there is - a type signature in a pattern without -XScopedTypeVariables extension + a type signature in a pattern without -XPatternSignatures extension Examples: f (a :: Bool) = ... ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -10,6 +10,11 @@ Language sized primitive literals, e.g. ``123#Int8`` is a literal of type ``Int8#``. See the GHC proposal `#451 `_. +- :extension:`ScopedTypeVariables` was split into several new extensions: + :extension:`PatternSignatures`, :extension:`ExtendedForAllScope`, :extension:`MethodTypeVariables`. + You can set :extension:`ScopedTypeVariables` to enable them all or enable them individually + for more fine-grained control of features that you want to have. + Compiler ~~~~~~~~ ===================================== docs/users_guide/expected-undocumented-flags.txt ===================================== @@ -14,7 +14,6 @@ -XMonomorphismRestriction -XParallelArrays -XPatternGuards --XPatternSignatures -XPolymorphicComponents -XRecordPuns -XRelaxedLayout ===================================== docs/users_guide/exts/explicit_forall.rst ===================================== @@ -114,7 +114,7 @@ The ``forall``-or-nothing rule takes effect in the following places: Notes: -- :ref:`pattern-type-sigs` are a notable example of a place where +- :extension:`PatternSignatures` are a notable example of a place where types do *not* obey the ``forall``-or-nothing rule. For example, GHC will accept the following: :: ===================================== docs/users_guide/exts/gadt.rst ===================================== @@ -194,7 +194,7 @@ also sets :extension:`GADTSyntax` and :extension:`MonoLocalBinds`. In the function clause for ``g``, GHC first checks ``MkF``, the outermost pattern, followed by the inner ``Nothing`` pattern. This outside-in order - can interact somewhat counterintuitively with :ref:`pattern-type-sigs`. + can interact somewhat counterintuitively with :extension:`PatternSignatures`. Consider the following variation of ``g``: :: g2 :: F a a -> a ===================================== docs/users_guide/exts/scoped_type_variables.rst ===================================== @@ -6,9 +6,13 @@ Lexically scoped type variables =============================== .. extension:: ScopedTypeVariables - :shortdesc: Enable lexically-scoped type variables. + :shortdesc: Enable lexically-scoped type variables everywhere. - :implies: :extension:`ExplicitForAll` + :implies: :extension:`ExplicitForAll`, + :extension:`PatternSignatures`, + :extension:`ExtendedForAllScope`, + :extension:`MethodTypeVariables`, + :extension:`TypeAbstractions` :since: 6.8.1 @@ -26,7 +30,7 @@ Lexically scoped type variables To trigger those forms of :extension:`ScopedTypeVariables`, the ``forall`` must appear against the top-level signature (or outer expression) but *not* against nested signatures referring to the same type variables. - Explicit ``forall`` is not always required -- see :ref:`pattern signature equivalent ` for the example in this section, or :ref:`pattern-type-sigs`. + Explicit ``forall`` is not always required -- see :ref:`pattern signature equivalent ` for the example in this section, or :extension:`PatternSignatures`. GHC supports *lexically scoped type variables*, without which some type signatures are simply impossible to write. For example: :: @@ -48,7 +52,7 @@ possible to do so. .. _pattern-equiv-form: -An equivalent form for that example, avoiding explicit ``forall`` uses :ref:`pattern-type-sigs`: :: +An equivalent form for that example, avoiding explicit ``forall`` uses :extension:`PatternSignatures`: :: f :: [a] -> [a] f (xs :: [aa]) = xs ++ ys @@ -84,9 +88,9 @@ A *lexically scoped type variable* can be bound by: - An expression type signature (:ref:`exp-type-sigs`) -- A pattern type signature (:ref:`pattern-type-sigs`) +- A pattern type signature (:extension:`PatternSignatures`) -- Class and instance declarations (:ref:`cls-inst-scoped-tyvars`) +- Class and instance declarations (:extension:`MethodTypeVariables`) In Haskell, a programmer-written type signature is implicitly quantified over its free type variables (`Section @@ -100,14 +104,31 @@ scope is *not* universally quantified. For example, if type variable (e :: b -> b) means (e :: forall b. b->b) (e :: a -> b) means (e :: forall b. a->b) +Extended ForAll Scope +===================== + +.. extension:: ExtendedForAllScope + :shortdesc: Enable lexically-scoped type variables in function bindings, + pattern synonyms and expression type signatures. + + :since: 9.8.1 + + :implied by: :extension:`ScopedTypeVariables` + + :status: Included in :extension:`GHC2021` + + Enable lexical scoping of type variables explicitly introduced with + a ``forall`` in function bindings, pattern synonyms and expression type signatures. + .. _decl-type-sigs: Declaration type signatures --------------------------- -A declaration type signature that has *explicit* quantification (using -``forall``) brings into scope the explicitly-quantified type variables, -in the definition of the named function. For example: :: +When :extension:`ExtendedForAllScope` is enabled, a declaration type signature +that has *explicit* quantification (using ``forall``) brings into scope the +explicitly-quantified type variables, in the definition of the named function. +For example: :: f :: forall a. [a] -> [a] f (x:xs) = xs ++ [ x :: a ] @@ -171,9 +192,9 @@ This only happens if: Expression type signatures -------------------------- -An expression type signature that has *explicit* quantification (using -``forall``) brings into scope the explicitly-quantified type variables, -in the annotated expression. For example: :: +When :extension:`ExtendedForAllScope` is enabled, an expression type signature +that has *explicit* quantification (using ``forall``) brings into scope the +explicitly-quantified type variables, in the annotated expression. For example: :: f = runST ( (op >>= \(x :: STRef s Int) -> g x) :: forall s. ST s Bool ) @@ -181,13 +202,22 @@ Here, the type signature ``forall s. ST s Bool`` brings the type variable ``s`` into scope, in the annotated expression ``(op >>= \(x :: STRef s Int) -> g x)``. -.. _pattern-type-sigs: +Pattern Signatures +================== + +.. extension:: PatternSignatures + :shortdesc: Allow type signatures in patterns. -Pattern type signatures ------------------------ + :since: 9.8.1 -A type signature may occur in any pattern; this is a *pattern type -signature*. For example: :: + :implied by: :extension:`ScopedTypeVariables` + + :status: Included in :extension:`GHC2021` + + Allow type signatures and type variable bindings in patterns. + +When :extension:`PatternSignatures` is enabled, a type signature may occur +in any pattern; this is a *pattern type signature*. For example: :: -- f and g assume that 'a' is already in scope f = \(x::Int, y::a) -> x @@ -259,12 +289,21 @@ they are both legal whether or not ``a`` is already in scope. They differ in that *if* ``a`` is already in scope, the signature constrains the pattern, rather than the pattern binding the variable. -.. _cls-inst-scoped-tyvars: +Method Type Variables +===================== + +.. extension:: MethodTypeVariables + :shortdesc: Enable lexically-scoped type variables in class and instance declarations. + + :since: 9.8.1 + + :implied by: :extension:`ScopedTypeVariables` + + :status: Included in :extension:`GHC2021` -Class and instance declarations -------------------------------- + Enable lexical scoping of type variables explicitly introduced by class and instance heads. -:extension:`ScopedTypeVariables` allow the type variables bound by the top of a +:extension:`MethodTypeVariables` allow the type variables bound by the top of a ``class`` or ``instance`` declaration to scope over the methods defined in the ``where`` part. Unlike :ref:`decl-type-sigs`, type variables from class and instance declarations can be lexically scoped without an explicit ``forall`` @@ -286,11 +325,11 @@ declaration; see :ref:`explicit-foralls`). For example: :: instance forall b. C b => C [b] where op xs = reverse (head (xs :: [[b]])) -While :extension:`ScopedTypeVariables` is required for type variables from the +While :extension:`MethodTypeVariables` is required for type variables from the top of a class or instance declaration to scope over the /bodies/ of the methods, it is not required for the type variables to scope over the /type signatures/ of the methods. For example, the following will be accepted without -explicitly enabling :extension:`ScopedTypeVariables`: :: +explicitly enabling :extension:`MethodTypeVariables`: :: class D a where m :: [a] -> a @@ -302,11 +341,11 @@ explicitly enabling :extension:`ScopedTypeVariables`: :: Note that writing ``m :: [a] -> [a]`` requires the use of the :extension:`InstanceSigs` extension. -Similarly, :extension:`ScopedTypeVariables` is not required for type variables +Similarly, :extension:`MethodTypeVariables` is not required for type variables from the top of the class or instance declaration to scope over associated type families, which only requires the :extension:`TypeFamilies` extension. For instance, the following will be accepted without explicitly enabling -:extension:`ScopedTypeVariables`: :: +:extension:`MethodTypeVariables`: :: class E a where type T a ===================================== docs/users_guide/exts/type_abstractions.rst ===================================== @@ -6,6 +6,8 @@ Type abstractions :since: 9.8.1 + :implied by: :extension:`ScopedTypeVariables` + :status: Partially implemented Allow the use of type abstraction syntax. ===================================== libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs ===================================== @@ -153,6 +153,9 @@ data Extension | OverloadedRecordUpdate | TypeAbstractions | ExtendedLiterals + | PatternSignatures + | ExtendedForAllScope + | MethodTypeVariables deriving (Eq, Enum, Show, Generic, Bounded) -- 'Ord' and 'Bounded' are provided for GHC API users (see discussions -- in https://gitlab.haskell.org/ghc/ghc/merge_requests/2707 and ===================================== testsuite/tests/driver/T4437.hs ===================================== @@ -38,7 +38,9 @@ check title expected got expectedGhcOnlyExtensions :: [String] expectedGhcOnlyExtensions = [ "TypeAbstractions", - "ExtendedLiterals" + "ExtendedLiterals", + "MethodTypeVariables", + "ExtendedForAllScope" ] expectedCabalOnlyExtensions :: [String] ===================================== testsuite/tests/rename/should_fail/T11663.stderr ===================================== @@ -1,20 +1,16 @@ T11663.hs:6:12: error: [GHC-74097] Illegal type signature: ‘Int’ - Type signatures are only allowed in patterns with ScopedTypeVariables - Suggested fix: Perhaps you intended to use ScopedTypeVariables + Suggested fix: Perhaps you intended to use PatternSignatures T11663.hs:7:9: error: [GHC-74097] Illegal type signature: ‘Int’ - Type signatures are only allowed in patterns with ScopedTypeVariables - Suggested fix: Perhaps you intended to use ScopedTypeVariables + Suggested fix: Perhaps you intended to use PatternSignatures T11663.hs:8:22: error: [GHC-74097] Illegal type signature: ‘Int’ - Type signatures are only allowed in patterns with ScopedTypeVariables - Suggested fix: Perhaps you intended to use ScopedTypeVariables + Suggested fix: Perhaps you intended to use PatternSignatures T11663.hs:9:32: error: [GHC-74097] Illegal type signature: ‘Int’ - Type signatures are only allowed in patterns with ScopedTypeVariables - Suggested fix: Perhaps you intended to use ScopedTypeVariables + Suggested fix: Perhaps you intended to use PatternSignatures ===================================== testsuite/tests/showIface/DocsInHiFile1.stdout ===================================== @@ -144,5 +144,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/DocsInHiFileTH.stdout ===================================== @@ -287,5 +287,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/HaddockIssue849.stdout ===================================== @@ -67,5 +67,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/HaddockOpts.stdout ===================================== @@ -59,5 +59,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/LanguageExts.stdout ===================================== @@ -23,4 +23,3 @@ docs: CUSKs FieldSelectors extensible fields: - ===================================== testsuite/tests/showIface/MagicHashInHaddocks.stdout ===================================== @@ -69,5 +69,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/NoExportList.stdout ===================================== @@ -95,5 +95,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/PragmaDocs.stdout ===================================== @@ -69,5 +69,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/ReExports.stdout ===================================== @@ -66,5 +66,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/typecheck/should_fail/PatSynExistential.stderr ===================================== @@ -1,4 +1,5 @@ -PatSynExistential.hs:6:1: [GHC-33973] - The result type of the signature for ‘P’, namely ‘x -> Maybe x’ + +PatSynExistential.hs:6:1: error: [GHC-33973] + • The result type of the signature for ‘P’, namely ‘x -> Maybe x’ mentions existential type variable ‘x’ - In the declaration for pattern synonym ‘P’ + • In the declaration for pattern synonym ‘P’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6049702e35e2a0cdc43731135b55ad6f95c318b0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6049702e35e2a0cdc43731135b55ad6f95c318b0 You're receiving 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 Jun 5 18:12:03 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Mon, 05 Jun 2023 14:12:03 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/modern-STV-add-warning] 2 commits: Extension shuffling (#23291) Message-ID: <647e2573acb26_1d329d27191f3c363315@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/modern-STV-add-warning at Glasgow Haskell Compiler / GHC Commits: 6049702e by Andrei Borzenkov at 2023-06-05T22:10:53+04:00 Extension shuffling (#23291) Where introduced 3 new extensions: - PatternSignatures - ExtendedForAllScope - MethodTypeVariables Tasks of ScopedTypeVariables extension were distributed between PatternSignatures, ExtendedForAllScope and MethodTypeVariables according to the proposal. Now ScopedTypeVaribles only implies these three exntesions. - - - - - 1f1f2036 by Andrei Borzenkov at 2023-06-05T22:11:49+04:00 Adding -Wpattern-signature-binds (#23291) Was introduced one new warning option: -Wpattern-signature-binds It warns when pattern signature binds into scope new type variable. For example: f (a :: t) = ... - - - - - 30 changed files: - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/expected-undocumented-flags.txt - docs/users_guide/exts/explicit_forall.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/scoped_type_variables.rst - docs/users_guide/exts/type_abstractions.rst - docs/users_guide/using-warnings.rst - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - testsuite/tests/driver/T4437.hs - testsuite/tests/rename/should_fail/T11663.stderr - + testsuite/tests/rename/should_fail/WPatternSigBinds.hs - + testsuite/tests/rename/should_fail/WPatternSigBinds.stderr - testsuite/tests/rename/should_fail/all.T - testsuite/tests/showIface/DocsInHiFile1.stdout - testsuite/tests/showIface/DocsInHiFileTH.stdout - testsuite/tests/showIface/HaddockIssue849.stdout - testsuite/tests/showIface/HaddockOpts.stdout The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/78d9205523f10cb8a5b03030ed56198cad21fa15...1f1f20364a7f609645e8a09277d5f3a94e6afa97 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/78d9205523f10cb8a5b03030ed56198cad21fa15...1f1f20364a7f609645e8a09277d5f3a94e6afa97 You're receiving 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 Jun 5 19:37:59 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 05 Jun 2023 15:37:59 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 5 commits: ghc-toolchain: Toolchain Selection Message-ID: <647e3997979e3_1d329d24afd62838017c@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: ff18cd7c by Rodrigo Mesquita at 2023-06-05T20:37:44+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b480f4ab1514ac0a4fc957db199d1a0279. Revert get_arm_isa deletion from 74f03f243d08aa910d39cdd9dadb976e9386283a As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X - - - - - 39cbceb6 by Rodrigo Mesquita at 2023-06-05T20:37:46+01:00 configure: Revert ripping out of toolchain selection logic - - - - - 3c9c636d by Rodrigo Mesquita at 2023-06-05T20:37:46+01:00 Stop configuring into settings unused Ld command - - - - - 8c3fcb4d by Rodrigo Mesquita at 2023-06-05T20:37:46+01:00 configure: Create and validate toolchain target file - - - - - 4e7b8caa by Rodrigo Mesquita at 2023-06-05T20:37:46+01:00 Fixes to match configure output - - - - - 30 changed files: - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/SysTools.hs - compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - + default.target.in - distrib/configure.ac.in - ghc/Main.hs - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Builders/Cabal.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f2b47a59bcc5fe3f9b17d6321d9a9e7ee062d8dc...4e7b8caa8995fc7996b2672ae18f9ee2c607de95 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f2b47a59bcc5fe3f9b17d6321d9a9e7ee062d8dc...4e7b8caa8995fc7996b2672ae18f9ee2c607de95 You're receiving 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 Jun 5 20:00:30 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 05 Jun 2023 16:00:30 -0400 Subject: [Git][ghc/ghc][master] 8 commits: Big TcLclEnv and CtLoc refactoring Message-ID: <647e3ede7ced9_1d329d3d01d88439087c@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 30 changed files: - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/Plugins.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Hole/FitTypes.hs - − compiler/GHC/Tc/Errors/Hole/FitTypes.hs-boot - + compiler/GHC/Tc/Errors/Hole/Plugin.hs - + compiler/GHC/Tc/Errors/Hole/Plugin.hs-boot - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - + compiler/GHC/Tc/Errors/Types/PromotionErr.hs - compiler/GHC/Tc/Gen/Foreign.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Solve.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b2c745db6a817993dcef03551243a2fd2b3ea756...698d160cb5dec68c0aa27920bbd7f03a312e4760 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b2c745db6a817993dcef03551243a2fd2b3ea756...698d160cb5dec68c0aa27920bbd7f03a312e4760 You're receiving 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 Jun 5 20:01:12 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 05 Jun 2023 16:01:12 -0400 Subject: [Git][ghc/ghc][master] TTG: only allow VarBind at GhcTc Message-ID: <647e3f08640ac_1d329d3383c2b8394312@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 5 changed files: - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Tc/Gen/Bind.hs Changes: ===================================== compiler/GHC/Hs/Binds.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} @@ -120,7 +121,11 @@ type instance XPatBind GhcTc (GhcPass pR) = , ( [CoreTickish] -- Ticks to put on the rhs, if any , [[CoreTickish]] ) ) -- and ticks to put on the bound variables. -type instance XVarBind (GhcPass pL) (GhcPass pR) = NoExtField +type instance XVarBind (GhcPass pL) (GhcPass pR) = XVarBindGhc pL pR +type family XVarBindGhc pL pR where + XVarBindGhc 'Typechecked 'Typechecked = NoExtField + XVarBindGhc _ _ = DataConCantHappen + type instance XPatSynBind (GhcPass pL) (GhcPass pR) = NoExtField type instance XXHsBindsLR GhcPs pR = DataConCantHappen ===================================== compiler/GHC/Hs/Utils.hs ===================================== @@ -819,7 +819,7 @@ mkTopFunBind origin fn ms = FunBind { fun_id = fn mkHsVarBind :: SrcSpan -> RdrName -> LHsExpr GhcPs -> LHsBind GhcPs mkHsVarBind loc var rhs = mkSimpleGeneratedFunBind loc var [] rhs -mkVarBind :: IdP (GhcPass p) -> LHsExpr (GhcPass p) -> LHsBind (GhcPass p) +mkVarBind :: IdP GhcTc -> LHsExpr GhcTc -> LHsBind GhcTc mkVarBind var rhs = L (getLoc rhs) $ VarBind { var_ext = noExtField, var_id = var, var_rhs = rhs } ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -1931,15 +1931,6 @@ rep_bind (L loc (PatBind { pat_lhs = pat ; ans' <- wrapGenSyms ss ans ; return (locA loc, ans') } -rep_bind (L _ (VarBind { var_id = v, var_rhs = e})) - = do { v' <- lookupBinder v - ; e2 <- repLE e - ; x <- repNormal e2 - ; patcore <- repPvar v' - ; empty_decls <- coreListM decTyConName [] - ; ans <- repVal patcore x empty_decls - ; return (srcLocSpan (getSrcLoc v), ans) } - rep_bind (L loc (PatSynBind _ (PSB { psb_id = syn , psb_args = args , psb_def = pat @@ -1978,6 +1969,8 @@ rep_bind (L loc (PatSynBind _ (PSB { psb_id = syn wrapGenArgSyms (RecCon _) _ dec = return dec wrapGenArgSyms _ ss dec = wrapGenSyms ss dec +rep_bind (L _ (VarBind { var_ext = x })) = dataConCantHappen x + repPatSynD :: Core TH.Name -> Core (M TH.PatSynArgs) -> Core (M TH.PatSynDir) ===================================== compiler/GHC/Rename/Bind.hs ===================================== @@ -542,7 +542,7 @@ rnBind sig_fn (PatSynBind x bind) = do { (bind', name, fvs) <- rnPatSynBind sig_fn bind ; return (PatSynBind x bind', name, fvs) } -rnBind _ b@(VarBind {}) = pprPanic "rnBind" (ppr b) +rnBind _ (VarBind { var_ext = x }) = dataConCantHappen x -- See Note [Pattern bindings that bind no variables] isOkNoBindPattern :: LPat GhcRn -> Bool ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -780,11 +780,12 @@ checkMonomorphismRestriction mbis lbinds no_mr_name _ = Nothing -- The Haskell 98 monomorphism restriction + restricted :: HsBindLR GhcRn GhcRn -> Bool restricted (PatBind {}) = True - restricted (VarBind { var_id = v }) = mr_needed_for v restricted (FunBind { fun_id = v, fun_matches = m }) = restricted_match m && mr_needed_for (unLoc v) - restricted b = pprPanic "isRestrictedGroup/unrestricted" (ppr b) + restricted (VarBind { var_ext = x }) = dataConCantHappen x + restricted b@(PatSynBind {}) = pprPanic "isRestrictedGroup/unrestricted" (ppr b) restricted_match mg = matchGroupArity mg == 0 -- No args => like a pattern binding @@ -1518,8 +1519,10 @@ tcLhs sig_fn no_gen (PatBind { pat_lhs = pat, pat_rhs = grhss }) Just (TcIdSig sig) -> Right (name, sig) _ -> Left name -tcLhs _ _ other_bind = pprPanic "tcLhs" (ppr other_bind) - -- AbsBind, VarBind impossible +tcLhs _ _ b@(PatSynBind {}) = pprPanic "tcLhs: PatSynBind" (ppr b) + -- pattern synonyms are handled separately; see tc_single + +tcLhs _ _ (VarBind { var_ext = x }) = dataConCantHappen x lookupMBI :: Name -> TcM MonoBindInfo -- After typechecking the pattern, look up the binder View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/58ccf02eb33073739c2849b3d9215a3d36906bc6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/58ccf02eb33073739c2849b3d9215a3d36906bc6 You're receiving 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 Jun 5 21:20:09 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Mon, 05 Jun 2023 17:20:09 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/no-stub-dir-include Message-ID: <647e51896af94_1d329d3fbc395c40420@gitlab.mail> Finley McIlwaine pushed new branch wip/no-stub-dir-include at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/no-stub-dir-include You're receiving 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 Jun 5 21:27:43 2023 From: gitlab at gitlab.haskell.org (Andrey Mokhov (@snowleopard)) Date: Mon, 05 Jun 2023 17:27:43 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/hadrian-fix-multiline-synopsis Message-ID: <647e534f2c503_1d329d3f9c950c40684f@gitlab.mail> Andrey Mokhov deleted branch wip/hadrian-fix-multiline-synopsis 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 Mon Jun 5 21:54:10 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 05 Jun 2023 17:54:10 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Fixes to match configure output Message-ID: <647e59824b8e3_1d329d3f27ee5041392c@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 64ef522c by Rodrigo Mesquita at 2023-06-05T22:53:59+01:00 Fixes to match configure output - - - - - 3 changed files: - utils/ghc-toolchain/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/PlatformDetails.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs Changes: ===================================== utils/ghc-toolchain/Main.hs ===================================== @@ -160,9 +160,11 @@ options = -- Empty list of flags is as if it was unspecified updatePoFlags "" existingOpts = existingOpts - -- Otherwise append specified flags to existing flags or make new + -- Otherwise prepend specified flags to existing flags or make new updatePoFlags newOpts Nothing = Just [newOpts] - updatePoFlags newOpts (Just eopts) = Just (eopts ++ [newOpts]) + updatePoFlags newOpts (Just eopts) = Just (newOpts:eopts) + -- NB: By prepending, the resulting flags will match the left-to-right + -- order they were passed in enableDisable :: String -> String -> Lens Opts (Maybe Bool) -> [OptDescr (Opts -> Opts)] @@ -329,7 +331,7 @@ mkTarget opts = do tgtWordSize <- checkWordSize cc tgtEndianness <- checkEndianness cc tgtSymbolsHaveLeadingUnderscore <- checkLeadingUnderscore cc nm - tgtSupportsSubsectionsViaSymbols <- checkSubsectionsViaSymbols cc + tgtSupportsSubsectionsViaSymbols <- checkSubsectionsViaSymbols archOs cc tgtSupportsIdentDirective <- checkIdentDirective cc tgtSupportsGnuNonexecStack <- checkGnuNonexecStack archOs cc @@ -340,7 +342,7 @@ mkTarget opts = do tgtUseLibffi <- determineUseLibFFIForAdjustors archOs (optUseLibFFIForAdjustors opts) when tgtUnregisterised $ do -- The via-C code generator requires these - let prog = "int main(int argc, char** argv) { return 0; }I" + let prog = "int main(int argc, char** argv) { return 0; }" via_c_args = ["-fwrapv", "-fno-builtin"] forM_ via_c_args $ \arg -> checking ("support of "++arg) $ withTempDir $ \dir -> do let cc' = over (_ccProgram % _prgFlags) (++ [arg]) cc ===================================== utils/ghc-toolchain/src/GHC/Toolchain/PlatformDetails.hs ===================================== @@ -102,11 +102,17 @@ checkLeadingUnderscore cc nm = checking ctxt $ withTempDir $ \dir -> do prog = "int func(void) { return 0; }" ctxt = "whether symbols have leading underscores" -checkSubsectionsViaSymbols :: Cc -> M Bool -checkSubsectionsViaSymbols = - testCompile - "whether .subsections-via-symbols directive is supported" - (asmStmt ".subsections_via_symbols") +checkSubsectionsViaSymbols :: ArchOS -> Cc -> M Bool +checkSubsectionsViaSymbols archos cc = + case archOS_arch archos of + ArchAArch64 -> + -- subsections via symbols is busted on arm64 + -- TODO: ^ is this comment up to date? + return False + _ -> + testCompile + "whether .subsections-via-symbols directive is supported" + (asmStmt ".subsections_via_symbols") cc checkIdentDirective :: Cc -> M Bool checkIdentDirective = ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -109,12 +109,13 @@ checkSupportsNoPie ccLink = checking "whether the cc linker supports -no-pie" $ -- Check output as some GCC versions only warn and don't respect -Werror -- when passed an unrecognized flag. (code, out, _err) <- readProgram ccLink ["-no-pie", "-Werror", "-x", "c", test_c, "-o", test] - if isSuccess code && "unrecognized" `isInfixOf` out - then return False - else return True + return (isSuccess code && not ("unrecognized" `isInfixOf` out)) checkSupportsCompactUnwind :: Cc -> Program -> M Bool checkSupportsCompactUnwind cc ccLink = checking "whether the cc linker understands -no_compact_unwind" $ + -- ROMES:TODO: This returns False here but True in configure because in + -- configure we check for ld supports compact unwind, whereas here we check + -- for cclink supports compact unwind... what do we need it for? withTempDir $ \dir -> do let test_o = dir "test.o" test2_o = dir "test2.o" @@ -122,7 +123,7 @@ checkSupportsCompactUnwind cc ccLink = checking "whether the cc linker understan compileC cc test_o "int foo() { return 0; }" exitCode <- runProgram ccLink ["-r", "-no_compact_unwind", "-o", test2_o, test_o] - pure $ isSuccess exitCode + return $ isSuccess exitCode checkSupportsFilelist :: Cc -> Program -> M Bool checkSupportsFilelist cc ccLink = checking "whether the cc linker understands -filelist" $ @@ -135,15 +136,17 @@ checkSupportsFilelist cc ccLink = checking "whether the cc linker understands -f compileC cc test1_o "int foo() { return 0; }" compileC cc test2_o "int bar() { return 0; }" - writeFile test_ofiles test1_o -- write the filename test1_o to the test_ofiles file - appendFile test_ofiles test2_o -- append the filename test2_o to the test_ofiles file + -- write the filenames test1_o and test2_o to the test_ofiles file + writeFile test_ofiles (unlines [test1_o,test2_o]) exitCode <- runProgram ccLink ["-r", "-filelist", test_ofiles, "-o", test_o] - pure $ isSuccess exitCode + return (isSuccess exitCode) checkSupportsResponseFiles :: Cc -> Program -> M Bool checkSupportsResponseFiles cc ccLink = checking "whether the cc linker supports response files" $ + -- ROMES:TODO: This returns True here while False in configure because in + -- configure we call -shared and -dylib on LD, whereas here we do it on CcLink withTempDir $ \dir -> do let test_o = dir "test.o" compileC cc test_o "int main(void) {return 0;}" @@ -155,7 +158,7 @@ checkSupportsResponseFiles cc ccLink = checking "whether the cc linker supports -- TODO: It'd be good to shortcircuit this logical `or` exitCode1 <- runProgram ccLink ["-shared", "@"++args_txt] exitCode2 <- runProgram ccLink ["-dylib", "@"++args_txt] - pure (isSuccess exitCode1 || isSuccess exitCode2) + return (isSuccess exitCode1 || isSuccess exitCode2) -- | Check whether linking works. checkLinkWorks :: Cc -> Program -> M () View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/64ef522ca2d655d458d3674bea5ddf0c13f900e4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/64ef522ca2d655d458d3674bea5ddf0c13f900e4 You're receiving 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 Jun 5 22:17:52 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 05 Jun 2023 18:17:52 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 2 commits: configure: Create and validate toolchain target file Message-ID: <647e5f1023b68_1d329d3fa0b4fc41875a@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 0d39eb62 by Rodrigo Mesquita at 2023-06-05T23:13:31+01:00 configure: Create and validate toolchain target file - - - - - 2bd70e58 by Rodrigo Mesquita at 2023-06-05T23:13:35+01:00 Fixes to match configure output - - - - - 10 changed files: - configure.ac - + default.target.in - distrib/configure.ac.in - m4/ghc_toolchain.m4 - + m4/prep_target_file.m4 - utils/ghc-toolchain/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/PlatformDetails.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs Changes: ===================================== configure.ac ===================================== @@ -644,7 +644,6 @@ dnl CONF_CC_OPTS_STAGE[012] accordingly. FP_CC_SUPPORTS_TARGET([$CC_STAGE0], [CONF_CC_OPTS_STAGE0], [CONF_CXX_OPTS_STAGE0], [CONF_GCC_LINKER_OPTS_STAGE0]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINKER_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINKER_OPTS_STAGE2]) -FIND_GHC_TOOLCHAIN # CPP, CPPFLAGS # --with-cpp/-with-cpp-flags @@ -1168,6 +1167,11 @@ checkMake380() { checkMake380 make checkMake380 gmake +# Toolchain target files +PREP_TARGET_FILE +FIND_GHC_TOOLCHAIN +VALIDATE_GHC_TOOLCHAIN + AC_CONFIG_FILES( [ mk/project.mk hadrian/cfg/system.config @@ -1176,6 +1180,7 @@ AC_CONFIG_FILES( hadrian/ghci-stack docs/users_guide/ghc_config.py distrib/configure.ac + default.target ]) dnl Create the VERSION file, satisfying #22322. ===================================== default.target.in ===================================== @@ -0,0 +1,39 @@ +Target +{ tgtArchOs = ArchOS {archOS_arch = @HaskellHostArch@, archOS_OS = @HaskellHostOs@} +, tgtSupportsGnuNonexecStack = @TargetHasGnuNonexecStackBool@ +, tgtSupportsSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbolsBool@ +, tgtSupportsIdentDirective = @TargetHasIdentDirectiveBool@ +, tgtWordSize = WS at TargetWordSize@ +, tgtEndianness = LittleEndian +, tgtSymbolsHaveLeadingUnderscore = @LeadingUnderscoreBool@ +, tgtLlvmTarget = "@HostPlatform@" +, tgtUnregisterised = @UnregisterisedBool@ +, tgtTablesNextToCode = @TablesNextToCodeBool@ +, tgtUseLibffiForAdjustors = @UseLibffiForAdjustorsBool@ +, tgtCCompiler = Cc {ccProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @SettingsCCompilerFlagsList@}} +, tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@SettingsCxxCompilerCommand@", prgFlags = @SettingsCxxCompilerFlagsList@}} +, tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@CPPCmd@", prgFlags = @CONF_CPP_OPTS_STAGE1List@}} +, tgtHsCPreprocessor = HsCpp {hsCppProgram = Program {prgPath = "@HaskellCPPCmd@", prgFlags = @HaskellCPPArgsList@}} +, tgtCCompilerLink = CcLink +{ ccLinkProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @SettingsCCompilerLinkFlagsList@} +, ccLinkSupportsNoPie = @SettingsCCompilerSupportsNoPieBool@ +, ccLinkSupportsCompactUnwind = @LdHasNoCompactUnwindBool@ +, ccLinkSupportsFilelist = @LdHasFilelistBool@ +, ccLinkSupportsResponseFiles = @LdSupportsResponseFilesBool@ +, ccLinkIsGnu = @LdIsGNULdBool@ +} + +, tgtAr = Ar +{ arMkArchive = Program {prgPath = "@AR@", prgFlags = @ArArgsList@} +, arIsGnu = False +, arSupportsAtFile = @ArSupportsAtFileBool@ +, arSupportsDashL = @ArSupportsDashLBool@ +, arNeedsRanlib = False +} + +, tgtRanlib = Just (Ranlib {ranlibProgram = Program {prgPath = "@REAL_RANLIB_CMD@", prgFlags = []}}) +, tgtNm = Nm {nmProgram = Program {prgPath = "@NmCmd@", prgFlags = []}} +, tgtMergeObjs = Just (MergeObjs {mergeObjsProgram = Program {prgPath = "@SettingsMergeObjectsCommand@", prgFlags = @SettingsMergeObjectsFlagsList@}}) +, tgtDllwrap = Nothing +, tgtWindres = Nothing +} ===================================== distrib/configure.ac.in ===================================== @@ -303,6 +303,11 @@ checkMake380() { checkMake380 make checkMake380 gmake +# Toolchain target files +PREP_TARGET_FILE +FIND_GHC_TOOLCHAIN +VALIDATE_GHC_TOOLCHAIN + echo "****************************************************" echo "Configuration done, ready to 'make install'" echo "(see README and INSTALL files for more info.)" ===================================== m4/ghc_toolchain.m4 ===================================== @@ -66,8 +66,19 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], ) &1` + if test -z "$diff_output"; then + true + else + AC_MSG_WARN([Differences found between $A and $B: $diff_output]) + fi +]) ===================================== m4/prep_target_file.m4 ===================================== @@ -0,0 +1,71 @@ +# PREP_BOOLEAN +# ============ +# +# Issue a substitution with True/False of [$1Bool] when $1 has YES/NO value +# $1 = boolean variable to substitute +AC_DEFUN([PREP_BOOLEAN],[ + case "$$1" in + YES) + $1Bool=True + ;; + NO) + $1Bool=False + ;; + *) + AC_MSG_ERROR([Expecting YES/NO but got $$1 in $1]) + ;; + esac + AC_SUBST([$1Bool]) +]) + +# PREP_LIST +# ============ +# +# Issue a substitution with ["list","of","args"] of [$1List] when $1 is a +# space-separated list of args +# $1 = list variable to substitute +dnl In autoconf, '@<:@' stands for '[', and '@:>@' for ']'. +AC_DEFUN([PREP_LIST],[ + TMP_ARR=($$1) + $1List="@<:@" + if test -z "$TMP_ARR"; then + true + else + $1List="${$1List}\"${TMP_ARR@<:@0@:>@}\"" + for arg in "${TMP_ARR@<:@@@:>@:1}" + do + $1List="${$1List},\"$arg\"" + done + fi + $1List="${$1List}@:>@" + AC_SUBST([$1List]) + unset TMP_ARR +]) + +# Eventually: PREP_BUILD_TARGET_FILE, PREP_HOST_TARGET_FILE, PREP_TARGET_TARGET_FILE +# Prepares required substitutions to generate the target file +AC_DEFUN([PREP_TARGET_FILE],[ + PREP_BOOLEAN([LdSupportsResponseFiles]) + PREP_BOOLEAN([TargetHasGnuNonexecStack]) + PREP_BOOLEAN([LeadingUnderscore]) + PREP_BOOLEAN([ArSupportsAtFile]) + PREP_BOOLEAN([ArSupportsDashL]) + PREP_BOOLEAN([TargetHasIdentDirective]) + PREP_BOOLEAN([SettingsCCompilerSupportsNoPie]) + PREP_BOOLEAN([LdHasFilelist]) + PREP_BOOLEAN([LdIsGNULd]) + PREP_BOOLEAN([LdHasNoCompactUnwind]) + PREP_BOOLEAN([TargetHasSubsectionsViaSymbols]) + PREP_BOOLEAN([Unregisterised]) + PREP_BOOLEAN([TablesNextToCode]) + PREP_BOOLEAN([UseLibffiForAdjustors]) + PREP_LIST([SettingsMergeObjectsFlags]) + PREP_LIST([ArArgs]) + PREP_LIST([SettingsCCompilerLinkFlags]) + PREP_LIST([HaskellCPPArgs]) + PREP_LIST([CONF_CPP_OPTS_STAGE1]) + PREP_LIST([SettingsCxxCompilerFlags]) + PREP_LIST([SettingsCCompilerFlags]) +]) + +AC_DEFUN() ===================================== utils/ghc-toolchain/Main.hs ===================================== @@ -160,9 +160,11 @@ options = -- Empty list of flags is as if it was unspecified updatePoFlags "" existingOpts = existingOpts - -- Otherwise append specified flags to existing flags or make new + -- Otherwise prepend specified flags to existing flags or make new updatePoFlags newOpts Nothing = Just [newOpts] - updatePoFlags newOpts (Just eopts) = Just (eopts ++ [newOpts]) + updatePoFlags newOpts (Just eopts) = Just (newOpts:eopts) + -- NB: By prepending, the resulting flags will match the left-to-right + -- order they were passed in enableDisable :: String -> String -> Lens Opts (Maybe Bool) -> [OptDescr (Opts -> Opts)] @@ -216,7 +218,9 @@ run :: Opts -> M () run opts = do tgt <- mkTarget opts logDebug $ "Final Target: " ++ show tgt - writeFile "default.target" (show tgt) + let file = "default.ghc-toolchain.target" + writeFile file (show tgt) + appendFile file "\n" -- eol optional :: M a -> M (Maybe a) optional k = fmap Just k <|> pure Nothing @@ -327,7 +331,7 @@ mkTarget opts = do tgtWordSize <- checkWordSize cc tgtEndianness <- checkEndianness cc tgtSymbolsHaveLeadingUnderscore <- checkLeadingUnderscore cc nm - tgtSupportsSubsectionsViaSymbols <- checkSubsectionsViaSymbols cc + tgtSupportsSubsectionsViaSymbols <- checkSubsectionsViaSymbols archOs cc tgtSupportsIdentDirective <- checkIdentDirective cc tgtSupportsGnuNonexecStack <- checkGnuNonexecStack archOs cc @@ -338,7 +342,7 @@ mkTarget opts = do tgtUseLibffi <- determineUseLibFFIForAdjustors archOs (optUseLibFFIForAdjustors opts) when tgtUnregisterised $ do -- The via-C code generator requires these - let prog = "int main(int argc, char** argv) { return 0; }I" + let prog = "int main(int argc, char** argv) { return 0; }" via_c_args = ["-fwrapv", "-fno-builtin"] forM_ via_c_args $ \arg -> checking ("support of "++arg) $ withTempDir $ \dir -> do let cc' = over (_ccProgram % _prgFlags) (++ [arg]) cc ===================================== utils/ghc-toolchain/src/GHC/Toolchain/PlatformDetails.hs ===================================== @@ -102,11 +102,17 @@ checkLeadingUnderscore cc nm = checking ctxt $ withTempDir $ \dir -> do prog = "int func(void) { return 0; }" ctxt = "whether symbols have leading underscores" -checkSubsectionsViaSymbols :: Cc -> M Bool -checkSubsectionsViaSymbols = - testCompile - "whether .subsections-via-symbols directive is supported" - (asmStmt ".subsections_via_symbols") +checkSubsectionsViaSymbols :: ArchOS -> Cc -> M Bool +checkSubsectionsViaSymbols archos cc = + case archOS_arch archos of + ArchAArch64 -> + -- subsections via symbols is busted on arm64 + -- TODO: ^ is this comment up to date? + return False + _ -> + testCompile + "whether .subsections-via-symbols directive is supported" + (asmStmt ".subsections_via_symbols") cc checkIdentDirective :: Cc -> M Bool checkIdentDirective = ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE RecordWildCards #-} module GHC.Toolchain.Target where import GHC.Platform.ArchOS @@ -60,7 +61,35 @@ data Target = Target , tgtDllwrap :: Maybe Program , tgtWindres :: Maybe Program } - deriving (Show, Read, Eq, Ord) + deriving (Read, Eq, Ord) + +instance Show Target where + show Target{..} = unlines + [ "Target" + , "{ tgtArchOs = " ++ show tgtArchOs + , ", tgtSupportsGnuNonexecStack = " ++ show tgtSupportsGnuNonexecStack + , ", tgtSupportsSubsectionsViaSymbols = " ++ show tgtSupportsSubsectionsViaSymbols + , ", tgtSupportsIdentDirective = " ++ show tgtSupportsIdentDirective + , ", tgtWordSize = " ++ show tgtWordSize + , ", tgtEndianness = " ++ show tgtEndianness + , ", tgtSymbolsHaveLeadingUnderscore = " ++ show tgtSymbolsHaveLeadingUnderscore + , ", tgtLlvmTarget = " ++ show tgtLlvmTarget + , ", tgtUnregisterised = " ++ show tgtUnregisterised + , ", tgtTablesNextToCode = " ++ show tgtTablesNextToCode + , ", tgtUseLibffiForAdjustors = " ++ show tgtUseLibffiForAdjustors + , ", tgtCCompiler = " ++ show tgtCCompiler + , ", tgtCxxCompiler = " ++ show tgtCxxCompiler + , ", tgtCPreprocessor = " ++ show tgtCPreprocessor + , ", tgtHsCPreprocessor = " ++ show tgtHsCPreprocessor + , ", tgtCCompilerLink = " ++ show tgtCCompilerLink + , ", tgtAr = " ++ show tgtAr + , ", tgtRanlib = " ++ show tgtRanlib + , ", tgtNm = " ++ show tgtNm + , ", tgtMergeObjs = " ++ show tgtMergeObjs + , ", tgtDllwrap = " ++ show tgtDllwrap + , ", tgtWindres = " ++ show tgtDllwrap + , "}" + ] -- | The word size as an integer representing the number of bytes wordSize2Bytes :: WordSize -> Int ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs ===================================== @@ -17,7 +17,19 @@ data Ar = Ar { arMkArchive :: Program , arSupportsDashL :: Bool , arNeedsRanlib :: Bool } - deriving (Show, Read, Eq, Ord) + deriving (Read, Eq, Ord) + +-- These instances are more suitable for diffing +instance Show Ar where + show Ar{..} = unlines + [ "Ar" + , "{ arMkArchive = " ++ show arMkArchive + , ", arIsGnu = " ++ show arIsGnu + , ", arSupportsAtFile = " ++ show arSupportsAtFile + , ", arSupportsDashL = " ++ show arSupportsDashL + , ", arNeedsRanlib = " ++ show arNeedsRanlib + , "}" + ] findAr :: ProgOpt -> M Ar findAr progOpt = checking "for 'ar'" $ do ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -1,5 +1,6 @@ {-# OPTIONS_GHC -Wno-name-shadowing #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE CPP #-} module GHC.Toolchain.Tools.Link ( CcLink(..), findCcLink ) where @@ -24,7 +25,20 @@ data CcLink = CcLink { ccLinkProgram :: Program , ccLinkSupportsResponseFiles :: Bool , ccLinkIsGnu :: Bool -- We once thought this could instead be LdSupportsGcSections, but then realized it couldn't IIRC } - deriving (Show, Read, Eq, Ord) + deriving (Read, Eq, Ord) + +-- These instances are more suitable for diffing +instance Show CcLink where + show CcLink{..} = unlines + [ "CcLink" + , "{ ccLinkProgram = " ++ show ccLinkProgram + , ", ccLinkSupportsNoPie = " ++ show ccLinkSupportsNoPie + , ", ccLinkSupportsCompactUnwind = " ++ show ccLinkSupportsCompactUnwind + , ", ccLinkSupportsFilelist = " ++ show ccLinkSupportsFilelist + , ", ccLinkSupportsResponseFiles = " ++ show ccLinkSupportsResponseFiles + , ", ccLinkIsGnu = " ++ show ccLinkIsGnu + , "}" + ] findCcLink :: ProgOpt -> Maybe Bool -> ArchOS -> Cc -> Maybe Readelf -> M CcLink findCcLink progOpt ldOverride archOs cc readelf = checking "for C compiler for linking command" $ do @@ -95,12 +109,13 @@ checkSupportsNoPie ccLink = checking "whether the cc linker supports -no-pie" $ -- Check output as some GCC versions only warn and don't respect -Werror -- when passed an unrecognized flag. (code, out, _err) <- readProgram ccLink ["-no-pie", "-Werror", "-x", "c", test_c, "-o", test] - if isSuccess code && "unrecognized" `isInfixOf` out - then return False - else return True + return (isSuccess code && not ("unrecognized" `isInfixOf` out)) checkSupportsCompactUnwind :: Cc -> Program -> M Bool checkSupportsCompactUnwind cc ccLink = checking "whether the cc linker understands -no_compact_unwind" $ + -- ROMES:TODO: This returns False here but True in configure because in + -- configure we check for ld supports compact unwind, whereas here we check + -- for cclink supports compact unwind... what do we need it for? withTempDir $ \dir -> do let test_o = dir "test.o" test2_o = dir "test2.o" @@ -108,7 +123,7 @@ checkSupportsCompactUnwind cc ccLink = checking "whether the cc linker understan compileC cc test_o "int foo() { return 0; }" exitCode <- runProgram ccLink ["-r", "-no_compact_unwind", "-o", test2_o, test_o] - pure $ isSuccess exitCode + return $ isSuccess exitCode checkSupportsFilelist :: Cc -> Program -> M Bool checkSupportsFilelist cc ccLink = checking "whether the cc linker understands -filelist" $ @@ -121,15 +136,17 @@ checkSupportsFilelist cc ccLink = checking "whether the cc linker understands -f compileC cc test1_o "int foo() { return 0; }" compileC cc test2_o "int bar() { return 0; }" - writeFile test_ofiles test1_o -- write the filename test1_o to the test_ofiles file - appendFile test_ofiles test2_o -- append the filename test2_o to the test_ofiles file + -- write the filenames test1_o and test2_o to the test_ofiles file + writeFile test_ofiles (unlines [test1_o,test2_o]) exitCode <- runProgram ccLink ["-r", "-filelist", test_ofiles, "-o", test_o] - pure $ isSuccess exitCode + return (isSuccess exitCode) checkSupportsResponseFiles :: Cc -> Program -> M Bool checkSupportsResponseFiles cc ccLink = checking "whether the cc linker supports response files" $ + -- ROMES:TODO: This returns True here while False in configure because in + -- configure we call -shared and -dylib on LD, whereas here we do it on CcLink withTempDir $ \dir -> do let test_o = dir "test.o" compileC cc test_o "int main(void) {return 0;}" @@ -141,7 +158,7 @@ checkSupportsResponseFiles cc ccLink = checking "whether the cc linker supports -- TODO: It'd be good to shortcircuit this logical `or` exitCode1 <- runProgram ccLink ["-shared", "@"++args_txt] exitCode2 <- runProgram ccLink ["-dylib", "@"++args_txt] - pure (isSuccess exitCode1 || isSuccess exitCode2) + return (isSuccess exitCode1 || isSuccess exitCode2) -- | Check whether linking works. checkLinkWorks :: Cc -> Program -> M () View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/64ef522ca2d655d458d3674bea5ddf0c13f900e4...2bd70e58c1f10ab9aedd6e26f2307f5569f83b8a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/64ef522ca2d655d458d3674bea5ddf0c13f900e4...2bd70e58c1f10ab9aedd6e26f2307f5569f83b8a You're receiving 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 Jun 5 22:54:18 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Mon, 05 Jun 2023 18:54:18 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/int-index/core-ignore-forall-vis Message-ID: <647e679a3cd3e_1d329d3f27ee50419592@gitlab.mail> Vladislav Zavialov pushed new branch wip/int-index/core-ignore-forall-vis at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/int-index/core-ignore-forall-vis You're receiving 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 Jun 5 23:00:03 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 05 Jun 2023 19:00:03 -0400 Subject: [Git][ghc/ghc][wip/expand-do] 2 commits: add location information for last statements Message-ID: <647e68f363169_1d329d3f27ee50425532@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 5974b668 by Apoorv Ingle at 2023-06-05T16:14:38-05:00 add location information for last statements - - - - - 25c5c258 by Apoorv Ingle at 2023-06-05T17:59:52-05:00 do not pop context while checking the second argument to expanded (>>) - - - - - 3 changed files: - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Types/Origin.hs Changes: ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -209,14 +209,16 @@ tcExpr e@(ExprWithTySig {}) res_ty = tcApp e res_ty tcExpr e@(HsRecSel {}) res_ty = tcApp e res_ty tcExpr e@(XExpr (ExpandedExpr {})) res_ty = tcApp e res_ty -tcExpr (XExpr (PopSrcSpan e)) res_ty = popErrCtxt $ tcExpr (unLoc e) res_ty +tcExpr (XExpr (PopSrcSpan e)) res_ty = do + do popErrCtxt $ tcExpr (unLoc e) res_ty -- needs to do more intelligent popping tcExpr (XExpr (ExpandedStmt (HsExpanded stmt expr))) res_ty = do { traceTc "tcDoStmts" (vcat [ text "stmt:" <+> ppr stmt , text "expr:" <+> ppr expr - , text "res_ty" <+> ppr res_ty + , text "res_ty:" <+> ppr res_ty ]) - ; tcExpr (unLoc expr) res_ty + ; addErrCtxt (pprStmtInCtxt @Renamed @Renamed @Renamed (HsDoStmt (DoExpr Nothing)) (unLoc stmt)) $ + tcExpr (unLoc expr) res_ty } ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1187,11 +1187,11 @@ checkArgCounts matchContext (MG { mg_alts = L _ (match1:matches) }) genPopSrcSpanExpr :: LHsExpr GhcRn -> LHsExpr GhcRn genPopSrcSpanExpr = wrapGenSpan . mkPopSrcSpanExpr -mkExpandedStmtLExpr - :: ExprLStmt GhcRn -- ^ source statement - -> LHsExpr GhcRn -- ^ expanded expression - -> LHsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' -mkExpandedStmtLExpr a b = noLocA $ mkExpandedStmt a b +-- mkExpandedStmtLExpr +-- :: ExprLStmt GhcRn -- ^ source statement +-- -> LHsExpr GhcRn -- ^ expanded expression +-- -> LHsExpr GhcRn -- ^ suitably wrapped 'HsExpansion' +-- mkExpandedStmtLExpr a b = noLocA $ mkExpandedStmt a b expandDoStmts :: HsDoFlavour -> [ExprLStmt GhcRn] -> TcM (LHsExpr GhcRn) expandDoStmts = expand_do_stmts @@ -1218,7 +1218,7 @@ expand_do_stmts _ [stmt@(L loc (LastStmt _ body _ ret_expr))] -- See `checkLastStmt` and `Syntax.Expr.StmtLR.LastStmt` | NoSyntaxExprRn <- ret_expr -- Last statement is just body if we are not in ListComp context. See Syntax.Expr.LastStmt - = return $ mkExpandedStmtLExpr stmt body + = return $ L loc (mkExpandedStmt stmt body) | SyntaxExprRn ret <- ret_expr -- @@ -1226,7 +1226,7 @@ expand_do_stmts _ [stmt@(L loc (LastStmt _ body _ ret_expr))] -- return e ~~> return e -- to make T18324 work = return $ L loc (mkExpandedStmt stmt - ((L loc (genHsApp ret body)))) + ((L loc (HsApp noAnn (L loc ret) body)))) expand_do_stmts do_or_lc (stmt@(L loc (LetStmt _ bnds)) : lstmts) = @@ -1251,7 +1251,7 @@ expand_do_stmts do_or_lc (stmt@(L loc (BindStmt xbsrn pat e)): lstmts) expr <- mk_failable_lexpr_tcm pat expand_stmts fail_op return $ (mkHsApps (wrapGenSpan bind_op) -- (>>=) [ L loc (mkPopSrcSpanExpr $ L loc (mkExpandedStmt stmt e)) - , genPopSrcSpanExpr expr + , expr ]) | otherwise = pprPanic "expand do: shouldn't happen" (text "stmt" <+> ppr stmt) @@ -1264,7 +1264,7 @@ expand_do_stmts do_or_lc (stmt@(L loc (BodyStmt _ e (SyntaxExprRn f) _)) : lstmt do expand_stmts <- expand_do_stmts do_or_lc lstmts return $ (mkHsApps (wrapGenSpan f) -- (>>) [ L loc (mkPopSrcSpanExpr $ L loc (mkExpandedStmt stmt e)) -- e - , genPopSrcSpanExpr expand_stmts ]) -- stmts' + , expand_stmts ]) -- stmts' expand_do_stmts do_or_lc ((L do_loc (RecStmt { recS_stmts = L stmts_loc rec_stmts ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -1380,11 +1380,12 @@ pprExpectedFunTyOrigin funTy_origin i = , nest 2 (ppr expr) ] ExpectedFunTyArg fun arg -> case arg of XExpr (PopSrcSpan (L _ (XExpr (ExpandedStmt (HsExpanded {}))))) -> + -- likey an expanded statement vcat [ sep [ the_arg_of , text "the rebindable syntax operator" , quotes (ppr fun) ] - , nest 2 (text "arising from a do stmt") + , nest 2 (text "arising from a do statement") ] _ -> sep [ text "The argument" , quotes (ppr arg) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/265cc4fd5cab792f22121bdafdc047e13fb1f374...25c5c258914627551a26a0764e693157cf10cd81 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/265cc4fd5cab792f22121bdafdc047e13fb1f374...25c5c258914627551a26a0764e693157cf10cd81 You're receiving 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 Jun 5 23:45:01 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 05 Jun 2023 19:45:01 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 2 commits: configure: Create and validate toolchain target file Message-ID: <647e737d46e97_1d329d3f9c950c42797d@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 178f7b91 by Rodrigo Mesquita at 2023-06-06T00:44:44+01:00 configure: Create and validate toolchain target file - - - - - c8252c53 by Rodrigo Mesquita at 2023-06-06T00:44:51+01:00 Fixes to match configure output - - - - - 10 changed files: - configure.ac - + default.target.in - distrib/configure.ac.in - m4/ghc_toolchain.m4 - + m4/prep_target_file.m4 - utils/ghc-toolchain/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/PlatformDetails.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs Changes: ===================================== configure.ac ===================================== @@ -644,7 +644,6 @@ dnl CONF_CC_OPTS_STAGE[012] accordingly. FP_CC_SUPPORTS_TARGET([$CC_STAGE0], [CONF_CC_OPTS_STAGE0], [CONF_CXX_OPTS_STAGE0], [CONF_GCC_LINKER_OPTS_STAGE0]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINKER_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINKER_OPTS_STAGE2]) -FIND_GHC_TOOLCHAIN # CPP, CPPFLAGS # --with-cpp/-with-cpp-flags @@ -1168,6 +1167,11 @@ checkMake380() { checkMake380 make checkMake380 gmake +# Toolchain target files +PREP_TARGET_FILE +FIND_GHC_TOOLCHAIN +VALIDATE_GHC_TOOLCHAIN + AC_CONFIG_FILES( [ mk/project.mk hadrian/cfg/system.config @@ -1176,6 +1180,7 @@ AC_CONFIG_FILES( hadrian/ghci-stack docs/users_guide/ghc_config.py distrib/configure.ac + default.target ]) dnl Create the VERSION file, satisfying #22322. ===================================== default.target.in ===================================== @@ -0,0 +1,39 @@ +Target +{ tgtArchOs = ArchOS {archOS_arch = @HaskellHostArch@, archOS_OS = @HaskellHostOs@} +, tgtSupportsGnuNonexecStack = @TargetHasGnuNonexecStackBool@ +, tgtSupportsSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbolsBool@ +, tgtSupportsIdentDirective = @TargetHasIdentDirectiveBool@ +, tgtWordSize = WS at TargetWordSize@ +, tgtEndianness = LittleEndian +, tgtSymbolsHaveLeadingUnderscore = @LeadingUnderscoreBool@ +, tgtLlvmTarget = "@HostPlatform@" +, tgtUnregisterised = @UnregisterisedBool@ +, tgtTablesNextToCode = @TablesNextToCodeBool@ +, tgtUseLibffiForAdjustors = @UseLibffiForAdjustorsBool@ +, tgtCCompiler = Cc {ccProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @SettingsCCompilerFlagsList@}} +, tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@SettingsCxxCompilerCommand@", prgFlags = @SettingsCxxCompilerFlagsList@}} +, tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@CPPCmd@", prgFlags = @CONF_CPP_OPTS_STAGE1List@}} +, tgtHsCPreprocessor = HsCpp {hsCppProgram = Program {prgPath = "@HaskellCPPCmd@", prgFlags = @HaskellCPPArgsList@}} +, tgtCCompilerLink = CcLink +{ ccLinkProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @SettingsCCompilerLinkFlagsList@} +, ccLinkSupportsNoPie = @SettingsCCompilerSupportsNoPieBool@ +, ccLinkSupportsCompactUnwind = @LdHasNoCompactUnwindBool@ +, ccLinkSupportsFilelist = @LdHasFilelistBool@ +, ccLinkSupportsResponseFiles = @LdSupportsResponseFilesBool@ +, ccLinkIsGnu = @LdIsGNULdBool@ +} + +, tgtAr = Ar +{ arMkArchive = Program {prgPath = "@AR@", prgFlags = @ArArgsList@} +, arIsGnu = False +, arSupportsAtFile = @ArSupportsAtFileBool@ +, arSupportsDashL = @ArSupportsDashLBool@ +, arNeedsRanlib = False +} + +, tgtRanlib = Just (Ranlib {ranlibProgram = Program {prgPath = "@REAL_RANLIB_CMD@", prgFlags = []}}) +, tgtNm = Nm {nmProgram = Program {prgPath = "@NmCmd@", prgFlags = []}} +, tgtMergeObjs = Just (MergeObjs {mergeObjsProgram = Program {prgPath = "@SettingsMergeObjectsCommand@", prgFlags = @SettingsMergeObjectsFlagsList@}}) +, tgtDllwrap = Nothing +, tgtWindres = Nothing +} ===================================== distrib/configure.ac.in ===================================== @@ -303,6 +303,11 @@ checkMake380() { checkMake380 make checkMake380 gmake +# Toolchain target files +PREP_TARGET_FILE +FIND_GHC_TOOLCHAIN +VALIDATE_GHC_TOOLCHAIN + echo "****************************************************" echo "Configuration done, ready to 'make install'" echo "(see README and INSTALL files for more info.)" ===================================== m4/ghc_toolchain.m4 ===================================== @@ -66,8 +66,19 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], ) &1` + if test -z "$diff_output"; then + true + else + AC_MSG_WARN([Differences found between $A and $B: $diff_output]) + fi +]) ===================================== m4/prep_target_file.m4 ===================================== @@ -0,0 +1,74 @@ +# PREP_BOOLEAN +# ============ +# +# Issue a substitution with True/False of [$1Bool] when $1 has YES/NO value +# $1 = boolean variable to substitute +AC_DEFUN([PREP_BOOLEAN],[ + case "$$1" in + YES) + $1Bool=True + ;; + NO) + $1Bool=False + ;; + *) + AC_MSG_ERROR([Expecting YES/NO but got $$1 in $1]) + ;; + esac + AC_SUBST([$1Bool]) +]) + +# PREP_LIST +# ============ +# +# Issue a substitution with ["list","of","args"] of [$1List] when $1 is a +# space-separated list of args +# $1 = list variable to substitute +dnl In autoconf, '@<:@' stands for '[', and '@:>@' for ']'. +AC_DEFUN([PREP_LIST],[ + # shell array + set -- $$1 + $1List="@<:@" + if test "[$]#" -eq 0; then + # no arguments + true + else + prep_List="${$1List}\"[$]1\"" + shift # drop first elem + for arg in "[$]@" + do + prep_List="${$1List},\"$arg\"" + done + fi + $1List="${$1List}@:>@" + + AC_SUBST([$1List]) +]) + +# Eventually: PREP_BUILD_TARGET_FILE, PREP_HOST_TARGET_FILE, PREP_TARGET_TARGET_FILE +# Prepares required substitutions to generate the target file +AC_DEFUN([PREP_TARGET_FILE],[ + PREP_BOOLEAN([LdSupportsResponseFiles]) + PREP_BOOLEAN([TargetHasGnuNonexecStack]) + PREP_BOOLEAN([LeadingUnderscore]) + PREP_BOOLEAN([ArSupportsAtFile]) + PREP_BOOLEAN([ArSupportsDashL]) + PREP_BOOLEAN([TargetHasIdentDirective]) + PREP_BOOLEAN([SettingsCCompilerSupportsNoPie]) + PREP_BOOLEAN([LdHasFilelist]) + PREP_BOOLEAN([LdIsGNULd]) + PREP_BOOLEAN([LdHasNoCompactUnwind]) + PREP_BOOLEAN([TargetHasSubsectionsViaSymbols]) + PREP_BOOLEAN([Unregisterised]) + PREP_BOOLEAN([TablesNextToCode]) + PREP_BOOLEAN([UseLibffiForAdjustors]) + PREP_LIST([SettingsMergeObjectsFlags]) + PREP_LIST([ArArgs]) + PREP_LIST([SettingsCCompilerLinkFlags]) + PREP_LIST([HaskellCPPArgs]) + PREP_LIST([CONF_CPP_OPTS_STAGE1]) + PREP_LIST([SettingsCxxCompilerFlags]) + PREP_LIST([SettingsCCompilerFlags]) +]) + +AC_DEFUN() ===================================== utils/ghc-toolchain/Main.hs ===================================== @@ -160,9 +160,11 @@ options = -- Empty list of flags is as if it was unspecified updatePoFlags "" existingOpts = existingOpts - -- Otherwise append specified flags to existing flags or make new + -- Otherwise prepend specified flags to existing flags or make new updatePoFlags newOpts Nothing = Just [newOpts] - updatePoFlags newOpts (Just eopts) = Just (eopts ++ [newOpts]) + updatePoFlags newOpts (Just eopts) = Just (newOpts:eopts) + -- NB: By prepending, the resulting flags will match the left-to-right + -- order they were passed in enableDisable :: String -> String -> Lens Opts (Maybe Bool) -> [OptDescr (Opts -> Opts)] @@ -216,7 +218,9 @@ run :: Opts -> M () run opts = do tgt <- mkTarget opts logDebug $ "Final Target: " ++ show tgt - writeFile "default.target" (show tgt) + let file = "default.ghc-toolchain.target" + writeFile file (show tgt) + appendFile file "\n" -- eol optional :: M a -> M (Maybe a) optional k = fmap Just k <|> pure Nothing @@ -327,7 +331,7 @@ mkTarget opts = do tgtWordSize <- checkWordSize cc tgtEndianness <- checkEndianness cc tgtSymbolsHaveLeadingUnderscore <- checkLeadingUnderscore cc nm - tgtSupportsSubsectionsViaSymbols <- checkSubsectionsViaSymbols cc + tgtSupportsSubsectionsViaSymbols <- checkSubsectionsViaSymbols archOs cc tgtSupportsIdentDirective <- checkIdentDirective cc tgtSupportsGnuNonexecStack <- checkGnuNonexecStack archOs cc @@ -338,7 +342,7 @@ mkTarget opts = do tgtUseLibffi <- determineUseLibFFIForAdjustors archOs (optUseLibFFIForAdjustors opts) when tgtUnregisterised $ do -- The via-C code generator requires these - let prog = "int main(int argc, char** argv) { return 0; }I" + let prog = "int main(int argc, char** argv) { return 0; }" via_c_args = ["-fwrapv", "-fno-builtin"] forM_ via_c_args $ \arg -> checking ("support of "++arg) $ withTempDir $ \dir -> do let cc' = over (_ccProgram % _prgFlags) (++ [arg]) cc ===================================== utils/ghc-toolchain/src/GHC/Toolchain/PlatformDetails.hs ===================================== @@ -102,11 +102,17 @@ checkLeadingUnderscore cc nm = checking ctxt $ withTempDir $ \dir -> do prog = "int func(void) { return 0; }" ctxt = "whether symbols have leading underscores" -checkSubsectionsViaSymbols :: Cc -> M Bool -checkSubsectionsViaSymbols = - testCompile - "whether .subsections-via-symbols directive is supported" - (asmStmt ".subsections_via_symbols") +checkSubsectionsViaSymbols :: ArchOS -> Cc -> M Bool +checkSubsectionsViaSymbols archos cc = + case archOS_arch archos of + ArchAArch64 -> + -- subsections via symbols is busted on arm64 + -- TODO: ^ is this comment up to date? + return False + _ -> + testCompile + "whether .subsections-via-symbols directive is supported" + (asmStmt ".subsections_via_symbols") cc checkIdentDirective :: Cc -> M Bool checkIdentDirective = ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE RecordWildCards #-} module GHC.Toolchain.Target where import GHC.Platform.ArchOS @@ -60,7 +61,35 @@ data Target = Target , tgtDllwrap :: Maybe Program , tgtWindres :: Maybe Program } - deriving (Show, Read, Eq, Ord) + deriving (Read, Eq, Ord) + +instance Show Target where + show Target{..} = unlines + [ "Target" + , "{ tgtArchOs = " ++ show tgtArchOs + , ", tgtSupportsGnuNonexecStack = " ++ show tgtSupportsGnuNonexecStack + , ", tgtSupportsSubsectionsViaSymbols = " ++ show tgtSupportsSubsectionsViaSymbols + , ", tgtSupportsIdentDirective = " ++ show tgtSupportsIdentDirective + , ", tgtWordSize = " ++ show tgtWordSize + , ", tgtEndianness = " ++ show tgtEndianness + , ", tgtSymbolsHaveLeadingUnderscore = " ++ show tgtSymbolsHaveLeadingUnderscore + , ", tgtLlvmTarget = " ++ show tgtLlvmTarget + , ", tgtUnregisterised = " ++ show tgtUnregisterised + , ", tgtTablesNextToCode = " ++ show tgtTablesNextToCode + , ", tgtUseLibffiForAdjustors = " ++ show tgtUseLibffiForAdjustors + , ", tgtCCompiler = " ++ show tgtCCompiler + , ", tgtCxxCompiler = " ++ show tgtCxxCompiler + , ", tgtCPreprocessor = " ++ show tgtCPreprocessor + , ", tgtHsCPreprocessor = " ++ show tgtHsCPreprocessor + , ", tgtCCompilerLink = " ++ show tgtCCompilerLink + , ", tgtAr = " ++ show tgtAr + , ", tgtRanlib = " ++ show tgtRanlib + , ", tgtNm = " ++ show tgtNm + , ", tgtMergeObjs = " ++ show tgtMergeObjs + , ", tgtDllwrap = " ++ show tgtDllwrap + , ", tgtWindres = " ++ show tgtDllwrap + , "}" + ] -- | The word size as an integer representing the number of bytes wordSize2Bytes :: WordSize -> Int ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs ===================================== @@ -17,7 +17,19 @@ data Ar = Ar { arMkArchive :: Program , arSupportsDashL :: Bool , arNeedsRanlib :: Bool } - deriving (Show, Read, Eq, Ord) + deriving (Read, Eq, Ord) + +-- These instances are more suitable for diffing +instance Show Ar where + show Ar{..} = unlines + [ "Ar" + , "{ arMkArchive = " ++ show arMkArchive + , ", arIsGnu = " ++ show arIsGnu + , ", arSupportsAtFile = " ++ show arSupportsAtFile + , ", arSupportsDashL = " ++ show arSupportsDashL + , ", arNeedsRanlib = " ++ show arNeedsRanlib + , "}" + ] findAr :: ProgOpt -> M Ar findAr progOpt = checking "for 'ar'" $ do ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -1,5 +1,6 @@ {-# OPTIONS_GHC -Wno-name-shadowing #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE CPP #-} module GHC.Toolchain.Tools.Link ( CcLink(..), findCcLink ) where @@ -24,7 +25,20 @@ data CcLink = CcLink { ccLinkProgram :: Program , ccLinkSupportsResponseFiles :: Bool , ccLinkIsGnu :: Bool -- We once thought this could instead be LdSupportsGcSections, but then realized it couldn't IIRC } - deriving (Show, Read, Eq, Ord) + deriving (Read, Eq, Ord) + +-- These instances are more suitable for diffing +instance Show CcLink where + show CcLink{..} = unlines + [ "CcLink" + , "{ ccLinkProgram = " ++ show ccLinkProgram + , ", ccLinkSupportsNoPie = " ++ show ccLinkSupportsNoPie + , ", ccLinkSupportsCompactUnwind = " ++ show ccLinkSupportsCompactUnwind + , ", ccLinkSupportsFilelist = " ++ show ccLinkSupportsFilelist + , ", ccLinkSupportsResponseFiles = " ++ show ccLinkSupportsResponseFiles + , ", ccLinkIsGnu = " ++ show ccLinkIsGnu + , "}" + ] findCcLink :: ProgOpt -> Maybe Bool -> ArchOS -> Cc -> Maybe Readelf -> M CcLink findCcLink progOpt ldOverride archOs cc readelf = checking "for C compiler for linking command" $ do @@ -95,12 +109,13 @@ checkSupportsNoPie ccLink = checking "whether the cc linker supports -no-pie" $ -- Check output as some GCC versions only warn and don't respect -Werror -- when passed an unrecognized flag. (code, out, _err) <- readProgram ccLink ["-no-pie", "-Werror", "-x", "c", test_c, "-o", test] - if isSuccess code && "unrecognized" `isInfixOf` out - then return False - else return True + return (isSuccess code && not ("unrecognized" `isInfixOf` out)) checkSupportsCompactUnwind :: Cc -> Program -> M Bool checkSupportsCompactUnwind cc ccLink = checking "whether the cc linker understands -no_compact_unwind" $ + -- ROMES:TODO: This returns False here but True in configure because in + -- configure we check for ld supports compact unwind, whereas here we check + -- for cclink supports compact unwind... what do we need it for? withTempDir $ \dir -> do let test_o = dir "test.o" test2_o = dir "test2.o" @@ -108,7 +123,7 @@ checkSupportsCompactUnwind cc ccLink = checking "whether the cc linker understan compileC cc test_o "int foo() { return 0; }" exitCode <- runProgram ccLink ["-r", "-no_compact_unwind", "-o", test2_o, test_o] - pure $ isSuccess exitCode + return $ isSuccess exitCode checkSupportsFilelist :: Cc -> Program -> M Bool checkSupportsFilelist cc ccLink = checking "whether the cc linker understands -filelist" $ @@ -121,15 +136,17 @@ checkSupportsFilelist cc ccLink = checking "whether the cc linker understands -f compileC cc test1_o "int foo() { return 0; }" compileC cc test2_o "int bar() { return 0; }" - writeFile test_ofiles test1_o -- write the filename test1_o to the test_ofiles file - appendFile test_ofiles test2_o -- append the filename test2_o to the test_ofiles file + -- write the filenames test1_o and test2_o to the test_ofiles file + writeFile test_ofiles (unlines [test1_o,test2_o]) exitCode <- runProgram ccLink ["-r", "-filelist", test_ofiles, "-o", test_o] - pure $ isSuccess exitCode + return (isSuccess exitCode) checkSupportsResponseFiles :: Cc -> Program -> M Bool checkSupportsResponseFiles cc ccLink = checking "whether the cc linker supports response files" $ + -- ROMES:TODO: This returns True here while False in configure because in + -- configure we call -shared and -dylib on LD, whereas here we do it on CcLink withTempDir $ \dir -> do let test_o = dir "test.o" compileC cc test_o "int main(void) {return 0;}" @@ -141,7 +158,7 @@ checkSupportsResponseFiles cc ccLink = checking "whether the cc linker supports -- TODO: It'd be good to shortcircuit this logical `or` exitCode1 <- runProgram ccLink ["-shared", "@"++args_txt] exitCode2 <- runProgram ccLink ["-dylib", "@"++args_txt] - pure (isSuccess exitCode1 || isSuccess exitCode2) + return (isSuccess exitCode1 || isSuccess exitCode2) -- | Check whether linking works. checkLinkWorks :: Cc -> Program -> M () View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2bd70e58c1f10ab9aedd6e26f2307f5569f83b8a...c8252c534c778f86fb9529a455c568a28d2074bf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2bd70e58c1f10ab9aedd6e26f2307f5569f83b8a...c8252c534c778f86fb9529a455c568a28d2074bf You're receiving 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 Jun 5 23:47:36 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 05 Jun 2023 19:47:36 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 2 commits: configure: Create and validate toolchain target file Message-ID: <647e7418b00ef_1d329d3fbc395c428654@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: d805ee2b by Rodrigo Mesquita at 2023-06-06T00:47:25+01:00 configure: Create and validate toolchain target file - - - - - 9ff922f1 by Rodrigo Mesquita at 2023-06-06T00:47:28+01:00 Fixes to match configure output - - - - - 10 changed files: - configure.ac - + default.target.in - distrib/configure.ac.in - m4/ghc_toolchain.m4 - + m4/prep_target_file.m4 - utils/ghc-toolchain/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/PlatformDetails.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs Changes: ===================================== configure.ac ===================================== @@ -644,7 +644,6 @@ dnl CONF_CC_OPTS_STAGE[012] accordingly. FP_CC_SUPPORTS_TARGET([$CC_STAGE0], [CONF_CC_OPTS_STAGE0], [CONF_CXX_OPTS_STAGE0], [CONF_GCC_LINKER_OPTS_STAGE0]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINKER_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINKER_OPTS_STAGE2]) -FIND_GHC_TOOLCHAIN # CPP, CPPFLAGS # --with-cpp/-with-cpp-flags @@ -1168,6 +1167,11 @@ checkMake380() { checkMake380 make checkMake380 gmake +# Toolchain target files +PREP_TARGET_FILE +FIND_GHC_TOOLCHAIN +VALIDATE_GHC_TOOLCHAIN + AC_CONFIG_FILES( [ mk/project.mk hadrian/cfg/system.config @@ -1176,6 +1180,7 @@ AC_CONFIG_FILES( hadrian/ghci-stack docs/users_guide/ghc_config.py distrib/configure.ac + default.target ]) dnl Create the VERSION file, satisfying #22322. ===================================== default.target.in ===================================== @@ -0,0 +1,39 @@ +Target +{ tgtArchOs = ArchOS {archOS_arch = @HaskellHostArch@, archOS_OS = @HaskellHostOs@} +, tgtSupportsGnuNonexecStack = @TargetHasGnuNonexecStackBool@ +, tgtSupportsSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbolsBool@ +, tgtSupportsIdentDirective = @TargetHasIdentDirectiveBool@ +, tgtWordSize = WS at TargetWordSize@ +, tgtEndianness = LittleEndian +, tgtSymbolsHaveLeadingUnderscore = @LeadingUnderscoreBool@ +, tgtLlvmTarget = "@HostPlatform@" +, tgtUnregisterised = @UnregisterisedBool@ +, tgtTablesNextToCode = @TablesNextToCodeBool@ +, tgtUseLibffiForAdjustors = @UseLibffiForAdjustorsBool@ +, tgtCCompiler = Cc {ccProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @SettingsCCompilerFlagsList@}} +, tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@SettingsCxxCompilerCommand@", prgFlags = @SettingsCxxCompilerFlagsList@}} +, tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@CPPCmd@", prgFlags = @CONF_CPP_OPTS_STAGE1List@}} +, tgtHsCPreprocessor = HsCpp {hsCppProgram = Program {prgPath = "@HaskellCPPCmd@", prgFlags = @HaskellCPPArgsList@}} +, tgtCCompilerLink = CcLink +{ ccLinkProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @SettingsCCompilerLinkFlagsList@} +, ccLinkSupportsNoPie = @SettingsCCompilerSupportsNoPieBool@ +, ccLinkSupportsCompactUnwind = @LdHasNoCompactUnwindBool@ +, ccLinkSupportsFilelist = @LdHasFilelistBool@ +, ccLinkSupportsResponseFiles = @LdSupportsResponseFilesBool@ +, ccLinkIsGnu = @LdIsGNULdBool@ +} + +, tgtAr = Ar +{ arMkArchive = Program {prgPath = "@AR@", prgFlags = @ArArgsList@} +, arIsGnu = False +, arSupportsAtFile = @ArSupportsAtFileBool@ +, arSupportsDashL = @ArSupportsDashLBool@ +, arNeedsRanlib = False +} + +, tgtRanlib = Just (Ranlib {ranlibProgram = Program {prgPath = "@REAL_RANLIB_CMD@", prgFlags = []}}) +, tgtNm = Nm {nmProgram = Program {prgPath = "@NmCmd@", prgFlags = []}} +, tgtMergeObjs = Just (MergeObjs {mergeObjsProgram = Program {prgPath = "@SettingsMergeObjectsCommand@", prgFlags = @SettingsMergeObjectsFlagsList@}}) +, tgtDllwrap = Nothing +, tgtWindres = Nothing +} ===================================== distrib/configure.ac.in ===================================== @@ -303,6 +303,11 @@ checkMake380() { checkMake380 make checkMake380 gmake +# Toolchain target files +PREP_TARGET_FILE +FIND_GHC_TOOLCHAIN +VALIDATE_GHC_TOOLCHAIN + echo "****************************************************" echo "Configuration done, ready to 'make install'" echo "(see README and INSTALL files for more info.)" ===================================== m4/ghc_toolchain.m4 ===================================== @@ -66,8 +66,19 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], ) &1` + if test -z "$diff_output"; then + true + else + AC_MSG_WARN([Differences found between $A and $B: $diff_output]) + fi +]) ===================================== m4/prep_target_file.m4 ===================================== @@ -0,0 +1,74 @@ +# PREP_BOOLEAN +# ============ +# +# Issue a substitution with True/False of [$1Bool] when $1 has YES/NO value +# $1 = boolean variable to substitute +AC_DEFUN([PREP_BOOLEAN],[ + case "$$1" in + YES) + $1Bool=True + ;; + NO) + $1Bool=False + ;; + *) + AC_MSG_ERROR([Expecting YES/NO but got $$1 in $1]) + ;; + esac + AC_SUBST([$1Bool]) +]) + +# PREP_LIST +# ============ +# +# Issue a substitution with ["list","of","args"] of [$1List] when $1 is a +# space-separated list of args +# $1 = list variable to substitute +dnl In autoconf, '@<:@' stands for '[', and '@:>@' for ']'. +AC_DEFUN([PREP_LIST],[ + # shell array + set -- $$1 + $1List="@<:@" + if test "[$]#" -eq 0; then + # no arguments + true + else + $1List="${$1List}\"[$]1\"" + shift # drop first elem + for arg in "[$]@" + do + $1List="${$1List},\"$arg\"" + done + fi + $1List="${$1List}@:>@" + + AC_SUBST([$1List]) +]) + +# Eventually: PREP_BUILD_TARGET_FILE, PREP_HOST_TARGET_FILE, PREP_TARGET_TARGET_FILE +# Prepares required substitutions to generate the target file +AC_DEFUN([PREP_TARGET_FILE],[ + PREP_BOOLEAN([LdSupportsResponseFiles]) + PREP_BOOLEAN([TargetHasGnuNonexecStack]) + PREP_BOOLEAN([LeadingUnderscore]) + PREP_BOOLEAN([ArSupportsAtFile]) + PREP_BOOLEAN([ArSupportsDashL]) + PREP_BOOLEAN([TargetHasIdentDirective]) + PREP_BOOLEAN([SettingsCCompilerSupportsNoPie]) + PREP_BOOLEAN([LdHasFilelist]) + PREP_BOOLEAN([LdIsGNULd]) + PREP_BOOLEAN([LdHasNoCompactUnwind]) + PREP_BOOLEAN([TargetHasSubsectionsViaSymbols]) + PREP_BOOLEAN([Unregisterised]) + PREP_BOOLEAN([TablesNextToCode]) + PREP_BOOLEAN([UseLibffiForAdjustors]) + PREP_LIST([SettingsMergeObjectsFlags]) + PREP_LIST([ArArgs]) + PREP_LIST([SettingsCCompilerLinkFlags]) + PREP_LIST([HaskellCPPArgs]) + PREP_LIST([CONF_CPP_OPTS_STAGE1]) + PREP_LIST([SettingsCxxCompilerFlags]) + PREP_LIST([SettingsCCompilerFlags]) +]) + +AC_DEFUN() ===================================== utils/ghc-toolchain/Main.hs ===================================== @@ -160,9 +160,11 @@ options = -- Empty list of flags is as if it was unspecified updatePoFlags "" existingOpts = existingOpts - -- Otherwise append specified flags to existing flags or make new + -- Otherwise prepend specified flags to existing flags or make new updatePoFlags newOpts Nothing = Just [newOpts] - updatePoFlags newOpts (Just eopts) = Just (eopts ++ [newOpts]) + updatePoFlags newOpts (Just eopts) = Just (newOpts:eopts) + -- NB: By prepending, the resulting flags will match the left-to-right + -- order they were passed in enableDisable :: String -> String -> Lens Opts (Maybe Bool) -> [OptDescr (Opts -> Opts)] @@ -216,7 +218,9 @@ run :: Opts -> M () run opts = do tgt <- mkTarget opts logDebug $ "Final Target: " ++ show tgt - writeFile "default.target" (show tgt) + let file = "default.ghc-toolchain.target" + writeFile file (show tgt) + appendFile file "\n" -- eol optional :: M a -> M (Maybe a) optional k = fmap Just k <|> pure Nothing @@ -327,7 +331,7 @@ mkTarget opts = do tgtWordSize <- checkWordSize cc tgtEndianness <- checkEndianness cc tgtSymbolsHaveLeadingUnderscore <- checkLeadingUnderscore cc nm - tgtSupportsSubsectionsViaSymbols <- checkSubsectionsViaSymbols cc + tgtSupportsSubsectionsViaSymbols <- checkSubsectionsViaSymbols archOs cc tgtSupportsIdentDirective <- checkIdentDirective cc tgtSupportsGnuNonexecStack <- checkGnuNonexecStack archOs cc @@ -338,7 +342,7 @@ mkTarget opts = do tgtUseLibffi <- determineUseLibFFIForAdjustors archOs (optUseLibFFIForAdjustors opts) when tgtUnregisterised $ do -- The via-C code generator requires these - let prog = "int main(int argc, char** argv) { return 0; }I" + let prog = "int main(int argc, char** argv) { return 0; }" via_c_args = ["-fwrapv", "-fno-builtin"] forM_ via_c_args $ \arg -> checking ("support of "++arg) $ withTempDir $ \dir -> do let cc' = over (_ccProgram % _prgFlags) (++ [arg]) cc ===================================== utils/ghc-toolchain/src/GHC/Toolchain/PlatformDetails.hs ===================================== @@ -102,11 +102,17 @@ checkLeadingUnderscore cc nm = checking ctxt $ withTempDir $ \dir -> do prog = "int func(void) { return 0; }" ctxt = "whether symbols have leading underscores" -checkSubsectionsViaSymbols :: Cc -> M Bool -checkSubsectionsViaSymbols = - testCompile - "whether .subsections-via-symbols directive is supported" - (asmStmt ".subsections_via_symbols") +checkSubsectionsViaSymbols :: ArchOS -> Cc -> M Bool +checkSubsectionsViaSymbols archos cc = + case archOS_arch archos of + ArchAArch64 -> + -- subsections via symbols is busted on arm64 + -- TODO: ^ is this comment up to date? + return False + _ -> + testCompile + "whether .subsections-via-symbols directive is supported" + (asmStmt ".subsections_via_symbols") cc checkIdentDirective :: Cc -> M Bool checkIdentDirective = ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE RecordWildCards #-} module GHC.Toolchain.Target where import GHC.Platform.ArchOS @@ -60,7 +61,35 @@ data Target = Target , tgtDllwrap :: Maybe Program , tgtWindres :: Maybe Program } - deriving (Show, Read, Eq, Ord) + deriving (Read, Eq, Ord) + +instance Show Target where + show Target{..} = unlines + [ "Target" + , "{ tgtArchOs = " ++ show tgtArchOs + , ", tgtSupportsGnuNonexecStack = " ++ show tgtSupportsGnuNonexecStack + , ", tgtSupportsSubsectionsViaSymbols = " ++ show tgtSupportsSubsectionsViaSymbols + , ", tgtSupportsIdentDirective = " ++ show tgtSupportsIdentDirective + , ", tgtWordSize = " ++ show tgtWordSize + , ", tgtEndianness = " ++ show tgtEndianness + , ", tgtSymbolsHaveLeadingUnderscore = " ++ show tgtSymbolsHaveLeadingUnderscore + , ", tgtLlvmTarget = " ++ show tgtLlvmTarget + , ", tgtUnregisterised = " ++ show tgtUnregisterised + , ", tgtTablesNextToCode = " ++ show tgtTablesNextToCode + , ", tgtUseLibffiForAdjustors = " ++ show tgtUseLibffiForAdjustors + , ", tgtCCompiler = " ++ show tgtCCompiler + , ", tgtCxxCompiler = " ++ show tgtCxxCompiler + , ", tgtCPreprocessor = " ++ show tgtCPreprocessor + , ", tgtHsCPreprocessor = " ++ show tgtHsCPreprocessor + , ", tgtCCompilerLink = " ++ show tgtCCompilerLink + , ", tgtAr = " ++ show tgtAr + , ", tgtRanlib = " ++ show tgtRanlib + , ", tgtNm = " ++ show tgtNm + , ", tgtMergeObjs = " ++ show tgtMergeObjs + , ", tgtDllwrap = " ++ show tgtDllwrap + , ", tgtWindres = " ++ show tgtDllwrap + , "}" + ] -- | The word size as an integer representing the number of bytes wordSize2Bytes :: WordSize -> Int ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs ===================================== @@ -17,7 +17,19 @@ data Ar = Ar { arMkArchive :: Program , arSupportsDashL :: Bool , arNeedsRanlib :: Bool } - deriving (Show, Read, Eq, Ord) + deriving (Read, Eq, Ord) + +-- These instances are more suitable for diffing +instance Show Ar where + show Ar{..} = unlines + [ "Ar" + , "{ arMkArchive = " ++ show arMkArchive + , ", arIsGnu = " ++ show arIsGnu + , ", arSupportsAtFile = " ++ show arSupportsAtFile + , ", arSupportsDashL = " ++ show arSupportsDashL + , ", arNeedsRanlib = " ++ show arNeedsRanlib + , "}" + ] findAr :: ProgOpt -> M Ar findAr progOpt = checking "for 'ar'" $ do ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -1,5 +1,6 @@ {-# OPTIONS_GHC -Wno-name-shadowing #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE CPP #-} module GHC.Toolchain.Tools.Link ( CcLink(..), findCcLink ) where @@ -24,7 +25,20 @@ data CcLink = CcLink { ccLinkProgram :: Program , ccLinkSupportsResponseFiles :: Bool , ccLinkIsGnu :: Bool -- We once thought this could instead be LdSupportsGcSections, but then realized it couldn't IIRC } - deriving (Show, Read, Eq, Ord) + deriving (Read, Eq, Ord) + +-- These instances are more suitable for diffing +instance Show CcLink where + show CcLink{..} = unlines + [ "CcLink" + , "{ ccLinkProgram = " ++ show ccLinkProgram + , ", ccLinkSupportsNoPie = " ++ show ccLinkSupportsNoPie + , ", ccLinkSupportsCompactUnwind = " ++ show ccLinkSupportsCompactUnwind + , ", ccLinkSupportsFilelist = " ++ show ccLinkSupportsFilelist + , ", ccLinkSupportsResponseFiles = " ++ show ccLinkSupportsResponseFiles + , ", ccLinkIsGnu = " ++ show ccLinkIsGnu + , "}" + ] findCcLink :: ProgOpt -> Maybe Bool -> ArchOS -> Cc -> Maybe Readelf -> M CcLink findCcLink progOpt ldOverride archOs cc readelf = checking "for C compiler for linking command" $ do @@ -95,12 +109,13 @@ checkSupportsNoPie ccLink = checking "whether the cc linker supports -no-pie" $ -- Check output as some GCC versions only warn and don't respect -Werror -- when passed an unrecognized flag. (code, out, _err) <- readProgram ccLink ["-no-pie", "-Werror", "-x", "c", test_c, "-o", test] - if isSuccess code && "unrecognized" `isInfixOf` out - then return False - else return True + return (isSuccess code && not ("unrecognized" `isInfixOf` out)) checkSupportsCompactUnwind :: Cc -> Program -> M Bool checkSupportsCompactUnwind cc ccLink = checking "whether the cc linker understands -no_compact_unwind" $ + -- ROMES:TODO: This returns False here but True in configure because in + -- configure we check for ld supports compact unwind, whereas here we check + -- for cclink supports compact unwind... what do we need it for? withTempDir $ \dir -> do let test_o = dir "test.o" test2_o = dir "test2.o" @@ -108,7 +123,7 @@ checkSupportsCompactUnwind cc ccLink = checking "whether the cc linker understan compileC cc test_o "int foo() { return 0; }" exitCode <- runProgram ccLink ["-r", "-no_compact_unwind", "-o", test2_o, test_o] - pure $ isSuccess exitCode + return $ isSuccess exitCode checkSupportsFilelist :: Cc -> Program -> M Bool checkSupportsFilelist cc ccLink = checking "whether the cc linker understands -filelist" $ @@ -121,15 +136,17 @@ checkSupportsFilelist cc ccLink = checking "whether the cc linker understands -f compileC cc test1_o "int foo() { return 0; }" compileC cc test2_o "int bar() { return 0; }" - writeFile test_ofiles test1_o -- write the filename test1_o to the test_ofiles file - appendFile test_ofiles test2_o -- append the filename test2_o to the test_ofiles file + -- write the filenames test1_o and test2_o to the test_ofiles file + writeFile test_ofiles (unlines [test1_o,test2_o]) exitCode <- runProgram ccLink ["-r", "-filelist", test_ofiles, "-o", test_o] - pure $ isSuccess exitCode + return (isSuccess exitCode) checkSupportsResponseFiles :: Cc -> Program -> M Bool checkSupportsResponseFiles cc ccLink = checking "whether the cc linker supports response files" $ + -- ROMES:TODO: This returns True here while False in configure because in + -- configure we call -shared and -dylib on LD, whereas here we do it on CcLink withTempDir $ \dir -> do let test_o = dir "test.o" compileC cc test_o "int main(void) {return 0;}" @@ -141,7 +158,7 @@ checkSupportsResponseFiles cc ccLink = checking "whether the cc linker supports -- TODO: It'd be good to shortcircuit this logical `or` exitCode1 <- runProgram ccLink ["-shared", "@"++args_txt] exitCode2 <- runProgram ccLink ["-dylib", "@"++args_txt] - pure (isSuccess exitCode1 || isSuccess exitCode2) + return (isSuccess exitCode1 || isSuccess exitCode2) -- | Check whether linking works. checkLinkWorks :: Cc -> Program -> M () View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c8252c534c778f86fb9529a455c568a28d2074bf...9ff922f1285285755797b2d3a3ba6d59690f62c9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c8252c534c778f86fb9529a455c568a28d2074bf...9ff922f1285285755797b2d3a3ba6d59690f62c9 You're receiving 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 Jun 5 23:57:59 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Mon, 05 Jun 2023 19:57:59 -0400 Subject: [Git][ghc/ghc][wip/js-th] 50 commits: Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) Message-ID: <647e768782b84_1d329d3fbc708442919e@gitlab.mail> Sylvain Henry pushed to branch wip/js-th at Glasgow Haskell Compiler / GHC Commits: 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - f5debc8f by Sylvain Henry at 2023-06-06T01:02:24+02: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> - - - - - 6a6c2866 by Sylvain Henry at 2023-06-06T01:02:29+02:00 Don't use getKey - - - - - 96e3bf6a by Sylvain Henry at 2023-06-06T01:02:29+02:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - a0ac19f0 by Sylvain Henry at 2023-06-06T01:02:29+02:00 Fix some recompilation avoidance tests - - - - - 51d432e9 by Sylvain Henry at 2023-06-06T01:02:29+02:00 TH_import_loop is now broken as expected - - - - - dd2f6d56 by Sylvain Henry at 2023-06-06T01:02:29+02:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 57874408 by Sylvain Henry at 2023-06-06T01:49:40+02:00 Fix tests - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match/Literal.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/152719c701277de7ae14712dd6563ba99f6c70f2...578744088ffdfda149ae7f1ddfadbc4b7e30cd31 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/152719c701277de7ae14712dd6563ba99f6c70f2...578744088ffdfda149ae7f1ddfadbc4b7e30cd31 You're receiving 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 Jun 6 06:07:10 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Tue, 06 Jun 2023 02:07:10 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/#16635-improve-errors] 44 commits: Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) Message-ID: <647ecd0e353c_1d329d49bf48a444273@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/#16635-improve-errors at Glasgow Haskell Compiler / GHC Commits: 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - fb624fe0 by Andrei Borzenkov at 2023-06-06T10:06:11+04:00 Capture scoped kind variables at type-checking phase (#16635) Like descibed in new Note [A scoping errors during type check] in GHC.Tc.Types, I made ScopedTypeVariables work on type level like in term level. For now that only means, that the error about kind variables scoped into type are rejected at the elaboration time, because we can't generalize the type by adding type-level lambda - we simply have no one. - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Errors/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/282ebd269467203b5e9ca1f4c26d2a1ae5cb3435...fb624fe0d2c5e9fa2e12075850fa9fe6c17d6bd7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/282ebd269467203b5e9ca1f4c26d2a1ae5cb3435...fb624fe0d2c5e9fa2e12075850fa9fe6c17d6bd7 You're receiving 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 Jun 6 06:29:51 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Tue, 06 Jun 2023 02:29:51 -0400 Subject: [Git][ghc/ghc][wip/int-index/core-ignore-forall-vis] [skip ci] Editing Message-ID: <647ed25f64a21_1d329d3f855a904535d2@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/core-ignore-forall-vis at Glasgow Haskell Compiler / GHC Commits: 25f0afa3 by Vladislav Zavialov at 2023-06-06T08:29:12+02:00 [skip ci] Editing - - - - - 1 changed file: - compiler/GHC/Core/TyCo/Compare.hs Changes: ===================================== compiler/GHC/Core/TyCo/Compare.hs ===================================== @@ -257,7 +257,7 @@ We call those properties *visibility* and *specificity* respectively. Visibility and specificity are jointly represented by the `ForallTyFlag` data type. The interaction between this flag and type equality is tricky: * Definitional equality (eqType) completly ignores the flag - * Typechecker equality (tcEqType, can_eq_nc) respect visibility but ignore specificity + * Typechecker equality (tcEqType, can_eq_nc) respects visibility but ignores specificity This is not the only possible design, so we describe the design space below. Since visibility and specificity are different properties, we cover them @@ -284,7 +284,7 @@ The Core terms for `idv` and `id` are identical, while the types are different. That's not possible because we should be able to determine the type from the term: exprType :: CoreExpr -> Type -So the question becomes: which forall visibility should we `exprType` return +So the question becomes: which forall visibility should `exprType` return when faced with (/\a -> e), is it (forall a. t) or (forall a -> t)? The term alone doesn't contain enough information to make this choice. @@ -300,6 +300,7 @@ There are two ways we could address this: b) Declare `forall a -> t` and `forall a. t` nominally equal and ignore the visibility flag in `eqType` eqType :: Type -> Type -> Bool + This way `exprType` can always generate invisible foralls because it won't matter. This begs the question: why not remove visibilities from Core syntax altogether? The answer is that it's not possible because Core types are also used in parts of the compiler we the distinction does matter: @@ -318,7 +319,6 @@ lint will accept the following: We are able to assign `idv = id` despite the difference in visibilities. There are no casts involved. -`exprType` can always generate invisible foralls because it won't matter. At the same time, we want to reject such programs in surface Haskell, where users care about the distinction between visible and invisible forall. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/25f0afa3b1db85c08f74b48a30411ac6f27e39aa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/25f0afa3b1db85c08f74b48a30411ac6f27e39aa You're receiving 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 Jun 6 06:45:33 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Tue, 06 Jun 2023 02:45:33 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/js-literalstrings Message-ID: <647ed60d538ae_1d329d3d01d884461845@gitlab.mail> Josh Meredith pushed new branch wip/js-literalstrings at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/js-literalstrings You're receiving 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 Jun 6 06:48:05 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Tue, 06 Jun 2023 02:48:05 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/modern-STV-extension-shuffling] Extension shuffling (#23291) Message-ID: <647ed6a5c3acd_1d329d49bf48a44638ed@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/modern-STV-extension-shuffling at Glasgow Haskell Compiler / GHC Commits: 9781127d by Andrei Borzenkov at 2023-06-06T10:47:41+04:00 Extension shuffling (#23291) Where introduced 3 new extensions: - PatternSignatures - ExtendedForAllScope - MethodTypeVariables Tasks of ScopedTypeVariables extension were distributed between PatternSignatures, ExtendedForAllScope and MethodTypeVariables according to the proposal. Now ScopedTypeVaribles only implies these three exntesions. - - - - - 29 changed files: - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/expected-undocumented-flags.txt - docs/users_guide/exts/explicit_forall.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/scoped_type_variables.rst - docs/users_guide/exts/type_abstractions.rst - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - testsuite/tests/driver/T4437.hs - testsuite/tests/rename/should_fail/T11663.stderr - testsuite/tests/showIface/DocsInHiFile1.stdout - testsuite/tests/showIface/DocsInHiFileTH.stdout - testsuite/tests/showIface/HaddockIssue849.stdout - testsuite/tests/showIface/HaddockOpts.stdout - testsuite/tests/showIface/LanguageExts.stdout - testsuite/tests/showIface/MagicHashInHaddocks.stdout - testsuite/tests/showIface/NoExportList.stdout - testsuite/tests/showIface/PragmaDocs.stdout - testsuite/tests/showIface/ReExports.stdout - testsuite/tests/typecheck/should_fail/PatSynExistential.stderr Changes: ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -1417,7 +1417,13 @@ languageExtensions (Just GHC2021) LangExt.PostfixOperators, LangExt.RankNTypes, LangExt.ScopedTypeVariables, - LangExt.TypeAbstractions, -- implied by ScopedTypeVariables according to GHC Proposal #448 "Modern Scoped Type Variables" + + -- implied by ScopedTypeVariables according to GHC Proposal #448 "Modern Scoped Type Variables" + LangExt.TypeAbstractions, + LangExt.PatternSignatures, + LangExt.MethodTypeVariables, + LangExt.ExtendedForAllScope, + LangExt.StandaloneDeriving, LangExt.StandaloneKindSignatures, LangExt.TupleSections, ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2673,8 +2673,9 @@ xFlagsDeps = [ flagSpec "ParallelListComp" LangExt.ParallelListComp, flagSpec "PartialTypeSignatures" LangExt.PartialTypeSignatures, flagSpec "PatternGuards" LangExt.PatternGuards, - depFlagSpec' "PatternSignatures" LangExt.ScopedTypeVariables - (deprecatedForExtension "ScopedTypeVariables"), + flagSpec "PatternSignatures" LangExt.PatternSignatures, + flagSpec "MethodTypeVariables" LangExt.MethodTypeVariables, + flagSpec "ExtendedForAllScope" LangExt.ExtendedForAllScope, flagSpec "PatternSynonyms" LangExt.PatternSynonyms, flagSpec "PolyKinds" LangExt.PolyKinds, flagSpec "PolymorphicComponents" LangExt.RankNTypes, @@ -2767,6 +2768,9 @@ impliedXFlags -- In accordance with GHC Proposal #448 "Modern Scoped Type Variables" , (LangExt.ScopedTypeVariables, turnOn, LangExt.TypeAbstractions) + , (LangExt.ScopedTypeVariables, turnOn, LangExt.PatternSignatures) + , (LangExt.ScopedTypeVariables, turnOn, LangExt.MethodTypeVariables) + , (LangExt.ScopedTypeVariables, turnOn, LangExt.ExtendedForAllScope) , (LangExt.RebindableSyntax, turnOff, LangExt.ImplicitPrelude) -- NB: turn off! ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -819,9 +819,9 @@ enabled. For example, the following will be rejected: instance (Eq a => Show (Maybe a)) where ... This restriction is partly motivated by an unusual quirk of instance -declarations. Namely, if ScopedTypeVariables is enabled, then the type -variables from the top of an instance will scope over the bodies of the -instance methods, /even if the type variables are implicitly quantified/. +declarations. Namely, if MethodTypeVariables (implied by ScopedTypeVariables) is enabled, +then the type variables from the top of an instance will scope over the bodies +of the instance methods, /even if the type variables are implicitly quantified/. For example, GHC will accept the following: instance Monoid a => Monoid (Identity a) where @@ -841,20 +841,20 @@ Somewhat surprisingly, old versions of GHC would accept the instance above. Even though the `forall` only quantifies `a`, the outermost parentheses mean that the `forall` is nested, and per the forall-or-nothing rule, this means that implicit quantification would occur. Therefore, the `a` is explicitly -bound and the `b` is implicitly bound. Moreover, ScopedTypeVariables would -bring /both/ sorts of type variables into scope over the body of `m`. +bound and the `b` is implicitly bound. Moreover, MethodTypeVariables +would bring /both/ sorts of type variables into scope over the body of `m`. How utterly confusing! To avoid this sort of confusion, we simply disallow nested `forall`s in instance types, which makes things like the instance above become illegal. For the sake of consistency, we also disallow nested contexts, even though they -don't have the same strange interaction with ScopedTypeVariables. +don't have the same strange interaction with MethodTypeVariables. Just as we forbid nested `forall`s and contexts in normal instance declarations, we also forbid them in SPECIALISE instance pragmas (#18455). -Unlike normal instance declarations, ScopedTypeVariables don't have any impact -on SPECIALISE instance pragmas, but we use the same validity checks for -SPECIALISE instance pragmas anyway to be consistent. +Unlike normal instance declarations, MethodTypeVariables +don't have any impact on SPECIALISE instance pragmas, but we use the same +validity checks for SPECIALISE instance pragmas anyway to be consistent. ----- -- Wrinkle: Derived instances @@ -863,7 +863,7 @@ SPECIALISE instance pragmas anyway to be consistent. `deriving` clauses and standalone `deriving` declarations also permit bringing type variables into scope, either through explicit or implicit quantification. Unlike in the tops of instance declarations, however, one does not need to -enable ScopedTypeVariables for this to take effect. +enable MethodTypeVariables for this to take effect. Just as GHC forbids nested `forall`s in the top of instance declarations, it also forbids them in types involved with `deriving`: ===================================== compiler/GHC/Rename/Bind.hs ===================================== @@ -920,7 +920,8 @@ rnMethodBinds is_cls_decl cls ktv_names binds sigs -- Rename the bindings RHSs. Again there's an issue about whether the -- type variables from the class/instance head are in scope. -- Answer no in Haskell 2010, but yes if you have -XScopedTypeVariables - ; (binds'', bind_fvs) <- bindSigTyVarsFV ktv_names $ + -- or -XMethodTypeVariables + ; (binds'', bind_fvs) <- bindClassInstanceHeadTyVarsFV ktv_names $ do { binds_w_dus <- mapBagM (rnLBind (mkScopedTvFn other_sigs')) binds' ; let bind_fvs = foldr (\(_,_,fv1) fv2 -> fv1 `plusFV` fv2) emptyFVs binds_w_dus ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -31,7 +31,8 @@ module GHC.Rename.HsType ( -- Binding related stuff bindHsOuterTyVarBndrs, bindHsForAllTelescope, bindLHsTyVarBndr, bindLHsTyVarBndrs, WarnUnusedForalls(..), - rnImplicitTvOccs, bindSigTyVarsFV, bindHsQTyVars, + rnImplicitTvOccs, bindSigTyVarsFV, bindClassInstanceHeadTyVarsFV , + bindHsQTyVars, FreeKiTyVars, filterInScopeM, extractHsTyRdrTyVars, extractHsTyRdrTyVarsKindVars, extractHsTysRdrTyVars, extractRdrKindSigVars, @@ -150,14 +151,14 @@ rnHsPatSigType :: HsPatSigTypeScoping -> (HsPatSigType GhcRn -> RnM (a, FreeVars)) -> RnM (a, FreeVars) -- Used for --- - Pattern type signatures, which are only allowed with ScopedTypeVariables +-- - Pattern type signatures, which are only allowed with PatternSignatures -- - Signatures on binders in a RULE, which are allowed even if --- ScopedTypeVariables isn't enabled +-- PatternSignatures isn't enabled -- Wildcards are allowed -- -- See Note [Pattern signature binders and scoping] in GHC.Hs.Type rnHsPatSigType scoping ctx sig_ty thing_inside - = do { ty_sig_okay <- xoptM LangExt.ScopedTypeVariables + = do { ty_sig_okay <- xoptM LangExt.PatternSignatures ; checkErr ty_sig_okay (unexpectedPatSigTypeErr sig_ty) ; free_vars <- filterInScopeM (extractHsTyRdrTyVars pat_sig_ty) ; (nwc_rdrs', tv_rdrs) <- partition_nwcs free_vars @@ -900,18 +901,25 @@ notInKinds _ _ = return () * * ***************************************************** -} -bindSigTyVarsFV :: [Name] - -> RnM (a, FreeVars) - -> RnM (a, FreeVars) -- Used just before renaming the defn of a function -- with a separate type signature, to bring its tyvars into scope --- With no -XScopedTypeVariables, this is a no-op +-- With no -XExtendedForAllScope/-XMethodTypeVariables, this is a no-op +bindSigTyVarsFV, bindClassInstanceHeadTyVarsFV :: [Name] + -> RnM (a, FreeVars) + -> RnM (a, FreeVars) + bindSigTyVarsFV tvs thing_inside - = do { scoped_tyvars <- xoptM LangExt.ScopedTypeVariables - ; if not scoped_tyvars then - thing_inside - else - bindLocalNamesFV tvs thing_inside } + = do { extended_for_all_scope <- xoptM LangExt.ExtendedForAllScope + ; if extended_for_all_scope + then bindLocalNamesFV tvs thing_inside + else thing_inside } + +bindClassInstanceHeadTyVarsFV tvs thing_inside + = do { method_type_variables <- xoptM LangExt.MethodTypeVariables + ; if method_type_variables + then bindLocalNamesFV tvs thing_inside + else thing_inside } + --------------- bindHsQTyVars :: forall a b. ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -198,7 +198,7 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls, -- (H) Rename Everything else - (rn_rule_decls, src_fvs2) <- setXOptM LangExt.ScopedTypeVariables $ + (rn_rule_decls, src_fvs2) <- setXOptM LangExt.PatternSignatures $ rnList rnHsRuleDecls rule_decls ; -- Inside RULES, scoped type variables are on (rn_foreign_decls, src_fvs3) <- rnList rnHsForeignDecl foreign_decls ; ===================================== compiler/GHC/Tc/Deriv.hs ===================================== @@ -273,7 +273,9 @@ renameDeriv inst_infos bagBinds setXOptM LangExt.EmptyCase $ -- Derived decls (for empty types) can have -- case x of {} - setXOptM LangExt.ScopedTypeVariables $ + setXOptM LangExt.MethodTypeVariables $ + setXOptM LangExt.PatternSignatures $ + setXOptM LangExt.ExtendedForAllScope $ setXOptM LangExt.KindSignatures $ -- Derived decls (for newtype-deriving) can use ScopedTypeVariables & -- KindSignatures ===================================== compiler/GHC/Tc/Deriv/Generate.hs ===================================== @@ -1875,9 +1875,9 @@ of the method. For example, recall: join In the example above, it is imperative that the `a` in the instance signature -for `join` scope over the body of `join` by way of ScopedTypeVariables. -This might sound obvious, but note that in gen_Newtype_binds, which is -responsible for generating the code above, the type in `join`'s instance +for `join` scope over the body of `join` by way of ExtendedForallScope (implied +by ScopedTypeVariables). This might sound obvious, but note that in gen_Newtype_binds, +which is responsible for generating the code above, the type in `join`'s instance signature is given as a Core type, whereas gen_Newtype_binds will eventually produce HsBinds (i.e., source Haskell) that is renamed and typechecked. We must ensure that `a` is in scope over the body of `join` during renaming ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1637,9 +1637,7 @@ instance Diagnostic TcRnMessage where nest 4 (text "in the section:" <+> quotes (ppr section))] TcRnUnexpectedPatSigType ty - -> mkSimpleDecorated $ - hang (text "Illegal type signature:" <+> quotes (ppr ty)) - 2 (text "Type signatures are only allowed in patterns with ScopedTypeVariables") + -> mkSimpleDecorated $ text "Illegal type signature:" <+> quotes (ppr ty) TcRnIllegalKindSignature ty -> mkSimpleDecorated $ text "Illegal kind signature:" <+> quotes (ppr ty) @@ -3011,7 +3009,7 @@ instance Diagnostic TcRnMessage where TcRnSectionPrecedenceError{} -> noHints TcRnUnexpectedPatSigType{} - -> [suggestExtension LangExt.ScopedTypeVariables] + -> [suggestExtension LangExt.PatternSignatures] TcRnIllegalKindSignature{} -> [suggestExtension LangExt.KindSignatures] TcRnUnusedQuantifiedTypeVar{} ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -2381,7 +2381,7 @@ data TcRnMessage where -> TcRnMessage {-| TcRnUnexpectedPatSigType is an error occurring when there is - a type signature in a pattern without -XScopedTypeVariables extension + a type signature in a pattern without -XPatternSignatures extension Examples: f (a :: Bool) = ... ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -10,6 +10,11 @@ Language sized primitive literals, e.g. ``123#Int8`` is a literal of type ``Int8#``. See the GHC proposal `#451 `_. +- :extension:`ScopedTypeVariables` was split into several new extensions: + :extension:`PatternSignatures`, :extension:`ExtendedForAllScope`, :extension:`MethodTypeVariables`. + You can set :extension:`ScopedTypeVariables` to enable them all or enable them individually + for more fine-grained control of features that you want to have. + Compiler ~~~~~~~~ ===================================== docs/users_guide/expected-undocumented-flags.txt ===================================== @@ -14,7 +14,6 @@ -XMonomorphismRestriction -XParallelArrays -XPatternGuards --XPatternSignatures -XPolymorphicComponents -XRecordPuns -XRelaxedLayout ===================================== docs/users_guide/exts/explicit_forall.rst ===================================== @@ -114,7 +114,7 @@ The ``forall``-or-nothing rule takes effect in the following places: Notes: -- :ref:`pattern-type-sigs` are a notable example of a place where +- :extension:`PatternSignatures` are a notable example of a place where types do *not* obey the ``forall``-or-nothing rule. For example, GHC will accept the following: :: ===================================== docs/users_guide/exts/gadt.rst ===================================== @@ -194,7 +194,7 @@ also sets :extension:`GADTSyntax` and :extension:`MonoLocalBinds`. In the function clause for ``g``, GHC first checks ``MkF``, the outermost pattern, followed by the inner ``Nothing`` pattern. This outside-in order - can interact somewhat counterintuitively with :ref:`pattern-type-sigs`. + can interact somewhat counterintuitively with :extension:`PatternSignatures`. Consider the following variation of ``g``: :: g2 :: F a a -> a ===================================== docs/users_guide/exts/scoped_type_variables.rst ===================================== @@ -6,9 +6,13 @@ Lexically scoped type variables =============================== .. extension:: ScopedTypeVariables - :shortdesc: Enable lexically-scoped type variables. + :shortdesc: Enable lexically-scoped type variables everywhere. - :implies: :extension:`ExplicitForAll` + :implies: :extension:`ExplicitForAll`, + :extension:`PatternSignatures`, + :extension:`ExtendedForAllScope`, + :extension:`MethodTypeVariables`, + :extension:`TypeAbstractions` :since: 6.8.1 @@ -26,7 +30,7 @@ Lexically scoped type variables To trigger those forms of :extension:`ScopedTypeVariables`, the ``forall`` must appear against the top-level signature (or outer expression) but *not* against nested signatures referring to the same type variables. - Explicit ``forall`` is not always required -- see :ref:`pattern signature equivalent ` for the example in this section, or :ref:`pattern-type-sigs`. + Explicit ``forall`` is not always required -- see :ref:`pattern signature equivalent ` for the example in this section, or :extension:`PatternSignatures`. GHC supports *lexically scoped type variables*, without which some type signatures are simply impossible to write. For example: :: @@ -48,7 +52,7 @@ possible to do so. .. _pattern-equiv-form: -An equivalent form for that example, avoiding explicit ``forall`` uses :ref:`pattern-type-sigs`: :: +An equivalent form for that example, avoiding explicit ``forall`` uses :extension:`PatternSignatures`: :: f :: [a] -> [a] f (xs :: [aa]) = xs ++ ys @@ -84,9 +88,9 @@ A *lexically scoped type variable* can be bound by: - An expression type signature (:ref:`exp-type-sigs`) -- A pattern type signature (:ref:`pattern-type-sigs`) +- A pattern type signature (:extension:`PatternSignatures`) -- Class and instance declarations (:ref:`cls-inst-scoped-tyvars`) +- Class and instance declarations (:extension:`MethodTypeVariables`) In Haskell, a programmer-written type signature is implicitly quantified over its free type variables (`Section @@ -100,14 +104,31 @@ scope is *not* universally quantified. For example, if type variable (e :: b -> b) means (e :: forall b. b->b) (e :: a -> b) means (e :: forall b. a->b) +Extended ForAll Scope +===================== + +.. extension:: ExtendedForAllScope + :shortdesc: Enable lexically-scoped type variables in function bindings, + pattern synonyms and expression type signatures. + + :since: 9.8.1 + + :implied by: :extension:`ScopedTypeVariables` + + :status: Included in :extension:`GHC2021` + + Enable lexical scoping of type variables explicitly introduced with + a ``forall`` in function bindings, pattern synonyms and expression type signatures. + .. _decl-type-sigs: Declaration type signatures --------------------------- -A declaration type signature that has *explicit* quantification (using -``forall``) brings into scope the explicitly-quantified type variables, -in the definition of the named function. For example: :: +When :extension:`ExtendedForAllScope` is enabled, a declaration type signature +that has *explicit* quantification (using ``forall``) brings into scope the +explicitly-quantified type variables, in the definition of the named function. +For example: :: f :: forall a. [a] -> [a] f (x:xs) = xs ++ [ x :: a ] @@ -171,9 +192,9 @@ This only happens if: Expression type signatures -------------------------- -An expression type signature that has *explicit* quantification (using -``forall``) brings into scope the explicitly-quantified type variables, -in the annotated expression. For example: :: +When :extension:`ExtendedForAllScope` is enabled, an expression type signature +that has *explicit* quantification (using ``forall``) brings into scope the +explicitly-quantified type variables, in the annotated expression. For example: :: f = runST ( (op >>= \(x :: STRef s Int) -> g x) :: forall s. ST s Bool ) @@ -181,13 +202,22 @@ Here, the type signature ``forall s. ST s Bool`` brings the type variable ``s`` into scope, in the annotated expression ``(op >>= \(x :: STRef s Int) -> g x)``. -.. _pattern-type-sigs: +Pattern Signatures +================== + +.. extension:: PatternSignatures + :shortdesc: Allow type signatures in patterns. -Pattern type signatures ------------------------ + :since: 9.8.1 -A type signature may occur in any pattern; this is a *pattern type -signature*. For example: :: + :implied by: :extension:`ScopedTypeVariables` + + :status: Included in :extension:`GHC2021` + + Allow type signatures and type variable bindings in patterns. + +When :extension:`PatternSignatures` is enabled, a type signature may occur +in any pattern; this is a *pattern type signature*. For example: :: -- f and g assume that 'a' is already in scope f = \(x::Int, y::a) -> x @@ -259,12 +289,21 @@ they are both legal whether or not ``a`` is already in scope. They differ in that *if* ``a`` is already in scope, the signature constrains the pattern, rather than the pattern binding the variable. -.. _cls-inst-scoped-tyvars: +Method Type Variables +===================== + +.. extension:: MethodTypeVariables + :shortdesc: Enable lexically-scoped type variables in class and instance declarations. + + :since: 9.8.1 + + :implied by: :extension:`ScopedTypeVariables` + + :status: Included in :extension:`GHC2021` -Class and instance declarations -------------------------------- + Enable lexical scoping of type variables explicitly introduced by class and instance heads. -:extension:`ScopedTypeVariables` allow the type variables bound by the top of a +:extension:`MethodTypeVariables` allow the type variables bound by the top of a ``class`` or ``instance`` declaration to scope over the methods defined in the ``where`` part. Unlike :ref:`decl-type-sigs`, type variables from class and instance declarations can be lexically scoped without an explicit ``forall`` @@ -286,11 +325,11 @@ declaration; see :ref:`explicit-foralls`). For example: :: instance forall b. C b => C [b] where op xs = reverse (head (xs :: [[b]])) -While :extension:`ScopedTypeVariables` is required for type variables from the +While :extension:`MethodTypeVariables` is required for type variables from the top of a class or instance declaration to scope over the /bodies/ of the methods, it is not required for the type variables to scope over the /type signatures/ of the methods. For example, the following will be accepted without -explicitly enabling :extension:`ScopedTypeVariables`: :: +explicitly enabling :extension:`MethodTypeVariables`: :: class D a where m :: [a] -> a @@ -302,11 +341,11 @@ explicitly enabling :extension:`ScopedTypeVariables`: :: Note that writing ``m :: [a] -> [a]`` requires the use of the :extension:`InstanceSigs` extension. -Similarly, :extension:`ScopedTypeVariables` is not required for type variables +Similarly, :extension:`MethodTypeVariables` is not required for type variables from the top of the class or instance declaration to scope over associated type families, which only requires the :extension:`TypeFamilies` extension. For instance, the following will be accepted without explicitly enabling -:extension:`ScopedTypeVariables`: :: +:extension:`MethodTypeVariables`: :: class E a where type T a ===================================== docs/users_guide/exts/type_abstractions.rst ===================================== @@ -6,6 +6,8 @@ Type abstractions :since: 9.8.1 + :implied by: :extension:`ScopedTypeVariables` + :status: Partially implemented Allow the use of type abstraction syntax. ===================================== libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs ===================================== @@ -153,6 +153,9 @@ data Extension | OverloadedRecordUpdate | TypeAbstractions | ExtendedLiterals + | PatternSignatures + | ExtendedForAllScope + | MethodTypeVariables deriving (Eq, Enum, Show, Generic, Bounded) -- 'Ord' and 'Bounded' are provided for GHC API users (see discussions -- in https://gitlab.haskell.org/ghc/ghc/merge_requests/2707 and ===================================== testsuite/tests/driver/T4437.hs ===================================== @@ -38,7 +38,9 @@ check title expected got expectedGhcOnlyExtensions :: [String] expectedGhcOnlyExtensions = [ "TypeAbstractions", - "ExtendedLiterals" + "ExtendedLiterals", + "MethodTypeVariables", + "ExtendedForAllScope" ] expectedCabalOnlyExtensions :: [String] ===================================== testsuite/tests/rename/should_fail/T11663.stderr ===================================== @@ -1,20 +1,16 @@ T11663.hs:6:12: error: [GHC-74097] Illegal type signature: ‘Int’ - Type signatures are only allowed in patterns with ScopedTypeVariables - Suggested fix: Perhaps you intended to use ScopedTypeVariables + Suggested fix: Perhaps you intended to use PatternSignatures T11663.hs:7:9: error: [GHC-74097] Illegal type signature: ‘Int’ - Type signatures are only allowed in patterns with ScopedTypeVariables - Suggested fix: Perhaps you intended to use ScopedTypeVariables + Suggested fix: Perhaps you intended to use PatternSignatures T11663.hs:8:22: error: [GHC-74097] Illegal type signature: ‘Int’ - Type signatures are only allowed in patterns with ScopedTypeVariables - Suggested fix: Perhaps you intended to use ScopedTypeVariables + Suggested fix: Perhaps you intended to use PatternSignatures T11663.hs:9:32: error: [GHC-74097] Illegal type signature: ‘Int’ - Type signatures are only allowed in patterns with ScopedTypeVariables - Suggested fix: Perhaps you intended to use ScopedTypeVariables + Suggested fix: Perhaps you intended to use PatternSignatures ===================================== testsuite/tests/showIface/DocsInHiFile1.stdout ===================================== @@ -144,5 +144,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/DocsInHiFileTH.stdout ===================================== @@ -287,5 +287,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/HaddockIssue849.stdout ===================================== @@ -67,5 +67,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/HaddockOpts.stdout ===================================== @@ -59,5 +59,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/LanguageExts.stdout ===================================== @@ -23,4 +23,3 @@ docs: CUSKs FieldSelectors extensible fields: - ===================================== testsuite/tests/showIface/MagicHashInHaddocks.stdout ===================================== @@ -69,5 +69,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/NoExportList.stdout ===================================== @@ -95,5 +95,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/PragmaDocs.stdout ===================================== @@ -69,5 +69,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/ReExports.stdout ===================================== @@ -66,5 +66,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/typecheck/should_fail/PatSynExistential.stderr ===================================== @@ -1,4 +1,5 @@ -PatSynExistential.hs:6:1: [GHC-33973] - The result type of the signature for ‘P’, namely ‘x -> Maybe x’ + +PatSynExistential.hs:6:1: error: [GHC-33973] + • The result type of the signature for ‘P’, namely ‘x -> Maybe x’ mentions existential type variable ‘x’ - In the declaration for pattern synonym ‘P’ + • In the declaration for pattern synonym ‘P’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9781127dbf7d25354237a56d7aaaa0b446c65ac9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9781127dbf7d25354237a56d7aaaa0b446c65ac9 You're receiving 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 Jun 6 07:15:43 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 06 Jun 2023 03:15:43 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 46 commits: Configure CPP into settings Message-ID: <647edd1f80efe_1d329d3d01d8844726f1@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 417c37e0 by Rodrigo Mesquita at 2023-05-30T16:59:28+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 746203e0 by Ben Gamari at 2023-05-30T20:10:29+01:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 1bf764ec by hainq at 2023-06-06T08:15:22+01:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 3d83ab77 by Krzysztof Gogolewski at 2023-06-06T08:15:22+01:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - b699578a by Matthew Pickering at 2023-06-06T08:15:22+01:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - e7095cd9 by Matthew Pickering at 2023-06-06T08:15:22+01:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - f89fa0b1 by Matthew Pickering at 2023-06-06T08:15:22+01:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - 260c77ff by Ben Gamari at 2023-06-06T08:15:23+01:00 users guide: A few small mark-up fixes - - - - - 9b9415c1 by Rodrigo Mesquita at 2023-06-06T08:15:23+01:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - 3c2af048 by mangoiv at 2023-06-06T08:15:23+01:00 [feat] add .direnv to the .gitignore file - - - - - 1b20a970 by Bodigrim at 2023-06-06T08:15:23+01:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - ca3b3f1e by Bartłomiej Cieślar at 2023-06-06T08:15:23+01:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - de5b548c by Krzysztof Gogolewski at 2023-06-06T08:15:23+01:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 89061653 by Krzysztof Gogolewski at 2023-06-06T08:15:23+01:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - f53da0de by uhbif19 at 2023-06-06T08:15:23+01:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 691cd492 by sheaf at 2023-06-06T08:15:23+01:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - 58fa623a by Krzysztof Gogolewski at 2023-06-06T08:15:23+01:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - ca4b12d7 by Matthew Pickering at 2023-06-06T08:15:23+01:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - 8a138ad6 by sheaf at 2023-06-06T08:15:23+01:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - 0c70cfab by Matthew Pickering at 2023-06-06T08:15:23+01:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 5818ccc8 by Matthew Pickering at 2023-06-06T08:15:23+01:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - 1b9fa5d8 by Matthew Pickering at 2023-06-06T08:15:23+01:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 32b07b52 by Matthew Pickering at 2023-06-06T08:15:23+01:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 2af762d1 by Matthew Pickering at 2023-06-06T08:15:23+01:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 1189aacc by Matthew Pickering at 2023-06-06T08:15:23+01:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - b744e3b8 by Matthew Pickering at 2023-06-06T08:15:23+01:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 6064b6e8 by Matthew Pickering at 2023-06-06T08:15:23+01:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 602ef5ff by Matthew Pickering at 2023-06-06T08:15:23+01:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - b67989d5 by Matthew Pickering at 2023-06-06T08:15:23+01:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - f650fa95 by Matthew Pickering at 2023-06-06T08:15:23+01:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 29913d67 by Matthew Pickering at 2023-06-06T08:15:23+01:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - 00cc82ff by Matthew Pickering at 2023-06-06T08:15:23+01:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 3b5a0588 by Josh Meredith at 2023-06-06T08:15:23+01:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - 597248d3 by Norman Ramsey at 2023-06-06T08:15:23+01:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 8843c682 by Sylvain Henry at 2023-06-06T08:15:23+01:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - 63f89325 by Oleg Grenrus at 2023-06-06T08:15:23+01:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 3f9895df by Alan Zimmerman at 2023-06-06T08:15:23+01:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - ccd46b57 by Ben Gamari at 2023-06-06T08:15:23+01:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - d8e9c70b by Ben Gamari at 2023-06-06T08:15:24+01:00 ghc-toolchain: Initial commit - - - - - ab3c63e2 by Ben Gamari at 2023-06-06T08:15:24+01:00 Rip out runtime linker/compiler checks - - - - - df50a5ff by Ben Gamari at 2023-06-06T08:15:24+01:00 configure: Rip out toolchain selection logic - - - - - f5d35eab by Rodrigo Mesquita at 2023-06-06T08:15:24+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b480f4ab1514ac0a4fc957db199d1a0279. Revert get_arm_isa deletion from 74f03f243d08aa910d39cdd9dadb976e9386283a As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X - - - - - 6686bc8b by Rodrigo Mesquita at 2023-06-06T08:15:24+01:00 configure: Revert ripping out of toolchain selection logic - - - - - 7cc3bbdd by Rodrigo Mesquita at 2023-06-06T08:15:24+01:00 Stop configuring into settings unused Ld command - - - - - 32161660 by Rodrigo Mesquita at 2023-06-06T08:15:24+01:00 configure: Create and validate toolchain target file - - - - - 405d6909 by Rodrigo Mesquita at 2023-06-06T08:15:24+01:00 Fixes to match configure output - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CmdLine.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Config/Cmm.hs - compiler/GHC/Driver/Config/Cmm/Parser.hs - compiler/GHC/Driver/Config/CmmToAsm.hs - compiler/GHC/Driver/Config/CmmToLlvm.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Config/Core/Lint/Interactive.hs - compiler/GHC/Driver/Config/Core/Opt/Arity.hs - compiler/GHC/Driver/Config/Core/Opt/LiberateCase.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/Driver/Config/Core/Opt/WorkWrap.hs - compiler/GHC/Driver/Config/Core/Rules.hs - compiler/GHC/Driver/Config/CoreToStg.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9ff922f1285285755797b2d3a3ba6d59690f62c9...405d69091b4fc4b4555ef827250afc20862980aa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9ff922f1285285755797b2d3a3ba6d59690f62c9...405d69091b4fc4b4555ef827250afc20862980aa You're receiving 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 Jun 6 07:29:30 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 06 Jun 2023 03:29:30 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 2 commits: configure: Create and validate toolchain target file Message-ID: <647ee05acdb2e_1d329d3fbc395c475180@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: b3c33d3c by Rodrigo Mesquita at 2023-06-06T08:29:16+01:00 configure: Create and validate toolchain target file - - - - - f7112721 by Rodrigo Mesquita at 2023-06-06T08:29:20+01:00 Fixes to match configure output - - - - - 10 changed files: - configure.ac - + default.target.in - distrib/configure.ac.in - m4/ghc_toolchain.m4 - + m4/prep_target_file.m4 - utils/ghc-toolchain/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/PlatformDetails.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs Changes: ===================================== configure.ac ===================================== @@ -644,7 +644,6 @@ dnl CONF_CC_OPTS_STAGE[012] accordingly. FP_CC_SUPPORTS_TARGET([$CC_STAGE0], [CONF_CC_OPTS_STAGE0], [CONF_CXX_OPTS_STAGE0], [CONF_GCC_LINKER_OPTS_STAGE0]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINKER_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINKER_OPTS_STAGE2]) -FIND_GHC_TOOLCHAIN # CPP, CPPFLAGS # --with-cpp/-with-cpp-flags @@ -1168,6 +1167,10 @@ checkMake380() { checkMake380 make checkMake380 gmake +# Toolchain target files +PREP_TARGET_FILE +FIND_GHC_TOOLCHAIN + AC_CONFIG_FILES( [ mk/project.mk hadrian/cfg/system.config @@ -1176,8 +1179,11 @@ AC_CONFIG_FILES( hadrian/ghci-stack docs/users_guide/ghc_config.py distrib/configure.ac + default.target ]) +VALIDATE_GHC_TOOLCHAIN + dnl Create the VERSION file, satisfying #22322. printf "$ProjectVersion" > VERSION ===================================== default.target.in ===================================== @@ -0,0 +1,39 @@ +Target +{ tgtArchOs = ArchOS {archOS_arch = @HaskellHostArch@, archOS_OS = @HaskellHostOs@} +, tgtSupportsGnuNonexecStack = @TargetHasGnuNonexecStackBool@ +, tgtSupportsSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbolsBool@ +, tgtSupportsIdentDirective = @TargetHasIdentDirectiveBool@ +, tgtWordSize = WS at TargetWordSize@ +, tgtEndianness = LittleEndian +, tgtSymbolsHaveLeadingUnderscore = @LeadingUnderscoreBool@ +, tgtLlvmTarget = "@HostPlatform@" +, tgtUnregisterised = @UnregisterisedBool@ +, tgtTablesNextToCode = @TablesNextToCodeBool@ +, tgtUseLibffiForAdjustors = @UseLibffiForAdjustorsBool@ +, tgtCCompiler = Cc {ccProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @SettingsCCompilerFlagsList@}} +, tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@SettingsCxxCompilerCommand@", prgFlags = @SettingsCxxCompilerFlagsList@}} +, tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@CPPCmd@", prgFlags = @CONF_CPP_OPTS_STAGE1List@}} +, tgtHsCPreprocessor = HsCpp {hsCppProgram = Program {prgPath = "@HaskellCPPCmd@", prgFlags = @HaskellCPPArgsList@}} +, tgtCCompilerLink = CcLink +{ ccLinkProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @SettingsCCompilerLinkFlagsList@} +, ccLinkSupportsNoPie = @SettingsCCompilerSupportsNoPieBool@ +, ccLinkSupportsCompactUnwind = @LdHasNoCompactUnwindBool@ +, ccLinkSupportsFilelist = @LdHasFilelistBool@ +, ccLinkSupportsResponseFiles = @LdSupportsResponseFilesBool@ +, ccLinkIsGnu = @LdIsGNULdBool@ +} + +, tgtAr = Ar +{ arMkArchive = Program {prgPath = "@AR@", prgFlags = @ArArgsList@} +, arIsGnu = False +, arSupportsAtFile = @ArSupportsAtFileBool@ +, arSupportsDashL = @ArSupportsDashLBool@ +, arNeedsRanlib = False +} + +, tgtRanlib = Just (Ranlib {ranlibProgram = Program {prgPath = "@REAL_RANLIB_CMD@", prgFlags = []}}) +, tgtNm = Nm {nmProgram = Program {prgPath = "@NmCmd@", prgFlags = []}} +, tgtMergeObjs = Just (MergeObjs {mergeObjsProgram = Program {prgPath = "@SettingsMergeObjectsCommand@", prgFlags = @SettingsMergeObjectsFlagsList@}}) +, tgtDllwrap = Nothing +, tgtWindres = Nothing +} ===================================== distrib/configure.ac.in ===================================== @@ -303,6 +303,11 @@ checkMake380() { checkMake380 make checkMake380 gmake +# Toolchain target files +PREP_TARGET_FILE +FIND_GHC_TOOLCHAIN +VALIDATE_GHC_TOOLCHAIN + echo "****************************************************" echo "Configuration done, ready to 'make install'" echo "(see README and INSTALL files for more info.)" ===================================== m4/ghc_toolchain.m4 ===================================== @@ -66,8 +66,19 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], ) &1` + if test -z "$diff_output"; then + true + else + AC_MSG_WARN([Differences found between $A and $B: $diff_output]) + fi +]) ===================================== m4/prep_target_file.m4 ===================================== @@ -0,0 +1,74 @@ +# PREP_BOOLEAN +# ============ +# +# Issue a substitution with True/False of [$1Bool] when $1 has YES/NO value +# $1 = boolean variable to substitute +AC_DEFUN([PREP_BOOLEAN],[ + case "$$1" in + YES) + $1Bool=True + ;; + NO) + $1Bool=False + ;; + *) + AC_MSG_ERROR([Expecting YES/NO but got $$1 in $1]) + ;; + esac + AC_SUBST([$1Bool]) +]) + +# PREP_LIST +# ============ +# +# Issue a substitution with ["list","of","args"] of [$1List] when $1 is a +# space-separated list of args +# $1 = list variable to substitute +dnl In autoconf, '@<:@' stands for '[', and '@:>@' for ']'. +AC_DEFUN([PREP_LIST],[ + # shell array + set -- $$1 + $1List="@<:@" + if test "[$]#" -eq 0; then + # no arguments + true + else + $1List="${$1List}\"[$]1\"" + shift # drop first elem + for arg in "[$]@" + do + $1List="${$1List},\"$arg\"" + done + fi + $1List="${$1List}@:>@" + + AC_SUBST([$1List]) +]) + +# Eventually: PREP_BUILD_TARGET_FILE, PREP_HOST_TARGET_FILE, PREP_TARGET_TARGET_FILE +# Prepares required substitutions to generate the target file +AC_DEFUN([PREP_TARGET_FILE],[ + PREP_BOOLEAN([LdSupportsResponseFiles]) + PREP_BOOLEAN([TargetHasGnuNonexecStack]) + PREP_BOOLEAN([LeadingUnderscore]) + PREP_BOOLEAN([ArSupportsAtFile]) + PREP_BOOLEAN([ArSupportsDashL]) + PREP_BOOLEAN([TargetHasIdentDirective]) + PREP_BOOLEAN([SettingsCCompilerSupportsNoPie]) + PREP_BOOLEAN([LdHasFilelist]) + PREP_BOOLEAN([LdIsGNULd]) + PREP_BOOLEAN([LdHasNoCompactUnwind]) + PREP_BOOLEAN([TargetHasSubsectionsViaSymbols]) + PREP_BOOLEAN([Unregisterised]) + PREP_BOOLEAN([TablesNextToCode]) + PREP_BOOLEAN([UseLibffiForAdjustors]) + PREP_LIST([SettingsMergeObjectsFlags]) + PREP_LIST([ArArgs]) + PREP_LIST([SettingsCCompilerLinkFlags]) + PREP_LIST([HaskellCPPArgs]) + PREP_LIST([CONF_CPP_OPTS_STAGE1]) + PREP_LIST([SettingsCxxCompilerFlags]) + PREP_LIST([SettingsCCompilerFlags]) +]) + +AC_DEFUN() ===================================== utils/ghc-toolchain/Main.hs ===================================== @@ -160,9 +160,11 @@ options = -- Empty list of flags is as if it was unspecified updatePoFlags "" existingOpts = existingOpts - -- Otherwise append specified flags to existing flags or make new + -- Otherwise prepend specified flags to existing flags or make new updatePoFlags newOpts Nothing = Just [newOpts] - updatePoFlags newOpts (Just eopts) = Just (eopts ++ [newOpts]) + updatePoFlags newOpts (Just eopts) = Just (newOpts:eopts) + -- NB: By prepending, the resulting flags will match the left-to-right + -- order they were passed in enableDisable :: String -> String -> Lens Opts (Maybe Bool) -> [OptDescr (Opts -> Opts)] @@ -216,7 +218,9 @@ run :: Opts -> M () run opts = do tgt <- mkTarget opts logDebug $ "Final Target: " ++ show tgt - writeFile "default.target" (show tgt) + let file = "default.ghc-toolchain.target" + writeFile file (show tgt) + appendFile file "\n" -- eol optional :: M a -> M (Maybe a) optional k = fmap Just k <|> pure Nothing @@ -327,7 +331,7 @@ mkTarget opts = do tgtWordSize <- checkWordSize cc tgtEndianness <- checkEndianness cc tgtSymbolsHaveLeadingUnderscore <- checkLeadingUnderscore cc nm - tgtSupportsSubsectionsViaSymbols <- checkSubsectionsViaSymbols cc + tgtSupportsSubsectionsViaSymbols <- checkSubsectionsViaSymbols archOs cc tgtSupportsIdentDirective <- checkIdentDirective cc tgtSupportsGnuNonexecStack <- checkGnuNonexecStack archOs cc @@ -338,7 +342,7 @@ mkTarget opts = do tgtUseLibffi <- determineUseLibFFIForAdjustors archOs (optUseLibFFIForAdjustors opts) when tgtUnregisterised $ do -- The via-C code generator requires these - let prog = "int main(int argc, char** argv) { return 0; }I" + let prog = "int main(int argc, char** argv) { return 0; }" via_c_args = ["-fwrapv", "-fno-builtin"] forM_ via_c_args $ \arg -> checking ("support of "++arg) $ withTempDir $ \dir -> do let cc' = over (_ccProgram % _prgFlags) (++ [arg]) cc ===================================== utils/ghc-toolchain/src/GHC/Toolchain/PlatformDetails.hs ===================================== @@ -102,11 +102,17 @@ checkLeadingUnderscore cc nm = checking ctxt $ withTempDir $ \dir -> do prog = "int func(void) { return 0; }" ctxt = "whether symbols have leading underscores" -checkSubsectionsViaSymbols :: Cc -> M Bool -checkSubsectionsViaSymbols = - testCompile - "whether .subsections-via-symbols directive is supported" - (asmStmt ".subsections_via_symbols") +checkSubsectionsViaSymbols :: ArchOS -> Cc -> M Bool +checkSubsectionsViaSymbols archos cc = + case archOS_arch archos of + ArchAArch64 -> + -- subsections via symbols is busted on arm64 + -- TODO: ^ is this comment up to date? + return False + _ -> + testCompile + "whether .subsections-via-symbols directive is supported" + (asmStmt ".subsections_via_symbols") cc checkIdentDirective :: Cc -> M Bool checkIdentDirective = ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE RecordWildCards #-} module GHC.Toolchain.Target where import GHC.Platform.ArchOS @@ -60,7 +61,35 @@ data Target = Target , tgtDllwrap :: Maybe Program , tgtWindres :: Maybe Program } - deriving (Show, Read, Eq, Ord) + deriving (Read, Eq, Ord) + +instance Show Target where + show Target{..} = unlines + [ "Target" + , "{ tgtArchOs = " ++ show tgtArchOs + , ", tgtSupportsGnuNonexecStack = " ++ show tgtSupportsGnuNonexecStack + , ", tgtSupportsSubsectionsViaSymbols = " ++ show tgtSupportsSubsectionsViaSymbols + , ", tgtSupportsIdentDirective = " ++ show tgtSupportsIdentDirective + , ", tgtWordSize = " ++ show tgtWordSize + , ", tgtEndianness = " ++ show tgtEndianness + , ", tgtSymbolsHaveLeadingUnderscore = " ++ show tgtSymbolsHaveLeadingUnderscore + , ", tgtLlvmTarget = " ++ show tgtLlvmTarget + , ", tgtUnregisterised = " ++ show tgtUnregisterised + , ", tgtTablesNextToCode = " ++ show tgtTablesNextToCode + , ", tgtUseLibffiForAdjustors = " ++ show tgtUseLibffiForAdjustors + , ", tgtCCompiler = " ++ show tgtCCompiler + , ", tgtCxxCompiler = " ++ show tgtCxxCompiler + , ", tgtCPreprocessor = " ++ show tgtCPreprocessor + , ", tgtHsCPreprocessor = " ++ show tgtHsCPreprocessor + , ", tgtCCompilerLink = " ++ show tgtCCompilerLink + , ", tgtAr = " ++ show tgtAr + , ", tgtRanlib = " ++ show tgtRanlib + , ", tgtNm = " ++ show tgtNm + , ", tgtMergeObjs = " ++ show tgtMergeObjs + , ", tgtDllwrap = " ++ show tgtDllwrap + , ", tgtWindres = " ++ show tgtDllwrap + , "}" + ] -- | The word size as an integer representing the number of bytes wordSize2Bytes :: WordSize -> Int ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs ===================================== @@ -17,7 +17,19 @@ data Ar = Ar { arMkArchive :: Program , arSupportsDashL :: Bool , arNeedsRanlib :: Bool } - deriving (Show, Read, Eq, Ord) + deriving (Read, Eq, Ord) + +-- These instances are more suitable for diffing +instance Show Ar where + show Ar{..} = unlines + [ "Ar" + , "{ arMkArchive = " ++ show arMkArchive + , ", arIsGnu = " ++ show arIsGnu + , ", arSupportsAtFile = " ++ show arSupportsAtFile + , ", arSupportsDashL = " ++ show arSupportsDashL + , ", arNeedsRanlib = " ++ show arNeedsRanlib + , "}" + ] findAr :: ProgOpt -> M Ar findAr progOpt = checking "for 'ar'" $ do ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -1,5 +1,6 @@ {-# OPTIONS_GHC -Wno-name-shadowing #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE CPP #-} module GHC.Toolchain.Tools.Link ( CcLink(..), findCcLink ) where @@ -24,7 +25,20 @@ data CcLink = CcLink { ccLinkProgram :: Program , ccLinkSupportsResponseFiles :: Bool , ccLinkIsGnu :: Bool -- We once thought this could instead be LdSupportsGcSections, but then realized it couldn't IIRC } - deriving (Show, Read, Eq, Ord) + deriving (Read, Eq, Ord) + +-- These instances are more suitable for diffing +instance Show CcLink where + show CcLink{..} = unlines + [ "CcLink" + , "{ ccLinkProgram = " ++ show ccLinkProgram + , ", ccLinkSupportsNoPie = " ++ show ccLinkSupportsNoPie + , ", ccLinkSupportsCompactUnwind = " ++ show ccLinkSupportsCompactUnwind + , ", ccLinkSupportsFilelist = " ++ show ccLinkSupportsFilelist + , ", ccLinkSupportsResponseFiles = " ++ show ccLinkSupportsResponseFiles + , ", ccLinkIsGnu = " ++ show ccLinkIsGnu + , "}" + ] findCcLink :: ProgOpt -> Maybe Bool -> ArchOS -> Cc -> Maybe Readelf -> M CcLink findCcLink progOpt ldOverride archOs cc readelf = checking "for C compiler for linking command" $ do @@ -95,12 +109,13 @@ checkSupportsNoPie ccLink = checking "whether the cc linker supports -no-pie" $ -- Check output as some GCC versions only warn and don't respect -Werror -- when passed an unrecognized flag. (code, out, _err) <- readProgram ccLink ["-no-pie", "-Werror", "-x", "c", test_c, "-o", test] - if isSuccess code && "unrecognized" `isInfixOf` out - then return False - else return True + return (isSuccess code && not ("unrecognized" `isInfixOf` out)) checkSupportsCompactUnwind :: Cc -> Program -> M Bool checkSupportsCompactUnwind cc ccLink = checking "whether the cc linker understands -no_compact_unwind" $ + -- ROMES:TODO: This returns False here but True in configure because in + -- configure we check for ld supports compact unwind, whereas here we check + -- for cclink supports compact unwind... what do we need it for? withTempDir $ \dir -> do let test_o = dir "test.o" test2_o = dir "test2.o" @@ -108,7 +123,7 @@ checkSupportsCompactUnwind cc ccLink = checking "whether the cc linker understan compileC cc test_o "int foo() { return 0; }" exitCode <- runProgram ccLink ["-r", "-no_compact_unwind", "-o", test2_o, test_o] - pure $ isSuccess exitCode + return $ isSuccess exitCode checkSupportsFilelist :: Cc -> Program -> M Bool checkSupportsFilelist cc ccLink = checking "whether the cc linker understands -filelist" $ @@ -121,15 +136,17 @@ checkSupportsFilelist cc ccLink = checking "whether the cc linker understands -f compileC cc test1_o "int foo() { return 0; }" compileC cc test2_o "int bar() { return 0; }" - writeFile test_ofiles test1_o -- write the filename test1_o to the test_ofiles file - appendFile test_ofiles test2_o -- append the filename test2_o to the test_ofiles file + -- write the filenames test1_o and test2_o to the test_ofiles file + writeFile test_ofiles (unlines [test1_o,test2_o]) exitCode <- runProgram ccLink ["-r", "-filelist", test_ofiles, "-o", test_o] - pure $ isSuccess exitCode + return (isSuccess exitCode) checkSupportsResponseFiles :: Cc -> Program -> M Bool checkSupportsResponseFiles cc ccLink = checking "whether the cc linker supports response files" $ + -- ROMES:TODO: This returns True here while False in configure because in + -- configure we call -shared and -dylib on LD, whereas here we do it on CcLink withTempDir $ \dir -> do let test_o = dir "test.o" compileC cc test_o "int main(void) {return 0;}" @@ -141,7 +158,7 @@ checkSupportsResponseFiles cc ccLink = checking "whether the cc linker supports -- TODO: It'd be good to shortcircuit this logical `or` exitCode1 <- runProgram ccLink ["-shared", "@"++args_txt] exitCode2 <- runProgram ccLink ["-dylib", "@"++args_txt] - pure (isSuccess exitCode1 || isSuccess exitCode2) + return (isSuccess exitCode1 || isSuccess exitCode2) -- | Check whether linking works. checkLinkWorks :: Cc -> Program -> M () View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/405d69091b4fc4b4555ef827250afc20862980aa...f7112721c57be029320623cc86a4699264cc8210 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/405d69091b4fc4b4555ef827250afc20862980aa...f7112721c57be029320623cc86a4699264cc8210 You're receiving 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 Jun 6 07:39:08 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 06 Jun 2023 03:39:08 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] fixup! configure: Create and validate toolchain target file Message-ID: <647ee29c9162d_1d329d49bf48a4475860@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 5465486a by Rodrigo Mesquita at 2023-06-06T08:38:41+01:00 fixup! configure: Create and validate toolchain target file - - - - - 1 changed file: - configure.ac Changes: ===================================== configure.ac ===================================== @@ -1182,8 +1182,6 @@ AC_CONFIG_FILES( default.target ]) -VALIDATE_GHC_TOOLCHAIN - dnl Create the VERSION file, satisfying #22322. printf "$ProjectVersion" > VERSION @@ -1282,3 +1280,6 @@ mk/build.mk.sample to mk/build.mk, and edit the settings in there. For more information on how to configure your GHC build, see https://gitlab.haskell.org/ghc/ghc/wikis/building "] + +VALIDATE_GHC_TOOLCHAIN + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5465486ac5e6d589d8f16a7c9052b38678d36098 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5465486ac5e6d589d8f16a7c9052b38678d36098 You're receiving 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 Jun 6 08:39:45 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 06 Jun 2023 04:39:45 -0400 Subject: [Git][ghc/ghc][wip/23305] 191 commits: Add structured error messages for GHC.Rename.Utils Message-ID: <647ef0d13d32a_1d329d3fbc395c485994@gitlab.mail> Matthew Pickering pushed to branch wip/23305 at Glasgow Haskell Compiler / GHC Commits: 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04: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. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04: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> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+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. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - e76c25ee by Matthew Pickering at 2023-06-06T09:38:33+01:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - a81f59d6 by Matthew Pickering at 2023-06-06T09:38:33+01:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 2e9613be by Matthew Pickering at 2023-06-06T09:39:28+01:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - 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/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1315c369203302fcba8f4f5966bf0d834b93b866...2e9613be905858c3389cfe986d6cf4d01082d856 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1315c369203302fcba8f4f5966bf0d834b93b866...2e9613be905858c3389cfe986d6cf4d01082d856 You're receiving 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 Jun 6 09:07:40 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 06 Jun 2023 05:07:40 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/romes/configure-qunused-args Message-ID: <647ef75c32cea_1d329d3d01d884490621@gitlab.mail> Rodrigo Mesquita pushed new branch wip/romes/configure-qunused-args at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/configure-qunused-args You're receiving 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 Jun 6 09:39:16 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 06 Jun 2023 05:39:16 -0400 Subject: [Git][ghc/ghc][wip/romes/configure-qunused-args] Configure -Qunused-arguments instead of hardcoding it Message-ID: <647efec42ef95_1d329d3fa0b4fc498388@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/configure-qunused-args at Glasgow Haskell Compiler / GHC Commits: 0f7a00cb by Rodrigo Mesquita at 2023-06-06T10:39:08+01:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. - - - - - 4 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - configure.ac - distrib/configure.ac.in - + m4/fp_cc_ignore_unused_args.m4 Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -292,11 +292,7 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do -- LLVM from version 3.0 onwards doesn't support the OS X system -- assembler, so we use clang as the assembler instead. (#5636) - let (as_prog, get_asm_info) = - ( applyAssemblerProg $ backendAssemblerProg (backend dflags) - , applyAssemblerInfoGetter $ backendAssemblerInfoGetter (backend dflags) - ) - asmInfo <- get_asm_info logger dflags platform + let as_prog = applyAssemblerProg $ backendAssemblerProg (backend dflags) let cmdline_include_paths = includePaths dflags let pic_c_flags = picCCOpts dflags @@ -330,9 +326,6 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do ++ [ GHC.SysTools.Option "-Wa,--no-type-check" | platformArch (targetPlatform dflags) == ArchWasm32] - ++ (if any (asmInfo ==) [Clang, AppleClang, AppleClang51] - then [GHC.SysTools.Option "-Qunused-arguments"] - else []) ++ [ GHC.SysTools.Option "-x" , if with_cpp then GHC.SysTools.Option "assembler-with-cpp" @@ -400,19 +393,6 @@ runForeignJsPhase pipe_env hsc_env _location input_fn = do return output_fn -applyAssemblerInfoGetter - :: DefunctionalizedAssemblerInfoGetter - -> Logger -> DynFlags -> Platform -> IO CompilerInfo -applyAssemblerInfoGetter StandardAssemblerInfoGetter logger dflags _platform = - getAssemblerInfo logger dflags -applyAssemblerInfoGetter JSAssemblerInfoGetter _ _ _ = - pure Emscripten -applyAssemblerInfoGetter DarwinClangAssemblerInfoGetter logger dflags platform = - if platformOS platform == OSDarwin then - pure Clang - else - getAssemblerInfo logger dflags - applyAssemblerProg :: DefunctionalizedAssemblerProg -> Logger -> DynFlags -> Platform -> [Option] -> IO () ===================================== configure.ac ===================================== @@ -663,6 +663,12 @@ FP_CC_SUPPORTS_TARGET([$CC_STAGE0], [CONF_CC_OPTS_STAGE0], [CONF_CXX_OPTS_STAGE0 FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINKER_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINKER_OPTS_STAGE2]) +dnl Pass -Qunused-arguments or otherwise GHC will have very noisy invocations of Clang +dnl TODO: Do we need -Qunused-arguments in CXX and GCC linker too? +FP_CC_IGNORE_UNUSED_ARGS([$CC_STAGE0], [CONF_CC_OPTS_STAGE0]) +FP_CC_IGNORE_UNUSED_ARGS([$CC], [CONF_CC_OPTS_STAGE1]) +FP_CC_IGNORE_UNUSED_ARGS([$CC], [CONF_CC_OPTS_STAGE2]) + # See rules/distdir-way-opts.mk for details. # Flags passed to the C compiler AC_SUBST(CONF_CC_OPTS_STAGE0) ===================================== distrib/configure.ac.in ===================================== @@ -223,6 +223,10 @@ dnl CONF_CC_OPTS_STAGE[12] accordingly. FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINK_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINK_OPTS_STAGE2]) +dnl Pass -Qunused-arguments or otherwise GHC will have very noisy invocations of Clang +FP_CC_IGNORE_UNUSED_ARGS([$CC], [CONF_CC_OPTS_STAGE1]) +FP_CC_IGNORE_UNUSED_ARGS([$CC], [CONF_CC_OPTS_STAGE2]) + dnl TargetWordSize for settings file AC_CHECK_SIZEOF(void *, 4) if test "x$ac_cv_sizeof_void_p" = "x0"; then ===================================== m4/fp_cc_ignore_unused_args.m4 ===================================== @@ -0,0 +1,31 @@ +# FP_CC_IGNORE_UNUSED_ARGS +# ------------------------ +# GHC tends to produce command-lines with unused arguments that elicit +# warnings from Clang. Clang offers the @-Qunused-arguments@ flag to silence +# these. See #11684. +# +# The primary effect of this is updating CONF_CC_OPTS_STAGE[12] to explicitly +# pass -Qunused-arguments to Clang, since otherwise Cc invocations by GHC will +# be very noisy +# +# $1 = CC +# $2 = CC_OPTS variable +AC_DEFUN([FP_CC_IGNORE_UNUSED_ARGS], +[ + AC_MSG_CHECKING([whether $1 supports -Qunused-arguments]) + echo 'int main() { return 0; }' > conftest.c + if $1 -Qunused-arguments -Werror conftest.c > /dev/null 2>&1 ; then + CONF_CC_SUPPORTS_TARGET=YES + AC_MSG_RESULT([yes]) + else + CONF_CC_SUPPORTS_TARGET=NO + AC_MSG_RESULT([no]) + fi + rm -f conftest.c conftest + + if test $CONF_CC_SUPPORTS_TARGET = YES ; then + $2="$$2 -Qunused-arguments" + fi +]) + + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0f7a00cbb1915dc9e4f7a7cf62a87b90c8837210 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0f7a00cbb1915dc9e4f7a7cf62a87b90c8837210 You're receiving 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 Jun 6 09:47:47 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Tue, 06 Jun 2023 05:47:47 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/js-posix-internals-ffi Message-ID: <647f00c331690_1d329d3d01d884500977@gitlab.mail> Josh Meredith pushed new branch wip/js-posix-internals-ffi at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/js-posix-internals-ffi You're receiving 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 Jun 6 11:22:22 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 06 Jun 2023 07:22:22 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/fix-ghcup-metadata-nightly Message-ID: <647f16eeaa34_1d329d3fdb4bbc515076@gitlab.mail> Matthew Pickering pushed new branch wip/fix-ghcup-metadata-nightly at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fix-ghcup-metadata-nightly You're receiving 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 Jun 6 11:44:39 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 06 Jun 2023 07:44:39 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 7 commits: Configure -Qunused-arguments instead of hardcoding it Message-ID: <647f1c273b139_1d329d3d01d8845192bc@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 80e74cd7 by Rodrigo Mesquita at 2023-06-06T09:54:17+01:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. - - - - - f189f4e2 by Rodrigo Mesquita at 2023-06-06T09:54:17+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b480f4ab1514ac0a4fc957db199d1a0279. Revert get_arm_isa deletion from 74f03f243d08aa910d39cdd9dadb976e9386283a As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X - - - - - bc6702b8 by Rodrigo Mesquita at 2023-06-06T09:54:17+01:00 configure: Revert ripping out of toolchain selection logic - - - - - 95248ec4 by Rodrigo Mesquita at 2023-06-06T09:54:17+01:00 Stop configuring into settings unused Ld command - - - - - ea444e0b by Rodrigo Mesquita at 2023-06-06T09:54:17+01:00 configure: Create and validate toolchain target file - - - - - e1048e1c by Rodrigo Mesquita at 2023-06-06T12:44:04+01:00 Fixes for ghc-toolchain to match configure output - - - - - 86b48e5e by Rodrigo Mesquita at 2023-06-06T12:44:27+01:00 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now - - - - - 30 changed files: - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/SysTools.hs - compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - + default.target.in - distrib/configure.ac.in - ghc/Main.hs - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Builders/Cabal.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5465486ac5e6d589d8f16a7c9052b38678d36098...86b48e5e2e5c06d2ff69e113c5bc7cd0ee92b06a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5465486ac5e6d589d8f16a7c9052b38678d36098...86b48e5e2e5c06d2ff69e113c5bc7cd0ee92b06a You're receiving 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 Jun 6 12:26:55 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 06 Jun 2023 08:26:55 -0400 Subject: [Git][ghc/ghc][wip/romes/configure-qunused-args] Configure -Qunused-arguments instead of hardcoding it Message-ID: <647f260f31be0_1d329d3d01d88452787d@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/configure-qunused-args at Glasgow Haskell Compiler / GHC Commits: 74bd70e4 by Rodrigo Mesquita at 2023-06-06T13:26:09+01:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 4 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - configure.ac - distrib/configure.ac.in - + m4/fp_cc_ignore_unused_args.m4 Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -292,11 +292,7 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do -- LLVM from version 3.0 onwards doesn't support the OS X system -- assembler, so we use clang as the assembler instead. (#5636) - let (as_prog, get_asm_info) = - ( applyAssemblerProg $ backendAssemblerProg (backend dflags) - , applyAssemblerInfoGetter $ backendAssemblerInfoGetter (backend dflags) - ) - asmInfo <- get_asm_info logger dflags platform + let as_prog = applyAssemblerProg $ backendAssemblerProg (backend dflags) let cmdline_include_paths = includePaths dflags let pic_c_flags = picCCOpts dflags @@ -330,9 +326,6 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do ++ [ GHC.SysTools.Option "-Wa,--no-type-check" | platformArch (targetPlatform dflags) == ArchWasm32] - ++ (if any (asmInfo ==) [Clang, AppleClang, AppleClang51] - then [GHC.SysTools.Option "-Qunused-arguments"] - else []) ++ [ GHC.SysTools.Option "-x" , if with_cpp then GHC.SysTools.Option "assembler-with-cpp" @@ -400,19 +393,6 @@ runForeignJsPhase pipe_env hsc_env _location input_fn = do return output_fn -applyAssemblerInfoGetter - :: DefunctionalizedAssemblerInfoGetter - -> Logger -> DynFlags -> Platform -> IO CompilerInfo -applyAssemblerInfoGetter StandardAssemblerInfoGetter logger dflags _platform = - getAssemblerInfo logger dflags -applyAssemblerInfoGetter JSAssemblerInfoGetter _ _ _ = - pure Emscripten -applyAssemblerInfoGetter DarwinClangAssemblerInfoGetter logger dflags platform = - if platformOS platform == OSDarwin then - pure Clang - else - getAssemblerInfo logger dflags - applyAssemblerProg :: DefunctionalizedAssemblerProg -> Logger -> DynFlags -> Platform -> [Option] -> IO () ===================================== configure.ac ===================================== @@ -663,6 +663,12 @@ FP_CC_SUPPORTS_TARGET([$CC_STAGE0], [CONF_CC_OPTS_STAGE0], [CONF_CXX_OPTS_STAGE0 FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINKER_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINKER_OPTS_STAGE2]) +dnl Pass -Qunused-arguments or otherwise GHC will have very noisy invocations of Clang +dnl TODO: Do we need -Qunused-arguments in CXX and GCC linker too? +FP_CC_IGNORE_UNUSED_ARGS([$CC_STAGE0], [CONF_CC_OPTS_STAGE0]) +FP_CC_IGNORE_UNUSED_ARGS([$CC], [CONF_CC_OPTS_STAGE1]) +FP_CC_IGNORE_UNUSED_ARGS([$CC], [CONF_CC_OPTS_STAGE2]) + # See rules/distdir-way-opts.mk for details. # Flags passed to the C compiler AC_SUBST(CONF_CC_OPTS_STAGE0) ===================================== distrib/configure.ac.in ===================================== @@ -223,6 +223,10 @@ dnl CONF_CC_OPTS_STAGE[12] accordingly. FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINK_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINK_OPTS_STAGE2]) +dnl Pass -Qunused-arguments or otherwise GHC will have very noisy invocations of Clang +FP_CC_IGNORE_UNUSED_ARGS([$CC], [CONF_CC_OPTS_STAGE1]) +FP_CC_IGNORE_UNUSED_ARGS([$CC], [CONF_CC_OPTS_STAGE2]) + dnl TargetWordSize for settings file AC_CHECK_SIZEOF(void *, 4) if test "x$ac_cv_sizeof_void_p" = "x0"; then ===================================== m4/fp_cc_ignore_unused_args.m4 ===================================== @@ -0,0 +1,31 @@ +# FP_CC_IGNORE_UNUSED_ARGS +# ------------------------ +# GHC tends to produce command-lines with unused arguments that elicit +# warnings from Clang. Clang offers the @-Qunused-arguments@ flag to silence +# these. See #11684. +# +# The primary effect of this is updating CONF_CC_OPTS_STAGE[12] to explicitly +# pass -Qunused-arguments to Clang, since otherwise Cc invocations by GHC will +# be very noisy +# +# $1 = CC +# $2 = CC_OPTS variable +AC_DEFUN([FP_CC_IGNORE_UNUSED_ARGS], +[ + AC_MSG_CHECKING([whether $1 supports -Qunused-arguments]) + echo 'int main() { return 0; }' > conftest.c + if $1 -Qunused-arguments -Werror conftest.c > /dev/null 2>&1 ; then + CONF_CC_SUPPORTS_TARGET=YES + AC_MSG_RESULT([yes]) + else + CONF_CC_SUPPORTS_TARGET=NO + AC_MSG_RESULT([no]) + fi + rm -f conftest.c conftest + + if test $CONF_CC_SUPPORTS_TARGET = YES ; then + $2="$$2 -Qunused-arguments" + fi +]) + + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/74bd70e4ed564f9192030a78d8207941acc2e108 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/74bd70e4ed564f9192030a78d8207941acc2e108 You're receiving 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 Jun 6 12:28:00 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 06 Jun 2023 08:28:00 -0400 Subject: [Git][ghc/ghc][wip/romes/configure-qunused-args] Configure -Qunused-arguments instead of hardcoding it Message-ID: <647f26506c7e_1d329d43d90808528374@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/configure-qunused-args at Glasgow Haskell Compiler / GHC Commits: f29cd0c1 by Rodrigo Mesquita at 2023-06-06T13:27:10+01:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 4 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - configure.ac - distrib/configure.ac.in - + m4/fp_cc_ignore_unused_args.m4 Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -292,11 +292,7 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do -- LLVM from version 3.0 onwards doesn't support the OS X system -- assembler, so we use clang as the assembler instead. (#5636) - let (as_prog, get_asm_info) = - ( applyAssemblerProg $ backendAssemblerProg (backend dflags) - , applyAssemblerInfoGetter $ backendAssemblerInfoGetter (backend dflags) - ) - asmInfo <- get_asm_info logger dflags platform + let as_prog = applyAssemblerProg $ backendAssemblerProg (backend dflags) let cmdline_include_paths = includePaths dflags let pic_c_flags = picCCOpts dflags @@ -330,9 +326,6 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do ++ [ GHC.SysTools.Option "-Wa,--no-type-check" | platformArch (targetPlatform dflags) == ArchWasm32] - ++ (if any (asmInfo ==) [Clang, AppleClang, AppleClang51] - then [GHC.SysTools.Option "-Qunused-arguments"] - else []) ++ [ GHC.SysTools.Option "-x" , if with_cpp then GHC.SysTools.Option "assembler-with-cpp" @@ -400,19 +393,6 @@ runForeignJsPhase pipe_env hsc_env _location input_fn = do return output_fn -applyAssemblerInfoGetter - :: DefunctionalizedAssemblerInfoGetter - -> Logger -> DynFlags -> Platform -> IO CompilerInfo -applyAssemblerInfoGetter StandardAssemblerInfoGetter logger dflags _platform = - getAssemblerInfo logger dflags -applyAssemblerInfoGetter JSAssemblerInfoGetter _ _ _ = - pure Emscripten -applyAssemblerInfoGetter DarwinClangAssemblerInfoGetter logger dflags platform = - if platformOS platform == OSDarwin then - pure Clang - else - getAssemblerInfo logger dflags - applyAssemblerProg :: DefunctionalizedAssemblerProg -> Logger -> DynFlags -> Platform -> [Option] -> IO () ===================================== configure.ac ===================================== @@ -663,6 +663,12 @@ FP_CC_SUPPORTS_TARGET([$CC_STAGE0], [CONF_CC_OPTS_STAGE0], [CONF_CXX_OPTS_STAGE0 FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINKER_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINKER_OPTS_STAGE2]) +dnl Pass -Qunused-arguments or otherwise GHC will have very noisy invocations of Clang +dnl TODO: Do we need -Qunused-arguments in CXX and GCC linker too? +FP_CC_IGNORE_UNUSED_ARGS([$CC_STAGE0], [CONF_CC_OPTS_STAGE0]) +FP_CC_IGNORE_UNUSED_ARGS([$CC], [CONF_CC_OPTS_STAGE1]) +FP_CC_IGNORE_UNUSED_ARGS([$CC], [CONF_CC_OPTS_STAGE2]) + # See rules/distdir-way-opts.mk for details. # Flags passed to the C compiler AC_SUBST(CONF_CC_OPTS_STAGE0) ===================================== distrib/configure.ac.in ===================================== @@ -223,6 +223,10 @@ dnl CONF_CC_OPTS_STAGE[12] accordingly. FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINK_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINK_OPTS_STAGE2]) +dnl Pass -Qunused-arguments or otherwise GHC will have very noisy invocations of Clang +FP_CC_IGNORE_UNUSED_ARGS([$CC], [CONF_CC_OPTS_STAGE1]) +FP_CC_IGNORE_UNUSED_ARGS([$CC], [CONF_CC_OPTS_STAGE2]) + dnl TargetWordSize for settings file AC_CHECK_SIZEOF(void *, 4) if test "x$ac_cv_sizeof_void_p" = "x0"; then ===================================== m4/fp_cc_ignore_unused_args.m4 ===================================== @@ -0,0 +1,31 @@ +# FP_CC_IGNORE_UNUSED_ARGS +# ------------------------ +# GHC tends to produce command-lines with unused arguments that elicit +# warnings from Clang. Clang offers the @-Qunused-arguments@ flag to silence +# these. See #11684. +# +# The primary effect of this is updating CONF_CC_OPTS_STAGE[12] to explicitly +# pass -Qunused-arguments to Clang, since otherwise Cc invocations by GHC will +# be very noisy +# +# $1 = CC +# $2 = CC_OPTS variable +AC_DEFUN([FP_CC_IGNORE_UNUSED_ARGS], +[ + AC_MSG_CHECKING([whether $1 supports -Qunused-arguments]) + echo 'int main() { return 0; }' > conftest.c + if $1 -Qunused-arguments -Werror conftest.c > /dev/null 2>&1 ; then + CONF_CC_SUPPORTS_TARGET=YES + AC_MSG_RESULT([yes]) + else + CONF_CC_SUPPORTS_TARGET=NO + AC_MSG_RESULT([no]) + fi + rm -f conftest.c conftest + + if test $CONF_CC_SUPPORTS_TARGET = YES ; then + $2="$$2 -Qunused-arguments" + fi +]) + + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f29cd0c1d58b80c9b9895222d17e05c081d3f7a5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f29cd0c1d58b80c9b9895222d17e05c081d3f7a5 You're receiving 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 Jun 6 14:09:33 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 06 Jun 2023 10:09:33 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: TTG: only allow VarBind at GhcTc Message-ID: <647f3e1d818f1_1d329d3fdb4bbc58601c@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 7e291b50 by Matthew Craven at 2023-06-06T10:09:18-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ede1f236 by Matthew Pickering at 2023-06-06T10:09:18-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 11 changed files: - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Tc/Gen/Bind.hs - hadrian/src/Rules/Generate.hs - rts/gen_event_types.py Changes: ===================================== .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py ===================================== @@ -264,7 +264,7 @@ def setNightlyTags(ghcup_metadata): for version in ghcup_metadata['ghcupDownloads']['GHC']: if "LatestNightly" in ghcup_metadata['ghcupDownloads']['GHC'][version]["viTags"]: ghcup_metadata['ghcupDownloads']['GHC'][version]["viTags"].remove("LatestNightly") - ghcup_metadata['ghcupDownloads']['GHC'][version]["viTags"].append("Nightly") + ghcup_metadata['ghcupDownloads']['GHC'][version]["viTags"].append("Nightly") ===================================== compiler/GHC/Builtin/bytearray-ops.txt.pp deleted ===================================== @@ -1,551 +0,0 @@ - ------------------------------------- --- ByteArray# operations ------------------------------------- - - --- Do not edit. This file is generated by utils/genprimopcode/gen_bytearray_ops.py. --- To regenerate run, --- --- python3 utils/genprimops/gen_bytearray_ops.py > compiler/GHC/Builtin/bytearray-ops.txt.pp - - ------------------------------------- --- aligned index operations ------------------------------------- - -primop IndexByteArrayOp_Char "indexCharArray#" GenPrimOp - ByteArray# -> Int# -> Char# - {Read a 8-bit character; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_WideChar "indexWideCharArray#" GenPrimOp - ByteArray# -> Int# -> Char# - {Read a 32-bit character; offset in 4-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Int "indexIntArray#" GenPrimOp - ByteArray# -> Int# -> Int# - {Read a word-sized integer; offset in machine words.} - with can_fail = True - -primop IndexByteArrayOp_Word "indexWordArray#" GenPrimOp - ByteArray# -> Int# -> Word# - {Read a word-sized unsigned integer; offset in machine words.} - with can_fail = True - -primop IndexByteArrayOp_Addr "indexAddrArray#" GenPrimOp - ByteArray# -> Int# -> Addr# - {Read a machine address; offset in machine words.} - with can_fail = True - -primop IndexByteArrayOp_Float "indexFloatArray#" GenPrimOp - ByteArray# -> Int# -> Float# - {Read a single-precision floating-point value; offset in 4-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Double "indexDoubleArray#" GenPrimOp - ByteArray# -> Int# -> Double# - {Read a double-precision floating-point value; offset in 8-byte words.} - with can_fail = True - -primop IndexByteArrayOp_StablePtr "indexStablePtrArray#" GenPrimOp - ByteArray# -> Int# -> StablePtr# a - {Read a 'StablePtr#' value; offset in machine words.} - with can_fail = True - -primop IndexByteArrayOp_Int8 "indexInt8Array#" GenPrimOp - ByteArray# -> Int# -> Int8# - {Read a 8-bit signed integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Int16 "indexInt16Array#" GenPrimOp - ByteArray# -> Int# -> Int16# - {Read a 16-bit signed integer; offset in 2-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Int32 "indexInt32Array#" GenPrimOp - ByteArray# -> Int# -> Int32# - {Read a 32-bit signed integer; offset in 4-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Int64 "indexInt64Array#" GenPrimOp - ByteArray# -> Int# -> Int64# - {Read a 64-bit signed integer; offset in 8-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Word8 "indexWord8Array#" GenPrimOp - ByteArray# -> Int# -> Word8# - {Read a 8-bit unsigned integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word16 "indexWord16Array#" GenPrimOp - ByteArray# -> Int# -> Word16# - {Read a 16-bit unsigned integer; offset in 2-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Word32 "indexWord32Array#" GenPrimOp - ByteArray# -> Int# -> Word32# - {Read a 32-bit unsigned integer; offset in 4-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Word64 "indexWord64Array#" GenPrimOp - ByteArray# -> Int# -> Word64# - {Read a 64-bit unsigned integer; offset in 8-byte words.} - with can_fail = True - - ------------------------------------- --- unaligned index operations ------------------------------------- - -primop IndexByteArrayOp_Word8AsChar "indexWord8ArrayAsChar#" GenPrimOp - ByteArray# -> Int# -> Char# - {Read a 8-bit character; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsWideChar "indexWord8ArrayAsWideChar#" GenPrimOp - ByteArray# -> Int# -> Char# - {Read a 32-bit character; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsInt "indexWord8ArrayAsInt#" GenPrimOp - ByteArray# -> Int# -> Int# - {Read a word-sized integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsWord "indexWord8ArrayAsWord#" GenPrimOp - ByteArray# -> Int# -> Word# - {Read a word-sized unsigned integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsAddr "indexWord8ArrayAsAddr#" GenPrimOp - ByteArray# -> Int# -> Addr# - {Read a machine address; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsFloat "indexWord8ArrayAsFloat#" GenPrimOp - ByteArray# -> Int# -> Float# - {Read a single-precision floating-point value; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsDouble "indexWord8ArrayAsDouble#" GenPrimOp - ByteArray# -> Int# -> Double# - {Read a double-precision floating-point value; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsStablePtr "indexWord8ArrayAsStablePtr#" GenPrimOp - ByteArray# -> Int# -> StablePtr# a - {Read a 'StablePtr#' value; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsInt16 "indexWord8ArrayAsInt16#" GenPrimOp - ByteArray# -> Int# -> Int16# - {Read a 16-bit signed integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsInt32 "indexWord8ArrayAsInt32#" GenPrimOp - ByteArray# -> Int# -> Int32# - {Read a 32-bit signed integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsInt64 "indexWord8ArrayAsInt64#" GenPrimOp - ByteArray# -> Int# -> Int64# - {Read a 64-bit signed integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsWord16 "indexWord8ArrayAsWord16#" GenPrimOp - ByteArray# -> Int# -> Word16# - {Read a 16-bit unsigned integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsWord32 "indexWord8ArrayAsWord32#" GenPrimOp - ByteArray# -> Int# -> Word32# - {Read a 32-bit unsigned integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsWord64 "indexWord8ArrayAsWord64#" GenPrimOp - ByteArray# -> Int# -> Word64# - {Read a 64-bit unsigned integer; offset in bytes.} - with can_fail = True - - ------------------------------------- --- aligned read operations ------------------------------------- - -primop ReadByteArrayOp_Char "readCharArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) - {Read a 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_WideChar "readWideCharArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) - {Read a 32-bit character; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int "readIntArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #) - {Read a word-sized integer; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word "readWordArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #) - {Read a word-sized unsigned integer; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Addr "readAddrArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Addr# #) - {Read a machine address; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Float "readFloatArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Float# #) - {Read a single-precision floating-point value; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Double "readDoubleArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Double# #) - {Read a double-precision floating-point value; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_StablePtr "readStablePtrArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, StablePtr# a #) - {Read a 'StablePtr#' value; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int8 "readInt8Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int8# #) - {Read a 8-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int16 "readInt16Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int16# #) - {Read a 16-bit signed integer; offset in 2-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int32 "readInt32Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int32# #) - {Read a 32-bit signed integer; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int64 "readInt64Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int64# #) - {Read a 64-bit signed integer; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8 "readWord8Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word8# #) - {Read a 8-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word16 "readWord16Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word16# #) - {Read a 16-bit unsigned integer; offset in 2-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word32 "readWord32Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word32# #) - {Read a 32-bit unsigned integer; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word64 "readWord64Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word64# #) - {Read a 64-bit unsigned integer; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - - ------------------------------------- --- unaligned read operations ------------------------------------- - -primop ReadByteArrayOp_Word8AsChar "readWord8ArrayAsChar#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) - {Read a 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsWideChar "readWord8ArrayAsWideChar#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) - {Read a 32-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsInt "readWord8ArrayAsInt#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #) - {Read a word-sized integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsWord "readWord8ArrayAsWord#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #) - {Read a word-sized unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsAddr "readWord8ArrayAsAddr#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Addr# #) - {Read a machine address; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsFloat "readWord8ArrayAsFloat#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Float# #) - {Read a single-precision floating-point value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsDouble "readWord8ArrayAsDouble#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Double# #) - {Read a double-precision floating-point value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsStablePtr "readWord8ArrayAsStablePtr#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, StablePtr# a #) - {Read a 'StablePtr#' value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsInt16 "readWord8ArrayAsInt16#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int16# #) - {Read a 16-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsInt32 "readWord8ArrayAsInt32#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int32# #) - {Read a 32-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsInt64 "readWord8ArrayAsInt64#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int64# #) - {Read a 64-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsWord16 "readWord8ArrayAsWord16#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word16# #) - {Read a 16-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsWord32 "readWord8ArrayAsWord32#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word32# #) - {Read a 32-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsWord64 "readWord8ArrayAsWord64#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word64# #) - {Read a 64-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - - ------------------------------------- --- aligned write operations ------------------------------------- - -primop WriteByteArrayOp_Char "writeCharArray#" GenPrimOp - MutableByteArray# s -> Int# -> Char# -> State# s -> State# s - {Write a 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_WideChar "writeWideCharArray#" GenPrimOp - MutableByteArray# s -> Int# -> Char# -> State# s -> State# s - {Write a 32-bit character; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int "writeIntArray#" GenPrimOp - MutableByteArray# s -> Int# -> Int# -> State# s -> State# s - {Write a word-sized integer; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word "writeWordArray#" GenPrimOp - MutableByteArray# s -> Int# -> Word# -> State# s -> State# s - {Write a word-sized unsigned integer; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Addr "writeAddrArray#" GenPrimOp - MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s - {Write a machine address; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Float "writeFloatArray#" GenPrimOp - MutableByteArray# s -> Int# -> Float# -> State# s -> State# s - {Write a single-precision floating-point value; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Double "writeDoubleArray#" GenPrimOp - MutableByteArray# s -> Int# -> Double# -> State# s -> State# s - {Write a double-precision floating-point value; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_StablePtr "writeStablePtrArray#" GenPrimOp - MutableByteArray# s -> Int# -> StablePtr# a -> State# s -> State# s - {Write a 'StablePtr#' value; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int8 "writeInt8Array#" GenPrimOp - MutableByteArray# s -> Int# -> Int8# -> State# s -> State# s - {Write a 8-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int16 "writeInt16Array#" GenPrimOp - MutableByteArray# s -> Int# -> Int16# -> State# s -> State# s - {Write a 16-bit signed integer; offset in 2-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int32 "writeInt32Array#" GenPrimOp - MutableByteArray# s -> Int# -> Int32# -> State# s -> State# s - {Write a 32-bit signed integer; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int64 "writeInt64Array#" GenPrimOp - MutableByteArray# s -> Int# -> Int64# -> State# s -> State# s - {Write a 64-bit signed integer; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8 "writeWord8Array#" GenPrimOp - MutableByteArray# s -> Int# -> Word8# -> State# s -> State# s - {Write a 8-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word16 "writeWord16Array#" GenPrimOp - MutableByteArray# s -> Int# -> Word16# -> State# s -> State# s - {Write a 16-bit unsigned integer; offset in 2-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word32 "writeWord32Array#" GenPrimOp - MutableByteArray# s -> Int# -> Word32# -> State# s -> State# s - {Write a 32-bit unsigned integer; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word64 "writeWord64Array#" GenPrimOp - MutableByteArray# s -> Int# -> Word64# -> State# s -> State# s - {Write a 64-bit unsigned integer; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - - ------------------------------------- --- unaligned write operations ------------------------------------- - -primop WriteByteArrayOp_Word8AsChar "writeWord8ArrayAsChar#" GenPrimOp - MutableByteArray# s -> Int# -> Char# -> State# s -> State# s - {Write a 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsWideChar "writeWord8ArrayAsWideChar#" GenPrimOp - MutableByteArray# s -> Int# -> Char# -> State# s -> State# s - {Write a 32-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsInt "writeWord8ArrayAsInt#" GenPrimOp - MutableByteArray# s -> Int# -> Int# -> State# s -> State# s - {Write a word-sized integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsWord "writeWord8ArrayAsWord#" GenPrimOp - MutableByteArray# s -> Int# -> Word# -> State# s -> State# s - {Write a word-sized unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsAddr "writeWord8ArrayAsAddr#" GenPrimOp - MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s - {Write a machine address; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsFloat "writeWord8ArrayAsFloat#" GenPrimOp - MutableByteArray# s -> Int# -> Float# -> State# s -> State# s - {Write a single-precision floating-point value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsDouble "writeWord8ArrayAsDouble#" GenPrimOp - MutableByteArray# s -> Int# -> Double# -> State# s -> State# s - {Write a double-precision floating-point value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsStablePtr "writeWord8ArrayAsStablePtr#" GenPrimOp - MutableByteArray# s -> Int# -> StablePtr# a -> State# s -> State# s - {Write a 'StablePtr#' value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsInt16 "writeWord8ArrayAsInt16#" GenPrimOp - MutableByteArray# s -> Int# -> Int16# -> State# s -> State# s - {Write a 16-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsInt32 "writeWord8ArrayAsInt32#" GenPrimOp - MutableByteArray# s -> Int# -> Int32# -> State# s -> State# s - {Write a 32-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsInt64 "writeWord8ArrayAsInt64#" GenPrimOp - MutableByteArray# s -> Int# -> Int64# -> State# s -> State# s - {Write a 64-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsWord16 "writeWord8ArrayAsWord16#" GenPrimOp - MutableByteArray# s -> Int# -> Word16# -> State# s -> State# s - {Write a 16-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsWord32 "writeWord8ArrayAsWord32#" GenPrimOp - MutableByteArray# s -> Int# -> Word32# -> State# s -> State# s - {Write a 32-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsWord64 "writeWord8ArrayAsWord64#" GenPrimOp - MutableByteArray# s -> Int# -> Word64# -> State# s -> State# s - {Write a 64-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - ===================================== utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py ===================================== @@ -1,8 +1,32 @@ #!/usr/bin/env python # -*- coding: utf-8 -*- +# This script generates the primop descriptions for many similar ByteArray# +# and Addr# access operations. Its output is #include-d into primops.txt.pp. + from typing import Optional, NamedTuple import textwrap +import argparse + +arg_parser = argparse.ArgumentParser() +arg_parser.add_argument('addr_or_bytearray', + choices = ["addr-access-ops", "bytearray-access-ops"], + ) +arg_parser.add_argument('output_file', + type=argparse.FileType('w'), + metavar='FILE', + ) +args = arg_parser.parse_args() +write = args.output_file.write + + + +write(''' +-- Do not edit. +-- This file is generated by compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py. +-- (The build system should take care of this for you.) + +''') class ElementType(NamedTuple): name: str @@ -28,26 +52,13 @@ element_types = [ ElementType("StablePtr", "StablePtr# a", "'StablePtr#' value", MACH_WORD), ] -# TODO: Eventually when the sized integer primops use proper unboxed types we -# should rather do: -# -#for n in [8,16,32,64]: -# element_types += [ ElementType(f"Int{n}", f"Int{n}#", f"{n}-bit signed integer", n // 8) ] -# -#for n in [8,16,32,64]: -# element_types += [ ElementType(f"Word{n}", f"Word{n}#", f"{n}-bit unsigned integer", n // 8) ] - -element_types += [ - ElementType("Int8", "Int8#", "8-bit signed integer", 1), - ElementType("Int16", "Int16#", "16-bit signed integer", 2), - ElementType("Int32", "Int32#", "32-bit signed integer", 4), - ElementType("Int64", "Int64#", "64-bit signed integer", 8), - - ElementType("Word8", "Word8#", "8-bit unsigned integer", 1), - ElementType("Word16", "Word16#", "16-bit unsigned integer", 2), - ElementType("Word32", "Word32#", "32-bit unsigned integer", 4), - ElementType("Word64", "Word64#", "64-bit unsigned integer", 8), -] +for n in [8,16,32,64]: + element_types += [ + ElementType(f"Int{n}", f"Int{n}#", + f"{n}-bit signed integer", n // 8), + ElementType(f"Word{n}", f"Word{n}#", + f"{n}-bit unsigned integer", n // 8) + ] def pretty_offset(n: Optional[int]) -> str: if n == MACH_WORD: @@ -57,87 +68,134 @@ def pretty_offset(n: Optional[int]) -> str: else: return f'{n}-byte words' +def get_align_warn(n: ElementType) -> str: + if n.width == 1: + return '' + return ''' + On some platforms, the access may fail + for an insufficiently aligned @Addr#@. + ''' + def print_block(template: str, **kwargs) -> None: - print(textwrap.dedent(template.format(**kwargs)).lstrip()) + write(textwrap.dedent(template.format(**kwargs)).lstrip()) + write('\n') def header(s: str): - print('') + write('\n') print_block(''' ------------------------------------ -- {s} ------------------------------------ ''', s=s) +if args.addr_or_bytearray == "bytearray-access-ops": + header("ByteArray# operations") -header("ByteArray# operations") - -print(''' --- Do not edit. This file is generated by utils/genprimopcode/gen_bytearray_ops.py. --- To regenerate run, --- --- python3 utils/genprimops/gen_bytearray_ops.py > compiler/GHC/Builtin/bytearray-ops.txt.pp -''') - -header('aligned index operations') -for t in element_types: - offset = pretty_offset(t.width) - print_block(''' + header('aligned index operations') + for t in element_types: + offset = pretty_offset(t.width) + print_block(''' primop IndexByteArrayOp_{name} "index{name}Array#" GenPrimOp ByteArray# -> Int# -> {rep_ty} {{Read a {desc}; offset in {offset}.}} with can_fail = True - ''', offset = offset, **t._asdict()) + ''', offset = offset, **t._asdict()) -header('unaligned index operations') -for t in element_types: - if t.name in ['Int8', 'Word8']: continue - print_block(''' + header('unaligned index operations') + for t in element_types: + if t.name in ['Int8', 'Word8']: continue + print_block(''' primop IndexByteArrayOp_Word8As{name} "indexWord8ArrayAs{name}#" GenPrimOp ByteArray# -> Int# -> {rep_ty} {{Read a {desc}; offset in bytes.}} with can_fail = True - ''', **t._asdict()) + ''', **t._asdict()) -header('aligned read operations') -for t in element_types: - offset = pretty_offset(t.width) - print_block(''' + header('aligned read operations') + for t in element_types: + offset = pretty_offset(t.width) + print_block(''' primop ReadByteArrayOp_{name} "read{name}Array#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> (# State# s, {rep_ty} #) {{Read a {desc}; offset in {offset}.}} with has_side_effects = True can_fail = True - ''', offset = offset, **t._asdict()) + ''', offset = offset, **t._asdict()) -header('unaligned read operations') -for t in element_types: - if t.name in ['Int8', 'Word8']: continue - print_block(''' + header('unaligned read operations') + for t in element_types: + if t.name in ['Int8', 'Word8']: continue + print_block(''' primop ReadByteArrayOp_Word8As{name} "readWord8ArrayAs{name}#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> (# State# s, {rep_ty} #) {{Read a {desc}; offset in bytes.}} with has_side_effects = True can_fail = True - ''', **t._asdict()) + ''', **t._asdict()) -header('aligned write operations') -for t in element_types: - offset = pretty_offset(t.width) - print_block(''' + header('aligned write operations') + for t in element_types: + offset = pretty_offset(t.width) + print_block(''' primop WriteByteArrayOp_{name} "write{name}Array#" GenPrimOp MutableByteArray# s -> Int# -> {rep_ty} -> State# s -> State# s {{Write a {desc}; offset in {offset}.}} with has_side_effects = True can_fail = True - ''', offset = offset, **t._asdict()) + ''', offset = offset, **t._asdict()) -header('unaligned write operations') -for t in element_types: - if t.name in ['Int8', 'Word8']: continue - print_block(''' + header('unaligned write operations') + for t in element_types: + if t.name in ['Int8', 'Word8']: continue + print_block(''' primop WriteByteArrayOp_Word8As{name} "writeWord8ArrayAs{name}#" GenPrimOp MutableByteArray# s -> Int# -> {rep_ty} -> State# s -> State# s {{Write a {desc}; offset in bytes.}} with has_side_effects = True can_fail = True - ''', **t._asdict()) + ''', **t._asdict()) + + +else: # addr_or_bytearray == "addr-access-ops": + header("Addr# access operations") + + header('aligned index operations') + for t in element_types: + offset = pretty_offset(t.width) + align_warn = get_align_warn(t) + print_block(''' + primop IndexOffAddrOp_{name} "index{name}OffAddr#" GenPrimOp + Addr# -> Int# -> {rep_ty} + {{ Read a {desc}; offset in {offset}. + {align_warn} + }} + with can_fail = True + ''', offset = offset, align_warn = align_warn, **t._asdict()) + + header('aligned read operations') + for t in element_types: + offset = pretty_offset(t.width) + align_warn = get_align_warn(t) + print_block(''' + primop ReadOffAddrOp_{name} "read{name}OffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, {rep_ty} #) + {{ Read a {desc}; offset in {offset}. + {align_warn} + }} + with has_side_effects = True + can_fail = True + ''', offset = offset, align_warn = align_warn, **t._asdict()) + + header('aligned write operations') + for t in element_types: + offset = pretty_offset(t.width) + align_warn = get_align_warn(t) + print_block(''' + primop WriteOffAddrOp_{name} "write{name}OffAddr#" GenPrimOp + Addr# -> Int# -> {rep_ty} -> State# s -> State# s + {{ Write a {desc}; offset in {offset}. + {align_warn} + }} + with has_side_effects = True + can_fail = True + ''', offset = offset, align_warn = align_warn, **t._asdict()) ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -1941,7 +1941,7 @@ primop GetSizeofMutableByteArrayOp "getSizeofMutableByteArray#" GenPrimOp @since 0.5.0.0} -#include "bytearray-ops.txt.pp" +#include "bytearray-access-ops.txt.pp" primop CompareByteArraysOp "compareByteArrays#" GenPrimOp ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int# @@ -2242,233 +2242,7 @@ primop AddrNeOp "neAddr#" Compare Addr# -> Addr# -> Int# primop AddrLtOp "ltAddr#" Compare Addr# -> Addr# -> Int# primop AddrLeOp "leAddr#" Compare Addr# -> Addr# -> Int# -primop IndexOffAddrOp_Char "indexCharOffAddr#" GenPrimOp - Addr# -> Int# -> Char# - {Reads 8-bit character; offset in bytes.} - with can_fail = True - -primop IndexOffAddrOp_WideChar "indexWideCharOffAddr#" GenPrimOp - Addr# -> Int# -> Char# - {Reads 31-bit character; offset in 4-byte words.} - with can_fail = True - -primop IndexOffAddrOp_Int "indexIntOffAddr#" GenPrimOp - Addr# -> Int# -> Int# - with can_fail = True - -primop IndexOffAddrOp_Word "indexWordOffAddr#" GenPrimOp - Addr# -> Int# -> Word# - with can_fail = True - -primop IndexOffAddrOp_Addr "indexAddrOffAddr#" GenPrimOp - Addr# -> Int# -> Addr# - with can_fail = True - -primop IndexOffAddrOp_Float "indexFloatOffAddr#" GenPrimOp - Addr# -> Int# -> Float# - with can_fail = True - -primop IndexOffAddrOp_Double "indexDoubleOffAddr#" GenPrimOp - Addr# -> Int# -> Double# - with can_fail = True - -primop IndexOffAddrOp_StablePtr "indexStablePtrOffAddr#" GenPrimOp - Addr# -> Int# -> StablePtr# a - with can_fail = True - -primop IndexOffAddrOp_Int8 "indexInt8OffAddr#" GenPrimOp - Addr# -> Int# -> Int8# - with can_fail = True - -primop IndexOffAddrOp_Int16 "indexInt16OffAddr#" GenPrimOp - Addr# -> Int# -> Int16# - with can_fail = True - -primop IndexOffAddrOp_Int32 "indexInt32OffAddr#" GenPrimOp - Addr# -> Int# -> Int32# - with can_fail = True - -primop IndexOffAddrOp_Int64 "indexInt64OffAddr#" GenPrimOp - Addr# -> Int# -> Int64# - with can_fail = True - -primop IndexOffAddrOp_Word8 "indexWord8OffAddr#" GenPrimOp - Addr# -> Int# -> Word8# - with can_fail = True - -primop IndexOffAddrOp_Word16 "indexWord16OffAddr#" GenPrimOp - Addr# -> Int# -> Word16# - with can_fail = True - -primop IndexOffAddrOp_Word32 "indexWord32OffAddr#" GenPrimOp - Addr# -> Int# -> Word32# - with can_fail = True - -primop IndexOffAddrOp_Word64 "indexWord64OffAddr#" GenPrimOp - Addr# -> Int# -> Word64# - with can_fail = True - -primop ReadOffAddrOp_Char "readCharOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Char# #) - {Reads 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_WideChar "readWideCharOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Char# #) - {Reads 31-bit character; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int "readIntOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word "readWordOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Addr "readAddrOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Addr# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Float "readFloatOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Float# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Double "readDoubleOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Double# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_StablePtr "readStablePtrOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, StablePtr# a #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int8 "readInt8OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int8# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int16 "readInt16OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int16# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int32 "readInt32OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int32# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int64 "readInt64OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int64# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word8 "readWord8OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word8# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word16 "readWord16OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word16# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word32 "readWord32OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word32# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word64 "readWord64OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word64# #) - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Char "writeCharOffAddr#" GenPrimOp - Addr# -> Int# -> Char# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_WideChar "writeWideCharOffAddr#" GenPrimOp - Addr# -> Int# -> Char# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int "writeIntOffAddr#" GenPrimOp - Addr# -> Int# -> Int# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word "writeWordOffAddr#" GenPrimOp - Addr# -> Int# -> Word# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Addr "writeAddrOffAddr#" GenPrimOp - Addr# -> Int# -> Addr# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Float "writeFloatOffAddr#" GenPrimOp - Addr# -> Int# -> Float# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Double "writeDoubleOffAddr#" GenPrimOp - Addr# -> Int# -> Double# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_StablePtr "writeStablePtrOffAddr#" GenPrimOp - Addr# -> Int# -> StablePtr# a -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int8 "writeInt8OffAddr#" GenPrimOp - Addr# -> Int# -> Int8# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int16 "writeInt16OffAddr#" GenPrimOp - Addr# -> Int# -> Int16# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int32 "writeInt32OffAddr#" GenPrimOp - Addr# -> Int# -> Int32# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int64 "writeInt64OffAddr#" GenPrimOp - Addr# -> Int# -> Int64# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word8 "writeWord8OffAddr#" GenPrimOp - Addr# -> Int# -> Word8# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word16 "writeWord16OffAddr#" GenPrimOp - Addr# -> Int# -> Word16# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word32 "writeWord32OffAddr#" GenPrimOp - Addr# -> Int# -> Word32# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word64 "writeWord64OffAddr#" GenPrimOp - Addr# -> Int# -> Word64# -> State# s -> State# s - with has_side_effects = True - can_fail = True +#include "addr-access-ops.txt.pp" primop InterlockedExchange_Addr "atomicExchangeAddrAddr#" GenPrimOp Addr# -> Addr# -> State# s -> (# State# s, Addr# #) ===================================== compiler/GHC/Hs/Binds.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} @@ -120,7 +121,11 @@ type instance XPatBind GhcTc (GhcPass pR) = , ( [CoreTickish] -- Ticks to put on the rhs, if any , [[CoreTickish]] ) ) -- and ticks to put on the bound variables. -type instance XVarBind (GhcPass pL) (GhcPass pR) = NoExtField +type instance XVarBind (GhcPass pL) (GhcPass pR) = XVarBindGhc pL pR +type family XVarBindGhc pL pR where + XVarBindGhc 'Typechecked 'Typechecked = NoExtField + XVarBindGhc _ _ = DataConCantHappen + type instance XPatSynBind (GhcPass pL) (GhcPass pR) = NoExtField type instance XXHsBindsLR GhcPs pR = DataConCantHappen ===================================== compiler/GHC/Hs/Utils.hs ===================================== @@ -819,7 +819,7 @@ mkTopFunBind origin fn ms = FunBind { fun_id = fn mkHsVarBind :: SrcSpan -> RdrName -> LHsExpr GhcPs -> LHsBind GhcPs mkHsVarBind loc var rhs = mkSimpleGeneratedFunBind loc var [] rhs -mkVarBind :: IdP (GhcPass p) -> LHsExpr (GhcPass p) -> LHsBind (GhcPass p) +mkVarBind :: IdP GhcTc -> LHsExpr GhcTc -> LHsBind GhcTc mkVarBind var rhs = L (getLoc rhs) $ VarBind { var_ext = noExtField, var_id = var, var_rhs = rhs } ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -1931,15 +1931,6 @@ rep_bind (L loc (PatBind { pat_lhs = pat ; ans' <- wrapGenSyms ss ans ; return (locA loc, ans') } -rep_bind (L _ (VarBind { var_id = v, var_rhs = e})) - = do { v' <- lookupBinder v - ; e2 <- repLE e - ; x <- repNormal e2 - ; patcore <- repPvar v' - ; empty_decls <- coreListM decTyConName [] - ; ans <- repVal patcore x empty_decls - ; return (srcLocSpan (getSrcLoc v), ans) } - rep_bind (L loc (PatSynBind _ (PSB { psb_id = syn , psb_args = args , psb_def = pat @@ -1978,6 +1969,8 @@ rep_bind (L loc (PatSynBind _ (PSB { psb_id = syn wrapGenArgSyms (RecCon _) _ dec = return dec wrapGenArgSyms _ ss dec = wrapGenSyms ss dec +rep_bind (L _ (VarBind { var_ext = x })) = dataConCantHappen x + repPatSynD :: Core TH.Name -> Core (M TH.PatSynArgs) -> Core (M TH.PatSynDir) ===================================== compiler/GHC/Rename/Bind.hs ===================================== @@ -542,7 +542,7 @@ rnBind sig_fn (PatSynBind x bind) = do { (bind', name, fvs) <- rnPatSynBind sig_fn bind ; return (PatSynBind x bind', name, fvs) } -rnBind _ b@(VarBind {}) = pprPanic "rnBind" (ppr b) +rnBind _ (VarBind { var_ext = x }) = dataConCantHappen x -- See Note [Pattern bindings that bind no variables] isOkNoBindPattern :: LPat GhcRn -> Bool ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -780,11 +780,12 @@ checkMonomorphismRestriction mbis lbinds no_mr_name _ = Nothing -- The Haskell 98 monomorphism restriction + restricted :: HsBindLR GhcRn GhcRn -> Bool restricted (PatBind {}) = True - restricted (VarBind { var_id = v }) = mr_needed_for v restricted (FunBind { fun_id = v, fun_matches = m }) = restricted_match m && mr_needed_for (unLoc v) - restricted b = pprPanic "isRestrictedGroup/unrestricted" (ppr b) + restricted (VarBind { var_ext = x }) = dataConCantHappen x + restricted b@(PatSynBind {}) = pprPanic "isRestrictedGroup/unrestricted" (ppr b) restricted_match mg = matchGroupArity mg == 0 -- No args => like a pattern binding @@ -1518,8 +1519,10 @@ tcLhs sig_fn no_gen (PatBind { pat_lhs = pat, pat_rhs = grhss }) Just (TcIdSig sig) -> Right (name, sig) _ -> Left name -tcLhs _ _ other_bind = pprPanic "tcLhs" (ppr other_bind) - -- AbsBind, VarBind impossible +tcLhs _ _ b@(PatSynBind {}) = pprPanic "tcLhs: PatSynBind" (ppr b) + -- pattern synonyms are handled separately; see tc_single + +tcLhs _ _ (VarBind { var_ext = x }) = dataConCantHappen x lookupMBI :: Name -> TcM MonoBindInfo -- After typechecking the pattern, look up the binder ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -32,6 +32,17 @@ primopsSource = "compiler/GHC/Builtin/primops.txt.pp" primopsTxt :: Stage -> FilePath primopsTxt stage = buildDir (vanillaContext stage compiler) -/- "primops.txt" +accessOpsSource :: FilePath +accessOpsSource = "compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py" + +byteArrayAccessOpsTxt :: Stage -> FilePath +byteArrayAccessOpsTxt stage + = buildDir (vanillaContext stage compiler) -/- "bytearray-access-ops.txt.pp" + +addrAccessOpsTxt :: Stage -> FilePath +addrAccessOpsTxt stage + = buildDir (vanillaContext stage compiler) -/- "addr-access-ops.txt.pp" + isGeneratedCmmFile :: FilePath -> Bool isGeneratedCmmFile file = takeBaseName file == "AutoApply" @@ -142,8 +153,21 @@ generatePackageCode context@(Context stage pkg _ _) = do root -/- "**" -/- dir -/- "GHC/Platform/Host.hs" %> go generatePlatformHostHs when (pkg == compiler) $ do + let ba_ops_txt = root -/- byteArrayAccessOpsTxt stage + let addr_ops_txt = root -/- addrAccessOpsTxt stage + ba_ops_txt %> \file -> do + need [accessOpsSource] + runBuilder Python + [accessOpsSource, "bytearray-access-ops", file] + [] [] + addr_ops_txt %> \file -> do + need [accessOpsSource] + runBuilder Python + [accessOpsSource, "addr-access-ops", file] + [] [] root -/- primopsTxt stage %> \file -> do - need $ [primopsSource] + need $ [primopsSource, ba_ops_txt, addr_ops_txt] + -- ba_ops_txt and addr_ops_txt get #include-d build $ target context HsCpp [primopsSource] [file] when (pkg == rts) $ do ===================================== rts/gen_event_types.py ===================================== @@ -157,7 +157,7 @@ def generate_event_types_array() -> str: pr = lambda s: x.append(s) pr('/*') - pr(' * Do not edit: This file is generated by event_types.py') + pr(' * Do not edit: This file is generated by gen_event_types.py') pr(' */') pr('') pr('EventType eventTypes[] = {') @@ -184,7 +184,7 @@ def generate_event_types_defines() -> str: pr = lambda s: x.append(s) pr('/*') - pr(' * Do not edit: This file is generated by event_types.py') + pr(' * Do not edit: This file is generated by gen_event_types.py') pr(' */') pr('') pr('#pragma once') View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/080d54a5b14d788d53bc98d5905e090489e78686...ede1f236c63e4d5c5c1c8c03b52c37656584fa90 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/080d54a5b14d788d53bc98d5905e090489e78686...ede1f236c63e4d5c5c1c8c03b52c37656584fa90 You're receiving 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 Jun 6 15:03:40 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Tue, 06 Jun 2023 11:03:40 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/core-lint-let Message-ID: <647f4acc64e7a_1d329d55a73ce460319c@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/core-lint-let at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/core-lint-let You're receiving 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 Jun 6 15:29:06 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 06 Jun 2023 11:29:06 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 3 commits: configure: Create and validate toolchain target file Message-ID: <647f50c29a2f6_1d329d5004d2b0615741@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: a3642797 by Rodrigo Mesquita at 2023-06-06T16:25:44+01:00 configure: Create and validate toolchain target file - - - - - 0a83e43d by Rodrigo Mesquita at 2023-06-06T16:27:04+01:00 Fixes for ghc-toolchain to match configure output - - - - - e398306c by Rodrigo Mesquita at 2023-06-06T16:27:46+01:00 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now - - - - - 17 changed files: - configure.ac - + default.target.in - distrib/configure.ac.in - m4/find_merge_objects.m4 - m4/fp_prog_ar_needs_ranlib.m4 - m4/ghc_toolchain.m4 - + m4/prep_target_file.m4 - utils/ghc-toolchain/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/ParseTriple.hs - utils/ghc-toolchain/src/GHC/Toolchain/PlatformDetails.hs - utils/ghc-toolchain/src/GHC/Toolchain/Program.hs - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cxx.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs Changes: ===================================== configure.ac ===================================== @@ -644,7 +644,6 @@ dnl CONF_CC_OPTS_STAGE[012] accordingly. FP_CC_SUPPORTS_TARGET([$CC_STAGE0], [CONF_CC_OPTS_STAGE0], [CONF_CXX_OPTS_STAGE0], [CONF_GCC_LINKER_OPTS_STAGE0]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINKER_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINKER_OPTS_STAGE2]) -FIND_GHC_TOOLCHAIN dnl Pass -Qunused-arguments or otherwise GHC will have very noisy invocations of Clang dnl TODO: Do we need -Qunused-arguments in CXX and GCC linker too? @@ -1174,6 +1173,10 @@ checkMake380() { checkMake380 make checkMake380 gmake +# Toolchain target files +PREP_TARGET_FILE +FIND_GHC_TOOLCHAIN + AC_CONFIG_FILES( [ mk/project.mk hadrian/cfg/system.config @@ -1182,6 +1185,7 @@ AC_CONFIG_FILES( hadrian/ghci-stack docs/users_guide/ghc_config.py distrib/configure.ac + default.target ]) dnl Create the VERSION file, satisfying #22322. @@ -1282,3 +1286,6 @@ mk/build.mk.sample to mk/build.mk, and edit the settings in there. For more information on how to configure your GHC build, see https://gitlab.haskell.org/ghc/ghc/wikis/building "] + +VALIDATE_GHC_TOOLCHAIN + ===================================== default.target.in ===================================== @@ -0,0 +1,39 @@ +Target +{ tgtArchOs = ArchOS {archOS_arch = @HaskellHostArch@, archOS_OS = @HaskellHostOs@} +, tgtSupportsGnuNonexecStack = @TargetHasGnuNonexecStackBool@ +, tgtSupportsSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbolsBool@ +, tgtSupportsIdentDirective = @TargetHasIdentDirectiveBool@ +, tgtWordSize = WS at TargetWordSize@ +, tgtEndianness = @TargetEndianness@ +, tgtSymbolsHaveLeadingUnderscore = @LeadingUnderscoreBool@ +, tgtLlvmTarget = "@LlvmTarget@" +, tgtUnregisterised = @UnregisterisedBool@ +, tgtTablesNextToCode = @TablesNextToCodeBool@ +, tgtUseLibffiForAdjustors = @UseLibffiForAdjustorsBool@ +, tgtCCompiler = Cc {ccProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @SettingsCCompilerFlagsList@}} +, tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@SettingsCxxCompilerCommand@", prgFlags = @SettingsCxxCompilerFlagsList@}} +, tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@CPPCmd@", prgFlags = @CONF_CPP_OPTS_STAGE1List@}} +, tgtHsCPreprocessor = HsCpp {hsCppProgram = Program {prgPath = "@HaskellCPPCmd@", prgFlags = @HaskellCPPArgsList@}} +, tgtCCompilerLink = CcLink +{ ccLinkProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @SettingsCCompilerLinkFlagsList@} +, ccLinkSupportsNoPie = @SettingsCCompilerSupportsNoPieBool@ +, ccLinkSupportsCompactUnwind = @LdHasNoCompactUnwindBool@ +, ccLinkSupportsFilelist = @LdHasFilelistBool@ +, ccLinkSupportsResponseFiles = @LdSupportsResponseFilesBool@ +, ccLinkIsGnu = @LdIsGNULdBool@ +} + +, tgtAr = Ar +{ arMkArchive = Program {prgPath = "@AR@", prgFlags = @ArArgsList@} +, arIsGnu = @ArIsGNUArBool@ +, arSupportsAtFile = @ArSupportsAtFileBool@ +, arSupportsDashL = @ArSupportsDashLBool@ +, arNeedsRanlib = @ArNeedsRanLibBool@ +} + +, tgtRanlib = Just (Ranlib {ranlibProgram = Program {prgPath = "@REAL_RANLIB_CMD@", prgFlags = []}}) +, tgtNm = Nm {nmProgram = Program {prgPath = "@NmCmd@", prgFlags = []}} +, tgtMergeObjs = Just (MergeObjs {mergeObjsProgram = Program {prgPath = "@SettingsMergeObjectsCommand@", prgFlags = @SettingsMergeObjectsFlagsList@}}) +, tgtDllwrap = Nothing +, tgtWindres = Nothing +} ===================================== distrib/configure.ac.in ===================================== @@ -307,6 +307,11 @@ checkMake380() { checkMake380 make checkMake380 gmake +# Toolchain target files +PREP_TARGET_FILE +FIND_GHC_TOOLCHAIN +VALIDATE_GHC_TOOLCHAIN + echo "****************************************************" echo "Configuration done, ready to 'make install'" echo "(see README and INSTALL files for more info.)" ===================================== m4/find_merge_objects.m4 ===================================== @@ -7,7 +7,7 @@ AC_DEFUN([FIND_MERGE_OBJECTS],[ AC_REQUIRE([FIND_LD]) if test -z "$MergeObjsCmd"; then - MergeObjsCmd="$LD" + MergeObjsCmd="$(which $LD)" fi if test -z "$MergeObjsArgs"; then MergeObjsArgs="-r" ===================================== m4/fp_prog_ar_needs_ranlib.m4 ===================================== @@ -46,4 +46,5 @@ AC_DEFUN([FP_PROG_AR_NEEDS_RANLIB],[ fi AC_SUBST([REAL_RANLIB_CMD]) AC_SUBST([RANLIB_CMD]) + AC_SUBST([ArNeedsRanLib],[`echo $fp_cv_prog_ar_needs_ranlib | tr 'a-z' 'A-Z'`]) ])# FP_PROG_AR_NEEDS_RANLIB ===================================== m4/ghc_toolchain.m4 ===================================== @@ -28,30 +28,33 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], utils/ghc-toolchain/Main.hs -o acghc-toolchain rm -f acargs - echo "--triple=$target" >> acargs - echo "--cc=$CC" >> acargs - ADD_GHC_TOOLCHAIN_ARG([cc-opt], [$CONF_CC_OPTS_STAGE1]) + dnl TODO: LLVMTarget vs Target, which should go where? + dnl echo "--triple=$target" >> acargs + dnl For now, LlvmTarget matches the configure output. + echo "--triple=$LlvmTarget" >> acargs + # echo "--cc=$CC" >> acargs + # ADD_GHC_TOOLCHAIN_ARG([cc-opt], [$CONF_CC_OPTS_STAGE1]) - # CPP flags - echo "--cpp=$CPPCmd" >> acargs - ADD_GHC_TOOLCHAIN_ARG([cpp-opt], [$CONF_CPP_OPTS_STAGE1]) + # # CPP flags + # echo "--cpp=$CPPCmd" >> acargs + # ADD_GHC_TOOLCHAIN_ARG([cpp-opt], [$CONF_CPP_OPTS_STAGE1]) - # HS CPP flags - echo "--hs-cpp=$HaskellCPPCmd" >> acargs - ADD_GHC_TOOLCHAIN_ARG([hs-cpp-opt], [$HaskellCPPArgs]) + # # HS CPP flags + # echo "--hs-cpp=$HaskellCPPCmd" >> acargs + # ADD_GHC_TOOLCHAIN_ARG([hs-cpp-opt], [$HaskellCPPArgs]) - echo "--cc-link=$CC" >> acargs - ADD_GHC_TOOLCHAIN_ARG([cc-link-opt], [$CONF_GCC_LINK_OPTS_STAGE1]) - echo "--cxx=$CXX" >> acargs - ADD_GHC_TOOLCHAIN_ARG([cxx-opt], [$CONF_CXX_OPTS_STAGE1]) - echo "--ar=$AR" >> acargs - ADD_GHC_TOOLCHAIN_ARG([ar-opt], [$ARFLAGS]) - echo "--ranlib=$RANLIB" >> acargs - ADD_GHC_TOOLCHAIN_ARG([ranlib-opt], [$RANLIBFLAGS]) - echo "--nm=$NM" >> acargs - ADD_GHC_TOOLCHAIN_ARG([nm-opt], [$NMFLAGS]) - echo "--readelf=$READELF" >> acargs - ADD_GHC_TOOLCHAIN_ARG([readelf-opt], [$READELFFLAGS]) + # echo "--cc-link=$CC" >> acargs + # ADD_GHC_TOOLCHAIN_ARG([cc-link-opt], [$CONF_GCC_LINK_OPTS_STAGE1]) + # echo "--cxx=$CXX" >> acargs + # ADD_GHC_TOOLCHAIN_ARG([cxx-opt], [$CONF_CXX_OPTS_STAGE1]) + # echo "--ar=$AR" >> acargs + # ADD_GHC_TOOLCHAIN_ARG([ar-opt], [$ARFLAGS]) + # echo "--ranlib=$RANLIB" >> acargs + # ADD_GHC_TOOLCHAIN_ARG([ranlib-opt], [$RANLIBFLAGS]) + # echo "--nm=$NM" >> acargs + # ADD_GHC_TOOLCHAIN_ARG([nm-opt], [$NMFLAGS]) + # echo "--readelf=$READELF" >> acargs + # ADD_GHC_TOOLCHAIN_ARG([readelf-opt], [$READELFFLAGS]) ENABLE_GHC_TOOLCHAIN_ARG([unregisterised], [$Unregisterised]) ENABLE_GHC_TOOLCHAIN_ARG([tables-next-to-code], [$TablesNextToCode]) @@ -66,8 +69,19 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], ) &1` + if test -z "$diff_output"; then + true + else + AC_MSG_WARN([Differences found between $A and $B: $diff_output]) + fi +]) ===================================== m4/prep_target_file.m4 ===================================== @@ -0,0 +1,89 @@ +# PREP_BOOLEAN +# ============ +# +# Issue a substitution with True/False of [$1Bool] when $1 has YES/NO value +# $1 = boolean variable to substitute +AC_DEFUN([PREP_BOOLEAN],[ + case "$$1" in + YES) + $1Bool=True + ;; + NO) + $1Bool=False + ;; + *) + AC_MSG_ERROR([Expecting YES/NO but got $$1 in $1]) + ;; + esac + AC_SUBST([$1Bool]) +]) + +# PREP_LIST +# ============ +# +# Issue a substitution with ["list","of","args"] of [$1List] when $1 is a +# space-separated list of args +# $1 = list variable to substitute +dnl In autoconf, '@<:@' stands for '[', and '@:>@' for ']'. +AC_DEFUN([PREP_LIST],[ + # shell array + set -- $$1 + $1List="@<:@" + if test "[$]#" -eq 0; then + # no arguments + true + else + $1List="${$1List}\"[$]1\"" + shift # drop first elem + for arg in "[$]@" + do + $1List="${$1List},\"$arg\"" + done + fi + $1List="${$1List}@:>@" + + AC_SUBST([$1List]) +]) + +# Eventually: PREP_BUILD_TARGET_FILE, PREP_HOST_TARGET_FILE, PREP_TARGET_TARGET_FILE +# Prepares required substitutions to generate the target file +AC_DEFUN([PREP_TARGET_FILE],[ + PREP_BOOLEAN([LdSupportsResponseFiles]) + PREP_BOOLEAN([TargetHasGnuNonexecStack]) + PREP_BOOLEAN([LeadingUnderscore]) + PREP_BOOLEAN([ArSupportsAtFile]) + PREP_BOOLEAN([ArSupportsDashL]) + PREP_BOOLEAN([TargetHasIdentDirective]) + PREP_BOOLEAN([SettingsCCompilerSupportsNoPie]) + PREP_BOOLEAN([LdHasFilelist]) + PREP_BOOLEAN([LdIsGNULd]) + PREP_BOOLEAN([LdHasNoCompactUnwind]) + PREP_BOOLEAN([TargetHasSubsectionsViaSymbols]) + PREP_BOOLEAN([Unregisterised]) + PREP_BOOLEAN([TablesNextToCode]) + PREP_BOOLEAN([UseLibffiForAdjustors]) + PREP_BOOLEAN([ArIsGNUAr]) + PREP_BOOLEAN([ArNeedsRanLib]) + PREP_LIST([SettingsMergeObjectsFlags]) + PREP_LIST([ArArgs]) + PREP_LIST([SettingsCCompilerLinkFlags]) + PREP_LIST([HaskellCPPArgs]) + PREP_LIST([CONF_CPP_OPTS_STAGE1]) + PREP_LIST([SettingsCxxCompilerFlags]) + PREP_LIST([SettingsCCompilerFlags]) + dnl PREP_ENDIANNESS + case "$TargetWordBigEndian" in + YES) + TargetEndianness=BigEndian + ;; + NO) + TargetEndianness=LittleEndian + ;; + *) + AC_MSG_ERROR([Expecting YES/NO but got $TargetWordBigEndian in TargetWordBigEndian]) + ;; + esac + AC_SUBST([TargetEndianness]) +]) + +AC_DEFUN() ===================================== utils/ghc-toolchain/Main.hs ===================================== @@ -160,9 +160,11 @@ options = -- Empty list of flags is as if it was unspecified updatePoFlags "" existingOpts = existingOpts - -- Otherwise append specified flags to existing flags or make new + -- Otherwise prepend specified flags to existing flags or make new updatePoFlags newOpts Nothing = Just [newOpts] - updatePoFlags newOpts (Just eopts) = Just (eopts ++ [newOpts]) + updatePoFlags newOpts (Just eopts) = Just (newOpts:eopts) + -- NB: By prepending, the resulting flags will match the left-to-right + -- order they were passed in enableDisable :: String -> String -> Lens Opts (Maybe Bool) -> [OptDescr (Opts -> Opts)] @@ -216,7 +218,9 @@ run :: Opts -> M () run opts = do tgt <- mkTarget opts logDebug $ "Final Target: " ++ show tgt - writeFile "default.target" (show tgt) + let file = "default.ghc-toolchain.target" + writeFile file (show tgt) + appendFile file "\n" -- eol optional :: M a -> M (Maybe a) optional k = fmap Just k <|> pure Nothing @@ -295,18 +299,21 @@ mkTarget :: Opts -> M Target mkTarget opts = do let tgtLlvmTarget = optTriple opts cc0 <- findCc tgtLlvmTarget (optCc opts) - cxx <- findCxx (optCxx opts) + cxx <- findCxx tgtLlvmTarget (optCxx opts) cpp <- findCpp (optCpp opts) cc0 hsCpp <- findHsCpp (optHsCpp opts) cc0 - archOs <- parseTriple cc0 (optTriple opts) + (archOs, vendorName) <- parseTriple cc0 (optTriple opts) cc <- addPlatformDepCcFlags archOs cc0 readelf <- optional $ findReadelf (optReadelf opts) - ccLink <- findCcLink (optCcLink opts) (optLdOverride opts) archOs cc readelf + ccLink <- findCcLink tgtLlvmTarget (optCcLink opts) (optLdOverride opts) archOs cc readelf - ar <- findAr (optAr opts) - ranlib <- if arNeedsRanlib ar - then Just <$> findRanlib (optRanlib opts) - else return Nothing + ar <- findAr vendorName (optAr opts) + -- TODO: We could have + -- ranlib <- if arNeedsRanlib ar + -- then Just <$> findRanlib (optRanlib opts) + -- else return Nothing + -- but in order to match the configure output, for now we do + ranlib <- Just <$> findRanlib (optRanlib opts) nm <- findNm (optNm opts) mergeObjs <- optional $ findMergeObjs (optMergeObjs opts) cc ccLink nm @@ -327,7 +334,7 @@ mkTarget opts = do tgtWordSize <- checkWordSize cc tgtEndianness <- checkEndianness cc tgtSymbolsHaveLeadingUnderscore <- checkLeadingUnderscore cc nm - tgtSupportsSubsectionsViaSymbols <- checkSubsectionsViaSymbols cc + tgtSupportsSubsectionsViaSymbols <- checkSubsectionsViaSymbols archOs cc tgtSupportsIdentDirective <- checkIdentDirective cc tgtSupportsGnuNonexecStack <- checkGnuNonexecStack archOs cc @@ -338,7 +345,7 @@ mkTarget opts = do tgtUseLibffi <- determineUseLibFFIForAdjustors archOs (optUseLibFFIForAdjustors opts) when tgtUnregisterised $ do -- The via-C code generator requires these - let prog = "int main(int argc, char** argv) { return 0; }I" + let prog = "int main(int argc, char** argv) { return 0; }" via_c_args = ["-fwrapv", "-fno-builtin"] forM_ via_c_args $ \arg -> checking ("support of "++arg) $ withTempDir $ \dir -> do let cc' = over (_ccProgram % _prgFlags) (++ [arg]) cc ===================================== utils/ghc-toolchain/src/GHC/Toolchain/ParseTriple.hs ===================================== @@ -8,17 +8,18 @@ import GHC.Toolchain.Prelude import GHC.Toolchain.CheckArm import GHC.Toolchain.Tools.Cc -parseTriple :: Cc -> String -> M ArchOS +-- | Parse a triple `arch-vendor-os` into an 'ArchOS' and a vendor name 'String' +parseTriple :: Cc -> String -> M (ArchOS, String) parseTriple cc triple | [archName, vendorName, osName] <- parts = do arch <- parseArch cc archName os <- parseOs vendorName osName - return $ ArchOS arch os + return $ (ArchOS arch os, vendorName) | [archName, vendorName, osName, _abi] <- parts = do arch <- parseArch cc archName os <- parseOs vendorName osName - return $ ArchOS arch os + return $ (ArchOS arch os, vendorName) | otherwise = throwE $ "malformed triple " ++ triple @@ -37,6 +38,7 @@ parseArch cc arch = "s390x" -> pure ArchS390X "arm" -> findArmIsa cc _ | "armv" `isPrefixOf` arch -> findArmIsa cc + "arm64" -> pure ArchAArch64 -- TODO Should we support this alias or does this cause confusion? "aarch64" -> pure ArchAArch64 "alpha" -> pure ArchAlpha "mips" -> pure ArchMipseb ===================================== utils/ghc-toolchain/src/GHC/Toolchain/PlatformDetails.hs ===================================== @@ -102,11 +102,17 @@ checkLeadingUnderscore cc nm = checking ctxt $ withTempDir $ \dir -> do prog = "int func(void) { return 0; }" ctxt = "whether symbols have leading underscores" -checkSubsectionsViaSymbols :: Cc -> M Bool -checkSubsectionsViaSymbols = - testCompile - "whether .subsections-via-symbols directive is supported" - (asmStmt ".subsections_via_symbols") +checkSubsectionsViaSymbols :: ArchOS -> Cc -> M Bool +checkSubsectionsViaSymbols archos cc = + case archOS_arch archos of + ArchAArch64 -> + -- subsections via symbols is busted on arm64 + -- TODO: ^ is this comment up to date? + return False + _ -> + testCompile + "whether .subsections-via-symbols directive is supported" + (asmStmt ".subsections_via_symbols") cc checkIdentDirective :: Cc -> M Bool checkIdentDirective = ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Program.hs ===================================== @@ -13,12 +13,16 @@ module GHC.Toolchain.Program , _poPath , _poFlags , findProgram + -- * Compiler programs + , compile + , supportsTarget ) where import Control.Monad import Control.Monad.IO.Class -import Data.List (intercalate) +import Data.List (intercalate, isPrefixOf) import Data.Maybe +import System.FilePath import System.Directory import System.Exit import System.Process hiding (env) @@ -129,3 +133,39 @@ findProgram description userSpec candidates case r of Nothing -> throwE $ name ++ " not found in search path" Just x -> return x + +-------------------- Compiling utilities -------------------- + +-- | Compile a program with a given compiler. +-- +-- The compiler must +-- * Take the program path as a positional argument +-- * Accept -o to specify output path +compile + :: FilePath -- ^ input extension + -> [String] -- ^ extra flags + -> Lens compiler Program + -> compiler + -> FilePath -- ^ output path + -> String -- ^ source + -> M () +compile ext extraFlags lens c outPath program = do + let srcPath = outPath <.> ext + writeFile srcPath program + callProgram (view lens c) $ extraFlags ++ ["-o", outPath, srcPath] + expectFileExists outPath "compiler produced no output" + +-- Does compiler program support the --target= option? If so, we should +-- pass it whenever possible to avoid ambiguity and potential compile-time +-- errors (e.g. see #20162). +supportsTarget :: Lens compiler Program + -> (compiler -> M ()) -- ^ Action to check if compiler with --target flag works + -> String -- ^ The llvm target to use if Cc supports --target + -> compiler -- ^ The compiler to check --target support for + -> M compiler -- ^ Return compiler with --target flag if supported +supportsTarget lens checkWorks llvmTarget c + | any ("--target=" `isPrefixOf`) (view (lens % _prgFlags) c) = return c + | otherwise + = let c' = over (lens % _prgFlags) (("--target="++llvmTarget):) c + in (c' <$ checkWorks c') <|> return c + ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE RecordWildCards #-} module GHC.Toolchain.Target where import GHC.Platform.ArchOS @@ -60,7 +61,35 @@ data Target = Target , tgtDllwrap :: Maybe Program , tgtWindres :: Maybe Program } - deriving (Show, Read, Eq, Ord) + deriving (Read, Eq, Ord) + +instance Show Target where + show Target{..} = unlines + [ "Target" + , "{ tgtArchOs = " ++ show tgtArchOs + , ", tgtSupportsGnuNonexecStack = " ++ show tgtSupportsGnuNonexecStack + , ", tgtSupportsSubsectionsViaSymbols = " ++ show tgtSupportsSubsectionsViaSymbols + , ", tgtSupportsIdentDirective = " ++ show tgtSupportsIdentDirective + , ", tgtWordSize = " ++ show tgtWordSize + , ", tgtEndianness = " ++ show tgtEndianness + , ", tgtSymbolsHaveLeadingUnderscore = " ++ show tgtSymbolsHaveLeadingUnderscore + , ", tgtLlvmTarget = " ++ show tgtLlvmTarget + , ", tgtUnregisterised = " ++ show tgtUnregisterised + , ", tgtTablesNextToCode = " ++ show tgtTablesNextToCode + , ", tgtUseLibffiForAdjustors = " ++ show tgtUseLibffiForAdjustors + , ", tgtCCompiler = " ++ show tgtCCompiler + , ", tgtCxxCompiler = " ++ show tgtCxxCompiler + , ", tgtCPreprocessor = " ++ show tgtCPreprocessor + , ", tgtHsCPreprocessor = " ++ show tgtHsCPreprocessor + , ", tgtCCompilerLink = " ++ show tgtCCompilerLink + , ", tgtAr = " ++ show tgtAr + , ", tgtRanlib = " ++ show tgtRanlib + , ", tgtNm = " ++ show tgtNm + , ", tgtMergeObjs = " ++ show tgtMergeObjs + , ", tgtDllwrap = " ++ show tgtDllwrap + , ", tgtWindres = " ++ show tgtDllwrap + , "}" + ] -- | The word size as an integer representing the number of bytes wordSize2Bytes :: WordSize -> Int ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs ===================================== @@ -17,10 +17,23 @@ data Ar = Ar { arMkArchive :: Program , arSupportsDashL :: Bool , arNeedsRanlib :: Bool } - deriving (Show, Read, Eq, Ord) + deriving (Read, Eq, Ord) -findAr :: ProgOpt -> M Ar -findAr progOpt = checking "for 'ar'" $ do +-- These instances are more suitable for diffing +instance Show Ar where + show Ar{..} = unlines + [ "Ar" + , "{ arMkArchive = " ++ show arMkArchive + , ", arIsGnu = " ++ show arIsGnu + , ", arSupportsAtFile = " ++ show arSupportsAtFile + , ", arSupportsDashL = " ++ show arSupportsDashL + , ", arNeedsRanlib = " ++ show arNeedsRanlib + , "}" + ] + +findAr :: String -- ^ Vendor name from the target triple + -> ProgOpt -> M Ar +findAr vendor progOpt = checking "for 'ar'" $ do bareAr <- findProgram "ar archiver" progOpt ["ar"] arIsGnu <- ("GNU" `isInfixOf`) <$> readProgramStdout bareAr ["--version"] @@ -32,7 +45,10 @@ findAr progOpt = checking "for 'ar'" $ do arSupportsDashL <- checkArSupportsDashL bareAr <|> return False let arNeedsRanlib | arIsGnu = False - -- TODO: Autoconf handles Apple specifically here + -- TODO: It'd be better not to handle Apple specifically here? + -- It's quite tedious to check for Apple's crazy timestamps in + -- .a files, so we hardcode it. + | vendor == "apple" = True | mode:_ <- prgFlags mkArchive , 's' `elem` mode = False | otherwise = True ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs ===================================== @@ -31,9 +31,11 @@ _ccProgram = Lens ccProgram (\x o -> o{ccProgram=x}) findCc :: String -- ^ The llvm target to use if Cc supports --target -> ProgOpt -> M Cc findCc llvmTarget progOpt = checking "for C compiler" $ do - ccProgram <- findProgram "C compiler" progOpt ["cc", "clang", "gcc"] + -- TODO: We keep the candidate order we had in configure, but perhaps + -- there's a more optimal one + ccProgram <- findProgram "C compiler" progOpt ["gcc", "clang", "cc"] cc' <- ignoreUnusedArgs $ Cc {ccProgram} - cc <- supportsTarget llvmTarget cc' + cc <- ccSupportsTarget llvmTarget cc' checkCcWorks cc checkC99Support cc checkCcSupportsExtraViaCFlags cc @@ -54,18 +56,19 @@ checkCcWorks cc = withTempDir $ \dir -> do -- warnings from Clang. Clang offers the @-Qunused-arguments@ flag to silence -- these. See #11684. ignoreUnusedArgs :: Cc -> M Cc -ignoreUnusedArgs cc = checking "for -Qunused-arguments support" $ do - let cc' = over (_ccProgram % _prgFlags) (++["-Qunused-arguments"]) cc - (cc' <$ checkCcWorks cc') <|> return cc - --- Does CC support the --target= option? If so, we should pass it +ignoreUnusedArgs cc + | "-Qunused-arguments" `elem` (view (_ccProgram % _prgFlags) cc) = return cc + | otherwise + = checking "for -Qunused-arguments support" $ do + let cc' = over (_ccProgram % _prgFlags) (++["-Qunused-arguments"]) cc + (cc' <$ checkCcWorks cc') <|> return cc + +-- Does Cc support the --target= option? If so, we should pass it -- whenever possible to avoid ambiguity and potential compile-time errors (e.g. -- see #20162). -supportsTarget :: String -- ^ The llvm target to use if Cc supports --target - -> Cc -> M Cc -supportsTarget llvmTarget cc = checking "whether Cc supports --target" $ do - let cc' = over (_ccProgram % _prgFlags) (++["--target="++llvmTarget]) cc - (cc' <$ checkCcWorks cc') <|> return cc +ccSupportsTarget :: String -> Cc -> M Cc +ccSupportsTarget target cc = checking "whether Cc supports --target" $ + supportsTarget _ccProgram checkCcWorks target cc checkC99Support :: Cc -> M () checkC99Support cc = checking "for C99 support" $ withTempDir $ \dir -> do @@ -99,7 +102,7 @@ preprocess -> M String -- ^ preprocessed output preprocess cc prog = withTempDir $ \dir -> do let out = dir "test.c" - compile "c" ["-E"] cc out prog + compile "c" ["-E"] _ccProgram cc out prog readFile out -- | Compile a C source file to object code. @@ -108,7 +111,7 @@ compileC -> FilePath -- ^ output path -> String -- ^ C source -> M () -compileC = compile "c" ["-c"] +compileC = compile "c" ["-c"] _ccProgram -- | Compile an assembler source file to object code. compileAsm @@ -116,20 +119,7 @@ compileAsm -> FilePath -- ^ output path -> String -- ^ Assembler source -> M () -compileAsm = compile "S" ["-c"] - -compile - :: FilePath -- ^ input extension - -> [String] -- ^ extra flags - -> Cc - -> FilePath -- ^ output path - -> String -- ^ source - -> M () -compile ext extraFlags cc outPath program = do - let srcPath = outPath <.> ext - writeFile srcPath program - callProgram (ccProgram cc) $ extraFlags ++ ["-o", outPath, srcPath] - expectFileExists outPath "compiler produced no output" +compileAsm = compile "S" ["-c"] _ccProgram -- | Add various platform-dependent compiler flags needed by GHC. We can't do -- this in `findCc` since we need a 'Cc` to determine the 'ArchOS'. @@ -146,3 +136,4 @@ checkFStackCheck cc = withTempDir $ \dir -> checking "that -fstack-check works" let cc' = over (_ccProgram % _prgFlags) (++["-Wl,-fstack-checkzz"]) cc compileC cc' (dir "test.o") "int main(int argc, char **argv) { return 0; }" return cc' + ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs ===================================== @@ -50,8 +50,8 @@ findHsCppArgs cpp = withTempDir $ \dir -> do writeFile tmp_h "" concat <$> sequence - [ ["-traditional"] <$ checkFlag "-traditional" - , tryFlag "-undef" + [ tryFlag "-undef" + , ["-traditional"] <$ checkFlag "-traditional" , tryFlag "-Wno-invalid-pp-token" , tryFlag "-Wno-unicode" , tryFlag "-Wno-trigraphs" ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cxx.hs ===================================== @@ -3,17 +3,49 @@ module GHC.Toolchain.Tools.Cxx ( Cxx(..) , findCxx + -- * Helpful utilities + , compileCxx ) where +import System.FilePath import GHC.Toolchain.Prelude import GHC.Toolchain.Program +import GHC.Toolchain.Utils newtype Cxx = Cxx { cxxProgram :: Program } deriving (Show, Read, Eq, Ord) -findCxx :: ProgOpt -> M Cxx -findCxx progOpt = checking "for C++ compiler" $ do - cxxProgram <- findProgram "C++ compiler" progOpt ["c++", "clang++", "g++"] - return $ Cxx {cxxProgram} +_cxxProgram :: Lens Cxx Program +_cxxProgram = Lens cxxProgram (\x o -> o{cxxProgram=x}) +findCxx :: String -- ^ The llvm target to use if Cc supports --target + -> ProgOpt -> M Cxx +findCxx target progOpt = checking "for C++ compiler" $ do + -- TODO: We use the search order in configure, but there could be a more optimal one + cxxProgram <- findProgram "C++ compiler" progOpt ["g++", "clang++", "c++"] + cxx <- cxxSupportsTarget target Cxx{cxxProgram} + checkCxxWorks cxx + return cxx + +cxxSupportsTarget :: String -> Cxx -> M Cxx +cxxSupportsTarget target cxx = checking "whether C++ supports --target" $ + supportsTarget _cxxProgram checkCxxWorks target cxx + +checkCxxWorks :: Cxx -> M () +checkCxxWorks cxx = withTempDir $ \dir -> do + let test_o = dir "test.o" + compileCxx cxx test_o $ unlines + [ "#include " + , "int main(int argc, char **argv) {" + , " printf(\"hello world!\");" + , " return 0;" + , "}" + ] + +compileCxx + :: Cxx -- ^ cxx + -> FilePath -- ^ output path + -> String -- ^ C++ source + -> M () +compileCxx = compile "cpp" ["-c"] _cxxProgram ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -1,5 +1,6 @@ {-# OPTIONS_GHC -Wno-name-shadowing #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE CPP #-} module GHC.Toolchain.Tools.Link ( CcLink(..), findCcLink ) where @@ -24,10 +25,27 @@ data CcLink = CcLink { ccLinkProgram :: Program , ccLinkSupportsResponseFiles :: Bool , ccLinkIsGnu :: Bool -- We once thought this could instead be LdSupportsGcSections, but then realized it couldn't IIRC } - deriving (Show, Read, Eq, Ord) - -findCcLink :: ProgOpt -> Maybe Bool -> ArchOS -> Cc -> Maybe Readelf -> M CcLink -findCcLink progOpt ldOverride archOs cc readelf = checking "for C compiler for linking command" $ do + deriving (Read, Eq, Ord) + +_ccLinkProgram :: Lens CcLink Program +_ccLinkProgram = Lens ccLinkProgram (\x o -> o{ccLinkProgram=x}) + +-- These instances are more suitable for diffing +instance Show CcLink where + show CcLink{..} = unlines + [ "CcLink" + , "{ ccLinkProgram = " ++ show ccLinkProgram + , ", ccLinkSupportsNoPie = " ++ show ccLinkSupportsNoPie + , ", ccLinkSupportsCompactUnwind = " ++ show ccLinkSupportsCompactUnwind + , ", ccLinkSupportsFilelist = " ++ show ccLinkSupportsFilelist + , ", ccLinkSupportsResponseFiles = " ++ show ccLinkSupportsResponseFiles + , ", ccLinkIsGnu = " ++ show ccLinkIsGnu + , "}" + ] + +findCcLink :: String -- ^ The llvm target to use if CcLink supports --target + -> ProgOpt -> Maybe Bool -> ArchOS -> Cc -> Maybe Readelf -> M CcLink +findCcLink target progOpt ldOverride archOs cc readelf = checking "for C compiler for linking command" $ do -- Use the specified linker or try to find one rawCcLink <- findProgram "C compiler for linking" progOpt [prgPath $ ccProgram cc] ccLinkProgram <- case poFlags progOpt of @@ -44,7 +62,13 @@ findCcLink progOpt ldOverride archOs cc readelf = checking "for C compiler for l ccLinkIsGnu <- checkLinkIsGnu ccLinkProgram checkBfdCopyBug archOs cc readelf ccLinkProgram ccLinkProgram <- addPlatformDepLinkFlags archOs cc ccLinkProgram - return $ CcLink {ccLinkProgram, ccLinkSupportsNoPie, ccLinkSupportsCompactUnwind, ccLinkSupportsFilelist, ccLinkSupportsResponseFiles, ccLinkIsGnu} + let ccLink = CcLink {ccLinkProgram, ccLinkSupportsNoPie, + ccLinkSupportsCompactUnwind, ccLinkSupportsFilelist, + ccLinkSupportsResponseFiles, ccLinkIsGnu} + ccLink <- linkSupportsTarget cc target ccLink + ccLink <- linkRequiresNoFixupChains archOs cc ccLink + return ccLink + -- | Try to convince @cc@ to use a more efficient linker than @bfd.ld@ findLinkFlags :: Maybe Bool -> Cc -> Program -> M Program @@ -71,6 +95,11 @@ findLinkFlags ldOverride cc ccLink Just True -> True Just False -> False +linkSupportsTarget :: Cc -> String -> CcLink -> M CcLink +linkSupportsTarget cc target link + = checking "whether cc linker supports --target" $ + supportsTarget _ccLinkProgram (checkLinkWorks cc . ccLinkProgram) target link + -- | Should we attempt to find a more efficient linker on this platform? -- -- N.B. On Darwin it is quite important that we use the system linker @@ -95,12 +124,13 @@ checkSupportsNoPie ccLink = checking "whether the cc linker supports -no-pie" $ -- Check output as some GCC versions only warn and don't respect -Werror -- when passed an unrecognized flag. (code, out, _err) <- readProgram ccLink ["-no-pie", "-Werror", "-x", "c", test_c, "-o", test] - if isSuccess code && "unrecognized" `isInfixOf` out - then return False - else return True + return (isSuccess code && not ("unrecognized" `isInfixOf` out)) checkSupportsCompactUnwind :: Cc -> Program -> M Bool checkSupportsCompactUnwind cc ccLink = checking "whether the cc linker understands -no_compact_unwind" $ + -- ROMES:TODO: This returns False here but True in configure because in + -- configure we check for ld supports compact unwind, whereas here we check + -- for cclink supports compact unwind... what do we need it for? withTempDir $ \dir -> do let test_o = dir "test.o" test2_o = dir "test2.o" @@ -108,7 +138,7 @@ checkSupportsCompactUnwind cc ccLink = checking "whether the cc linker understan compileC cc test_o "int foo() { return 0; }" exitCode <- runProgram ccLink ["-r", "-no_compact_unwind", "-o", test2_o, test_o] - pure $ isSuccess exitCode + return $ isSuccess exitCode checkSupportsFilelist :: Cc -> Program -> M Bool checkSupportsFilelist cc ccLink = checking "whether the cc linker understands -filelist" $ @@ -121,15 +151,17 @@ checkSupportsFilelist cc ccLink = checking "whether the cc linker understands -f compileC cc test1_o "int foo() { return 0; }" compileC cc test2_o "int bar() { return 0; }" - writeFile test_ofiles test1_o -- write the filename test1_o to the test_ofiles file - appendFile test_ofiles test2_o -- append the filename test2_o to the test_ofiles file + -- write the filenames test1_o and test2_o to the test_ofiles file + writeFile test_ofiles (unlines [test1_o,test2_o]) exitCode <- runProgram ccLink ["-r", "-filelist", test_ofiles, "-o", test_o] - pure $ isSuccess exitCode + return (isSuccess exitCode) checkSupportsResponseFiles :: Cc -> Program -> M Bool checkSupportsResponseFiles cc ccLink = checking "whether the cc linker supports response files" $ + -- ROMES:TODO: This returns True here while False in configure because in + -- configure we call -shared and -dylib on LD, whereas here we do it on CcLink withTempDir $ \dir -> do let test_o = dir "test.o" compileC cc test_o "int main(void) {return 0;}" @@ -141,7 +173,7 @@ checkSupportsResponseFiles cc ccLink = checking "whether the cc linker supports -- TODO: It'd be good to shortcircuit this logical `or` exitCode1 <- runProgram ccLink ["-shared", "@"++args_txt] exitCode2 <- runProgram ccLink ["-dylib", "@"++args_txt] - pure (isSuccess exitCode1 || isSuccess exitCode2) + return (isSuccess exitCode1 || isSuccess exitCode2) -- | Check whether linking works. checkLinkWorks :: Cc -> Program -> M () @@ -236,3 +268,14 @@ addPlatformDepLinkFlags archOs cc ccLink return ccLink' | otherwise = return ccLink + +-- See if whether we are using a version of ld64 on darwin platforms which +-- requires us to pass -no_fixup_chains +linkRequiresNoFixupChains :: ArchOS -> Cc -> CcLink -> M CcLink +linkRequiresNoFixupChains archOs cc ccLink + | OSDarwin <- archOS_OS archOs = checking "whether CC linker requires -no_fixup_chains" $ + let ccLink' = over (_ccLinkProgram % _prgFlags) (++["-Wl,-no_fixup_chains"]) ccLink + in (ccLink' <$ checkLinkWorks cc (ccLinkProgram ccLink')) <|> return ccLink + | otherwise = return ccLink + + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/86b48e5e2e5c06d2ff69e113c5bc7cd0ee92b06a...e398306c264d98fa02eed082f275ced96da074a1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/86b48e5e2e5c06d2ff69e113c5bc7cd0ee92b06a...e398306c264d98fa02eed082f275ced96da074a1 You're receiving 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 Jun 6 16:10:17 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 06 Jun 2023 12:10:17 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/alpine-aarch64 Message-ID: <647f5a69a636c_1d329d565d66046317dc@gitlab.mail> Matthew Pickering pushed new branch wip/alpine-aarch64 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/alpine-aarch64 You're receiving 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 Jun 6 16:27:47 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Tue, 06 Jun 2023 12:27:47 -0400 Subject: [Git][ghc/ghc][wip/expand-do] adjusting the generated spans for proper error messages Message-ID: <647f5e836b229_1d329d565d66046381fa@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 39ac8d8f by Apoorv Ingle at 2023-06-06T11:27:36-05:00 adjusting the generated spans for proper error messages - - - - - 5 changed files: - compiler/GHC/Hs/Utils.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Match.hs Changes: ===================================== compiler/GHC/Hs/Utils.hs ===================================== @@ -45,7 +45,7 @@ module GHC.Hs.Utils( mkSimpleMatch, unguardedGRHSs, unguardedRHS, mkMatchGroup, mkLamCaseMatchGroup, mkMatch, mkPrefixFunRhs, mkHsLam, mkHsIf, mkHsWrap, mkLHsWrap, mkHsWrapCo, mkHsWrapCoR, mkLHsWrapCo, - mkHsDictLet, mkHsLams, mkHsLamDoExp, + mkHsDictLet, mkHsLams, mkHsOpApp, mkHsDo, mkHsDoAnns, mkHsComp, mkHsCompAnns, mkHsWrapPat, mkHsWrapPatCo, mkLHsPar, mkHsCmdWrap, mkLHsCmdWrap, mkHsCmdIf, mkConLikeTc, @@ -275,16 +275,6 @@ mkHsLam pats body = mkHsPar (L (getLoc body) (HsLam noExtField matches)) (noLocA [mkSimpleMatch LambdaExpr pats' body]) pats' = map (parenthesizePat appPrec) pats -mkHsLamDoExp :: (IsPass p, XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ Origin) - => [LPat (GhcPass p)] - -> LHsExpr (GhcPass p) - -> LHsExpr (GhcPass p) -mkHsLamDoExp pats body = mkHsPar (noLocA $ HsLam noExtField matches) - where - matches = mkMatchGroup (Generated DoExpansion) - (noLocA [mkSimpleMatch (StmtCtxt (HsDoStmt (DoExpr Nothing))) pats' body]) - pats' = map (parenthesizePat appPrec) pats - mkHsLams :: [TyVar] -> [EvVar] -> LHsExpr GhcTc -> LHsExpr GhcTc mkHsLams tyvars dicts expr = mkLHsWrap (mkWpTyLams tyvars <.> mkWpEvLams dicts) expr ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -328,6 +328,8 @@ tcApp rn_expr exp_res_ty vcat [ text "rn_fun:" <+> ppr rn_fun , text "rn_args:" <+> ppr rn_args , text "fun_ctxt:" <+> ppr fun_ctxt <+> ppr (appCtxtLoc fun_ctxt) + <+> ppr (isGeneratedSrcSpan (appCtxtLoc fun_ctxt)) + <+> ppr (insideExpansion fun_ctxt) ] ; (tc_fun, fun_sigma) <- tcInferAppHead fun rn_args @@ -349,7 +351,7 @@ tcApp rn_expr exp_res_ty -- the source program; it was added by the renamer. See -- Note [Handling overloaded and rebindable constructs] in GHC.Rename.Expr ; let perhaps_add_res_ty_ctxt thing_inside - | insideExpansion fun_ctxt + | insideExpansion fun_ctxt || isGeneratedSrcSpan (appCtxtLoc fun_ctxt) = thing_inside | otherwise = addFunResCtxt rn_fun rn_args app_res_rho exp_res_ty $ ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -222,8 +222,6 @@ tcExpr (XExpr (ExpandedStmt (HsExpanded stmt expr))) res_ty } - - tcExpr e@(HsOverLit _ lit) res_ty = do { mb_res <- tcShortCutLit lit res_ty -- See Note [Short cut for overloaded literals] in GHC.Tc.Zonk.Type ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -250,8 +250,8 @@ insideExpansion (VAExpansion {}) = True insideExpansion (VACall {}) = False instance Outputable AppCtxt where - ppr (VAExpansion e _) = text "VAExpansion" <+> ppr e - ppr (VACall f n _) = text "VACall" <+> int n <+> ppr f + ppr (VAExpansion e l) = text "VAExpansion" <+> ppr e <+> ppr l + ppr (VACall f n l) = text "VACall" <+> int n <+> ppr f <+> ppr l type family XPass p where XPass 'TcpRn = 'Renamed ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -78,7 +78,7 @@ import GHC.Types.Fixity (LexicalFixity(..)) import GHC.Types.Name import GHC.Types.Id import GHC.Types.SrcLoc -import GHC.Types.Basic (Origin (..), GenReason (..)) +import GHC.Types.Basic (Origin (..), GenReason (..), appPrec) import qualified GHC.LanguageExtensions as LangExt import Control.Monad @@ -1225,8 +1225,7 @@ expand_do_stmts _ [stmt@(L loc (LastStmt _ body _ ret_expr))] -- ------------------------------------------------ -- return e ~~> return e -- to make T18324 work - = return $ L loc (mkExpandedStmt stmt - ((L loc (HsApp noAnn (L loc ret) body)))) + = return $ wrapGenSpan (mkExpandedStmt stmt (L loc $ genHsApp ret body)) expand_do_stmts do_or_lc (stmt@(L loc (LetStmt _ bnds)) : lstmts) = @@ -1249,12 +1248,13 @@ expand_do_stmts do_or_lc (stmt@(L loc (BindStmt xbsrn pat e)): lstmts) -- pat <- e ; stmts ~~> (>>=) e f do expand_stmts <- expand_do_stmts do_or_lc lstmts expr <- mk_failable_lexpr_tcm pat expand_stmts fail_op - return $ (mkHsApps (wrapGenSpan bind_op) -- (>>=) - [ L loc (mkPopSrcSpanExpr $ L loc (mkExpandedStmt stmt e)) - , expr - ]) - + return $ (foldl genHsApp' (wrapGenSpan bind_op) -- (>>=) + [ L loc (mkPopSrcSpanExpr $ L loc (mkExpandedStmt stmt e)) + , expr + ]) | otherwise = pprPanic "expand do: shouldn't happen" (text "stmt" <+> ppr stmt) + where genHsApp' :: LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn + genHsApp' fun arg = wrapGenSpan (HsApp noAnn fun arg) expand_do_stmts do_or_lc (stmt@(L loc (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) = -- See Note [BodyStmt] @@ -1262,9 +1262,12 @@ expand_do_stmts do_or_lc (stmt@(L loc (BodyStmt _ e (SyntaxExprRn f) _)) : lstmt -- ---------------------------------------------- -- e ; stmts ~~> (>>) e stmts' do expand_stmts <- expand_do_stmts do_or_lc lstmts - return $ (mkHsApps (wrapGenSpan f) -- (>>) - [ L loc (mkPopSrcSpanExpr $ L loc (mkExpandedStmt stmt e)) -- e - , expand_stmts ]) -- stmts' + return $ (foldl genHsApp' (wrapGenSpan f) -- (>>) + [ L loc (mkPopSrcSpanExpr $ L loc (mkExpandedStmt stmt e)) -- e + , expand_stmts ]) -- stmts' + where + genHsApp' :: LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn + genHsApp' fun arg = wrapGenSpan (HsApp noAnn fun arg) expand_do_stmts do_or_lc ((L do_loc (RecStmt { recS_stmts = L stmts_loc rec_stmts @@ -1405,6 +1408,32 @@ mk_fail_lexpr pat lexpr (Just (SyntaxExprRn fail_op)) = mk_fail_lexpr _ _ _ = pprPanic "mk_fail_lexpr: impossible happened" empty + +mkHsLamDoExp :: (IsPass p, XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ Origin) + => [LPat (GhcPass p)] + -> LHsExpr (GhcPass p) + -> LHsExpr (GhcPass p) +mkHsLamDoExp pats body = mkHsPar (wrapGenSpan $ HsLam noExtField matches) + where + matches = mkMatchGroup (Generated DoExpansion) + (wrapGenSpan [genSimpleMatch (StmtCtxt (HsDoStmt (DoExpr Nothing))) pats' body]) + pats' = map (parenthesizePat appPrec) pats + + + +genSimpleMatch :: (Anno (Match (GhcPass p) (LocatedA (body (GhcPass p)))) + ~ SrcSpanAnnA, + Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) + ~ SrcAnn NoEpAnns) + => HsMatchContext (GhcPass p) + -> [LPat (GhcPass p)] -> LocatedA (body (GhcPass p)) + -> LMatch (GhcPass p) (LocatedA (body (GhcPass p))) +genSimpleMatch ctxt pats rhs + = wrapGenSpan $ + Match { m_ext = noAnn, m_ctxt = ctxt, m_pats = pats + , m_grhss = unguardedGRHSs generatedSrcSpan rhs noAnn } + + {- Note [Expanding HsDo with HsExpansion] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We expand do blocks before typechecking it rather than after type checking it using the View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/39ac8d8f65452b619447c66770c5dc6f46a28219 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/39ac8d8f65452b619447c66770c5dc6f46a28219 You're receiving 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 Jun 6 16:29:41 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 06 Jun 2023 12:29:41 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/t23465 Message-ID: <647f5ef5b7eaa_1d329d3fbc395c63867a@gitlab.mail> Matthew Pickering pushed new branch wip/t23465 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/t23465 You're receiving 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 Jun 6 16:30:06 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 06 Jun 2023 12:30:06 -0400 Subject: [Git][ghc/ghc][wip/t23465] Fix pretty printing of WARNING pragmas Message-ID: <647f5f0e7ea66_1d329d3d01d88463889e@gitlab.mail> Matthew Pickering pushed to branch wip/t23465 at Glasgow Haskell Compiler / GHC Commits: 5c33fa18 by Matthew Pickering at 2023-06-06T17:29:56+01:00 Fix pretty printing of WARNING pragmas There is still something quite unsavoury going on with WARNING pragma printing because the printing relies on the fact that for decl deprecations the SourceText of WarningTxt is empty. However, I let that lion sleep and just fixed things directly. Fixes #23465 - - - - - 5 changed files: - compiler/GHC/Hs/Decls.hs - compiler/GHC/Unit/Module/Warnings.hs - + testsuite/tests/warnings/should_compile/T23465.hs - + testsuite/tests/warnings/should_compile/T23465.stderr - testsuite/tests/warnings/should_compile/all.T Changes: ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -1234,7 +1234,7 @@ instance OutputableBndrId p <+> ppr txt where ppr_category = case txt of - WarningTxt (Just cat) _ _ -> text "[" <> ppr (unLoc cat) <> text "]" + WarningTxt (Just cat) _ _ -> text "in" <+> doubleQuotes (ppr cat) _ -> empty {- ===================================== compiler/GHC/Unit/Module/Warnings.hs ===================================== @@ -193,10 +193,13 @@ deriving instance Eq (IdP pass) => Eq (WarningTxt pass) deriving instance (Data pass, Data (IdP pass)) => Data (WarningTxt pass) instance Outputable (WarningTxt pass) where - ppr (WarningTxt _ lsrc ws) - = case unLoc lsrc of - NoSourceText -> pp_ws ws - SourceText src -> ftext src <+> pp_ws ws <+> text "#-}" + ppr (WarningTxt mcat lsrc ws) + = let + cat = maybe empty (\cat -> text "in" <+> doubleQuotes (ppr cat)) mcat + in case unLoc lsrc of + NoSourceText -> pp_ws ws + SourceText src -> ftext src <+> cat <+> pp_ws ws <+> text "#-}" + ppr (DeprecatedTxt lsrc ds) = case unLoc lsrc of ===================================== testsuite/tests/warnings/should_compile/T23465.hs ===================================== @@ -0,0 +1,4 @@ +module T23465 {-# WARNING in "x-a" "b" #-} where + +{-# WARNING in "x-c" e "d" #-} +e = e ===================================== testsuite/tests/warnings/should_compile/T23465.stderr ===================================== @@ -0,0 +1,9 @@ + +==================== Parser ==================== +module T23465 +{-# WARNING in "x-a" "b" #-} +where +{-# WARNING in "x-c" e "d" #-} +e = e + + ===================================== testsuite/tests/warnings/should_compile/all.T ===================================== @@ -62,5 +62,4 @@ test('T22759', normal, compile, ['']) test('T22676', [extra_files(['src'])], multimod_compile, ['src.hs', '-working-dir src -Wmissing-home-modules -v0']) test('DodgyImports', normal, compile, ['-Wdodgy-imports']) test('DodgyImports_hiding', normal, compile, ['-Wdodgy-imports']) -test('T22702a', normal, compile, ['']) -test('T22702b', normal, compile, ['']) +test('T23465', normal, compile, ['-ddump-parsed']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5c33fa1850eddb9dbb788d7daf7106d1377dbeeb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5c33fa1850eddb9dbb788d7daf7106d1377dbeeb You're receiving 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 Jun 6 16:31:00 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Tue, 06 Jun 2023 12:31:00 -0400 Subject: [Git][ghc/ghc][wip/t23465] Fix pretty printing of WARNING pragmas Message-ID: <647f5f44c2a9b_1d329d3f855a906410af@gitlab.mail> Matthew Pickering pushed to branch wip/t23465 at Glasgow Haskell Compiler / GHC Commits: 02758825 by Matthew Pickering at 2023-06-06T17:30:53+01:00 Fix pretty printing of WARNING pragmas There is still something quite unsavoury going on with WARNING pragma printing because the printing relies on the fact that for decl deprecations the SourceText of WarningTxt is empty. However, I let that lion sleep and just fixed things directly. Fixes #23465 - - - - - 5 changed files: - compiler/GHC/Hs/Decls.hs - compiler/GHC/Unit/Module/Warnings.hs - + testsuite/tests/warnings/should_compile/T23465.hs - + testsuite/tests/warnings/should_compile/T23465.stderr - testsuite/tests/warnings/should_compile/all.T Changes: ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -1234,7 +1234,7 @@ instance OutputableBndrId p <+> ppr txt where ppr_category = case txt of - WarningTxt (Just cat) _ _ -> text "[" <> ppr (unLoc cat) <> text "]" + WarningTxt (Just cat) _ _ -> text "in" <+> doubleQuotes (ppr cat) _ -> empty {- ===================================== compiler/GHC/Unit/Module/Warnings.hs ===================================== @@ -193,10 +193,13 @@ deriving instance Eq (IdP pass) => Eq (WarningTxt pass) deriving instance (Data pass, Data (IdP pass)) => Data (WarningTxt pass) instance Outputable (WarningTxt pass) where - ppr (WarningTxt _ lsrc ws) - = case unLoc lsrc of - NoSourceText -> pp_ws ws - SourceText src -> ftext src <+> pp_ws ws <+> text "#-}" + ppr (WarningTxt mcat lsrc ws) + = let + cat = maybe empty (\cat -> text "in" <+> doubleQuotes (ppr cat)) mcat + in case unLoc lsrc of + NoSourceText -> pp_ws ws + SourceText src -> ftext src <+> cat <+> pp_ws ws <+> text "#-}" + ppr (DeprecatedTxt lsrc ds) = case unLoc lsrc of ===================================== testsuite/tests/warnings/should_compile/T23465.hs ===================================== @@ -0,0 +1,4 @@ +module T23465 {-# WaRNING in "x-a" "b" #-} where + +{-# WARNInG in "x-c" e "d" #-} +e = e ===================================== testsuite/tests/warnings/should_compile/T23465.stderr ===================================== @@ -0,0 +1,9 @@ + +==================== Parser ==================== +module T23465 +{-# WaRNING in "x-a" "b" #-} +where +{-# WARNInG in "x-c" e "d" #-} +e = e + + ===================================== testsuite/tests/warnings/should_compile/all.T ===================================== @@ -62,5 +62,4 @@ test('T22759', normal, compile, ['']) test('T22676', [extra_files(['src'])], multimod_compile, ['src.hs', '-working-dir src -Wmissing-home-modules -v0']) test('DodgyImports', normal, compile, ['-Wdodgy-imports']) test('DodgyImports_hiding', normal, compile, ['-Wdodgy-imports']) -test('T22702a', normal, compile, ['']) -test('T22702b', normal, compile, ['']) +test('T23465', normal, compile, ['-ddump-parsed']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0275882551e9a2fc8c79378cd377fc91c2acc079 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0275882551e9a2fc8c79378cd377fc91c2acc079 You're receiving 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 Jun 6 16:59:50 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 06 Jun 2023 12:59:50 -0400 Subject: [Git][ghc/ghc][master] Generate Addr# access ops programmatically Message-ID: <647f6606b1326_1d329d3d01d8846473fb@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - 5 changed files: - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - hadrian/src/Rules/Generate.hs - rts/gen_event_types.py Changes: ===================================== compiler/GHC/Builtin/bytearray-ops.txt.pp deleted ===================================== @@ -1,551 +0,0 @@ - ------------------------------------- --- ByteArray# operations ------------------------------------- - - --- Do not edit. This file is generated by utils/genprimopcode/gen_bytearray_ops.py. --- To regenerate run, --- --- python3 utils/genprimops/gen_bytearray_ops.py > compiler/GHC/Builtin/bytearray-ops.txt.pp - - ------------------------------------- --- aligned index operations ------------------------------------- - -primop IndexByteArrayOp_Char "indexCharArray#" GenPrimOp - ByteArray# -> Int# -> Char# - {Read a 8-bit character; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_WideChar "indexWideCharArray#" GenPrimOp - ByteArray# -> Int# -> Char# - {Read a 32-bit character; offset in 4-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Int "indexIntArray#" GenPrimOp - ByteArray# -> Int# -> Int# - {Read a word-sized integer; offset in machine words.} - with can_fail = True - -primop IndexByteArrayOp_Word "indexWordArray#" GenPrimOp - ByteArray# -> Int# -> Word# - {Read a word-sized unsigned integer; offset in machine words.} - with can_fail = True - -primop IndexByteArrayOp_Addr "indexAddrArray#" GenPrimOp - ByteArray# -> Int# -> Addr# - {Read a machine address; offset in machine words.} - with can_fail = True - -primop IndexByteArrayOp_Float "indexFloatArray#" GenPrimOp - ByteArray# -> Int# -> Float# - {Read a single-precision floating-point value; offset in 4-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Double "indexDoubleArray#" GenPrimOp - ByteArray# -> Int# -> Double# - {Read a double-precision floating-point value; offset in 8-byte words.} - with can_fail = True - -primop IndexByteArrayOp_StablePtr "indexStablePtrArray#" GenPrimOp - ByteArray# -> Int# -> StablePtr# a - {Read a 'StablePtr#' value; offset in machine words.} - with can_fail = True - -primop IndexByteArrayOp_Int8 "indexInt8Array#" GenPrimOp - ByteArray# -> Int# -> Int8# - {Read a 8-bit signed integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Int16 "indexInt16Array#" GenPrimOp - ByteArray# -> Int# -> Int16# - {Read a 16-bit signed integer; offset in 2-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Int32 "indexInt32Array#" GenPrimOp - ByteArray# -> Int# -> Int32# - {Read a 32-bit signed integer; offset in 4-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Int64 "indexInt64Array#" GenPrimOp - ByteArray# -> Int# -> Int64# - {Read a 64-bit signed integer; offset in 8-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Word8 "indexWord8Array#" GenPrimOp - ByteArray# -> Int# -> Word8# - {Read a 8-bit unsigned integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word16 "indexWord16Array#" GenPrimOp - ByteArray# -> Int# -> Word16# - {Read a 16-bit unsigned integer; offset in 2-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Word32 "indexWord32Array#" GenPrimOp - ByteArray# -> Int# -> Word32# - {Read a 32-bit unsigned integer; offset in 4-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Word64 "indexWord64Array#" GenPrimOp - ByteArray# -> Int# -> Word64# - {Read a 64-bit unsigned integer; offset in 8-byte words.} - with can_fail = True - - ------------------------------------- --- unaligned index operations ------------------------------------- - -primop IndexByteArrayOp_Word8AsChar "indexWord8ArrayAsChar#" GenPrimOp - ByteArray# -> Int# -> Char# - {Read a 8-bit character; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsWideChar "indexWord8ArrayAsWideChar#" GenPrimOp - ByteArray# -> Int# -> Char# - {Read a 32-bit character; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsInt "indexWord8ArrayAsInt#" GenPrimOp - ByteArray# -> Int# -> Int# - {Read a word-sized integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsWord "indexWord8ArrayAsWord#" GenPrimOp - ByteArray# -> Int# -> Word# - {Read a word-sized unsigned integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsAddr "indexWord8ArrayAsAddr#" GenPrimOp - ByteArray# -> Int# -> Addr# - {Read a machine address; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsFloat "indexWord8ArrayAsFloat#" GenPrimOp - ByteArray# -> Int# -> Float# - {Read a single-precision floating-point value; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsDouble "indexWord8ArrayAsDouble#" GenPrimOp - ByteArray# -> Int# -> Double# - {Read a double-precision floating-point value; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsStablePtr "indexWord8ArrayAsStablePtr#" GenPrimOp - ByteArray# -> Int# -> StablePtr# a - {Read a 'StablePtr#' value; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsInt16 "indexWord8ArrayAsInt16#" GenPrimOp - ByteArray# -> Int# -> Int16# - {Read a 16-bit signed integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsInt32 "indexWord8ArrayAsInt32#" GenPrimOp - ByteArray# -> Int# -> Int32# - {Read a 32-bit signed integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsInt64 "indexWord8ArrayAsInt64#" GenPrimOp - ByteArray# -> Int# -> Int64# - {Read a 64-bit signed integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsWord16 "indexWord8ArrayAsWord16#" GenPrimOp - ByteArray# -> Int# -> Word16# - {Read a 16-bit unsigned integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsWord32 "indexWord8ArrayAsWord32#" GenPrimOp - ByteArray# -> Int# -> Word32# - {Read a 32-bit unsigned integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsWord64 "indexWord8ArrayAsWord64#" GenPrimOp - ByteArray# -> Int# -> Word64# - {Read a 64-bit unsigned integer; offset in bytes.} - with can_fail = True - - ------------------------------------- --- aligned read operations ------------------------------------- - -primop ReadByteArrayOp_Char "readCharArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) - {Read a 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_WideChar "readWideCharArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) - {Read a 32-bit character; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int "readIntArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #) - {Read a word-sized integer; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word "readWordArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #) - {Read a word-sized unsigned integer; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Addr "readAddrArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Addr# #) - {Read a machine address; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Float "readFloatArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Float# #) - {Read a single-precision floating-point value; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Double "readDoubleArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Double# #) - {Read a double-precision floating-point value; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_StablePtr "readStablePtrArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, StablePtr# a #) - {Read a 'StablePtr#' value; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int8 "readInt8Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int8# #) - {Read a 8-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int16 "readInt16Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int16# #) - {Read a 16-bit signed integer; offset in 2-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int32 "readInt32Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int32# #) - {Read a 32-bit signed integer; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int64 "readInt64Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int64# #) - {Read a 64-bit signed integer; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8 "readWord8Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word8# #) - {Read a 8-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word16 "readWord16Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word16# #) - {Read a 16-bit unsigned integer; offset in 2-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word32 "readWord32Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word32# #) - {Read a 32-bit unsigned integer; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word64 "readWord64Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word64# #) - {Read a 64-bit unsigned integer; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - - ------------------------------------- --- unaligned read operations ------------------------------------- - -primop ReadByteArrayOp_Word8AsChar "readWord8ArrayAsChar#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) - {Read a 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsWideChar "readWord8ArrayAsWideChar#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) - {Read a 32-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsInt "readWord8ArrayAsInt#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #) - {Read a word-sized integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsWord "readWord8ArrayAsWord#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #) - {Read a word-sized unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsAddr "readWord8ArrayAsAddr#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Addr# #) - {Read a machine address; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsFloat "readWord8ArrayAsFloat#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Float# #) - {Read a single-precision floating-point value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsDouble "readWord8ArrayAsDouble#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Double# #) - {Read a double-precision floating-point value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsStablePtr "readWord8ArrayAsStablePtr#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, StablePtr# a #) - {Read a 'StablePtr#' value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsInt16 "readWord8ArrayAsInt16#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int16# #) - {Read a 16-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsInt32 "readWord8ArrayAsInt32#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int32# #) - {Read a 32-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsInt64 "readWord8ArrayAsInt64#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int64# #) - {Read a 64-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsWord16 "readWord8ArrayAsWord16#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word16# #) - {Read a 16-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsWord32 "readWord8ArrayAsWord32#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word32# #) - {Read a 32-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsWord64 "readWord8ArrayAsWord64#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word64# #) - {Read a 64-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - - ------------------------------------- --- aligned write operations ------------------------------------- - -primop WriteByteArrayOp_Char "writeCharArray#" GenPrimOp - MutableByteArray# s -> Int# -> Char# -> State# s -> State# s - {Write a 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_WideChar "writeWideCharArray#" GenPrimOp - MutableByteArray# s -> Int# -> Char# -> State# s -> State# s - {Write a 32-bit character; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int "writeIntArray#" GenPrimOp - MutableByteArray# s -> Int# -> Int# -> State# s -> State# s - {Write a word-sized integer; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word "writeWordArray#" GenPrimOp - MutableByteArray# s -> Int# -> Word# -> State# s -> State# s - {Write a word-sized unsigned integer; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Addr "writeAddrArray#" GenPrimOp - MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s - {Write a machine address; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Float "writeFloatArray#" GenPrimOp - MutableByteArray# s -> Int# -> Float# -> State# s -> State# s - {Write a single-precision floating-point value; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Double "writeDoubleArray#" GenPrimOp - MutableByteArray# s -> Int# -> Double# -> State# s -> State# s - {Write a double-precision floating-point value; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_StablePtr "writeStablePtrArray#" GenPrimOp - MutableByteArray# s -> Int# -> StablePtr# a -> State# s -> State# s - {Write a 'StablePtr#' value; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int8 "writeInt8Array#" GenPrimOp - MutableByteArray# s -> Int# -> Int8# -> State# s -> State# s - {Write a 8-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int16 "writeInt16Array#" GenPrimOp - MutableByteArray# s -> Int# -> Int16# -> State# s -> State# s - {Write a 16-bit signed integer; offset in 2-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int32 "writeInt32Array#" GenPrimOp - MutableByteArray# s -> Int# -> Int32# -> State# s -> State# s - {Write a 32-bit signed integer; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int64 "writeInt64Array#" GenPrimOp - MutableByteArray# s -> Int# -> Int64# -> State# s -> State# s - {Write a 64-bit signed integer; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8 "writeWord8Array#" GenPrimOp - MutableByteArray# s -> Int# -> Word8# -> State# s -> State# s - {Write a 8-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word16 "writeWord16Array#" GenPrimOp - MutableByteArray# s -> Int# -> Word16# -> State# s -> State# s - {Write a 16-bit unsigned integer; offset in 2-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word32 "writeWord32Array#" GenPrimOp - MutableByteArray# s -> Int# -> Word32# -> State# s -> State# s - {Write a 32-bit unsigned integer; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word64 "writeWord64Array#" GenPrimOp - MutableByteArray# s -> Int# -> Word64# -> State# s -> State# s - {Write a 64-bit unsigned integer; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - - ------------------------------------- --- unaligned write operations ------------------------------------- - -primop WriteByteArrayOp_Word8AsChar "writeWord8ArrayAsChar#" GenPrimOp - MutableByteArray# s -> Int# -> Char# -> State# s -> State# s - {Write a 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsWideChar "writeWord8ArrayAsWideChar#" GenPrimOp - MutableByteArray# s -> Int# -> Char# -> State# s -> State# s - {Write a 32-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsInt "writeWord8ArrayAsInt#" GenPrimOp - MutableByteArray# s -> Int# -> Int# -> State# s -> State# s - {Write a word-sized integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsWord "writeWord8ArrayAsWord#" GenPrimOp - MutableByteArray# s -> Int# -> Word# -> State# s -> State# s - {Write a word-sized unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsAddr "writeWord8ArrayAsAddr#" GenPrimOp - MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s - {Write a machine address; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsFloat "writeWord8ArrayAsFloat#" GenPrimOp - MutableByteArray# s -> Int# -> Float# -> State# s -> State# s - {Write a single-precision floating-point value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsDouble "writeWord8ArrayAsDouble#" GenPrimOp - MutableByteArray# s -> Int# -> Double# -> State# s -> State# s - {Write a double-precision floating-point value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsStablePtr "writeWord8ArrayAsStablePtr#" GenPrimOp - MutableByteArray# s -> Int# -> StablePtr# a -> State# s -> State# s - {Write a 'StablePtr#' value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsInt16 "writeWord8ArrayAsInt16#" GenPrimOp - MutableByteArray# s -> Int# -> Int16# -> State# s -> State# s - {Write a 16-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsInt32 "writeWord8ArrayAsInt32#" GenPrimOp - MutableByteArray# s -> Int# -> Int32# -> State# s -> State# s - {Write a 32-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsInt64 "writeWord8ArrayAsInt64#" GenPrimOp - MutableByteArray# s -> Int# -> Int64# -> State# s -> State# s - {Write a 64-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsWord16 "writeWord8ArrayAsWord16#" GenPrimOp - MutableByteArray# s -> Int# -> Word16# -> State# s -> State# s - {Write a 16-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsWord32 "writeWord8ArrayAsWord32#" GenPrimOp - MutableByteArray# s -> Int# -> Word32# -> State# s -> State# s - {Write a 32-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsWord64 "writeWord8ArrayAsWord64#" GenPrimOp - MutableByteArray# s -> Int# -> Word64# -> State# s -> State# s - {Write a 64-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - ===================================== utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py ===================================== @@ -1,8 +1,32 @@ #!/usr/bin/env python # -*- coding: utf-8 -*- +# This script generates the primop descriptions for many similar ByteArray# +# and Addr# access operations. Its output is #include-d into primops.txt.pp. + from typing import Optional, NamedTuple import textwrap +import argparse + +arg_parser = argparse.ArgumentParser() +arg_parser.add_argument('addr_or_bytearray', + choices = ["addr-access-ops", "bytearray-access-ops"], + ) +arg_parser.add_argument('output_file', + type=argparse.FileType('w'), + metavar='FILE', + ) +args = arg_parser.parse_args() +write = args.output_file.write + + + +write(''' +-- Do not edit. +-- This file is generated by compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py. +-- (The build system should take care of this for you.) + +''') class ElementType(NamedTuple): name: str @@ -28,26 +52,13 @@ element_types = [ ElementType("StablePtr", "StablePtr# a", "'StablePtr#' value", MACH_WORD), ] -# TODO: Eventually when the sized integer primops use proper unboxed types we -# should rather do: -# -#for n in [8,16,32,64]: -# element_types += [ ElementType(f"Int{n}", f"Int{n}#", f"{n}-bit signed integer", n // 8) ] -# -#for n in [8,16,32,64]: -# element_types += [ ElementType(f"Word{n}", f"Word{n}#", f"{n}-bit unsigned integer", n // 8) ] - -element_types += [ - ElementType("Int8", "Int8#", "8-bit signed integer", 1), - ElementType("Int16", "Int16#", "16-bit signed integer", 2), - ElementType("Int32", "Int32#", "32-bit signed integer", 4), - ElementType("Int64", "Int64#", "64-bit signed integer", 8), - - ElementType("Word8", "Word8#", "8-bit unsigned integer", 1), - ElementType("Word16", "Word16#", "16-bit unsigned integer", 2), - ElementType("Word32", "Word32#", "32-bit unsigned integer", 4), - ElementType("Word64", "Word64#", "64-bit unsigned integer", 8), -] +for n in [8,16,32,64]: + element_types += [ + ElementType(f"Int{n}", f"Int{n}#", + f"{n}-bit signed integer", n // 8), + ElementType(f"Word{n}", f"Word{n}#", + f"{n}-bit unsigned integer", n // 8) + ] def pretty_offset(n: Optional[int]) -> str: if n == MACH_WORD: @@ -57,87 +68,134 @@ def pretty_offset(n: Optional[int]) -> str: else: return f'{n}-byte words' +def get_align_warn(n: ElementType) -> str: + if n.width == 1: + return '' + return ''' + On some platforms, the access may fail + for an insufficiently aligned @Addr#@. + ''' + def print_block(template: str, **kwargs) -> None: - print(textwrap.dedent(template.format(**kwargs)).lstrip()) + write(textwrap.dedent(template.format(**kwargs)).lstrip()) + write('\n') def header(s: str): - print('') + write('\n') print_block(''' ------------------------------------ -- {s} ------------------------------------ ''', s=s) +if args.addr_or_bytearray == "bytearray-access-ops": + header("ByteArray# operations") -header("ByteArray# operations") - -print(''' --- Do not edit. This file is generated by utils/genprimopcode/gen_bytearray_ops.py. --- To regenerate run, --- --- python3 utils/genprimops/gen_bytearray_ops.py > compiler/GHC/Builtin/bytearray-ops.txt.pp -''') - -header('aligned index operations') -for t in element_types: - offset = pretty_offset(t.width) - print_block(''' + header('aligned index operations') + for t in element_types: + offset = pretty_offset(t.width) + print_block(''' primop IndexByteArrayOp_{name} "index{name}Array#" GenPrimOp ByteArray# -> Int# -> {rep_ty} {{Read a {desc}; offset in {offset}.}} with can_fail = True - ''', offset = offset, **t._asdict()) + ''', offset = offset, **t._asdict()) -header('unaligned index operations') -for t in element_types: - if t.name in ['Int8', 'Word8']: continue - print_block(''' + header('unaligned index operations') + for t in element_types: + if t.name in ['Int8', 'Word8']: continue + print_block(''' primop IndexByteArrayOp_Word8As{name} "indexWord8ArrayAs{name}#" GenPrimOp ByteArray# -> Int# -> {rep_ty} {{Read a {desc}; offset in bytes.}} with can_fail = True - ''', **t._asdict()) + ''', **t._asdict()) -header('aligned read operations') -for t in element_types: - offset = pretty_offset(t.width) - print_block(''' + header('aligned read operations') + for t in element_types: + offset = pretty_offset(t.width) + print_block(''' primop ReadByteArrayOp_{name} "read{name}Array#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> (# State# s, {rep_ty} #) {{Read a {desc}; offset in {offset}.}} with has_side_effects = True can_fail = True - ''', offset = offset, **t._asdict()) + ''', offset = offset, **t._asdict()) -header('unaligned read operations') -for t in element_types: - if t.name in ['Int8', 'Word8']: continue - print_block(''' + header('unaligned read operations') + for t in element_types: + if t.name in ['Int8', 'Word8']: continue + print_block(''' primop ReadByteArrayOp_Word8As{name} "readWord8ArrayAs{name}#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> (# State# s, {rep_ty} #) {{Read a {desc}; offset in bytes.}} with has_side_effects = True can_fail = True - ''', **t._asdict()) + ''', **t._asdict()) -header('aligned write operations') -for t in element_types: - offset = pretty_offset(t.width) - print_block(''' + header('aligned write operations') + for t in element_types: + offset = pretty_offset(t.width) + print_block(''' primop WriteByteArrayOp_{name} "write{name}Array#" GenPrimOp MutableByteArray# s -> Int# -> {rep_ty} -> State# s -> State# s {{Write a {desc}; offset in {offset}.}} with has_side_effects = True can_fail = True - ''', offset = offset, **t._asdict()) + ''', offset = offset, **t._asdict()) -header('unaligned write operations') -for t in element_types: - if t.name in ['Int8', 'Word8']: continue - print_block(''' + header('unaligned write operations') + for t in element_types: + if t.name in ['Int8', 'Word8']: continue + print_block(''' primop WriteByteArrayOp_Word8As{name} "writeWord8ArrayAs{name}#" GenPrimOp MutableByteArray# s -> Int# -> {rep_ty} -> State# s -> State# s {{Write a {desc}; offset in bytes.}} with has_side_effects = True can_fail = True - ''', **t._asdict()) + ''', **t._asdict()) + + +else: # addr_or_bytearray == "addr-access-ops": + header("Addr# access operations") + + header('aligned index operations') + for t in element_types: + offset = pretty_offset(t.width) + align_warn = get_align_warn(t) + print_block(''' + primop IndexOffAddrOp_{name} "index{name}OffAddr#" GenPrimOp + Addr# -> Int# -> {rep_ty} + {{ Read a {desc}; offset in {offset}. + {align_warn} + }} + with can_fail = True + ''', offset = offset, align_warn = align_warn, **t._asdict()) + + header('aligned read operations') + for t in element_types: + offset = pretty_offset(t.width) + align_warn = get_align_warn(t) + print_block(''' + primop ReadOffAddrOp_{name} "read{name}OffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, {rep_ty} #) + {{ Read a {desc}; offset in {offset}. + {align_warn} + }} + with has_side_effects = True + can_fail = True + ''', offset = offset, align_warn = align_warn, **t._asdict()) + + header('aligned write operations') + for t in element_types: + offset = pretty_offset(t.width) + align_warn = get_align_warn(t) + print_block(''' + primop WriteOffAddrOp_{name} "write{name}OffAddr#" GenPrimOp + Addr# -> Int# -> {rep_ty} -> State# s -> State# s + {{ Write a {desc}; offset in {offset}. + {align_warn} + }} + with has_side_effects = True + can_fail = True + ''', offset = offset, align_warn = align_warn, **t._asdict()) ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -1941,7 +1941,7 @@ primop GetSizeofMutableByteArrayOp "getSizeofMutableByteArray#" GenPrimOp @since 0.5.0.0} -#include "bytearray-ops.txt.pp" +#include "bytearray-access-ops.txt.pp" primop CompareByteArraysOp "compareByteArrays#" GenPrimOp ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int# @@ -2242,233 +2242,7 @@ primop AddrNeOp "neAddr#" Compare Addr# -> Addr# -> Int# primop AddrLtOp "ltAddr#" Compare Addr# -> Addr# -> Int# primop AddrLeOp "leAddr#" Compare Addr# -> Addr# -> Int# -primop IndexOffAddrOp_Char "indexCharOffAddr#" GenPrimOp - Addr# -> Int# -> Char# - {Reads 8-bit character; offset in bytes.} - with can_fail = True - -primop IndexOffAddrOp_WideChar "indexWideCharOffAddr#" GenPrimOp - Addr# -> Int# -> Char# - {Reads 31-bit character; offset in 4-byte words.} - with can_fail = True - -primop IndexOffAddrOp_Int "indexIntOffAddr#" GenPrimOp - Addr# -> Int# -> Int# - with can_fail = True - -primop IndexOffAddrOp_Word "indexWordOffAddr#" GenPrimOp - Addr# -> Int# -> Word# - with can_fail = True - -primop IndexOffAddrOp_Addr "indexAddrOffAddr#" GenPrimOp - Addr# -> Int# -> Addr# - with can_fail = True - -primop IndexOffAddrOp_Float "indexFloatOffAddr#" GenPrimOp - Addr# -> Int# -> Float# - with can_fail = True - -primop IndexOffAddrOp_Double "indexDoubleOffAddr#" GenPrimOp - Addr# -> Int# -> Double# - with can_fail = True - -primop IndexOffAddrOp_StablePtr "indexStablePtrOffAddr#" GenPrimOp - Addr# -> Int# -> StablePtr# a - with can_fail = True - -primop IndexOffAddrOp_Int8 "indexInt8OffAddr#" GenPrimOp - Addr# -> Int# -> Int8# - with can_fail = True - -primop IndexOffAddrOp_Int16 "indexInt16OffAddr#" GenPrimOp - Addr# -> Int# -> Int16# - with can_fail = True - -primop IndexOffAddrOp_Int32 "indexInt32OffAddr#" GenPrimOp - Addr# -> Int# -> Int32# - with can_fail = True - -primop IndexOffAddrOp_Int64 "indexInt64OffAddr#" GenPrimOp - Addr# -> Int# -> Int64# - with can_fail = True - -primop IndexOffAddrOp_Word8 "indexWord8OffAddr#" GenPrimOp - Addr# -> Int# -> Word8# - with can_fail = True - -primop IndexOffAddrOp_Word16 "indexWord16OffAddr#" GenPrimOp - Addr# -> Int# -> Word16# - with can_fail = True - -primop IndexOffAddrOp_Word32 "indexWord32OffAddr#" GenPrimOp - Addr# -> Int# -> Word32# - with can_fail = True - -primop IndexOffAddrOp_Word64 "indexWord64OffAddr#" GenPrimOp - Addr# -> Int# -> Word64# - with can_fail = True - -primop ReadOffAddrOp_Char "readCharOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Char# #) - {Reads 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_WideChar "readWideCharOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Char# #) - {Reads 31-bit character; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int "readIntOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word "readWordOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Addr "readAddrOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Addr# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Float "readFloatOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Float# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Double "readDoubleOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Double# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_StablePtr "readStablePtrOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, StablePtr# a #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int8 "readInt8OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int8# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int16 "readInt16OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int16# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int32 "readInt32OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int32# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int64 "readInt64OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int64# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word8 "readWord8OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word8# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word16 "readWord16OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word16# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word32 "readWord32OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word32# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word64 "readWord64OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word64# #) - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Char "writeCharOffAddr#" GenPrimOp - Addr# -> Int# -> Char# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_WideChar "writeWideCharOffAddr#" GenPrimOp - Addr# -> Int# -> Char# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int "writeIntOffAddr#" GenPrimOp - Addr# -> Int# -> Int# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word "writeWordOffAddr#" GenPrimOp - Addr# -> Int# -> Word# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Addr "writeAddrOffAddr#" GenPrimOp - Addr# -> Int# -> Addr# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Float "writeFloatOffAddr#" GenPrimOp - Addr# -> Int# -> Float# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Double "writeDoubleOffAddr#" GenPrimOp - Addr# -> Int# -> Double# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_StablePtr "writeStablePtrOffAddr#" GenPrimOp - Addr# -> Int# -> StablePtr# a -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int8 "writeInt8OffAddr#" GenPrimOp - Addr# -> Int# -> Int8# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int16 "writeInt16OffAddr#" GenPrimOp - Addr# -> Int# -> Int16# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int32 "writeInt32OffAddr#" GenPrimOp - Addr# -> Int# -> Int32# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int64 "writeInt64OffAddr#" GenPrimOp - Addr# -> Int# -> Int64# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word8 "writeWord8OffAddr#" GenPrimOp - Addr# -> Int# -> Word8# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word16 "writeWord16OffAddr#" GenPrimOp - Addr# -> Int# -> Word16# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word32 "writeWord32OffAddr#" GenPrimOp - Addr# -> Int# -> Word32# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word64 "writeWord64OffAddr#" GenPrimOp - Addr# -> Int# -> Word64# -> State# s -> State# s - with has_side_effects = True - can_fail = True +#include "addr-access-ops.txt.pp" primop InterlockedExchange_Addr "atomicExchangeAddrAddr#" GenPrimOp Addr# -> Addr# -> State# s -> (# State# s, Addr# #) ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -32,6 +32,17 @@ primopsSource = "compiler/GHC/Builtin/primops.txt.pp" primopsTxt :: Stage -> FilePath primopsTxt stage = buildDir (vanillaContext stage compiler) -/- "primops.txt" +accessOpsSource :: FilePath +accessOpsSource = "compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py" + +byteArrayAccessOpsTxt :: Stage -> FilePath +byteArrayAccessOpsTxt stage + = buildDir (vanillaContext stage compiler) -/- "bytearray-access-ops.txt.pp" + +addrAccessOpsTxt :: Stage -> FilePath +addrAccessOpsTxt stage + = buildDir (vanillaContext stage compiler) -/- "addr-access-ops.txt.pp" + isGeneratedCmmFile :: FilePath -> Bool isGeneratedCmmFile file = takeBaseName file == "AutoApply" @@ -142,8 +153,21 @@ generatePackageCode context@(Context stage pkg _ _) = do root -/- "**" -/- dir -/- "GHC/Platform/Host.hs" %> go generatePlatformHostHs when (pkg == compiler) $ do + let ba_ops_txt = root -/- byteArrayAccessOpsTxt stage + let addr_ops_txt = root -/- addrAccessOpsTxt stage + ba_ops_txt %> \file -> do + need [accessOpsSource] + runBuilder Python + [accessOpsSource, "bytearray-access-ops", file] + [] [] + addr_ops_txt %> \file -> do + need [accessOpsSource] + runBuilder Python + [accessOpsSource, "addr-access-ops", file] + [] [] root -/- primopsTxt stage %> \file -> do - need $ [primopsSource] + need $ [primopsSource, ba_ops_txt, addr_ops_txt] + -- ba_ops_txt and addr_ops_txt get #include-d build $ target context HsCpp [primopsSource] [file] when (pkg == rts) $ do ===================================== rts/gen_event_types.py ===================================== @@ -157,7 +157,7 @@ def generate_event_types_array() -> str: pr = lambda s: x.append(s) pr('/*') - pr(' * Do not edit: This file is generated by event_types.py') + pr(' * Do not edit: This file is generated by gen_event_types.py') pr(' */') pr('') pr('EventType eventTypes[] = {') @@ -184,7 +184,7 @@ def generate_event_types_defines() -> str: pr = lambda s: x.append(s) pr('/*') - pr(' * Do not edit: This file is generated by event_types.py') + pr(' * Do not edit: This file is generated by gen_event_types.py') pr(' */') pr('') pr('#pragma once') View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/54b83253e6a02e6a3d01caecc78e4c3ad9c00934 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/54b83253e6a02e6a3d01caecc78e4c3ad9c00934 You're receiving 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 Jun 6 17:00:23 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 06 Jun 2023 13:00:23 -0400 Subject: [Git][ghc/ghc][master] ghcup-metadata: Only add Nightly tag when replacing LatestNightly Message-ID: <647f66271f557_1d329d5004d2b06505f7@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 1 changed file: - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py Changes: ===================================== .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py ===================================== @@ -264,7 +264,7 @@ def setNightlyTags(ghcup_metadata): for version in ghcup_metadata['ghcupDownloads']['GHC']: if "LatestNightly" in ghcup_metadata['ghcupDownloads']['GHC'][version]["viTags"]: ghcup_metadata['ghcupDownloads']['GHC'][version]["viTags"].remove("LatestNightly") - ghcup_metadata['ghcupDownloads']['GHC'][version]["viTags"].append("Nightly") + ghcup_metadata['ghcupDownloads']['GHC'][version]["viTags"].append("Nightly") View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ecadbc7e7eda5b854b7dcbff7f1dee2dd2c0883c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ecadbc7e7eda5b854b7dcbff7f1dee2dd2c0883c You're receiving 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 Jun 6 19:47:52 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Tue, 06 Jun 2023 15:47:52 -0400 Subject: [Git][ghc/ghc][wip/core-lint-let] Core Lint: distinguish let and letrec in locations Message-ID: <647f8d6855ebe_1d329d598ae3106846ac@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/core-lint-let at Glasgow Haskell Compiler / GHC Commits: 9c4efac0 by Krzysztof Gogolewski at 2023-06-06T21:47:05+02:00 Core Lint: distinguish let and letrec in locations Lint messages were saying "in the body of letrec" even for non-recursive let. I've also renamed BodyOfLetRec to BodyOfLet in stg, since there's no separate letrec. - - - - - 3 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Stg/Lint.hs - testsuite/tests/corelint/T21115b.stderr Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -558,9 +558,9 @@ lintRecBindings top_lvl pairs thing_inside ; lintLetBind top_lvl Recursive bndr' rhs rhs_ty ; return ue } -lintLetBody :: [LintedId] -> CoreExpr -> LintM (LintedType, UsageEnv) -lintLetBody bndrs body - = do { (body_ty, body_ue) <- addLoc (BodyOfLetRec bndrs) (lintCoreExpr body) +lintLetBody :: LintLocInfo -> [LintedId] -> CoreExpr -> LintM (LintedType, UsageEnv) +lintLetBody loc bndrs body + = do { (body_ty, body_ue) <- addLoc loc (lintCoreExpr body) ; mapM_ (lintJoinBndrType body_ty) bndrs ; return (body_ty, body_ue) } @@ -892,7 +892,7 @@ lintCoreExpr (Let (NonRec tv (Type ty)) body) -- Now extend the substitution so we -- take advantage of it in the body ; extendTvSubstL tv ty' $ - addLoc (BodyOfLetRec [tv]) $ + addLoc (BodyOfLet tv) $ lintCoreExpr body } } lintCoreExpr (Let (NonRec bndr rhs) body) @@ -904,7 +904,7 @@ lintCoreExpr (Let (NonRec bndr rhs) body) -- Now lint the binder ; lintBinder LetBind bndr $ \bndr' -> do { lintLetBind NotTopLevel NonRecursive bndr' rhs rhs_ty - ; addAliasUE bndr let_ue (lintLetBody [bndr'] body) } } + ; addAliasUE bndr let_ue (lintLetBody (BodyOfLet bndr') [bndr'] body) } } | otherwise = failWithL (mkLetErr bndr rhs) -- Not quite accurate @@ -924,7 +924,7 @@ lintCoreExpr e@(Let (Rec pairs) body) -- See Note [Multiplicity of let binders] in Var ; ((body_type, body_ue), ues) <- lintRecBindings NotTopLevel pairs $ \ bndrs' -> - lintLetBody bndrs' body + lintLetBody (BodyOfLetRec bndrs') bndrs' body ; return (body_type, body_ue `addUE` scaleUE ManyTy (foldr1 addUE ues)) } where bndrs = map fst pairs @@ -3074,6 +3074,7 @@ data LintLocInfo | LambdaBodyOf Id -- The lambda-binder | RuleOf Id -- Rules attached to a binder | UnfoldingOf Id -- Unfolding of a binder + | BodyOfLet Id -- The let-bound variable | BodyOfLetRec [Id] -- One of the binders | CaseAlt CoreAlt -- Case alternative | CasePat CoreAlt -- The *pattern* of the case alternative @@ -3362,6 +3363,9 @@ dumpLoc (RuleOf b) dumpLoc (UnfoldingOf b) = (getSrcLoc b, text "In the unfolding of" <+> pp_binder b) +dumpLoc (BodyOfLet b) + = (noSrcLoc, text "In the body of let with binder" <+> pp_binder b) + dumpLoc (BodyOfLetRec []) = (noSrcLoc, text "In body of a letrec with no binders") ===================================== compiler/GHC/Stg/Lint.hs ===================================== @@ -283,13 +283,13 @@ lintStgExpr (StgOpApp _ args _) = lintStgExpr (StgLet _ binds body) = do binders <- lintStgBinds NotTopLevel binds - addLoc (BodyOfLetRec binders) $ + addLoc (BodyOfLet binders) $ addInScopeVars binders $ lintStgExpr body lintStgExpr (StgLetNoEscape _ binds body) = do binders <- lintStgBinds NotTopLevel binds - addLoc (BodyOfLetRec binders) $ + addLoc (BodyOfLet binders) $ addInScopeVars binders $ lintStgExpr body @@ -446,7 +446,7 @@ data LintFlags = LintFlags { lf_unarised :: !Bool data LintLocInfo = RhsOf Id -- The variable bound | LambdaBodyOf [Id] -- The lambda-binder - | BodyOfLetRec [Id] -- One of the binders + | BodyOfLet [Id] -- One of the binders dumpLoc :: LintLocInfo -> (SrcSpan, SDoc) dumpLoc (RhsOf v) = @@ -454,8 +454,8 @@ dumpLoc (RhsOf v) = dumpLoc (LambdaBodyOf bs) = (srcLocSpan (getSrcLoc (head bs)), text " [in body of lambda with binders " <> pp_binders bs <> char ']' ) -dumpLoc (BodyOfLetRec bs) = - (srcLocSpan (getSrcLoc (head bs)), text " [in body of letrec with binders " <> pp_binders bs <> char ']' ) +dumpLoc (BodyOfLet bs) = + (srcLocSpan (getSrcLoc (head bs)), text " [in body of let with binders " <> pp_binders bs <> char ']' ) pp_binders :: [Id] -> SDoc ===================================== testsuite/tests/corelint/T21115b.stderr ===================================== @@ -4,8 +4,8 @@ T21115b.hs:9:1: warning: scrut ds In the RHS of foo :: Double# -> Int# In the body of lambda with binder ds :: Double# - In the body of letrec with binders fail :: (# #) -> Int# - In the body of letrec with binders fail :: (# #) -> Int# + In the body of let with binder fail :: (# #) -> Int# + In the body of let with binder fail :: (# #) -> Int# Substitution: From gitlab at gitlab.haskell.org Tue Jun 6 20:21:22 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Tue, 06 Jun 2023 16:21:22 -0400 Subject: [Git][ghc/ghc][wip/no-stub-dir-include] Include -haddock in DynFlags fingerprint Message-ID: <647f954232c50_1d329d5a288e08688585@gitlab.mail> Finley McIlwaine pushed to branch wip/no-stub-dir-include at Glasgow Haskell Compiler / GHC Commits: e7c862d0 by Finley McIlwaine at 2023-06-06T14:20:58-06:00 Include -haddock in DynFlags fingerprint The -haddock flag determines whether or not the resulting .hi files contain haddock documentation strings. If the existing .hi files do not contain haddock documentation strings and the user requests them, we should recompile. - - - - - 1 changed file: - compiler/GHC/Iface/Recomp/Flags.hs Changes: ===================================== compiler/GHC/Iface/Recomp/Flags.hs ===================================== @@ -67,7 +67,10 @@ fingerprintDynFlags hsc_env this_mod nameio = ticky = map (`gopt` dflags) [Opt_Ticky, Opt_Ticky_Allocd, Opt_Ticky_LNE, Opt_Ticky_Dyn_Thunk, Opt_Ticky_Tag] - flags = ((mainis, safeHs, lang, cpp), (paths, prof, ticky, debugLevel, callerCcFilters)) + -- Haddock + haddock = Opt_Haddock `gopt` dflags + + flags = ((mainis, safeHs, lang, cpp), (paths, prof, ticky, haddock, debugLevel, callerCcFilters)) in -- pprTrace "flags" (ppr flags) $ computeFingerprint nameio flags View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e7c862d0959d47e46c1b9edea2833b3b15678f91 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e7c862d0959d47e46c1b9edea2833b3b15678f91 You're receiving 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 Jun 6 22:03:11 2023 From: gitlab at gitlab.haskell.org (Oleg Grenrus (@phadej)) Date: Tue, 06 Jun 2023 18:03:11 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/hide-typelits-internals Message-ID: <647fad1f1976d_1d329d5a476dc8707521@gitlab.mail> Oleg Grenrus pushed new branch wip/hide-typelits-internals at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/hide-typelits-internals You're receiving 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 Jun 7 07:09:00 2023 From: gitlab at gitlab.haskell.org (Oleg Grenrus (@phadej)) Date: Wed, 07 Jun 2023 03:09:00 -0400 Subject: [Git][ghc/ghc][wip/hide-typelits-internals] Hide GHC.TypeLits/Nats.Internal in other-modules Message-ID: <64802d0cab267_1d329d5a4ac7847766e9@gitlab.mail> Oleg Grenrus pushed to branch wip/hide-typelits-internals at Glasgow Haskell Compiler / GHC Commits: 10ec0db7 by Oleg Grenrus at 2023-06-07T10:08:50+03:00 Hide GHC.TypeLits/Nats.Internal in other-modules - - - - - 2 changed files: - libraries/base/base.cabal - testsuite/tests/ghci/scripts/T9181.stdout Changes: ===================================== libraries/base/base.cabal ===================================== @@ -286,9 +286,7 @@ Library GHC.TopHandler GHC.TypeError GHC.TypeLits - GHC.TypeLits.Internal GHC.TypeNats - GHC.TypeNats.Internal GHC.Unicode GHC.Weak GHC.Weak.Finalize @@ -352,6 +350,8 @@ Library GHC.Event.PSQ GHC.Event.Unique GHC.Foreign.Internal + GHC.TypeLits.Internal + GHC.TypeNats.Internal -- GHC.IOPort -- TODO: hide again after debug GHC.Unicode.Internal.Bits GHC.Unicode.Internal.Char.DerivedCoreProperties ===================================== testsuite/tests/ghci/scripts/T9181.stdout ===================================== @@ -115,14 +115,15 @@ type (Data.Type.Ord.<=?) :: forall k. k -> k -> Bool type (Data.Type.Ord.<=?) m n = Data.Type.Ord.OrdCond (Data.Type.Ord.Compare m n) True True False :: Bool -type GHC.TypeLits.Internal.CmpChar :: Char -> Char -> Ordering -type family GHC.TypeLits.Internal.CmpChar a b -type GHC.TypeNats.Internal.CmpNat :: GHC.Num.Natural.Natural - -> GHC.Num.Natural.Natural -> Ordering -type family GHC.TypeNats.Internal.CmpNat a b -type GHC.TypeLits.Internal.CmpSymbol :: GHC.Types.Symbol - -> GHC.Types.Symbol -> Ordering -type family GHC.TypeLits.Internal.CmpSymbol a b +type base-4.18.0.0:GHC.TypeLits.Internal.CmpChar :: Char + -> Char -> Ordering +type family base-4.18.0.0:GHC.TypeLits.Internal.CmpChar a b +type base-4.18.0.0:GHC.TypeNats.Internal.CmpNat :: GHC.Num.Natural.Natural + -> GHC.Num.Natural.Natural -> Ordering +type family base-4.18.0.0:GHC.TypeNats.Internal.CmpNat a b +type base-4.18.0.0:GHC.TypeLits.Internal.CmpSymbol :: GHC.Types.Symbol + -> GHC.Types.Symbol -> Ordering +type family base-4.18.0.0:GHC.TypeLits.Internal.CmpSymbol a b type GHC.TypeNats.Div :: GHC.Num.Natural.Natural -> GHC.Num.Natural.Natural -> GHC.Num.Natural.Natural type family GHC.TypeNats.Div a b View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/10ec0db72ef6da42f097cd20aed3a90694eef764 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/10ec0db72ef6da42f097cd20aed3a90694eef764 You're receiving 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 Jun 7 07:23:02 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Wed, 07 Jun 2023 03:23:02 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/modern-STV-extension-shuffling] Extension shuffling (#23291) Message-ID: <64803056a033f_1d329d5a288e08777778@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/modern-STV-extension-shuffling at Glasgow Haskell Compiler / GHC Commits: 83a32273 by Andrei Borzenkov at 2023-06-07T11:22:35+04:00 Extension shuffling (#23291) Where introduced 3 new extensions: - PatternSignatures - ExtendedForAllScope - MethodTypeVariables Tasks of ScopedTypeVariables extension were distributed between PatternSignatures, ExtendedForAllScope and MethodTypeVariables according to the proposal. Now ScopedTypeVaribles only implies these three exntesions. - - - - - 29 changed files: - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/expected-undocumented-flags.txt - docs/users_guide/exts/explicit_forall.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/scoped_type_variables.rst - docs/users_guide/exts/type_abstractions.rst - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - testsuite/tests/driver/T4437.hs - testsuite/tests/rename/should_fail/T11663.stderr - testsuite/tests/showIface/DocsInHiFile1.stdout - testsuite/tests/showIface/DocsInHiFileTH.stdout - testsuite/tests/showIface/HaddockIssue849.stdout - testsuite/tests/showIface/HaddockOpts.stdout - testsuite/tests/showIface/LanguageExts.stdout - testsuite/tests/showIface/MagicHashInHaddocks.stdout - testsuite/tests/showIface/NoExportList.stdout - testsuite/tests/showIface/PragmaDocs.stdout - testsuite/tests/showIface/ReExports.stdout - testsuite/tests/typecheck/should_fail/PatSynExistential.stderr Changes: ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -1417,7 +1417,13 @@ languageExtensions (Just GHC2021) LangExt.PostfixOperators, LangExt.RankNTypes, LangExt.ScopedTypeVariables, - LangExt.TypeAbstractions, -- implied by ScopedTypeVariables according to GHC Proposal #448 "Modern Scoped Type Variables" + + -- implied by ScopedTypeVariables according to GHC Proposal #448 "Modern Scoped Type Variables" + LangExt.TypeAbstractions, + LangExt.PatternSignatures, + LangExt.MethodTypeVariables, + LangExt.ExtendedForAllScope, + LangExt.StandaloneDeriving, LangExt.StandaloneKindSignatures, LangExt.TupleSections, ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2673,8 +2673,9 @@ xFlagsDeps = [ flagSpec "ParallelListComp" LangExt.ParallelListComp, flagSpec "PartialTypeSignatures" LangExt.PartialTypeSignatures, flagSpec "PatternGuards" LangExt.PatternGuards, - depFlagSpec' "PatternSignatures" LangExt.ScopedTypeVariables - (deprecatedForExtension "ScopedTypeVariables"), + flagSpec "PatternSignatures" LangExt.PatternSignatures, + flagSpec "MethodTypeVariables" LangExt.MethodTypeVariables, + flagSpec "ExtendedForAllScope" LangExt.ExtendedForAllScope, flagSpec "PatternSynonyms" LangExt.PatternSynonyms, flagSpec "PolyKinds" LangExt.PolyKinds, flagSpec "PolymorphicComponents" LangExt.RankNTypes, @@ -2767,6 +2768,9 @@ impliedXFlags -- In accordance with GHC Proposal #448 "Modern Scoped Type Variables" , (LangExt.ScopedTypeVariables, turnOn, LangExt.TypeAbstractions) + , (LangExt.ScopedTypeVariables, turnOn, LangExt.PatternSignatures) + , (LangExt.ScopedTypeVariables, turnOn, LangExt.MethodTypeVariables) + , (LangExt.ScopedTypeVariables, turnOn, LangExt.ExtendedForAllScope) , (LangExt.RebindableSyntax, turnOff, LangExt.ImplicitPrelude) -- NB: turn off! ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -819,9 +819,9 @@ enabled. For example, the following will be rejected: instance (Eq a => Show (Maybe a)) where ... This restriction is partly motivated by an unusual quirk of instance -declarations. Namely, if ScopedTypeVariables is enabled, then the type -variables from the top of an instance will scope over the bodies of the -instance methods, /even if the type variables are implicitly quantified/. +declarations. Namely, if MethodTypeVariables (implied by ScopedTypeVariables) is enabled, +then the type variables from the top of an instance will scope over the bodies +of the instance methods, /even if the type variables are implicitly quantified/. For example, GHC will accept the following: instance Monoid a => Monoid (Identity a) where @@ -841,20 +841,20 @@ Somewhat surprisingly, old versions of GHC would accept the instance above. Even though the `forall` only quantifies `a`, the outermost parentheses mean that the `forall` is nested, and per the forall-or-nothing rule, this means that implicit quantification would occur. Therefore, the `a` is explicitly -bound and the `b` is implicitly bound. Moreover, ScopedTypeVariables would -bring /both/ sorts of type variables into scope over the body of `m`. +bound and the `b` is implicitly bound. Moreover, MethodTypeVariables +would bring /both/ sorts of type variables into scope over the body of `m`. How utterly confusing! To avoid this sort of confusion, we simply disallow nested `forall`s in instance types, which makes things like the instance above become illegal. For the sake of consistency, we also disallow nested contexts, even though they -don't have the same strange interaction with ScopedTypeVariables. +don't have the same strange interaction with MethodTypeVariables. Just as we forbid nested `forall`s and contexts in normal instance declarations, we also forbid them in SPECIALISE instance pragmas (#18455). -Unlike normal instance declarations, ScopedTypeVariables don't have any impact -on SPECIALISE instance pragmas, but we use the same validity checks for -SPECIALISE instance pragmas anyway to be consistent. +Unlike normal instance declarations, MethodTypeVariables +don't have any impact on SPECIALISE instance pragmas, but we use the same +validity checks for SPECIALISE instance pragmas anyway to be consistent. ----- -- Wrinkle: Derived instances @@ -863,7 +863,7 @@ SPECIALISE instance pragmas anyway to be consistent. `deriving` clauses and standalone `deriving` declarations also permit bringing type variables into scope, either through explicit or implicit quantification. Unlike in the tops of instance declarations, however, one does not need to -enable ScopedTypeVariables for this to take effect. +enable MethodTypeVariables for this to take effect. Just as GHC forbids nested `forall`s in the top of instance declarations, it also forbids them in types involved with `deriving`: ===================================== compiler/GHC/Rename/Bind.hs ===================================== @@ -920,7 +920,8 @@ rnMethodBinds is_cls_decl cls ktv_names binds sigs -- Rename the bindings RHSs. Again there's an issue about whether the -- type variables from the class/instance head are in scope. -- Answer no in Haskell 2010, but yes if you have -XScopedTypeVariables - ; (binds'', bind_fvs) <- bindSigTyVarsFV ktv_names $ + -- or -XMethodTypeVariables + ; (binds'', bind_fvs) <- bindClassInstanceHeadTyVarsFV ktv_names $ do { binds_w_dus <- mapBagM (rnLBind (mkScopedTvFn other_sigs')) binds' ; let bind_fvs = foldr (\(_,_,fv1) fv2 -> fv1 `plusFV` fv2) emptyFVs binds_w_dus ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -31,7 +31,8 @@ module GHC.Rename.HsType ( -- Binding related stuff bindHsOuterTyVarBndrs, bindHsForAllTelescope, bindLHsTyVarBndr, bindLHsTyVarBndrs, WarnUnusedForalls(..), - rnImplicitTvOccs, bindSigTyVarsFV, bindHsQTyVars, + rnImplicitTvOccs, bindSigTyVarsFV, bindClassInstanceHeadTyVarsFV , + bindHsQTyVars, FreeKiTyVars, filterInScopeM, extractHsTyRdrTyVars, extractHsTyRdrTyVarsKindVars, extractHsTysRdrTyVars, extractRdrKindSigVars, @@ -150,20 +151,27 @@ rnHsPatSigType :: HsPatSigTypeScoping -> (HsPatSigType GhcRn -> RnM (a, FreeVars)) -> RnM (a, FreeVars) -- Used for --- - Pattern type signatures, which are only allowed with ScopedTypeVariables +-- - Pattern type signatures, which are only allowed with PatternSignatures -- - Signatures on binders in a RULE, which are allowed even if --- ScopedTypeVariables isn't enabled +-- PatternSignatures isn't enabled -- Wildcards are allowed -- -- See Note [Pattern signature binders and scoping] in GHC.Hs.Type rnHsPatSigType scoping ctx sig_ty thing_inside - = do { ty_sig_okay <- xoptM LangExt.ScopedTypeVariables + = do { ty_sig_okay <- xoptM LangExt.PatternSignatures + ; free_var_should_bind <- xoptM LangExt.ExtendedForAllScope ; checkErr ty_sig_okay (unexpectedPatSigTypeErr sig_ty) ; free_vars <- filterInScopeM (extractHsTyRdrTyVars pat_sig_ty) ; (nwc_rdrs', tv_rdrs) <- partition_nwcs free_vars ; let nwc_rdrs = nubN nwc_rdrs' implicit_bndrs = case scoping of - AlwaysBind -> tv_rdrs + AlwaysBind -> + -- `PatternSignatures` doesn't enable binding of + -- free type variables in pattern signatures. + -- That does `ExtendedForAllScope`. + if free_var_should_bind + then tv_rdrs + else [] NeverBind -> [] ; rnImplicitTvOccs Nothing implicit_bndrs $ \ imp_tvs -> do { (nwcs, pat_sig_ty', fvs1) <- rnWcBody ctx nwc_rdrs pat_sig_ty @@ -900,18 +908,25 @@ notInKinds _ _ = return () * * ***************************************************** -} -bindSigTyVarsFV :: [Name] - -> RnM (a, FreeVars) - -> RnM (a, FreeVars) -- Used just before renaming the defn of a function -- with a separate type signature, to bring its tyvars into scope --- With no -XScopedTypeVariables, this is a no-op +-- With no -XExtendedForAllScope/-XMethodTypeVariables, this is a no-op +bindSigTyVarsFV, bindClassInstanceHeadTyVarsFV :: [Name] + -> RnM (a, FreeVars) + -> RnM (a, FreeVars) + bindSigTyVarsFV tvs thing_inside - = do { scoped_tyvars <- xoptM LangExt.ScopedTypeVariables - ; if not scoped_tyvars then - thing_inside - else - bindLocalNamesFV tvs thing_inside } + = do { extended_for_all_scope <- xoptM LangExt.ExtendedForAllScope + ; if extended_for_all_scope + then bindLocalNamesFV tvs thing_inside + else thing_inside } + +bindClassInstanceHeadTyVarsFV tvs thing_inside + = do { method_type_variables <- xoptM LangExt.MethodTypeVariables + ; if method_type_variables + then bindLocalNamesFV tvs thing_inside + else thing_inside } + --------------- bindHsQTyVars :: forall a b. ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -198,7 +198,7 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls, -- (H) Rename Everything else - (rn_rule_decls, src_fvs2) <- setXOptM LangExt.ScopedTypeVariables $ + (rn_rule_decls, src_fvs2) <- setXOptM LangExt.PatternSignatures $ rnList rnHsRuleDecls rule_decls ; -- Inside RULES, scoped type variables are on (rn_foreign_decls, src_fvs3) <- rnList rnHsForeignDecl foreign_decls ; ===================================== compiler/GHC/Tc/Deriv.hs ===================================== @@ -273,7 +273,9 @@ renameDeriv inst_infos bagBinds setXOptM LangExt.EmptyCase $ -- Derived decls (for empty types) can have -- case x of {} - setXOptM LangExt.ScopedTypeVariables $ + setXOptM LangExt.MethodTypeVariables $ + setXOptM LangExt.PatternSignatures $ + setXOptM LangExt.ExtendedForAllScope $ setXOptM LangExt.KindSignatures $ -- Derived decls (for newtype-deriving) can use ScopedTypeVariables & -- KindSignatures ===================================== compiler/GHC/Tc/Deriv/Generate.hs ===================================== @@ -1875,9 +1875,9 @@ of the method. For example, recall: join In the example above, it is imperative that the `a` in the instance signature -for `join` scope over the body of `join` by way of ScopedTypeVariables. -This might sound obvious, but note that in gen_Newtype_binds, which is -responsible for generating the code above, the type in `join`'s instance +for `join` scope over the body of `join` by way of ExtendedForallScope (implied +by ScopedTypeVariables). This might sound obvious, but note that in gen_Newtype_binds, +which is responsible for generating the code above, the type in `join`'s instance signature is given as a Core type, whereas gen_Newtype_binds will eventually produce HsBinds (i.e., source Haskell) that is renamed and typechecked. We must ensure that `a` is in scope over the body of `join` during renaming ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1637,9 +1637,7 @@ instance Diagnostic TcRnMessage where nest 4 (text "in the section:" <+> quotes (ppr section))] TcRnUnexpectedPatSigType ty - -> mkSimpleDecorated $ - hang (text "Illegal type signature:" <+> quotes (ppr ty)) - 2 (text "Type signatures are only allowed in patterns with ScopedTypeVariables") + -> mkSimpleDecorated $ text "Illegal type signature:" <+> quotes (ppr ty) TcRnIllegalKindSignature ty -> mkSimpleDecorated $ text "Illegal kind signature:" <+> quotes (ppr ty) @@ -3011,7 +3009,7 @@ instance Diagnostic TcRnMessage where TcRnSectionPrecedenceError{} -> noHints TcRnUnexpectedPatSigType{} - -> [suggestExtension LangExt.ScopedTypeVariables] + -> [suggestExtension LangExt.PatternSignatures] TcRnIllegalKindSignature{} -> [suggestExtension LangExt.KindSignatures] TcRnUnusedQuantifiedTypeVar{} ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -2381,7 +2381,7 @@ data TcRnMessage where -> TcRnMessage {-| TcRnUnexpectedPatSigType is an error occurring when there is - a type signature in a pattern without -XScopedTypeVariables extension + a type signature in a pattern without -XPatternSignatures extension Examples: f (a :: Bool) = ... ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -10,6 +10,11 @@ Language sized primitive literals, e.g. ``123#Int8`` is a literal of type ``Int8#``. See the GHC proposal `#451 `_. +- :extension:`ScopedTypeVariables` was split into several new extensions: + :extension:`PatternSignatures`, :extension:`ExtendedForAllScope`, :extension:`MethodTypeVariables`. + You can set :extension:`ScopedTypeVariables` to enable them all or enable them individually + for more fine-grained control of features that you want to have. + Compiler ~~~~~~~~ ===================================== docs/users_guide/expected-undocumented-flags.txt ===================================== @@ -14,7 +14,6 @@ -XMonomorphismRestriction -XParallelArrays -XPatternGuards --XPatternSignatures -XPolymorphicComponents -XRecordPuns -XRelaxedLayout ===================================== docs/users_guide/exts/explicit_forall.rst ===================================== @@ -114,7 +114,7 @@ The ``forall``-or-nothing rule takes effect in the following places: Notes: -- :ref:`pattern-type-sigs` are a notable example of a place where +- :extension:`PatternSignatures` are a notable example of a place where types do *not* obey the ``forall``-or-nothing rule. For example, GHC will accept the following: :: ===================================== docs/users_guide/exts/gadt.rst ===================================== @@ -194,7 +194,7 @@ also sets :extension:`GADTSyntax` and :extension:`MonoLocalBinds`. In the function clause for ``g``, GHC first checks ``MkF``, the outermost pattern, followed by the inner ``Nothing`` pattern. This outside-in order - can interact somewhat counterintuitively with :ref:`pattern-type-sigs`. + can interact somewhat counterintuitively with :extension:`PatternSignatures`. Consider the following variation of ``g``: :: g2 :: F a a -> a ===================================== docs/users_guide/exts/scoped_type_variables.rst ===================================== @@ -6,9 +6,13 @@ Lexically scoped type variables =============================== .. extension:: ScopedTypeVariables - :shortdesc: Enable lexically-scoped type variables. + :shortdesc: Enable lexically-scoped type variables everywhere. - :implies: :extension:`ExplicitForAll` + :implies: :extension:`ExplicitForAll`, + :extension:`PatternSignatures`, + :extension:`ExtendedForAllScope`, + :extension:`MethodTypeVariables`, + :extension:`TypeAbstractions` :since: 6.8.1 @@ -26,7 +30,7 @@ Lexically scoped type variables To trigger those forms of :extension:`ScopedTypeVariables`, the ``forall`` must appear against the top-level signature (or outer expression) but *not* against nested signatures referring to the same type variables. - Explicit ``forall`` is not always required -- see :ref:`pattern signature equivalent ` for the example in this section, or :ref:`pattern-type-sigs`. + Explicit ``forall`` is not always required -- see :ref:`pattern signature equivalent ` for the example in this section, or :extension:`PatternSignatures`. GHC supports *lexically scoped type variables*, without which some type signatures are simply impossible to write. For example: :: @@ -48,7 +52,7 @@ possible to do so. .. _pattern-equiv-form: -An equivalent form for that example, avoiding explicit ``forall`` uses :ref:`pattern-type-sigs`: :: +An equivalent form for that example, avoiding explicit ``forall`` uses :extension:`PatternSignatures`: :: f :: [a] -> [a] f (xs :: [aa]) = xs ++ ys @@ -84,9 +88,9 @@ A *lexically scoped type variable* can be bound by: - An expression type signature (:ref:`exp-type-sigs`) -- A pattern type signature (:ref:`pattern-type-sigs`) +- A pattern type signature (:extension:`PatternSignatures`) -- Class and instance declarations (:ref:`cls-inst-scoped-tyvars`) +- Class and instance declarations (:extension:`MethodTypeVariables`) In Haskell, a programmer-written type signature is implicitly quantified over its free type variables (`Section @@ -100,14 +104,31 @@ scope is *not* universally quantified. For example, if type variable (e :: b -> b) means (e :: forall b. b->b) (e :: a -> b) means (e :: forall b. a->b) +Extended ForAll Scope +===================== + +.. extension:: ExtendedForAllScope + :shortdesc: Enable lexically-scoped type variables in function bindings, + pattern synonyms and expression type signatures. + + :since: 9.8.1 + + :implied by: :extension:`ScopedTypeVariables` + + :status: Included in :extension:`GHC2021` + + Enable lexical scoping of type variables explicitly introduced with + a ``forall`` in function bindings, pattern synonyms and expression type signatures. + .. _decl-type-sigs: Declaration type signatures --------------------------- -A declaration type signature that has *explicit* quantification (using -``forall``) brings into scope the explicitly-quantified type variables, -in the definition of the named function. For example: :: +When :extension:`ExtendedForAllScope` is enabled, a declaration type signature +that has *explicit* quantification (using ``forall``) brings into scope the +explicitly-quantified type variables, in the definition of the named function. +For example: :: f :: forall a. [a] -> [a] f (x:xs) = xs ++ [ x :: a ] @@ -171,9 +192,9 @@ This only happens if: Expression type signatures -------------------------- -An expression type signature that has *explicit* quantification (using -``forall``) brings into scope the explicitly-quantified type variables, -in the annotated expression. For example: :: +When :extension:`ExtendedForAllScope` is enabled, an expression type signature +that has *explicit* quantification (using ``forall``) brings into scope the +explicitly-quantified type variables, in the annotated expression. For example: :: f = runST ( (op >>= \(x :: STRef s Int) -> g x) :: forall s. ST s Bool ) @@ -181,13 +202,22 @@ Here, the type signature ``forall s. ST s Bool`` brings the type variable ``s`` into scope, in the annotated expression ``(op >>= \(x :: STRef s Int) -> g x)``. -.. _pattern-type-sigs: +Pattern Signatures +================== + +.. extension:: PatternSignatures + :shortdesc: Allow type signatures in patterns. -Pattern type signatures ------------------------ + :since: 9.8.1 -A type signature may occur in any pattern; this is a *pattern type -signature*. For example: :: + :implied by: :extension:`ScopedTypeVariables` + + :status: Included in :extension:`GHC2021` + + Allow type signatures and type variable bindings in patterns. + +When :extension:`PatternSignatures` is enabled, a type signature may occur +in any pattern; this is a *pattern type signature*. For example: :: -- f and g assume that 'a' is already in scope f = \(x::Int, y::a) -> x @@ -259,12 +289,21 @@ they are both legal whether or not ``a`` is already in scope. They differ in that *if* ``a`` is already in scope, the signature constrains the pattern, rather than the pattern binding the variable. -.. _cls-inst-scoped-tyvars: +Method Type Variables +===================== + +.. extension:: MethodTypeVariables + :shortdesc: Enable lexically-scoped type variables in class and instance declarations. + + :since: 9.8.1 + + :implied by: :extension:`ScopedTypeVariables` + + :status: Included in :extension:`GHC2021` -Class and instance declarations -------------------------------- + Enable lexical scoping of type variables explicitly introduced by class and instance heads. -:extension:`ScopedTypeVariables` allow the type variables bound by the top of a +:extension:`MethodTypeVariables` allow the type variables bound by the top of a ``class`` or ``instance`` declaration to scope over the methods defined in the ``where`` part. Unlike :ref:`decl-type-sigs`, type variables from class and instance declarations can be lexically scoped without an explicit ``forall`` @@ -286,11 +325,11 @@ declaration; see :ref:`explicit-foralls`). For example: :: instance forall b. C b => C [b] where op xs = reverse (head (xs :: [[b]])) -While :extension:`ScopedTypeVariables` is required for type variables from the +While :extension:`MethodTypeVariables` is required for type variables from the top of a class or instance declaration to scope over the /bodies/ of the methods, it is not required for the type variables to scope over the /type signatures/ of the methods. For example, the following will be accepted without -explicitly enabling :extension:`ScopedTypeVariables`: :: +explicitly enabling :extension:`MethodTypeVariables`: :: class D a where m :: [a] -> a @@ -302,11 +341,11 @@ explicitly enabling :extension:`ScopedTypeVariables`: :: Note that writing ``m :: [a] -> [a]`` requires the use of the :extension:`InstanceSigs` extension. -Similarly, :extension:`ScopedTypeVariables` is not required for type variables +Similarly, :extension:`MethodTypeVariables` is not required for type variables from the top of the class or instance declaration to scope over associated type families, which only requires the :extension:`TypeFamilies` extension. For instance, the following will be accepted without explicitly enabling -:extension:`ScopedTypeVariables`: :: +:extension:`MethodTypeVariables`: :: class E a where type T a ===================================== docs/users_guide/exts/type_abstractions.rst ===================================== @@ -6,6 +6,8 @@ Type abstractions :since: 9.8.1 + :implied by: :extension:`ScopedTypeVariables` + :status: Partially implemented Allow the use of type abstraction syntax. ===================================== libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs ===================================== @@ -153,6 +153,9 @@ data Extension | OverloadedRecordUpdate | TypeAbstractions | ExtendedLiterals + | PatternSignatures + | ExtendedForAllScope + | MethodTypeVariables deriving (Eq, Enum, Show, Generic, Bounded) -- 'Ord' and 'Bounded' are provided for GHC API users (see discussions -- in https://gitlab.haskell.org/ghc/ghc/merge_requests/2707 and ===================================== testsuite/tests/driver/T4437.hs ===================================== @@ -38,7 +38,9 @@ check title expected got expectedGhcOnlyExtensions :: [String] expectedGhcOnlyExtensions = [ "TypeAbstractions", - "ExtendedLiterals" + "ExtendedLiterals", + "MethodTypeVariables", + "ExtendedForAllScope" ] expectedCabalOnlyExtensions :: [String] ===================================== testsuite/tests/rename/should_fail/T11663.stderr ===================================== @@ -1,20 +1,16 @@ T11663.hs:6:12: error: [GHC-74097] Illegal type signature: ‘Int’ - Type signatures are only allowed in patterns with ScopedTypeVariables - Suggested fix: Perhaps you intended to use ScopedTypeVariables + Suggested fix: Perhaps you intended to use PatternSignatures T11663.hs:7:9: error: [GHC-74097] Illegal type signature: ‘Int’ - Type signatures are only allowed in patterns with ScopedTypeVariables - Suggested fix: Perhaps you intended to use ScopedTypeVariables + Suggested fix: Perhaps you intended to use PatternSignatures T11663.hs:8:22: error: [GHC-74097] Illegal type signature: ‘Int’ - Type signatures are only allowed in patterns with ScopedTypeVariables - Suggested fix: Perhaps you intended to use ScopedTypeVariables + Suggested fix: Perhaps you intended to use PatternSignatures T11663.hs:9:32: error: [GHC-74097] Illegal type signature: ‘Int’ - Type signatures are only allowed in patterns with ScopedTypeVariables - Suggested fix: Perhaps you intended to use ScopedTypeVariables + Suggested fix: Perhaps you intended to use PatternSignatures ===================================== testsuite/tests/showIface/DocsInHiFile1.stdout ===================================== @@ -144,5 +144,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/DocsInHiFileTH.stdout ===================================== @@ -287,5 +287,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/HaddockIssue849.stdout ===================================== @@ -67,5 +67,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/HaddockOpts.stdout ===================================== @@ -59,5 +59,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/LanguageExts.stdout ===================================== @@ -23,4 +23,3 @@ docs: CUSKs FieldSelectors extensible fields: - ===================================== testsuite/tests/showIface/MagicHashInHaddocks.stdout ===================================== @@ -69,5 +69,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/NoExportList.stdout ===================================== @@ -95,5 +95,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/PragmaDocs.stdout ===================================== @@ -69,5 +69,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/ReExports.stdout ===================================== @@ -66,5 +66,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/typecheck/should_fail/PatSynExistential.stderr ===================================== @@ -1,4 +1,5 @@ -PatSynExistential.hs:6:1: [GHC-33973] - The result type of the signature for ‘P’, namely ‘x -> Maybe x’ + +PatSynExistential.hs:6:1: error: [GHC-33973] + • The result type of the signature for ‘P’, namely ‘x -> Maybe x’ mentions existential type variable ‘x’ - In the declaration for pattern synonym ‘P’ + • In the declaration for pattern synonym ‘P’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/83a32273ddca0d6c85db846be5e8fe9a37435d4d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/83a32273ddca0d6c85db846be5e8fe9a37435d4d You're receiving 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 Jun 7 08:08:36 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Wed, 07 Jun 2023 04:08:36 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/modern-STV-extension-shuffling] Extension shuffling (#23291) Message-ID: <64803b04318ef_1d329d5a0a2cb07867f5@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/modern-STV-extension-shuffling at Glasgow Haskell Compiler / GHC Commits: 979366a1 by Andrei Borzenkov at 2023-06-07T12:08:15+04:00 Extension shuffling (#23291) Where introduced 3 new extensions: - PatternSignatures - ExtendedForAllScope - MethodTypeVariables Tasks of ScopedTypeVariables extension were distributed between PatternSignatures, ExtendedForAllScope and MethodTypeVariables according to the proposal. Now ScopedTypeVaribles only implies these three exntesions. - - - - - 29 changed files: - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/expected-undocumented-flags.txt - docs/users_guide/exts/explicit_forall.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/scoped_type_variables.rst - docs/users_guide/exts/type_abstractions.rst - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - testsuite/tests/driver/T4437.hs - testsuite/tests/rename/should_fail/T11663.stderr - testsuite/tests/showIface/DocsInHiFile1.stdout - testsuite/tests/showIface/DocsInHiFileTH.stdout - testsuite/tests/showIface/HaddockIssue849.stdout - testsuite/tests/showIface/HaddockOpts.stdout - testsuite/tests/showIface/LanguageExts.stdout - testsuite/tests/showIface/MagicHashInHaddocks.stdout - testsuite/tests/showIface/NoExportList.stdout - testsuite/tests/showIface/PragmaDocs.stdout - testsuite/tests/showIface/ReExports.stdout - testsuite/tests/typecheck/should_fail/PatSynExistential.stderr Changes: ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -1417,7 +1417,13 @@ languageExtensions (Just GHC2021) LangExt.PostfixOperators, LangExt.RankNTypes, LangExt.ScopedTypeVariables, - LangExt.TypeAbstractions, -- implied by ScopedTypeVariables according to GHC Proposal #448 "Modern Scoped Type Variables" + + -- implied by ScopedTypeVariables according to GHC Proposal #448 "Modern Scoped Type Variables" + LangExt.TypeAbstractions, + LangExt.PatternSignatures, + LangExt.MethodTypeVariables, + LangExt.ExtendedForAllScope, + LangExt.StandaloneDeriving, LangExt.StandaloneKindSignatures, LangExt.TupleSections, ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2673,8 +2673,9 @@ xFlagsDeps = [ flagSpec "ParallelListComp" LangExt.ParallelListComp, flagSpec "PartialTypeSignatures" LangExt.PartialTypeSignatures, flagSpec "PatternGuards" LangExt.PatternGuards, - depFlagSpec' "PatternSignatures" LangExt.ScopedTypeVariables - (deprecatedForExtension "ScopedTypeVariables"), + flagSpec "PatternSignatures" LangExt.PatternSignatures, + flagSpec "MethodTypeVariables" LangExt.MethodTypeVariables, + flagSpec "ExtendedForAllScope" LangExt.ExtendedForAllScope, flagSpec "PatternSynonyms" LangExt.PatternSynonyms, flagSpec "PolyKinds" LangExt.PolyKinds, flagSpec "PolymorphicComponents" LangExt.RankNTypes, @@ -2767,6 +2768,9 @@ impliedXFlags -- In accordance with GHC Proposal #448 "Modern Scoped Type Variables" , (LangExt.ScopedTypeVariables, turnOn, LangExt.TypeAbstractions) + , (LangExt.ScopedTypeVariables, turnOn, LangExt.PatternSignatures) + , (LangExt.ScopedTypeVariables, turnOn, LangExt.MethodTypeVariables) + , (LangExt.ScopedTypeVariables, turnOn, LangExt.ExtendedForAllScope) , (LangExt.RebindableSyntax, turnOff, LangExt.ImplicitPrelude) -- NB: turn off! ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -819,9 +819,9 @@ enabled. For example, the following will be rejected: instance (Eq a => Show (Maybe a)) where ... This restriction is partly motivated by an unusual quirk of instance -declarations. Namely, if ScopedTypeVariables is enabled, then the type -variables from the top of an instance will scope over the bodies of the -instance methods, /even if the type variables are implicitly quantified/. +declarations. Namely, if MethodTypeVariables (implied by ScopedTypeVariables) is enabled, +then the type variables from the top of an instance will scope over the bodies +of the instance methods, /even if the type variables are implicitly quantified/. For example, GHC will accept the following: instance Monoid a => Monoid (Identity a) where @@ -841,20 +841,20 @@ Somewhat surprisingly, old versions of GHC would accept the instance above. Even though the `forall` only quantifies `a`, the outermost parentheses mean that the `forall` is nested, and per the forall-or-nothing rule, this means that implicit quantification would occur. Therefore, the `a` is explicitly -bound and the `b` is implicitly bound. Moreover, ScopedTypeVariables would -bring /both/ sorts of type variables into scope over the body of `m`. +bound and the `b` is implicitly bound. Moreover, MethodTypeVariables +would bring /both/ sorts of type variables into scope over the body of `m`. How utterly confusing! To avoid this sort of confusion, we simply disallow nested `forall`s in instance types, which makes things like the instance above become illegal. For the sake of consistency, we also disallow nested contexts, even though they -don't have the same strange interaction with ScopedTypeVariables. +don't have the same strange interaction with MethodTypeVariables. Just as we forbid nested `forall`s and contexts in normal instance declarations, we also forbid them in SPECIALISE instance pragmas (#18455). -Unlike normal instance declarations, ScopedTypeVariables don't have any impact -on SPECIALISE instance pragmas, but we use the same validity checks for -SPECIALISE instance pragmas anyway to be consistent. +Unlike normal instance declarations, MethodTypeVariables +don't have any impact on SPECIALISE instance pragmas, but we use the same +validity checks for SPECIALISE instance pragmas anyway to be consistent. ----- -- Wrinkle: Derived instances @@ -863,7 +863,7 @@ SPECIALISE instance pragmas anyway to be consistent. `deriving` clauses and standalone `deriving` declarations also permit bringing type variables into scope, either through explicit or implicit quantification. Unlike in the tops of instance declarations, however, one does not need to -enable ScopedTypeVariables for this to take effect. +enable MethodTypeVariables for this to take effect. Just as GHC forbids nested `forall`s in the top of instance declarations, it also forbids them in types involved with `deriving`: ===================================== compiler/GHC/Rename/Bind.hs ===================================== @@ -920,7 +920,8 @@ rnMethodBinds is_cls_decl cls ktv_names binds sigs -- Rename the bindings RHSs. Again there's an issue about whether the -- type variables from the class/instance head are in scope. -- Answer no in Haskell 2010, but yes if you have -XScopedTypeVariables - ; (binds'', bind_fvs) <- bindSigTyVarsFV ktv_names $ + -- or -XMethodTypeVariables + ; (binds'', bind_fvs) <- bindClassInstanceHeadTyVarsFV ktv_names $ do { binds_w_dus <- mapBagM (rnLBind (mkScopedTvFn other_sigs')) binds' ; let bind_fvs = foldr (\(_,_,fv1) fv2 -> fv1 `plusFV` fv2) emptyFVs binds_w_dus ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -31,7 +31,8 @@ module GHC.Rename.HsType ( -- Binding related stuff bindHsOuterTyVarBndrs, bindHsForAllTelescope, bindLHsTyVarBndr, bindLHsTyVarBndrs, WarnUnusedForalls(..), - rnImplicitTvOccs, bindSigTyVarsFV, bindHsQTyVars, + rnImplicitTvOccs, bindSigTyVarsFV, bindClassInstanceHeadTyVarsFV , + bindHsQTyVars, FreeKiTyVars, filterInScopeM, extractHsTyRdrTyVars, extractHsTyRdrTyVarsKindVars, extractHsTysRdrTyVars, extractRdrKindSigVars, @@ -150,20 +151,27 @@ rnHsPatSigType :: HsPatSigTypeScoping -> (HsPatSigType GhcRn -> RnM (a, FreeVars)) -> RnM (a, FreeVars) -- Used for --- - Pattern type signatures, which are only allowed with ScopedTypeVariables +-- - Pattern type signatures, which are only allowed with PatternSignatures -- - Signatures on binders in a RULE, which are allowed even if --- ScopedTypeVariables isn't enabled +-- PatternSignatures isn't enabled -- Wildcards are allowed -- -- See Note [Pattern signature binders and scoping] in GHC.Hs.Type rnHsPatSigType scoping ctx sig_ty thing_inside - = do { ty_sig_okay <- xoptM LangExt.ScopedTypeVariables + = do { ty_sig_okay <- xoptM LangExt.PatternSignatures + ; free_var_should_bind <- xoptM LangExt.ExtendedForAllScope ; checkErr ty_sig_okay (unexpectedPatSigTypeErr sig_ty) ; free_vars <- filterInScopeM (extractHsTyRdrTyVars pat_sig_ty) ; (nwc_rdrs', tv_rdrs) <- partition_nwcs free_vars ; let nwc_rdrs = nubN nwc_rdrs' implicit_bndrs = case scoping of - AlwaysBind -> tv_rdrs + AlwaysBind -> + -- `PatternSignatures` doesn't enable binding of + -- free type variables in pattern signatures. + -- That does `ExtendedForAllScope`. + if free_var_should_bind + then tv_rdrs + else [] NeverBind -> [] ; rnImplicitTvOccs Nothing implicit_bndrs $ \ imp_tvs -> do { (nwcs, pat_sig_ty', fvs1) <- rnWcBody ctx nwc_rdrs pat_sig_ty @@ -900,18 +908,25 @@ notInKinds _ _ = return () * * ***************************************************** -} -bindSigTyVarsFV :: [Name] - -> RnM (a, FreeVars) - -> RnM (a, FreeVars) -- Used just before renaming the defn of a function -- with a separate type signature, to bring its tyvars into scope --- With no -XScopedTypeVariables, this is a no-op +-- With no -XExtendedForAllScope/-XMethodTypeVariables, this is a no-op +bindSigTyVarsFV, bindClassInstanceHeadTyVarsFV :: [Name] + -> RnM (a, FreeVars) + -> RnM (a, FreeVars) + bindSigTyVarsFV tvs thing_inside - = do { scoped_tyvars <- xoptM LangExt.ScopedTypeVariables - ; if not scoped_tyvars then - thing_inside - else - bindLocalNamesFV tvs thing_inside } + = do { extended_for_all_scope <- xoptM LangExt.ExtendedForAllScope + ; if extended_for_all_scope + then bindLocalNamesFV tvs thing_inside + else thing_inside } + +bindClassInstanceHeadTyVarsFV tvs thing_inside + = do { method_type_variables <- xoptM LangExt.MethodTypeVariables + ; if method_type_variables + then bindLocalNamesFV tvs thing_inside + else thing_inside } + --------------- bindHsQTyVars :: forall a b. ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -198,7 +198,8 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls, -- (H) Rename Everything else - (rn_rule_decls, src_fvs2) <- setXOptM LangExt.ScopedTypeVariables $ + (rn_rule_decls, src_fvs2) <- setXOptM LangExt.PatternSignatures $ + setXOptM LangExt.ExtendedForAllScope $ rnList rnHsRuleDecls rule_decls ; -- Inside RULES, scoped type variables are on (rn_foreign_decls, src_fvs3) <- rnList rnHsForeignDecl foreign_decls ; ===================================== compiler/GHC/Tc/Deriv.hs ===================================== @@ -273,7 +273,9 @@ renameDeriv inst_infos bagBinds setXOptM LangExt.EmptyCase $ -- Derived decls (for empty types) can have -- case x of {} - setXOptM LangExt.ScopedTypeVariables $ + setXOptM LangExt.MethodTypeVariables $ + setXOptM LangExt.PatternSignatures $ + setXOptM LangExt.ExtendedForAllScope $ setXOptM LangExt.KindSignatures $ -- Derived decls (for newtype-deriving) can use ScopedTypeVariables & -- KindSignatures ===================================== compiler/GHC/Tc/Deriv/Generate.hs ===================================== @@ -1875,9 +1875,9 @@ of the method. For example, recall: join In the example above, it is imperative that the `a` in the instance signature -for `join` scope over the body of `join` by way of ScopedTypeVariables. -This might sound obvious, but note that in gen_Newtype_binds, which is -responsible for generating the code above, the type in `join`'s instance +for `join` scope over the body of `join` by way of ExtendedForallScope (implied +by ScopedTypeVariables). This might sound obvious, but note that in gen_Newtype_binds, +which is responsible for generating the code above, the type in `join`'s instance signature is given as a Core type, whereas gen_Newtype_binds will eventually produce HsBinds (i.e., source Haskell) that is renamed and typechecked. We must ensure that `a` is in scope over the body of `join` during renaming ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1637,9 +1637,7 @@ instance Diagnostic TcRnMessage where nest 4 (text "in the section:" <+> quotes (ppr section))] TcRnUnexpectedPatSigType ty - -> mkSimpleDecorated $ - hang (text "Illegal type signature:" <+> quotes (ppr ty)) - 2 (text "Type signatures are only allowed in patterns with ScopedTypeVariables") + -> mkSimpleDecorated $ text "Illegal type signature:" <+> quotes (ppr ty) TcRnIllegalKindSignature ty -> mkSimpleDecorated $ text "Illegal kind signature:" <+> quotes (ppr ty) @@ -3011,7 +3009,7 @@ instance Diagnostic TcRnMessage where TcRnSectionPrecedenceError{} -> noHints TcRnUnexpectedPatSigType{} - -> [suggestExtension LangExt.ScopedTypeVariables] + -> [suggestExtension LangExt.PatternSignatures] TcRnIllegalKindSignature{} -> [suggestExtension LangExt.KindSignatures] TcRnUnusedQuantifiedTypeVar{} ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -2381,7 +2381,7 @@ data TcRnMessage where -> TcRnMessage {-| TcRnUnexpectedPatSigType is an error occurring when there is - a type signature in a pattern without -XScopedTypeVariables extension + a type signature in a pattern without -XPatternSignatures extension Examples: f (a :: Bool) = ... ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -10,6 +10,11 @@ Language sized primitive literals, e.g. ``123#Int8`` is a literal of type ``Int8#``. See the GHC proposal `#451 `_. +- :extension:`ScopedTypeVariables` was split into several new extensions: + :extension:`PatternSignatures`, :extension:`ExtendedForAllScope`, :extension:`MethodTypeVariables`. + You can set :extension:`ScopedTypeVariables` to enable them all or enable them individually + for more fine-grained control of features that you want to have. + Compiler ~~~~~~~~ ===================================== docs/users_guide/expected-undocumented-flags.txt ===================================== @@ -14,7 +14,6 @@ -XMonomorphismRestriction -XParallelArrays -XPatternGuards --XPatternSignatures -XPolymorphicComponents -XRecordPuns -XRelaxedLayout ===================================== docs/users_guide/exts/explicit_forall.rst ===================================== @@ -114,7 +114,7 @@ The ``forall``-or-nothing rule takes effect in the following places: Notes: -- :ref:`pattern-type-sigs` are a notable example of a place where +- :extension:`PatternSignatures` are a notable example of a place where types do *not* obey the ``forall``-or-nothing rule. For example, GHC will accept the following: :: ===================================== docs/users_guide/exts/gadt.rst ===================================== @@ -194,7 +194,7 @@ also sets :extension:`GADTSyntax` and :extension:`MonoLocalBinds`. In the function clause for ``g``, GHC first checks ``MkF``, the outermost pattern, followed by the inner ``Nothing`` pattern. This outside-in order - can interact somewhat counterintuitively with :ref:`pattern-type-sigs`. + can interact somewhat counterintuitively with :extension:`PatternSignatures`. Consider the following variation of ``g``: :: g2 :: F a a -> a ===================================== docs/users_guide/exts/scoped_type_variables.rst ===================================== @@ -6,9 +6,13 @@ Lexically scoped type variables =============================== .. extension:: ScopedTypeVariables - :shortdesc: Enable lexically-scoped type variables. + :shortdesc: Enable lexically-scoped type variables everywhere. - :implies: :extension:`ExplicitForAll` + :implies: :extension:`ExplicitForAll`, + :extension:`PatternSignatures`, + :extension:`ExtendedForAllScope`, + :extension:`MethodTypeVariables`, + :extension:`TypeAbstractions` :since: 6.8.1 @@ -26,7 +30,7 @@ Lexically scoped type variables To trigger those forms of :extension:`ScopedTypeVariables`, the ``forall`` must appear against the top-level signature (or outer expression) but *not* against nested signatures referring to the same type variables. - Explicit ``forall`` is not always required -- see :ref:`pattern signature equivalent ` for the example in this section, or :ref:`pattern-type-sigs`. + Explicit ``forall`` is not always required -- see :ref:`pattern signature equivalent ` for the example in this section, or :extension:`PatternSignatures`. GHC supports *lexically scoped type variables*, without which some type signatures are simply impossible to write. For example: :: @@ -48,7 +52,7 @@ possible to do so. .. _pattern-equiv-form: -An equivalent form for that example, avoiding explicit ``forall`` uses :ref:`pattern-type-sigs`: :: +An equivalent form for that example, avoiding explicit ``forall`` uses :extension:`PatternSignatures`: :: f :: [a] -> [a] f (xs :: [aa]) = xs ++ ys @@ -84,9 +88,9 @@ A *lexically scoped type variable* can be bound by: - An expression type signature (:ref:`exp-type-sigs`) -- A pattern type signature (:ref:`pattern-type-sigs`) +- A pattern type signature (:extension:`PatternSignatures`) -- Class and instance declarations (:ref:`cls-inst-scoped-tyvars`) +- Class and instance declarations (:extension:`MethodTypeVariables`) In Haskell, a programmer-written type signature is implicitly quantified over its free type variables (`Section @@ -100,14 +104,31 @@ scope is *not* universally quantified. For example, if type variable (e :: b -> b) means (e :: forall b. b->b) (e :: a -> b) means (e :: forall b. a->b) +Extended ForAll Scope +===================== + +.. extension:: ExtendedForAllScope + :shortdesc: Enable lexically-scoped type variables in function bindings, + pattern synonyms and expression type signatures. + + :since: 9.8.1 + + :implied by: :extension:`ScopedTypeVariables` + + :status: Included in :extension:`GHC2021` + + Enable lexical scoping of type variables explicitly introduced with + a ``forall`` in function bindings, pattern synonyms and expression type signatures. + .. _decl-type-sigs: Declaration type signatures --------------------------- -A declaration type signature that has *explicit* quantification (using -``forall``) brings into scope the explicitly-quantified type variables, -in the definition of the named function. For example: :: +When :extension:`ExtendedForAllScope` is enabled, a declaration type signature +that has *explicit* quantification (using ``forall``) brings into scope the +explicitly-quantified type variables, in the definition of the named function. +For example: :: f :: forall a. [a] -> [a] f (x:xs) = xs ++ [ x :: a ] @@ -171,9 +192,9 @@ This only happens if: Expression type signatures -------------------------- -An expression type signature that has *explicit* quantification (using -``forall``) brings into scope the explicitly-quantified type variables, -in the annotated expression. For example: :: +When :extension:`ExtendedForAllScope` is enabled, an expression type signature +that has *explicit* quantification (using ``forall``) brings into scope the +explicitly-quantified type variables, in the annotated expression. For example: :: f = runST ( (op >>= \(x :: STRef s Int) -> g x) :: forall s. ST s Bool ) @@ -181,13 +202,22 @@ Here, the type signature ``forall s. ST s Bool`` brings the type variable ``s`` into scope, in the annotated expression ``(op >>= \(x :: STRef s Int) -> g x)``. -.. _pattern-type-sigs: +Pattern Signatures +================== + +.. extension:: PatternSignatures + :shortdesc: Allow type signatures in patterns. -Pattern type signatures ------------------------ + :since: 9.8.1 -A type signature may occur in any pattern; this is a *pattern type -signature*. For example: :: + :implied by: :extension:`ScopedTypeVariables` + + :status: Included in :extension:`GHC2021` + + Allow type signatures and type variable bindings in patterns. + +When :extension:`PatternSignatures` is enabled, a type signature may occur +in any pattern; this is a *pattern type signature*. For example: :: -- f and g assume that 'a' is already in scope f = \(x::Int, y::a) -> x @@ -259,12 +289,21 @@ they are both legal whether or not ``a`` is already in scope. They differ in that *if* ``a`` is already in scope, the signature constrains the pattern, rather than the pattern binding the variable. -.. _cls-inst-scoped-tyvars: +Method Type Variables +===================== + +.. extension:: MethodTypeVariables + :shortdesc: Enable lexically-scoped type variables in class and instance declarations. + + :since: 9.8.1 + + :implied by: :extension:`ScopedTypeVariables` + + :status: Included in :extension:`GHC2021` -Class and instance declarations -------------------------------- + Enable lexical scoping of type variables explicitly introduced by class and instance heads. -:extension:`ScopedTypeVariables` allow the type variables bound by the top of a +:extension:`MethodTypeVariables` allow the type variables bound by the top of a ``class`` or ``instance`` declaration to scope over the methods defined in the ``where`` part. Unlike :ref:`decl-type-sigs`, type variables from class and instance declarations can be lexically scoped without an explicit ``forall`` @@ -286,11 +325,11 @@ declaration; see :ref:`explicit-foralls`). For example: :: instance forall b. C b => C [b] where op xs = reverse (head (xs :: [[b]])) -While :extension:`ScopedTypeVariables` is required for type variables from the +While :extension:`MethodTypeVariables` is required for type variables from the top of a class or instance declaration to scope over the /bodies/ of the methods, it is not required for the type variables to scope over the /type signatures/ of the methods. For example, the following will be accepted without -explicitly enabling :extension:`ScopedTypeVariables`: :: +explicitly enabling :extension:`MethodTypeVariables`: :: class D a where m :: [a] -> a @@ -302,11 +341,11 @@ explicitly enabling :extension:`ScopedTypeVariables`: :: Note that writing ``m :: [a] -> [a]`` requires the use of the :extension:`InstanceSigs` extension. -Similarly, :extension:`ScopedTypeVariables` is not required for type variables +Similarly, :extension:`MethodTypeVariables` is not required for type variables from the top of the class or instance declaration to scope over associated type families, which only requires the :extension:`TypeFamilies` extension. For instance, the following will be accepted without explicitly enabling -:extension:`ScopedTypeVariables`: :: +:extension:`MethodTypeVariables`: :: class E a where type T a ===================================== docs/users_guide/exts/type_abstractions.rst ===================================== @@ -6,6 +6,8 @@ Type abstractions :since: 9.8.1 + :implied by: :extension:`ScopedTypeVariables` + :status: Partially implemented Allow the use of type abstraction syntax. ===================================== libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs ===================================== @@ -153,6 +153,9 @@ data Extension | OverloadedRecordUpdate | TypeAbstractions | ExtendedLiterals + | PatternSignatures + | ExtendedForAllScope + | MethodTypeVariables deriving (Eq, Enum, Show, Generic, Bounded) -- 'Ord' and 'Bounded' are provided for GHC API users (see discussions -- in https://gitlab.haskell.org/ghc/ghc/merge_requests/2707 and ===================================== testsuite/tests/driver/T4437.hs ===================================== @@ -38,7 +38,9 @@ check title expected got expectedGhcOnlyExtensions :: [String] expectedGhcOnlyExtensions = [ "TypeAbstractions", - "ExtendedLiterals" + "ExtendedLiterals", + "MethodTypeVariables", + "ExtendedForAllScope" ] expectedCabalOnlyExtensions :: [String] ===================================== testsuite/tests/rename/should_fail/T11663.stderr ===================================== @@ -1,20 +1,16 @@ T11663.hs:6:12: error: [GHC-74097] Illegal type signature: ‘Int’ - Type signatures are only allowed in patterns with ScopedTypeVariables - Suggested fix: Perhaps you intended to use ScopedTypeVariables + Suggested fix: Perhaps you intended to use PatternSignatures T11663.hs:7:9: error: [GHC-74097] Illegal type signature: ‘Int’ - Type signatures are only allowed in patterns with ScopedTypeVariables - Suggested fix: Perhaps you intended to use ScopedTypeVariables + Suggested fix: Perhaps you intended to use PatternSignatures T11663.hs:8:22: error: [GHC-74097] Illegal type signature: ‘Int’ - Type signatures are only allowed in patterns with ScopedTypeVariables - Suggested fix: Perhaps you intended to use ScopedTypeVariables + Suggested fix: Perhaps you intended to use PatternSignatures T11663.hs:9:32: error: [GHC-74097] Illegal type signature: ‘Int’ - Type signatures are only allowed in patterns with ScopedTypeVariables - Suggested fix: Perhaps you intended to use ScopedTypeVariables + Suggested fix: Perhaps you intended to use PatternSignatures ===================================== testsuite/tests/showIface/DocsInHiFile1.stdout ===================================== @@ -144,5 +144,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/DocsInHiFileTH.stdout ===================================== @@ -287,5 +287,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/HaddockIssue849.stdout ===================================== @@ -67,5 +67,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/HaddockOpts.stdout ===================================== @@ -59,5 +59,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/LanguageExts.stdout ===================================== @@ -23,4 +23,3 @@ docs: CUSKs FieldSelectors extensible fields: - ===================================== testsuite/tests/showIface/MagicHashInHaddocks.stdout ===================================== @@ -69,5 +69,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/NoExportList.stdout ===================================== @@ -95,5 +95,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/PragmaDocs.stdout ===================================== @@ -69,5 +69,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/ReExports.stdout ===================================== @@ -66,5 +66,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/typecheck/should_fail/PatSynExistential.stderr ===================================== @@ -1,4 +1,5 @@ -PatSynExistential.hs:6:1: [GHC-33973] - The result type of the signature for ‘P’, namely ‘x -> Maybe x’ + +PatSynExistential.hs:6:1: error: [GHC-33973] + • The result type of the signature for ‘P’, namely ‘x -> Maybe x’ mentions existential type variable ‘x’ - In the declaration for pattern synonym ‘P’ + • In the declaration for pattern synonym ‘P’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/979366a1b0695db8e274425b52b3a4eff6eb8c87 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/979366a1b0695db8e274425b52b3a4eff6eb8c87 You're receiving 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 Jun 7 08:18:15 2023 From: gitlab at gitlab.haskell.org (Moritz Angermann (@angerman)) Date: Wed, 07 Jun 2023 04:18:15 -0400 Subject: [Git][ghc/ghc][wip/angerman/riscv64-ncg] 21 commits: Pretty-print registers by their alias names Message-ID: <64803d47eedfa_1d329d61fc4264790458@gitlab.mail> Moritz Angermann pushed to branch wip/angerman/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: 5d7d4217 by Sven Tennie at 2023-05-17T17:33:25+02:00 Pretty-print registers by their alias names The alias name is easier to memorize and simplifies reasoning about what's going on. - - - - - 0484fa82 by Sven Tennie at 2023-05-18T12:10:35+02:00 Fix getAmode: Only signed 12bit immediates The symptom to find this was a too big immediate in a LW instruction in test arr020: Error: illegal operands `lw t0,4016(t0)' - - - - - 5545140f by Ben Gamari at 2023-05-18T12:56:34+02:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - ce78097c by Ben Gamari at 2023-05-18T12:56:34+02:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - 4f22557e by Sven Tennie at 2023-05-18T18:07:30+02:00 Add OR and ORI instructions ORR doesn't exist on RISCV. OR with register load is used when the immediate is too big for ORI (i.e. >12bits.) - - - - - b877aa85 by Sven Tennie at 2023-05-18T18:09:52+02:00 Refine TODO comment: Stack frame header size is 2 * 8 byte The stack frame header should contain two registers: ra and previous fp - - - - - c8c7bce6 by Sven Tennie at 2023-05-18T19:36:56+02:00 Fix MOV with immediate There are three cases: - Fits in a 12bit immediate slot -> ADDI - Fits in 32bit -> %hi / %lo piecewise loading - Else: Let the assembler solve this issue for now, LI - - - - - 4e60ab12 by Sven Tennie at 2023-05-19T10:24:07+02:00 Add DIV and REM REM calculates the remainder and replaces the more complex logic copied from AARCH64. - - - - - c3508989 by Sven Tennie at 2023-05-19T11:41:17+02:00 Fix: LDRB -> LB, LDRH -> LH A simple translation of these instructions from ARM to RISCV. Add panic-ing pattern matches to fetch the outstanding STR and LDR cases. - - - - - c1413de1 by Sven Tennie at 2023-05-19T18:19:28+02:00 Implement MO_S_Shr and truncateReg These store and load on the stack to move values in changed widths into registers. - - - - - a08a160d by Sven Tennie at 2023-05-20T11:57:23+02:00 CmmInt 0 should refer to zero register A constant 0 can always be taken from the zero register. - - - - - 6c908960 by Sven Tennie at 2023-05-21T17:52:50+02:00 Fix signed shift right This includes overhauling the sign extension and width truncation logic. - - - - - e1bce7ce by Sven Tennie at 2023-05-26T21:14:48+02:00 Replace SXTH & SXTB Both do not exist on RISCV64. While touching the sign extension code, also fix the integer calling convention in this sense and update the sign extension note. - - - - - 9c83e459 by Sven Tennie at 2023-05-26T22:18:42+02:00 Allow truncation to from smaller to larger Width This is used as inverse of sign extension to 64bit at many places. - - - - - 6418dd82 by Sven Tennie at 2023-05-27T09:21:41+02:00 Implement MO_NOT: Replace MVN MVN does not exist in RV64. Replace it by pseudo-instr not's effective assembly. - - - - - 63358eb4 by Sven Tennie at 2023-05-27T10:29:00+02:00 Replace UXTB & UXTH, Fix UDIV Replace UXTB and UXTB with truncateReg as these instructions do not exist in RISCV64. UDIV is named DIVU in RISCV64. - - - - - b1489bbd by Sven Tennie at 2023-05-27T11:02:58+02:00 Implement XOR Delete EOR which does not exist on RISCV64. - - - - - 3ba71edc by Sven Tennie at 2023-05-27T11:14:05+02:00 Rename UDIV -> DIVU That's how unsigned div is called on RISCV64. This should avoid confusion. - - - - - 1f737e0a by Sven Tennie at 2023-05-27T11:24:04+02:00 Delete unused EON It does not exist on RISCV64. - - - - - a9c3b295 by Sven Tennie at 2023-05-30T19:55:40+02:00 WIP: MO_S_MulMayOflo - - - - - 51010f35 by Moritz Angermann at 2023-06-07T08:17:23+00:00 float: first stab at supporting float ins - - - - - 13 changed files: - compiler/GHC/CmmToAsm/RV64/CodeGen.hs - compiler/GHC/CmmToAsm/RV64/Instr.hs - compiler/GHC/CmmToAsm/RV64/Ppr.hs - compiler/GHC/CmmToAsm/RV64/Regs.hs - hadrian/src/Settings/Builders/RunTest.hs - + tests/compiler/cmm/shift_right.cmm - + tests/compiler/cmm/zero.cmm - testsuite/driver/runtests.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - + testsuite/tests/codeGen/should_run/MulMayOflo.hs - + testsuite/tests/codeGen/should_run/MulMayOflo_cmm.cmm - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/CmmToAsm/RV64/CodeGen.hs ===================================== @@ -201,7 +201,7 @@ ann doc instr {- debugIsOn -} = ANN doc instr -- forced until we actually force them, and without -dppr-debug they should -- never end up being forced. annExpr :: CmmExpr -> Instr -> Instr -annExpr e instr {- debugIsOn -} = ANN (text . show $ e) instr +annExpr e {- debugIsOn -} = ANN (text . show $ e) -- annExpr e instr {- debugIsOn -} = ANN (pprExpr genericPlatform e) instr -- annExpr _ instr = instr {-# INLINE annExpr #-} @@ -413,11 +413,11 @@ opRegWidth W16 = W32 -- w opRegWidth W8 = W32 -- w opRegWidth w = pprPanic "opRegWidth" (text "Unsupported width" <+> ppr w) --- Note [Signed arithmetic on AArch64] +-- Note [Signed arithmetic on RISCV64] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- Handling signed arithmetic on sub-word-size values on AArch64 is a bit +-- Handling signed arithmetic on sub-word-size values on RISCV64 is a bit -- tricky as Cmm's type system does not capture signedness. While 32-bit values --- are fairly easy to handle due to AArch64's 32-bit instruction variants +-- are fairly easy to handle due to RISCV64's 32-bit instruction variants -- (denoted by use of %wN registers), 16- and 8-bit values require quite some -- care. -- @@ -447,6 +447,10 @@ opRegWidth w = pprPanic "opRegWidth" (text "Unsupported width" <+> ppr w) -- requires no extension and no truncate since we can assume that -- `c` is zero-extended. -- +-- The "RISC-V Sign Extension Optimizations" LLVM tech talk presentation by +-- Craig Topper covers possible future improvements +-- (https://llvm.org/devmtg/2022-11/slides/TechTalk21-RISC-VSignExtensionOptimizations.pdf) +-- -- TODO: -- Don't use Width in Operands -- Instructions should rather carry a RegWidth @@ -499,7 +503,7 @@ getRegister' config plat expr CmmLit lit -> case lit of - -- TODO handle CmmInt 0 specially, use wzr or xzr. + CmmInt 0 w -> pure $ Fixed (intFormat w) zero_reg nilOL CmmInt i W8 | i >= 0 -> do return (Any (intFormat W8) (\dst -> unitOL $ annExpr expr (MOV (OpReg W8 dst) (OpImm (ImmInteger (narrowU W8 i)))))) @@ -531,26 +535,16 @@ getRegister' config plat expr CmmFloat _f W16 -> pprPanic "getRegister' (CmmLit:CmmFloat), no support for halfs" (pdoc plat expr) CmmFloat f W32 -> do let word = castFloatToWord32 (fromRational f) :: Word32 - half0 = fromIntegral (fromIntegral word :: Word16) - half1 = fromIntegral (fromIntegral (word `shiftR` 16) :: Word16) tmp <- getNewRegNat (intFormat W32) return (Any (floatFormat W32) (\dst -> toOL [ annExpr expr - $ MOV (OpReg W32 tmp) (OpImm (ImmInt half0)) - , MOVK (OpReg W32 tmp) (OpImmShift (ImmInt half1) SLSL 16) + $ MOV (OpReg W32 tmp) (OpImm (ImmInteger (fromIntegral word))) , MOV (OpReg W32 dst) (OpReg W32 tmp) ])) CmmFloat f W64 -> do let word = castDoubleToWord64 (fromRational f) :: Word64 - half0 = fromIntegral (fromIntegral word :: Word16) - half1 = fromIntegral (fromIntegral (word `shiftR` 16) :: Word16) - half2 = fromIntegral (fromIntegral (word `shiftR` 32) :: Word16) - half3 = fromIntegral (fromIntegral (word `shiftR` 48) :: Word16) tmp <- getNewRegNat (intFormat W64) return (Any (floatFormat W64) (\dst -> toOL [ annExpr expr - $ MOV (OpReg W64 tmp) (OpImm (ImmInt half0)) - , MOVK (OpReg W64 tmp) (OpImmShift (ImmInt half1) SLSL 16) - , MOVK (OpReg W64 tmp) (OpImmShift (ImmInt half2) SLSL 32) - , MOVK (OpReg W64 tmp) (OpImmShift (ImmInt half3) SLSL 48) + $ MOV (OpReg W64 tmp) (OpImm (ImmInteger (fromIntegral word))) , MOV (OpReg W64 dst) (OpReg W64 tmp) ])) CmmFloat _f _w -> pprPanic "getRegister' (CmmLit:CmmFloat), unsupported float lit" (pdoc plat expr) @@ -610,8 +604,9 @@ getRegister' config plat expr MO_Not w -> return $ Any (intFormat w) $ \dst -> let w' = opRegWidth w in code `snocOL` - MVN (OpReg w' dst) (OpReg w' reg) `appOL` - truncateReg w' w dst -- See Note [Signed arithmetic on AArch64] + -- pseudo instruction `not` is `xori rd, rs, -1` + ann (text "not") (XORI (OpReg w' dst) (OpReg w' reg) (OpImm (ImmInt (-1)))) `appOL` + truncateReg w' w dst -- See Note [Signed arithmetic on RISCV64] MO_S_Neg w -> negate code w reg MO_F_Neg w -> return $ Any (floatFormat w) (\dst -> code `snocOL` NEG (OpReg w dst) (OpReg w reg)) @@ -655,14 +650,28 @@ getRegister' config plat expr NEG (OpReg w' dst) (OpReg w' reg') `appOL` truncateReg w' w dst - ss_conv from to reg code = - let w' = opRegWidth (max from to) - in return $ Any (intFormat to) $ \dst -> - code `snocOL` - SBFM (OpReg w' dst) (OpReg w' reg) (OpImm (ImmInt 0)) (toImm (min from to)) `appOL` - -- At this point an 8- or 16-bit value would be sign-extended - -- to 32-bits. Truncate back down the final width. - truncateReg w' to dst + ss_conv from to reg code | from == to = + pure $ Any (intFormat from) $ \dst -> + code `snocOL` (MOV (OpReg from dst) (OpReg from reg)) + ss_conv from to reg code | from < to = do + pure $ Any (intFormat to) $ \dst -> + code + `appOL` signExtend from to reg dst + `appOL` truncateReg from to dst + ss_conv from to reg code | from > to = + pure $ Any (intFormat to) $ \dst -> + code + `appOL` toOL + [ ann + (text "narrow register signed" <+> ppr reg <+> ppr from <> text "->" <> ppr to) + (LSL (OpReg to dst) (OpReg from reg) (OpImm (ImmInt shift))), + -- signed right shift + ASR (OpReg to dst) (OpReg to dst) (OpImm (ImmInt shift)) + ] + `appOL` truncateReg from to dst + where + -- Why -1? We need to shift out one more bit for the sign. + shift = 64 - (widthInBits from - widthInBits to - 1) -- Dyadic machops: -- @@ -690,14 +699,14 @@ getRegister' config plat expr where w' = formatToWidth (cmmTypeFormat (cmmRegType plat reg)) r' = getRegisterReg plat reg - CmmMachOp (MO_U_Quot w) [x, y] | w == W8 -> do - (reg_x, _format_x, code_x) <- getSomeReg x - (reg_y, _format_y, code_y) <- getSomeReg y - return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (UXTB (OpReg w reg_y) (OpReg w reg_y)) `snocOL` (UDIV (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) - CmmMachOp (MO_U_Quot w) [x, y] | w == W16 -> do - (reg_x, _format_x, code_x) <- getSomeReg x - (reg_y, _format_y, code_y) <- getSomeReg y - return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTH (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (UXTH (OpReg w reg_y) (OpReg w reg_y)) `snocOL` (UDIV (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) + CmmMachOp (MO_U_Quot w) [x, y] | w == W8 || w == W16 -> do + (reg_x, format_x, code_x) <- getSomeReg x + (reg_y, format_y, code_y) <- getSomeReg y + return $ Any (intFormat w) (\dst -> code_x `appOL` + truncateReg (formatToWidth format_x) w reg_x `appOL` + code_y `appOL` + truncateReg (formatToWidth format_y) w reg_y `snocOL` + annExpr expr (DIVU (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) -- 2. Shifts. x << n, x >> n. CmmMachOp (MO_Shl w) [x, (CmmLit (CmmInt n _))] | w == W32, 0 <= n, n < 32 -> do @@ -707,46 +716,33 @@ getRegister' config plat expr (reg_x, _format_x, code_x) <- getSomeReg x return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSL (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) - CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | w == W8, 0 <= n, n < 8 -> do - (reg_x, _format_x, code_x) <- getSomeReg x - return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (SBFX (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)) (OpImm (ImmInteger (8-n))))) - CmmMachOp (MO_S_Shr w) [x, y] | w == W8 -> do - (reg_x, _format_x, code_x) <- getSomeReg x - (reg_y, _format_y, code_y) <- getSomeReg y - return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (SXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) - - CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | w == W16, 0 <= n, n < 16 -> do - (reg_x, _format_x, code_x) <- getSomeReg x - return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (SBFX (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)) (OpImm (ImmInteger (16-n))))) - CmmMachOp (MO_S_Shr w) [x, y] | w == W16 -> do - (reg_x, _format_x, code_x) <- getSomeReg x + CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | fitsIn12bitImm n -> do + (reg_x, format_x, code_x) <- getSomeReg x + (reg_x', code_x') <- signExtendReg (formatToWidth format_x) w reg_x + return $ Any (intFormat w) ( + \dst -> + code_x `appOL` code_x' `snocOL` annExpr expr (ASR (OpReg w dst) (OpReg w reg_x') (OpImm (ImmInteger n))) + ) + CmmMachOp (MO_S_Shr w) [x, y] -> do + (reg_x, format_x, code_x) <- getSomeReg x (reg_y, _format_y, code_y) <- getSomeReg y - return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (SXTH (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) - - CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | w == W32, 0 <= n, n < 32 -> do - (reg_x, _format_x, code_x) <- getSomeReg x - return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (ASR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) - - CmmMachOp (MO_S_Shr w) [x, (CmmLit (CmmInt n _))] | w == W64, 0 <= n, n < 64 -> do - (reg_x, _format_x, code_x) <- getSomeReg x - return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (ASR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) - + (reg_x', code_x') <- signExtendReg (formatToWidth format_x) w reg_x + return $ Any (intFormat w) ( + \dst -> + code_x `appOL` code_x' `appOL` code_y `snocOL` annExpr expr (ASR (OpReg w dst) (OpReg w reg_x') (OpReg w reg_y)) + ) CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W8, 0 <= n, n < 8 -> do (reg_x, _format_x, code_x) <- getSomeReg x return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (UBFX (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)) (OpImm (ImmInteger (8-n))))) - CmmMachOp (MO_U_Shr w) [x, y] | w == W8 -> do - (reg_x, _format_x, code_x) <- getSomeReg x + CmmMachOp (MO_U_Shr w) [x, y] | w == W8 || w == W16 -> do + (reg_x, format_x, code_x) <- getSomeReg x (reg_y, _format_y, code_y) <- getSomeReg y - return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTB (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) + return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `appOL` truncateReg (formatToWidth format_x) w reg_x `snocOL` annExpr expr (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W16, 0 <= n, n < 16 -> do (reg_x, _format_x, code_x) <- getSomeReg x return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (UBFX (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)) (OpImm (ImmInteger (16-n))))) - CmmMachOp (MO_U_Shr w) [x, y] | w == W16 -> do - (reg_x, _format_x, code_x) <- getSomeReg x - (reg_y, _format_y, code_y) <- getSomeReg y - return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `snocOL` annExpr expr (UXTH (OpReg w reg_x) (OpReg w reg_x)) `snocOL` (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W32, 0 <= n, n < 32 -> do (reg_x, _format_x, code_x) <- getSomeReg x @@ -757,13 +753,13 @@ getRegister' config plat expr return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) -- 3. Logic &&, || - CmmMachOp (MO_And w) [(CmmReg reg), CmmLit (CmmInt n _)] | isBitMaskImmediate (fromIntegral n) -> + CmmMachOp (MO_And w) [(CmmReg reg), CmmLit (CmmInt n _)] | fitsIn12bitImm n -> return $ Any (intFormat w) (\d -> unitOL $ annExpr expr (AND (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n)))) where w' = formatToWidth (cmmTypeFormat (cmmRegType plat reg)) r' = getRegisterReg plat reg - CmmMachOp (MO_Or w) [(CmmReg reg), CmmLit (CmmInt n _)] | isBitMaskImmediate (fromIntegral n) -> - return $ Any (intFormat w) (\d -> unitOL $ annExpr expr (ORR (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n)))) + CmmMachOp (MO_Or w) [(CmmReg reg), CmmLit (CmmInt n _)] | fitsIn12bitImm n -> + return $ Any (intFormat w) (\d -> unitOL $ annExpr expr (ORI (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n)))) where w' = formatToWidth (cmmTypeFormat (cmmRegType plat reg)) r' = getRegisterReg plat reg @@ -881,22 +877,14 @@ getRegister' config plat expr -- Signed multiply/divide MO_Mul w -> intOp True w (\d x y -> unitOL $ MUL d x y) MO_S_MulMayOflo w -> do_mul_may_oflo w x y - MO_S_Quot w -> intOp True w (\d x y -> unitOL $ SDIV d x y) - - -- No native rem instruction. So we'll compute the following - -- Rd <- Rx / Ry | 2 <- 7 / 3 -- SDIV Rd Rx Ry - -- Rd' <- Rx - Rd * Ry | 1 <- 7 - 2 * 3 -- MSUB Rd' Rd Ry Rx - -- | '---|----------------|---' | - -- | '----------------|-------' - -- '--------------------------' + MO_S_Quot w -> intOp True w (\d x y -> unitOL $ DIV d x y) + -- Note the swap in Rx and Ry. - MO_S_Rem w -> withTempIntReg w $ \t -> - intOp True w (\d x y -> toOL [ SDIV t x y, MSUB d t y x ]) + MO_S_Rem w -> intOp True w (\d x y -> unitOL $ REM d x y) -- Unsigned multiply/divide - MO_U_Quot w -> intOp False w (\d x y -> unitOL $ UDIV d x y) - MO_U_Rem w -> withTempIntReg w $ \t -> - intOp False w (\d x y -> toOL [ UDIV t x y, MSUB d t y x ]) + MO_U_Quot w -> intOp False w (\d x y -> unitOL $ DIVU d x y) + MO_U_Rem w -> intOp False w (\d x y -> unitOL $ REM d x y) -- Signed comparisons -- see Note [CSET] MO_S_Ge w -> intOp True w (\d x y -> toOL [ CSET d x y SGE ]) @@ -914,7 +902,7 @@ getRegister' config plat expr MO_F_Add w -> floatOp w (\d x y -> unitOL $ ADD d x y) MO_F_Sub w -> floatOp w (\d x y -> unitOL $ SUB d x y) MO_F_Mul w -> floatOp w (\d x y -> unitOL $ MUL d x y) - MO_F_Quot w -> floatOp w (\d x y -> unitOL $ SDIV d x y) + MO_F_Quot w -> floatOp w (\d x y -> unitOL $ DIV d x y) -- Floating point comparison MO_F_Eq w -> floatCond w (\d x y -> toOL [ CSET d x y EQ ]) @@ -932,8 +920,8 @@ getRegister' config plat expr -- Bitwise operations MO_And w -> bitOp w (\d x y -> unitOL $ AND d x y) - MO_Or w -> bitOp w (\d x y -> unitOL $ ORR d x y) - MO_Xor w -> bitOp w (\d x y -> unitOL $ EOR d x y) + MO_Or w -> bitOp w (\d x y -> unitOL $ OR d x y) + MO_Xor w -> bitOp w (\d x y -> unitOL $ XOR d x y) MO_Shl w -> intOp False w (\d x y -> unitOL $ LSL d x y) MO_U_Shr w -> intOp False w (\d x y -> unitOL $ LSR d x y) MO_S_Shr w -> intOp True w (\d x y -> unitOL $ ASR d x y) @@ -947,113 +935,187 @@ getRegister' config plat expr where isNbitEncodeable :: Int -> Integer -> Bool isNbitEncodeable n i = let shift = n - 1 in (-1 `shiftL` shift) <= i && i < (1 `shiftL` shift) - -- FIXME: These are wrong, they are for AArch64, not RISCV! I'm not even sure we need them for RISCV - isBitMaskImmediate :: Integer -> Bool - isBitMaskImmediate i = i `elem` [0b0000_0001, 0b0000_0010, 0b0000_0100, 0b0000_1000, 0b0001_0000, 0b0010_0000, 0b0100_0000, 0b1000_0000 - ,0b0000_0011, 0b0000_0110, 0b0000_1100, 0b0001_1000, 0b0011_0000, 0b0110_0000, 0b1100_0000 - ,0b0000_0111, 0b0000_1110, 0b0001_1100, 0b0011_1000, 0b0111_0000, 0b1110_0000 - ,0b0000_1111, 0b0001_1110, 0b0011_1100, 0b0111_1000, 0b1111_0000 - ,0b0001_1111, 0b0011_1110, 0b0111_1100, 0b1111_1000 - ,0b0011_1111, 0b0111_1110, 0b1111_1100 - ,0b0111_1111, 0b1111_1110 - ,0b1111_1111] - -- N.B. MUL does not set the overflow flag. + -- Return 0 when the operation cannot overflow, /= 0 otherwise do_mul_may_oflo :: Width -> CmmExpr -> CmmExpr -> NatM Register + do_mul_may_oflo w _x _y | w > W64 = pprPanic "Cannot multiply larger than 64bit" (ppr w) do_mul_may_oflo w at W64 x y = do - (reg_x, _format_x, code_x) <- getSomeReg x - (reg_y, _format_y, code_y) <- getSomeReg y - lo <- getNewRegNat II64 - hi <- getNewRegNat II64 - return $ Any (intFormat w) (\dst -> - code_x `appOL` - code_y `snocOL` - MUL (OpReg w lo) (OpReg w reg_x) (OpReg w reg_y) `snocOL` - SMULH (OpReg w hi) (OpReg w reg_x) (OpReg w reg_y) `snocOL` - CSET (OpReg w dst) (OpReg w hi) (OpRegShift w lo SASR 63) NE) + (reg_x, format_x, code_x) <- getSomeReg x + (reg_y, format_y, code_y) <- getSomeReg y + -- TODO: Can't we clobber reg_x and reg_y to save registers? + lo <- getNewRegNat II64 + hi <- getNewRegNat II64 + -- TODO: Overhaul CSET: 3rd operand isn't needed for SNEZ + let nonSense = OpImm (ImmInt 0) + pure $ + Any + (intFormat w) + ( \dst -> + code_x + `appOL` signExtend (formatToWidth format_x) W64 reg_x reg_x + `appOL` code_y + `appOL` signExtend (formatToWidth format_y) W64 reg_x reg_y + `appOL` toOL + [ annExpr expr (SMULH (OpReg w hi) (OpReg w reg_x) (OpReg w reg_y)), + MUL (OpReg w lo) (OpReg w reg_x) (OpReg w reg_y), + ASR (OpReg w lo) (OpReg w reg_x) (OpImm (ImmInt (widthInBits W64 - 1))), + ann + (text "Set flag if result of MULH contains more than sign bits.") + (SUB (OpReg w hi) (OpReg w hi) (OpReg w lo)), + CSET (OpReg w dst) (OpReg w hi) nonSense NE + ] + ) do_mul_may_oflo w x y = do - (reg_x, _format_x, code_x) <- getSomeReg x - (reg_y, _format_y, code_y) <- getSomeReg y - let tmp_w = case w of - W32 -> W64 - W16 -> W32 - W8 -> W32 - _ -> panic "do_mul_may_oflo: impossible" - -- This will hold the product - tmp <- getNewRegNat (intFormat tmp_w) - let ext_mode = case w of - W32 -> ESXTW - W16 -> ESXTH - W8 -> ESXTB - _ -> panic "do_mul_may_oflo: impossible" - mul = case w of - W32 -> SMULL - W16 -> MUL - W8 -> MUL - _ -> panic "do_mul_may_oflo: impossible" - return $ Any (intFormat w) (\dst -> - code_x `appOL` - code_y `snocOL` - mul (OpReg tmp_w tmp) (OpReg w reg_x) (OpReg w reg_y) `snocOL` - CSET (OpReg w dst) (OpReg tmp_w tmp) (OpRegExt tmp_w tmp ext_mode 0) NE) + (reg_x, format_x, code_x) <- getSomeReg x + (reg_y, format_y, code_y) <- getSomeReg y + let width_x = formatToWidth format_x + width_y = formatToWidth format_y + if w > width_x && w > width_y + then + pure $ + Any + (intFormat w) + ( \dst -> + -- 8bit * 8bit cannot overflow 16bit + -- 16bit * 16bit cannot overflow 32bit + -- 32bit * 32bit cannot overflow 64bit + unitOL $ annExpr expr (ADD (OpReg w dst) zero (OpImm (ImmInt 0))) + ) + else do + let use32BitMul = width_x <= W32 && width_y <= W32 + nonSense = OpImm (ImmInt 0) + if use32BitMul + then do + narrowedReg <- getNewRegNat II64 + pure $ + Any + (intFormat w) + ( \dst -> + code_x + `appOL` signExtend (formatToWidth format_x) W32 reg_x reg_x + `appOL` code_y + `appOL` signExtend (formatToWidth format_y) W32 reg_y reg_y + `snocOL` annExpr expr (MUL (OpReg W32 dst) (OpReg W32 reg_x) (OpReg W32 reg_y)) + `appOL` signExtend W32 w dst narrowedReg + `appOL` toOL + [ ann + (text "Check if the multiplied value fits in the narrowed register") + (SUB (OpReg w dst) (OpReg w dst) (OpReg w narrowedReg)), + CSET (OpReg w dst) (OpReg w dst) nonSense NE + ] + ) + else do + -- TODO: Can't we clobber reg_x and reg_y to save registers? + lo <- getNewRegNat II64 + hi <- getNewRegNat II64 + narrowedLo <- getNewRegNat II64 + + -- TODO: Overhaul CSET: 3rd operand isn't needed for SNEZ + let nonSense = OpImm (ImmInt 0) + pure $ + Any + (intFormat w) + ( \dst -> + code_x + `appOL` signExtend (formatToWidth format_x) W64 reg_x reg_x + `appOL` code_y + `appOL` signExtend (formatToWidth format_y) W64 reg_x reg_y + `appOL` toOL + [ annExpr expr (SMULH (OpReg w hi) (OpReg w reg_x) (OpReg w reg_y)), + MUL (OpReg w lo) (OpReg w reg_x) (OpReg w reg_y), + ASR (OpReg w lo) (OpReg w reg_x) (OpImm (ImmInt (widthInBits W64 - 1))), + ann + (text "Set flag if result of MULH contains more than sign bits.") + (SUB (OpReg w hi) (OpReg w hi) (OpReg w lo)), + CSET (OpReg w hi) (OpReg w hi) nonSense NE + ] + `appOL` signExtend W64 w lo narrowedLo + `appOL` toOL + [ ann + (text "Check if the multiplied value fits in the narrowed register") + (SUB (OpReg w narrowedLo) (OpReg w lo) (OpReg w narrowedLo)), + CSET (OpReg w narrowedLo) (OpReg w narrowedLo) nonSense NE, + ann + (text "Combine both overflow flags") + (OR (OpReg w dst) (OpReg w narrowedLo) (OpReg w hi)) + ] + ) -- | Instructions to sign-extend the value in the given register from width @w@ -- up to width @w'@. signExtendReg :: Width -> Width -> Reg -> NatM (Reg, OrdList Instr) -signExtendReg w w' r = - case w of - W64 -> noop - W32 - | w' == W32 -> noop - | otherwise -> extend SXTH - W16 -> extend SXTH - W8 -> extend SXTB - _ -> panic "intOp" +signExtendReg w _w' r | w == W64 = pure (r, nilOL) +signExtendReg w w' r = do + r' <- getNewRegNat (intFormat w') + let instrs = signExtend w w' r r' + pure (r', instrs) + +-- | Sign extends to 64bit, if needed +-- +-- Source `Reg` @r@ stays untouched, while the conversion happens on destination +-- `Reg` @r'@. +signExtend :: Width -> Width -> Reg -> Reg -> OrdList Instr +signExtend w w' _r _r' | w > w' = pprPanic "This is not a sign extension, but a truncation." $ ppr w <> text "->" <+> ppr w' +signExtend w w' _r _r' | w > W64 || w' > W64 = pprPanic "Unexpected width (max is 64bit):" $ ppr w <> text "->" <+> ppr w' +signExtend w w' r r' | w == W64 && w' == W64 && r == r' = nilOL +signExtend w w' r r' | w == W64 && w' == W64 = unitOL $ MOV (OpReg w' r') (OpReg w r) +signExtend w w' r r' + | w == W32 && w' == W64 = + unitOL $ + ann + (text "sign-extend register (SEXT.W)" <+> ppr r <+> ppr w <> text "->" <> ppr w') + -- `ADDIW r r 0` is the pseudo-op SEXT.W + (ADD (OpReg w' r') (OpReg w r) (OpImm (ImmInt 0))) +signExtend w w' r r' = + toOL + [ ann + (text "narrow register signed" <+> ppr r <> char ':' <> ppr w <> text "->" <> ppr r <> char ':' <> ppr w') + (LSL (OpReg w' r') (OpReg w r) (OpImm (ImmInt shift))), + -- signed (arithmetic) right shift + ASR (OpReg w' r') (OpReg w' r') (OpImm (ImmInt shift)) + ] where - noop = return (r, nilOL) - extend instr = do - r' <- getNewRegNat II64 - return (r', unitOL $ instr (OpReg w' r') (OpReg w' r)) + shift = 64 - widthInBits w -- | Instructions to truncate the value in the given register from width @w@ --- down to width @w'@. +-- to width @w'@. +-- +-- In other words, it just cuts the width out of the register. N.B.: This +-- ignores signedness (no sign extension takes place)! truncateReg :: Width -> Width -> Reg -> OrdList Instr +truncateReg _w w' _r | w' == W64 = nilOL +truncateReg _w w' r | w' > W64 = pprPanic "Cannot truncate to width bigger than register size (max is 64bit):" $ text (show r) <> char ':' <+> ppr w' +truncateReg w _w' r | w > W64 = pprPanic "Unexpected register size (max is 64bit):" $ text (show r) <> char ':' <+> ppr w truncateReg w w' r = - case w of - W64 -> nilOL - W32 - | w' == W32 -> nilOL - _ -> unitOL $ UBFM (OpReg w r) - (OpReg w r) - (OpImm (ImmInt 0)) - (OpImm $ ImmInt $ widthInBits w' - 1) + toOL + [ ann + (text "truncate register" <+> ppr r <+> ppr w <> text "->" <> ppr w') + (LSL (OpReg w' r) (OpReg w r) (OpImm (ImmInt shift))), + -- SHL ignores signedness! + LSR (OpReg w' r) (OpReg w r) (OpImm (ImmInt shift)) + ] + where + shift = 64 - widthInBits w' -- ----------------------------------------------------------------------------- -- The 'Amode' type: Memory addressing modes passed up the tree. data Amode = Amode AddrMode InstrBlock +-- | Provide the value of a `CmmExpr` with an `Amode` +-- +-- N.B. this function should be used to provide operands to load and store +-- instructions with signed 12bit wide immediates (S & I types). For other +-- immediate sizes and formats (e.g. B type uses multiples of 2) this function +-- would need to be adjusted. getAmode :: Platform -> Width -- ^ width of loaded value -> CmmExpr -> NatM Amode -- TODO: Specialize stuff we can destructure here. --- OPTIMIZATION WARNING: Addressing modes. --- Addressing options: --- LDUR/STUR: imm9: -256 - 255 -getAmode platform _ (CmmRegOff reg off) | -256 <= off, off <= 255 - = return $ Amode (AddrRegImm reg' off') nilOL - where reg' = getRegisterReg platform reg - off' = ImmInt off --- LDR/STR: imm12: if reg is 32bit: 0 -- 16380 in multiples of 4 -getAmode platform W32 (CmmRegOff reg off) - | 0 <= off, off <= 16380, off `mod` 4 == 0 - = return $ Amode (AddrRegImm reg' off') nilOL - where reg' = getRegisterReg platform reg - off' = ImmInt off --- LDR/STR: imm12: if reg is 64bit: 0 -- 32760 in multiples of 8 -getAmode platform W64 (CmmRegOff reg off) - | 0 <= off, off <= 32760, off `mod` 8 == 0 +-- LDR/STR: Immediate can be represented with 12bits +getAmode platform w (CmmRegOff reg off) + | w <= W64, fitsIn12bitImm off = return $ Amode (AddrRegImm reg' off') nilOL where reg' = getRegisterReg platform reg off' = ImmInt off @@ -1063,12 +1125,12 @@ getAmode platform W64 (CmmRegOff reg off) -- E.g. a CmmStoreOff really. This can be translated to `str $expr2, [$expr, #n ] -- for `n` in range. getAmode _platform _ (CmmMachOp (MO_Add _w) [expr, CmmLit (CmmInt off _w')]) - | -256 <= off, off <= 255 + | fitsIn12bitImm off = do (reg, _format, code) <- getSomeReg expr return $ Amode (AddrRegImm reg (ImmInteger off)) code getAmode _platform _ (CmmMachOp (MO_Sub _w) [expr, CmmLit (CmmInt off _w')]) - | -256 <= -off, -off <= 255 + | fitsIn12bitImm (-off) = do (reg, _format, code) <- getSomeReg expr return $ Amode (AddrRegImm reg (ImmInteger (-off))) code @@ -1167,25 +1229,39 @@ genCondJump bid expr = do let ubcond w cmp = do -- compute both sides. - (reg_x, _format_x, code_x) <- getSomeReg x - (reg_y, _format_y, code_y) <- getSomeReg y + (reg_x, format_x, code_x) <- getSomeReg x + (reg_y, format_y, code_y) <- getSomeReg y let x' = OpReg w reg_x y' = OpReg w reg_y return $ case w of - W8 -> code_x `appOL` code_y `appOL` toOL [ UXTB x' x', UXTB y' y', (annExpr expr (BCOND cmp x' y' (TBlock bid))) ] - W16 -> code_x `appOL` code_y `appOL` toOL [ UXTH x' x', UXTH y' y', (annExpr expr (BCOND cmp x' y' (TBlock bid))) ] - _ -> code_x `appOL` code_y `appOL` toOL [ (annExpr expr (BCOND cmp x' y' (TBlock bid))) ] + w | w == W8 || w == W16 -> code_x `appOL` + truncateReg (formatToWidth format_x) w reg_x `appOL` + code_y `appOL` + truncateReg (formatToWidth format_y) w reg_y `appOL` + code_y `snocOL` + annExpr expr (BCOND cmp x' y' (TBlock bid)) + _ -> code_x `appOL` code_y `snocOL` annExpr expr (BCOND cmp x' y' (TBlock bid)) sbcond w cmp = do - -- compute both sides. - (reg_x, _format_x, code_x) <- getSomeReg x - (reg_y, _format_y, code_y) <- getSomeReg y - let x' = OpReg w reg_x - y' = OpReg w reg_y - return $ case w of - W8 -> code_x `appOL` code_y `appOL` toOL [ SXTB x' x', SXTB y' y', (annExpr expr (BCOND cmp x' y' (TBlock bid))) ] - W16 -> code_x `appOL` code_y `appOL` toOL [ SXTH x' x', SXTH y' y', (annExpr expr (BCOND cmp x' y' (TBlock bid))) ] - _ -> code_x `appOL` code_y `appOL` toOL [ (annExpr expr (BCOND cmp x' y' (TBlock bid))) ] + -- compute both sides. + (reg_x, format_x, code_x) <- getSomeReg x + (reg_y, format_y, code_y) <- getSomeReg y + let x' = OpReg w reg_x + y' = OpReg w reg_y + return $ case w of + W8 -> + code_x + `appOL` signExtend (formatToWidth format_x) W64 reg_x reg_x + `appOL` code_y + `appOL` signExtend (formatToWidth format_y) W64 reg_y reg_y + `appOL` unitOL (annExpr expr (BCOND cmp x' y' (TBlock bid))) + W16 -> + code_x + `appOL` signExtend (formatToWidth format_x) W64 reg_x reg_x + `appOL` code_y + `appOL` signExtend (formatToWidth format_y) W64 reg_y reg_y + `appOL` unitOL (annExpr expr (BCOND cmp x' y' (TBlock bid))) + _ -> code_x `appOL` code_y `appOL` unitOL (annExpr expr (BCOND cmp x' y' (TBlock bid))) fbcond w cmp = do -- ensure we get float regs @@ -1617,25 +1693,15 @@ genCCall target dest_regs arg_regs bid = do -- -- Still have GP regs, and we want to pass an GP argument. - passArguments pack (gpReg:gpRegs) fpRegs ((r, format, hint, code_r):args) stackSpace accumRegs accumCode | isIntFormat format = do platform <- getPlatform + -- RISCV64 Integer Calling Convention: "When passed in registers or on the + -- stack, integer scalars narrower than XLEN bits are widened according to + -- the sign of their type up to 32 bits, then sign-extended to XLEN bits." let w = formatToWidth format - mov - -- Specifically, Darwin/AArch64's ABI requires that the caller - -- sign-extend arguments which are smaller than 32-bits. - | w < W32 - , platformCConvNeedsExtension platform - , SignedHint <- hint - = case w of - W8 -> SXTB (OpReg W64 gpReg) (OpReg w r) - W16 -> SXTH (OpReg W64 gpReg) (OpReg w r) - _ -> panic "impossible" - | otherwise - = MOV (OpReg w gpReg) (OpReg w r) accumCode' = accumCode `appOL` - code_r `snocOL` - ann (text "Pass gp argument: " <> ppr r) mov + code_r `appOL` + signExtend w W64 r gpReg passArguments pack gpRegs fpRegs args stackSpace (gpReg:accumRegs) accumCode' -- Still have FP regs, and we want to pass an FP argument. ===================================== compiler/GHC/CmmToAsm/RV64/Instr.hs ===================================== @@ -32,7 +32,7 @@ import Data.Maybe (fromMaybe) import GHC.Stack --- | TODO: verify this! +-- | TODO: Should be `2 * spillSlotSize = 16` stackFrameHeaderSize :: Platform -> Int stackFrameHeaderSize _ = 64 @@ -82,37 +82,33 @@ regUsageOfInstr platform instr = case instr of ADD dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) -- CMN l r -> usage (regOp l ++ regOp r, []) -- CMP l r -> usage (regOp l ++ regOp r, []) - MSUB dst src1 src2 src3 -> usage (regOp src1 ++ regOp src2 ++ regOp src3, regOp dst) MUL dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) NEG dst src -> usage (regOp src, regOp dst) SMULH dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) SMULL dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) - SDIV dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + DIV dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + REM dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) SUB dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) - UDIV dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + DIVU dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) -- 2. Bit Manipulation Instructions ------------------------------------------ SBFM dst src _ _ -> usage (regOp src, regOp dst) UBFM dst src _ _ -> usage (regOp src, regOp dst) - SBFX dst src _ _ -> usage (regOp src, regOp dst) UBFX dst src _ _ -> usage (regOp src, regOp dst) - SXTB dst src -> usage (regOp src, regOp dst) - UXTB dst src -> usage (regOp src, regOp dst) - SXTH dst src -> usage (regOp src, regOp dst) - UXTH dst src -> usage (regOp src, regOp dst) -- 3. Logical and Move Instructions ------------------------------------------ AND dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + OR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) ASR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) BIC dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) BICS dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) - EON dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) - EOR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + XOR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) LSL dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) LSR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) MOV dst src -> usage (regOp src, regOp dst) MOVK dst src -> usage (regOp src, regOp dst) - MVN dst src -> usage (regOp src, regOp dst) - ORR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) + -- ORI's third operand is always an immediate + ORI dst src1 _ -> usage (regOp src1, regOp dst) + XORI dst src1 _ -> usage (regOp src1, regOp dst) ROR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) TST src1 src2 -> usage (regOp src1 ++ regOp src2, []) -- 4. Branch Instructions ---------------------------------------------------- @@ -220,39 +216,35 @@ patchRegsOfInstr instr env = case instr of ADD o1 o2 o3 -> ADD (patchOp o1) (patchOp o2) (patchOp o3) -- CMN o1 o2 -> CMN (patchOp o1) (patchOp o2) -- CMP o1 o2 -> CMP (patchOp o1) (patchOp o2) - MSUB o1 o2 o3 o4 -> MSUB (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4) MUL o1 o2 o3 -> MUL (patchOp o1) (patchOp o2) (patchOp o3) NEG o1 o2 -> NEG (patchOp o1) (patchOp o2) SMULH o1 o2 o3 -> SMULH (patchOp o1) (patchOp o2) (patchOp o3) SMULL o1 o2 o3 -> SMULL (patchOp o1) (patchOp o2) (patchOp o3) - SDIV o1 o2 o3 -> SDIV (patchOp o1) (patchOp o2) (patchOp o3) + DIV o1 o2 o3 -> DIV (patchOp o1) (patchOp o2) (patchOp o3) + REM o1 o2 o3 -> REM (patchOp o1) (patchOp o2) (patchOp o3) SUB o1 o2 o3 -> SUB (patchOp o1) (patchOp o2) (patchOp o3) - UDIV o1 o2 o3 -> UDIV (patchOp o1) (patchOp o2) (patchOp o3) + DIVU o1 o2 o3 -> DIVU (patchOp o1) (patchOp o2) (patchOp o3) -- 2. Bit Manipulation Instructions ---------------------------------------- SBFM o1 o2 o3 o4 -> SBFM (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4) UBFM o1 o2 o3 o4 -> UBFM (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4) - SBFX o1 o2 o3 o4 -> SBFX (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4) UBFX o1 o2 o3 o4 -> UBFX (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4) - SXTB o1 o2 -> SXTB (patchOp o1) (patchOp o2) - UXTB o1 o2 -> UXTB (patchOp o1) (patchOp o2) - SXTH o1 o2 -> SXTH (patchOp o1) (patchOp o2) - UXTH o1 o2 -> UXTH (patchOp o1) (patchOp o2) -- 3. Logical and Move Instructions ---------------------------------------- AND o1 o2 o3 -> AND (patchOp o1) (patchOp o2) (patchOp o3) + OR o1 o2 o3 -> OR (patchOp o1) (patchOp o2) (patchOp o3) -- ANDS o1 o2 o3 -> ANDS (patchOp o1) (patchOp o2) (patchOp o3) ASR o1 o2 o3 -> ASR (patchOp o1) (patchOp o2) (patchOp o3) BIC o1 o2 o3 -> BIC (patchOp o1) (patchOp o2) (patchOp o3) BICS o1 o2 o3 -> BICS (patchOp o1) (patchOp o2) (patchOp o3) - EON o1 o2 o3 -> EON (patchOp o1) (patchOp o2) (patchOp o3) - EOR o1 o2 o3 -> EOR (patchOp o1) (patchOp o2) (patchOp o3) + XOR o1 o2 o3 -> XOR (patchOp o1) (patchOp o2) (patchOp o3) LSL o1 o2 o3 -> LSL (patchOp o1) (patchOp o2) (patchOp o3) LSR o1 o2 o3 -> LSR (patchOp o1) (patchOp o2) (patchOp o3) MOV o1 o2 -> MOV (patchOp o1) (patchOp o2) MOVK o1 o2 -> MOVK (patchOp o1) (patchOp o2) - MVN o1 o2 -> MVN (patchOp o1) (patchOp o2) - ORR o1 o2 o3 -> ORR (patchOp o1) (patchOp o2) (patchOp o3) + -- o3 cannot be a register for ORI (always an immediate) + ORI o1 o2 o3 -> ORI (patchOp o1) (patchOp o2) (patchOp o3) + XORI o1 o2 o3 -> XORI (patchOp o1) (patchOp o2) (patchOp o3) ROR o1 o2 o3 -> ROR (patchOp o1) (patchOp o2) (patchOp o3) TST o1 o2 -> TST (patchOp o1) (patchOp o2) @@ -560,10 +552,6 @@ data Instr | DELTA Int -- 0. Pseudo Instructions -------------------------------------------------- - | SXTB Operand Operand - | UXTB Operand Operand - | SXTH Operand Operand - | UXTH Operand Operand -- | SXTW Operand Operand -- | SXTX Operand Operand | PUSH_STACK_FRAME @@ -588,7 +576,7 @@ data Instr -- 2. Memory Load/Store Instructions --------------------------------------- -- Unlike arm, we don't have register shorthands for size. - -- We do hover have {L,S}{B,H,W,D}[U] instructions for Load/Store, Byte, Half, Word, Double, (Unsigned). + -- We do however have {L,S}{B,H,W,D}[U] instructions for Load/Store, Byte, Half, Word, Double, (Unsigned). -- Reusing the arm logic with the _format_ specifier will hopefully work. | STR Format Operand Operand -- str Xn, address-mode // Xn -> *addr | LDR Format Operand Operand -- ldr Xn, address-mode // Xn <- *addr @@ -603,7 +591,6 @@ data Instr -- | CMN Operand Operand -- rd + op2 -- | CMP Operand Operand -- rd - op2 - | MSUB Operand Operand Operand Operand -- rd = ra - rn × rm | MUL Operand Operand Operand -- rd = rn × rm @@ -612,23 +599,19 @@ data Instr -- NOT = XOR -1, x | NEG Operand Operand -- rd = -op2 - | SDIV Operand Operand Operand -- rd = rn ÷ rm + | DIV Operand Operand Operand -- rd = rn ÷ rm + | REM Operand Operand Operand -- rd = rn % rm + -- TODO: Rename: MULH | SMULH Operand Operand Operand | SMULL Operand Operand Operand - | UDIV Operand Operand Operand -- rd = rn ÷ rm + | DIVU Operand Operand Operand -- rd = rn ÷ rm -- 2. Bit Manipulation Instructions ---------------------------------------- | SBFM Operand Operand Operand Operand -- rd = rn[i,j] - -- SXTB = SBFM , , #0, #7 - -- SXTH = SBFM , , #0, #15 - -- SXTW = SBFM , , #0, #31 | UBFM Operand Operand Operand Operand -- rd = rn[i,j] - -- UXTB = UBFM , , #0, #7 - -- UXTH = UBFM , , #0, #15 -- Signed/Unsigned bitfield extract - | SBFX Operand Operand Operand Operand -- rd = rn[i,j] | UBFX Operand Operand Operand Operand -- rd = rn[i,j] -- 3. Logical and Move Instructions ---------------------------------------- @@ -637,17 +620,16 @@ data Instr -- | ASR Operand Operand Operand -- rd = rn ≫ rm or rd = rn ≫ #i, i is 6 bits | BIC Operand Operand Operand -- rd = rn & ~op2 | BICS Operand Operand Operand -- rd = rn & ~op2 - | EON Operand Operand Operand -- rd = rn ⊕ ~op2 - | EOR Operand Operand Operand -- rd = rn ⊕ op2 + | XOR Operand Operand Operand -- rd = rn ⊕ op2 -- | LSL Operand Operand Operand -- rd = rn ≪ rm or rd = rn ≪ #i, i is 6 bits -- | LSR Operand Operand Operand -- rd = rn ≫ rm or rd = rn ≫ #i, i is 6 bits | MOV Operand Operand -- rd = rn or rd = #i | MOVK Operand Operand -- | MOVN Operand Operand -- | MOVZ Operand Operand - | MVN Operand Operand -- rd = ~rn | ORN Operand Operand Operand -- rd = rn | ~op2 - | ORR Operand Operand Operand -- rd = rn | op2 + | ORI Operand Operand Operand -- rd = rn | op2 + | XORI Operand Operand Operand -- rd = rn `xor` imm | ROR Operand Operand Operand -- rd = rn ≫ rm or rd = rn ≫ #i, i is 6 bits | TST Operand Operand -- rn & op2 -- Load and stores. @@ -693,41 +675,36 @@ instrCon i = 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" + OR{} -> "OR" -- CMN{} -> "CMN" -- CMP{} -> "CMP" - MSUB{} -> "MSUB" MUL{} -> "MUL" NEG{} -> "NEG" - SDIV{} -> "SDIV" + DIV{} -> "DIV" + REM{} -> "REM" SMULH{} -> "SMULH" SMULL{} -> "SMULL" SUB{} -> "SUB" - UDIV{} -> "UDIV" + DIVU{} -> "DIVU" SBFM{} -> "SBFM" UBFM{} -> "UBFM" - SBFX{} -> "SBFX" UBFX{} -> "UBFX" AND{} -> "AND" -- ANDS{} -> "ANDS" ASR{} -> "ASR" BIC{} -> "BIC" BICS{} -> "BICS" - EON{} -> "EON" - EOR{} -> "EOR" + XOR{} -> "XOR" LSL{} -> "LSL" LSR{} -> "LSR" MOV{} -> "MOV" MOVK{} -> "MOVK" - MVN{} -> "MVN" ORN{} -> "ORN" - ORR{} -> "ORR" + ORI{} -> "ORI" + XORI{} -> "ORI" ROR{} -> "ROR" TST{} -> "TST" STR{} -> "STR" @@ -778,6 +755,7 @@ data Operand | OpRegExt Width Reg ExtMode ExtShift -- rm, [, ] | OpRegShift Width Reg ShiftMode RegShift -- rm, , <0-64> | OpImm Imm -- immediate value + -- TODO: Does OpImmShift exist in RV64? | OpImmShift Imm ShiftMode RegShift | OpAddr AddrMode -- memory reference deriving (Eq, Show) @@ -787,14 +765,14 @@ opReg :: Width -> Reg -> Operand opReg = OpReg ra_reg, sp_reg :: Reg +zero_reg = RegReal (RealRegSingle 0) ra_reg = RegReal (RealRegSingle 1) sp_reg = RegReal (RealRegSingle 2) -xzr, wzr, sp, ip0 :: Operand -xzr = OpReg W64 (RegReal (RealRegSingle 0)) -wzr = OpReg W32 (RegReal (RealRegSingle 0)) -ra = OpReg W64 (RegReal (RealRegSingle 1)) -sp = OpReg W64 (RegReal (RealRegSingle 2)) +zero, sp, ip0 :: Operand +zero = OpReg W64 zero_reg +ra = OpReg W64 ra_reg +sp = OpReg W64 sp_reg gp = OpReg W64 (RegReal (RealRegSingle 3)) tp = OpReg W64 (RegReal (RealRegSingle 4)) fp = OpReg W64 (RegReal (RealRegSingle 8)) @@ -879,16 +857,19 @@ d29 = OpReg W64 (RegReal (RealRegSingle 61)) d30 = OpReg W64 (RegReal (RealRegSingle 62)) d31 = OpReg W64 (RegReal (RealRegSingle 63)) -opRegUExt :: Width -> Reg -> Operand -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" (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" (ppr w) + +fitsIn12bitImm :: (Num a, Ord a) => a -> Bool +fitsIn12bitImm off = off >= intMin12bit && off <= intMax12bit + where + intMin12bit = -2048 + intMax12bit = 2047 + +fitsIn32bits :: (Num a, Ord a, Bits a) => a -> Bool +fitsIn32bits i = (-1 `shiftL` 31) <= i && i <= (1 `shiftL` 31 -1) + ===================================== compiler/GHC/CmmToAsm/RV64/Ppr.hs ===================================== @@ -238,12 +238,8 @@ pprImm p (ImmIndex l i) = pprAsmLabel p l <> char '+' <> int i pprImm _ (ImmLit s) = ftext s -- TODO: See pprIm below for why this is a bad idea! -pprImm _ (ImmFloat f) - | f == 0 = text "wzr" - | otherwise = float (fromRational f) -pprImm _ (ImmDouble d) - | d == 0 = text "xzr" - | otherwise = double (fromRational d) +pprImm _ (ImmFloat f) = float (fromRational f) +pprImm _ (ImmDouble d) = double (fromRational d) pprImm p (ImmConstantSum a b) = pprImm p a <> char '+' <> pprImm p b pprImm p (ImmConstantDiff a b) = pprImm p a <> char '-' @@ -278,9 +274,9 @@ pprIm platform im = case im of -- -- We could also just turn them into statics :-/ Which is what the -- PowerPC backend does. - ImmFloat f | f == 0 -> text "wzr" + ImmFloat f | f == 0 -> text "zero" ImmFloat f -> char '#' <> float (fromRational f) - ImmDouble d | d == 0 -> text "xzr" + ImmDouble d | d == 0 -> text "zero" ImmDouble d -> char '#' <> double (fromRational d) -- = pseudo instruction! ImmCLbl l -> char '=' <> pprAsmLabel platform l @@ -332,19 +328,79 @@ pprReg w r = case r of where ppr_reg_no :: Width -> Int -> doc + -- General Purpose Registers ppr_reg_no _ 0 = text "zero" + ppr_reg_no _ 1 = text "ra" ppr_reg_no _ 2 = text "sp" + ppr_reg_no _ 3 = text "gp" + ppr_reg_no _ 4 = text "tp" + ppr_reg_no _ 5 = text "t0" + ppr_reg_no _ 6 = text "t1" + ppr_reg_no _ 7 = text "t2" + ppr_reg_no _ 8 = text "s0" + ppr_reg_no _ 9 = text "s1" + ppr_reg_no _ 10 = text "a0" + ppr_reg_no _ 11 = text "a1" + ppr_reg_no _ 12 = text "a2" + ppr_reg_no _ 13 = text "a3" + ppr_reg_no _ 14 = text "a4" + ppr_reg_no _ 15 = text "a5" + ppr_reg_no _ 16 = text "a6" + ppr_reg_no _ 17 = text "a7" + ppr_reg_no _ 18 = text "s2" + ppr_reg_no _ 19 = text "s3" + ppr_reg_no _ 20 = text "s4" + ppr_reg_no _ 21 = text "s5" + ppr_reg_no _ 22 = text "s6" + ppr_reg_no _ 23 = text "s7" + ppr_reg_no _ 24 = text "s8" + ppr_reg_no _ 25 = text "s9" + ppr_reg_no _ 26 = text "s10" + ppr_reg_no _ 27 = text "s11" + ppr_reg_no _ 28 = text "t3" + ppr_reg_no _ 29 = text "t4" + ppr_reg_no _ 30 = text "t5" + ppr_reg_no _ 31 = text "t6" + + -- Floating Point Registers + ppr_reg_no _ 32 = text "ft0" + ppr_reg_no _ 33 = text "ft1" + ppr_reg_no _ 34 = text "ft2" + ppr_reg_no _ 35 = text "ft3" + ppr_reg_no _ 36 = text "ft4" + ppr_reg_no _ 37 = text "ft5" + ppr_reg_no _ 38 = text "ft6" + ppr_reg_no _ 39 = text "ft7" + ppr_reg_no _ 40 = text "fs0" + ppr_reg_no _ 41 = text "fs1" + ppr_reg_no _ 42 = text "fa0" + ppr_reg_no _ 43 = text "fa1" + ppr_reg_no _ 44 = text "fa2" + ppr_reg_no _ 45 = text "fa3" + ppr_reg_no _ 46 = text "fa4" + ppr_reg_no _ 47 = text "fa5" + ppr_reg_no _ 48 = text "fa6" + ppr_reg_no _ 49 = text "fa7" + ppr_reg_no _ 50 = text "fs2" + ppr_reg_no _ 51 = text "fs3" + ppr_reg_no _ 52 = text "fs4" + ppr_reg_no _ 53 = text "fs5" + ppr_reg_no _ 54 = text "fs6" + ppr_reg_no _ 55 = text "fs7" + ppr_reg_no _ 56 = text "fs8" + ppr_reg_no _ 57 = text "fs9" + ppr_reg_no _ 58 = text "fs10" + ppr_reg_no _ 59 = text "fs11" + ppr_reg_no _ 60 = text "ft8" + ppr_reg_no _ 61 = text "ft9" + ppr_reg_no _ 62 = text "ft10" + ppr_reg_no _ 63 = text "ft11" ppr_reg_no w i - | i < 0, w == W32 = text "wzr" - | i < 0, w == W64 = text "xzr" - | i < 0 = pprPanic "Invalid Zero Reg" (ppr w <+> int i) - -- General Purpose Registers - | i <= 31 = text "x" <> int i - -- Floating Point Registers - | i <= 63 = text "f" <> int (i-32) - -- no support for 'q'uad in GHC's NCG yet. - | otherwise = text "very naughty powerpc register" + | i < 0 = pprPanic "Unexpected register number (min is 0)" (ppr w <+> int i) + | i > 63 = pprPanic "Unexpected register number (max is 63)" (ppr w <+> int i) + -- no support for widths > W64. + | otherwise = pprPanic "Unsupported width in register (max is 64)" (ppr w <+> int i) isFloatOp :: Operand -> Bool isFloatOp (OpReg _ (RegReal (RealRegSingle i))) | i > 31 = True @@ -352,10 +408,25 @@ isFloatOp (OpReg _ (RegVirtual (VirtualRegF _))) = True isFloatOp (OpReg _ (RegVirtual (VirtualRegD _))) = True isFloatOp _ = False +isSingleOp :: Operand -> Bool +isSingleOp (OpReg W32 _) = True +isSingleOp _ = False + +isDoubleOp :: Operand -> Bool +isDoubleOp (OpReg W64 _) = True +isDoubleOp _ = False + isImmOp :: Operand -> Bool isImmOp (OpImm _) = True isImmOp _ = False +isImmZero :: Operand -> Bool +isImmZero (OpImm (ImmFloat 0)) = True +isImmZero (OpImm (ImmDouble 0)) = True +isImmZero (OpImm (ImmInt 0)) = True +isImmZero _ = False + + isLabel :: Target -> Bool isLabel (TBlock _) = True isLabel (TLabel _) = True @@ -395,68 +466,79 @@ pprInstr platform instr = case instr of -- AArch64 Instruction Set -- 1. Arithmetic Instructions ------------------------------------------------ ADD o1 o2 o3 - | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfadd") o1 o2 o3 + | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfadd." <> if isSingleOp o1 then text "s" else text "d") o1 o2 o3 + -- This case is used for sign extension: SEXT.W op + | OpReg W64 _ <- o1 , OpReg W32 _ <- o2, isImmOp o3 -> op3 (text "\taddiw") o1 o2 o3 | otherwise -> op3 (text "\tadd") o1 o2 o3 -- CMN o1 o2 -> op2 (text "\tcmn") o1 o2 -- CMP o1 o2 -- | isFloatOp o1 && isFloatOp o2 -> op2 (text "\tfcmp") o1 o2 -- | otherwise -> op2 (text "\tcmp") o1 o2 - MSUB o1 o2 o3 o4 -> op4 (text "\tmsub") o1 o2 o3 o4 MUL o1 o2 o3 - | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfmul") o1 o2 o3 + | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfmul." <> if isSingleOp o1 then text "s" else text "d") o1 o2 o3 | otherwise -> op3 (text "\tmul") o1 o2 o3 - SMULH o1 o2 o3 -> op3 (text "\tsmulh") o1 o2 o3 + SMULH o1 o2 o3 -> op3 (text "\tmulh") o1 o2 o3 SMULL o1 o2 o3 -> op3 (text "\tsmull") o1 o2 o3 NEG o1 o2 | isFloatOp o1 && isFloatOp o2 -> op2 (text "\tfneg") o1 o2 | otherwise -> op2 (text "\tneg") o1 o2 - SDIV o1 o2 o3 | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 - -> op3 (text "\tfdiv") o1 o2 o3 - SDIV o1 o2 o3 -> op3 (text "\tsdiv") o1 o2 o3 + DIV o1 o2 o3 | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 + -- TODO: This must (likely) be refined regarding width + -> op3 (text "\tfdiv." <> if isSingleOp o1 then text "s" else text "d") o1 o2 o3 + DIV o1 o2 o3 -> op3 (text "\tdiv") o1 o2 o3 + REM o1 o2 o3 | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 + -> panic $ "pprInstr - REM not implemented for floats (yet)" + REM o1 o2 o3 -> op3 (text "\trem") o1 o2 o3 SUB o1 o2 o3 - | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfsub") o1 o2 o3 + | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfsub." <> if isSingleOp o1 then text "s" else text "d") o1 o2 o3 | isImmOp o3 -> op3 (text "\taddi") o1 o2 (negOp o3) | otherwise -> op3 (text "\tsub") o1 o2 o3 - UDIV o1 o2 o3 -> op3 (text "\tudiv") o1 o2 o3 + DIVU o1 o2 o3 -> op3 (text "\tdivu") o1 o2 o3 -- 2. Bit Manipulation Instructions ------------------------------------------ SBFM o1 o2 o3 o4 -> op4 (text "\tsbfm") o1 o2 o3 o4 UBFM o1 o2 o3 o4 -> op4 (text "\tubfm") o1 o2 o3 o4 -- signed and unsigned bitfield extract - SBFX o1 o2 o3 o4 -> op4 (text "\tsbfx") o1 o2 o3 o4 UBFX o1 o2 o3 o4 -> op4 (text "\tubfx") o1 o2 o3 o4 - SXTB o1 o2 -> op2 (text "\tsxtb") o1 o2 - UXTB o1 o2 -> op2 (text "\tuxtb") o1 o2 - SXTH o1 o2 -> op2 (text "\tsxth") o1 o2 - UXTH o1 o2 -> op2 (text "\tuxth") o1 o2 -- 3. Logical and Move Instructions ------------------------------------------ AND o1 o2 o3 -> op3 (text "\tand") o1 o2 o3 + OR o1 o2 o3 -> op3 (text "\tor") o1 o2 o3 -- ANDS o1 o2 o3 -> op3 (text "\tands") o1 o2 o3 + ASR o1 o2 o3 | isImmOp o3 -> op3 (text "\tsrai") o1 o2 o3 ASR o1 o2 o3 -> op3 (text "\tsra") o1 o2 o3 BIC o1 o2 o3 -> op3 (text "\tbic") o1 o2 o3 BICS o1 o2 o3 -> op3 (text "\tbics") o1 o2 o3 - EON o1 o2 o3 -> op3 (text "\teon") o1 o2 o3 - EOR o1 o2 o3 -> op3 (text "\teor") o1 o2 o3 + XOR o1 o2 o3 -> op3 (text "\txor") o1 o2 o3 LSL o1 o2 o3 -> op3 (text "\tsll") o1 o2 o3 LSR o1 o2 o3 -> op3 (text "\tsrl") o1 o2 o3 MOV o1 o2 - | isFloatOp o1 || isFloatOp o2 -> op2 (text "\tfmov") o1 o2 + | isFloatOp o1 && isFloatOp o2 && isDoubleOp o2 -> op2 (text "\tfmv.d") o1 o2 -- fmv.d rd, rs is pseudo op fsgnj.d rd, rs, rs + | isFloatOp o1 && isFloatOp o2 && isSingleOp o2 -> op2 (text "\tfmv.s") o1 o2 -- fmv.s rd, rs is pseudo op fsgnj.s rd, rs, rs + | isFloatOp o1 && isImmZero o2 && isDoubleOp o1 -> op2 (text "\tfcvt.d.w") o1 zero + | isFloatOp o1 && isImmZero o2 && isSingleOp o1 -> op2 (text "\tfcvt.s.w") o1 zero + | isFloatOp o1 && not (isFloatOp o2) && isSingleOp o1 -> op2 (text "\tfmv.w.x") o1 o2 + | isFloatOp o1 && not (isFloatOp o2) && isDoubleOp o1 -> op2 (text "\tfmv.d.x") o1 o2 + | not (isFloatOp o1) && isFloatOp o2 && isSingleOp o2 -> op2 (text "\tfmv.x.w") o1 o2 + | not (isFloatOp o1) && isFloatOp o2 && isDoubleOp o2 -> op2 (text "\tfmv.x.d") o1 o2 | isImmOp o2 , (OpImm (ImmInteger i)) <- o2 - , (-1 `shiftL` 11) <= i - , i <= (1 `shiftL` 11 - 1) -> lines_ [ text "\taddi" <+> pprOp platform o1 <> comma <+> pprOp platform x0 <> comma <+> pprOp platform o2 ] + , fitsIn12bitImm i + -> lines_ [ text "\taddi" <+> pprOp platform o1 <> comma <+> pprOp platform x0 <> comma <+> pprOp platform o2 ] | isImmOp o2 , (OpImm (ImmInteger i)) <- o2 - , (-1 `shiftL` 31) <= i - , i <= (1 `shiftL` 31 -1) -> lines_ [ text "\tlui" <+> pprOp platform o1 <> comma <+> text "%hi(" <> pprOp platform o2 <> text ")" + , fitsIn32bits i + -> lines_ [ text "\tlui" <+> pprOp platform o1 <> comma <+> text "%hi(" <> pprOp platform o2 <> text ")" , text "\taddi" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text "%lo(" <> pprOp platform o2 <> text ")" ] + | isImmOp o2 + -- Surrender! Let the assembler figure out the right expressions with pseudo-op LI. + -> lines_ [ text "\tli" <+> pprOp platform o1 <> comma <+> pprOp platform o2 ] | otherwise -> op3 (text "\taddi") o1 o2 (OpImm (ImmInt 0)) MOVK o1 o2 -> op2 (text "\tmovk") o1 o2 - MVN o1 o2 -> op2 (text "\tmvn") o1 o2 ORN o1 o2 o3 -> op3 (text "\torn") o1 o2 o3 - ORR o1 o2 o3 -> op3 (text "\torr") o1 o2 o3 + ORI o1 o2 o3 -> op3 (text "\tori") o1 o2 o3 + XORI o1 o2 o3 -> op3 (text "\txori") o1 o2 o3 ROR o1 o2 o3 -> op3 (text "\tror") o1 o2 o3 TST o1 o2 -> op2 (text "\ttst") o1 o2 @@ -529,6 +611,10 @@ pprInstr platform instr = case instr of STR II16 o1 o2 -> op2 (text "\tsh") o1 o2 STR II32 o1 o2 -> op2 (text "\tsw") o1 o2 STR II64 o1 o2 -> op2 (text "\tsd") o1 o2 + STR FF32 o1 o2 -> op2 (text "\tfsw") o1 o2 + STR FF64 o1 o2 -> op2 (text "\tfsd") o1 o2 + STR f o1 o2 -> pprPanic "RV64.pprInstr - STR not implemented for ... " + (text "STR" <+> (text.show) f <+> pprOp platform o1 <+> pprOp platform o2) LDR _f o1 (OpImm (ImmIndex lbl off)) -> lines_ [ text "\tla" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl @@ -546,15 +632,17 @@ pprInstr platform instr = case instr of -- op_add o1 (text "%pcrel_lo(" <> pprAsmLabel platform lbl <> text ")") line $ text "\tla" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl - LDR _f o1@(OpReg W8 (RegReal (RealRegSingle i))) o2 | i < 32 -> - op2 (text "\tldrb") o1 o2 - LDR _f o1@(OpReg W16 (RegReal (RealRegSingle i))) o2 | i < 32 -> - op2 (text "\tldrh") o1 o2 + LDR _f o1@(OpReg W8 reg) o2 | isIntRealReg reg -> + op2 (text "\tlb") o1 o2 + LDR _f o1@(OpReg W16 reg) o2 | isIntRealReg reg -> + op2 (text "\tlh") o1 o2 LDR II8 o1 o2 -> op2 (text "\tlb") o1 o2 LDR II16 o1 o2 -> op2 (text "\tlh") o1 o2 LDR II32 o1 o2 -> op2 (text "\tlw") o1 o2 LDR II64 o1 o2 -> op2 (text "\tld") o1 o2 + LDR FF32 o1 o2 -> op2 (text "\tflw") o1 o2 + LDR FF64 o1 o2 -> op2 (text "\tfld") o1 o2 -- LDAR _f o1 o2 -> op2 (text "\tldar") o1 o2 -- STP _f o1 o2 o3 -> op3 (text "\tstp") o1 o2 o3 @@ -567,6 +655,7 @@ pprInstr platform instr = case instr of SCVTF o1 o2 -> op2 (text "\tscvtf") o1 o2 FCVTZS o1 o2 -> op2 (text "\tfcvtzs") o1 o2 FABS o1 o2 -> op2 (text "\tfabs") o1 o2 + instr -> panic $ "RV64.pprInstr - Unknown instruction: " ++ (instrCon instr) where op2 op o1 o2 = line $ op <+> pprOp platform o1 <> comma <+> pprOp platform o2 op3 op o1 o2 o3 = line $ op <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 op4 op o1 o2 o3 o4 = line $ op <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprOp platform o4 ===================================== compiler/GHC/CmmToAsm/RV64/Regs.hs ===================================== @@ -145,6 +145,10 @@ classOfRealReg (RealRegSingle i) | i < 32 = RcInteger | otherwise = RcDouble +isIntRealReg :: Reg -> Bool +isIntRealReg (RegReal r) = classOfRealReg r == RcInteger +isIntRealReg _ = False + regDotColor :: RealReg -> SDoc regDotColor reg = case classOfRealReg reg of ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -211,6 +211,7 @@ runTestBuilderArgs = builder Testsuite ? do (testEnv, testMetricsFile) <- expr . liftIO $ (,) <$> lookupEnv "TEST_ENV" <*> lookupEnv "METRICS_FILE" perfBaseline <- expr . liftIO $ lookupEnv "PERF_BASELINE_COMMIT" + targetWrapper <- expr . liftIO $ lookupEnv "CROSS_EMULATOR" threads <- shakeThreads <$> expr getShakeOptions top <- expr $ topDirectory @@ -280,6 +281,7 @@ runTestBuilderArgs = builder Testsuite ? do , case perfBaseline of Just commit | not (null commit) -> arg ("--perf-baseline=" ++ commit) _ -> mempty + , emitWhenSet targetWrapper $ \cmd -> arg ("--target-wrapper=" ++ cmd) , emitWhenSet testEnv $ \env -> arg ("--test-env=" ++ env) , emitWhenSet testMetricsFile $ \file -> arg ("--metrics-file=" ++ file) , getTestArgs -- User-provided arguments from command line. ===================================== tests/compiler/cmm/shift_right.cmm ===================================== @@ -0,0 +1,24 @@ +// RUN: "$HC" -debug -dppr-debug -cpp -dcmm-lint -keep-s-file -O0 -c "$1" && cat "${1%%.*}.s" | FileCheck "$1" -check-prefix=CHECK-RV64 +// RUN: "$CC" "${1%%.*}.o" -o "${1%%.*}.exe" +// RUN: "$EXEC" "${1%%.cmm}.exe" + +#include "Cmm.h" +#include "Types.h" + +main() { + I64 buffer; + I32 a, b, c, d; + + I64 arr; + (arr) = foreign "C" malloc(1024); + bits64[arr] = 2; + + a = I32[arr]; + b = %mul(a, 32 :: I32); + c = %neg(b); + d = %shra(c, 4::I64); + + foreign "C" printf("a: %hd b: %hd c: %hd d: %hd", a, b, c, d); + + foreign "C" exit(d == -4 :: I32); +} ===================================== tests/compiler/cmm/zero.cmm ===================================== @@ -0,0 +1,14 @@ +// RUN: "$HC" -cpp -dcmm-lint -keep-s-file -c "$1" && cat "${1%%.*}.s" | FileCheck "$1" -check-prefix=CHECK-RV64 +// RUN: "$CC" "${1%%.*}.o" -o "${1%%.*}.exe" +// RUN: "$EXEC" "${1%%.cmm}.exe" + +#include "Cmm.h" +#include "Types.h" + +main(){ + I64 zero; + // Should refer to the zero register + // CHECK-RV64: addi t0, zero, 0 + zero = 0; + foreign "C" exit(zero); +} ===================================== testsuite/driver/runtests.py ===================================== @@ -71,6 +71,7 @@ parser.add_argument("--config", action='append', help="config field") parser.add_argument("--rootdir", action='append', help="root of tree containing tests (default: .)") parser.add_argument("--metrics-file", help="file in which to save (append) the performance test metrics. If omitted, git notes will be used.") parser.add_argument("--summary-file", help="file in which to save the (human-readable) summary") +parser.add_argument("--target-wrapper", help="wrapper executable to use when executing binaries compiled for the target") parser.add_argument("--no-print-summary", action="store_true", help="should we print the summary?") parser.add_argument("--only", action="append", help="just this test (can be give multiple --only= flags)") parser.add_argument("--way", action="append", help="just this way") @@ -118,6 +119,7 @@ hasMetricsFile = config.metrics_file is not None config.summary_file = args.summary_file config.no_print_summary = args.no_print_summary config.baseline_commit = args.perf_baseline +config.target_wrapper = args.target_wrapper if args.top: config.top = args.top ===================================== testsuite/driver/testglobals.py ===================================== @@ -175,6 +175,11 @@ class TestConfig: # threads self.threads = 1 + # An optional executable used to wrap target code execution + # When set tests which aren't marked with TestConfig.cross_okay + # are skipped. + self.target_wrapper = None + # tests which should be considered to be broken during this testsuite # run. self.broken_tests = set() # type: Set[TestName] @@ -445,6 +450,12 @@ class TestOptions: # Should we copy the files of symlink the files for the test? self.copy_files = False + # Should the test be run in a cross-compiled tree? + # None: infer from test function + # True: run when --target-wrapper is set + # False: do not run in cross-compiled trees + self.cross_okay = None # type: Optional[bool] + # The extra hadrian dependencies we need for this particular test self.hadrian_deps = set(["test:ghc"]) # type: Set[str] ===================================== testsuite/driver/testlib.py ===================================== @@ -90,6 +90,10 @@ def setLocalTestOpts(opts: TestOptions) -> None: global testopts_local testopts_local.x = opts +def isCross() -> bool: + """ Are we testing a cross-compiler? """ + return config.target_wrapper is not None + def isCompilerStatsTest() -> bool: opts = getTestOpts() return bool(opts.is_compiler_stats_test) @@ -255,7 +259,7 @@ def req_dynamic_hs( name, opts ): opts.expect = 'fail' def req_interp( name, opts ): - if not config.have_interp: + if not config.have_interp or isCross(): opts.expect = 'fail' # JS backend doesn't provide an interpreter yet js_skip(name, opts) @@ -1080,14 +1084,21 @@ def test_common_work(name: TestName, opts, all_ways = [WayName('ghci')] else: all_ways = [] + if isCross(): + opts.cross_okay = False elif func in [makefile_test, run_command]: # makefile tests aren't necessarily runtime or compile-time # specific. Assume we can run them in all ways. See #16042 for what # happened previously. all_ways = config.compile_ways + config.run_ways + if isCross(): + opts.cross_okay = False else: all_ways = [WayName('normal')] + if isCross() and opts.cross_okay is False: + opts.skip = True + # A test itself can request extra ways by setting opts.extra_ways all_ways = list(OrderedDict.fromkeys(all_ways + [way for way in opts.extra_ways if way not in all_ways])) @@ -1813,7 +1824,10 @@ def simple_run(name: TestName, way: WayName, prog: str, extra_run_opts: str) -> stats_args = '' # Put extra_run_opts last: extra_run_opts('+RTS foo') should work. - cmd = ' '.join([prog, stats_args, my_rts_flags, extra_run_opts]) + args = [prog, stats_args, my_rts_flags, extra_run_opts] + if config.target_wrapper is not None: + args = [config.target_wrapper] + args + cmd = ' '.join(args) if opts.cmd_wrapper is not None: cmd = opts.cmd_wrapper(cmd) ===================================== testsuite/tests/codeGen/should_run/MulMayOflo.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE GHCForeignImportPrim, MagicHash, UnliftedFFITypes #-} + +module Main where +import GHC.Exts + +foreign import prim "runCmmzh" runCmm# :: Int# -> Int# + +main :: IO () +main = (print . show) (I# (runCmm# 0#)) ===================================== testsuite/tests/codeGen/should_run/MulMayOflo_cmm.cmm ===================================== @@ -0,0 +1,4 @@ +runCmmzh() { + + return(0); +} ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -229,3 +229,8 @@ test('T20640b', normal, compile_and_run, ['']) test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', normal, compile_and_run, ['-fregs-graph']) + +test('MulMayOflo', + [ omit_ways(['ghci']), js_skip], + multi_compile_and_run, + ['MulMayOflo', [('MulMayOflo_cmm.cmm', '')], '']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c5024bcbe41c5cab6429185fa4d65c67f87b8aa1...51010f35d6df756abbb57bf0ee1ceaaaa205a2bf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c5024bcbe41c5cab6429185fa4d65c67f87b8aa1...51010f35d6df756abbb57bf0ee1ceaaaa205a2bf You're receiving 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 Jun 7 09:07:57 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Wed, 07 Jun 2023 05:07:57 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T22474 Message-ID: <648048ed159bf_1d329d598ae310816880@gitlab.mail> Jaro Reinders pushed new branch wip/T22474 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22474 You're receiving 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 Jun 7 09:13:19 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Wed, 07 Jun 2023 05:13:19 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T22559 Message-ID: <64804a2f9945e_1d329d5a476dc88226e@gitlab.mail> Ryan Scott pushed new branch wip/T22559 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22559 You're receiving 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 Jun 7 09:13:51 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Wed, 07 Jun 2023 05:13:51 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/sgraf812-master-patch-08515 Message-ID: <64804a4f25999_1d329d59a55b64822884@gitlab.mail> Sebastian Graf pushed new branch wip/sgraf812-master-patch-08515 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sgraf812-master-patch-08515 You're receiving 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 Jun 7 10:07:00 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Wed, 07 Jun 2023 06:07:00 -0400 Subject: [Git][ghc/ghc][wip/int-index/decl-invis-binders] 14 commits: [hadrian] Fix multiline synopsis rendering Message-ID: <648056c43659_1d329d61fc426484681@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/decl-invis-binders at Glasgow Haskell Compiler / GHC Commits: f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Builtin/Names/TH.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Plugins.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c403d849450b9f3275cf3cc23ecf655aacdbcf51...4aea0a72040e862ab518d911057905e8cf8d15fb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c403d849450b9f3275cf3cc23ecf655aacdbcf51...4aea0a72040e862ab518d911057905e8cf8d15fb You're receiving 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 Jun 7 10:17:52 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 07 Jun 2023 06:17:52 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/t23472 Message-ID: <6480595065deb_1d329d5a4ac7848504ad@gitlab.mail> Matthew Pickering pushed new branch wip/t23472 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/t23472 You're receiving 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 Jun 7 10:25:16 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 07 Jun 2023 06:25:16 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/revert-ipe Message-ID: <64805b0cc907e_1d329d5a476dc8854437@gitlab.mail> Matthew Pickering pushed new branch wip/revert-ipe at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/revert-ipe You're receiving 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 Jun 7 11:42:15 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Wed, 07 Jun 2023 07:42:15 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] float: first stab at supporting float ins Message-ID: <64806d17d7944_1d329d5a476dc8871711@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: 51010f35 by Moritz Angermann at 2023-06-07T08:17:23+00:00 float: first stab at supporting float ins - - - - - 2 changed files: - compiler/GHC/CmmToAsm/RV64/CodeGen.hs - compiler/GHC/CmmToAsm/RV64/Ppr.hs Changes: ===================================== compiler/GHC/CmmToAsm/RV64/CodeGen.hs ===================================== @@ -535,26 +535,16 @@ getRegister' config plat expr CmmFloat _f W16 -> pprPanic "getRegister' (CmmLit:CmmFloat), no support for halfs" (pdoc plat expr) CmmFloat f W32 -> do let word = castFloatToWord32 (fromRational f) :: Word32 - half0 = fromIntegral (fromIntegral word :: Word16) - half1 = fromIntegral (fromIntegral (word `shiftR` 16) :: Word16) tmp <- getNewRegNat (intFormat W32) return (Any (floatFormat W32) (\dst -> toOL [ annExpr expr - $ MOV (OpReg W32 tmp) (OpImm (ImmInt half0)) - , MOVK (OpReg W32 tmp) (OpImmShift (ImmInt half1) SLSL 16) + $ MOV (OpReg W32 tmp) (OpImm (ImmInteger (fromIntegral word))) , MOV (OpReg W32 dst) (OpReg W32 tmp) ])) CmmFloat f W64 -> do let word = castDoubleToWord64 (fromRational f) :: Word64 - half0 = fromIntegral (fromIntegral word :: Word16) - half1 = fromIntegral (fromIntegral (word `shiftR` 16) :: Word16) - half2 = fromIntegral (fromIntegral (word `shiftR` 32) :: Word16) - half3 = fromIntegral (fromIntegral (word `shiftR` 48) :: Word16) tmp <- getNewRegNat (intFormat W64) return (Any (floatFormat W64) (\dst -> toOL [ annExpr expr - $ MOV (OpReg W64 tmp) (OpImm (ImmInt half0)) - , MOVK (OpReg W64 tmp) (OpImmShift (ImmInt half1) SLSL 16) - , MOVK (OpReg W64 tmp) (OpImmShift (ImmInt half2) SLSL 32) - , MOVK (OpReg W64 tmp) (OpImmShift (ImmInt half3) SLSL 48) + $ MOV (OpReg W64 tmp) (OpImm (ImmInteger (fromIntegral word))) , MOV (OpReg W64 dst) (OpReg W64 tmp) ])) CmmFloat _f _w -> pprPanic "getRegister' (CmmLit:CmmFloat), unsupported float lit" (pdoc plat expr) ===================================== compiler/GHC/CmmToAsm/RV64/Ppr.hs ===================================== @@ -238,12 +238,8 @@ pprImm p (ImmIndex l i) = pprAsmLabel p l <> char '+' <> int i pprImm _ (ImmLit s) = ftext s -- TODO: See pprIm below for why this is a bad idea! -pprImm _ (ImmFloat f) - | f == 0 = text "wzr" - | otherwise = float (fromRational f) -pprImm _ (ImmDouble d) - | d == 0 = text "xzr" - | otherwise = double (fromRational d) +pprImm _ (ImmFloat f) = float (fromRational f) +pprImm _ (ImmDouble d) = double (fromRational d) pprImm p (ImmConstantSum a b) = pprImm p a <> char '+' <> pprImm p b pprImm p (ImmConstantDiff a b) = pprImm p a <> char '-' @@ -278,9 +274,9 @@ pprIm platform im = case im of -- -- We could also just turn them into statics :-/ Which is what the -- PowerPC backend does. - ImmFloat f | f == 0 -> text "wzr" + ImmFloat f | f == 0 -> text "zero" ImmFloat f -> char '#' <> float (fromRational f) - ImmDouble d | d == 0 -> text "xzr" + ImmDouble d | d == 0 -> text "zero" ImmDouble d -> char '#' <> double (fromRational d) -- = pseudo instruction! ImmCLbl l -> char '=' <> pprAsmLabel platform l @@ -412,10 +408,25 @@ isFloatOp (OpReg _ (RegVirtual (VirtualRegF _))) = True isFloatOp (OpReg _ (RegVirtual (VirtualRegD _))) = True isFloatOp _ = False +isSingleOp :: Operand -> Bool +isSingleOp (OpReg W32 _) = True +isSingleOp _ = False + +isDoubleOp :: Operand -> Bool +isDoubleOp (OpReg W64 _) = True +isDoubleOp _ = False + isImmOp :: Operand -> Bool isImmOp (OpImm _) = True isImmOp _ = False +isImmZero :: Operand -> Bool +isImmZero (OpImm (ImmFloat 0)) = True +isImmZero (OpImm (ImmDouble 0)) = True +isImmZero (OpImm (ImmInt 0)) = True +isImmZero _ = False + + isLabel :: Target -> Bool isLabel (TBlock _) = True isLabel (TLabel _) = True @@ -455,7 +466,7 @@ pprInstr platform instr = case instr of -- AArch64 Instruction Set -- 1. Arithmetic Instructions ------------------------------------------------ ADD o1 o2 o3 - | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfadd") o1 o2 o3 + | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfadd." <> if isSingleOp o1 then text "s" else text "d") o1 o2 o3 -- This case is used for sign extension: SEXT.W op | OpReg W64 _ <- o1 , OpReg W32 _ <- o2, isImmOp o3 -> op3 (text "\taddiw") o1 o2 o3 | otherwise -> op3 (text "\tadd") o1 o2 o3 @@ -464,7 +475,7 @@ pprInstr platform instr = case instr of -- | isFloatOp o1 && isFloatOp o2 -> op2 (text "\tfcmp") o1 o2 -- | otherwise -> op2 (text "\tcmp") o1 o2 MUL o1 o2 o3 - | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfmul") o1 o2 o3 + | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfmul." <> if isSingleOp o1 then text "s" else text "d") o1 o2 o3 | otherwise -> op3 (text "\tmul") o1 o2 o3 SMULH o1 o2 o3 -> op3 (text "\tmulh") o1 o2 o3 SMULL o1 o2 o3 -> op3 (text "\tsmull") o1 o2 o3 @@ -473,14 +484,14 @@ pprInstr platform instr = case instr of | otherwise -> op2 (text "\tneg") o1 o2 DIV o1 o2 o3 | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -- TODO: This must (likely) be refined regarding width - -> op3 (text "\tfdiv") o1 o2 o3 + -> op3 (text "\tfdiv." <> if isSingleOp o1 then text "s" else text "d") o1 o2 o3 DIV o1 o2 o3 -> op3 (text "\tdiv") o1 o2 o3 REM o1 o2 o3 | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> panic $ "pprInstr - REM not implemented for floats (yet)" REM o1 o2 o3 -> op3 (text "\trem") o1 o2 o3 SUB o1 o2 o3 - | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfsub") o1 o2 o3 + | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfsub." <> if isSingleOp o1 then text "s" else text "d") o1 o2 o3 | isImmOp o3 -> op3 (text "\taddi") o1 o2 (negOp o3) | otherwise -> op3 (text "\tsub") o1 o2 o3 DIVU o1 o2 o3 -> op3 (text "\tdivu") o1 o2 o3 @@ -503,7 +514,14 @@ pprInstr platform instr = case instr of LSL o1 o2 o3 -> op3 (text "\tsll") o1 o2 o3 LSR o1 o2 o3 -> op3 (text "\tsrl") o1 o2 o3 MOV o1 o2 - | isFloatOp o1 || isFloatOp o2 -> op2 (text "\tfmov") o1 o2 + | isFloatOp o1 && isFloatOp o2 && isDoubleOp o2 -> op2 (text "\tfmv.d") o1 o2 -- fmv.d rd, rs is pseudo op fsgnj.d rd, rs, rs + | isFloatOp o1 && isFloatOp o2 && isSingleOp o2 -> op2 (text "\tfmv.s") o1 o2 -- fmv.s rd, rs is pseudo op fsgnj.s rd, rs, rs + | isFloatOp o1 && isImmZero o2 && isDoubleOp o1 -> op2 (text "\tfcvt.d.w") o1 zero + | isFloatOp o1 && isImmZero o2 && isSingleOp o1 -> op2 (text "\tfcvt.s.w") o1 zero + | isFloatOp o1 && not (isFloatOp o2) && isSingleOp o1 -> op2 (text "\tfmv.w.x") o1 o2 + | isFloatOp o1 && not (isFloatOp o2) && isDoubleOp o1 -> op2 (text "\tfmv.d.x") o1 o2 + | not (isFloatOp o1) && isFloatOp o2 && isSingleOp o2 -> op2 (text "\tfmv.x.w") o1 o2 + | not (isFloatOp o1) && isFloatOp o2 && isDoubleOp o2 -> op2 (text "\tfmv.x.d") o1 o2 | isImmOp o2 , (OpImm (ImmInteger i)) <- o2 , fitsIn12bitImm i @@ -593,6 +611,8 @@ pprInstr platform instr = case instr of STR II16 o1 o2 -> op2 (text "\tsh") o1 o2 STR II32 o1 o2 -> op2 (text "\tsw") o1 o2 STR II64 o1 o2 -> op2 (text "\tsd") o1 o2 + STR FF32 o1 o2 -> op2 (text "\tfsw") o1 o2 + STR FF64 o1 o2 -> op2 (text "\tfsd") o1 o2 STR f o1 o2 -> pprPanic "RV64.pprInstr - STR not implemented for ... " (text "STR" <+> (text.show) f <+> pprOp platform o1 <+> pprOp platform o2) @@ -621,8 +641,8 @@ pprInstr platform instr = case instr of LDR II16 o1 o2 -> op2 (text "\tlh") o1 o2 LDR II32 o1 o2 -> op2 (text "\tlw") o1 o2 LDR II64 o1 o2 -> op2 (text "\tld") o1 o2 - LDR f o1 o2 -> pprPanic "RV64.pprInstr - LDR not implemented for ... " - (text "LDR" <+> (text.show) f <+> pprOp platform o1 <+> pprOp platform o2) + LDR FF32 o1 o2 -> op2 (text "\tflw") o1 o2 + LDR FF64 o1 o2 -> op2 (text "\tfld") o1 o2 -- LDAR _f o1 o2 -> op2 (text "\tldar") o1 o2 -- STP _f o1 o2 o3 -> op3 (text "\tstp") o1 o2 o3 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/51010f35d6df756abbb57bf0ee1ceaaaa205a2bf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/51010f35d6df756abbb57bf0ee1ceaaaa205a2bf You're receiving 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 Jun 7 11:53:12 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Wed, 07 Jun 2023 07:53:12 -0400 Subject: [Git][ghc/ghc][wip/T22559] Consistently use validity checks for TH conversion of data constructors Message-ID: <64806fa815854_1d329d62dbf558876624@gitlab.mail> Ryan Scott pushed to branch wip/T22559 at Glasgow Haskell Compiler / GHC Commits: 1e3986b7 by Ryan Scott at 2023-06-07T13:42:20+02:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - 9 changed files: - compiler/GHC/ThToHs.hs - compiler/Language/Haskell/Syntax/Decls.hs - + testsuite/tests/th/T22559a.hs - + testsuite/tests/th/T22559a.stderr - + testsuite/tests/th/T22559b.hs - + testsuite/tests/th/T22559b.stderr - + testsuite/tests/th/T22559c.hs - + testsuite/tests/th/T22559c.stderr - testsuite/tests/th/all.T Changes: ===================================== compiler/GHC/ThToHs.hs ===================================== @@ -276,17 +276,13 @@ cvtDec (DataD ctxt tc tvs ksig constrs derivs) cvtDec (NewtypeD ctxt tc tvs ksig constr derivs) = do { (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs ; ksig' <- cvtKind `traverse` ksig - ; let first_datacon = - case get_cons_names constr of - [] -> panic "cvtDec: empty list of constructors" - c:_ -> c - ; con' <- cvtConstr first_datacon cNameN constr + ; con' <- cvtDataDefnCons False ksig $ NewTypeCon constr ; derivs' <- cvtDerivs derivs ; let defn = HsDataDefn { dd_ext = noExtField , dd_cType = Nothing , dd_ctxt = mkHsContextMaybe ctxt' , dd_kindSig = ksig' - , dd_cons = NewTypeCon con' + , dd_cons = con' , dd_derivs = derivs' } ; returnJustLA $ TyClD noExtField $ DataDecl { tcdDExt = noAnn @@ -352,17 +348,13 @@ cvtDec (DataFamilyD tc tvs kind) cvtDec (DataInstD ctxt bndrs tys ksig constrs derivs) = do { (ctxt', tc', bndrs', typats') <- cvt_datainst_hdr ctxt bndrs tys ; ksig' <- cvtKind `traverse` ksig - ; let first_datacon = - case get_cons_names $ head constrs of - [] -> panic "cvtDec: empty list of constructors" - c:_ -> c - ; cons' <- mapM (cvtConstr first_datacon cNameN) constrs + ; cons' <- cvtDataDefnCons False ksig $ DataTypeCons False constrs ; derivs' <- cvtDerivs derivs ; let defn = HsDataDefn { dd_ext = noExtField , dd_cType = Nothing , dd_ctxt = mkHsContextMaybe ctxt' , dd_kindSig = ksig' - , dd_cons = DataTypeCons False cons' + , dd_cons = cons' , dd_derivs = derivs' } ; returnJustLA $ InstD noExtField $ DataFamInstD @@ -378,17 +370,14 @@ cvtDec (DataInstD ctxt bndrs tys ksig constrs derivs) cvtDec (NewtypeInstD ctxt bndrs tys ksig constr derivs) = do { (ctxt', tc', bndrs', typats') <- cvt_datainst_hdr ctxt bndrs tys ; ksig' <- cvtKind `traverse` ksig - ; let first_datacon = - case get_cons_names constr of - [] -> panic "cvtDec: empty list of constructors" - c:_ -> c - ; con' <- cvtConstr first_datacon cNameN constr + ; con' <- cvtDataDefnCons False ksig $ NewTypeCon constr ; derivs' <- cvtDerivs derivs ; let defn = HsDataDefn { dd_ext = noExtField , dd_cType = Nothing , dd_ctxt = mkHsContextMaybe ctxt' , dd_kindSig = ksig' - , dd_cons = NewTypeCon con', dd_derivs = derivs' } + , dd_cons = con' + , dd_derivs = derivs' } ; returnJustLA $ InstD noExtField $ DataFamInstD { dfid_ext = noExtField , dfid_inst = DataFamInstDecl { dfid_eqn = @@ -497,6 +486,28 @@ cvtGenDataDec :: Bool -> TH.Cxt -> TH.Name -> [TH.TyVarBndr ()] -> Maybe TH.Kind -> [TH.Con] -> [TH.DerivClause] -> CvtM (Maybe (LHsDecl GhcPs)) cvtGenDataDec type_data ctxt tc tvs ksig constrs derivs + = do { (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs + ; ksig' <- cvtKind `traverse` ksig + ; cons' <- cvtDataDefnCons type_data ksig $ + DataTypeCons type_data constrs + ; derivs' <- cvtDerivs derivs + ; let defn = HsDataDefn { dd_ext = noExtField + , dd_cType = Nothing + , dd_ctxt = mkHsContextMaybe ctxt' + , dd_kindSig = ksig' + , dd_cons = cons' + , dd_derivs = derivs' } + ; returnJustLA $ TyClD noExtField $ + DataDecl { tcdDExt = noAnn + , tcdLName = tc', tcdTyVars = tvs' + , tcdFixity = Prefix + , tcdDataDefn = defn } } + +-- Convert a set of data constructors. +cvtDataDefnCons :: + Bool -> Maybe TH.Kind -> + DataDefnCons TH.Con -> CvtM (DataDefnCons (LConDecl GhcPs)) +cvtDataDefnCons type_data ksig constrs = do { let isGadtCon (GadtC _ _ _) = True isGadtCon (RecGadtC _ _ _) = True isGadtCon (ForallC _ _ c) = isGadtCon c @@ -514,27 +525,16 @@ cvtGenDataDec type_data ctxt tc tvs ksig constrs derivs (failWith CannotMixGADTConsWith98Cons) ; unless (isNothing ksig || isGadtDecl) (failWith KindSigsOnlyAllowedOnGADTs) - ; (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs - ; ksig' <- cvtKind `traverse` ksig ; let first_datacon = - case get_cons_names $ head constrs of - [] -> panic "cvtGenDataDec: empty list of constructors" + case firstDataDefnCon constrs of + Nothing -> panic "cvtDataDefnCons: empty list of constructors" + Just con -> con + first_datacon_name = + case get_cons_names first_datacon of + [] -> panic "cvtDataDefnCons: data constructor with no names" c:_ -> c - ; cons' <- mapM (cvtConstr first_datacon con_name) constrs - - ; derivs' <- cvtDerivs derivs - ; let defn = HsDataDefn { dd_ext = noExtField - , dd_cType = Nothing - , dd_ctxt = mkHsContextMaybe ctxt' - , dd_kindSig = ksig' - , dd_cons = DataTypeCons type_data cons' - , dd_derivs = derivs' } - ; returnJustLA $ TyClD noExtField $ - DataDecl { tcdDExt = noAnn - , tcdLName = tc', tcdTyVars = tvs' - , tcdFixity = Prefix - , tcdDataDefn = defn } } + ; mapM (cvtConstr first_datacon_name con_name) constrs } ---------------- cvtTySynEqn :: TySynEqn -> CvtM (LTyFamInstEqn GhcPs) ===================================== compiler/Language/Haskell/Syntax/Decls.hs ===================================== @@ -30,7 +30,7 @@ module Language.Haskell.Syntax.Decls ( HsDecl(..), LHsDecl, HsDataDefn(..), HsDeriving, LHsFunDep, FunDep(..), HsDerivingClause(..), LHsDerivingClause, DerivClauseTys(..), LDerivClauseTys, NewOrData(..), DataDefnCons(..), dataDefnConsNewOrData, - isTypeDataDefnCons, + isTypeDataDefnCons, firstDataDefnCon, StandaloneKindSig(..), LStandaloneKindSig, -- ** Class or type declarations @@ -1040,6 +1040,11 @@ isTypeDataDefnCons :: DataDefnCons a -> Bool isTypeDataDefnCons (NewTypeCon _) = False isTypeDataDefnCons (DataTypeCons is_type_data _) = is_type_data +-- | Retrieve the first data constructor in a 'DataDefnCons' (if one exists). +firstDataDefnCon :: DataDefnCons a -> Maybe a +firstDataDefnCon (NewTypeCon con) = Just con +firstDataDefnCon (DataTypeCons _ cons) = listToMaybe cons + -- | Located data Constructor Declaration type LConDecl pass = XRec pass (ConDecl pass) -- ^ May have 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnSemi' when ===================================== testsuite/tests/th/T22559a.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TemplateHaskell #-} +module T22559a where + +import Language.Haskell.TH + +$(pure [NewtypeD + [] (mkName "D") [] (Just StarT) + (NormalC (mkName "MkD") + [( Bang NoSourceUnpackedness NoSourceStrictness + , ConT ''Int + )]) + []]) ===================================== testsuite/tests/th/T22559a.stderr ===================================== @@ -0,0 +1,4 @@ + +T22559a.hs:7:2: error: [GHC-40746] + Kind signatures are only allowed on GADTs + When splicing a TH declaration: newtype D :: * = MkD GHC.Types.Int ===================================== testsuite/tests/th/T22559b.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +module T22559b where + +import Language.Haskell.TH + +data family D + +$(pure [DataInstD + [] Nothing + (ConT (mkName "D")) (Just StarT) + [NormalC (mkName "MkD") + [( Bang NoSourceUnpackedness NoSourceStrictness + , ConT ''Int + )]] + []]) ===================================== testsuite/tests/th/T22559b.stderr ===================================== @@ -0,0 +1,5 @@ + +T22559b.hs:10:2: error: [GHC-40746] + Kind signatures are only allowed on GADTs + When splicing a TH declaration: + data instance D :: * = MkD GHC.Types.Int ===================================== testsuite/tests/th/T22559c.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +module T22559c where + +import Language.Haskell.TH + +data family D + +$(pure [NewtypeInstD + [] Nothing + (ConT (mkName "D")) (Just StarT) + (NormalC (mkName "MkD") + [( Bang NoSourceUnpackedness NoSourceStrictness + , ConT ''Int + )]) + []]) ===================================== testsuite/tests/th/T22559c.stderr ===================================== @@ -0,0 +1,5 @@ + +T22559c.hs:10:2: error: [GHC-40746] + Kind signatures are only allowed on GADTs + When splicing a TH declaration: + newtype instance D :: * = MkD GHC.Types.Int ===================================== testsuite/tests/th/all.T ===================================== @@ -573,3 +573,6 @@ test('TH_typed3', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('TH_typed4', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('TH_typed5', normal, compile_and_run, ['']) test('T21050', normal, compile_fail, ['']) +test('T22559a', normal, compile_fail, ['']) +test('T22559b', normal, compile_fail, ['']) +test('T22559c', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e3986b7d601a16b33b4d99d7618fa9d8c3d224e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e3986b7d601a16b33b4d99d7618fa9d8c3d224e You're receiving 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 Jun 7 12:50:07 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Wed, 07 Jun 2023 08:50:07 -0400 Subject: [Git][ghc/ghc][wip/T22474] 12 commits: Big TcLclEnv and CtLoc refactoring Message-ID: <64807cff33462_1d329d5cf49b409053a5@gitlab.mail> Jaro Reinders pushed to branch wip/T22474 at Glasgow Haskell Compiler / GHC Commits: 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 63430756 by Jaro Reinders at 2023-06-07T14:49:52+02:00 Fix #22474 - - - - - 30 changed files: - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/Plugins.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Errors/Hole/FitTypes.hs - − compiler/GHC/Tc/Errors/Hole/FitTypes.hs-boot - + compiler/GHC/Tc/Errors/Hole/Plugin.hs - + compiler/GHC/Tc/Errors/Hole/Plugin.hs-boot - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - + compiler/GHC/Tc/Errors/Types/PromotionErr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bc89925013cc154da9b7f39d5a017d6c26133f0e...63430756743ee80a6bad029920edf73c92fc22b9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bc89925013cc154da9b7f39d5a017d6c26133f0e...63430756743ee80a6bad029920edf73c92fc22b9 You're receiving 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 Jun 7 13:09:41 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 07 Jun 2023 09:09:41 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Generate Addr# access ops programmatically Message-ID: <648081952a795_1d329d51686d4c907824@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - 79bd0e01 by Josh Meredith at 2023-06-07T09:09:37-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - 30 changed files: - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Builtin/Names/TH.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/TyCon.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Quote.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/Splice.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Zonk/TcType.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/Language/Haskell/Syntax/Type.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/exts/primitives.rst - docs/users_guide/exts/type_abstractions.rst - hadrian/src/Rules/Generate.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/ede1f236c63e4d5c5c1c8c03b52c37656584fa90...79bd0e011088837b561c19005ce1388bc4bb1c6c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ede1f236c63e4d5c5c1c8c03b52c37656584fa90...79bd0e011088837b561c19005ce1388bc4bb1c6c You're receiving 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 Jun 7 15:12:20 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 07 Jun 2023 11:12:20 -0400 Subject: [Git][ghc/ghc][wip/T23323] 64 commits: Introduce GHCiMessage to wrap GhcMessage Message-ID: <64809e549dd8_1d329d61fc4264940076@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23323 at Glasgow Haskell Compiler / GHC Commits: f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 57f47497 by Simon Peyton Jones at 2023-06-07T17:06:31+02:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Builtin/Types/Prim.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CmdLine.hs - compiler/GHC/Driver/CodeOutput.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6249d0067e8f085452f540bb803fd98f69002a72...57f474976329626987b191b8bef5375df7df1fdb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6249d0067e8f085452f540bb803fd98f69002a72...57f474976329626987b191b8bef5375df7df1fdb You're receiving 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 Jun 7 17:10:03 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 07 Jun 2023 13:10:03 -0400 Subject: [Git][ghc/ghc][master] Invisible binders in type declarations (#22560) Message-ID: <6480b9ebad5b2_208850c47c0518c1@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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: - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Quote.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/Splice.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Zonk/TcType.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/Language/Haskell/Syntax/Type.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/exts/primitives.rst - docs/users_guide/exts/type_abstractions.rst - libraries/ghci/GHCi/TH/Binary.hs - libraries/template-haskell/Language/Haskell/TH.hs - libraries/template-haskell/Language/Haskell/TH/Lib.hs - libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs - libraries/template-haskell/Language/Haskell/TH/Ppr.hs - 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/-/commit/4aea0a72040e862ab518d911057905e8cf8d15fb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4aea0a72040e862ab518d911057905e8cf8d15fb You're receiving 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 Jun 7 17:10:40 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 07 Jun 2023 13:10:40 -0400 Subject: [Git][ghc/ghc][master] JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) Message-ID: <6480ba10a91_208850c47d4551b0@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - 1 changed file: - libraries/base/System/Posix/Internals.hs Changes: ===================================== libraries/base/System/Posix/Internals.hs ===================================== @@ -499,71 +499,71 @@ foreign import ccall unsafe "HsBase.h __hscore_lstat" #if defined(javascript_HOST_ARCH) foreign import javascript unsafe "(() => { return rts_isThreaded; })" rtsIsThreaded_ :: Int -foreign import javascript interruptible "(($1_1, $2_2, $2, $c) => { return h$base_access($1_1,$2_2,$2,$c); })" +foreign import javascript interruptible "h$base_access" c_access :: CString -> CInt -> IO CInt -foreign import javascript interruptible "(($1_1, $2_2, $2, $c) => { return h$base_chmod($1_1,$2_2,$2,$c); })" +foreign import javascript interruptible "h$base_chmod" c_chmod :: CString -> CMode -> IO CInt -foreign import javascript interruptible "(($1,$c) => { return h$base_close($1,$c); })" +foreign import javascript interruptible "h$base_close" c_close :: CInt -> IO CInt -foreign import javascript interruptible "(($1, $c) => { return h$base_creat($1,$c); })" +foreign import javascript interruptible "h$base_creat" c_creat :: CString -> CMode -> IO CInt -foreign import javascript interruptible "(($1, $c) => { return h$base_dup($1, $c); })" +foreign import javascript interruptible "h$base_dup" c_dup :: CInt -> IO CInt -foreign import javascript interruptible "(($1, $2, $c) => { return h$base_dup2($1,$2,$c); })" +foreign import javascript interruptible "h$base_dup2" c_dup2 :: CInt -> CInt -> IO CInt -foreign import javascript interruptible "(($1,$2_1,$2_2,$c) => { return h$base_fstat($1,$2_1,$2_2,$c); })" -- fixme wrong type +foreign import javascript interruptible "h$base_fstat" -- fixme wrong type c_fstat :: CInt -> Ptr CStat -> IO CInt -foreign import javascript unsafe "(($1) => { return h$base_isatty($1); })" +foreign import javascript unsafe "h$base_isatty" c_isatty :: CInt -> IO CInt -foreign import javascript interruptible "(($1,$2_1,$2_2,$3,$c) => { return h$base_lseek($1,$2_1,$2_2,$3,$c); })" +foreign import javascript interruptible "h$base_lseek" c_lseek :: CInt -> COff -> CInt -> IO COff -foreign import javascript interruptible "(($1_1,$1_2,$2_1,$2_2,$c) => { return h$base_lstat($1_1,$1_2,$2_1,$2_2,$c); })" -- fixme wrong type +foreign import javascript interruptible "h$base_lstat" -- fixme wrong type lstat :: CFilePath -> Ptr CStat -> IO CInt -foreign import javascript interruptible "(($1_1,$1_2,$2,$3,$c) => { return h$base_open($1_1,$1_2,$2,$3,$c); })" +foreign import javascript interruptible "h$base_open" c_open :: CFilePath -> CInt -> CMode -> IO CInt -foreign import javascript interruptible "(($1_1,$1_2,$2,$3,$c) => { return h$base_open($1_1,$1_2,$2,$3,$c); })" +foreign import javascript interruptible "h$base_open" c_interruptible_open_ :: CFilePath -> CInt -> CMode -> IO CInt -foreign import javascript interruptible "(($1_1,$1_2,$2,$3,$c) => { return h$base_open($1_1,$1_2,$2,$3,$c); })" +foreign import javascript interruptible "h$base_open" c_safe_open_ :: CFilePath -> CInt -> CMode -> IO CInt -foreign import javascript interruptible "(($1,$2_1,$2_2,$3,$c) => { return h$base_read($1,$2_1,$2_2,$3,$c); })" +foreign import javascript interruptible "h$base_read" c_read :: CInt -> Ptr Word8 -> CSize -> IO CSsize -foreign import javascript interruptible "(($1,$2_1,$2_2,$3,$c) => { return h$base_read($1,$2_1,$2_2,$3,$c); })" +foreign import javascript interruptible "h$base_read" c_safe_read :: CInt -> Ptr Word8 -> CSize -> IO CSsize -foreign import javascript interruptible "(($1_1,$1_2,$2_1,$2_2,$c) => { return h$base_stat($1_1,$1_2,$2_1,$2_2,$c); })" -- fixme wrong type +foreign import javascript interruptible "h$base_stat" -- fixme wrong type c_stat :: CFilePath -> Ptr CStat -> IO CInt -foreign import javascript unsafe "(($1) => { return h$base_umask($1); })" +foreign import javascript unsafe "h$base_umask" c_umask :: CMode -> IO CMode -foreign import javascript interruptible "(($1,$2_1,$2_2,$3,$c) => { return h$base_write($1,$2_1,$2_2,$3,$c); })" +foreign import javascript interruptible "h$base_write" c_write :: CInt -> Ptr Word8 -> CSize -> IO CSsize -foreign import javascript interruptible "(($1,$2_1,$2_2,$3,$c) => { return h$base_write($1,$2_1,$2_2,$3,$c); })" +foreign import javascript interruptible "h$base_write" c_safe_write :: CInt -> Ptr Word8 -> CSize -> IO CSsize -foreign import javascript interruptible "(($1,$2_1,$2_2,$c) => { return h$base_ftruncate($1,$2_1,$2_2,$c); })" -- fixme COff +foreign import javascript interruptible "h$base_ftruncate" -- fixme COff c_ftruncate :: CInt -> FileOffset -> IO CInt -foreign import javascript interruptible "(($1_1,$1_2,$c) => { return h$base_unlink($1_1,$1_2,$c); })" +foreign import javascript interruptible "h$base_unlink" c_unlink :: CString -> IO CInt foreign import javascript unsafe "h$base_getpid" c_getpid :: IO CPid -- foreign import ccall unsafe "HsBase.h fork" -- c_fork :: IO CPid -foreign import javascript interruptible "($1_1,$1_2,$2_1,$2_2,$c) => { return h$base_link($1_1,$1_2,$2_1,$2_2,$c); })" +foreign import javascript interruptible "h$base_link" c_link :: CString -> CString -> IO CInt -foreign import javascript interruptible "(($1_1,$1_2,$2,$c) => { return h$base_mkfifo($1_1,$1_2,$2,$c); })" +foreign import javascript interruptible "h$base_mkfifo" c_mkfifo :: CString -> CMode -> IO CInt -foreign import javascript interruptible "(($1_1,$1_2,$c) => { return h$base_pipe($1_1,$1_2,$c); })" +foreign import javascript interruptible "h$base_pipe" c_pipe :: Ptr CInt -> IO CInt -foreign import javascript unsafe "(($1_1,$1_2) => { return h$base_sigemptyset($1_1,$1_2); })" +foreign import javascript unsafe "h$base_sigemptyset" c_sigemptyset :: Ptr CSigset -> IO CInt -foreign import javascript unsafe "(($1_1,$1_2,$2) => { return h$base_sigaddset($1_1,$1_2,$2); })" +foreign import javascript unsafe "h$base_sigaddset" c_sigaddset :: Ptr CSigset -> CInt -> IO CInt -foreign import javascript unsafe "(($1,$2_1,$2_2,$3_1,$3_2) => { return h$base_sigprocmask($1,$2_1,$2_2,$3_1,$3_2); })" +foreign import javascript unsafe "h$base_sigprocmask" c_sigprocmask :: CInt -> Ptr CSigset -> Ptr CSigset -> IO CInt -foreign import javascript unsafe "(($1,$2_1,$2_2) => { return h$base_tcgetattr($1,$2_1,$2_2); })" +foreign import javascript unsafe "h$base_tcgetattr" c_tcgetattr :: CInt -> Ptr CTermios -> IO CInt -foreign import javascript unsafe "(($1,$2,$3_1,$3_2) => { return h$base_tcsetattr($1,$2,$3_1,$3_2); })" +foreign import javascript unsafe "h$base_tcsetattr" c_tcsetattr :: CInt -> CInt -> Ptr CTermios -> IO CInt -foreign import javascript unsafe "(($1_1,$1_2,$2_1,$2_2) => { return h$base_utime($1_1,$1_2,$2_1,$2_2); })" -- should this be async? +foreign import javascript unsafe "h$base_utime" -- should this be async? c_utime :: CString -> Ptr CUtimbuf -> IO CInt -foreign import javascript interruptible "(($1,$2_1,$2_2,$3,$c) => { return h$base_waitpid($1,$2_1,$2_2,$3,$c); })" +foreign import javascript interruptible "h$base_waitpid" c_waitpid :: CPid -> Ptr CInt -> CInt -> IO CPid foreign import javascript unsafe "(() => { return h$base_o_rdonly; })" o_RDONLY :: CInt @@ -577,11 +577,11 @@ foreign import javascript unsafe "(() => { return h$base_o_noctty; })" o_NOCTT foreign import javascript unsafe "(() => { return h$base_o_nonblock; })" o_NONBLOCK :: CInt foreign import javascript unsafe "(() => { return h$base_o_binary; })" o_BINARY :: CInt -foreign import javascript unsafe "(($1) => { return h$base_c_s_isreg($1); })" c_s_isreg :: CMode -> CInt -foreign import javascript unsafe "(($1) => { return h$base_c_s_ischr($1); })" c_s_ischr :: CMode -> CInt -foreign import javascript unsafe "(($1) => { return h$base_c_s_isblk($1); })" c_s_isblk :: CMode -> CInt -foreign import javascript unsafe "(($1) => { return h$base_c_s_isdir($1); })" c_s_isdir :: CMode -> CInt -foreign import javascript unsafe "(($1) => { return h$base_c_s_isfifo($1); })" c_s_isfifo :: CMode -> CInt +foreign import javascript unsafe "h$base_c_s_isreg" c_s_isreg :: CMode -> CInt +foreign import javascript unsafe "h$base_c_s_ischr" c_s_ischr :: CMode -> CInt +foreign import javascript unsafe "h$base_c_s_isblk" c_s_isblk :: CMode -> CInt +foreign import javascript unsafe "h$base_c_s_isdir" c_s_isdir :: CMode -> CInt +foreign import javascript unsafe "h$base_c_s_isfifo" c_s_isfifo :: CMode -> CInt s_isreg :: CMode -> Bool s_isreg cm = c_s_isreg cm /= 0 @@ -595,11 +595,11 @@ s_isfifo :: CMode -> Bool s_isfifo cm = c_s_isfifo cm /= 0 foreign import javascript unsafe "(() => { return h$base_sizeof_stat; })" sizeof_stat :: Int -foreign import javascript unsafe "(($1_1,$1_2) => { return h$base_st_mtime($1_1,$1_2); })" st_mtime :: Ptr CStat -> IO CTime -foreign import javascript unsafe "(($1_1,$1_2) => { return h$base_st_size($1_1,$1_2); })" st_size :: Ptr CStat -> IO Int64 -foreign import javascript unsafe "(($1_1,$1_2) => { return h$base_st_mode($1_1,$1_2); })" st_mode :: Ptr CStat -> IO CMode -foreign import javascript unsafe "(($1_1,$1_2) => { return h$base_st_dev($1_1,$1_2); })" st_dev :: Ptr CStat -> IO CDev -foreign import javascript unsafe "(($1_1,$1_2) => { return h$base_st_ino($1_1,$1_2); })" st_ino :: Ptr CStat -> IO CIno +foreign import javascript unsafe "h$base_st_mtime" st_mtime :: Ptr CStat -> IO CTime +foreign import javascript unsafe "h$base_st_size" st_size :: Ptr CStat -> IO Int64 +foreign import javascript unsafe "h$base_st_mode" st_mode :: Ptr CStat -> IO CMode +foreign import javascript unsafe "h$base_st_dev" st_dev :: Ptr CStat -> IO CDev +foreign import javascript unsafe "h$base_st_ino" st_ino :: Ptr CStat -> IO CIno foreign import javascript unsafe "(() => { return h$base_echo; })" const_echo :: CInt foreign import javascript unsafe "(() => { return h$base_tcsanow; })" const_tcsanow :: CInt @@ -615,21 +615,21 @@ foreign import javascript unsafe "(() => { return h$base_f_setfd; })" co foreign import javascript unsafe "(() => { return h$base_fd_cloexec; })" const_fd_cloexec :: CLong foreign import javascript unsafe "(() => { return h$base_sizeof_termios; })" sizeof_termios :: Int foreign import javascript unsafe "(() => { return h$base_sizeof_sigset_t; })" sizeof_sigset_t :: Int -foreign import javascript unsafe "(($1_1,$1_2) => { return h$base_lflag($1_1,$1_2); })" c_lflag :: Ptr CTermios -> IO CTcflag -foreign import javascript unsafe "(($1_1,$1_2,$2) => { return h$base_poke_lflag($1_1,$1_2,$2); })" poke_c_lflag :: Ptr CTermios -> CTcflag -> IO () -foreign import javascript unsafe "(($1_1,$1_2) => { return h$base_ptr_c_cc($1_1,$1_2); })" ptr_c_cc :: Ptr CTermios -> IO (Ptr Word8) +foreign import javascript unsafe "h$base_lflag" c_lflag :: Ptr CTermios -> IO CTcflag +foreign import javascript unsafe "h$base_poke_lflag" poke_c_lflag :: Ptr CTermios -> CTcflag -> IO () +foreign import javascript unsafe "h$base_ptr_c_cc" ptr_c_cc :: Ptr CTermios -> IO (Ptr Word8) s_issock :: CMode -> Bool s_issock cmode = c_s_issock cmode /= 0 -foreign import javascript unsafe "(($1) => { return h$base_c_s_issock($1); })" c_s_issock :: CMode -> CInt +foreign import javascript unsafe "h$base_c_s_issock" c_s_issock :: CMode -> CInt foreign import javascript unsafe "(() => { return h$base_default_buffer_size; })" dEFAULT_BUFFER_SIZE :: Int foreign import javascript unsafe "(() => { return h$base_SEEK_CUR; })" sEEK_CUR :: CInt foreign import javascript unsafe "(() => { return h$base_SEEK_SET; })" sEEK_SET :: CInt foreign import javascript unsafe "(() => { return h$base_SEEK_END; })" sEEK_END :: CInt -- fixme, unclear if these can be supported, remove? -foreign import javascript unsafe "(($1, $2) => { return h$base_c_fcntl_read($1,$2); })" c_fcntl_read :: CInt -> CInt -> IO CInt -foreign import javascript unsafe "(($1, $2, $3) => { return h$base_c_fcntl_write($1,$2,$3); })" c_fcntl_write :: CInt -> CInt -> CLong -> IO CInt -foreign import javascript unsafe "(($1,$2,$3_1,$3_2) => { return h$base_c_fcntl_lock($1,$2,$3_1,$3_2); })" c_fcntl_lock :: CInt -> CInt -> Ptr CFLock -> IO CInt +foreign import javascript unsafe "h$base_c_fcntl_read" c_fcntl_read :: CInt -> CInt -> IO CInt +foreign import javascript unsafe "h$base_c_fcntl_write" c_fcntl_write :: CInt -> CInt -> CLong -> IO CInt +foreign import javascript unsafe "h$base_c_fcntl_lock" c_fcntl_lock :: CInt -> CInt -> Ptr CFLock -> IO CInt #else View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b76009974ff34fe7730fc0343a1977dd1a3183e2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b76009974ff34fe7730fc0343a1977dd1a3183e2 You're receiving 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 Jun 7 17:22:41 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Wed, 07 Jun 2023 13:22:41 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/t23487 Message-ID: <6480bce1ccd6e_2088509c1be863068@gitlab.mail> Finley McIlwaine pushed new branch wip/t23487 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/t23487 You're receiving 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 Jun 7 17:30:09 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Wed, 07 Jun 2023 13:30:09 -0400 Subject: [Git][ghc/ghc][wip/t23487] 4 commits: Invisible binders in type declarations (#22560) Message-ID: <6480bea1eb52e_2088501045e8868655@gitlab.mail> Finley McIlwaine pushed to branch wip/t23487 at Glasgow Haskell Compiler / GHC Commits: 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - 6292778e by Finley McIlwaine at 2023-06-07T17:30:07+00:00 Fix incompatible pointer type warnings - - - - - 09e1e490 by Finley McIlwaine at 2023-06-07T17:30:07+00:00 Remove IPE compression config from deb10 nightly Fixes #23487 - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Quote.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/Splice.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Zonk/TcType.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/Language/Haskell/Syntax/Type.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/exts/primitives.rst - docs/users_guide/exts/type_abstractions.rst - libraries/base/System/Posix/Internals.hs - libraries/ghci/GHCi/TH/Binary.hs - libraries/template-haskell/Language/Haskell/TH.hs - libraries/template-haskell/Language/Haskell/TH/Lib.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/97dd850ed7ed03d708e60bdbd1340405db015e67...09e1e490e2b1e75fbdd8ae56a9220a6707fef0f3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/97dd850ed7ed03d708e60bdbd1340405db015e67...09e1e490e2b1e75fbdd8ae56a9220a6707fef0f3 You're receiving 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 Jun 7 17:41:51 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 07 Jun 2023 13:41:51 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 13 commits: JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) Message-ID: <6480c15ff19bd_208850aa2198740dc@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - f2aa3929 by Sebastian Graf at 2023-06-07T13:41:20-04:00 Update CODEOWNERS - - - - - 68decb14 by Matthew Pickering at 2023-06-07T13:41:20-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - 1678122e by Matthew Pickering at 2023-06-07T13:41:20-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - ac068d8f by Matthew Pickering at 2023-06-07T13:41:20-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - 08db6535 by Matthew Pickering at 2023-06-07T13:41:20-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 5986b6bf by Matthew Pickering at 2023-06-07T13:41:20-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 50da6d88 by Matthew Pickering at 2023-06-07T13:41:20-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3415cd9d by Matthew Pickering at 2023-06-07T13:41:20-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - d2a31742 by Matthew Pickering at 2023-06-07T13:41:20-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 51a65145 by Matthew Pickering at 2023-06-07T13:41:20-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - cb148618 by Matthew Pickering at 2023-06-07T13:41:20-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 06112cd1 by Matthew Pickering at 2023-06-07T13:41:20-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 24 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - CODEOWNERS - compiler/GHC/StgToCmm/InfoTableProv.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 - libraries/base/System/Posix/Internals.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/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 ===================================== @@ -141,7 +141,6 @@ data BuildConfig , llvmBootstrap :: Bool , withAssertions :: Bool , withNuma :: Bool - , withZstd :: Bool , crossTarget :: Maybe String , crossEmulator :: CrossEmulator , configureWrapper :: Maybe String @@ -155,11 +154,10 @@ 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 @@ -174,12 +172,8 @@ mkJobFlavour BuildConfig{..} = Flavour buildFlavour opts 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 @@ -198,7 +192,6 @@ vanilla = BuildConfig , llvmBootstrap = False , withAssertions = False , withNuma = False - , withZstd = False , crossTarget = Nothing , crossEmulator = NoEmulator , configureWrapper = Nothing @@ -231,9 +224,6 @@ debug = vanilla { buildFlavour = SlowValidate , withNuma = True } -zstdIpe :: BuildConfig -zstdIpe = vanilla { withZstd = True } - static :: BuildConfig static = vanilla { fullyStatic = True } @@ -323,18 +313,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) = base_string base ++ concatMap (("+" ++) . flavour_string) trans +flavourString (Flavour base trans) = baseString base ++ concatMap (("+" ++) . flavourString) trans where - base_string Release = "release" - base_string Validate = "validate" - base_string SlowValidate = "slow-validate" + baseString Release = "release" + baseString Validate = "validate" + baseString SlowValidate = "slow-validate" - 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 BootNonmovingGc = "boot_nonmoving_gc" + flavourString Llvm = "llvm" + flavourString Dwarf = "debug_info" + 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 @@ -527,7 +517,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 rulesList +enumRules o = map lkup rules where enabled_rules = rule_set o lkup r = OnOffRule (if S.member r enabled_rules then On else Off) r @@ -563,7 +553,6 @@ data Rule = FastCI -- ^ Run this job when the fast-ci label is set | 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. - | IpeData -- ^ Only run this job when the "IPE" label is set | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) @@ -590,14 +579,12 @@ 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 -rulesList :: [Rule] -rulesList = [minBound .. maxBound] +rules :: [Rule] +rules = [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 @@ -886,7 +873,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) zstdIpe) , -- Nightly allowed to fail: #22520 modifyNightlyJobs allowFailure (modifyValidateJobs manual tsan_jobs) @@ -894,7 +880,7 @@ job_groups = modifyNightlyJobs allowFailure (modifyValidateJobs manual (validateBuilds Amd64 (Linux Debian10) noTntc)) , addValidateRule LLVMBackend (validateBuilds Amd64 (Linux Debian10) llvm) - , addValidateRule IpeData (validateBuilds Amd64 (Linux Debian10) zstdIpe) + , 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\") && (\"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\") && (\"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\") && (\"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\") && (\"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\") && (\"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\") && (\"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\") && (\"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\") && (\"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\") && (\"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\") && (\"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" } ], @@ -641,7 +641,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -703,7 +703,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -765,7 +765,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -826,7 +826,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -887,7 +887,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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\") && (\"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" } ], @@ -1008,7 +1008,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1067,7 +1067,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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\") && (\"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" } ], @@ -1186,7 +1186,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1245,7 +1245,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1264,7 +1264,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "CONFIGURE_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -1304,7 +1304,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1363,7 +1363,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1422,7 +1422,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1483,7 +1483,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1544,7 +1544,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1606,7 +1606,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1665,7 +1665,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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 +1725,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1784,7 +1784,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1845,7 +1845,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1907,7 +1907,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1968,7 +1968,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2028,7 +2028,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2087,7 +2087,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2142,7 +2142,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2201,7 +2201,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2264,7 +2264,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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 +2328,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2389,7 +2389,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2450,7 +2450,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2516,7 +2516,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2579,7 +2579,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2642,7 +2642,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2705,7 +2705,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2766,7 +2766,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2827,7 +2827,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2888,7 +2888,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2949,7 +2949,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3011,7 +3011,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3072,7 +3072,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3135,7 +3135,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3198,7 +3198,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3261,7 +3261,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3322,7 +3322,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3383,7 +3383,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3440,7 +3440,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3500,7 +3500,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3564,7 +3564,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3628,7 +3628,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3688,7 +3688,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3749,7 +3749,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3810,7 +3810,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3871,7 +3871,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3931,7 +3931,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3990,7 +3990,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -4048,7 +4048,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -4107,7 +4107,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -4130,64 +4130,6 @@ "TEST_ENV": "x86_64-linux-deb10-unreg-validate" } }, - "x86_64-linux-deb10-validate": { - "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.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\") && (\"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", - "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--enable-ipe-data-compression", - "TEST_ENV": "x86_64-linux-deb10-validate" - } - }, "x86_64-linux-deb10-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -4223,7 +4165,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -4281,7 +4223,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -4340,7 +4282,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -4400,7 +4342,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -4460,7 +4402,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -4521,7 +4463,7 @@ ], "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\") && (\"true\" == \"true\")", + "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" } ], @@ -4580,7 +4522,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -4636,7 +4578,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], ===================================== CODEOWNERS ===================================== @@ -36,6 +36,7 @@ /compiler/GHC/Rename/ @simonpj @rae /compiler/GHC/Types/ @simonpj @rae /compiler/GHC/HsToCore/ @simonpj @rae +/compiler/GHC/HsToCore/Pmc* @sgraf /compiler/GHC/Tc/Deriv/ @RyanGlScott /compiler/GHC/CmmToAsm/ @simonmar @bgamari @AndreasK /compiler/GHC/CmmToAsm/Wasm/ @TerrorJack @@ -43,13 +44,12 @@ /compiler/GHC/StgToCmm/ @simonmar @osa1 /compiler/GHC/Cmm/ @simonmar @osa1 /compiler/ghci/ @simonmar -/compiler/GHC/Core/Op/CallArity.hs @nomeata -/compiler/utils/UnVarGraph.hs @nomeata -/compiler/GHC/Core/Op/Exitify.hs @nomeata +/compiler/GHC/Core/Opt/CallArity.hs @nomeata +/compiler/GHC/Core/Opt/Exitify.hs @nomeata /compiler/GHC/Stg/CSE.hs @nomeata -/compiler/GHC/Stg/Lift.hs @sgraf +/compiler/GHC/Stg/Lift* @sgraf /compiler/GHC/Cmm/Switch.hs @nomeata -/compiler/GHC/Core/Op/DmdAnal.hs @simonpj @sgraf +/compiler/GHC/Core/Opt/ @simonpj @sgraf /compiler/GHC/ThToHs.hs @rae /compiler/GHC/Wasm/ @nrnrnr ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -1,188 +1,67 @@ -{-# 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.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, unpackFS, LexicalFastString(..)) -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. - -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 :: Module + -> [InfoProvEnt] + -> FCode () emitIpeBufferListNode _ [] = return () emitIpeBufferListNode this_mod ents = do cfg <- getStgToCmmConfig - - tables_lbl <- mkStringLitLabel <$> newUnique - strings_lbl <- mkStringLitLabel <$> newUnique - entries_lbl <- mkStringLitLabel <$> newUnique - - let ctx = stgToCmmContext cfg + 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 - - 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 + 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 toCgIPE :: Platform -> SDocContext -> StrTabOffset -> InfoProvEnt -> State StringTable CgInfoProvEnt toCgIPE platform ctx module_name ipe = do @@ -198,7 +77,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 @@ -226,7 +105,7 @@ data StringTable = StringTable { stStrings :: DList ShortText , stLookup :: !(M.Map ShortText StrTabOffset) } -type StrTabOffset = Word32 +newtype StrTabOffset = StrTabOffset Int emptyStringTable :: StringTable emptyStringTable = @@ -251,50 +130,9 @@ lookupStringTable str = state $ \st -> , stLength = stLength st + ST.byteLength str + 1 , stLookup = M.insert str res (stLookup st) } - res = fromIntegral (stLength st) + res = StrTabOffset (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,10 +57,6 @@ Flag build-tool-depends Description: Use build-tool-depends Default: True -Flag with-libzstd - Default: False - Manual: True - -- While the boot compiler fixes ghc's unit-id to `ghc`, the stage0 compiler must still be compiled with `-this-unit-id ghc` Flag hadrian-stage0 Description: Enable if compiling the stage0 compiler with hadrian @@ -81,10 +77,6 @@ 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 ===================================== @@ -1105,10 +1105,6 @@ 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 @@ -1254,17 +1250,6 @@ 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 ===================================== @@ -128,17 +128,6 @@ Compiler GHC used to accept the contradictory ``Int~Bool`` in the type signature, but reject the ``Int~Bool`` constraint that arises from typechecking the definition itself. Now it accepts both. More details in `GHC ticket #23413 `_, which gives examples of the previous inconsistency. GHC now implements the "PermissivePlan" described in that ticket. -- 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,23 +370,9 @@ 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`. - 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. + 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. .. ghc-flag:: -fdistinct-constructor-tables :shortdesc: Generate a fresh info table for each usage ===================================== hadrian/cfg/system.config.in ===================================== @@ -199,14 +199,10 @@ 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,7 +35,6 @@ data Flag = ArSupportsAtFile | UseLibffiForAdjustors | UseLibdw | UseLibnuma - | UseLibzstd | UseLibm | UseLibrt | UseLibdl @@ -66,7 +65,6 @@ 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,8 +60,6 @@ data Setting = BuildArch | LibdwLibDir | LibnumaIncludeDir | LibnumaLibDir - | LibZstdIncludeDir - | LibZstdLibDir | LlvmTarget | ProjectGitCommitId | ProjectName @@ -163,8 +161,6 @@ 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 ===================================== @@ -316,7 +316,6 @@ 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 ===================================== @@ -74,7 +74,6 @@ packageArgs = do [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" , notM cross `cabalFlag` "terminfo" , arg "-build-tool-depends" - , flag UseLibzstd `cabalFlag` "with-libzstd" -- ROMES: While the boot compiler is not updated wrt -this-unit-id -- not being fixed to `ghc`, when building stage0, we must set -- -this-unit-id to `ghc` because the boot compiler expects that. @@ -289,8 +288,6 @@ 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 @@ -397,7 +394,6 @@ 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/System/Posix/Internals.hs ===================================== @@ -499,71 +499,71 @@ foreign import ccall unsafe "HsBase.h __hscore_lstat" #if defined(javascript_HOST_ARCH) foreign import javascript unsafe "(() => { return rts_isThreaded; })" rtsIsThreaded_ :: Int -foreign import javascript interruptible "(($1_1, $2_2, $2, $c) => { return h$base_access($1_1,$2_2,$2,$c); })" +foreign import javascript interruptible "h$base_access" c_access :: CString -> CInt -> IO CInt -foreign import javascript interruptible "(($1_1, $2_2, $2, $c) => { return h$base_chmod($1_1,$2_2,$2,$c); })" +foreign import javascript interruptible "h$base_chmod" c_chmod :: CString -> CMode -> IO CInt -foreign import javascript interruptible "(($1,$c) => { return h$base_close($1,$c); })" +foreign import javascript interruptible "h$base_close" c_close :: CInt -> IO CInt -foreign import javascript interruptible "(($1, $c) => { return h$base_creat($1,$c); })" +foreign import javascript interruptible "h$base_creat" c_creat :: CString -> CMode -> IO CInt -foreign import javascript interruptible "(($1, $c) => { return h$base_dup($1, $c); })" +foreign import javascript interruptible "h$base_dup" c_dup :: CInt -> IO CInt -foreign import javascript interruptible "(($1, $2, $c) => { return h$base_dup2($1,$2,$c); })" +foreign import javascript interruptible "h$base_dup2" c_dup2 :: CInt -> CInt -> IO CInt -foreign import javascript interruptible "(($1,$2_1,$2_2,$c) => { return h$base_fstat($1,$2_1,$2_2,$c); })" -- fixme wrong type +foreign import javascript interruptible "h$base_fstat" -- fixme wrong type c_fstat :: CInt -> Ptr CStat -> IO CInt -foreign import javascript unsafe "(($1) => { return h$base_isatty($1); })" +foreign import javascript unsafe "h$base_isatty" c_isatty :: CInt -> IO CInt -foreign import javascript interruptible "(($1,$2_1,$2_2,$3,$c) => { return h$base_lseek($1,$2_1,$2_2,$3,$c); })" +foreign import javascript interruptible "h$base_lseek" c_lseek :: CInt -> COff -> CInt -> IO COff -foreign import javascript interruptible "(($1_1,$1_2,$2_1,$2_2,$c) => { return h$base_lstat($1_1,$1_2,$2_1,$2_2,$c); })" -- fixme wrong type +foreign import javascript interruptible "h$base_lstat" -- fixme wrong type lstat :: CFilePath -> Ptr CStat -> IO CInt -foreign import javascript interruptible "(($1_1,$1_2,$2,$3,$c) => { return h$base_open($1_1,$1_2,$2,$3,$c); })" +foreign import javascript interruptible "h$base_open" c_open :: CFilePath -> CInt -> CMode -> IO CInt -foreign import javascript interruptible "(($1_1,$1_2,$2,$3,$c) => { return h$base_open($1_1,$1_2,$2,$3,$c); })" +foreign import javascript interruptible "h$base_open" c_interruptible_open_ :: CFilePath -> CInt -> CMode -> IO CInt -foreign import javascript interruptible "(($1_1,$1_2,$2,$3,$c) => { return h$base_open($1_1,$1_2,$2,$3,$c); })" +foreign import javascript interruptible "h$base_open" c_safe_open_ :: CFilePath -> CInt -> CMode -> IO CInt -foreign import javascript interruptible "(($1,$2_1,$2_2,$3,$c) => { return h$base_read($1,$2_1,$2_2,$3,$c); })" +foreign import javascript interruptible "h$base_read" c_read :: CInt -> Ptr Word8 -> CSize -> IO CSsize -foreign import javascript interruptible "(($1,$2_1,$2_2,$3,$c) => { return h$base_read($1,$2_1,$2_2,$3,$c); })" +foreign import javascript interruptible "h$base_read" c_safe_read :: CInt -> Ptr Word8 -> CSize -> IO CSsize -foreign import javascript interruptible "(($1_1,$1_2,$2_1,$2_2,$c) => { return h$base_stat($1_1,$1_2,$2_1,$2_2,$c); })" -- fixme wrong type +foreign import javascript interruptible "h$base_stat" -- fixme wrong type c_stat :: CFilePath -> Ptr CStat -> IO CInt -foreign import javascript unsafe "(($1) => { return h$base_umask($1); })" +foreign import javascript unsafe "h$base_umask" c_umask :: CMode -> IO CMode -foreign import javascript interruptible "(($1,$2_1,$2_2,$3,$c) => { return h$base_write($1,$2_1,$2_2,$3,$c); })" +foreign import javascript interruptible "h$base_write" c_write :: CInt -> Ptr Word8 -> CSize -> IO CSsize -foreign import javascript interruptible "(($1,$2_1,$2_2,$3,$c) => { return h$base_write($1,$2_1,$2_2,$3,$c); })" +foreign import javascript interruptible "h$base_write" c_safe_write :: CInt -> Ptr Word8 -> CSize -> IO CSsize -foreign import javascript interruptible "(($1,$2_1,$2_2,$c) => { return h$base_ftruncate($1,$2_1,$2_2,$c); })" -- fixme COff +foreign import javascript interruptible "h$base_ftruncate" -- fixme COff c_ftruncate :: CInt -> FileOffset -> IO CInt -foreign import javascript interruptible "(($1_1,$1_2,$c) => { return h$base_unlink($1_1,$1_2,$c); })" +foreign import javascript interruptible "h$base_unlink" c_unlink :: CString -> IO CInt foreign import javascript unsafe "h$base_getpid" c_getpid :: IO CPid -- foreign import ccall unsafe "HsBase.h fork" -- c_fork :: IO CPid -foreign import javascript interruptible "($1_1,$1_2,$2_1,$2_2,$c) => { return h$base_link($1_1,$1_2,$2_1,$2_2,$c); })" +foreign import javascript interruptible "h$base_link" c_link :: CString -> CString -> IO CInt -foreign import javascript interruptible "(($1_1,$1_2,$2,$c) => { return h$base_mkfifo($1_1,$1_2,$2,$c); })" +foreign import javascript interruptible "h$base_mkfifo" c_mkfifo :: CString -> CMode -> IO CInt -foreign import javascript interruptible "(($1_1,$1_2,$c) => { return h$base_pipe($1_1,$1_2,$c); })" +foreign import javascript interruptible "h$base_pipe" c_pipe :: Ptr CInt -> IO CInt -foreign import javascript unsafe "(($1_1,$1_2) => { return h$base_sigemptyset($1_1,$1_2); })" +foreign import javascript unsafe "h$base_sigemptyset" c_sigemptyset :: Ptr CSigset -> IO CInt -foreign import javascript unsafe "(($1_1,$1_2,$2) => { return h$base_sigaddset($1_1,$1_2,$2); })" +foreign import javascript unsafe "h$base_sigaddset" c_sigaddset :: Ptr CSigset -> CInt -> IO CInt -foreign import javascript unsafe "(($1,$2_1,$2_2,$3_1,$3_2) => { return h$base_sigprocmask($1,$2_1,$2_2,$3_1,$3_2); })" +foreign import javascript unsafe "h$base_sigprocmask" c_sigprocmask :: CInt -> Ptr CSigset -> Ptr CSigset -> IO CInt -foreign import javascript unsafe "(($1,$2_1,$2_2) => { return h$base_tcgetattr($1,$2_1,$2_2); })" +foreign import javascript unsafe "h$base_tcgetattr" c_tcgetattr :: CInt -> Ptr CTermios -> IO CInt -foreign import javascript unsafe "(($1,$2,$3_1,$3_2) => { return h$base_tcsetattr($1,$2,$3_1,$3_2); })" +foreign import javascript unsafe "h$base_tcsetattr" c_tcsetattr :: CInt -> CInt -> Ptr CTermios -> IO CInt -foreign import javascript unsafe "(($1_1,$1_2,$2_1,$2_2) => { return h$base_utime($1_1,$1_2,$2_1,$2_2); })" -- should this be async? +foreign import javascript unsafe "h$base_utime" -- should this be async? c_utime :: CString -> Ptr CUtimbuf -> IO CInt -foreign import javascript interruptible "(($1,$2_1,$2_2,$3,$c) => { return h$base_waitpid($1,$2_1,$2_2,$3,$c); })" +foreign import javascript interruptible "h$base_waitpid" c_waitpid :: CPid -> Ptr CInt -> CInt -> IO CPid foreign import javascript unsafe "(() => { return h$base_o_rdonly; })" o_RDONLY :: CInt @@ -577,11 +577,11 @@ foreign import javascript unsafe "(() => { return h$base_o_noctty; })" o_NOCTT foreign import javascript unsafe "(() => { return h$base_o_nonblock; })" o_NONBLOCK :: CInt foreign import javascript unsafe "(() => { return h$base_o_binary; })" o_BINARY :: CInt -foreign import javascript unsafe "(($1) => { return h$base_c_s_isreg($1); })" c_s_isreg :: CMode -> CInt -foreign import javascript unsafe "(($1) => { return h$base_c_s_ischr($1); })" c_s_ischr :: CMode -> CInt -foreign import javascript unsafe "(($1) => { return h$base_c_s_isblk($1); })" c_s_isblk :: CMode -> CInt -foreign import javascript unsafe "(($1) => { return h$base_c_s_isdir($1); })" c_s_isdir :: CMode -> CInt -foreign import javascript unsafe "(($1) => { return h$base_c_s_isfifo($1); })" c_s_isfifo :: CMode -> CInt +foreign import javascript unsafe "h$base_c_s_isreg" c_s_isreg :: CMode -> CInt +foreign import javascript unsafe "h$base_c_s_ischr" c_s_ischr :: CMode -> CInt +foreign import javascript unsafe "h$base_c_s_isblk" c_s_isblk :: CMode -> CInt +foreign import javascript unsafe "h$base_c_s_isdir" c_s_isdir :: CMode -> CInt +foreign import javascript unsafe "h$base_c_s_isfifo" c_s_isfifo :: CMode -> CInt s_isreg :: CMode -> Bool s_isreg cm = c_s_isreg cm /= 0 @@ -595,11 +595,11 @@ s_isfifo :: CMode -> Bool s_isfifo cm = c_s_isfifo cm /= 0 foreign import javascript unsafe "(() => { return h$base_sizeof_stat; })" sizeof_stat :: Int -foreign import javascript unsafe "(($1_1,$1_2) => { return h$base_st_mtime($1_1,$1_2); })" st_mtime :: Ptr CStat -> IO CTime -foreign import javascript unsafe "(($1_1,$1_2) => { return h$base_st_size($1_1,$1_2); })" st_size :: Ptr CStat -> IO Int64 -foreign import javascript unsafe "(($1_1,$1_2) => { return h$base_st_mode($1_1,$1_2); })" st_mode :: Ptr CStat -> IO CMode -foreign import javascript unsafe "(($1_1,$1_2) => { return h$base_st_dev($1_1,$1_2); })" st_dev :: Ptr CStat -> IO CDev -foreign import javascript unsafe "(($1_1,$1_2) => { return h$base_st_ino($1_1,$1_2); })" st_ino :: Ptr CStat -> IO CIno +foreign import javascript unsafe "h$base_st_mtime" st_mtime :: Ptr CStat -> IO CTime +foreign import javascript unsafe "h$base_st_size" st_size :: Ptr CStat -> IO Int64 +foreign import javascript unsafe "h$base_st_mode" st_mode :: Ptr CStat -> IO CMode +foreign import javascript unsafe "h$base_st_dev" st_dev :: Ptr CStat -> IO CDev +foreign import javascript unsafe "h$base_st_ino" st_ino :: Ptr CStat -> IO CIno foreign import javascript unsafe "(() => { return h$base_echo; })" const_echo :: CInt foreign import javascript unsafe "(() => { return h$base_tcsanow; })" const_tcsanow :: CInt @@ -615,21 +615,21 @@ foreign import javascript unsafe "(() => { return h$base_f_setfd; })" co foreign import javascript unsafe "(() => { return h$base_fd_cloexec; })" const_fd_cloexec :: CLong foreign import javascript unsafe "(() => { return h$base_sizeof_termios; })" sizeof_termios :: Int foreign import javascript unsafe "(() => { return h$base_sizeof_sigset_t; })" sizeof_sigset_t :: Int -foreign import javascript unsafe "(($1_1,$1_2) => { return h$base_lflag($1_1,$1_2); })" c_lflag :: Ptr CTermios -> IO CTcflag -foreign import javascript unsafe "(($1_1,$1_2,$2) => { return h$base_poke_lflag($1_1,$1_2,$2); })" poke_c_lflag :: Ptr CTermios -> CTcflag -> IO () -foreign import javascript unsafe "(($1_1,$1_2) => { return h$base_ptr_c_cc($1_1,$1_2); })" ptr_c_cc :: Ptr CTermios -> IO (Ptr Word8) +foreign import javascript unsafe "h$base_lflag" c_lflag :: Ptr CTermios -> IO CTcflag +foreign import javascript unsafe "h$base_poke_lflag" poke_c_lflag :: Ptr CTermios -> CTcflag -> IO () +foreign import javascript unsafe "h$base_ptr_c_cc" ptr_c_cc :: Ptr CTermios -> IO (Ptr Word8) s_issock :: CMode -> Bool s_issock cmode = c_s_issock cmode /= 0 -foreign import javascript unsafe "(($1) => { return h$base_c_s_issock($1); })" c_s_issock :: CMode -> CInt +foreign import javascript unsafe "h$base_c_s_issock" c_s_issock :: CMode -> CInt foreign import javascript unsafe "(() => { return h$base_default_buffer_size; })" dEFAULT_BUFFER_SIZE :: Int foreign import javascript unsafe "(() => { return h$base_SEEK_CUR; })" sEEK_CUR :: CInt foreign import javascript unsafe "(() => { return h$base_SEEK_SET; })" sEEK_SET :: CInt foreign import javascript unsafe "(() => { return h$base_SEEK_END; })" sEEK_END :: CInt -- fixme, unclear if these can be supported, remove? -foreign import javascript unsafe "(($1, $2) => { return h$base_c_fcntl_read($1,$2); })" c_fcntl_read :: CInt -> CInt -> IO CInt -foreign import javascript unsafe "(($1, $2, $3) => { return h$base_c_fcntl_write($1,$2,$3); })" c_fcntl_write :: CInt -> CInt -> CLong -> IO CInt -foreign import javascript unsafe "(($1,$2,$3_1,$3_2) => { return h$base_c_fcntl_lock($1,$2,$3_1,$3_2); })" c_fcntl_lock :: CInt -> CInt -> Ptr CFLock -> IO CInt +foreign import javascript unsafe "h$base_c_fcntl_read" c_fcntl_read :: CInt -> CInt -> IO CInt +foreign import javascript unsafe "h$base_c_fcntl_write" c_fcntl_write :: CInt -> CInt -> CLong -> IO CInt +foreign import javascript unsafe "h$base_c_fcntl_lock" c_fcntl_lock :: CInt -> CInt -> Ptr CFLock -> IO CInt #else ===================================== 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" = "yes" ; then + if test "$enable_numa" != "no" ; 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 "$HaveLibNuma" = "0" ; then + if test "$enable_numa:$HaveLibNuma" = "yes:0" ; then AC_MSG_ERROR([Cannot find system libnuma (required by --enable-numa)]) fi ===================================== m4/fp_find_libzstd.m4 deleted ===================================== @@ -1,79 +0,0 @@ -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,10 +20,6 @@ #include #include -#if HAVE_LIBZSTD == 1 -#include -#endif - #if defined(TRACING) #include "Trace.h" #endif @@ -40,9 +36,8 @@ 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 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. +contains an array of IPE entries 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 @@ -82,23 +77,23 @@ void exitIpe(void) { } #endif // THREADED_RTS -static InfoProvEnt ipeBufferEntryToIpe(const char *strings, const StgInfoTable *tbl, const IpeBufferEntry ent) +static InfoProvEnt ipeBufferEntryToIpe(const IpeBufferListNode *node, const IpeBufferEntry *ent) { + const char *strings = node->string_table; return (InfoProvEnt) { - .info = tbl, + .info = ent->info, .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) { @@ -110,18 +105,8 @@ 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( - strings, - cursor->tables[i], - entries[i] - ); + const InfoProvEnt ent = ipeBufferEntryToIpe(cursor, &cursor->entries[i]); traceIPE(&ent); } cursor = cursor->next; @@ -135,7 +120,6 @@ void dumpIPEToEventLog(void) { RELEASE_LOCK(&ipeMapLock); } - #else void dumpIPEToEventLog(void) { } @@ -185,84 +169,16 @@ void updateIpeMap() { } while (pending != NULL) { - 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]); + 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]); } - pending = current_node->next; + pending = currentNode->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 == 1) { - // 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,6 +17,5 @@ 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,6 +52,9 @@ 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; @@ -66,23 +69,10 @@ 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 - - // This flag should be treated as a boolean - StgWord compressed; - + const char *string_table; StgWord count; - - // 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 + IpeBufferEntry entries[]; } IpeBufferListNode; void registerInfoProvList(IpeBufferListNode *node); ===================================== rts/rts.cabal.in ===================================== @@ -45,8 +45,6 @@ flag libdw default: @CabalHaveLibdw@ flag libnuma default: @CabalHaveLibNuma@ -flag libzstd - default: @CabalHaveLibZstd@ flag leading-underscore default: @CabalLeadingUnderscore@ flag smp @@ -213,8 +211,6 @@ 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/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->tables[0]); + lookupIPE(list1->entries[0].info); // Trace all IPE events. dumpIPEToEventLog(); ===================================== testsuite/tests/rts/ipe/ipeMap.c ===================================== @@ -40,23 +40,15 @@ void shouldFindNothingInAnEmptyIPEMap(Capability *cap) { } HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) { - // Allocate buffers for IPE buffer list node - IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); - node->tables = malloc(sizeof(StgInfoTable *)); - node->entries = malloc(sizeof(IpeBufferEntry)); - + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + sizeof(IpeBufferEntry)); StringTable st; init_string_table(&st); HaskellObj fortyTwo = UNTAG_CLOSURE(rts_mkInt(cap, 42)); - node->next = NULL; - node->compressed = 0; + node->entries[0] = makeAnyProvEntry(cap, &st, fortyTwo, 42); node->count = 1; - node->tables[0] = get_itbl(fortyTwo); - node->entries[0] = makeAnyProvEntry(cap, &st, 42); - node->entries_size = sizeof(IpeBufferEntry); + node->next = NULL; node->string_table = st.buffer; - node->string_table_size = st.size; registerInfoProvList(node); @@ -80,23 +72,15 @@ HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) { void shouldFindTwoIfTwoHaveBeenRegistered(Capability *cap, HaskellObj fortyTwo) { - // Allocate buffers for IPE buffer list node - IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); - node->tables = malloc(sizeof(StgInfoTable *)); - node->entries = malloc(sizeof(IpeBufferEntry)); - + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + sizeof(IpeBufferEntry)); StringTable st; init_string_table(&st); HaskellObj twentyThree = UNTAG_CLOSURE(rts_mkInt8(cap, 23)); - node->next = NULL; - node->compressed = 0; + node->entries[0] = makeAnyProvEntry(cap, &st, twentyThree, 23); node->count = 1; - node->tables[0] = get_itbl(twentyThree); - node->entries[0] = makeAnyProvEntry(cap, &st, 23); - node->entries_size = sizeof(IpeBufferEntry); + node->next = NULL; node->string_table = st.buffer; - node->string_table_size = st.size; registerInfoProvList(node); @@ -119,26 +103,17 @@ void shouldFindTwoIfTwoHaveBeenRegistered(Capability *cap, } void shouldFindTwoFromTheSameList(Capability *cap) { - // Allocate buffers for IPE buffer list node - IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); - node->tables = malloc(sizeof(StgInfoTable *) * 2); - node->entries = malloc(sizeof(IpeBufferEntry) * 2); - + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + 2 * sizeof(IpeBufferEntry)); StringTable st; init_string_table(&st); HaskellObj one = UNTAG_CLOSURE(rts_mkInt16(cap, 1)); HaskellObj two = UNTAG_CLOSURE(rts_mkInt32(cap, 2)); - node->next = NULL; - node->compressed = 0; + node->entries[0] = makeAnyProvEntry(cap, &st, one, 1); + node->entries[1] = makeAnyProvEntry(cap, &st, two, 2); 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->next = NULL; node->string_table = st.buffer; - node->string_table_size = st.size; registerInfoProvList(node); ===================================== testsuite/tests/rts/ipe/ipe_lib.c ===================================== @@ -25,8 +25,9 @@ uint32_t add_string(StringTable *st, const char *s) { return n; } -IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, int i) { +IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, HaskellObj closure, 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); @@ -68,27 +69,15 @@ IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, int i) { IpeBufferListNode *makeAnyProvEntries(Capability *cap, int start, int end) { const int n = end - start; - - // Allocate buffers for IpeBufferListNode - IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); - node->tables = malloc(sizeof(StgInfoTable *) * n); - node->entries = malloc(sizeof(IpeBufferEntry) * n); - + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + n * sizeof(IpeBufferEntry)); 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->tables[i] = get_itbl(closure); - node->entries[i] = makeAnyProvEntry(cap, &st, i); + node->entries[i] = makeAnyProvEntry(cap, &st, closure, 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, int i); +IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, HaskellObj closure, int i); void dumpIPEToEventLog(void); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/79bd0e011088837b561c19005ce1388bc4bb1c6c...06112cd19dafdd9b68b1bb28fb93a823883b6456 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/79bd0e011088837b561c19005ce1388bc4bb1c6c...06112cd19dafdd9b68b1bb28fb93a823883b6456 You're receiving 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 Jun 7 21:01:36 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Wed, 07 Jun 2023 17:01:36 -0400 Subject: [Git][ghc/ghc][wip/T23309] 2 commits: Restore mingwex dependency on Windows Message-ID: <6480f0305e32a_2088501e79dc4985aa@gitlab.mail> Ryan Scott pushed to branch wip/T23309 at Glasgow Haskell Compiler / GHC Commits: 1a18d6cf by Ryan Scott at 2023-06-07T15:03:54+02:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 0c8fe204 by Ryan Scott at 2023-06-07T15:03:57+02:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 4 changed files: - configure.ac - libraries/base/base.cabal - libraries/ghc-prim/ghc-prim.cabal - rts/RtsSymbols.c Changes: ===================================== configure.ac ===================================== @@ -931,6 +931,9 @@ AC_CHECK_DECLS([program_invocation_short_name], , , [#define _GNU_SOURCE 1 #include ]) +dnl ** check for mingwex library +AC_CHECK_LIB([mingwex],[closedir]) + dnl ** check for math library dnl Keep that check as early as possible. dnl as we need to know whether we need libm ===================================== libraries/base/base.cabal ===================================== @@ -397,6 +397,7 @@ Library if os(windows) -- Windows requires some extra libraries for linking because the RTS -- is no longer re-exporting them. + -- mingwex: provides GNU POSIX extensions that aren't provided by ucrt. -- 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. @@ -409,7 +410,7 @@ Library -- advapi32: provides advanced kernel functions extra-libraries: wsock32, user32, shell32, mingw32, kernel32, advapi32, - ws2_32, shlwapi, ole32, rpcrt4, ntdll + mingwex, 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/ghc-prim/ghc-prim.cabal ===================================== @@ -68,12 +68,13 @@ Library -- is no longer re-exporting them (see #11223) -- ucrt: standard C library. The RTS will automatically include this, -- but is added for completeness. + -- mingwex: provides GNU POSIX extensions that aren't provided by ucrt. -- 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, ucrt + extra-libraries: user32, mingw32, mingwex, ucrt if os(linux) -- we need libm, but for musl and other's we might need libc, as libm ===================================== rts/RtsSymbols.c ===================================== @@ -113,6 +113,26 @@ 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 @@ -150,17 +170,17 @@ extern char **environ; SymI_NeedsProto(__mingw_module_is_dll) \ RTS_WIN32_ONLY(SymI_NeedsProto(___chkstk_ms)) \ RTS_WIN64_ONLY(SymI_NeedsProto(___chkstk_ms)) \ - SymI_HasProto(__mingw_vsnwprintf) \ - /* ^^ Need to figure out why this is needed. */ \ + RTS_WIN64_ONLY(SymI_HasProto(__stdio_common_vswprintf_s)) \ + RTS_WIN64_ONLY(SymI_HasProto(__stdio_common_vswprintf)) \ + RTS_WIN64_ONLY(SymI_HasProto(_errno)) \ + /* see Note [Symbols for MinGW's printf] */ \ + SymI_HasProto(_lock_file) \ + SymI_HasProto(_unlock_file) \ /* See Note [_iob_func symbol] */ \ RTS_WIN64_ONLY(SymI_HasProto_redirect( \ __imp___acrt_iob_func, __rts_iob_func, STRENGTH_WEAK, SYM_TYPE_INDIRECT_DATA)) \ RTS_WIN32_ONLY(SymI_HasProto_redirect( \ - __imp____acrt_iob_func, __rts_iob_func, STRENGTH_WEAK, SYM_TYPE_INDIRECT_DATA)) \ - SymI_HasProto(__mingw_vsnwprintf) \ - /* ^^ Need to figure out why this is needed. */ \ - SymI_HasProto(__mingw_vfprintf) \ - /* ^^ Need to figure out why this is needed. */ + __imp____acrt_iob_func, __rts_iob_func, STRENGTH_WEAK, SYM_TYPE_INDIRECT_DATA)) #else #define RTS_MINGW_ONLY_SYMBOLS /**/ #endif View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/35d7aee26a52a36f67ac411a8916bfa9883e305b...0c8fe204d9c129c2eba33a81dff468c2e5283060 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/35d7aee26a52a36f67ac411a8916bfa9883e305b...0c8fe204d9c129c2eba33a81dff468c2e5283060 You're receiving 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 Jun 7 22:01:45 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 07 Jun 2023 18:01:45 -0400 Subject: [Git][ghc/ghc][master] Update CODEOWNERS Message-ID: <6480fe492d1bb_208850425b8c811143f@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 1 changed file: - CODEOWNERS Changes: ===================================== CODEOWNERS ===================================== @@ -36,6 +36,7 @@ /compiler/GHC/Rename/ @simonpj @rae /compiler/GHC/Types/ @simonpj @rae /compiler/GHC/HsToCore/ @simonpj @rae +/compiler/GHC/HsToCore/Pmc* @sgraf /compiler/GHC/Tc/Deriv/ @RyanGlScott /compiler/GHC/CmmToAsm/ @simonmar @bgamari @AndreasK /compiler/GHC/CmmToAsm/Wasm/ @TerrorJack @@ -43,13 +44,12 @@ /compiler/GHC/StgToCmm/ @simonmar @osa1 /compiler/GHC/Cmm/ @simonmar @osa1 /compiler/ghci/ @simonmar -/compiler/GHC/Core/Op/CallArity.hs @nomeata -/compiler/utils/UnVarGraph.hs @nomeata -/compiler/GHC/Core/Op/Exitify.hs @nomeata +/compiler/GHC/Core/Opt/CallArity.hs @nomeata +/compiler/GHC/Core/Opt/Exitify.hs @nomeata /compiler/GHC/Stg/CSE.hs @nomeata -/compiler/GHC/Stg/Lift.hs @sgraf +/compiler/GHC/Stg/Lift* @sgraf /compiler/GHC/Cmm/Switch.hs @nomeata -/compiler/GHC/Core/Op/DmdAnal.hs @simonpj @sgraf +/compiler/GHC/Core/Opt/ @simonpj @sgraf /compiler/GHC/ThToHs.hs @rae /compiler/GHC/Wasm/ @nrnrnr View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e5d3940d80ee4b05db47e8a0e80207766d8dc934 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e5d3940d80ee4b05db47e8a0e80207766d8dc934 You're receiving 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 Jun 7 22:02:43 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 07 Jun 2023 18:02:43 -0400 Subject: [Git][ghc/ghc][master] 11 commits: Revert "Remove IPE enabled builds from CI" Message-ID: <6480fe83914a8_2088501e79dc411485f@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 22 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/StgToCmm/InfoTableProv.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/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 ===================================== @@ -141,7 +141,6 @@ data BuildConfig , llvmBootstrap :: Bool , withAssertions :: Bool , withNuma :: Bool - , withZstd :: Bool , crossTarget :: Maybe String , crossEmulator :: CrossEmulator , configureWrapper :: Maybe String @@ -155,11 +154,10 @@ 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 @@ -174,12 +172,8 @@ mkJobFlavour BuildConfig{..} = Flavour buildFlavour opts 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 @@ -198,7 +192,6 @@ vanilla = BuildConfig , llvmBootstrap = False , withAssertions = False , withNuma = False - , withZstd = False , crossTarget = Nothing , crossEmulator = NoEmulator , configureWrapper = Nothing @@ -231,9 +224,6 @@ debug = vanilla { buildFlavour = SlowValidate , withNuma = True } -zstdIpe :: BuildConfig -zstdIpe = vanilla { withZstd = True } - static :: BuildConfig static = vanilla { fullyStatic = True } @@ -323,18 +313,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) = base_string base ++ concatMap (("+" ++) . flavour_string) trans +flavourString (Flavour base trans) = baseString base ++ concatMap (("+" ++) . flavourString) trans where - base_string Release = "release" - base_string Validate = "validate" - base_string SlowValidate = "slow-validate" + baseString Release = "release" + baseString Validate = "validate" + baseString SlowValidate = "slow-validate" - 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 BootNonmovingGc = "boot_nonmoving_gc" + flavourString Llvm = "llvm" + flavourString Dwarf = "debug_info" + 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 @@ -527,7 +517,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 rulesList +enumRules o = map lkup rules where enabled_rules = rule_set o lkup r = OnOffRule (if S.member r enabled_rules then On else Off) r @@ -563,7 +553,6 @@ data Rule = FastCI -- ^ Run this job when the fast-ci label is set | 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. - | IpeData -- ^ Only run this job when the "IPE" label is set | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) @@ -590,14 +579,12 @@ 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 -rulesList :: [Rule] -rulesList = [minBound .. maxBound] +rules :: [Rule] +rules = [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 @@ -886,7 +873,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) zstdIpe) , -- Nightly allowed to fail: #22520 modifyNightlyJobs allowFailure (modifyValidateJobs manual tsan_jobs) @@ -894,7 +880,7 @@ job_groups = modifyNightlyJobs allowFailure (modifyValidateJobs manual (validateBuilds Amd64 (Linux Debian10) noTntc)) , addValidateRule LLVMBackend (validateBuilds Amd64 (Linux Debian10) llvm) - , addValidateRule IpeData (validateBuilds Amd64 (Linux Debian10) zstdIpe) + , 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\") && (\"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\") && (\"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\") && (\"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\") && (\"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\") && (\"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\") && (\"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\") && (\"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\") && (\"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\") && (\"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\") && (\"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" } ], @@ -641,7 +641,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -703,7 +703,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -765,7 +765,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -826,7 +826,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -887,7 +887,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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\") && (\"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" } ], @@ -1008,7 +1008,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1067,7 +1067,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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\") && (\"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" } ], @@ -1186,7 +1186,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1245,7 +1245,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1264,7 +1264,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "CONFIGURE_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -1304,7 +1304,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1363,7 +1363,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1422,7 +1422,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1483,7 +1483,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1544,7 +1544,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1606,7 +1606,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1665,7 +1665,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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 +1725,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1784,7 +1784,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1845,7 +1845,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1907,7 +1907,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1968,7 +1968,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2028,7 +2028,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2087,7 +2087,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2142,7 +2142,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2201,7 +2201,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2264,7 +2264,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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 +2328,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2389,7 +2389,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2450,7 +2450,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2516,7 +2516,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2579,7 +2579,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2642,7 +2642,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2705,7 +2705,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2766,7 +2766,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2827,7 +2827,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2888,7 +2888,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2949,7 +2949,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3011,7 +3011,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3072,7 +3072,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3135,7 +3135,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3198,7 +3198,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3261,7 +3261,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3322,7 +3322,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3383,7 +3383,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3440,7 +3440,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3500,7 +3500,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3564,7 +3564,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3628,7 +3628,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3688,7 +3688,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3749,7 +3749,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3810,7 +3810,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3871,7 +3871,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3931,7 +3931,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3990,7 +3990,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -4048,7 +4048,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -4107,7 +4107,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -4130,64 +4130,6 @@ "TEST_ENV": "x86_64-linux-deb10-unreg-validate" } }, - "x86_64-linux-deb10-validate": { - "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.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\") && (\"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", - "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--enable-ipe-data-compression", - "TEST_ENV": "x86_64-linux-deb10-validate" - } - }, "x86_64-linux-deb10-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -4223,7 +4165,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -4281,7 +4223,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -4340,7 +4282,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -4400,7 +4342,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -4460,7 +4402,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -4521,7 +4463,7 @@ ], "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\") && (\"true\" == \"true\")", + "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" } ], @@ -4580,7 +4522,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -4636,7 +4578,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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,188 +1,67 @@ -{-# 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.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, unpackFS, LexicalFastString(..)) -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. - -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 :: Module + -> [InfoProvEnt] + -> FCode () emitIpeBufferListNode _ [] = return () emitIpeBufferListNode this_mod ents = do cfg <- getStgToCmmConfig - - tables_lbl <- mkStringLitLabel <$> newUnique - strings_lbl <- mkStringLitLabel <$> newUnique - entries_lbl <- mkStringLitLabel <$> newUnique - - let ctx = stgToCmmContext cfg + 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 - - 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 + 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 toCgIPE :: Platform -> SDocContext -> StrTabOffset -> InfoProvEnt -> State StringTable CgInfoProvEnt toCgIPE platform ctx module_name ipe = do @@ -198,7 +77,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 @@ -226,7 +105,7 @@ data StringTable = StringTable { stStrings :: DList ShortText , stLookup :: !(M.Map ShortText StrTabOffset) } -type StrTabOffset = Word32 +newtype StrTabOffset = StrTabOffset Int emptyStringTable :: StringTable emptyStringTable = @@ -251,50 +130,9 @@ lookupStringTable str = state $ \st -> , stLength = stLength st + ST.byteLength str + 1 , stLookup = M.insert str res (stLookup st) } - res = fromIntegral (stLength st) + res = StrTabOffset (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,10 +57,6 @@ Flag build-tool-depends Description: Use build-tool-depends Default: True -Flag with-libzstd - Default: False - Manual: True - -- While the boot compiler fixes ghc's unit-id to `ghc`, the stage0 compiler must still be compiled with `-this-unit-id ghc` Flag hadrian-stage0 Description: Enable if compiling the stage0 compiler with hadrian @@ -81,10 +77,6 @@ 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 ===================================== @@ -1105,10 +1105,6 @@ 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 @@ -1254,17 +1250,6 @@ 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 ===================================== @@ -128,17 +128,6 @@ Compiler GHC used to accept the contradictory ``Int~Bool`` in the type signature, but reject the ``Int~Bool`` constraint that arises from typechecking the definition itself. Now it accepts both. More details in `GHC ticket #23413 `_, which gives examples of the previous inconsistency. GHC now implements the "PermissivePlan" described in that ticket. -- 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,23 +370,9 @@ 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`. - 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. + 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. .. ghc-flag:: -fdistinct-constructor-tables :shortdesc: Generate a fresh info table for each usage ===================================== hadrian/cfg/system.config.in ===================================== @@ -199,14 +199,10 @@ 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,7 +35,6 @@ data Flag = ArSupportsAtFile | UseLibffiForAdjustors | UseLibdw | UseLibnuma - | UseLibzstd | UseLibm | UseLibrt | UseLibdl @@ -66,7 +65,6 @@ 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,8 +60,6 @@ data Setting = BuildArch | LibdwLibDir | LibnumaIncludeDir | LibnumaLibDir - | LibZstdIncludeDir - | LibZstdLibDir | LlvmTarget | ProjectGitCommitId | ProjectName @@ -163,8 +161,6 @@ 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 ===================================== @@ -316,7 +316,6 @@ 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 ===================================== @@ -74,7 +74,6 @@ packageArgs = do [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" , notM cross `cabalFlag` "terminfo" , arg "-build-tool-depends" - , flag UseLibzstd `cabalFlag` "with-libzstd" -- ROMES: While the boot compiler is not updated wrt -this-unit-id -- not being fixed to `ghc`, when building stage0, we must set -- -this-unit-id to `ghc` because the boot compiler expects that. @@ -289,8 +288,6 @@ 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 @@ -397,7 +394,6 @@ 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" = "yes" ; then + if test "$enable_numa" != "no" ; 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 "$HaveLibNuma" = "0" ; then + if test "$enable_numa:$HaveLibNuma" = "yes:0" ; then AC_MSG_ERROR([Cannot find system libnuma (required by --enable-numa)]) fi ===================================== m4/fp_find_libzstd.m4 deleted ===================================== @@ -1,79 +0,0 @@ -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,10 +20,6 @@ #include #include -#if HAVE_LIBZSTD == 1 -#include -#endif - #if defined(TRACING) #include "Trace.h" #endif @@ -40,9 +36,8 @@ 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 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. +contains an array of IPE entries 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 @@ -82,23 +77,23 @@ void exitIpe(void) { } #endif // THREADED_RTS -static InfoProvEnt ipeBufferEntryToIpe(const char *strings, const StgInfoTable *tbl, const IpeBufferEntry ent) +static InfoProvEnt ipeBufferEntryToIpe(const IpeBufferListNode *node, const IpeBufferEntry *ent) { + const char *strings = node->string_table; return (InfoProvEnt) { - .info = tbl, + .info = ent->info, .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) { @@ -110,18 +105,8 @@ 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( - strings, - cursor->tables[i], - entries[i] - ); + const InfoProvEnt ent = ipeBufferEntryToIpe(cursor, &cursor->entries[i]); traceIPE(&ent); } cursor = cursor->next; @@ -135,7 +120,6 @@ void dumpIPEToEventLog(void) { RELEASE_LOCK(&ipeMapLock); } - #else void dumpIPEToEventLog(void) { } @@ -185,84 +169,16 @@ void updateIpeMap() { } while (pending != NULL) { - 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]); + 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]); } - pending = current_node->next; + pending = currentNode->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 == 1) { - // 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,6 +17,5 @@ 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,6 +52,9 @@ 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; @@ -66,23 +69,10 @@ 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 - - // This flag should be treated as a boolean - StgWord compressed; - + const char *string_table; StgWord count; - - // 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 + IpeBufferEntry entries[]; } IpeBufferListNode; void registerInfoProvList(IpeBufferListNode *node); ===================================== rts/rts.cabal.in ===================================== @@ -45,8 +45,6 @@ flag libdw default: @CabalHaveLibdw@ flag libnuma default: @CabalHaveLibNuma@ -flag libzstd - default: @CabalHaveLibZstd@ flag leading-underscore default: @CabalLeadingUnderscore@ flag smp @@ -213,8 +211,6 @@ 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/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->tables[0]); + lookupIPE(list1->entries[0].info); // Trace all IPE events. dumpIPEToEventLog(); ===================================== testsuite/tests/rts/ipe/ipeMap.c ===================================== @@ -40,23 +40,15 @@ void shouldFindNothingInAnEmptyIPEMap(Capability *cap) { } HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) { - // Allocate buffers for IPE buffer list node - IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); - node->tables = malloc(sizeof(StgInfoTable *)); - node->entries = malloc(sizeof(IpeBufferEntry)); - + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + sizeof(IpeBufferEntry)); StringTable st; init_string_table(&st); HaskellObj fortyTwo = UNTAG_CLOSURE(rts_mkInt(cap, 42)); - node->next = NULL; - node->compressed = 0; + node->entries[0] = makeAnyProvEntry(cap, &st, fortyTwo, 42); node->count = 1; - node->tables[0] = get_itbl(fortyTwo); - node->entries[0] = makeAnyProvEntry(cap, &st, 42); - node->entries_size = sizeof(IpeBufferEntry); + node->next = NULL; node->string_table = st.buffer; - node->string_table_size = st.size; registerInfoProvList(node); @@ -80,23 +72,15 @@ HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) { void shouldFindTwoIfTwoHaveBeenRegistered(Capability *cap, HaskellObj fortyTwo) { - // Allocate buffers for IPE buffer list node - IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); - node->tables = malloc(sizeof(StgInfoTable *)); - node->entries = malloc(sizeof(IpeBufferEntry)); - + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + sizeof(IpeBufferEntry)); StringTable st; init_string_table(&st); HaskellObj twentyThree = UNTAG_CLOSURE(rts_mkInt8(cap, 23)); - node->next = NULL; - node->compressed = 0; + node->entries[0] = makeAnyProvEntry(cap, &st, twentyThree, 23); node->count = 1; - node->tables[0] = get_itbl(twentyThree); - node->entries[0] = makeAnyProvEntry(cap, &st, 23); - node->entries_size = sizeof(IpeBufferEntry); + node->next = NULL; node->string_table = st.buffer; - node->string_table_size = st.size; registerInfoProvList(node); @@ -119,26 +103,17 @@ void shouldFindTwoIfTwoHaveBeenRegistered(Capability *cap, } void shouldFindTwoFromTheSameList(Capability *cap) { - // Allocate buffers for IPE buffer list node - IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); - node->tables = malloc(sizeof(StgInfoTable *) * 2); - node->entries = malloc(sizeof(IpeBufferEntry) * 2); - + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + 2 * sizeof(IpeBufferEntry)); StringTable st; init_string_table(&st); HaskellObj one = UNTAG_CLOSURE(rts_mkInt16(cap, 1)); HaskellObj two = UNTAG_CLOSURE(rts_mkInt32(cap, 2)); - node->next = NULL; - node->compressed = 0; + node->entries[0] = makeAnyProvEntry(cap, &st, one, 1); + node->entries[1] = makeAnyProvEntry(cap, &st, two, 2); 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->next = NULL; node->string_table = st.buffer; - node->string_table_size = st.size; registerInfoProvList(node); ===================================== testsuite/tests/rts/ipe/ipe_lib.c ===================================== @@ -25,8 +25,9 @@ uint32_t add_string(StringTable *st, const char *s) { return n; } -IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, int i) { +IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, HaskellObj closure, 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); @@ -68,27 +69,15 @@ IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, int i) { IpeBufferListNode *makeAnyProvEntries(Capability *cap, int start, int end) { const int n = end - start; - - // Allocate buffers for IpeBufferListNode - IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); - node->tables = malloc(sizeof(StgInfoTable *) * n); - node->entries = malloc(sizeof(IpeBufferEntry) * n); - + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + n * sizeof(IpeBufferEntry)); 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->tables[i] = get_itbl(closure); - node->entries[i] = makeAnyProvEntry(cap, &st, i); + node->entries[i] = makeAnyProvEntry(cap, &st, closure, 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, int i); +IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, HaskellObj closure, int i); void dumpIPEToEventLog(void); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e5d3940d80ee4b05db47e8a0e80207766d8dc934...2cdcb3a59ac8f52fe0871490aa0d047e2d23cf6e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e5d3940d80ee4b05db47e8a0e80207766d8dc934...2cdcb3a59ac8f52fe0871490aa0d047e2d23cf6e You're receiving 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 Jun 7 22:16:32 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Wed, 07 Jun 2023 18:16:32 -0400 Subject: [Git][ghc/ghc][wip/expand-do] 28 commits: cleanup: Remove unused field from SelfBoot Message-ID: <648101c0ec8f3_20885078954ac118766@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - 9dddf6ba by Apoorv Ingle at 2023-06-07T16:56:58-05:00 Fixes #18324 #23147 Expands do notation before typechecking using `HsExpansion` - Adds testcases T18324, T18324b, DoubleMatch Expands - Do statements - Monadic do statements - monadic fix blocks - make sure fail is used for pattern match failures in bind statments - Makes sure unused binds generate warnings - runs the pattern match check in generated lambda exprs to avoid getting suprious pattern match failures. c.f. pmcheck/should_compile/DoubleMatch.hs - PopSrcSpan in HsExpr to pop error context - Discards default monad fail alternatives that are spuriously generated - Make sure we check for generated loc span for checking if the (>>) is user written or expanded for /do/ purposes - - - - - 2b05513f by Apoorv Ingle at 2023-06-07T16:57:57-05:00 - Add PopSrcSpan (XXExprGhcRn) in appropriate places while expanding statements - correct source spans displayed for warnDiscardedDoBindings - use `mkExpandStmt` to store original stmts along with expanded expr for using the right context for error message printing - improves error messages for applicative do - remove special case from isMatchContextPmChecked (long distance info is now properly propogated) - set correct src spans to statement expansions - Match ctxt while type checking HsLam is different if the lambda match is due to an expression generated from a do block - call tcExpr and not tcApp in PopSrcSpan so make sure impredicativity works fine - look into XExprs in tcInferAppHead_maybe for infering the type to make T18324 typecheck and run - - - - - 8e515523 by Apoorv Ingle at 2023-06-07T16:58:04-05:00 generate incomplete uni patterns warnings if the origin context is a generated do expansion - - - - - 813f98b3 by Apoorv Ingle at 2023-06-07T16:58:04-05:00 use the correct bind operator for qualified rebindable rec do expansions - - - - - 0e857ea4 by Apoorv Ingle at 2023-06-07T16:58:04-05:00 trying out changes to heralds - - - - - 06fc5dcb by Apoorv Ingle at 2023-06-07T16:58:04-05:00 add location information for last statements - - - - - e353a690 by Apoorv Ingle at 2023-06-07T16:58:04-05:00 do not pop context while checking the second argument to expanded (>>) - - - - - 40f44b8d by Apoorv Ingle at 2023-06-07T16:58:04-05:00 adjusting the generated spans for proper error messages - - - - - 4bd0e329 by Apoorv Ingle at 2023-06-07T17:16:19-05:00 change the addHeadCtxt to include the first statement of the do block for more precise error messages - - - - - 30 changed files: - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - compiler/GHC/Builtin/Names/TH.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/JS/Make.hs - compiler/GHC/JS/Optimizer.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/39ac8d8f65452b619447c66770c5dc6f46a28219...4bd0e329e6948967d047650946692ca6cc5cb933 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/39ac8d8f65452b619447c66770c5dc6f46a28219...4bd0e329e6948967d047650946692ca6cc5cb933 You're receiving 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 Jun 7 22:33:04 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Wed, 07 Jun 2023 18:33:04 -0400 Subject: [Git][ghc/ghc][wip/expand-do] - don't add any ctxt in addExprCtxt for `XExpr(ExpandedStmt{})` as it is not... Message-ID: <648105a0f2c30_20885081591d813271c@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: e495b49f by Apoorv Ingle at 2023-06-07T17:30:50-05:00 - don't add any ctxt in addExprCtxt for `XExpr(ExpandedStmt{})` as it is not very useful, the statement ctxt is already added by `tcExpr` and `addHeadCtxt` - - - - - 2 changed files: - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Match.hs Changes: ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -1487,6 +1487,7 @@ addExprCtxt :: HsExpr GhcRn -> TcRn a -> TcRn a addExprCtxt e thing_inside = case e of HsUnboundVar {} -> thing_inside + XExpr (ExpandedStmt _) -> thing_inside _ -> addErrCtxt (exprCtxt e) thing_inside -- The HsUnboundVar special case addresses situations like -- f x = _ ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1228,7 +1228,7 @@ expand_do_stmts _ [stmt@(L loc (LastStmt _ body _ ret_expr))] = return $ wrapGenSpan (mkExpandedStmt stmt (genHsApp (wrapGenSpan ret) body)) -expand_do_stmts do_or_lc (stmt@(L loc (LetStmt _ bs)) : lstmts) = +expand_do_stmts do_or_lc ((L _ (LetStmt _ bs)) : lstmts) = -- stmts ~~> stmts' -- ------------------------------------------------ -- let x = e ; stmts ~~> let x = e in stmts' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e495b49f9084cc6d10150765b6b614854377174b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e495b49f9084cc6d10150765b6b614854377174b You're receiving 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 Jun 7 23:27:10 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Wed, 07 Jun 2023 19:27:10 -0400 Subject: [Git][ghc/ghc][wip/int-index/core-ignore-forall-vis] 26 commits: Big TcLclEnv and CtLoc refactoring Message-ID: <6481124e41110_2088501be7a0c1352e4@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/core-ignore-forall-vis at Glasgow Haskell Compiler / GHC Commits: 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2e2760b4 by Vladislav Zavialov at 2023-06-08T01:25:48+02:00 Ignore forall visibility in eqType (#22762) This change fixes a Core lint bug (#22762) and unblocks further work on visible forall in types of terms (GHC Proposal #281). - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - compiler/GHC/Builtin/Names/TH.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Plugins.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/25f0afa3b1db85c08f74b48a30411ac6f27e39aa...2e2760b455419bb333e3ff8b77715f891027486d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/25f0afa3b1db85c08f74b48a30411ac6f27e39aa...2e2760b455419bb333e3ff8b77715f891027486d You're receiving 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 Jun 7 23:28:18 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Wed, 07 Jun 2023 19:28:18 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ipe-data-compression Message-ID: <64811292edb69_208850766c7841354c6@gitlab.mail> Finley McIlwaine pushed new branch wip/ipe-data-compression at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ipe-data-compression You're receiving 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 Jun 8 02:16:01 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Wed, 07 Jun 2023 22:16:01 -0400 Subject: [Git][ghc/ghc][wip/ipe-data-compression] IPE data compression Message-ID: <648139e190887_20885078934cc140740@gitlab.mail> Finley McIlwaine pushed to branch wip/ipe-data-compression at Glasgow Haskell Compiler / GHC Commits: 8a938f56 by Finley McIlwaine at 2023-06-07T20:14:46-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 23 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/StgToCmm/InfoTableProv.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/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-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: ae60a90db673e679399286e3b63c21c8e7a9a9b9 + DOCKER_REV: 147a4b6c6337b149db53b19185e100e45e549094 # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. ===================================== .gitlab/gen_ci.hs ===================================== @@ -141,6 +141,7 @@ data BuildConfig , llvmBootstrap :: Bool , withAssertions :: Bool , withNuma :: Bool + , withZstd :: Bool , crossTarget :: Maybe String , crossEmulator :: CrossEmulator , configureWrapper :: Maybe String @@ -154,10 +155,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 @@ -172,8 +174,12 @@ mkJobFlavour BuildConfig{..} = Flavour buildFlavour opts 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 @@ -192,6 +198,7 @@ vanilla = BuildConfig , llvmBootstrap = False , withAssertions = False , withNuma = False + , withZstd = False , crossTarget = Nothing , crossEmulator = NoEmulator , configureWrapper = Nothing @@ -224,6 +231,9 @@ debug = vanilla { buildFlavour = SlowValidate , withNuma = True } +zstdIpe :: BuildConfig +zstdIpe = vanilla { withZstd = True } + static :: BuildConfig static = vanilla { fullyStatic = True } @@ -313,18 +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" - flavourString BootNonmovingGc = "boot_nonmoving_gc" + 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 BootNonmovingGc = "boot_nonmoving_gc" -- The path to the docker image (just for linux builders) dockerImage :: Arch -> Opsys -> Maybe String @@ -517,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 @@ -553,6 +563,7 @@ data Rule = FastCI -- ^ Run this job when the fast-ci label is set | 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. + | IpeData -- ^ Only run this job when the "IPE" label is set | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) @@ -579,12 +590,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 @@ -880,7 +893,6 @@ job_groups = modifyNightlyJobs allowFailure (modifyValidateJobs manual (validateBuilds Amd64 (Linux Debian10) noTntc)) , addValidateRule LLVMBackend (validateBuilds Amd64 (Linux Debian10) llvm) - , 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. @@ -919,6 +931,8 @@ job_groups = , modifyValidateJobs manual $ make_wasm_jobs wasm_build_config {unregisterised = True} , addValidateRule NonmovingGc (standardBuildsWithConfig Amd64 (Linux Debian11) vanilla {validateNonmovingGc = True}) + , modifyNightlyJobs (addJobRule Disable) $ + addValidateRule IpeData (validateBuilds Amd64 (Linux Debian10) zstdIpe) ] where ===================================== .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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -641,7 +641,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -703,7 +703,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -765,7 +765,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -826,7 +826,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -887,7 +887,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1008,7 +1008,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1067,7 +1067,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1186,7 +1186,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1245,7 +1245,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1304,7 +1304,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1363,7 +1363,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1422,7 +1422,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1483,7 +1483,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1544,7 +1544,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1606,7 +1606,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1665,7 +1665,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1725,7 +1725,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1784,7 +1784,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1845,7 +1845,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1907,7 +1907,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1968,7 +1968,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2028,7 +2028,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2087,7 +2087,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2142,7 +2142,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2201,7 +2201,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2264,7 +2264,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2328,7 +2328,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2389,7 +2389,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2450,7 +2450,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2516,7 +2516,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2579,7 +2579,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2642,7 +2642,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2705,7 +2705,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2766,7 +2766,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2827,7 +2827,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2888,7 +2888,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2949,7 +2949,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3011,7 +3011,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3072,7 +3072,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3135,7 +3135,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3198,7 +3198,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3261,7 +3261,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3322,7 +3322,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3383,7 +3383,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3440,7 +3440,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3500,7 +3500,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3564,7 +3564,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3628,7 +3628,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3688,7 +3688,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3749,7 +3749,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3810,7 +3810,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -3871,7 +3871,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -3931,7 +3931,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3990,7 +3990,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4048,7 +4048,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4107,7 +4107,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4130,6 +4130,64 @@ "TEST_ENV": "x86_64-linux-deb10-unreg-validate" } }, + "x86_64-linux-deb10-validate": { + "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.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\") && (\"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", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "TEST_ENV": "x86_64-linux-deb10-validate" + } + }, "x86_64-linux-deb10-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -4165,7 +4223,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4223,7 +4281,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4282,7 +4340,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4342,7 +4400,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4402,7 +4460,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4463,7 +4521,7 @@ ], "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\")", + "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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4522,7 +4580,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4578,7 +4636,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -1,67 +1,188 @@ +{-# 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.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, unpackFS, LexicalFastString(..)) +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. + +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). -emitIpeBufferListNode :: Module - -> [InfoProvEnt] - -> FCode () +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 + + entries_bytes :: BS.ByteString + entries_bytes = compress defaultCompressionLevel uncompressed_entries - 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 :: [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 @@ -77,7 +198,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 @@ -105,7 +226,7 @@ data StringTable = StringTable { stStrings :: DList ShortText , stLookup :: !(M.Map ShortText StrTabOffset) } -newtype StrTabOffset = StrTabOffset Int +type StrTabOffset = Word32 emptyStringTable :: StringTable emptyStringTable = @@ -130,9 +251,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,12 +57,20 @@ Flag build-tool-depends Description: Use build-tool-depends Default: True +Flag with-libzstd + Default: False + Manual: True + -- While the boot compiler fixes ghc's unit-id to `ghc`, the stage0 compiler must still be compiled with `-this-unit-id ghc` Flag hadrian-stage0 Description: Enable if compiling the stage0 compiler with hadrian Default: False Manual: True +Flag static-libzstd + Default: False + Manual: True + Library Default-Language: Haskell2010 Exposed: False @@ -77,6 +85,16 @@ 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) + if flag(static-libzstd) + if os(darwin) + buildable: False + else + extra-libraries: :libzstd.a + else + 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 ===================================== @@ -1105,6 +1105,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 @@ -1250,6 +1254,19 @@ 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;) +STATIC_LIBZSTD=$(if [ "$StaticLibZstd" = "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 + statically linked? : $STATIC_LIBZSTD + libdw : $USING_LIBDW Using LLVM tools clang : $ClangCmd ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -128,6 +128,20 @@ Compiler GHC used to accept the contradictory ``Int~Bool`` in the type signature, but reject the ``Int~Bool`` constraint that arises from typechecking the definition itself. Now it accepts both. More details in `GHC ticket #23413 `_, which gives examples of the previous inconsistency. GHC now implements the "PermissivePlan" described in that ticket. +- 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 `_ version 1.4.0 or greater + installed. The compression library `libzstd` may optionally be statically + linked in the resulting compiler (on non-darwin machines) using the + `--enable-static-libzstd` configure flag. + + 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,26 @@ 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. The compression + library ``libzstd`` may optionally be statically linked in the resulting + compiler (on non-darwin machines) using the ``--enable-static-libzstd`` + configure flag. + + 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 ===================================== @@ -199,10 +199,15 @@ 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@ +static-lib-zstd = @UseStaticLibZstd@ use-lib-numa = @UseLibNuma@ use-lib-m = @UseLibm@ use-lib-rt = @UseLibrt@ ===================================== hadrian/src/Oracles/Flag.hs ===================================== @@ -35,6 +35,8 @@ data Flag = ArSupportsAtFile | UseLibffiForAdjustors | UseLibdw | UseLibnuma + | UseLibzstd + | StaticLibzstd | UseLibm | UseLibrt | UseLibdl @@ -65,6 +67,8 @@ flag f = do UseLibffiForAdjustors -> "use-libffi-for-adjustors" UseLibdw -> "use-lib-dw" UseLibnuma -> "use-lib-numa" + UseLibzstd -> "use-lib-zstd" + StaticLibzstd -> "static-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 @@ -161,6 +163,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 ===================================== @@ -316,6 +316,8 @@ rtsCabalFlags = mconcat , flag "CabalNeedLibpthread" UseLibpthread , flag "CabalHaveLibbfd" UseLibbfd , flag "CabalHaveLibNuma" UseLibnuma + , flag "CabalHaveLibZstd" UseLibzstd + , flag "CabalStaticLibZstd" StaticLibzstd , flag "CabalNeedLibatomic" NeedLibatomic , flag "CabalUseSystemLibFFI" UseSystemFfi , flag "CabalLibffiAdjustors" UseLibffiForAdjustors ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -74,11 +74,13 @@ packageArgs = do [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" , notM cross `cabalFlag` "terminfo" , arg "-build-tool-depends" + , flag UseLibzstd `cabalFlag` "with-libzstd" -- ROMES: While the boot compiler is not updated wrt -this-unit-id -- not being fixed to `ghc`, when building stage0, we must set -- -this-unit-id to `ghc` because the boot compiler expects that. -- We do it through a cabal flag in ghc.cabal , stage0 ? arg "+hadrian-stage0" + , flag StaticLibzstd `cabalFlag` "static-libzstd" ] , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ] @@ -288,6 +290,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 @@ -394,6 +398,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,120 @@ +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] + ) + + StaticLibZstd=0 + AC_ARG_ENABLE( + static-libzstd, + [AS_HELP_STRING( + [--enable-static-libzstd], + [Statically link the libzstd compression library with the compiler + (not compatible with darwin) [default=no]] + )], + [StaticLibZstd=1], + [StaticLibZstd=0] + ) + + HaveLibZstd=0 + if test "$EnableIpeDataCompression" = "YES"; then + dnl ** Have zstd >= 1.4.0? + 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 + + # libzstd >= 1.4.0 is required for IPE data compression + fp_libzstd_version="`pkg-config --modversion libzstd`" + FP_COMPARE_VERSIONS( + [$fp_libzstd_version], + [-lt], + [1.4.0], + [AC_MSG_ERROR( + [Need at least libzstd version 1.4.0 for + --enable-ipe-data-compression]) + ] + ) + + 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)]) + + AC_DEFINE_UNQUOTED([STATIC_LIBZSTD], [$StaticLibZstd], [Define to 1 if you + wish to statically link the libzstd compression library in the compiler + (requires libzstd)]) + + if test $HaveLibZstd = "1" ; then + AC_SUBST([UseLibZstd],[YES]) + AC_SUBST([CabalHaveLibZstd],[True]) + if test $StaticLibZstd = "1" ; then + case "${host_os}" in + darwin*) + AC_MSG_ERROR( + [--enable-static-libzstd is not compatible with darwin] + ) + esac + AC_SUBST([UseStaticLibZstd],[YES]) + AC_SUBST([CabalStaticLibZstd],[True]) + else + AC_SUBST([UseStaticLibZstd],[NO]) + AC_SUBST([CabalStaticLibZstd],[False]) + fi + 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,85 @@ 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; + IpeBufferEntry *entries; + 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 == 1) { + // 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,10 @@ flag libdw default: @CabalHaveLibdw@ flag libnuma default: @CabalHaveLibNuma@ +flag libzstd + default: @CabalHaveLibZstd@ +flag static-libzstd + default: @CabalStaticLibZstd@ flag leading-underscore default: @CabalLeadingUnderscore@ flag smp @@ -211,6 +215,14 @@ library extra-libraries: elf dw if flag(libnuma) extra-libraries: numa + if flag(libzstd) + if flag(static-libzstd) + if os(darwin) + buildable: False + else + extra-libraries: :libzstd.a + else + extra-libraries: zstd if !flag(smp) cpp-options: -DNOSMP ===================================== 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/8a938f56408deaf3f7bff619568f217a1c93e74c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8a938f56408deaf3f7bff619568f217a1c93e74c You're receiving 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 Jun 8 02:38:59 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Wed, 07 Jun 2023 22:38:59 -0400 Subject: [Git][ghc/ghc][wip/ipe-data-compression] IPE data compression Message-ID: <64813f436679e_2088507be5954148239@gitlab.mail> Finley McIlwaine pushed to branch wip/ipe-data-compression at Glasgow Haskell Compiler / GHC Commits: f60707ef by Finley McIlwaine at 2023-06-07T20:38:25-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 23 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/StgToCmm/InfoTableProv.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/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-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: ae60a90db673e679399286e3b63c21c8e7a9a9b9 + DOCKER_REV: 147a4b6c6337b149db53b19185e100e45e549094 # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. ===================================== .gitlab/gen_ci.hs ===================================== @@ -141,6 +141,7 @@ data BuildConfig , llvmBootstrap :: Bool , withAssertions :: Bool , withNuma :: Bool + , withZstd :: Bool , crossTarget :: Maybe String , crossEmulator :: CrossEmulator , configureWrapper :: Maybe String @@ -154,10 +155,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 @@ -172,8 +174,12 @@ mkJobFlavour BuildConfig{..} = Flavour buildFlavour opts 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 @@ -192,6 +198,7 @@ vanilla = BuildConfig , llvmBootstrap = False , withAssertions = False , withNuma = False + , withZstd = False , crossTarget = Nothing , crossEmulator = NoEmulator , configureWrapper = Nothing @@ -224,6 +231,9 @@ debug = vanilla { buildFlavour = SlowValidate , withNuma = True } +zstdIpe :: BuildConfig +zstdIpe = vanilla { withZstd = True } + static :: BuildConfig static = vanilla { fullyStatic = True } @@ -313,18 +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" - flavourString BootNonmovingGc = "boot_nonmoving_gc" + 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 BootNonmovingGc = "boot_nonmoving_gc" -- The path to the docker image (just for linux builders) dockerImage :: Arch -> Opsys -> Maybe String @@ -517,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 @@ -553,6 +563,7 @@ data Rule = FastCI -- ^ Run this job when the fast-ci label is set | 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. + | IpeData -- ^ Only run this job when the "IPE" label is set | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) @@ -579,12 +590,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 @@ -880,7 +893,6 @@ job_groups = modifyNightlyJobs allowFailure (modifyValidateJobs manual (validateBuilds Amd64 (Linux Debian10) noTntc)) , addValidateRule LLVMBackend (validateBuilds Amd64 (Linux Debian10) llvm) - , 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. @@ -919,6 +931,8 @@ job_groups = , modifyValidateJobs manual $ make_wasm_jobs wasm_build_config {unregisterised = True} , addValidateRule NonmovingGc (standardBuildsWithConfig Amd64 (Linux Debian11) vanilla {validateNonmovingGc = True}) + , modifyNightlyJobs (addJobRule Disable) $ + addValidateRule IpeData (validateBuilds Amd64 (Linux Debian10) zstdIpe) ] where ===================================== .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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -641,7 +641,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -703,7 +703,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -765,7 +765,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -826,7 +826,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -887,7 +887,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1008,7 +1008,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1067,7 +1067,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1186,7 +1186,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1245,7 +1245,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1304,7 +1304,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1363,7 +1363,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1422,7 +1422,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1483,7 +1483,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1544,7 +1544,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1606,7 +1606,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1665,7 +1665,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1725,7 +1725,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1784,7 +1784,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1845,7 +1845,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1907,7 +1907,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1968,7 +1968,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2028,7 +2028,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2087,7 +2087,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2142,7 +2142,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2201,7 +2201,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2264,7 +2264,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2328,7 +2328,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2389,7 +2389,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2450,7 +2450,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2516,7 +2516,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2579,7 +2579,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2642,7 +2642,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2705,7 +2705,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2766,7 +2766,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2827,7 +2827,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2888,7 +2888,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2949,7 +2949,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3011,7 +3011,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3072,7 +3072,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3135,7 +3135,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3198,7 +3198,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3261,7 +3261,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3322,7 +3322,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3383,7 +3383,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3440,7 +3440,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3500,7 +3500,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3564,7 +3564,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3628,7 +3628,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3688,7 +3688,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3749,7 +3749,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3810,7 +3810,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -3871,7 +3871,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -3931,7 +3931,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3990,7 +3990,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4048,7 +4048,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4107,7 +4107,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4130,6 +4130,64 @@ "TEST_ENV": "x86_64-linux-deb10-unreg-validate" } }, + "x86_64-linux-deb10-validate": { + "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.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\") && (\"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", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "TEST_ENV": "x86_64-linux-deb10-validate" + } + }, "x86_64-linux-deb10-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -4165,7 +4223,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4223,7 +4281,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4282,7 +4340,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4342,7 +4400,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4402,7 +4460,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4463,7 +4521,7 @@ ], "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\")", + "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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4522,7 +4580,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4578,7 +4636,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -1,67 +1,188 @@ +{-# 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.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, unpackFS, LexicalFastString(..)) +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. + +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). -emitIpeBufferListNode :: Module - -> [InfoProvEnt] - -> FCode () +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 + + entries_bytes :: BS.ByteString + entries_bytes = compress defaultCompressionLevel uncompressed_entries - 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 :: [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 @@ -77,7 +198,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 @@ -105,7 +226,7 @@ data StringTable = StringTable { stStrings :: DList ShortText , stLookup :: !(M.Map ShortText StrTabOffset) } -newtype StrTabOffset = StrTabOffset Int +type StrTabOffset = Word32 emptyStringTable :: StringTable emptyStringTable = @@ -130,9 +251,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,14 @@ Flag build-tool-depends Description: Use build-tool-depends Default: True +Flag with-libzstd + Default: False + Manual: True + +Flag static-libzstd + Default: False + Manual: True + -- While the boot compiler fixes ghc's unit-id to `ghc`, the stage0 compiler must still be compiled with `-this-unit-id ghc` Flag hadrian-stage0 Description: Enable if compiling the stage0 compiler with hadrian @@ -77,6 +85,16 @@ 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) + if flag(static-libzstd) + if os(darwin) + buildable: False + else + extra-libraries: :libzstd.a + else + 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 ===================================== @@ -1105,6 +1105,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 @@ -1250,6 +1254,19 @@ 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;) +STATIC_LIBZSTD=$(if [ "$StaticLibZstd" = "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 + statically linked? : $STATIC_LIBZSTD + libdw : $USING_LIBDW Using LLVM tools clang : $ClangCmd ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -128,6 +128,20 @@ Compiler GHC used to accept the contradictory ``Int~Bool`` in the type signature, but reject the ``Int~Bool`` constraint that arises from typechecking the definition itself. Now it accepts both. More details in `GHC ticket #23413 `_, which gives examples of the previous inconsistency. GHC now implements the "PermissivePlan" described in that ticket. +- 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 `_ version 1.4.0 or greater + installed. The compression library `libzstd` may optionally be statically + linked in the resulting compiler (on non-darwin machines) using the + `--enable-static-libzstd` configure flag. + + 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,26 @@ 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. The compression + library ``libzstd`` may optionally be statically linked in the resulting + compiler (on non-darwin machines) using the ``--enable-static-libzstd`` + configure flag. + + 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 ===================================== @@ -199,10 +199,15 @@ 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@ +static-lib-zstd = @UseStaticLibZstd@ use-lib-numa = @UseLibNuma@ use-lib-m = @UseLibm@ use-lib-rt = @UseLibrt@ ===================================== hadrian/src/Oracles/Flag.hs ===================================== @@ -35,6 +35,8 @@ data Flag = ArSupportsAtFile | UseLibffiForAdjustors | UseLibdw | UseLibnuma + | UseLibzstd + | StaticLibzstd | UseLibm | UseLibrt | UseLibdl @@ -65,6 +67,8 @@ flag f = do UseLibffiForAdjustors -> "use-libffi-for-adjustors" UseLibdw -> "use-lib-dw" UseLibnuma -> "use-lib-numa" + UseLibzstd -> "use-lib-zstd" + StaticLibzstd -> "static-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 @@ -161,6 +163,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 ===================================== @@ -316,6 +316,8 @@ rtsCabalFlags = mconcat , flag "CabalNeedLibpthread" UseLibpthread , flag "CabalHaveLibbfd" UseLibbfd , flag "CabalHaveLibNuma" UseLibnuma + , flag "CabalHaveLibZstd" UseLibzstd + , flag "CabalStaticLibZstd" StaticLibzstd , flag "CabalNeedLibatomic" NeedLibatomic , flag "CabalUseSystemLibFFI" UseSystemFfi , flag "CabalLibffiAdjustors" UseLibffiForAdjustors ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -74,11 +74,13 @@ packageArgs = do [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" , notM cross `cabalFlag` "terminfo" , arg "-build-tool-depends" + , flag UseLibzstd `cabalFlag` "with-libzstd" -- ROMES: While the boot compiler is not updated wrt -this-unit-id -- not being fixed to `ghc`, when building stage0, we must set -- -this-unit-id to `ghc` because the boot compiler expects that. -- We do it through a cabal flag in ghc.cabal , stage0 ? arg "+hadrian-stage0" + , flag StaticLibzstd `cabalFlag` "static-libzstd" ] , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ] @@ -288,6 +290,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 @@ -394,6 +398,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,120 @@ +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] + ) + + StaticLibZstd=0 + AC_ARG_ENABLE( + static-libzstd, + [AS_HELP_STRING( + [--enable-static-libzstd], + [Statically link the libzstd compression library with the compiler + (not compatible with darwin) [default=no]] + )], + [StaticLibZstd=1], + [StaticLibZstd=0] + ) + + HaveLibZstd=0 + if test "$EnableIpeDataCompression" = "YES"; then + dnl ** Have zstd >= 1.4.0? + 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 + + # libzstd >= 1.4.0 is required for IPE data compression + fp_libzstd_version="`pkg-config --modversion libzstd`" + FP_COMPARE_VERSIONS( + [$fp_libzstd_version], + [-lt], + [1.4.0], + [AC_MSG_ERROR( + [Need at least libzstd version 1.4.0 for + --enable-ipe-data-compression]) + ] + ) + + 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)]) + + AC_DEFINE_UNQUOTED([STATIC_LIBZSTD], [$StaticLibZstd], [Define to 1 if you + wish to statically link the libzstd compression library in the compiler + (requires libzstd)]) + + if test $HaveLibZstd = "1" ; then + AC_SUBST([UseLibZstd],[YES]) + AC_SUBST([CabalHaveLibZstd],[True]) + if test $StaticLibZstd = "1" ; then + case "${host_os}" in + darwin*) + AC_MSG_ERROR( + [--enable-static-libzstd is not compatible with darwin] + ) + esac + AC_SUBST([UseStaticLibZstd],[YES]) + AC_SUBST([CabalStaticLibZstd],[True]) + else + AC_SUBST([UseStaticLibZstd],[NO]) + AC_SUBST([CabalStaticLibZstd],[False]) + fi + 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,85 @@ 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; + IpeBufferEntry *entries; + 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 == 1) { + // 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,10 @@ flag libdw default: @CabalHaveLibdw@ flag libnuma default: @CabalHaveLibNuma@ +flag libzstd + default: @CabalHaveLibZstd@ +flag static-libzstd + default: @CabalStaticLibZstd@ flag leading-underscore default: @CabalLeadingUnderscore@ flag smp @@ -211,6 +215,14 @@ library extra-libraries: elf dw if flag(libnuma) extra-libraries: numa + if flag(libzstd) + if flag(static-libzstd) + if os(darwin) + buildable: False + else + extra-libraries: :libzstd.a + else + extra-libraries: zstd if !flag(smp) cpp-options: -DNOSMP ===================================== 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/f60707efe212b5f6c2a5c05ca69ea77be65713c6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f60707efe212b5f6c2a5c05ca69ea77be65713c6 You're receiving 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 Jun 8 03:00:40 2023 From: gitlab at gitlab.haskell.org (Matthew Craven (@clyring)) Date: Wed, 07 Jun 2023 23:00:40 -0400 Subject: [Git][ghc/ghc][wip/forall-vis-coercions] 98 commits: Migrate errors in GHC.Tc.Validity Message-ID: <64814458e721d_20885081591d8148798@gitlab.mail> Matthew Craven pushed to branch wip/forall-vis-coercions at Glasgow Haskell Compiler / GHC Commits: 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - a5961bd1 by Matthew Craven at 2023-06-07T22:53:44-04:00 WIP: Track visibility in forall-coercions - - - - - 69ff576f by Matthew Craven at 2023-06-07T22:57:41-04:00 revert temporary renamings of the forallco constructors - - - - - 1338e04f by Matthew Craven at 2023-06-07T23:00:15-04:00 make necessary testsuite changes - - - - - 1c783821 by Matthew Craven at 2023-06-07T23:00:15-04:00 accept new output for T23398 - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types/Prim.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/01955e401b4b701c9ca23fb3e7b798f56d68d5a7...1c7838219ec5d804dfca14a9659c62d88579b9e4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/01955e401b4b701c9ca23fb3e7b798f56d68d5a7...1c7838219ec5d804dfca14a9659c62d88579b9e4 You're receiving 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 Jun 8 06:17:56 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Thu, 08 Jun 2023 02:17:56 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/modern-STV-extension-shuffling] 28 commits: [hadrian] Fix multiline synopsis rendering Message-ID: <648172945a74_20885081591c4161121@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/modern-STV-extension-shuffling at Glasgow Haskell Compiler / GHC Commits: f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - bb4d1dc8 by Andrei Borzenkov at 2023-06-08T10:17:38+04:00 Extension shuffling (#23291) Where introduced 3 new extensions: - PatternSignatures - ExtendedForAllScope - MethodTypeVariables Tasks of ScopedTypeVariables extension were distributed between PatternSignatures, ExtendedForAllScope and MethodTypeVariables according to the proposal. Now ScopedTypeVaribles only implies these three exntesions. - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - compiler/GHC/Builtin/Names/TH.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Plugins.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/979366a1b0695db8e274425b52b3a4eff6eb8c87...bb4d1dc87411472b8779107e32742442f9fc4d0d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/979366a1b0695db8e274425b52b3a4eff6eb8c87...bb4d1dc87411472b8779107e32742442f9fc4d0d You're receiving 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 Jun 8 06:21:18 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Thu, 08 Jun 2023 02:21:18 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/#23434-wterm-variable-capture] 60 commits: Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) Message-ID: <6481735ea962c_20885010e39418164355@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/#23434-wterm-variable-capture at Glasgow Haskell Compiler / GHC Commits: 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 4785fc30 by Andrei Borzenkov at 2023-06-08T10:21:07+04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 30 changed files: - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types/Prim.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0009b5ae5bab089a79499f6446a3afebf43d08ce...4785fc30b650053176e0c05ba2ce0f3de548b144 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0009b5ae5bab089a79499f6446a3afebf43d08ce...4785fc30b650053176e0c05ba2ce0f3de548b144 You're receiving 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 Jun 8 06:25:06 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Thu, 08 Jun 2023 02:25:06 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/modern-STV-add-warning] 30 commits: [hadrian] Fix multiline synopsis rendering Message-ID: <64817442ea02b_2088507be59541652db@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/modern-STV-add-warning at Glasgow Haskell Compiler / GHC Commits: f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - bb4d1dc8 by Andrei Borzenkov at 2023-06-08T10:17:38+04:00 Extension shuffling (#23291) Where introduced 3 new extensions: - PatternSignatures - ExtendedForAllScope - MethodTypeVariables Tasks of ScopedTypeVariables extension were distributed between PatternSignatures, ExtendedForAllScope and MethodTypeVariables according to the proposal. Now ScopedTypeVaribles only implies these three exntesions. - - - - - 30ee76b8 by Andrei Borzenkov at 2023-06-08T10:24:13+04:00 Extension shuffling (#23291) Where introduced 3 new extensions: - PatternSignatures - ExtendedForAllScope - MethodTypeVariables Tasks of ScopedTypeVariables extension were distributed between PatternSignatures, ExtendedForAllScope and MethodTypeVariables according to the proposal. Now ScopedTypeVaribles only implies these three exntesions. - - - - - ea6fada4 by Andrei Borzenkov at 2023-06-08T10:24:52+04:00 Adding -Wpattern-signature-binds (#23291) Was introduced one new warning option: -Wpattern-signature-binds It warns when pattern signature binds into scope new type variable. For example: f (a :: t) = ... - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - compiler/GHC/Builtin/Names/TH.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Plugins.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Env.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1f1f20364a7f609645e8a09277d5f3a94e6afa97...ea6fada4fe1b87a6c37d97f1f992a40996784d40 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1f1f20364a7f609645e8a09277d5f3a94e6afa97...ea6fada4fe1b87a6c37d97f1f992a40996784d40 You're receiving 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 Jun 8 06:27:54 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Thu, 08 Jun 2023 02:27:54 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/#16635-improve-errors] 17 commits: Generate Addr# access ops programmatically Message-ID: <648174eae53ea_208850820a53c16545f@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/#16635-improve-errors at Glasgow Haskell Compiler / GHC Commits: 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 3acaa9b6 by Andrei Borzenkov at 2023-06-08T10:27:44+04:00 Capture scoped kind variables at type-checking phase (#16635) Like descibed in new Note [A scoping errors during type check] in GHC.Tc.Types, I made ScopedTypeVariables work on type level like in term level. For now that only means, that the error about kind variables scoped into type are rejected at the elaboration time, because we can't generalize the type by adding type-level lambda - we simply have no one. - - - - - 21 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - compiler/GHC/Builtin/Names/TH.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/TyCon.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Quote.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/StgToCmm/InfoTableProv.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Splice.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fb624fe0d2c5e9fa2e12075850fa9fe6c17d6bd7...3acaa9b6f0c658c31c70b68c895d16872e9e701b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fb624fe0d2c5e9fa2e12075850fa9fe6c17d6bd7...3acaa9b6f0c658c31c70b68c895d16872e9e701b You're receiving 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 Jun 8 06:50:37 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Thu, 08 Jun 2023 02:50:37 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/modern-STV-add-warning] Adding -Wpattern-signature-binds (#23291) Message-ID: <64817a3d5d695_208850766c784169945@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/modern-STV-add-warning at Glasgow Haskell Compiler / GHC Commits: 57538c95 by Andrei Borzenkov at 2023-06-08T10:50:22+04:00 Adding -Wpattern-signature-binds (#23291) Was introduced one new warning option: -Wpattern-signature-binds It warns when pattern signature binds into scope new type variable. For example: f (a :: t) = ... - - - - - 12 changed files: - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/using-warnings.rst - + testsuite/tests/rename/should_fail/WPatternSigBinds.hs - + testsuite/tests/rename/should_fail/WPatternSigBinds.stderr - testsuite/tests/rename/should_fail/all.T Changes: ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -640,6 +640,7 @@ data WarningFlag = | Opt_WarnLoopySuperclassSolve -- Since 9.6 | Opt_WarnTermVariableCapture -- Since 9.8 | Opt_WarnMissingRoleAnnotations -- Since 9.8 + | Opt_WarnPatternSignatureBinds -- Since 9.8 deriving (Eq, Ord, Show, Enum) -- | Return the names of a WarningFlag @@ -747,6 +748,7 @@ warnFlagNames wflag = case wflag of Opt_WarnLoopySuperclassSolve -> "loopy-superclass-solve" :| [] Opt_WarnTypeEqualityRequiresOperators -> "type-equality-requires-operators" :| [] Opt_WarnMissingRoleAnnotations -> "missing-role-annotations" :| [] + Opt_WarnPatternSignatureBinds -> "pattern-signature-binds" :| [] -- ----------------------------------------------------------------------------- -- Standard sets of warning options ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2257,7 +2257,8 @@ wWarningFlagsDeps = mconcat [ warnSpec Opt_WarnTypeEqualityOutOfScope, warnSpec Opt_WarnTypeEqualityRequiresOperators, warnSpec Opt_WarnTermVariableCapture, - warnSpec Opt_WarnMissingRoleAnnotations + warnSpec Opt_WarnMissingRoleAnnotations, + warnSpec Opt_WarnPatternSignatureBinds ] warningGroupsDeps :: [(Deprecation, FlagSpec WarningGroup)] ===================================== compiler/GHC/Rename/Bind.hs ===================================== @@ -519,7 +519,7 @@ rnBind sig_fn bind@(FunBind { fun_id = name -- invariant: no free vars here when it's a FunBind = do { let plain_name = unLoc name - ; (matches', rhs_fvs) <- bindSigTyVarsFVExtended (sig_fn plain_name) $ + ; (matches', rhs_fvs) <- bindSigTyVarsFV (sig_fn plain_name) $ -- bindSigTyVars tests for LangExt.ScopedTyVars rnMatchGroup (mkPrefixFunRhs name) rnLExpr matches @@ -726,7 +726,7 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name ; unless pattern_synonym_ok (addErr TcRnIllegalPatternSynonymDecl) ; let scoped_tvs = sig_fn name - ; ((pat', details'), fvs1) <- bindSigTyVarsFVExtended scoped_tvs $ + ; ((pat', details'), fvs1) <- bindSigTyVarsFV scoped_tvs $ rnPat PatSyn pat $ \pat' -> -- We check the 'RdrName's instead of the 'Name's -- so that the binding locations are reported @@ -763,7 +763,7 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name Unidirectional -> return (Unidirectional, emptyFVs) ImplicitBidirectional -> return (ImplicitBidirectional, emptyFVs) ExplicitBidirectional mg -> - do { (mg', fvs) <- bindSigTyVarsFVExtended scoped_tvs $ + do { (mg', fvs) <- bindSigTyVarsFV scoped_tvs $ rnMatchGroup (mkPrefixFunRhs (L l name)) rnLExpr mg ; return (ExplicitBidirectional mg', fvs) } ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -173,6 +173,10 @@ rnHsPatSigType scoping ctx sig_ty thing_inside then tv_rdrs else [] NeverBind -> [] + ; let i_bndrs = nubN implicit_bndrs in + unless (null i_bndrs) $ + forM_ i_bndrs $ \i_bndr -> + addDiagnosticAt (locA $ getLoc i_bndr) (TcRnPatternSignatureBinds i_bndr) ; rnImplicitTvOccs Nothing implicit_bndrs $ \ imp_tvs -> do { (nwcs, pat_sig_ty', fvs1) <- rnWcBody ctx nwc_rdrs pat_sig_ty ; let sig_names = HsPSRn { hsps_nwcs = nwcs, hsps_imp_tvs = imp_tvs } ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1848,6 +1848,11 @@ instance Diagnostic TcRnMessage where , text "Either a standalone kind signature (SAKS)" , text "or a complete user-supplied kind (CUSK, legacy feature)" , text "is required to use invisible binders." ] + + TcRnPatternSignatureBinds fvar -> mkSimpleDecorated $ + sep [text "Type variable binding" + , text "in pattern signature:" <+> quotes (ppr fvar) + ] diagnosticReason = \case TcRnUnknownMessage m @@ -2465,6 +2470,8 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnInvisBndrWithoutSig{} -> ErrorWithoutFlag + TcRnPatternSignatureBinds{} + -> WarningWithFlag Opt_WarnPatternSignatureBinds diagnosticHints = \case TcRnUnknownMessage m @@ -3128,6 +3135,8 @@ instance Diagnostic TcRnMessage where -> noHints TcRnInvisBndrWithoutSig name _ -> [SuggestAddStandaloneKindSignature name] + TcRnPatternSignatureBinds{} + -> noHints diagnosticCode :: TcRnMessage -> Maybe DiagnosticCode diagnosticCode = constructorCode ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -4094,6 +4094,18 @@ data TcRnMessage where -} TcRnMissingRoleAnnotation :: Name -> [Role] -> TcRnMessage + {-| TcRnPatternSignatureBinds is a warning thrown when a user binds + type variables in a pattern signature. This is only performed with + -Wpattern-signature-binds + + Example(s): + + id (x :: b) = x + + Test case: rename/should_fail/WPatternSigBinds + -} + TcRnPatternSignatureBinds :: LocatedN RdrName -> TcRnMessage + deriving Generic ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -591,6 +591,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnArityMismatch" = 27346 GhcDiagnosticCode "TcRnSimplifiableConstraint" = 62412 GhcDiagnosticCode "TcRnIllegalQuasiQuotes" = 77343 + GhcDiagnosticCode "TcRnPatternSignatureBinds" = 65467 -- TcRnTypeApplicationsDisabled GhcDiagnosticCode "TypeApplication" = 23482 ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -30,6 +30,9 @@ Compiler - Added a new warning :ghc-flag:`-Wterm-variable-capture` that helps to make code compatible with the future extension ``RequiredTypeArguments``. +- Added a new warning :ghc-flag:`-Wpattern-signature-binds` which alerts the user when they bind + a new type variable in a pattern signature. + - Rewrite rules now support a limited form of higher order matching when a pattern variable is applied to distinct locally bound variables. For example: :: ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -2415,6 +2415,28 @@ of ``-W(no-)*``. In other words the type-class role cannot be accidentally left representational or phantom, which could affected the code correctness. +.. ghc-flag:: -Wpattern-signature-binds + :shortdesc: warn when a pattern signature binds new type variables + :type: dynamic + + :since: 9.8.1 + + Added in accordance with `GHC Proposal #448 + `__. + + Type variable bindings in pattern signatures violate the Lexical Scoping Principle: depending + on the context, type variables in pattern signatures can be either occurrences or bindings. + + For example: :: + + f (x :: a) = ... -- binding of ‘a’ + + g :: forall a . ... + g (x :: a) = ... -- occurrence of ‘a’ + + When :ghc-flag:`-Wpattern-signature-binds` is enabled, GHC warns about type variable bindings + in pattern signatures. + If you're feeling really paranoid, the :ghc-flag:`-dcore-lint` option is a good choice. It turns on heavyweight intra-pass sanity-checking within GHC. (It checks GHC's ===================================== testsuite/tests/rename/should_fail/WPatternSigBinds.hs ===================================== @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -Wpattern-signature-binds -Werror #-} +module WPatternSigBinds where + +f (x :: a) = x + +g (x :: a) (y :: b) = x + +h (x :: a) (y :: b c d) = x + +i :: forall f a . f a -> f a +i (x :: b c) = x ===================================== testsuite/tests/rename/should_fail/WPatternSigBinds.stderr ===================================== @@ -0,0 +1,27 @@ + +WPatternSigBinds.hs:4:9: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds] + Type variable binding in pattern signature: ‘a’ + +WPatternSigBinds.hs:6:9: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds] + Type variable binding in pattern signature: ‘a’ + +WPatternSigBinds.hs:6:18: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds] + Type variable binding in pattern signature: ‘b’ + +WPatternSigBinds.hs:8:9: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds] + Type variable binding in pattern signature: ‘a’ + +WPatternSigBinds.hs:8:18: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds] + Type variable binding in pattern signature: ‘b’ + +WPatternSigBinds.hs:8:20: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds] + Type variable binding in pattern signature: ‘c’ + +WPatternSigBinds.hs:8:22: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds] + Type variable binding in pattern signature: ‘d’ + +WPatternSigBinds.hs:11:9: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds] + Type variable binding in pattern signature: ‘b’ + +WPatternSigBinds.hs:11:11: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds] + Type variable binding in pattern signature: ‘c’ ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -198,3 +198,4 @@ test('RnUnexpectedStandaloneDeriving', normal, compile_fail, ['']) test('RnStupidThetaInGadt', normal, compile_fail, ['']) test('PackageImportsDisabled', normal, compile_fail, ['']) test('ImportLookupIllegal', normal, compile_fail, ['']) +test('WPatternSigBinds', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/57538c9569954da222aa6b01b453a252a8667b34 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/57538c9569954da222aa6b01b453a252a8667b34 You're receiving 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 Jun 8 06:59:18 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 08 Jun 2023 02:59:18 -0400 Subject: [Git][ghc/ghc][wip/t23472] hadrian: Fix dependencies of docs:* rule Message-ID: <64817c46297ca_20885081591d81702c7@gitlab.mail> Matthew Pickering pushed to branch wip/t23472 at Glasgow Haskell Compiler / GHC Commits: 03a1ebb1 by Matthew Pickering at 2023-06-08T07:58:45+01:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - 1 changed file: - hadrian/src/Rules/Documentation.hs Changes: ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -258,6 +258,15 @@ buildPackageDocumentation = do need [ takeDirectory file -/- "haddock-prologue.txt"] haddocks <- haddockDependencies context + -- Build Haddock documentation + -- TODO: Pass the correct way from Rules via Context. + dynamicPrograms <- dynamicGhcPrograms =<< flavour + let haddockWay = if dynamicPrograms then dynamic else vanilla + + -- Build the dependencies of the package we are going to build documentation for + dep_pkgs <- sequence [pkgConfFile (context { way = haddockWay, Context.package = p}) + | (p, _) <- haddocks] + -- `ghc-prim` has a source file for 'GHC.Prim' which is generated just -- for Haddock. We need to 'union' (instead of '++') to avoid passing -- 'GHC.PrimopWrappers' (which unfortunately shows up in both @@ -266,12 +275,8 @@ buildPackageDocumentation = do vanillaSrcs <- hsSources context let srcs = vanillaSrcs `union` generatedSrcs - need $ srcs ++ (map snd haddocks) + need $ srcs ++ (map snd haddocks) ++ dep_pkgs - -- Build Haddock documentation - -- TODO: Pass the correct way from Rules via Context. - dynamicPrograms <- dynamicGhcPrograms =<< flavour - let haddockWay = if dynamicPrograms then dynamic else vanilla statsFilesDir <- haddockStatsFilesDir createDirectory statsFilesDir build $ target (context {way = haddockWay}) (Haddock BuildPackage) srcs [file] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/03a1ebb19bcf5ef304b36c3e5da654235986a19a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/03a1ebb19bcf5ef304b36c3e5da654235986a19a You're receiving 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 Jun 8 06:59:53 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 08 Jun 2023 02:59:53 -0400 Subject: [Git][ghc/ghc][wip/t23472] 3 commits: Generate Addr# access ops programmatically Message-ID: <64817c69d9388_20885078934cc1706c0@gitlab.mail> Matthew Pickering pushed to branch wip/t23472 at Glasgow Haskell Compiler / GHC Commits: 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - e1800a7a by Matthew Pickering at 2023-06-08T07:59:31+01:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - 7 changed files: - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - hadrian/src/Rules/Documentation.hs - hadrian/src/Rules/Generate.hs - rts/gen_event_types.py Changes: ===================================== .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py ===================================== @@ -264,7 +264,7 @@ def setNightlyTags(ghcup_metadata): for version in ghcup_metadata['ghcupDownloads']['GHC']: if "LatestNightly" in ghcup_metadata['ghcupDownloads']['GHC'][version]["viTags"]: ghcup_metadata['ghcupDownloads']['GHC'][version]["viTags"].remove("LatestNightly") - ghcup_metadata['ghcupDownloads']['GHC'][version]["viTags"].append("Nightly") + ghcup_metadata['ghcupDownloads']['GHC'][version]["viTags"].append("Nightly") ===================================== compiler/GHC/Builtin/bytearray-ops.txt.pp deleted ===================================== @@ -1,551 +0,0 @@ - ------------------------------------- --- ByteArray# operations ------------------------------------- - - --- Do not edit. This file is generated by utils/genprimopcode/gen_bytearray_ops.py. --- To regenerate run, --- --- python3 utils/genprimops/gen_bytearray_ops.py > compiler/GHC/Builtin/bytearray-ops.txt.pp - - ------------------------------------- --- aligned index operations ------------------------------------- - -primop IndexByteArrayOp_Char "indexCharArray#" GenPrimOp - ByteArray# -> Int# -> Char# - {Read a 8-bit character; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_WideChar "indexWideCharArray#" GenPrimOp - ByteArray# -> Int# -> Char# - {Read a 32-bit character; offset in 4-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Int "indexIntArray#" GenPrimOp - ByteArray# -> Int# -> Int# - {Read a word-sized integer; offset in machine words.} - with can_fail = True - -primop IndexByteArrayOp_Word "indexWordArray#" GenPrimOp - ByteArray# -> Int# -> Word# - {Read a word-sized unsigned integer; offset in machine words.} - with can_fail = True - -primop IndexByteArrayOp_Addr "indexAddrArray#" GenPrimOp - ByteArray# -> Int# -> Addr# - {Read a machine address; offset in machine words.} - with can_fail = True - -primop IndexByteArrayOp_Float "indexFloatArray#" GenPrimOp - ByteArray# -> Int# -> Float# - {Read a single-precision floating-point value; offset in 4-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Double "indexDoubleArray#" GenPrimOp - ByteArray# -> Int# -> Double# - {Read a double-precision floating-point value; offset in 8-byte words.} - with can_fail = True - -primop IndexByteArrayOp_StablePtr "indexStablePtrArray#" GenPrimOp - ByteArray# -> Int# -> StablePtr# a - {Read a 'StablePtr#' value; offset in machine words.} - with can_fail = True - -primop IndexByteArrayOp_Int8 "indexInt8Array#" GenPrimOp - ByteArray# -> Int# -> Int8# - {Read a 8-bit signed integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Int16 "indexInt16Array#" GenPrimOp - ByteArray# -> Int# -> Int16# - {Read a 16-bit signed integer; offset in 2-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Int32 "indexInt32Array#" GenPrimOp - ByteArray# -> Int# -> Int32# - {Read a 32-bit signed integer; offset in 4-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Int64 "indexInt64Array#" GenPrimOp - ByteArray# -> Int# -> Int64# - {Read a 64-bit signed integer; offset in 8-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Word8 "indexWord8Array#" GenPrimOp - ByteArray# -> Int# -> Word8# - {Read a 8-bit unsigned integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word16 "indexWord16Array#" GenPrimOp - ByteArray# -> Int# -> Word16# - {Read a 16-bit unsigned integer; offset in 2-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Word32 "indexWord32Array#" GenPrimOp - ByteArray# -> Int# -> Word32# - {Read a 32-bit unsigned integer; offset in 4-byte words.} - with can_fail = True - -primop IndexByteArrayOp_Word64 "indexWord64Array#" GenPrimOp - ByteArray# -> Int# -> Word64# - {Read a 64-bit unsigned integer; offset in 8-byte words.} - with can_fail = True - - ------------------------------------- --- unaligned index operations ------------------------------------- - -primop IndexByteArrayOp_Word8AsChar "indexWord8ArrayAsChar#" GenPrimOp - ByteArray# -> Int# -> Char# - {Read a 8-bit character; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsWideChar "indexWord8ArrayAsWideChar#" GenPrimOp - ByteArray# -> Int# -> Char# - {Read a 32-bit character; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsInt "indexWord8ArrayAsInt#" GenPrimOp - ByteArray# -> Int# -> Int# - {Read a word-sized integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsWord "indexWord8ArrayAsWord#" GenPrimOp - ByteArray# -> Int# -> Word# - {Read a word-sized unsigned integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsAddr "indexWord8ArrayAsAddr#" GenPrimOp - ByteArray# -> Int# -> Addr# - {Read a machine address; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsFloat "indexWord8ArrayAsFloat#" GenPrimOp - ByteArray# -> Int# -> Float# - {Read a single-precision floating-point value; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsDouble "indexWord8ArrayAsDouble#" GenPrimOp - ByteArray# -> Int# -> Double# - {Read a double-precision floating-point value; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsStablePtr "indexWord8ArrayAsStablePtr#" GenPrimOp - ByteArray# -> Int# -> StablePtr# a - {Read a 'StablePtr#' value; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsInt16 "indexWord8ArrayAsInt16#" GenPrimOp - ByteArray# -> Int# -> Int16# - {Read a 16-bit signed integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsInt32 "indexWord8ArrayAsInt32#" GenPrimOp - ByteArray# -> Int# -> Int32# - {Read a 32-bit signed integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsInt64 "indexWord8ArrayAsInt64#" GenPrimOp - ByteArray# -> Int# -> Int64# - {Read a 64-bit signed integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsWord16 "indexWord8ArrayAsWord16#" GenPrimOp - ByteArray# -> Int# -> Word16# - {Read a 16-bit unsigned integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsWord32 "indexWord8ArrayAsWord32#" GenPrimOp - ByteArray# -> Int# -> Word32# - {Read a 32-bit unsigned integer; offset in bytes.} - with can_fail = True - -primop IndexByteArrayOp_Word8AsWord64 "indexWord8ArrayAsWord64#" GenPrimOp - ByteArray# -> Int# -> Word64# - {Read a 64-bit unsigned integer; offset in bytes.} - with can_fail = True - - ------------------------------------- --- aligned read operations ------------------------------------- - -primop ReadByteArrayOp_Char "readCharArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) - {Read a 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_WideChar "readWideCharArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) - {Read a 32-bit character; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int "readIntArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #) - {Read a word-sized integer; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word "readWordArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #) - {Read a word-sized unsigned integer; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Addr "readAddrArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Addr# #) - {Read a machine address; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Float "readFloatArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Float# #) - {Read a single-precision floating-point value; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Double "readDoubleArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Double# #) - {Read a double-precision floating-point value; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_StablePtr "readStablePtrArray#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, StablePtr# a #) - {Read a 'StablePtr#' value; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int8 "readInt8Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int8# #) - {Read a 8-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int16 "readInt16Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int16# #) - {Read a 16-bit signed integer; offset in 2-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int32 "readInt32Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int32# #) - {Read a 32-bit signed integer; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Int64 "readInt64Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int64# #) - {Read a 64-bit signed integer; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8 "readWord8Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word8# #) - {Read a 8-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word16 "readWord16Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word16# #) - {Read a 16-bit unsigned integer; offset in 2-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word32 "readWord32Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word32# #) - {Read a 32-bit unsigned integer; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word64 "readWord64Array#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word64# #) - {Read a 64-bit unsigned integer; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - - ------------------------------------- --- unaligned read operations ------------------------------------- - -primop ReadByteArrayOp_Word8AsChar "readWord8ArrayAsChar#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) - {Read a 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsWideChar "readWord8ArrayAsWideChar#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) - {Read a 32-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsInt "readWord8ArrayAsInt#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #) - {Read a word-sized integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsWord "readWord8ArrayAsWord#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #) - {Read a word-sized unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsAddr "readWord8ArrayAsAddr#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Addr# #) - {Read a machine address; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsFloat "readWord8ArrayAsFloat#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Float# #) - {Read a single-precision floating-point value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsDouble "readWord8ArrayAsDouble#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Double# #) - {Read a double-precision floating-point value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsStablePtr "readWord8ArrayAsStablePtr#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, StablePtr# a #) - {Read a 'StablePtr#' value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsInt16 "readWord8ArrayAsInt16#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int16# #) - {Read a 16-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsInt32 "readWord8ArrayAsInt32#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int32# #) - {Read a 32-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsInt64 "readWord8ArrayAsInt64#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Int64# #) - {Read a 64-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsWord16 "readWord8ArrayAsWord16#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word16# #) - {Read a 16-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsWord32 "readWord8ArrayAsWord32#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word32# #) - {Read a 32-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadByteArrayOp_Word8AsWord64 "readWord8ArrayAsWord64#" GenPrimOp - MutableByteArray# s -> Int# -> State# s -> (# State# s, Word64# #) - {Read a 64-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - - ------------------------------------- --- aligned write operations ------------------------------------- - -primop WriteByteArrayOp_Char "writeCharArray#" GenPrimOp - MutableByteArray# s -> Int# -> Char# -> State# s -> State# s - {Write a 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_WideChar "writeWideCharArray#" GenPrimOp - MutableByteArray# s -> Int# -> Char# -> State# s -> State# s - {Write a 32-bit character; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int "writeIntArray#" GenPrimOp - MutableByteArray# s -> Int# -> Int# -> State# s -> State# s - {Write a word-sized integer; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word "writeWordArray#" GenPrimOp - MutableByteArray# s -> Int# -> Word# -> State# s -> State# s - {Write a word-sized unsigned integer; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Addr "writeAddrArray#" GenPrimOp - MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s - {Write a machine address; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Float "writeFloatArray#" GenPrimOp - MutableByteArray# s -> Int# -> Float# -> State# s -> State# s - {Write a single-precision floating-point value; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Double "writeDoubleArray#" GenPrimOp - MutableByteArray# s -> Int# -> Double# -> State# s -> State# s - {Write a double-precision floating-point value; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_StablePtr "writeStablePtrArray#" GenPrimOp - MutableByteArray# s -> Int# -> StablePtr# a -> State# s -> State# s - {Write a 'StablePtr#' value; offset in machine words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int8 "writeInt8Array#" GenPrimOp - MutableByteArray# s -> Int# -> Int8# -> State# s -> State# s - {Write a 8-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int16 "writeInt16Array#" GenPrimOp - MutableByteArray# s -> Int# -> Int16# -> State# s -> State# s - {Write a 16-bit signed integer; offset in 2-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int32 "writeInt32Array#" GenPrimOp - MutableByteArray# s -> Int# -> Int32# -> State# s -> State# s - {Write a 32-bit signed integer; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Int64 "writeInt64Array#" GenPrimOp - MutableByteArray# s -> Int# -> Int64# -> State# s -> State# s - {Write a 64-bit signed integer; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8 "writeWord8Array#" GenPrimOp - MutableByteArray# s -> Int# -> Word8# -> State# s -> State# s - {Write a 8-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word16 "writeWord16Array#" GenPrimOp - MutableByteArray# s -> Int# -> Word16# -> State# s -> State# s - {Write a 16-bit unsigned integer; offset in 2-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word32 "writeWord32Array#" GenPrimOp - MutableByteArray# s -> Int# -> Word32# -> State# s -> State# s - {Write a 32-bit unsigned integer; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word64 "writeWord64Array#" GenPrimOp - MutableByteArray# s -> Int# -> Word64# -> State# s -> State# s - {Write a 64-bit unsigned integer; offset in 8-byte words.} - with has_side_effects = True - can_fail = True - - ------------------------------------- --- unaligned write operations ------------------------------------- - -primop WriteByteArrayOp_Word8AsChar "writeWord8ArrayAsChar#" GenPrimOp - MutableByteArray# s -> Int# -> Char# -> State# s -> State# s - {Write a 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsWideChar "writeWord8ArrayAsWideChar#" GenPrimOp - MutableByteArray# s -> Int# -> Char# -> State# s -> State# s - {Write a 32-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsInt "writeWord8ArrayAsInt#" GenPrimOp - MutableByteArray# s -> Int# -> Int# -> State# s -> State# s - {Write a word-sized integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsWord "writeWord8ArrayAsWord#" GenPrimOp - MutableByteArray# s -> Int# -> Word# -> State# s -> State# s - {Write a word-sized unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsAddr "writeWord8ArrayAsAddr#" GenPrimOp - MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s - {Write a machine address; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsFloat "writeWord8ArrayAsFloat#" GenPrimOp - MutableByteArray# s -> Int# -> Float# -> State# s -> State# s - {Write a single-precision floating-point value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsDouble "writeWord8ArrayAsDouble#" GenPrimOp - MutableByteArray# s -> Int# -> Double# -> State# s -> State# s - {Write a double-precision floating-point value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsStablePtr "writeWord8ArrayAsStablePtr#" GenPrimOp - MutableByteArray# s -> Int# -> StablePtr# a -> State# s -> State# s - {Write a 'StablePtr#' value; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsInt16 "writeWord8ArrayAsInt16#" GenPrimOp - MutableByteArray# s -> Int# -> Int16# -> State# s -> State# s - {Write a 16-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsInt32 "writeWord8ArrayAsInt32#" GenPrimOp - MutableByteArray# s -> Int# -> Int32# -> State# s -> State# s - {Write a 32-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsInt64 "writeWord8ArrayAsInt64#" GenPrimOp - MutableByteArray# s -> Int# -> Int64# -> State# s -> State# s - {Write a 64-bit signed integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsWord16 "writeWord8ArrayAsWord16#" GenPrimOp - MutableByteArray# s -> Int# -> Word16# -> State# s -> State# s - {Write a 16-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsWord32 "writeWord8ArrayAsWord32#" GenPrimOp - MutableByteArray# s -> Int# -> Word32# -> State# s -> State# s - {Write a 32-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop WriteByteArrayOp_Word8AsWord64 "writeWord8ArrayAsWord64#" GenPrimOp - MutableByteArray# s -> Int# -> Word64# -> State# s -> State# s - {Write a 64-bit unsigned integer; offset in bytes.} - with has_side_effects = True - can_fail = True - ===================================== utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py ===================================== @@ -1,8 +1,32 @@ #!/usr/bin/env python # -*- coding: utf-8 -*- +# This script generates the primop descriptions for many similar ByteArray# +# and Addr# access operations. Its output is #include-d into primops.txt.pp. + from typing import Optional, NamedTuple import textwrap +import argparse + +arg_parser = argparse.ArgumentParser() +arg_parser.add_argument('addr_or_bytearray', + choices = ["addr-access-ops", "bytearray-access-ops"], + ) +arg_parser.add_argument('output_file', + type=argparse.FileType('w'), + metavar='FILE', + ) +args = arg_parser.parse_args() +write = args.output_file.write + + + +write(''' +-- Do not edit. +-- This file is generated by compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py. +-- (The build system should take care of this for you.) + +''') class ElementType(NamedTuple): name: str @@ -28,26 +52,13 @@ element_types = [ ElementType("StablePtr", "StablePtr# a", "'StablePtr#' value", MACH_WORD), ] -# TODO: Eventually when the sized integer primops use proper unboxed types we -# should rather do: -# -#for n in [8,16,32,64]: -# element_types += [ ElementType(f"Int{n}", f"Int{n}#", f"{n}-bit signed integer", n // 8) ] -# -#for n in [8,16,32,64]: -# element_types += [ ElementType(f"Word{n}", f"Word{n}#", f"{n}-bit unsigned integer", n // 8) ] - -element_types += [ - ElementType("Int8", "Int8#", "8-bit signed integer", 1), - ElementType("Int16", "Int16#", "16-bit signed integer", 2), - ElementType("Int32", "Int32#", "32-bit signed integer", 4), - ElementType("Int64", "Int64#", "64-bit signed integer", 8), - - ElementType("Word8", "Word8#", "8-bit unsigned integer", 1), - ElementType("Word16", "Word16#", "16-bit unsigned integer", 2), - ElementType("Word32", "Word32#", "32-bit unsigned integer", 4), - ElementType("Word64", "Word64#", "64-bit unsigned integer", 8), -] +for n in [8,16,32,64]: + element_types += [ + ElementType(f"Int{n}", f"Int{n}#", + f"{n}-bit signed integer", n // 8), + ElementType(f"Word{n}", f"Word{n}#", + f"{n}-bit unsigned integer", n // 8) + ] def pretty_offset(n: Optional[int]) -> str: if n == MACH_WORD: @@ -57,87 +68,134 @@ def pretty_offset(n: Optional[int]) -> str: else: return f'{n}-byte words' +def get_align_warn(n: ElementType) -> str: + if n.width == 1: + return '' + return ''' + On some platforms, the access may fail + for an insufficiently aligned @Addr#@. + ''' + def print_block(template: str, **kwargs) -> None: - print(textwrap.dedent(template.format(**kwargs)).lstrip()) + write(textwrap.dedent(template.format(**kwargs)).lstrip()) + write('\n') def header(s: str): - print('') + write('\n') print_block(''' ------------------------------------ -- {s} ------------------------------------ ''', s=s) +if args.addr_or_bytearray == "bytearray-access-ops": + header("ByteArray# operations") -header("ByteArray# operations") - -print(''' --- Do not edit. This file is generated by utils/genprimopcode/gen_bytearray_ops.py. --- To regenerate run, --- --- python3 utils/genprimops/gen_bytearray_ops.py > compiler/GHC/Builtin/bytearray-ops.txt.pp -''') - -header('aligned index operations') -for t in element_types: - offset = pretty_offset(t.width) - print_block(''' + header('aligned index operations') + for t in element_types: + offset = pretty_offset(t.width) + print_block(''' primop IndexByteArrayOp_{name} "index{name}Array#" GenPrimOp ByteArray# -> Int# -> {rep_ty} {{Read a {desc}; offset in {offset}.}} with can_fail = True - ''', offset = offset, **t._asdict()) + ''', offset = offset, **t._asdict()) -header('unaligned index operations') -for t in element_types: - if t.name in ['Int8', 'Word8']: continue - print_block(''' + header('unaligned index operations') + for t in element_types: + if t.name in ['Int8', 'Word8']: continue + print_block(''' primop IndexByteArrayOp_Word8As{name} "indexWord8ArrayAs{name}#" GenPrimOp ByteArray# -> Int# -> {rep_ty} {{Read a {desc}; offset in bytes.}} with can_fail = True - ''', **t._asdict()) + ''', **t._asdict()) -header('aligned read operations') -for t in element_types: - offset = pretty_offset(t.width) - print_block(''' + header('aligned read operations') + for t in element_types: + offset = pretty_offset(t.width) + print_block(''' primop ReadByteArrayOp_{name} "read{name}Array#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> (# State# s, {rep_ty} #) {{Read a {desc}; offset in {offset}.}} with has_side_effects = True can_fail = True - ''', offset = offset, **t._asdict()) + ''', offset = offset, **t._asdict()) -header('unaligned read operations') -for t in element_types: - if t.name in ['Int8', 'Word8']: continue - print_block(''' + header('unaligned read operations') + for t in element_types: + if t.name in ['Int8', 'Word8']: continue + print_block(''' primop ReadByteArrayOp_Word8As{name} "readWord8ArrayAs{name}#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> (# State# s, {rep_ty} #) {{Read a {desc}; offset in bytes.}} with has_side_effects = True can_fail = True - ''', **t._asdict()) + ''', **t._asdict()) -header('aligned write operations') -for t in element_types: - offset = pretty_offset(t.width) - print_block(''' + header('aligned write operations') + for t in element_types: + offset = pretty_offset(t.width) + print_block(''' primop WriteByteArrayOp_{name} "write{name}Array#" GenPrimOp MutableByteArray# s -> Int# -> {rep_ty} -> State# s -> State# s {{Write a {desc}; offset in {offset}.}} with has_side_effects = True can_fail = True - ''', offset = offset, **t._asdict()) + ''', offset = offset, **t._asdict()) -header('unaligned write operations') -for t in element_types: - if t.name in ['Int8', 'Word8']: continue - print_block(''' + header('unaligned write operations') + for t in element_types: + if t.name in ['Int8', 'Word8']: continue + print_block(''' primop WriteByteArrayOp_Word8As{name} "writeWord8ArrayAs{name}#" GenPrimOp MutableByteArray# s -> Int# -> {rep_ty} -> State# s -> State# s {{Write a {desc}; offset in bytes.}} with has_side_effects = True can_fail = True - ''', **t._asdict()) + ''', **t._asdict()) + + +else: # addr_or_bytearray == "addr-access-ops": + header("Addr# access operations") + + header('aligned index operations') + for t in element_types: + offset = pretty_offset(t.width) + align_warn = get_align_warn(t) + print_block(''' + primop IndexOffAddrOp_{name} "index{name}OffAddr#" GenPrimOp + Addr# -> Int# -> {rep_ty} + {{ Read a {desc}; offset in {offset}. + {align_warn} + }} + with can_fail = True + ''', offset = offset, align_warn = align_warn, **t._asdict()) + + header('aligned read operations') + for t in element_types: + offset = pretty_offset(t.width) + align_warn = get_align_warn(t) + print_block(''' + primop ReadOffAddrOp_{name} "read{name}OffAddr#" GenPrimOp + Addr# -> Int# -> State# s -> (# State# s, {rep_ty} #) + {{ Read a {desc}; offset in {offset}. + {align_warn} + }} + with has_side_effects = True + can_fail = True + ''', offset = offset, align_warn = align_warn, **t._asdict()) + + header('aligned write operations') + for t in element_types: + offset = pretty_offset(t.width) + align_warn = get_align_warn(t) + print_block(''' + primop WriteOffAddrOp_{name} "write{name}OffAddr#" GenPrimOp + Addr# -> Int# -> {rep_ty} -> State# s -> State# s + {{ Write a {desc}; offset in {offset}. + {align_warn} + }} + with has_side_effects = True + can_fail = True + ''', offset = offset, align_warn = align_warn, **t._asdict()) ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -1941,7 +1941,7 @@ primop GetSizeofMutableByteArrayOp "getSizeofMutableByteArray#" GenPrimOp @since 0.5.0.0} -#include "bytearray-ops.txt.pp" +#include "bytearray-access-ops.txt.pp" primop CompareByteArraysOp "compareByteArrays#" GenPrimOp ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int# @@ -2242,233 +2242,7 @@ primop AddrNeOp "neAddr#" Compare Addr# -> Addr# -> Int# primop AddrLtOp "ltAddr#" Compare Addr# -> Addr# -> Int# primop AddrLeOp "leAddr#" Compare Addr# -> Addr# -> Int# -primop IndexOffAddrOp_Char "indexCharOffAddr#" GenPrimOp - Addr# -> Int# -> Char# - {Reads 8-bit character; offset in bytes.} - with can_fail = True - -primop IndexOffAddrOp_WideChar "indexWideCharOffAddr#" GenPrimOp - Addr# -> Int# -> Char# - {Reads 31-bit character; offset in 4-byte words.} - with can_fail = True - -primop IndexOffAddrOp_Int "indexIntOffAddr#" GenPrimOp - Addr# -> Int# -> Int# - with can_fail = True - -primop IndexOffAddrOp_Word "indexWordOffAddr#" GenPrimOp - Addr# -> Int# -> Word# - with can_fail = True - -primop IndexOffAddrOp_Addr "indexAddrOffAddr#" GenPrimOp - Addr# -> Int# -> Addr# - with can_fail = True - -primop IndexOffAddrOp_Float "indexFloatOffAddr#" GenPrimOp - Addr# -> Int# -> Float# - with can_fail = True - -primop IndexOffAddrOp_Double "indexDoubleOffAddr#" GenPrimOp - Addr# -> Int# -> Double# - with can_fail = True - -primop IndexOffAddrOp_StablePtr "indexStablePtrOffAddr#" GenPrimOp - Addr# -> Int# -> StablePtr# a - with can_fail = True - -primop IndexOffAddrOp_Int8 "indexInt8OffAddr#" GenPrimOp - Addr# -> Int# -> Int8# - with can_fail = True - -primop IndexOffAddrOp_Int16 "indexInt16OffAddr#" GenPrimOp - Addr# -> Int# -> Int16# - with can_fail = True - -primop IndexOffAddrOp_Int32 "indexInt32OffAddr#" GenPrimOp - Addr# -> Int# -> Int32# - with can_fail = True - -primop IndexOffAddrOp_Int64 "indexInt64OffAddr#" GenPrimOp - Addr# -> Int# -> Int64# - with can_fail = True - -primop IndexOffAddrOp_Word8 "indexWord8OffAddr#" GenPrimOp - Addr# -> Int# -> Word8# - with can_fail = True - -primop IndexOffAddrOp_Word16 "indexWord16OffAddr#" GenPrimOp - Addr# -> Int# -> Word16# - with can_fail = True - -primop IndexOffAddrOp_Word32 "indexWord32OffAddr#" GenPrimOp - Addr# -> Int# -> Word32# - with can_fail = True - -primop IndexOffAddrOp_Word64 "indexWord64OffAddr#" GenPrimOp - Addr# -> Int# -> Word64# - with can_fail = True - -primop ReadOffAddrOp_Char "readCharOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Char# #) - {Reads 8-bit character; offset in bytes.} - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_WideChar "readWideCharOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Char# #) - {Reads 31-bit character; offset in 4-byte words.} - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int "readIntOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word "readWordOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Addr "readAddrOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Addr# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Float "readFloatOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Float# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Double "readDoubleOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Double# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_StablePtr "readStablePtrOffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, StablePtr# a #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int8 "readInt8OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int8# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int16 "readInt16OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int16# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int32 "readInt32OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int32# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Int64 "readInt64OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Int64# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word8 "readWord8OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word8# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word16 "readWord16OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word16# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word32 "readWord32OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word32# #) - with has_side_effects = True - can_fail = True - -primop ReadOffAddrOp_Word64 "readWord64OffAddr#" GenPrimOp - Addr# -> Int# -> State# s -> (# State# s, Word64# #) - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Char "writeCharOffAddr#" GenPrimOp - Addr# -> Int# -> Char# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_WideChar "writeWideCharOffAddr#" GenPrimOp - Addr# -> Int# -> Char# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int "writeIntOffAddr#" GenPrimOp - Addr# -> Int# -> Int# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word "writeWordOffAddr#" GenPrimOp - Addr# -> Int# -> Word# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Addr "writeAddrOffAddr#" GenPrimOp - Addr# -> Int# -> Addr# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Float "writeFloatOffAddr#" GenPrimOp - Addr# -> Int# -> Float# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Double "writeDoubleOffAddr#" GenPrimOp - Addr# -> Int# -> Double# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_StablePtr "writeStablePtrOffAddr#" GenPrimOp - Addr# -> Int# -> StablePtr# a -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int8 "writeInt8OffAddr#" GenPrimOp - Addr# -> Int# -> Int8# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int16 "writeInt16OffAddr#" GenPrimOp - Addr# -> Int# -> Int16# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int32 "writeInt32OffAddr#" GenPrimOp - Addr# -> Int# -> Int32# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Int64 "writeInt64OffAddr#" GenPrimOp - Addr# -> Int# -> Int64# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word8 "writeWord8OffAddr#" GenPrimOp - Addr# -> Int# -> Word8# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word16 "writeWord16OffAddr#" GenPrimOp - Addr# -> Int# -> Word16# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word32 "writeWord32OffAddr#" GenPrimOp - Addr# -> Int# -> Word32# -> State# s -> State# s - with has_side_effects = True - can_fail = True - -primop WriteOffAddrOp_Word64 "writeWord64OffAddr#" GenPrimOp - Addr# -> Int# -> Word64# -> State# s -> State# s - with has_side_effects = True - can_fail = True +#include "addr-access-ops.txt.pp" primop InterlockedExchange_Addr "atomicExchangeAddrAddr#" GenPrimOp Addr# -> Addr# -> State# s -> (# State# s, Addr# #) ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -258,6 +258,15 @@ buildPackageDocumentation = do need [ takeDirectory file -/- "haddock-prologue.txt"] haddocks <- haddockDependencies context + -- Build Haddock documentation + -- TODO: Pass the correct way from Rules via Context. + dynamicPrograms <- dynamicGhcPrograms =<< flavour + let haddockWay = if dynamicPrograms then dynamic else vanilla + + -- Build the dependencies of the package we are going to build documentation for + dep_pkgs <- sequence [pkgConfFile (context { way = haddockWay, Context.package = p}) + | (p, _) <- haddocks] + -- `ghc-prim` has a source file for 'GHC.Prim' which is generated just -- for Haddock. We need to 'union' (instead of '++') to avoid passing -- 'GHC.PrimopWrappers' (which unfortunately shows up in both @@ -266,12 +275,8 @@ buildPackageDocumentation = do vanillaSrcs <- hsSources context let srcs = vanillaSrcs `union` generatedSrcs - need $ srcs ++ (map snd haddocks) + need $ srcs ++ (map snd haddocks) ++ dep_pkgs - -- Build Haddock documentation - -- TODO: Pass the correct way from Rules via Context. - dynamicPrograms <- dynamicGhcPrograms =<< flavour - let haddockWay = if dynamicPrograms then dynamic else vanilla statsFilesDir <- haddockStatsFilesDir createDirectory statsFilesDir build $ target (context {way = haddockWay}) (Haddock BuildPackage) srcs [file] ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -32,6 +32,17 @@ primopsSource = "compiler/GHC/Builtin/primops.txt.pp" primopsTxt :: Stage -> FilePath primopsTxt stage = buildDir (vanillaContext stage compiler) -/- "primops.txt" +accessOpsSource :: FilePath +accessOpsSource = "compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py" + +byteArrayAccessOpsTxt :: Stage -> FilePath +byteArrayAccessOpsTxt stage + = buildDir (vanillaContext stage compiler) -/- "bytearray-access-ops.txt.pp" + +addrAccessOpsTxt :: Stage -> FilePath +addrAccessOpsTxt stage + = buildDir (vanillaContext stage compiler) -/- "addr-access-ops.txt.pp" + isGeneratedCmmFile :: FilePath -> Bool isGeneratedCmmFile file = takeBaseName file == "AutoApply" @@ -142,8 +153,21 @@ generatePackageCode context@(Context stage pkg _ _) = do root -/- "**" -/- dir -/- "GHC/Platform/Host.hs" %> go generatePlatformHostHs when (pkg == compiler) $ do + let ba_ops_txt = root -/- byteArrayAccessOpsTxt stage + let addr_ops_txt = root -/- addrAccessOpsTxt stage + ba_ops_txt %> \file -> do + need [accessOpsSource] + runBuilder Python + [accessOpsSource, "bytearray-access-ops", file] + [] [] + addr_ops_txt %> \file -> do + need [accessOpsSource] + runBuilder Python + [accessOpsSource, "addr-access-ops", file] + [] [] root -/- primopsTxt stage %> \file -> do - need $ [primopsSource] + need $ [primopsSource, ba_ops_txt, addr_ops_txt] + -- ba_ops_txt and addr_ops_txt get #include-d build $ target context HsCpp [primopsSource] [file] when (pkg == rts) $ do ===================================== rts/gen_event_types.py ===================================== @@ -157,7 +157,7 @@ def generate_event_types_array() -> str: pr = lambda s: x.append(s) pr('/*') - pr(' * Do not edit: This file is generated by event_types.py') + pr(' * Do not edit: This file is generated by gen_event_types.py') pr(' */') pr('') pr('EventType eventTypes[] = {') @@ -184,7 +184,7 @@ def generate_event_types_defines() -> str: pr = lambda s: x.append(s) pr('/*') - pr(' * Do not edit: This file is generated by event_types.py') + pr(' * Do not edit: This file is generated by gen_event_types.py') pr(' */') pr('') pr('#pragma once') View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/03a1ebb19bcf5ef304b36c3e5da654235986a19a...e1800a7a546b8ae8e08c923c9ab8f64f1431012b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/03a1ebb19bcf5ef304b36c3e5da654235986a19a...e1800a7a546b8ae8e08c923c9ab8f64f1431012b You're receiving 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 Jun 8 07:52:38 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 08 Jun 2023 03:52:38 -0400 Subject: [Git][ghc/ghc][wip/T23323] 15 commits: Invisible binders in type declarations (#22560) Message-ID: <648188c61ec50_208850820a53c1819cc@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23323 at Glasgow Haskell Compiler / GHC Commits: 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - CODEOWNERS - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Quote.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/StgToCmm/InfoTableProv.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Solve.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Zonk/TcType.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/Language/Haskell/Syntax/Type.hs - compiler/ghc.cabal.in The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/57f474976329626987b191b8bef5375df7df1fdb...2b0c9f5ef026df6dd2637aacce05a11d74146296 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/57f474976329626987b191b8bef5375df7df1fdb...2b0c9f5ef026df6dd2637aacce05a11d74146296 You're receiving 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 Jun 8 07:54:54 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 08 Jun 2023 03:54:54 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/fix-cabal-file Message-ID: <6481894ea9e8a_208850766c78418627@gitlab.mail> Matthew Pickering pushed new branch wip/fix-cabal-file at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fix-cabal-file You're receiving 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 Jun 8 08:20:57 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Thu, 08 Jun 2023 04:20:57 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/modern-STV-add-warning] Adding -Wpattern-signature-binds (#23291) Message-ID: <64818f696d33d_226212c46e497bb@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/modern-STV-add-warning at Glasgow Haskell Compiler / GHC Commits: ef6806b5 by Andrei Borzenkov at 2023-06-08T12:20:41+04:00 Adding -Wpattern-signature-binds (#23291) Was introduced one new warning option: -Wpattern-signature-binds It warns when pattern signature binds into scope new type variable. For example: f (a :: t) = ... - - - - - 13 changed files: - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/using-warnings.rst - + testsuite/tests/rename/should_fail/WPatternSigBinds.hs - + testsuite/tests/rename/should_fail/WPatternSigBinds.stderr - testsuite/tests/rename/should_fail/all.T Changes: ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -640,6 +640,7 @@ data WarningFlag = | Opt_WarnLoopySuperclassSolve -- Since 9.6 | Opt_WarnTermVariableCapture -- Since 9.8 | Opt_WarnMissingRoleAnnotations -- Since 9.8 + | Opt_WarnPatternSignatureBinds -- Since 9.8 deriving (Eq, Ord, Show, Enum) -- | Return the names of a WarningFlag @@ -747,6 +748,7 @@ warnFlagNames wflag = case wflag of Opt_WarnLoopySuperclassSolve -> "loopy-superclass-solve" :| [] Opt_WarnTypeEqualityRequiresOperators -> "type-equality-requires-operators" :| [] Opt_WarnMissingRoleAnnotations -> "missing-role-annotations" :| [] + Opt_WarnPatternSignatureBinds -> "pattern-signature-binds" :| [] -- ----------------------------------------------------------------------------- -- Standard sets of warning options ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2257,7 +2257,8 @@ wWarningFlagsDeps = mconcat [ warnSpec Opt_WarnTypeEqualityOutOfScope, warnSpec Opt_WarnTypeEqualityRequiresOperators, warnSpec Opt_WarnTermVariableCapture, - warnSpec Opt_WarnMissingRoleAnnotations + warnSpec Opt_WarnMissingRoleAnnotations, + warnSpec Opt_WarnPatternSignatureBinds ] warningGroupsDeps :: [(Deprecation, FlagSpec WarningGroup)] ===================================== compiler/GHC/Rename/Bind.hs ===================================== @@ -519,7 +519,7 @@ rnBind sig_fn bind@(FunBind { fun_id = name -- invariant: no free vars here when it's a FunBind = do { let plain_name = unLoc name - ; (matches', rhs_fvs) <- bindSigTyVarsFVExtended (sig_fn plain_name) $ + ; (matches', rhs_fvs) <- bindSigTyVarsFV (sig_fn plain_name) $ -- bindSigTyVars tests for LangExt.ScopedTyVars rnMatchGroup (mkPrefixFunRhs name) rnLExpr matches @@ -726,7 +726,7 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name ; unless pattern_synonym_ok (addErr TcRnIllegalPatternSynonymDecl) ; let scoped_tvs = sig_fn name - ; ((pat', details'), fvs1) <- bindSigTyVarsFVExtended scoped_tvs $ + ; ((pat', details'), fvs1) <- bindSigTyVarsFV scoped_tvs $ rnPat PatSyn pat $ \pat' -> -- We check the 'RdrName's instead of the 'Name's -- so that the binding locations are reported @@ -763,7 +763,7 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name Unidirectional -> return (Unidirectional, emptyFVs) ImplicitBidirectional -> return (ImplicitBidirectional, emptyFVs) ExplicitBidirectional mg -> - do { (mg', fvs) <- bindSigTyVarsFVExtended scoped_tvs $ + do { (mg', fvs) <- bindSigTyVarsFV scoped_tvs $ rnMatchGroup (mkPrefixFunRhs (L l name)) rnLExpr mg ; return (ExplicitBidirectional mg', fvs) } ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -523,7 +523,7 @@ rnExpr (HsRecSel x _) = dataConCantHappen x rnExpr (ExprWithTySig _ expr pty) = do { (pty', fvTy) <- rnHsSigWcType ExprWithTySigCtx pty - ; (expr', fvExpr) <- bindSigTyVarsFVExtended (hsWcScopedTvs pty') $ + ; (expr', fvExpr) <- bindSigTyVarsFV (hsWcScopedTvs pty') $ rnLExpr expr ; return (ExprWithTySig noExtField expr' pty', fvExpr `plusFV` fvTy) } ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -173,6 +173,10 @@ rnHsPatSigType scoping ctx sig_ty thing_inside then tv_rdrs else [] NeverBind -> [] + ; let i_bndrs = nubN implicit_bndrs in + unless (null i_bndrs) $ + forM_ i_bndrs $ \i_bndr -> + addDiagnosticAt (locA $ getLoc i_bndr) (TcRnPatternSignatureBinds i_bndr) ; rnImplicitTvOccs Nothing implicit_bndrs $ \ imp_tvs -> do { (nwcs, pat_sig_ty', fvs1) <- rnWcBody ctx nwc_rdrs pat_sig_ty ; let sig_names = HsPSRn { hsps_nwcs = nwcs, hsps_imp_tvs = imp_tvs } ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1848,6 +1848,11 @@ instance Diagnostic TcRnMessage where , text "Either a standalone kind signature (SAKS)" , text "or a complete user-supplied kind (CUSK, legacy feature)" , text "is required to use invisible binders." ] + + TcRnPatternSignatureBinds fvar -> mkSimpleDecorated $ + sep [text "Type variable binding" + , text "in pattern signature:" <+> quotes (ppr fvar) + ] diagnosticReason = \case TcRnUnknownMessage m @@ -2465,6 +2470,8 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnInvisBndrWithoutSig{} -> ErrorWithoutFlag + TcRnPatternSignatureBinds{} + -> WarningWithFlag Opt_WarnPatternSignatureBinds diagnosticHints = \case TcRnUnknownMessage m @@ -3128,6 +3135,8 @@ instance Diagnostic TcRnMessage where -> noHints TcRnInvisBndrWithoutSig name _ -> [SuggestAddStandaloneKindSignature name] + TcRnPatternSignatureBinds{} + -> noHints diagnosticCode :: TcRnMessage -> Maybe DiagnosticCode diagnosticCode = constructorCode ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -4094,6 +4094,18 @@ data TcRnMessage where -} TcRnMissingRoleAnnotation :: Name -> [Role] -> TcRnMessage + {-| TcRnPatternSignatureBinds is a warning thrown when a user binds + type variables in a pattern signature. This is only performed with + -Wpattern-signature-binds + + Example(s): + + id (x :: b) = x + + Test case: rename/should_fail/WPatternSigBinds + -} + TcRnPatternSignatureBinds :: LocatedN RdrName -> TcRnMessage + deriving Generic ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -591,6 +591,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnArityMismatch" = 27346 GhcDiagnosticCode "TcRnSimplifiableConstraint" = 62412 GhcDiagnosticCode "TcRnIllegalQuasiQuotes" = 77343 + GhcDiagnosticCode "TcRnPatternSignatureBinds" = 65467 -- TcRnTypeApplicationsDisabled GhcDiagnosticCode "TypeApplication" = 23482 ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -30,6 +30,9 @@ Compiler - Added a new warning :ghc-flag:`-Wterm-variable-capture` that helps to make code compatible with the future extension ``RequiredTypeArguments``. +- Added a new warning :ghc-flag:`-Wpattern-signature-binds` which alerts the user when they bind + a new type variable in a pattern signature. + - Rewrite rules now support a limited form of higher order matching when a pattern variable is applied to distinct locally bound variables. For example: :: ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -2415,6 +2415,28 @@ of ``-W(no-)*``. In other words the type-class role cannot be accidentally left representational or phantom, which could affected the code correctness. +.. ghc-flag:: -Wpattern-signature-binds + :shortdesc: warn when a pattern signature binds new type variables + :type: dynamic + + :since: 9.8.1 + + Added in accordance with `GHC Proposal #448 + `__. + + Type variable bindings in pattern signatures violate the Lexical Scoping Principle: depending + on the context, type variables in pattern signatures can be either occurrences or bindings. + + For example: :: + + f (x :: a) = ... -- binding of ‘a’ + + g :: forall a . ... + g (x :: a) = ... -- occurrence of ‘a’ + + When :ghc-flag:`-Wpattern-signature-binds` is enabled, GHC warns about type variable bindings + in pattern signatures. + If you're feeling really paranoid, the :ghc-flag:`-dcore-lint` option is a good choice. It turns on heavyweight intra-pass sanity-checking within GHC. (It checks GHC's ===================================== testsuite/tests/rename/should_fail/WPatternSigBinds.hs ===================================== @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -Wpattern-signature-binds -Werror #-} +module WPatternSigBinds where + +f (x :: a) = x + +g (x :: a) (y :: b) = x + +h (x :: a) (y :: b c d) = x + +i :: forall f a . f a -> f a +i (x :: b c) = x ===================================== testsuite/tests/rename/should_fail/WPatternSigBinds.stderr ===================================== @@ -0,0 +1,27 @@ + +WPatternSigBinds.hs:4:9: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds] + Type variable binding in pattern signature: ‘a’ + +WPatternSigBinds.hs:6:9: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds] + Type variable binding in pattern signature: ‘a’ + +WPatternSigBinds.hs:6:18: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds] + Type variable binding in pattern signature: ‘b’ + +WPatternSigBinds.hs:8:9: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds] + Type variable binding in pattern signature: ‘a’ + +WPatternSigBinds.hs:8:18: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds] + Type variable binding in pattern signature: ‘b’ + +WPatternSigBinds.hs:8:20: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds] + Type variable binding in pattern signature: ‘c’ + +WPatternSigBinds.hs:8:22: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds] + Type variable binding in pattern signature: ‘d’ + +WPatternSigBinds.hs:11:9: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds] + Type variable binding in pattern signature: ‘b’ + +WPatternSigBinds.hs:11:11: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds] + Type variable binding in pattern signature: ‘c’ ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -198,3 +198,4 @@ test('RnUnexpectedStandaloneDeriving', normal, compile_fail, ['']) test('RnStupidThetaInGadt', normal, compile_fail, ['']) test('PackageImportsDisabled', normal, compile_fail, ['']) test('ImportLookupIllegal', normal, compile_fail, ['']) +test('WPatternSigBinds', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ef6806b5dd867c40bffd0631dca5da178f14f1f4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ef6806b5dd867c40bffd0631dca5da178f14f1f4 You're receiving 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 Jun 8 09:29:15 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Thu, 08 Jun 2023 05:29:15 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/#16635-improve-errors] Capture scoped kind variables at type-checking phase (#16635) Message-ID: <64819f6b9a415_226212c46a829876@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/#16635-improve-errors at Glasgow Haskell Compiler / GHC Commits: c4232c36 by Andrei Borzenkov at 2023-06-08T13:29:01+04:00 Capture scoped kind variables at type-checking phase (#16635) Like descibed in new Note [A scoping errors during type check] in GHC.Tc.Types, I made ScopedTypeVariables work on type level like in term level. For now that only means, that the error about kind variables scoped into type are rejected at the elaboration time, because we can't generalize the type by adding type-level lambda - we simply have no one. - - - - - 14 changed files: - compiler/GHC/Hs/Type.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/Splice.hs - compiler/GHC/Tc/Types/BasicTypes.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Types/Error/Codes.hs - + testsuite/tests/rename/should_fail/T16635a.hs - + testsuite/tests/rename/should_fail/T16635a.stderr - + testsuite/tests/rename/should_fail/T16635b.hs - + testsuite/tests/rename/should_fail/T16635b.stderr - testsuite/tests/rename/should_fail/all.T Changes: ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -73,7 +73,7 @@ module GHC.Hs.Type ( mkHsForAllVisTele, mkHsForAllInvisTele, mkHsQTvs, hsQTvExplicit, emptyLHsQTvs, isHsKindedTyVar, hsTvbAllKinded, - hsScopedTvs, hsWcScopedTvs, dropWildCards, + hsScopedTvs, hsScopedKiVs, hsWcScopedTvs, dropWildCards, hsTyVarName, hsAllLTyVarNames, hsLTyVarLocNames, hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsExplicitLTyVarNames, splitLHsInstDeclTy, getLHsInstDeclHead, getLHsInstDeclClass_maybe, @@ -431,6 +431,14 @@ hsScopedTvs (L _ (HsSig{sig_bndrs = outer_bndrs})) = hsLTyVarNames (hsOuterExplicitBndrs outer_bndrs) -- See Note [hsScopedTvs and visible foralls] +hsScopedKiVs :: LHsKind GhcRn -> [Name] +-- here we should fuse two actions, performed for +-- type signatures, but not for kind ones: `hsTypeToHsSigType` +-- (but in GhcRn phase) and `hsScopedTvs` +hsScopedKiVs (L _ HsForAllTy { hst_tele = HsForAllInvis { hsf_invis_bndrs = bndrs }}) + = hsLTyVarNames bndrs +hsScopedKiVs _ = [] + --------------------- hsTyVarName :: HsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p) hsTyVarName (UserTyVar _ _ (L _ n)) = n ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -647,8 +647,9 @@ rnHsTyKi env listTy@(HsListTy x ty) rnHsTyKi env (HsKindSig x ty k) = do { kind_sigs_ok <- xoptM LangExt.KindSignatures ; unless kind_sigs_ok (badKindSigErr (rtke_ctxt env) ty) - ; (ty', lhs_fvs) <- rnLHsTyKi env ty ; (k', sig_fvs) <- rnLHsTyKi (env { rtke_level = KindLevel }) k + ; (ty', lhs_fvs) <- bindSigTyVarsFV (hsScopedKiVs k') + (rnLHsTyKi env ty) ; return (HsKindSig x ty' k', lhs_fvs `plusFV` sig_fvs) } -- Unboxed tuples are allowed to have poly-typed arguments. These @@ -1937,8 +1938,7 @@ extract_lty (L _ ty) acc HsExplicitTupleTy _ tys -> extract_ltys tys acc HsTyLit _ _ -> acc HsStarTy _ _ -> acc - HsKindSig _ ty ki -> extract_lty ty $ - extract_lty ki acc + HsKindSig _ ty ki -> extract_kind_sig ty ki acc HsForAllTy { hst_tele = tele, hst_body = ty } -> extract_hs_for_all_telescope tele acc $ extract_lty ty [] @@ -1949,6 +1949,17 @@ extract_lty (L _ ty) acc -- We deal with these separately in rnLHsTypeWithWildCards HsWildCardTy {} -> acc +extract_kind_sig :: LHsType GhcPs -- type + -> LHsType GhcPs -- kind + -> FreeKiTyVars -> FreeKiTyVars +extract_kind_sig + ty + (L _ HsForAllTy { hst_tele = HsForAllInvis { hsf_invis_bndrs = bndrs }, hst_body = ki_body }) + acc + = extract_hs_tv_bndrs bndrs acc (extract_lty ty $ extract_lty ki_body []) +extract_kind_sig ty ki acc = extract_lty ty $ + extract_lty ki acc + extract_lhs_sig_ty :: LHsSigType GhcPs -> FreeKiTyVars extract_lhs_sig_ty (L _ (HsSig{sig_bndrs = outer_bndrs, sig_body = body})) = extractHsOuterTvBndrs outer_bndrs $ extract_lty body [] ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1826,6 +1826,11 @@ instance Diagnostic TcRnMessage where TcRnIllegalQuasiQuotes -> mkSimpleDecorated $ text "Quasi-quotes are not permitted without QuasiQuotes" TcRnTHError err -> pprTHError err + TcRnAScopingError where_ty tv_name -> mkSimpleDecorated $ + vcat + [ text "Cannot generalise type" <+> ppr where_ty + , text "to /\\" <+> ppr tv_name <+> text "->" <+> ppr where_ty + ] TcRnIllegalInvisTyVarBndr bndr -> mkSimpleDecorated $ @@ -2467,6 +2472,8 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnInvisBndrWithoutSig{} -> ErrorWithoutFlag + TcRnAScopingError{} + -> ErrorWithoutFlag diagnosticHints = \case TcRnUnknownMessage m @@ -3130,6 +3137,8 @@ instance Diagnostic TcRnMessage where -> noHints TcRnInvisBndrWithoutSig name _ -> [SuggestAddStandaloneKindSignature name] + TcRnAScopingError{} + -> noHints diagnosticCode :: TcRnMessage -> Maybe DiagnosticCode diagnosticCode = constructorCode ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -4094,6 +4094,24 @@ data TcRnMessage where -} TcRnMissingRoleAnnotation :: Name -> [Role] -> TcRnMessage + {-| TcRnAScopingError is an error that occurs when type mentions + kind variables bringed by the forall of kind signature. + For more information see Note [Scoping errors during type check] in GHC.Tc.Types.BasicTypes + + Example: + + type F = '[Left @a :: forall a. a -> Either a ()] + -- ^ rejected + + Test cases: + T16635a + T16635b + -} + TcRnAScopingError + :: LHsType GhcRn -- where + -> Name -- what + -> TcRnMessage + deriving Generic ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -1042,7 +1042,8 @@ tc_infer_hs_type mode (HsKindSig _ ty sig) -- things like instantiate its foralls, so it needs -- to be fully determined (#14904) ; traceTc "tc_infer_hs_type:sig" (ppr ty $$ ppr sig') - ; ty' <- tc_lhs_type mode ty sig' + ; ty' <- tcAddKindSigPlaceholders sig ty $ + tc_lhs_type mode ty sig' ; return (ty', sig') } -- HsSpliced is an annotation produced by 'GHC.Rename.Splice.rnSpliceType' to communicate @@ -1994,6 +1995,8 @@ tcTyVar name -- Could be a tyvar, a tycon, or a datacon APromotionErr err -> promotionErr name err + AScopingError ty -> failWithTc (TcRnAScopingError ty name) + _ -> wrongThingErr WrongThingType thing name } {- ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -2830,6 +2830,7 @@ reifyTypeOfThing th_name = do AGlobal (ACoAxiom _) -> panic "reifyTypeOfThing: ACoAxiom" ATcTyCon _ -> panic "reifyTypeOfThing: ATcTyCon" APromotionErr _ -> panic "reifyTypeOfThing: APromotionErr" + AScopingError{} -> panic "reifyTypeOfThing: AScopingError" ------------------------------ lookupThAnnLookup :: TH.AnnLookup -> TcM CoreAnnTarget ===================================== compiler/GHC/Tc/Types/BasicTypes.hs ===================================== @@ -39,7 +39,7 @@ import GHC.Tc.Utils.TcType import GHC.Hs.Extension ( GhcRn ) -import Language.Haskell.Syntax.Type ( LHsSigWcType ) +import Language.Haskell.Syntax.Type ( LHsSigWcType, LHsType ) import GHC.Tc.Errors.Types.PromotionErr (PromotionErr, peCategory) @@ -298,6 +298,10 @@ data TcTyThing | APromotionErr PromotionErr + | AScopingError (LHsType GhcRn) -- See Note [Scoping errors during type check] + -- The argument is the type where scoping error may occur, + -- and is only required for error reporting. + -- | Matches on either a global 'TyCon' or a 'TcTyCon'. tcTyThingTyCon_maybe :: TcTyThing -> Maybe TyCon tcTyThingTyCon_maybe (AGlobal (ATyCon tc)) = Just tc @@ -314,6 +318,7 @@ instance Outputable TcTyThing where -- Debugging only <+> dcolon <+> ppr (varType tv) ppr (ATcTyCon tc) = text "ATcTyCon" <+> ppr tc <+> dcolon <+> ppr (tyConKind tc) ppr (APromotionErr err) = text "APromotionErr" <+> ppr err + ppr (AScopingError ty) = text "AScopingError" <+> ppr ty -- | IdBindingInfo describes how an Id is bound. -- @@ -480,6 +485,45 @@ in the type environment. type environment so in the latter case it always stays as a unification variable, although that variable may be later unified with a type (such as Int in 'g2'). + +Note [Scoping errors during type check] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider you have such function at the term level: + + -- f :: [forall b . Either b ()] + f = [Right @a @() () :: forall a. Either a ()] + +Here `@a` in the type application and `a` in the type signature are the same +type variable, so `forall a` introduces the type variable `a` in the +term context. This is a binder in the surface language. + +After elaboration in Core, the binder change would be changed to the +lambda abstraction: + + f = [(\@a -> Right @a @() ()) :: forall a . Either a ()] + +So, in Core, only lambda brings new variables into scope, not `forall`. +But how does this work with types? + + type F = '[Right @a @() () :: forall a. Either a ()] + +If we look at this through the prism of surface language, then `a` +should obviously be in the scope of `Right`, because that's what forall does. +But if we take elaboration into account things get trickier - +we need some sort of lambda in types to do such elaboration, +like this: + + type F = '[(/\ a . Right @a @() ()) :: forall a. Either a ()] -- Bogus + +Core has no such construct, so this is not a valid type. + +So, in the surface language `a` definitely IS in scope, and in the core language +`a` definitely IS NOT in scope - we can't add a new binder. + +The solution is to reject such programs at elaboration time, and this is where +`AScopingError` comes in. We add forall'd type variables from the kind +signature with such a placeholder into the scope of the type-checker and report an +error with an explanation of the problem - like in `APromotionErr`. -} instance Outputable IdBindingInfo where @@ -497,4 +541,5 @@ tcTyThingCategory (AGlobal thing) = tyThingCategory thing tcTyThingCategory (ATyVar {}) = "type variable" tcTyThingCategory (ATcId {}) = "local identifier" tcTyThingCategory (ATcTyCon {}) = "local tycon" -tcTyThingCategory (APromotionErr pe) = peCategory pe \ No newline at end of file +tcTyThingCategory (APromotionErr pe) = peCategory pe +tcTyThingCategory AScopingError{} = "type variable" ===================================== compiler/GHC/Tc/Utils/Env.hs ===================================== @@ -43,7 +43,7 @@ module GHC.Tc.Utils.Env( getInLocalScope, wrongThingErr, pprBinders, - tcAddDataFamConPlaceholders, tcAddPatSynPlaceholders, + tcAddDataFamConPlaceholders, tcAddPatSynPlaceholders, tcAddKindSigPlaceholders, getTypeSigNames, tcExtendRecEnv, -- For knot-tying @@ -509,7 +509,7 @@ getInLocalScope = do { lcl_env <- getLclTypeEnv tcExtendKindEnvList :: [(Name, TcTyThing)] -> TcM r -> TcM r -- Used only during kind checking, for TcThings that are --- ATcTyCon or APromotionErr +-- ATcTyCon, APromotionErr or AScopingError -- No need to update the global tyvars, or tcl_th_bndrs, or tcl_rdr tcExtendKindEnvList things thing_inside = do { traceTc "tcExtendKindEnvList" (ppr things) @@ -705,6 +705,12 @@ tcAddPatSynPlaceholders pat_syns thing_inside | PSB{ psb_id = L _ name } <- pat_syns ] thing_inside +tcAddKindSigPlaceholders :: LHsKind GhcRn -> LHsType GhcRn -> TcM a -> TcM a +tcAddKindSigPlaceholders kind_sig type_we_traverse_in thing_inside + = tcExtendKindEnvList [ (name, AScopingError type_we_traverse_in) + | name <- hsScopedKiVs kind_sig ] + thing_inside + getTypeSigNames :: [LSig GhcRn] -> NameSet -- Get the names that have a user type sig getTypeSigNames sigs ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -591,6 +591,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnArityMismatch" = 27346 GhcDiagnosticCode "TcRnSimplifiableConstraint" = 62412 GhcDiagnosticCode "TcRnIllegalQuasiQuotes" = 77343 + GhcDiagnosticCode "TcRnAScopingError" = 34573 -- TcRnTypeApplicationsDisabled GhcDiagnosticCode "TypeApplication" = 23482 ===================================== testsuite/tests/rename/should_fail/T16635a.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE NoScopedTypeVariables, ExplicitForAll #-} +{-# LANGUAGE DataKinds, PolyKinds, TypeApplications #-} + +module T16635a where + +data Unit = U +data P a = MkP + +-- ScopedTypeVariables are disabled. +-- Fails because because @a is not in scope. +type F = (Just @a :: forall a. a -> Maybe a) U ===================================== testsuite/tests/rename/should_fail/T16635a.stderr ===================================== @@ -0,0 +1,3 @@ + +T16635a.hs:11:17: error: [GHC-76037] + Not in scope: type variable ‘a’ ===================================== testsuite/tests/rename/should_fail/T16635b.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE DataKinds, PolyKinds, TypeApplications #-} + +module T16635b where + +data Unit = U +data P a = MkP + +-- OK. +f = (Just @a :: forall a. a -> Maybe a) U + +-- Fails because we cannot generalize to (/\a. Just @a) +-- but NOT because @a is not in scope. +type F = (Just @a :: forall a. a -> Maybe a) U ===================================== testsuite/tests/rename/should_fail/T16635b.stderr ===================================== @@ -0,0 +1,7 @@ + +T16635b.hs:14:17: error: [GHC-34573] + • Cannot generalise type Just @a + to /\ a -> Just @a + • In the first argument of ‘Just’, namely ‘a’ + In the type ‘(Just @a :: forall a. a -> Maybe a) U’ + In the type declaration for ‘F’ ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -198,3 +198,5 @@ test('RnUnexpectedStandaloneDeriving', normal, compile_fail, ['']) test('RnStupidThetaInGadt', normal, compile_fail, ['']) test('PackageImportsDisabled', normal, compile_fail, ['']) test('ImportLookupIllegal', normal, compile_fail, ['']) +test('T16635a', normal, compile_fail, ['']) +test('T16635b', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c4232c36ca88cb34fcc9d8889bd21290b0c5f742 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c4232c36ca88cb34fcc9d8889bd21290b0c5f742 You're receiving 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 Jun 8 09:32:15 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Thu, 08 Jun 2023 05:32:15 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/modern-STV-add-warning] Adding -Wpattern-signature-binds (#23291) Message-ID: <6481a01f20c8d_226212c4734305f7@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/modern-STV-add-warning at Glasgow Haskell Compiler / GHC Commits: c94056c5 by Andrei Borzenkov at 2023-06-08T13:31:58+04:00 Adding -Wpattern-signature-binds (#23291) Was introduced one new warning option: -Wpattern-signature-binds It warns when pattern signature binds into scope new type variable. For example: f (a :: t) = ... - - - - - 13 changed files: - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/using-warnings.rst - + testsuite/tests/rename/should_fail/WPatternSigBinds.hs - + testsuite/tests/rename/should_fail/WPatternSigBinds.stderr - testsuite/tests/rename/should_fail/all.T Changes: ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -640,6 +640,7 @@ data WarningFlag = | Opt_WarnLoopySuperclassSolve -- Since 9.6 | Opt_WarnTermVariableCapture -- Since 9.8 | Opt_WarnMissingRoleAnnotations -- Since 9.8 + | Opt_WarnPatternSignatureBinds -- Since 9.8 deriving (Eq, Ord, Show, Enum) -- | Return the names of a WarningFlag @@ -747,6 +748,7 @@ warnFlagNames wflag = case wflag of Opt_WarnLoopySuperclassSolve -> "loopy-superclass-solve" :| [] Opt_WarnTypeEqualityRequiresOperators -> "type-equality-requires-operators" :| [] Opt_WarnMissingRoleAnnotations -> "missing-role-annotations" :| [] + Opt_WarnPatternSignatureBinds -> "pattern-signature-binds" :| [] -- ----------------------------------------------------------------------------- -- Standard sets of warning options ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2257,7 +2257,8 @@ wWarningFlagsDeps = mconcat [ warnSpec Opt_WarnTypeEqualityOutOfScope, warnSpec Opt_WarnTypeEqualityRequiresOperators, warnSpec Opt_WarnTermVariableCapture, - warnSpec Opt_WarnMissingRoleAnnotations + warnSpec Opt_WarnMissingRoleAnnotations, + warnSpec Opt_WarnPatternSignatureBinds ] warningGroupsDeps :: [(Deprecation, FlagSpec WarningGroup)] ===================================== compiler/GHC/Rename/Bind.hs ===================================== @@ -519,7 +519,7 @@ rnBind sig_fn bind@(FunBind { fun_id = name -- invariant: no free vars here when it's a FunBind = do { let plain_name = unLoc name - ; (matches', rhs_fvs) <- bindSigTyVarsFVExtended (sig_fn plain_name) $ + ; (matches', rhs_fvs) <- bindSigTyVarsFV (sig_fn plain_name) $ -- bindSigTyVars tests for LangExt.ScopedTyVars rnMatchGroup (mkPrefixFunRhs name) rnLExpr matches @@ -726,7 +726,7 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name ; unless pattern_synonym_ok (addErr TcRnIllegalPatternSynonymDecl) ; let scoped_tvs = sig_fn name - ; ((pat', details'), fvs1) <- bindSigTyVarsFVExtended scoped_tvs $ + ; ((pat', details'), fvs1) <- bindSigTyVarsFV scoped_tvs $ rnPat PatSyn pat $ \pat' -> -- We check the 'RdrName's instead of the 'Name's -- so that the binding locations are reported @@ -763,7 +763,7 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name Unidirectional -> return (Unidirectional, emptyFVs) ImplicitBidirectional -> return (ImplicitBidirectional, emptyFVs) ExplicitBidirectional mg -> - do { (mg', fvs) <- bindSigTyVarsFVExtended scoped_tvs $ + do { (mg', fvs) <- bindSigTyVarsFV scoped_tvs $ rnMatchGroup (mkPrefixFunRhs (L l name)) rnLExpr mg ; return (ExplicitBidirectional mg', fvs) } ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -523,7 +523,7 @@ rnExpr (HsRecSel x _) = dataConCantHappen x rnExpr (ExprWithTySig _ expr pty) = do { (pty', fvTy) <- rnHsSigWcType ExprWithTySigCtx pty - ; (expr', fvExpr) <- bindSigTyVarsFVExtended (hsWcScopedTvs pty') $ + ; (expr', fvExpr) <- bindSigTyVarsFV (hsWcScopedTvs pty') $ rnLExpr expr ; return (ExprWithTySig noExtField expr' pty', fvExpr `plusFV` fvTy) } ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -173,6 +173,10 @@ rnHsPatSigType scoping ctx sig_ty thing_inside then tv_rdrs else [] NeverBind -> [] + ; let i_bndrs = nubN implicit_bndrs in + unless (null i_bndrs) $ + forM_ i_bndrs $ \i_bndr -> + addDiagnosticAt (locA $ getLoc i_bndr) (TcRnPatternSignatureBinds i_bndr) ; rnImplicitTvOccs Nothing implicit_bndrs $ \ imp_tvs -> do { (nwcs, pat_sig_ty', fvs1) <- rnWcBody ctx nwc_rdrs pat_sig_ty ; let sig_names = HsPSRn { hsps_nwcs = nwcs, hsps_imp_tvs = imp_tvs } ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1849,6 +1849,11 @@ instance Diagnostic TcRnMessage where , text "or a complete user-supplied kind (CUSK, legacy feature)" , text "is required to use invisible binders." ] + TcRnPatternSignatureBinds fvar -> mkSimpleDecorated $ + sep [text "Type variable binding" + , text "in pattern signature:" <+> quotes (ppr fvar) + ] + diagnosticReason = \case TcRnUnknownMessage m -> diagnosticReason m @@ -2465,6 +2470,8 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnInvisBndrWithoutSig{} -> ErrorWithoutFlag + TcRnPatternSignatureBinds{} + -> WarningWithFlag Opt_WarnPatternSignatureBinds diagnosticHints = \case TcRnUnknownMessage m @@ -3128,6 +3135,8 @@ instance Diagnostic TcRnMessage where -> noHints TcRnInvisBndrWithoutSig name _ -> [SuggestAddStandaloneKindSignature name] + TcRnPatternSignatureBinds{} + -> noHints diagnosticCode :: TcRnMessage -> Maybe DiagnosticCode diagnosticCode = constructorCode ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -4094,6 +4094,18 @@ data TcRnMessage where -} TcRnMissingRoleAnnotation :: Name -> [Role] -> TcRnMessage + {-| TcRnPatternSignatureBinds is a warning thrown when a user binds + type variables in a pattern signature. This is only performed with + -Wpattern-signature-binds + + Example(s): + + id (x :: b) = x + + Test case: rename/should_fail/WPatternSigBinds + -} + TcRnPatternSignatureBinds :: LocatedN RdrName -> TcRnMessage + deriving Generic ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -591,6 +591,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnArityMismatch" = 27346 GhcDiagnosticCode "TcRnSimplifiableConstraint" = 62412 GhcDiagnosticCode "TcRnIllegalQuasiQuotes" = 77343 + GhcDiagnosticCode "TcRnPatternSignatureBinds" = 65467 -- TcRnTypeApplicationsDisabled GhcDiagnosticCode "TypeApplication" = 23482 ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -30,6 +30,9 @@ Compiler - Added a new warning :ghc-flag:`-Wterm-variable-capture` that helps to make code compatible with the future extension ``RequiredTypeArguments``. +- Added a new warning :ghc-flag:`-Wpattern-signature-binds` which alerts the user when they bind + a new type variable in a pattern signature. + - Rewrite rules now support a limited form of higher order matching when a pattern variable is applied to distinct locally bound variables. For example: :: ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -2415,6 +2415,28 @@ of ``-W(no-)*``. In other words the type-class role cannot be accidentally left representational or phantom, which could affected the code correctness. +.. ghc-flag:: -Wpattern-signature-binds + :shortdesc: warn when a pattern signature binds new type variables + :type: dynamic + + :since: 9.8.1 + + Added in accordance with `GHC Proposal #448 + `__. + + Type variable bindings in pattern signatures violate the Lexical Scoping Principle: depending + on the context, type variables in pattern signatures can be either occurrences or bindings. + + For example: :: + + f (x :: a) = ... -- binding of ‘a’ + + g :: forall a . ... + g (x :: a) = ... -- occurrence of ‘a’ + + When :ghc-flag:`-Wpattern-signature-binds` is enabled, GHC warns about type variable bindings + in pattern signatures. + If you're feeling really paranoid, the :ghc-flag:`-dcore-lint` option is a good choice. It turns on heavyweight intra-pass sanity-checking within GHC. (It checks GHC's ===================================== testsuite/tests/rename/should_fail/WPatternSigBinds.hs ===================================== @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -Wpattern-signature-binds -Werror #-} +module WPatternSigBinds where + +f (x :: a) = x + +g (x :: a) (y :: b) = x + +h (x :: a) (y :: b c d) = x + +i :: forall f a . f a -> f a +i (x :: b c) = x ===================================== testsuite/tests/rename/should_fail/WPatternSigBinds.stderr ===================================== @@ -0,0 +1,27 @@ + +WPatternSigBinds.hs:4:9: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds] + Type variable binding in pattern signature: ‘a’ + +WPatternSigBinds.hs:6:9: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds] + Type variable binding in pattern signature: ‘a’ + +WPatternSigBinds.hs:6:18: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds] + Type variable binding in pattern signature: ‘b’ + +WPatternSigBinds.hs:8:9: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds] + Type variable binding in pattern signature: ‘a’ + +WPatternSigBinds.hs:8:18: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds] + Type variable binding in pattern signature: ‘b’ + +WPatternSigBinds.hs:8:20: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds] + Type variable binding in pattern signature: ‘c’ + +WPatternSigBinds.hs:8:22: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds] + Type variable binding in pattern signature: ‘d’ + +WPatternSigBinds.hs:11:9: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds] + Type variable binding in pattern signature: ‘b’ + +WPatternSigBinds.hs:11:11: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds] + Type variable binding in pattern signature: ‘c’ ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -198,3 +198,4 @@ test('RnUnexpectedStandaloneDeriving', normal, compile_fail, ['']) test('RnStupidThetaInGadt', normal, compile_fail, ['']) test('PackageImportsDisabled', normal, compile_fail, ['']) test('ImportLookupIllegal', normal, compile_fail, ['']) +test('WPatternSigBinds', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c94056c53a07e056c5133aab5f9fb630b6466223 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c94056c53a07e056c5133aab5f9fb630b6466223 You're receiving 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 Jun 8 10:05:37 2023 From: gitlab at gitlab.haskell.org (Torsten Schmits (@torsten.schmits)) Date: Thu, 08 Jun 2023 06:05:37 -0400 Subject: [Git][ghc/ghc][wip/torsten.schmits/test-way-ghci-opt] 60 commits: Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) Message-ID: <6481a7f14d17f_226212c474844274@gitlab.mail> Torsten Schmits pushed to branch wip/torsten.schmits/test-way-ghci-opt at Glasgow Haskell Compiler / GHC Commits: 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 119e1751 by Matthew Pickering at 2023-06-08T11:48:32+02:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - 30 changed files: - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types/Prim.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ad496be64439a10f8ced1b29621eba8a70eff46b...119e17515101a22b140fd6fa278f5a313fcc0af3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ad496be64439a10f8ced1b29621eba8a70eff46b...119e17515101a22b140fd6fa278f5a313fcc0af3 You're receiving 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 Jun 8 10:07:48 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Thu, 08 Jun 2023 06:07:48 -0400 Subject: [Git][ghc/ghc][wip/js-literalstrings] JS: Readd unpacking of literal strings in genApp (#23479) Message-ID: <6481a874996a8_2262122dff97444450@gitlab.mail> Josh Meredith pushed to branch wip/js-literalstrings at Glasgow Haskell Compiler / GHC Commits: 7dfc05c4 by Josh Meredith at 2023-06-08T10:06:54+00:00 JS: Readd unpacking of literal strings in genApp (#23479) - - - - - 1 changed file: - compiler/GHC/StgToJS/Apply.hs Changes: ===================================== compiler/GHC/StgToJS/Apply.hs ===================================== @@ -1,6 +1,8 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE BlockArguments #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE ViewPatterns #-} ----------------------------------------------------------------------------- -- | @@ -49,6 +51,10 @@ import GHC.Types.Literal import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.CostCentre +import GHC.Types.Name + +import Language.Haskell.Syntax.Module.Name +import GHC.Unit.Types import GHC.Stg.Syntax @@ -68,6 +74,7 @@ import GHC.Data.FastString import qualified Data.Bits as Bits import Data.Monoid import Data.Array +import qualified Data.List as L -- | Pre-generated functions for fast Apply. -- These are bundled with the RTS. @@ -85,6 +92,13 @@ rtsApply cfg = BlockStat $ , selectors cfg ] +matchVarName :: String -> FastString -> FastString -> Id -> Bool +matchVarName pkg modu occ (idName -> n) + | Just m <- nameModule_maybe n = + occ == occNameFS (nameOccName n) && + modu == moduleNameFS (moduleName m) && + pkg `L.isPrefixOf` (unitIdString (moduleUnitId m)) + | otherwise = False -- | Generate an application of some args to an Id. -- @@ -97,6 +111,13 @@ genApp -> [StgArg] -> G (JStat, ExprResult) genApp ctx i args + -- JSString literals + | [StgVarArg v] <- args + , matchVarName "base" "GHC.JS.Prim" "unsafeUnpackJSStringUtf8##" i + -- `typex_expr` can throw an error for certain bindings so it's important + -- that this condition comes after matching on the function name + , [top] <- concatMap typex_expr (ctxTarget ctx) + = (,ExprInline Nothing) . (top |=) . app "h$decodeUtf8z" <$> varsForId v -- Case: unpackCStringAppend# "some string"# str -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7dfc05c4009f5661285cf6191dd5c79e5001a1be -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7dfc05c4009f5661285cf6191dd5c79e5001a1be You're receiving 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 Jun 8 13:02:54 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Thu, 08 Jun 2023 09:02:54 -0400 Subject: [Git][ghc/ghc][wip/ipe-data-compression] IPE data compression Message-ID: <6481d17e8bd56_226212c46d097872@gitlab.mail> Finley McIlwaine pushed to branch wip/ipe-data-compression at Glasgow Haskell Compiler / GHC Commits: 905dec2d by Finley McIlwaine at 2023-06-08T07:02:18-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 23 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/StgToCmm/InfoTableProv.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/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-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: ae60a90db673e679399286e3b63c21c8e7a9a9b9 + DOCKER_REV: 243a00f06550e6b9a00fa0f1530d1bb761e8b7cc # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. ===================================== .gitlab/gen_ci.hs ===================================== @@ -141,6 +141,7 @@ data BuildConfig , llvmBootstrap :: Bool , withAssertions :: Bool , withNuma :: Bool + , withZstd :: Bool , crossTarget :: Maybe String , crossEmulator :: CrossEmulator , configureWrapper :: Maybe String @@ -154,10 +155,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 @@ -172,8 +174,12 @@ mkJobFlavour BuildConfig{..} = Flavour buildFlavour opts 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 @@ -192,6 +198,7 @@ vanilla = BuildConfig , llvmBootstrap = False , withAssertions = False , withNuma = False + , withZstd = False , crossTarget = Nothing , crossEmulator = NoEmulator , configureWrapper = Nothing @@ -224,6 +231,9 @@ debug = vanilla { buildFlavour = SlowValidate , withNuma = True } +zstdIpe :: BuildConfig +zstdIpe = vanilla { withZstd = True } + static :: BuildConfig static = vanilla { fullyStatic = True } @@ -313,18 +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" - flavourString BootNonmovingGc = "boot_nonmoving_gc" + 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 BootNonmovingGc = "boot_nonmoving_gc" -- The path to the docker image (just for linux builders) dockerImage :: Arch -> Opsys -> Maybe String @@ -517,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 @@ -553,6 +563,7 @@ data Rule = FastCI -- ^ Run this job when the fast-ci label is set | 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. + | IpeData -- ^ Only run this job when the "IPE" label is set | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) @@ -579,12 +590,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 @@ -880,7 +893,6 @@ job_groups = modifyNightlyJobs allowFailure (modifyValidateJobs manual (validateBuilds Amd64 (Linux Debian10) noTntc)) , addValidateRule LLVMBackend (validateBuilds Amd64 (Linux Debian10) llvm) - , 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. @@ -919,6 +931,8 @@ job_groups = , modifyValidateJobs manual $ make_wasm_jobs wasm_build_config {unregisterised = True} , addValidateRule NonmovingGc (standardBuildsWithConfig Amd64 (Linux Debian11) vanilla {validateNonmovingGc = True}) + , modifyNightlyJobs (addJobRule Disable) $ + addValidateRule IpeData (validateBuilds Amd64 (Linux Debian10) zstdIpe) ] where ===================================== .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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -641,7 +641,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -703,7 +703,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -765,7 +765,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -826,7 +826,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -887,7 +887,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1008,7 +1008,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1067,7 +1067,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1186,7 +1186,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1245,7 +1245,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1304,7 +1304,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1363,7 +1363,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1422,7 +1422,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1483,7 +1483,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1544,7 +1544,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1606,7 +1606,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1665,7 +1665,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1725,7 +1725,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1784,7 +1784,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1845,7 +1845,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1907,7 +1907,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1968,7 +1968,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2028,7 +2028,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2087,7 +2087,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2142,7 +2142,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2201,7 +2201,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2264,7 +2264,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2328,7 +2328,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2389,7 +2389,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2450,7 +2450,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2516,7 +2516,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2579,7 +2579,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2642,7 +2642,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2705,7 +2705,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2766,7 +2766,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2827,7 +2827,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2888,7 +2888,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2949,7 +2949,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3011,7 +3011,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3072,7 +3072,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3135,7 +3135,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3198,7 +3198,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3261,7 +3261,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3322,7 +3322,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3383,7 +3383,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3440,7 +3440,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3500,7 +3500,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3564,7 +3564,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3628,7 +3628,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3688,7 +3688,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3749,7 +3749,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3810,7 +3810,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -3871,7 +3871,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -3931,7 +3931,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3990,7 +3990,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4048,7 +4048,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4107,7 +4107,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4130,6 +4130,64 @@ "TEST_ENV": "x86_64-linux-deb10-unreg-validate" } }, + "x86_64-linux-deb10-validate": { + "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.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\") && (\"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", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "TEST_ENV": "x86_64-linux-deb10-validate" + } + }, "x86_64-linux-deb10-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -4165,7 +4223,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4223,7 +4281,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4282,7 +4340,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4342,7 +4400,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4402,7 +4460,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4463,7 +4521,7 @@ ], "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\")", + "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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4522,7 +4580,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4578,7 +4636,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -1,67 +1,188 @@ +{-# 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.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, unpackFS, LexicalFastString(..)) +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. + +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). -emitIpeBufferListNode :: Module - -> [InfoProvEnt] - -> FCode () +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 + + entries_bytes :: BS.ByteString + entries_bytes = compress defaultCompressionLevel uncompressed_entries - 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 :: [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 @@ -77,7 +198,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 @@ -105,7 +226,7 @@ data StringTable = StringTable { stStrings :: DList ShortText , stLookup :: !(M.Map ShortText StrTabOffset) } -newtype StrTabOffset = StrTabOffset Int +type StrTabOffset = Word32 emptyStringTable :: StringTable emptyStringTable = @@ -130,9 +251,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,14 @@ Flag build-tool-depends Description: Use build-tool-depends Default: True +Flag with-libzstd + Default: False + Manual: True + +Flag static-libzstd + Default: False + Manual: True + -- While the boot compiler fixes ghc's unit-id to `ghc`, the stage0 compiler must still be compiled with `-this-unit-id ghc` Flag hadrian-stage0 Description: Enable if compiling the stage0 compiler with hadrian @@ -77,6 +85,16 @@ 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) + if flag(static-libzstd) + if os(darwin) + buildable: False + else + extra-libraries: :libzstd.a + else + 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 ===================================== @@ -1105,6 +1105,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 @@ -1250,6 +1254,19 @@ 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;) +STATIC_LIBZSTD=$(if [ "$StaticLibZstd" = "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 + statically linked? : $STATIC_LIBZSTD + libdw : $USING_LIBDW Using LLVM tools clang : $ClangCmd ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -128,6 +128,20 @@ Compiler GHC used to accept the contradictory ``Int~Bool`` in the type signature, but reject the ``Int~Bool`` constraint that arises from typechecking the definition itself. Now it accepts both. More details in `GHC ticket #23413 `_, which gives examples of the previous inconsistency. GHC now implements the "PermissivePlan" described in that ticket. +- 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 `_ version 1.4.0 or greater + installed. The compression library `libzstd` may optionally be statically + linked in the resulting compiler (on non-darwin machines) using the + `--enable-static-libzstd` configure flag. + + 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,26 @@ 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. The compression + library ``libzstd`` may optionally be statically linked in the resulting + compiler (on non-darwin machines) using the ``--enable-static-libzstd`` + configure flag. + + 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 ===================================== @@ -199,10 +199,15 @@ 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@ +static-lib-zstd = @UseStaticLibZstd@ use-lib-numa = @UseLibNuma@ use-lib-m = @UseLibm@ use-lib-rt = @UseLibrt@ ===================================== hadrian/src/Oracles/Flag.hs ===================================== @@ -35,6 +35,8 @@ data Flag = ArSupportsAtFile | UseLibffiForAdjustors | UseLibdw | UseLibnuma + | UseLibzstd + | StaticLibzstd | UseLibm | UseLibrt | UseLibdl @@ -65,6 +67,8 @@ flag f = do UseLibffiForAdjustors -> "use-libffi-for-adjustors" UseLibdw -> "use-lib-dw" UseLibnuma -> "use-lib-numa" + UseLibzstd -> "use-lib-zstd" + StaticLibzstd -> "static-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 @@ -161,6 +163,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 ===================================== @@ -316,6 +316,8 @@ rtsCabalFlags = mconcat , flag "CabalNeedLibpthread" UseLibpthread , flag "CabalHaveLibbfd" UseLibbfd , flag "CabalHaveLibNuma" UseLibnuma + , flag "CabalHaveLibZstd" UseLibzstd + , flag "CabalStaticLibZstd" StaticLibzstd , flag "CabalNeedLibatomic" NeedLibatomic , flag "CabalUseSystemLibFFI" UseSystemFfi , flag "CabalLibffiAdjustors" UseLibffiForAdjustors ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -74,11 +74,13 @@ packageArgs = do [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" , notM cross `cabalFlag` "terminfo" , arg "-build-tool-depends" + , flag UseLibzstd `cabalFlag` "with-libzstd" -- ROMES: While the boot compiler is not updated wrt -this-unit-id -- not being fixed to `ghc`, when building stage0, we must set -- -this-unit-id to `ghc` because the boot compiler expects that. -- We do it through a cabal flag in ghc.cabal , stage0 ? arg "+hadrian-stage0" + , flag StaticLibzstd `cabalFlag` "static-libzstd" ] , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ] @@ -288,6 +290,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 @@ -394,6 +398,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,120 @@ +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] + ) + + StaticLibZstd=0 + AC_ARG_ENABLE( + static-libzstd, + [AS_HELP_STRING( + [--enable-static-libzstd], + [Statically link the libzstd compression library with the compiler + (not compatible with darwin) [default=no]] + )], + [StaticLibZstd=1], + [StaticLibZstd=0] + ) + + HaveLibZstd=0 + if test "$EnableIpeDataCompression" = "YES"; then + dnl ** Have zstd >= 1.4.0? + 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 + + # libzstd >= 1.4.0 is required for IPE data compression + fp_libzstd_version="`pkg-config --modversion libzstd`" + FP_COMPARE_VERSIONS( + [$fp_libzstd_version], + [-lt], + [1.4.0], + [AC_MSG_ERROR( + [Need at least libzstd version 1.4.0 for + --enable-ipe-data-compression]) + ] + ) + + 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)]) + + AC_DEFINE_UNQUOTED([STATIC_LIBZSTD], [$StaticLibZstd], [Define to 1 if you + wish to statically link the libzstd compression library in the compiler + (requires libzstd)]) + + if test $HaveLibZstd = "1" ; then + AC_SUBST([UseLibZstd],[YES]) + AC_SUBST([CabalHaveLibZstd],[True]) + if test $StaticLibZstd = "1" ; then + case "${host_os}" in + darwin*) + AC_MSG_ERROR( + [--enable-static-libzstd is not compatible with darwin] + ) + esac + AC_SUBST([UseStaticLibZstd],[YES]) + AC_SUBST([CabalStaticLibZstd],[True]) + else + AC_SUBST([UseStaticLibZstd],[NO]) + AC_SUBST([CabalStaticLibZstd],[False]) + fi + 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,85 @@ 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; + IpeBufferEntry *entries; + 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 == 1) { + // 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,10 @@ flag libdw default: @CabalHaveLibdw@ flag libnuma default: @CabalHaveLibNuma@ +flag libzstd + default: @CabalHaveLibZstd@ +flag static-libzstd + default: @CabalStaticLibZstd@ flag leading-underscore default: @CabalLeadingUnderscore@ flag smp @@ -211,6 +215,14 @@ library extra-libraries: elf dw if flag(libnuma) extra-libraries: numa + if flag(libzstd) + if flag(static-libzstd) + if os(darwin) + buildable: False + else + extra-libraries: :libzstd.a + else + extra-libraries: zstd if !flag(smp) cpp-options: -DNOSMP ===================================== 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/905dec2d36034196cd07481226d359896c62c416 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/905dec2d36034196cd07481226d359896c62c416 You're receiving 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 Jun 8 13:18:17 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Thu, 08 Jun 2023 09:18:17 -0400 Subject: [Git][ghc/ghc][wip/no-stub-dir-include] Include -haddock in DynFlags fingerprint Message-ID: <6481d5193ee94_226212c46e4101841@gitlab.mail> Finley McIlwaine pushed to branch wip/no-stub-dir-include at Glasgow Haskell Compiler / GHC Commits: c69d9798 by Finley McIlwaine at 2023-06-08T07:18:00-06:00 Include -haddock in DynFlags fingerprint The -haddock flag determines whether or not the resulting .hi files contain haddock documentation strings. If the existing .hi files do not contain haddock documentation strings and the user requests them, we should recompile. - - - - - 1 changed file: - compiler/GHC/Iface/Recomp/Flags.hs Changes: ===================================== compiler/GHC/Iface/Recomp/Flags.hs ===================================== @@ -67,7 +67,10 @@ fingerprintDynFlags hsc_env this_mod nameio = ticky = map (`gopt` dflags) [Opt_Ticky, Opt_Ticky_Allocd, Opt_Ticky_LNE, Opt_Ticky_Dyn_Thunk, Opt_Ticky_Tag] - flags = ((mainis, safeHs, lang, cpp), (paths, prof, ticky, debugLevel, callerCcFilters)) + -- Haddock + haddock = Opt_Haddock `gopt` dflags + + flags = ((mainis, safeHs, lang, cpp), (paths, prof, ticky, haddock, debugLevel, callerCcFilters)) in -- pprTrace "flags" (ppr flags) $ computeFingerprint nameio flags View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c69d97986a0901fe79bd311f22a152551c5cf0a8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c69d97986a0901fe79bd311f22a152551c5cf0a8 You're receiving 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 Jun 8 13:33:45 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Thu, 08 Jun 2023 09:33:45 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/#16635-improve-errors] Capture scoped kind variables at type-checking phase (#16635) Message-ID: <6481d8b969d4b_226212c46e41123df@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/#16635-improve-errors at Glasgow Haskell Compiler / GHC Commits: 5e5df728 by Andrei Borzenkov at 2023-06-08T17:32:47+04:00 Capture scoped kind variables at type-checking phase (#16635) Like descibed in new Note [Type variable scoping errors during type check] in GHC.Tc.Types, I made ScopedTypeVariables work on type level like in term level. For now that only means, that the error about kind variables scoped into type are rejected at the elaboration time, because we can't generalize the type by adding type-level lambda - we simply have no one. - - - - - 12 changed files: - compiler/GHC/Hs/Type.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types/PromotionErr.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Types/BasicTypes.hs - compiler/GHC/Tc/Utils/Env.hs - + testsuite/tests/rename/should_fail/T16635a.hs - + testsuite/tests/rename/should_fail/T16635a.stderr - + testsuite/tests/rename/should_fail/T16635b.hs - + testsuite/tests/rename/should_fail/T16635b.stderr - testsuite/tests/rename/should_fail/all.T Changes: ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -73,7 +73,7 @@ module GHC.Hs.Type ( mkHsForAllVisTele, mkHsForAllInvisTele, mkHsQTvs, hsQTvExplicit, emptyLHsQTvs, isHsKindedTyVar, hsTvbAllKinded, - hsScopedTvs, hsWcScopedTvs, dropWildCards, + hsScopedTvs, hsScopedKiVs, hsWcScopedTvs, dropWildCards, hsTyVarName, hsAllLTyVarNames, hsLTyVarLocNames, hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsExplicitLTyVarNames, splitLHsInstDeclTy, getLHsInstDeclHead, getLHsInstDeclClass_maybe, @@ -431,6 +431,14 @@ hsScopedTvs (L _ (HsSig{sig_bndrs = outer_bndrs})) = hsLTyVarNames (hsOuterExplicitBndrs outer_bndrs) -- See Note [hsScopedTvs and visible foralls] +hsScopedKiVs :: LHsKind GhcRn -> [Name] +-- here we should fuse two actions, performed for +-- type signatures, but not for kind ones: `hsTypeToHsSigType` +-- (but in GhcRn phase) and `hsScopedTvs` +hsScopedKiVs (L _ HsForAllTy { hst_tele = HsForAllInvis { hsf_invis_bndrs = bndrs }}) + = hsLTyVarNames bndrs +hsScopedKiVs _ = [] + --------------------- hsTyVarName :: HsTyVarBndr flag (GhcPass p) -> IdP (GhcPass p) hsTyVarName (UserTyVar _ _ (L _ n)) = n ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -647,8 +647,9 @@ rnHsTyKi env listTy@(HsListTy x ty) rnHsTyKi env (HsKindSig x ty k) = do { kind_sigs_ok <- xoptM LangExt.KindSignatures ; unless kind_sigs_ok (badKindSigErr (rtke_ctxt env) ty) - ; (ty', lhs_fvs) <- rnLHsTyKi env ty ; (k', sig_fvs) <- rnLHsTyKi (env { rtke_level = KindLevel }) k + ; (ty', lhs_fvs) <- bindSigTyVarsFV (hsScopedKiVs k') + (rnLHsTyKi env ty) ; return (HsKindSig x ty' k', lhs_fvs `plusFV` sig_fvs) } -- Unboxed tuples are allowed to have poly-typed arguments. These @@ -1937,8 +1938,7 @@ extract_lty (L _ ty) acc HsExplicitTupleTy _ tys -> extract_ltys tys acc HsTyLit _ _ -> acc HsStarTy _ _ -> acc - HsKindSig _ ty ki -> extract_lty ty $ - extract_lty ki acc + HsKindSig _ ty ki -> extract_kind_sig ty ki acc HsForAllTy { hst_tele = tele, hst_body = ty } -> extract_hs_for_all_telescope tele acc $ extract_lty ty [] @@ -1949,6 +1949,17 @@ extract_lty (L _ ty) acc -- We deal with these separately in rnLHsTypeWithWildCards HsWildCardTy {} -> acc +extract_kind_sig :: LHsType GhcPs -- type + -> LHsType GhcPs -- kind + -> FreeKiTyVars -> FreeKiTyVars +extract_kind_sig + ty + (L _ HsForAllTy { hst_tele = HsForAllInvis { hsf_invis_bndrs = bndrs }, hst_body = ki_body }) + acc + = extract_hs_tv_bndrs bndrs acc (extract_lty ty $ extract_lty ki_body []) +extract_kind_sig ty ki acc = extract_lty ty $ + extract_lty ki acc + extract_lhs_sig_ty :: LHsSigType GhcPs -> FreeKiTyVars extract_lhs_sig_ty (L _ (HsSig{sig_bndrs = outer_bndrs, sig_body = body})) = extractHsOuterTvBndrs outer_bndrs $ extract_lty body [] ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1046,6 +1046,7 @@ instance Diagnostic TcRnMessage where ClassPE -> same_rec_group_msg TyConPE -> same_rec_group_msg TermVariablePE -> text "term variables cannot be promoted" + TypeVariablePE -> text "forall-bound variables cannot be used in kinds" same_rec_group_msg = text "it is defined and used in the same recursive group" TcRnMatchesHaveDiffNumArgs argsContext (MatchArgMatches match1 bad_matches) -> mkSimpleDecorated $ ===================================== compiler/GHC/Tc/Errors/Types/PromotionErr.hs ===================================== @@ -25,6 +25,7 @@ data PromotionErr -- See Note [Recursion and promoting data constructors] in GHC.Tc.TyCl | TermVariablePE -- See Note [Promoted variables in types] | NoDataKindsDC -- -XDataKinds not enabled (for a datacon) + | TypeVariablePE -- See Note [Type variable scoping errors during type check] instance Outputable PromotionErr where ppr ClassPE = text "ClassPE" @@ -35,6 +36,7 @@ instance Outputable PromotionErr where ppr RecDataConPE = text "RecDataConPE" ppr NoDataKindsDC = text "NoDataKindsDC" ppr TermVariablePE = text "TermVariablePE" + ppr TypeVariablePE = text "TypeVariablePE" pprPECategory :: PromotionErr -> SDoc pprPECategory = text . capitalise . peCategory @@ -47,4 +49,47 @@ peCategory FamDataConPE = "data constructor" peCategory ConstrainedDataConPE{} = "data constructor" peCategory RecDataConPE = "data constructor" peCategory NoDataKindsDC = "data constructor" -peCategory TermVariablePE = "term variable" \ No newline at end of file +peCategory TermVariablePE = "term variable" +peCategory TypeVariablePE = "type variable" + + +{- +Note [Type variable scoping errors during type check] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider you have such function at the term level: + + -- f :: [forall b . Either b ()] + f = [Right @a @() () :: forall a. Either a ()] + +Here `@a` in the type application and `a` in the type signature are the same +type variable, so `forall a` introduces the type variable `a` in the +term context. This is a binder in the surface language. + +After elaboration in Core, the binder change would be changed to the +lambda abstraction: + + f = [(\@a -> Right @a @() ()) :: forall a . Either a ()] + +So, in Core, only lambda brings new variables into scope, not `forall`. +But how does this work with types? + + type F = '[Right @a @() () :: forall a. Either a ()] + +If we look at this through the prism of surface language, then `a` +should obviously be in the scope of `Right`, because that's what forall does. +But if we take elaboration into account things get trickier - +we need some sort of lambda in types to do such elaboration, +like this: + + type F = '[(/\ a . Right @a @() ()) :: forall a. Either a ()] -- Bogus + +Core has no such construct, so this is not a valid type. + +So, in the surface language `a` definitely IS in scope, and in the core language +`a` definitely IS NOT in scope - we can't add a new binder. + +The solution is to reject such programs at elaboration time, and this is where +`TypeVariablePE` comes in. We add forall'd type variables from the kind +signature with such a placeholder into the scope of the type-checker and report an +error with an explanation of the problem. +-} ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -1042,7 +1042,8 @@ tc_infer_hs_type mode (HsKindSig _ ty sig) -- things like instantiate its foralls, so it needs -- to be fully determined (#14904) ; traceTc "tc_infer_hs_type:sig" (ppr ty $$ ppr sig') - ; ty' <- tc_lhs_type mode ty sig' + ; ty' <- tcAddKindSigPlaceholders sig $ + tc_lhs_type mode ty sig' ; return (ty', sig') } -- HsSpliced is an annotation produced by 'GHC.Rename.Splice.rnSpliceType' to communicate ===================================== compiler/GHC/Tc/Types/BasicTypes.hs ===================================== @@ -497,4 +497,4 @@ tcTyThingCategory (AGlobal thing) = tyThingCategory thing tcTyThingCategory (ATyVar {}) = "type variable" tcTyThingCategory (ATcId {}) = "local identifier" tcTyThingCategory (ATcTyCon {}) = "local tycon" -tcTyThingCategory (APromotionErr pe) = peCategory pe \ No newline at end of file +tcTyThingCategory (APromotionErr pe) = peCategory pe ===================================== compiler/GHC/Tc/Utils/Env.hs ===================================== @@ -43,7 +43,7 @@ module GHC.Tc.Utils.Env( getInLocalScope, wrongThingErr, pprBinders, - tcAddDataFamConPlaceholders, tcAddPatSynPlaceholders, + tcAddDataFamConPlaceholders, tcAddPatSynPlaceholders, tcAddKindSigPlaceholders, getTypeSigNames, tcExtendRecEnv, -- For knot-tying @@ -705,6 +705,12 @@ tcAddPatSynPlaceholders pat_syns thing_inside | PSB{ psb_id = L _ name } <- pat_syns ] thing_inside +tcAddKindSigPlaceholders :: LHsKind GhcRn -> TcM a -> TcM a +tcAddKindSigPlaceholders kind_sig thing_inside + = tcExtendKindEnvList [ (name, APromotionErr TypeVariablePE) + | name <- hsScopedKiVs kind_sig ] + thing_inside + getTypeSigNames :: [LSig GhcRn] -> NameSet -- Get the names that have a user type sig getTypeSigNames sigs ===================================== testsuite/tests/rename/should_fail/T16635a.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE NoScopedTypeVariables, ExplicitForAll #-} +{-# LANGUAGE DataKinds, PolyKinds, TypeApplications #-} + +module T16635a where + +data Unit = U +data P a = MkP + +-- ScopedTypeVariables are disabled. +-- Fails because because @a is not in scope. +type F = (Just @a :: forall a. a -> Maybe a) U ===================================== testsuite/tests/rename/should_fail/T16635a.stderr ===================================== @@ -0,0 +1,3 @@ + +T16635a.hs:11:17: error: [GHC-76037] + Not in scope: type variable ‘a’ ===================================== testsuite/tests/rename/should_fail/T16635b.hs ===================================== @@ -0,0 +1,14 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE DataKinds, PolyKinds, TypeApplications #-} + +module T16635b where + +data Unit = U +data P a = MkP + +-- OK. +f = (Just @a :: forall a. a -> Maybe a) U + +-- Fails because we cannot generalize to (/\a. Just @a) +-- but NOT because @a is not in scope. +type F = (Just @a :: forall a. a -> Maybe a) U ===================================== testsuite/tests/rename/should_fail/T16635b.stderr ===================================== @@ -0,0 +1,7 @@ + +T16635b.hs:14:17: error: [GHC-88634] + • Type variable ‘a’ cannot be used here + (forall-bound variables cannot be used in kinds) + • In the first argument of ‘Just’, namely ‘a’ + In the type ‘(Just @a :: forall a. a -> Maybe a) U’ + In the type declaration for ‘F’ ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -198,3 +198,5 @@ test('RnUnexpectedStandaloneDeriving', normal, compile_fail, ['']) test('RnStupidThetaInGadt', normal, compile_fail, ['']) test('PackageImportsDisabled', normal, compile_fail, ['']) test('ImportLookupIllegal', normal, compile_fail, ['']) +test('T16635a', normal, compile_fail, ['']) +test('T16635b', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5e5df728a2ec82b6c5bc3d9d1fd0feb958e292a1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5e5df728a2ec82b6c5bc3d9d1fd0feb958e292a1 You're receiving 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 Jun 8 14:41:08 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 08 Jun 2023 10:41:08 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 14 commits: Update CODEOWNERS Message-ID: <6481e884420cb_226212c46e41227a7@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 8e44b3f1 by David Binder at 2023-06-08T10:40:35-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - CODEOWNERS - HACKING.md - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Solve.hs - compiler/GHC/Tc/Types/Constraint.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/tests/quantified-constraints/T23323.hs - testsuite/tests/quantified-constraints/all.T - 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 ===================================== @@ -141,7 +141,6 @@ data BuildConfig , llvmBootstrap :: Bool , withAssertions :: Bool , withNuma :: Bool - , withZstd :: Bool , crossTarget :: Maybe String , crossEmulator :: CrossEmulator , configureWrapper :: Maybe String @@ -155,11 +154,10 @@ 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 @@ -174,12 +172,8 @@ mkJobFlavour BuildConfig{..} = Flavour buildFlavour opts 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 @@ -198,7 +192,6 @@ vanilla = BuildConfig , llvmBootstrap = False , withAssertions = False , withNuma = False - , withZstd = False , crossTarget = Nothing , crossEmulator = NoEmulator , configureWrapper = Nothing @@ -231,9 +224,6 @@ debug = vanilla { buildFlavour = SlowValidate , withNuma = True } -zstdIpe :: BuildConfig -zstdIpe = vanilla { withZstd = True } - static :: BuildConfig static = vanilla { fullyStatic = True } @@ -323,18 +313,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) = base_string base ++ concatMap (("+" ++) . flavour_string) trans +flavourString (Flavour base trans) = baseString base ++ concatMap (("+" ++) . flavourString) trans where - base_string Release = "release" - base_string Validate = "validate" - base_string SlowValidate = "slow-validate" + baseString Release = "release" + baseString Validate = "validate" + baseString SlowValidate = "slow-validate" - 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 BootNonmovingGc = "boot_nonmoving_gc" + flavourString Llvm = "llvm" + flavourString Dwarf = "debug_info" + 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 @@ -527,7 +517,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 rulesList +enumRules o = map lkup rules where enabled_rules = rule_set o lkup r = OnOffRule (if S.member r enabled_rules then On else Off) r @@ -563,7 +553,6 @@ data Rule = FastCI -- ^ Run this job when the fast-ci label is set | 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. - | IpeData -- ^ Only run this job when the "IPE" label is set | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) @@ -590,14 +579,12 @@ 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 -rulesList :: [Rule] -rulesList = [minBound .. maxBound] +rules :: [Rule] +rules = [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 @@ -886,7 +873,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) zstdIpe) , -- Nightly allowed to fail: #22520 modifyNightlyJobs allowFailure (modifyValidateJobs manual tsan_jobs) @@ -894,7 +880,7 @@ job_groups = modifyNightlyJobs allowFailure (modifyValidateJobs manual (validateBuilds Amd64 (Linux Debian10) noTntc)) , addValidateRule LLVMBackend (validateBuilds Amd64 (Linux Debian10) llvm) - , addValidateRule IpeData (validateBuilds Amd64 (Linux Debian10) zstdIpe) + , 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\") && (\"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\") && (\"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\") && (\"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\") && (\"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\") && (\"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\") && (\"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\") && (\"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\") && (\"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\") && (\"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\") && (\"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" } ], @@ -641,7 +641,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -703,7 +703,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -765,7 +765,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -826,7 +826,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -887,7 +887,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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\") && (\"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" } ], @@ -1008,7 +1008,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1067,7 +1067,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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\") && (\"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" } ], @@ -1186,7 +1186,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1245,7 +1245,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1264,7 +1264,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "CONFIGURE_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -1304,7 +1304,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1363,7 +1363,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1422,7 +1422,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1483,7 +1483,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1544,7 +1544,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1606,7 +1606,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1665,7 +1665,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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 +1725,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1784,7 +1784,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1845,7 +1845,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1907,7 +1907,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -1968,7 +1968,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2028,7 +2028,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2087,7 +2087,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2142,7 +2142,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2201,7 +2201,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2264,7 +2264,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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 +2328,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2389,7 +2389,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2450,7 +2450,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2516,7 +2516,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2579,7 +2579,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2642,7 +2642,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2705,7 +2705,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2766,7 +2766,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2827,7 +2827,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2888,7 +2888,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -2949,7 +2949,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3011,7 +3011,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3072,7 +3072,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3135,7 +3135,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3198,7 +3198,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3261,7 +3261,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3322,7 +3322,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3383,7 +3383,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3440,7 +3440,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3500,7 +3500,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3564,7 +3564,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3628,7 +3628,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3688,7 +3688,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3749,7 +3749,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3810,7 +3810,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3871,7 +3871,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3931,7 +3931,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -3990,7 +3990,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -4048,7 +4048,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -4107,7 +4107,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -4130,64 +4130,6 @@ "TEST_ENV": "x86_64-linux-deb10-unreg-validate" } }, - "x86_64-linux-deb10-validate": { - "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.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\") && (\"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", - "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "--enable-ipe-data-compression", - "TEST_ENV": "x86_64-linux-deb10-validate" - } - }, "x86_64-linux-deb10-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -4223,7 +4165,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -4281,7 +4223,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -4340,7 +4282,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -4400,7 +4342,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -4460,7 +4402,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -4521,7 +4463,7 @@ ], "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\") && (\"true\" == \"true\")", + "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" } ], @@ -4580,7 +4522,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], @@ -4636,7 +4578,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"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" } ], ===================================== CODEOWNERS ===================================== @@ -36,6 +36,7 @@ /compiler/GHC/Rename/ @simonpj @rae /compiler/GHC/Types/ @simonpj @rae /compiler/GHC/HsToCore/ @simonpj @rae +/compiler/GHC/HsToCore/Pmc* @sgraf /compiler/GHC/Tc/Deriv/ @RyanGlScott /compiler/GHC/CmmToAsm/ @simonmar @bgamari @AndreasK /compiler/GHC/CmmToAsm/Wasm/ @TerrorJack @@ -43,13 +44,12 @@ /compiler/GHC/StgToCmm/ @simonmar @osa1 /compiler/GHC/Cmm/ @simonmar @osa1 /compiler/ghci/ @simonmar -/compiler/GHC/Core/Op/CallArity.hs @nomeata -/compiler/utils/UnVarGraph.hs @nomeata -/compiler/GHC/Core/Op/Exitify.hs @nomeata +/compiler/GHC/Core/Opt/CallArity.hs @nomeata +/compiler/GHC/Core/Opt/Exitify.hs @nomeata /compiler/GHC/Stg/CSE.hs @nomeata -/compiler/GHC/Stg/Lift.hs @sgraf +/compiler/GHC/Stg/Lift* @sgraf /compiler/GHC/Cmm/Switch.hs @nomeata -/compiler/GHC/Core/Op/DmdAnal.hs @simonpj @sgraf +/compiler/GHC/Core/Opt/ @simonpj @sgraf /compiler/GHC/ThToHs.hs @rae /compiler/GHC/Wasm/ @nrnrnr ===================================== HACKING.md ===================================== @@ -23,47 +23,15 @@ Contributing patches to GHC in a hurry ====================================== Make sure your system has the necessary tools to compile GHC. You can -find an overview here: +find an overview of how to prepare your system for compiling GHC here: -Next, clone the repository and all the associated libraries: +After you have prepared your system, you can build GHC following the instructions described here: -``` -$ git clone --recursive git at gitlab.haskell.org:ghc/ghc.git -``` + -On Windows, you need an extra repository containing some build tools. -These can be downloaded for you by `configure`. This only needs to be done once by running: - -``` -$ ./configure --enable-tarballs-autodownload -``` - -First copy `mk/build.mk.sample` to `mk/build.mk` and ensure it has -your preferred build settings. (You probably want to at least set -`BuildFlavour` to `quick`): - -``` -$ cp mk/build.mk.sample mk/build.mk -$ ... double-check mk/build.mk ... -``` - -Now build. The convenient `validate` script will build the tree in a way which -is both quick to build and consistent with our testsuite: - -``` -$ ./validate --build-only -``` - -You can use the `_validatebuild/stage1/bin/ghc` binary to play with the -newly built compiler. - -Now, hack on your copy and rebuild (with `make`) as necessary. - -Then start by making your commits however you want. When you're done, you can submit -a pull request on Github for small changes. For larger changes the patch needs to be -submitted to [GitLab](https://gitlab.haskell.org/ghc/ghc/merge_requests) for code review. +Then start by making your commits however you want. When you're done, you can submit a merge request to [GitLab](https://gitlab.haskell.org/ghc/ghc/merge_requests) for code review. Changes to the `base` library require a proposal to the [core libraries committee](https://github.com/haskell/core-libraries-committee/issues). The GHC Wiki has a good summary for the [overall process](https://gitlab.haskell.org/ghc/ghc/wikis/working-conventions/fixing-bugs). One or several reviewers will review your PR, and when they are ok with your changes, they will assign the PR to [Marge Bot](https://gitlab.haskell.org/marge-bot) which will automatically rebase, batch and then merge your PR (assuming the build passes). ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -1,188 +1,67 @@ -{-# 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.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, unpackFS, LexicalFastString(..)) -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. - -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 :: Module + -> [InfoProvEnt] + -> FCode () emitIpeBufferListNode _ [] = return () emitIpeBufferListNode this_mod ents = do cfg <- getStgToCmmConfig - - tables_lbl <- mkStringLitLabel <$> newUnique - strings_lbl <- mkStringLitLabel <$> newUnique - entries_lbl <- mkStringLitLabel <$> newUnique - - let ctx = stgToCmmContext cfg + 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 - - 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 + 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 toCgIPE :: Platform -> SDocContext -> StrTabOffset -> InfoProvEnt -> State StringTable CgInfoProvEnt toCgIPE platform ctx module_name ipe = do @@ -198,7 +77,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 @@ -226,7 +105,7 @@ data StringTable = StringTable { stStrings :: DList ShortText , stLookup :: !(M.Map ShortText StrTabOffset) } -type StrTabOffset = Word32 +newtype StrTabOffset = StrTabOffset Int emptyStringTable :: StringTable emptyStringTable = @@ -251,50 +130,9 @@ lookupStringTable str = state $ \st -> , stLength = stLength st + ST.byteLength str + 1 , stLookup = M.insert str res (stLookup st) } - res = fromIntegral (stLength st) + res = StrTabOffset (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/Tc/Errors.hs ===================================== @@ -352,8 +352,9 @@ reportImplic ctxt implic@(Implic { ic_skols = tvs -- Do /not/ use the tidied tvs because then are in the -- wrong order, so tidying will rename things wrongly ; reportWanteds ctxt' tc_lvl wanted - ; when (cec_warn_redundant ctxt) $ - warnRedundantConstraints ctxt' ct_loc_env info' dead_givens } + + -- Report redundant (unused) constraints + ; warnRedundantConstraints ctxt' ct_loc_env info' dead_givens } where insoluble = isInsolubleStatus status (env1, tvs') = tidyVarBndrs (cec_tidy ctxt) $ @@ -390,9 +391,19 @@ reportImplic ctxt implic@(Implic { ic_skols = tvs warnRedundantConstraints :: SolverReportErrCtxt -> CtLocEnv -> SkolemInfoAnon -> [EvVar] -> TcM () -- See Note [Tracking redundant constraints] in GHC.Tc.Solver warnRedundantConstraints ctxt env info redundant_evs + | not (cec_warn_redundant ctxt) + = return () + | null redundant_evs = return () + -- Do not report redundant constraints for quantified constraints + -- See (RC4) in Note [Tracking redundant constraints] + -- Fortunately it is easy to spot implications constraints that arise + -- from quantified constraints, from their SkolInfo + | InstSkol (IsQC {}) _ <- info + = return () + | SigSkol user_ctxt _ _ <- info -- When dealing with a user-written type signature, -- we want to add "In the type signature for f". @@ -404,7 +415,7 @@ warnRedundantConstraints ctxt env info redundant_evs -- "In the instance declaration for Eq [a]" context -- and we don't want to say it twice. Seems a bit ad-hoc = report_redundant_msg False env - -- ^^^^^ don't add "In the type signature..." + -- ^^^^^ don't add "In the type signature..." where report_redundant_msg :: Bool -- whether to add "In the type signature..." to the diagnostic -> CtLocEnv ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -3228,39 +3228,54 @@ others). ----- How tracking works -* When two Givens are the same, we drop the evidence for the one +(RC1) When two Givens are the same, we drop the evidence for the one that requires more superclass selectors. This is done - according to Note [Replacement vs keeping] in GHC.Tc.Solver.InertSet. + according to 2(c) of Note [Replacement vs keeping] in GHC.Tc.Solver.InertSet. -* The ic_need fields of an Implic records in-scope (given) evidence +(RC2) The ic_need fields of an Implic records in-scope (given) evidence variables bound by the context, that were needed to solve this implication (so far). See the declaration of Implication. -* When the constraint solver finishes solving all the wanteds in +(RC3) setImplicationStatus: + When the constraint solver finishes solving all the wanteds in an implication, it sets its status to IC_Solved - The ics_dead field, of IC_Solved, records the subset of this implication's ic_given that are redundant (not needed). -* We compute which evidence variables are needed by an implication - in setImplicationStatus. A variable is needed if + - We compute which evidence variables are needed by an implication + in setImplicationStatus. A variable is needed if a) it is free in the RHS of a Wanted EvBind, b) it is free in the RHS of an EvBind whose LHS is needed, or c) it is in the ics_need of a nested implication. -* After computing which variables are needed, we then look at the - remaining variables for internal redundancies. This is case (b) - from above. This is also done in setImplicationStatus. - Note that we only look for case (b) if case (a) shows up empty, - as exemplified below. - -* We need to be careful not to discard an implication - prematurely, even one that is fully solved, because we might - thereby forget which variables it needs, and hence wrongly - report a constraint as redundant. But we can discard it once - its free vars have been incorporated into its parent; or if it - simply has no free vars. This careful discarding is also - handled in setImplicationStatus. + - After computing which variables are needed, we then look at the + remaining variables for internal redundancies. This is case (b) + from above. This is also done in setImplicationStatus. + Note that we only look for case (b) if case (a) shows up empty, + as exemplified below. + + - We need to be careful not to discard an implication + prematurely, even one that is fully solved, because we might + thereby forget which variables it needs, and hence wrongly + report a constraint as redundant. But we can discard it once + its free vars have been incorporated into its parent; or if it + simply has no free vars. This careful discarding is also + handled in setImplicationStatus. + +(RC4) We do not want to report redundant constraints for implications + that come from quantified constraints. Example #23323: + data T a + instance Show (T a) where ... -- No context! + foo :: forall f c. (forall a. c a => Show (f a)) => Proxy c -> f Int -> Int + bar = foo @T @Eq + + The call to `foo` gives us + [W] d : (forall a. Eq a => Show (T a)) + To solve this, GHC.Tc.Solver.Solve.solveForAll makes an implication constraint: + forall a. Eq a => [W] ds : Show (T a) + and because of the degnerate instance for `Show (T a)`, we don't need the `Eq a` + constraint. But we don't want to report it as redundant! * Examples: ===================================== compiler/GHC/Tc/Solver/Solve.hs ===================================== @@ -425,8 +425,7 @@ solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_lo ; return ( ctEvEvId wanted_ev , unitBag (mkNonCanonical wanted_ev)) } - ; ev_binds <- emitImplicationTcS lvl (getSkolemInfo skol_info) skol_tvs - given_ev_vars wanteds + ; ev_binds <- emitImplicationTcS lvl skol_info_anon skol_tvs given_ev_vars wanteds ; setWantedEvTerm dest IsCoherent $ EvFun { et_tvs = skol_tvs, et_given = given_ev_vars ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -1479,6 +1479,7 @@ data Implication -- NB: including stuff used by nested implications that have since -- been discarded -- See Note [Needed evidence variables] + -- and (RC2) in Note [Tracking redundant constraints]a ic_need_inner :: VarSet, -- Includes all used Given evidence ic_need_outer :: VarSet, -- Includes only the free Given evidence -- i.e. ic_need_inner after deleting ===================================== compiler/ghc.cabal.in ===================================== @@ -57,10 +57,6 @@ Flag build-tool-depends Description: Use build-tool-depends Default: True -Flag with-libzstd - Default: False - Manual: True - -- While the boot compiler fixes ghc's unit-id to `ghc`, the stage0 compiler must still be compiled with `-this-unit-id ghc` Flag hadrian-stage0 Description: Enable if compiling the stage0 compiler with hadrian @@ -81,10 +77,6 @@ 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 ===================================== @@ -1105,10 +1105,6 @@ 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 @@ -1254,17 +1250,6 @@ 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 ===================================== @@ -128,17 +128,6 @@ Compiler GHC used to accept the contradictory ``Int~Bool`` in the type signature, but reject the ``Int~Bool`` constraint that arises from typechecking the definition itself. Now it accepts both. More details in `GHC ticket #23413 `_, which gives examples of the previous inconsistency. GHC now implements the "PermissivePlan" described in that ticket. -- 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,23 +370,9 @@ 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`. - 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. + 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. .. ghc-flag:: -fdistinct-constructor-tables :shortdesc: Generate a fresh info table for each usage ===================================== hadrian/cfg/system.config.in ===================================== @@ -199,14 +199,10 @@ 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,7 +35,6 @@ data Flag = ArSupportsAtFile | UseLibffiForAdjustors | UseLibdw | UseLibnuma - | UseLibzstd | UseLibm | UseLibrt | UseLibdl @@ -66,7 +65,6 @@ 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,8 +60,6 @@ data Setting = BuildArch | LibdwLibDir | LibnumaIncludeDir | LibnumaLibDir - | LibZstdIncludeDir - | LibZstdLibDir | LlvmTarget | ProjectGitCommitId | ProjectName @@ -163,8 +161,6 @@ 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 ===================================== @@ -316,7 +316,6 @@ 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 ===================================== @@ -74,7 +74,6 @@ packageArgs = do [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" , notM cross `cabalFlag` "terminfo" , arg "-build-tool-depends" - , flag UseLibzstd `cabalFlag` "with-libzstd" -- ROMES: While the boot compiler is not updated wrt -this-unit-id -- not being fixed to `ghc`, when building stage0, we must set -- -this-unit-id to `ghc` because the boot compiler expects that. @@ -289,8 +288,6 @@ 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 @@ -397,7 +394,6 @@ 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" = "yes" ; then + if test "$enable_numa" != "no" ; 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 "$HaveLibNuma" = "0" ; then + if test "$enable_numa:$HaveLibNuma" = "yes:0" ; then AC_MSG_ERROR([Cannot find system libnuma (required by --enable-numa)]) fi ===================================== m4/fp_find_libzstd.m4 deleted ===================================== @@ -1,79 +0,0 @@ -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,10 +20,6 @@ #include #include -#if HAVE_LIBZSTD == 1 -#include -#endif - #if defined(TRACING) #include "Trace.h" #endif @@ -40,9 +36,8 @@ 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 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. +contains an array of IPE entries 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 @@ -82,23 +77,23 @@ void exitIpe(void) { } #endif // THREADED_RTS -static InfoProvEnt ipeBufferEntryToIpe(const char *strings, const StgInfoTable *tbl, const IpeBufferEntry ent) +static InfoProvEnt ipeBufferEntryToIpe(const IpeBufferListNode *node, const IpeBufferEntry *ent) { + const char *strings = node->string_table; return (InfoProvEnt) { - .info = tbl, + .info = ent->info, .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) { @@ -110,18 +105,8 @@ 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( - strings, - cursor->tables[i], - entries[i] - ); + const InfoProvEnt ent = ipeBufferEntryToIpe(cursor, &cursor->entries[i]); traceIPE(&ent); } cursor = cursor->next; @@ -135,7 +120,6 @@ void dumpIPEToEventLog(void) { RELEASE_LOCK(&ipeMapLock); } - #else void dumpIPEToEventLog(void) { } @@ -185,84 +169,16 @@ void updateIpeMap() { } while (pending != NULL) { - 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]); + 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]); } - pending = current_node->next; + pending = currentNode->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 == 1) { - // 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,6 +17,5 @@ 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,6 +52,9 @@ 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; @@ -66,23 +69,10 @@ 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 - - // This flag should be treated as a boolean - StgWord compressed; - + const char *string_table; StgWord count; - - // 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 + IpeBufferEntry entries[]; } IpeBufferListNode; void registerInfoProvList(IpeBufferListNode *node); ===================================== rts/rts.cabal.in ===================================== @@ -45,8 +45,6 @@ flag libdw default: @CabalHaveLibdw@ flag libnuma default: @CabalHaveLibNuma@ -flag libzstd - default: @CabalHaveLibZstd@ flag leading-underscore default: @CabalLeadingUnderscore@ flag smp @@ -213,8 +211,6 @@ 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/quantified-constraints/T23323.hs ===================================== @@ -0,0 +1,17 @@ +{-# OPTIONS_GHC -Werror -Wredundant-constraints #-} +{-# LANGUAGE QuantifiedConstraints, TypeApplications, UndecidableInstances #-} + +module Lib where + +import Data.Kind +import Data.Proxy + +data T a +instance Show (T a) where { show x = "no" } + +foo :: forall f c. (forall a. c a => Show (f a)) => Proxy c -> f Int -> Int +foo = foo + +bar = foo @T @Eq +-- We dont' want to report a redundance (Eq a) constraint + ===================================== testsuite/tests/quantified-constraints/all.T ===================================== @@ -42,3 +42,4 @@ test('T22216e', normal, compile, ['']) test('T22223', normal, compile, ['']) test('T19690', normal, compile_fail, ['']) test('T23333', normal, compile, ['']) +test('T23323', normal, compile, ['']) ===================================== 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->tables[0]); + lookupIPE(list1->entries[0].info); // Trace all IPE events. dumpIPEToEventLog(); ===================================== testsuite/tests/rts/ipe/ipeMap.c ===================================== @@ -40,23 +40,15 @@ void shouldFindNothingInAnEmptyIPEMap(Capability *cap) { } HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) { - // Allocate buffers for IPE buffer list node - IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); - node->tables = malloc(sizeof(StgInfoTable *)); - node->entries = malloc(sizeof(IpeBufferEntry)); - + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + sizeof(IpeBufferEntry)); StringTable st; init_string_table(&st); HaskellObj fortyTwo = UNTAG_CLOSURE(rts_mkInt(cap, 42)); - node->next = NULL; - node->compressed = 0; + node->entries[0] = makeAnyProvEntry(cap, &st, fortyTwo, 42); node->count = 1; - node->tables[0] = get_itbl(fortyTwo); - node->entries[0] = makeAnyProvEntry(cap, &st, 42); - node->entries_size = sizeof(IpeBufferEntry); + node->next = NULL; node->string_table = st.buffer; - node->string_table_size = st.size; registerInfoProvList(node); @@ -80,23 +72,15 @@ HaskellObj shouldFindOneIfItHasBeenRegistered(Capability *cap) { void shouldFindTwoIfTwoHaveBeenRegistered(Capability *cap, HaskellObj fortyTwo) { - // Allocate buffers for IPE buffer list node - IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); - node->tables = malloc(sizeof(StgInfoTable *)); - node->entries = malloc(sizeof(IpeBufferEntry)); - + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + sizeof(IpeBufferEntry)); StringTable st; init_string_table(&st); HaskellObj twentyThree = UNTAG_CLOSURE(rts_mkInt8(cap, 23)); - node->next = NULL; - node->compressed = 0; + node->entries[0] = makeAnyProvEntry(cap, &st, twentyThree, 23); node->count = 1; - node->tables[0] = get_itbl(twentyThree); - node->entries[0] = makeAnyProvEntry(cap, &st, 23); - node->entries_size = sizeof(IpeBufferEntry); + node->next = NULL; node->string_table = st.buffer; - node->string_table_size = st.size; registerInfoProvList(node); @@ -119,26 +103,17 @@ void shouldFindTwoIfTwoHaveBeenRegistered(Capability *cap, } void shouldFindTwoFromTheSameList(Capability *cap) { - // Allocate buffers for IPE buffer list node - IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); - node->tables = malloc(sizeof(StgInfoTable *) * 2); - node->entries = malloc(sizeof(IpeBufferEntry) * 2); - + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + 2 * sizeof(IpeBufferEntry)); StringTable st; init_string_table(&st); HaskellObj one = UNTAG_CLOSURE(rts_mkInt16(cap, 1)); HaskellObj two = UNTAG_CLOSURE(rts_mkInt32(cap, 2)); - node->next = NULL; - node->compressed = 0; + node->entries[0] = makeAnyProvEntry(cap, &st, one, 1); + node->entries[1] = makeAnyProvEntry(cap, &st, two, 2); 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->next = NULL; node->string_table = st.buffer; - node->string_table_size = st.size; registerInfoProvList(node); ===================================== testsuite/tests/rts/ipe/ipe_lib.c ===================================== @@ -25,8 +25,9 @@ uint32_t add_string(StringTable *st, const char *s) { return n; } -IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, int i) { +IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, HaskellObj closure, 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); @@ -68,27 +69,15 @@ IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, int i) { IpeBufferListNode *makeAnyProvEntries(Capability *cap, int start, int end) { const int n = end - start; - - // Allocate buffers for IpeBufferListNode - IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode)); - node->tables = malloc(sizeof(StgInfoTable *) * n); - node->entries = malloc(sizeof(IpeBufferEntry) * n); - + IpeBufferListNode *node = malloc(sizeof(IpeBufferListNode) + n * sizeof(IpeBufferEntry)); 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->tables[i] = get_itbl(closure); - node->entries[i] = makeAnyProvEntry(cap, &st, i); + node->entries[i] = makeAnyProvEntry(cap, &st, closure, 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, int i); +IpeBufferEntry makeAnyProvEntry(Capability *cap, StringTable *st, HaskellObj closure, int i); void dumpIPEToEventLog(void); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/06112cd19dafdd9b68b1bb28fb93a823883b6456...8e44b3f11af040fcabd7453cdbe3e5e0e34165ff -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/06112cd19dafdd9b68b1bb28fb93a823883b6456...8e44b3f11af040fcabd7453cdbe3e5e0e34165ff You're receiving 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 Jun 8 22:21:16 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Thu, 08 Jun 2023 18:21:16 -0400 Subject: [Git][ghc/ghc][wip/haddock-mem-fixes] 34 commits: cleanup: Remove unused field from SelfBoot Message-ID: <6482545c54f09_226212c470c2009ac@gitlab.mail> Finley McIlwaine pushed to branch wip/haddock-mem-fixes at Glasgow Haskell Compiler / GHC Commits: f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 890ed046 by Finley McIlwaine at 2023-06-08T15:49:54-06:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` - - - - - b3bdefad by Finley McIlwaine at 2023-06-08T15:52:58-06:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 7ea070f1 by Finley McIlwaine at 2023-06-08T16:20:45-06:00 Bump haddock submodule - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - compiler/GHC/Builtin/Names/TH.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/JS/Make.hs - compiler/GHC/JS/Optimizer.hs - compiler/GHC/JS/Ppr.hs - compiler/GHC/Parser/Errors/Ppr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fbe48eed0b24187823844fbe6eb9ec08cdf615bf...7ea070f1d4771fdb13fa0b83f0bea9d1be7aac76 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fbe48eed0b24187823844fbe6eb9ec08cdf615bf...7ea070f1d4771fdb13fa0b83f0bea9d1be7aac76 You're receiving 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 Jun 8 22:27:18 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Thu, 08 Jun 2023 18:27:18 -0400 Subject: [Git][ghc/ghc][wip/haddock-mem-fixes] 3 commits: Memory usage fixes for Haddock Message-ID: <648255c67a0ac_226212c47342047f8@gitlab.mail> Finley McIlwaine pushed to branch wip/haddock-mem-fixes at Glasgow Haskell Compiler / GHC Commits: 0887aa3e by Finley McIlwaine at 2023-06-08T16:26:19-06:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` - - - - - e55d7d1f by Finley McIlwaine at 2023-06-08T16:26:41-06:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - f8fe1858 by Finley McIlwaine at 2023-06-08T16:26:41-06:00 Bump haddock submodule - - - - - 6 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/HsToCore/Docs.hs - testsuite/tests/haddock/perf/Fold.hs - testsuite/tests/haddock/perf/Makefile - utils/haddock Changes: ===================================== compiler/GHC/Driver/Backend.hs ===================================== @@ -551,17 +551,14 @@ backendRespectsSpecialise (Named NoBackend) = False -- | This back end wants the `mi_globals` field of a -- `ModIface` to be populated (with the top-level bindings --- of the original source). True for the interpreter, and --- also true for "no backend", which is used by Haddock. --- (After typechecking a module, Haddock wants access to --- the module's `GlobalRdrEnv`.) +-- of the original source). Only true for the interpreter. backendWantsGlobalBindings :: Backend -> Bool backendWantsGlobalBindings (Named NCG) = False backendWantsGlobalBindings (Named LLVM) = False backendWantsGlobalBindings (Named ViaC) = False backendWantsGlobalBindings (Named JavaScript) = False +backendWantsGlobalBindings (Named NoBackend) = False backendWantsGlobalBindings (Named Interpreter) = True -backendWantsGlobalBindings (Named NoBackend) = True -- | The back end targets a technology that implements -- `switch` natively. (For example, LLVM or C.) Therefore ===================================== compiler/GHC/Hs/Doc.hs ===================================== @@ -123,7 +123,7 @@ type LHsDoc pass = Located (HsDoc pass) data DocStructureItem = DsiSectionHeading !Int !(HsDoc GhcRn) | DsiDocChunk !(HsDoc GhcRn) - | DsiNamedChunkRef !(String) + | DsiNamedChunkRef !String | DsiExports !Avails | DsiModExport !(NonEmpty ModuleName) -- ^ We might re-export avails from multiple ===================================== compiler/GHC/HsToCore/Docs.hs ===================================== @@ -31,18 +31,18 @@ import Data.Bifunctor (first) import Data.Foldable (toList) import Data.IntMap (IntMap) import qualified Data.IntMap as IM +import qualified Data.List.NonEmpty as NonEmpty +import Data.List.NonEmpty (NonEmpty ((:|))) import Data.Map.Strict (Map) import qualified Data.Map as M -import qualified Data.Set as Set import Data.Maybe +import qualified Data.Set as Set import Data.Semigroup import GHC.IORef (readIORef) import GHC.Unit.Types import GHC.Hs import GHC.Types.Avail import GHC.Unit.Module -import qualified Data.List.NonEmpty as NonEmpty -import Data.List.NonEmpty (NonEmpty ((:|))) import GHC.Unit.Module.Imported import GHC.Driver.DynFlags import GHC.Types.TypeEnv @@ -192,7 +192,13 @@ mkDocStructureFromDecls env all_exports decls = Just loc -> L loc (DsiExports [avail]) -- FIXME: This is just a workaround that we use when handling e.g. -- associated data families like in the html-test Instances.hs. - Nothing -> noLoc (DsiExports [avail]) + Nothing -> noLoc (DsiExports []) + + -- This causes the associated data family to be incorrectly documented + -- separately from its class: + -- Nothing -> noLoc (DsiExports [avail]) + + -- This panics on the associated data family: -- Nothing -> panicDoc "mkDocStructureFromDecls: No loc found for" -- (ppr avail) ===================================== testsuite/tests/haddock/perf/Fold.hs ===================================== @@ -143,6 +143,7 @@ import Prelude import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NonEmpty import Control.Monad as Monad +import Control.Monad.Fix import Control.Monad.Reader import qualified Control.Monad.Reader as Reader import Data.Functor ===================================== testsuite/tests/haddock/perf/Makefile ===================================== @@ -4,12 +4,12 @@ include $(TOP)/mk/test.mk # We accept a 5% increase in parser allocations due to -haddock haddock_parser_perf : - WithHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fforce-recomp -Wno-all -ddump-timings -haddock -O0 Fold.hs 2>/dev/null | grep Parser | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ - WithoutHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fforce-recomp -Wno-all -ddump-timings -O0 Fold.hs 2>/dev/null | grep Parser | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ + WithHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface -fforce-recomp -Wno-all -ddump-timings -haddock -O0 Fold.hs 2>/dev/null | grep Parser | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ + WithoutHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface -fforce-recomp -Wno-all -ddump-timings -O0 Fold.hs 2>/dev/null | grep Parser | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ awk "BEGIN { ratio = ($$WithHaddock / $$WithoutHaddock); if (ratio > 1.05) {print \"-haddock allocation ratio too high:\", ratio; exit 1} else {exit 0} }" # Similarly for the renamer haddock_renamer_perf : - WithoutHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fforce-recomp -Wno-all -ddump-timings -O0 Fold.hs 2>/dev/null | grep Renamer | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ - WithHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fforce-recomp -Wno-all -ddump-timings -haddock -O0 Fold.hs 2>/dev/null | grep Renamer | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ - awk "BEGIN { ratio = ($$WithHaddock / $$WithoutHaddock); if (ratio > 1.20) {print \"-haddock allocation ratio too high:\", ratio; exit 1} else {exit 0} }" + WithoutHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface -fforce-recomp -Wno-all -ddump-timings -O0 Fold.hs 2>/dev/null | grep Renamer | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ + WithHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface -fforce-recomp -Wno-all -ddump-timings -haddock -O0 Fold.hs 2>/dev/null | grep Renamer | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ + awk "BEGIN { ratio = ($$WithHaddock / $$WithoutHaddock); if (ratio > 1.05) {print \"-haddock allocation ratio too high:\", ratio; exit 1} else {exit 0} }" ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 30cf825972c53d97d6add9aa0e61bcb32ccc3ad1 +Subproject commit 61b0845b3e3268b469db8bb20fd3d19118453727 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7ea070f1d4771fdb13fa0b83f0bea9d1be7aac76...f8fe18581bfb1edc86444ced1ac44fcd70c50a86 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7ea070f1d4771fdb13fa0b83f0bea9d1be7aac76...f8fe18581bfb1edc86444ced1ac44fcd70c50a86 You're receiving 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 Jun 8 22:33:49 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Thu, 08 Jun 2023 18:33:49 -0400 Subject: [Git][ghc/ghc][wip/haddock-mem-fixes] 2 commits: Fix associated data family doc structure items Message-ID: <6482574d78273_226212c46bc205175@gitlab.mail> Finley McIlwaine pushed to branch wip/haddock-mem-fixes at Glasgow Haskell Compiler / GHC Commits: 2f9e52da by Finley McIlwaine at 2023-06-08T16:33:23-06:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 048b3f35 by Finley McIlwaine at 2023-06-08T16:33:38-06:00 Bump haddock submodule - - - - - 3 changed files: - compiler/GHC/Hs/Doc.hs - compiler/GHC/HsToCore/Docs.hs - utils/haddock Changes: ===================================== compiler/GHC/Hs/Doc.hs ===================================== @@ -123,7 +123,7 @@ type LHsDoc pass = Located (HsDoc pass) data DocStructureItem = DsiSectionHeading !Int !(HsDoc GhcRn) | DsiDocChunk !(HsDoc GhcRn) - | DsiNamedChunkRef !(String) + | DsiNamedChunkRef !String | DsiExports !Avails | DsiModExport !(NonEmpty ModuleName) -- ^ We might re-export avails from multiple ===================================== compiler/GHC/HsToCore/Docs.hs ===================================== @@ -192,7 +192,13 @@ mkDocStructureFromDecls env all_exports decls = Just loc -> L loc (DsiExports [avail]) -- FIXME: This is just a workaround that we use when handling e.g. -- associated data families like in the html-test Instances.hs. - Nothing -> noLoc (DsiExports [avail]) + Nothing -> noLoc (DsiExports []) + + -- This causes the associated data family to be incorrectly documented + -- separately from its class: + -- Nothing -> noLoc (DsiExports [avail]) + + -- This panics on the associated data family: -- Nothing -> panicDoc "mkDocStructureFromDecls: No loc found for" -- (ppr avail) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 30cf825972c53d97d6add9aa0e61bcb32ccc3ad1 +Subproject commit 61b0845b3e3268b469db8bb20fd3d19118453727 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f8fe18581bfb1edc86444ced1ac44fcd70c50a86...048b3f35b22060c584d2b2ba5cc1303af3ab2f0f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f8fe18581bfb1edc86444ced1ac44fcd70c50a86...048b3f35b22060c584d2b2ba5cc1303af3ab2f0f You're receiving 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 Jun 8 22:41:08 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 08 Jun 2023 18:41:08 -0400 Subject: [Git][ghc/ghc][master] Don't report redundant Givens from quantified constraints Message-ID: <648259041eaf1_226212c46e42118c1@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 6 changed files: - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Solve.hs - compiler/GHC/Tc/Types/Constraint.hs - + testsuite/tests/quantified-constraints/T23323.hs - testsuite/tests/quantified-constraints/all.T Changes: ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -352,8 +352,9 @@ reportImplic ctxt implic@(Implic { ic_skols = tvs -- Do /not/ use the tidied tvs because then are in the -- wrong order, so tidying will rename things wrongly ; reportWanteds ctxt' tc_lvl wanted - ; when (cec_warn_redundant ctxt) $ - warnRedundantConstraints ctxt' ct_loc_env info' dead_givens } + + -- Report redundant (unused) constraints + ; warnRedundantConstraints ctxt' ct_loc_env info' dead_givens } where insoluble = isInsolubleStatus status (env1, tvs') = tidyVarBndrs (cec_tidy ctxt) $ @@ -390,9 +391,19 @@ reportImplic ctxt implic@(Implic { ic_skols = tvs warnRedundantConstraints :: SolverReportErrCtxt -> CtLocEnv -> SkolemInfoAnon -> [EvVar] -> TcM () -- See Note [Tracking redundant constraints] in GHC.Tc.Solver warnRedundantConstraints ctxt env info redundant_evs + | not (cec_warn_redundant ctxt) + = return () + | null redundant_evs = return () + -- Do not report redundant constraints for quantified constraints + -- See (RC4) in Note [Tracking redundant constraints] + -- Fortunately it is easy to spot implications constraints that arise + -- from quantified constraints, from their SkolInfo + | InstSkol (IsQC {}) _ <- info + = return () + | SigSkol user_ctxt _ _ <- info -- When dealing with a user-written type signature, -- we want to add "In the type signature for f". @@ -404,7 +415,7 @@ warnRedundantConstraints ctxt env info redundant_evs -- "In the instance declaration for Eq [a]" context -- and we don't want to say it twice. Seems a bit ad-hoc = report_redundant_msg False env - -- ^^^^^ don't add "In the type signature..." + -- ^^^^^ don't add "In the type signature..." where report_redundant_msg :: Bool -- whether to add "In the type signature..." to the diagnostic -> CtLocEnv ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -3228,39 +3228,54 @@ others). ----- How tracking works -* When two Givens are the same, we drop the evidence for the one +(RC1) When two Givens are the same, we drop the evidence for the one that requires more superclass selectors. This is done - according to Note [Replacement vs keeping] in GHC.Tc.Solver.InertSet. + according to 2(c) of Note [Replacement vs keeping] in GHC.Tc.Solver.InertSet. -* The ic_need fields of an Implic records in-scope (given) evidence +(RC2) The ic_need fields of an Implic records in-scope (given) evidence variables bound by the context, that were needed to solve this implication (so far). See the declaration of Implication. -* When the constraint solver finishes solving all the wanteds in +(RC3) setImplicationStatus: + When the constraint solver finishes solving all the wanteds in an implication, it sets its status to IC_Solved - The ics_dead field, of IC_Solved, records the subset of this implication's ic_given that are redundant (not needed). -* We compute which evidence variables are needed by an implication - in setImplicationStatus. A variable is needed if + - We compute which evidence variables are needed by an implication + in setImplicationStatus. A variable is needed if a) it is free in the RHS of a Wanted EvBind, b) it is free in the RHS of an EvBind whose LHS is needed, or c) it is in the ics_need of a nested implication. -* After computing which variables are needed, we then look at the - remaining variables for internal redundancies. This is case (b) - from above. This is also done in setImplicationStatus. - Note that we only look for case (b) if case (a) shows up empty, - as exemplified below. - -* We need to be careful not to discard an implication - prematurely, even one that is fully solved, because we might - thereby forget which variables it needs, and hence wrongly - report a constraint as redundant. But we can discard it once - its free vars have been incorporated into its parent; or if it - simply has no free vars. This careful discarding is also - handled in setImplicationStatus. + - After computing which variables are needed, we then look at the + remaining variables for internal redundancies. This is case (b) + from above. This is also done in setImplicationStatus. + Note that we only look for case (b) if case (a) shows up empty, + as exemplified below. + + - We need to be careful not to discard an implication + prematurely, even one that is fully solved, because we might + thereby forget which variables it needs, and hence wrongly + report a constraint as redundant. But we can discard it once + its free vars have been incorporated into its parent; or if it + simply has no free vars. This careful discarding is also + handled in setImplicationStatus. + +(RC4) We do not want to report redundant constraints for implications + that come from quantified constraints. Example #23323: + data T a + instance Show (T a) where ... -- No context! + foo :: forall f c. (forall a. c a => Show (f a)) => Proxy c -> f Int -> Int + bar = foo @T @Eq + + The call to `foo` gives us + [W] d : (forall a. Eq a => Show (T a)) + To solve this, GHC.Tc.Solver.Solve.solveForAll makes an implication constraint: + forall a. Eq a => [W] ds : Show (T a) + and because of the degnerate instance for `Show (T a)`, we don't need the `Eq a` + constraint. But we don't want to report it as redundant! * Examples: ===================================== compiler/GHC/Tc/Solver/Solve.hs ===================================== @@ -425,8 +425,7 @@ solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_lo ; return ( ctEvEvId wanted_ev , unitBag (mkNonCanonical wanted_ev)) } - ; ev_binds <- emitImplicationTcS lvl (getSkolemInfo skol_info) skol_tvs - given_ev_vars wanteds + ; ev_binds <- emitImplicationTcS lvl skol_info_anon skol_tvs given_ev_vars wanteds ; setWantedEvTerm dest IsCoherent $ EvFun { et_tvs = skol_tvs, et_given = given_ev_vars ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -1479,6 +1479,7 @@ data Implication -- NB: including stuff used by nested implications that have since -- been discarded -- See Note [Needed evidence variables] + -- and (RC2) in Note [Tracking redundant constraints]a ic_need_inner :: VarSet, -- Includes all used Given evidence ic_need_outer :: VarSet, -- Includes only the free Given evidence -- i.e. ic_need_inner after deleting ===================================== testsuite/tests/quantified-constraints/T23323.hs ===================================== @@ -0,0 +1,17 @@ +{-# OPTIONS_GHC -Werror -Wredundant-constraints #-} +{-# LANGUAGE QuantifiedConstraints, TypeApplications, UndecidableInstances #-} + +module Lib where + +import Data.Kind +import Data.Proxy + +data T a +instance Show (T a) where { show x = "no" } + +foo :: forall f c. (forall a. c a => Show (f a)) => Proxy c -> f Int -> Int +foo = foo + +bar = foo @T @Eq +-- We dont' want to report a redundance (Eq a) constraint + ===================================== testsuite/tests/quantified-constraints/all.T ===================================== @@ -42,3 +42,4 @@ test('T22216e', normal, compile, ['']) test('T22223', normal, compile, ['']) test('T19690', normal, compile_fail, ['']) test('T23333', normal, compile, ['']) +test('T23323', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2b0c9f5ef026df6dd2637aacce05a11d74146296 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2b0c9f5ef026df6dd2637aacce05a11d74146296 You're receiving 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 Jun 8 22:41:46 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 08 Jun 2023 18:41:46 -0400 Subject: [Git][ghc/ghc][master] Update the outdated instructions in HACKING.md on how to compile GHC Message-ID: <6482592af3937_2262121131e50021539a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 1 changed file: - HACKING.md Changes: ===================================== HACKING.md ===================================== @@ -23,47 +23,15 @@ Contributing patches to GHC in a hurry ====================================== Make sure your system has the necessary tools to compile GHC. You can -find an overview here: +find an overview of how to prepare your system for compiling GHC here: -Next, clone the repository and all the associated libraries: +After you have prepared your system, you can build GHC following the instructions described here: -``` -$ git clone --recursive git at gitlab.haskell.org:ghc/ghc.git -``` + -On Windows, you need an extra repository containing some build tools. -These can be downloaded for you by `configure`. This only needs to be done once by running: - -``` -$ ./configure --enable-tarballs-autodownload -``` - -First copy `mk/build.mk.sample` to `mk/build.mk` and ensure it has -your preferred build settings. (You probably want to at least set -`BuildFlavour` to `quick`): - -``` -$ cp mk/build.mk.sample mk/build.mk -$ ... double-check mk/build.mk ... -``` - -Now build. The convenient `validate` script will build the tree in a way which -is both quick to build and consistent with our testsuite: - -``` -$ ./validate --build-only -``` - -You can use the `_validatebuild/stage1/bin/ghc` binary to play with the -newly built compiler. - -Now, hack on your copy and rebuild (with `make`) as necessary. - -Then start by making your commits however you want. When you're done, you can submit -a pull request on Github for small changes. For larger changes the patch needs to be -submitted to [GitLab](https://gitlab.haskell.org/ghc/ghc/merge_requests) for code review. +Then start by making your commits however you want. When you're done, you can submit a merge request to [GitLab](https://gitlab.haskell.org/ghc/ghc/merge_requests) for code review. Changes to the `base` library require a proposal to the [core libraries committee](https://github.com/haskell/core-libraries-committee/issues). The GHC Wiki has a good summary for the [overall process](https://gitlab.haskell.org/ghc/ghc/wikis/working-conventions/fixing-bugs). One or several reviewers will review your PR, and when they are ok with your changes, they will assign the PR to [Marge Bot](https://gitlab.haskell.org/marge-bot) which will automatically rebase, batch and then merge your PR (assuming the build passes). View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/567b32e12cbae07bee78d66252e83a0ad08419be -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/567b32e12cbae07bee78d66252e83a0ad08419be You're receiving 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 Jun 9 05:42:31 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Fri, 09 Jun 2023 01:42:31 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/#23434-wterm-variable-capture] Fix -Wterm-variable-capture scope (#23434) Message-ID: <6482bbc79b0d4_226212128656ac2481a@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/#23434-wterm-variable-capture at Glasgow Haskell Compiler / GHC Commits: e1a74105 by Andrei Borzenkov at 2023-06-09T09:41:46+04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 11 changed files: - compiler/GHC/Rename/HsType.hs - testsuite/tests/rename/should_compile/T22513a.stderr - testsuite/tests/rename/should_compile/T22513b.stderr - testsuite/tests/rename/should_compile/T22513c.stderr - testsuite/tests/rename/should_compile/T22513d.stderr - testsuite/tests/rename/should_compile/T22513e.stderr - testsuite/tests/rename/should_compile/T22513f.stderr - testsuite/tests/rename/should_compile/T22513g.stderr - testsuite/tests/rename/should_compile/T22513h.stderr - + testsuite/tests/rename/should_compile/T23434.hs - testsuite/tests/rename/should_compile/all.T Changes: ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -16,7 +16,6 @@ module GHC.Rename.HsType ( rnLHsKind, rnLHsTypeArgs, rnHsSigType, rnHsWcType, rnHsPatSigTypeBindingVars, HsPatSigTypeScoping(..), rnHsSigWcType, rnHsPatSigType, - newTyVarNameRn, rnConDeclFields, lookupField, rnLTyVar, @@ -386,7 +385,6 @@ rnImplicitTvOccs :: Maybe assoc -> RnM (a, FreeVars) rnImplicitTvOccs mb_assoc implicit_vs_with_dups thing_inside = do { let implicit_vs = nubN implicit_vs_with_dups - ; mapM_ warn_term_var_capture implicit_vs ; traceRn "rnImplicitTvOccs" $ vcat [ ppr implicit_vs_with_dups, ppr implicit_vs ] @@ -395,7 +393,7 @@ rnImplicitTvOccs mb_assoc implicit_vs_with_dups thing_inside -- See Note [Source locations for implicitly bound type variables]. ; loc <- getSrcSpanM ; let loc' = noAnnSrcSpan loc - ; vars <- mapM (newTyVarNameRn mb_assoc . L loc' . unLoc) implicit_vs + ; vars <- mapM (newTyVarNameRnImplicit mb_assoc . L loc' . unLoc) implicit_vs ; bindLocalNamesFV vars $ thing_inside vars } @@ -1136,6 +1134,7 @@ bindHsOuterTyVarBndrs doc mb_cls implicit_vars outer_bndrs thing_inside = thing_inside $ HsOuterExplicit { hso_xexplicit = noExtField , hso_bndrs = exp_bndrs' } +-- See Note [Term variable capture and implicit quantification] warn_term_var_capture :: LocatedN RdrName -> RnM () warn_term_var_capture lVar = do gbl_env <- getGlobalRdrEnv @@ -1242,15 +1241,68 @@ rnHsBndrVis :: HsBndrVis GhcPs -> HsBndrVis GhcRn rnHsBndrVis HsBndrRequired = HsBndrRequired rnHsBndrVis (HsBndrInvisible at) = HsBndrInvisible at -newTyVarNameRn :: Maybe a -- associated class - -> LocatedN RdrName -> RnM Name -newTyVarNameRn mb_assoc lrdr@(L _ rdr) +newTyVarNameRn, newTyVarNameRnImplicit + :: Maybe a -- associated class + -> LocatedN RdrName -> RnM Name +newTyVarNameRn mb_assoc = new_tv_name_rn mb_assoc newLocalBndrRn +newTyVarNameRnImplicit mb_assoc = new_tv_name_rn mb_assoc $ \lrdr -> + do { warn_term_var_capture lrdr + ; newLocalBndrRn lrdr } + +new_tv_name_rn :: Maybe a -- associated class + -> (LocatedN RdrName -> RnM Name) -- how to create a new name + -> (LocatedN RdrName -> RnM Name) +new_tv_name_rn Nothing cont lrdr = cont lrdr +new_tv_name_rn (Just _) cont lrdr@(L _ rdr) = do { rdr_env <- getLocalRdrEnv - ; case (mb_assoc, lookupLocalRdrEnv rdr_env rdr) of - (Just _, Just n) -> return n - -- Use the same Name as the parent class decl + ; case lookupLocalRdrEnv rdr_env rdr of + Just n -> return n -- Use the same Name as the parent class decl + _ -> cont lrdr } + +{- Note [Term variable capture and implicit quantification] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-Wterm-variable-capture is a warning introduced in GHC Proposal #281 "Visible forall in types of terms", +Section 7.3: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0281-visible-forall.rst#73implicit-quantification + +Its purpose is to notify users when implicit quantification occurs that would +stop working under RequiredTypeArguments (a future GHC extension). Example: + + a = 42 + id :: a -> a + +As it stands, the `a` in the signature `id :: a -> a` is considered free and +leads to implicit quantification, as if the user wrote `id :: forall a. a -> a`. +Under RequiredTypeArguments it will capture the term-level variable `a` (bound by `a = 42`), +leading to a type error. + +`warn_term_var_capture` detects this by demoting the namespace of the +implicitly quantified type variable (`TvName` becomes `VarName`) and looking it up +in the environment. But when do we call `warn_term_var_capture`? It's tempting +to do so at the start of `rnImplicitTvOccs`, as soon as we know our implicit +variables: + + rnImplicitTvOccs mb_assoc implicit_vs_with_dups thing_inside + = do { let implicit_vs = nubN implicit_vs_with_dups + ; mapM_ warn_term_var_capture implicit_vs + ... } + +This approach generates false positives (#23434) because it misses a corner +case: class variables in associated types. Consider the following example: + + k = 12 + class C k a where + type AT a :: k -> Type + +If we look at the signature for `AT` in isolation, the `k` looks like a free +variable, so it's passed to `rnImplicitTvOccs`. And if we passed it to +`warn_term_var_capture`, we would find the `k` bound by `k = 12` and report a warning. +But don't want that: `k` is actually bound in the declaration header of the +parent class. + +The solution is to check if it's a class variable (this is done in `new_tv_name_rn`) +before we check for term variable capture. +-} - _ -> newLocalBndrRn lrdr } {- ********************************************************* * * ===================================== testsuite/tests/rename/should_compile/T22513a.stderr ===================================== @@ -1,6 +1,7 @@ -T22513a.hs:5:6: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513a.hs:5:1: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘a’ is implicitly quantified, even though another variable of the same name is in scope: - ‘a’ defined at T22513a.hs:3:1 + ‘a’ defined at T22513a.hs:3:1 This is not forward-compatible with a planned GHC extension, RequiredTypeArguments. - Suggested fix: Consider renaming the type variable. \ No newline at end of file + Suggested fix: Consider renaming the type variable. ===================================== testsuite/tests/rename/should_compile/T22513b.stderr ===================================== @@ -1,4 +1,5 @@ -T22513b.hs:5:6: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513b.hs:5:1: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘id’ is implicitly quantified, even though another variable of the same name is in scope: ‘id’ imported from ‘Prelude’ at T22513b.hs:3:17-18 ===================================== testsuite/tests/rename/should_compile/T22513c.stderr ===================================== @@ -1,4 +1,5 @@ -T22513c.hs:6:10: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513c.hs:6:5: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘a’ is implicitly quantified, even though another variable of the same name is in scope: ‘a’ defined at T22513c.hs:4:3 ===================================== testsuite/tests/rename/should_compile/T22513d.stderr ===================================== @@ -1,7 +1,8 @@ -T22513d.hs:3:28: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513d.hs:3:4: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘id’ is implicitly quantified, even though another variable of the same name is in scope: ‘id’ imported from ‘Prelude’ at T22513d.hs:1:8-14 (and originally defined in ‘GHC.Base’) This is not forward-compatible with a planned GHC extension, RequiredTypeArguments. - Suggested fix: Consider renaming the type variable. \ No newline at end of file + Suggested fix: Consider renaming the type variable. ===================================== testsuite/tests/rename/should_compile/T22513e.stderr ===================================== @@ -1,7 +1,8 @@ -T22513e.hs:3:14: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513e.hs:3:1: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘id’ is implicitly quantified, even though another variable of the same name is in scope: ‘id’ imported from ‘Prelude’ at T22513e.hs:1:8-14 (and originally defined in ‘GHC.Base’) This is not forward-compatible with a planned GHC extension, RequiredTypeArguments. - Suggested fix: Consider renaming the type variable. \ No newline at end of file + Suggested fix: Consider renaming the type variable. ===================================== testsuite/tests/rename/should_compile/T22513f.stderr ===================================== @@ -1,7 +1,8 @@ -T22513f.hs:5:25: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513f.hs:5:1: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘id’ is implicitly quantified, even though another variable of the same name is in scope: ‘id’ imported from ‘Prelude’ at T22513f.hs:1:8-14 (and originally defined in ‘GHC.Base’) This is not forward-compatible with a planned GHC extension, RequiredTypeArguments. - Suggested fix: Consider renaming the type variable. \ No newline at end of file + Suggested fix: Consider renaming the type variable. ===================================== testsuite/tests/rename/should_compile/T22513g.stderr ===================================== @@ -1,7 +1,8 @@ -T22513g.hs:5:15: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513g.hs:5:1: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘head’ is implicitly quantified, even though another variable of the same name is in scope: ‘head’ imported from ‘Prelude’ at T22513g.hs:2:8-14 (and originally defined in ‘GHC.List’) This is not forward-compatible with a planned GHC extension, RequiredTypeArguments. - Suggested fix: Consider renaming the type variable. \ No newline at end of file + Suggested fix: Consider renaming the type variable. ===================================== testsuite/tests/rename/should_compile/T22513h.stderr ===================================== @@ -1,7 +1,8 @@ -T22513h.hs:6:19: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513h.hs:6:10: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘id’ is implicitly quantified, even though another variable of the same name is in scope: ‘id’ imported from ‘Prelude’ at T22513h.hs:1:8-14 (and originally defined in ‘GHC.Base’) This is not forward-compatible with a planned GHC extension, RequiredTypeArguments. - Suggested fix: Consider renaming the type variable. \ No newline at end of file + Suggested fix: Consider renaming the type variable. ===================================== testsuite/tests/rename/should_compile/T23434.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -Wterm-variable-capture #-} +module T23434 where + +import GHC.Types (Type) + +k = 12 + +class C k a where + type AT a :: k -> Type ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -211,3 +211,4 @@ test('GHCIImplicitImportNullaryRecordWildcard', combined_output, ghci_script, [' test('T22122', [expect_broken(22122), extra_files(['T22122_aux.hs'])], multimod_compile, ['T22122', '-v0']) test('T23240', [req_th, extra_files(['T23240_aux.hs'])], multimod_compile, ['T23240', '-v0']) test('T23318', normal, compile, ['-Wduplicate-exports']) +test('T23434', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e1a74105c3f4f07c99a124e1a7179409351e7ec6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e1a74105c3f4f07c99a124e1a7179409351e7ec6 You're receiving 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 Jun 9 07:57:48 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Fri, 09 Jun 2023 03:57:48 -0400 Subject: [Git][ghc/ghc][wip/T18389-task-zero] 2181 commits: Implement \cases (Proposal 302) Message-ID: <6482db7c1a140_2262122dff974280878@gitlab.mail> Ryan Scott pushed to branch wip/T18389-task-zero at Glasgow Haskell Compiler / GHC Commits: 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. - - - - - 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 - - - - - 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. - - - - - 08c0822c by doyougnu at 2023-02-15T00:16:39-05:00 docs: release notes, user guide: add js backend Follow up from #21078 - - - - - 79d8fd65 by Bryan Richter at 2023-02-15T00:17:15-05:00 Allow failure in nightly-x86_64-linux-deb10-no_tntc-validate See #22343 - - - - - 9ca51f9e by Cheng Shao at 2023-02-15T00:17:53-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. - - - - - 26df73fb by Oleg Grenrus at 2023-02-15T22:20:57-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 - - - - - 631c6c72 by Cheng Shao at 2023-02-16T06:43:09-05:00 docs: add a section for the wasm backend Fixes #22658 - - - - - 1878e0bd by Bryan Richter at 2023-02-16T06:43:47-05:00 tests: Mark T12903 fragile everywhere See #21184 - - - - - b9420eac by Bryan Richter at 2023-02-16T06:43:47-05:00 Mark all T5435 variants as fragile See #22970. - - - - - df3d94bd by Sylvain Henry at 2023-02-16T06:44:33-05:00 Testsuite: mark T13167 as fragile for JS (#22921) - - - - - 324e925b by Sylvain Henry at 2023-02-16T06:45:15-05:00 JS: disable debugging info for heap objects - - - - - 518af814 by Josh Meredith at 2023-02-16T10:16:32-05:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 34cd308e by Ben Gamari at 2023-02-16T10:17:08-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 12965aba by Simon Peyton Jones at 2023-02-16T10:17:46-05: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 - - - - - 5b038888 by Bodigrim at 2023-02-16T10:18:24-05:00 Documentation: add an example of SPEC usage - - - - - 681e0e8c by sheaf at 2023-02-16T14:09:56-05:00 No default finalizer exception handler Commit cfc8e2e2 introduced a mechanism for handling of exceptions that occur during Handle finalization, and 372cf730 set the default handler to print out the error to stderr. However, #21680 pointed out we might not want to set this by default, as it might pollute users' terminals with unwanted information. So, for the time being, the default handler discards the exception. Fixes #21680 - - - - - b3ac17ad by Matthew Pickering at 2023-02-16T14:10:31-05: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 ------------------------- - - - - - 8988eeef by sheaf at 2023-02-16T20:32:27-05:00 Expand synonyms in RoughMap We were failing to expand type synonyms in the function GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the RoughMap infrastructure crucially relies on type synonym expansion to work. This patch adds the missing type-synonym expansion. Fixes #22985 - - - - - 3dd50e2f by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Add test artifact Add the released testsuite tarball to the generated ghcup metadata. - - - - - c6a967d9 by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Use Ubuntu and Rocky bindists Prefer to use the Ubuntu 20.04 and 18.04 binary distributions on Ubuntu and Linux Mint. Prefer to use the Rocky 8 binary distribution on unknown distributions. - - - - - be0b7209 by Matthew Pickering at 2023-02-17T09:37:16+00:00 Add INLINABLE pragmas to `generic*` functions in Data.OldList These functions are * recursive * overloaded So it's important to add an `INLINABLE` pragma to each so that they can be specialised at the use site when the specific numeric type is known. Adding these pragmas improves the LazyText replicate benchmark (see https://gitlab.haskell.org/ghc/ghc/-/issues/22886#note_481020) https://github.com/haskell/core-libraries-committee/issues/129 - - - - - a203ad85 by Sylvain Henry at 2023-02-17T15:59:16-05:00 Merge libiserv with ghci `libiserv` serves no purpose. As it depends on `ghci` and doesn't have more dependencies than the `ghci` package, its code could live in the `ghci` package too. This commit also moves most of the code from the `iserv` program into the `ghci` package as well so that it can be reused. This is especially useful for the implementation of TH for the JS backend (#22261, !9779). - - - - - 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01: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 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-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. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-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. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-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. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 7192ef91 by Simon Peyton Jones at 2023-02-28T18:54:59-05:00 Take more care with unlifted bindings in the specialiser As #22998 showed, we were floating an unlifted binding to top level, which breaks a Core invariant. The fix is easy, albeit a little bit conservative. See Note [Care with unlifted bindings] in GHC.Core.Opt.Specialise - - - - - bb500e2a by Simon Peyton Jones at 2023-02-28T18:55:35-05:00 Account for TYPE vs CONSTRAINT in mkSelCo As #23018 showed, in mkRuntimeRepCo we need to account for coercions between TYPE and COERCION. See Note [mkRuntimeRepCo] in GHC.Core.Coercion. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-05:00 hadrian: Add dependency from lib/settings to mk/config.mk In 81975ef375de07a0ea5a69596b2077d7f5959182 we attempted to fix #20253 by adding logic to the bindist Makefile to regenerate the `settings` file from information gleaned by the bindist `configure` script. However, this fix had no effect as `lib/settings` is shipped in the binary distribution (to allow in-place use of the binary distribution). As `lib/settings` already existed and its rule declared no dependencies, `make` would fail to use the added rule to regenerate it. Fix this by explicitly declaring a dependency from `lib/settings` on `mk/config.mk`. Fixes #22982. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-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. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-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. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00: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. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 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: ...lots of lines omitted... 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. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04: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. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04: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> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+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. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - e4617b7c by Ryan Scott at 2023-06-09T09:56:58+02:00 Introduce and use ConGadtSigBody (preparatory refactor for #18389) This patch removes the `con_g_args :: HsConDeclGADTDetails pass` and `con_res_ty :: LHsType pass` fields of `ConDeclGADT` in favor of a unified `con_body :: ConGadtSigBody pass` field. There are two major differences between `HsConDeclGADTDetails` and `ConGadtSigBody`: 1. `HsConDeclGADTDetails` only contains the argument type, while `ConGadtSigBody` contains both the argument and result types. 2. The `PrefixConGADT` constructor of `ConGadtSigBody` now uses a new `PrefixConGadtSigBody` data type. `PrefixConGadtSigBody` closely mirrors the structure of `HsType`, but with minor, data constructor–specific tweaks. This will become vital in a future patch which implements nested `forall`s and contexts in prefix GADT constructor types (see #18389). Besides the refactoring in the GHC API (and some minor changes in GHC AST–related test cases) this does not introduce any user-visible changes in behavior. - - - - - 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/ff8d81265090dc89e067a08028d9c598f72529ab...e4617b7ca1da826638bc1b1d5e475561730a79a3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ff8d81265090dc89e067a08028d9c598f72529ab...e4617b7ca1da826638bc1b1d5e475561730a79a3 You're receiving 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 Jun 9 08:16:59 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 09 Jun 2023 04:16:59 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Update the outdated instructions in HACKING.md on how to compile GHC Message-ID: <6482dffb63a7b_22621212c0915029287f@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - b93168d7 by Ryan Scott at 2023-06-09T04:16:50-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 548a4b8a by Ryan Scott at 2023-06-09T04:16:50-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - adb2a55a by Ryan Scott at 2023-06-09T04:16:50-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - 14 changed files: - HACKING.md - compiler/GHC/ThToHs.hs - compiler/Language/Haskell/Syntax/Decls.hs - configure.ac - libraries/base/base.cabal - libraries/ghc-prim/ghc-prim.cabal - rts/RtsSymbols.c - + testsuite/tests/th/T22559a.hs - + testsuite/tests/th/T22559a.stderr - + testsuite/tests/th/T22559b.hs - + testsuite/tests/th/T22559b.stderr - + testsuite/tests/th/T22559c.hs - + testsuite/tests/th/T22559c.stderr - testsuite/tests/th/all.T Changes: ===================================== HACKING.md ===================================== @@ -23,47 +23,15 @@ Contributing patches to GHC in a hurry ====================================== Make sure your system has the necessary tools to compile GHC. You can -find an overview here: +find an overview of how to prepare your system for compiling GHC here: -Next, clone the repository and all the associated libraries: +After you have prepared your system, you can build GHC following the instructions described here: -``` -$ git clone --recursive git at gitlab.haskell.org:ghc/ghc.git -``` + -On Windows, you need an extra repository containing some build tools. -These can be downloaded for you by `configure`. This only needs to be done once by running: - -``` -$ ./configure --enable-tarballs-autodownload -``` - -First copy `mk/build.mk.sample` to `mk/build.mk` and ensure it has -your preferred build settings. (You probably want to at least set -`BuildFlavour` to `quick`): - -``` -$ cp mk/build.mk.sample mk/build.mk -$ ... double-check mk/build.mk ... -``` - -Now build. The convenient `validate` script will build the tree in a way which -is both quick to build and consistent with our testsuite: - -``` -$ ./validate --build-only -``` - -You can use the `_validatebuild/stage1/bin/ghc` binary to play with the -newly built compiler. - -Now, hack on your copy and rebuild (with `make`) as necessary. - -Then start by making your commits however you want. When you're done, you can submit -a pull request on Github for small changes. For larger changes the patch needs to be -submitted to [GitLab](https://gitlab.haskell.org/ghc/ghc/merge_requests) for code review. +Then start by making your commits however you want. When you're done, you can submit a merge request to [GitLab](https://gitlab.haskell.org/ghc/ghc/merge_requests) for code review. Changes to the `base` library require a proposal to the [core libraries committee](https://github.com/haskell/core-libraries-committee/issues). The GHC Wiki has a good summary for the [overall process](https://gitlab.haskell.org/ghc/ghc/wikis/working-conventions/fixing-bugs). One or several reviewers will review your PR, and when they are ok with your changes, they will assign the PR to [Marge Bot](https://gitlab.haskell.org/marge-bot) which will automatically rebase, batch and then merge your PR (assuming the build passes). ===================================== compiler/GHC/ThToHs.hs ===================================== @@ -277,17 +277,13 @@ cvtDec (DataD ctxt tc tvs ksig constrs derivs) cvtDec (NewtypeD ctxt tc tvs ksig constr derivs) = do { (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs ; ksig' <- cvtKind `traverse` ksig - ; let first_datacon = - case get_cons_names constr of - [] -> panic "cvtDec: empty list of constructors" - c:_ -> c - ; con' <- cvtConstr first_datacon cNameN constr + ; con' <- cvtDataDefnCons False ksig $ NewTypeCon constr ; derivs' <- cvtDerivs derivs ; let defn = HsDataDefn { dd_ext = noExtField , dd_cType = Nothing , dd_ctxt = mkHsContextMaybe ctxt' , dd_kindSig = ksig' - , dd_cons = NewTypeCon con' + , dd_cons = con' , dd_derivs = derivs' } ; returnJustLA $ TyClD noExtField $ DataDecl { tcdDExt = noAnn @@ -353,17 +349,13 @@ cvtDec (DataFamilyD tc tvs kind) cvtDec (DataInstD ctxt bndrs tys ksig constrs derivs) = do { (ctxt', tc', bndrs', typats') <- cvt_datainst_hdr ctxt bndrs tys ; ksig' <- cvtKind `traverse` ksig - ; let first_datacon = - case get_cons_names $ head constrs of - [] -> panic "cvtDec: empty list of constructors" - c:_ -> c - ; cons' <- mapM (cvtConstr first_datacon cNameN) constrs + ; cons' <- cvtDataDefnCons False ksig $ DataTypeCons False constrs ; derivs' <- cvtDerivs derivs ; let defn = HsDataDefn { dd_ext = noExtField , dd_cType = Nothing , dd_ctxt = mkHsContextMaybe ctxt' , dd_kindSig = ksig' - , dd_cons = DataTypeCons False cons' + , dd_cons = cons' , dd_derivs = derivs' } ; returnJustLA $ InstD noExtField $ DataFamInstD @@ -379,17 +371,14 @@ cvtDec (DataInstD ctxt bndrs tys ksig constrs derivs) cvtDec (NewtypeInstD ctxt bndrs tys ksig constr derivs) = do { (ctxt', tc', bndrs', typats') <- cvt_datainst_hdr ctxt bndrs tys ; ksig' <- cvtKind `traverse` ksig - ; let first_datacon = - case get_cons_names constr of - [] -> panic "cvtDec: empty list of constructors" - c:_ -> c - ; con' <- cvtConstr first_datacon cNameN constr + ; con' <- cvtDataDefnCons False ksig $ NewTypeCon constr ; derivs' <- cvtDerivs derivs ; let defn = HsDataDefn { dd_ext = noExtField , dd_cType = Nothing , dd_ctxt = mkHsContextMaybe ctxt' , dd_kindSig = ksig' - , dd_cons = NewTypeCon con', dd_derivs = derivs' } + , dd_cons = con' + , dd_derivs = derivs' } ; returnJustLA $ InstD noExtField $ DataFamInstD { dfid_ext = noExtField , dfid_inst = DataFamInstDecl { dfid_eqn = @@ -498,6 +487,28 @@ cvtGenDataDec :: Bool -> TH.Cxt -> TH.Name -> [TH.TyVarBndr TH.BndrVis] -> Maybe TH.Kind -> [TH.Con] -> [TH.DerivClause] -> CvtM (Maybe (LHsDecl GhcPs)) cvtGenDataDec type_data ctxt tc tvs ksig constrs derivs + = do { (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs + ; ksig' <- cvtKind `traverse` ksig + ; cons' <- cvtDataDefnCons type_data ksig $ + DataTypeCons type_data constrs + ; derivs' <- cvtDerivs derivs + ; let defn = HsDataDefn { dd_ext = noExtField + , dd_cType = Nothing + , dd_ctxt = mkHsContextMaybe ctxt' + , dd_kindSig = ksig' + , dd_cons = cons' + , dd_derivs = derivs' } + ; returnJustLA $ TyClD noExtField $ + DataDecl { tcdDExt = noAnn + , tcdLName = tc', tcdTyVars = tvs' + , tcdFixity = Prefix + , tcdDataDefn = defn } } + +-- Convert a set of data constructors. +cvtDataDefnCons :: + Bool -> Maybe TH.Kind -> + DataDefnCons TH.Con -> CvtM (DataDefnCons (LConDecl GhcPs)) +cvtDataDefnCons type_data ksig constrs = do { let isGadtCon (GadtC _ _ _) = True isGadtCon (RecGadtC _ _ _) = True isGadtCon (ForallC _ _ c) = isGadtCon c @@ -515,27 +526,16 @@ cvtGenDataDec type_data ctxt tc tvs ksig constrs derivs (failWith CannotMixGADTConsWith98Cons) ; unless (isNothing ksig || isGadtDecl) (failWith KindSigsOnlyAllowedOnGADTs) - ; (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs - ; ksig' <- cvtKind `traverse` ksig ; let first_datacon = - case get_cons_names $ head constrs of - [] -> panic "cvtGenDataDec: empty list of constructors" + case firstDataDefnCon constrs of + Nothing -> panic "cvtDataDefnCons: empty list of constructors" + Just con -> con + first_datacon_name = + case get_cons_names first_datacon of + [] -> panic "cvtDataDefnCons: data constructor with no names" c:_ -> c - ; cons' <- mapM (cvtConstr first_datacon con_name) constrs - - ; derivs' <- cvtDerivs derivs - ; let defn = HsDataDefn { dd_ext = noExtField - , dd_cType = Nothing - , dd_ctxt = mkHsContextMaybe ctxt' - , dd_kindSig = ksig' - , dd_cons = DataTypeCons type_data cons' - , dd_derivs = derivs' } - ; returnJustLA $ TyClD noExtField $ - DataDecl { tcdDExt = noAnn - , tcdLName = tc', tcdTyVars = tvs' - , tcdFixity = Prefix - , tcdDataDefn = defn } } + ; mapM (cvtConstr first_datacon_name con_name) constrs } ---------------- cvtTySynEqn :: TySynEqn -> CvtM (LTyFamInstEqn GhcPs) ===================================== compiler/Language/Haskell/Syntax/Decls.hs ===================================== @@ -30,7 +30,7 @@ module Language.Haskell.Syntax.Decls ( HsDecl(..), LHsDecl, HsDataDefn(..), HsDeriving, LHsFunDep, FunDep(..), HsDerivingClause(..), LHsDerivingClause, DerivClauseTys(..), LDerivClauseTys, NewOrData(..), DataDefnCons(..), dataDefnConsNewOrData, - isTypeDataDefnCons, + isTypeDataDefnCons, firstDataDefnCon, StandaloneKindSig(..), LStandaloneKindSig, -- ** Class or type declarations @@ -1040,6 +1040,11 @@ isTypeDataDefnCons :: DataDefnCons a -> Bool isTypeDataDefnCons (NewTypeCon _) = False isTypeDataDefnCons (DataTypeCons is_type_data _) = is_type_data +-- | Retrieve the first data constructor in a 'DataDefnCons' (if one exists). +firstDataDefnCon :: DataDefnCons a -> Maybe a +firstDataDefnCon (NewTypeCon con) = Just con +firstDataDefnCon (DataTypeCons _ cons) = listToMaybe cons + -- | Located data Constructor Declaration type LConDecl pass = XRec pass (ConDecl pass) -- ^ May have 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnSemi' when ===================================== configure.ac ===================================== @@ -917,6 +917,9 @@ AC_CHECK_DECLS([program_invocation_short_name], , , [#define _GNU_SOURCE 1 #include ]) +dnl ** check for mingwex library +AC_CHECK_LIB([mingwex],[closedir]) + dnl ** check for math library dnl Keep that check as early as possible. dnl as we need to know whether we need libm ===================================== libraries/base/base.cabal ===================================== @@ -398,6 +398,7 @@ Library if os(windows) -- Windows requires some extra libraries for linking because the RTS -- is no longer re-exporting them. + -- mingwex: provides GNU POSIX extensions that aren't provided by ucrt. -- 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 +411,7 @@ Library -- advapi32: provides advanced kernel functions extra-libraries: wsock32, user32, shell32, mingw32, kernel32, advapi32, - ws2_32, shlwapi, ole32, rpcrt4, ntdll + mingwex, 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/ghc-prim/ghc-prim.cabal ===================================== @@ -68,12 +68,13 @@ Library -- is no longer re-exporting them (see #11223) -- ucrt: standard C library. The RTS will automatically include this, -- but is added for completeness. + -- mingwex: provides GNU POSIX extensions that aren't provided by ucrt. -- 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, ucrt + extra-libraries: user32, mingw32, mingwex, ucrt if os(linux) -- we need libm, but for musl and other's we might need libc, as libm ===================================== rts/RtsSymbols.c ===================================== @@ -113,6 +113,26 @@ 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 @@ -150,17 +170,17 @@ extern char **environ; SymI_NeedsProto(__mingw_module_is_dll) \ RTS_WIN32_ONLY(SymI_NeedsProto(___chkstk_ms)) \ RTS_WIN64_ONLY(SymI_NeedsProto(___chkstk_ms)) \ - SymI_HasProto(__mingw_vsnwprintf) \ - /* ^^ Need to figure out why this is needed. */ \ + RTS_WIN64_ONLY(SymI_HasProto(__stdio_common_vswprintf_s)) \ + RTS_WIN64_ONLY(SymI_HasProto(__stdio_common_vswprintf)) \ + RTS_WIN64_ONLY(SymI_HasProto(_errno)) \ + /* see Note [Symbols for MinGW's printf] */ \ + SymI_HasProto(_lock_file) \ + SymI_HasProto(_unlock_file) \ /* See Note [_iob_func symbol] */ \ RTS_WIN64_ONLY(SymI_HasProto_redirect( \ __imp___acrt_iob_func, __rts_iob_func, STRENGTH_WEAK, SYM_TYPE_INDIRECT_DATA)) \ RTS_WIN32_ONLY(SymI_HasProto_redirect( \ - __imp____acrt_iob_func, __rts_iob_func, STRENGTH_WEAK, SYM_TYPE_INDIRECT_DATA)) \ - SymI_HasProto(__mingw_vsnwprintf) \ - /* ^^ Need to figure out why this is needed. */ \ - SymI_HasProto(__mingw_vfprintf) \ - /* ^^ Need to figure out why this is needed. */ + __imp____acrt_iob_func, __rts_iob_func, STRENGTH_WEAK, SYM_TYPE_INDIRECT_DATA)) #else #define RTS_MINGW_ONLY_SYMBOLS /**/ #endif ===================================== testsuite/tests/th/T22559a.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TemplateHaskell #-} +module T22559a where + +import Language.Haskell.TH + +$(pure [NewtypeD + [] (mkName "D") [] (Just StarT) + (NormalC (mkName "MkD") + [( Bang NoSourceUnpackedness NoSourceStrictness + , ConT ''Int + )]) + []]) ===================================== testsuite/tests/th/T22559a.stderr ===================================== @@ -0,0 +1,4 @@ + +T22559a.hs:7:2: error: [GHC-40746] + Kind signatures are only allowed on GADTs + When splicing a TH declaration: newtype D :: * = MkD GHC.Types.Int ===================================== testsuite/tests/th/T22559b.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +module T22559b where + +import Language.Haskell.TH + +data family D + +$(pure [DataInstD + [] Nothing + (ConT (mkName "D")) (Just StarT) + [NormalC (mkName "MkD") + [( Bang NoSourceUnpackedness NoSourceStrictness + , ConT ''Int + )]] + []]) ===================================== testsuite/tests/th/T22559b.stderr ===================================== @@ -0,0 +1,5 @@ + +T22559b.hs:10:2: error: [GHC-40746] + Kind signatures are only allowed on GADTs + When splicing a TH declaration: + data instance D :: * = MkD GHC.Types.Int ===================================== testsuite/tests/th/T22559c.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +module T22559c where + +import Language.Haskell.TH + +data family D + +$(pure [NewtypeInstD + [] Nothing + (ConT (mkName "D")) (Just StarT) + (NormalC (mkName "MkD") + [( Bang NoSourceUnpackedness NoSourceStrictness + , ConT ''Int + )]) + []]) ===================================== testsuite/tests/th/T22559c.stderr ===================================== @@ -0,0 +1,5 @@ + +T22559c.hs:10:2: error: [GHC-40746] + Kind signatures are only allowed on GADTs + When splicing a TH declaration: + newtype instance D :: * = MkD GHC.Types.Int ===================================== testsuite/tests/th/all.T ===================================== @@ -573,3 +573,6 @@ test('TH_typed3', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('TH_typed4', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('TH_typed5', normal, compile_and_run, ['']) test('T21050', normal, compile_fail, ['']) +test('T22559a', normal, compile_fail, ['']) +test('T22559b', normal, compile_fail, ['']) +test('T22559c', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8e44b3f11af040fcabd7453cdbe3e5e0e34165ff...adb2a55afab372abea97365bf4f97074d921e6f5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8e44b3f11af040fcabd7453cdbe3e5e0e34165ff...adb2a55afab372abea97365bf4f97074d921e6f5 You're receiving 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 Jun 9 09:08:17 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Fri, 09 Jun 2023 05:08:17 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/#16635-improve-errors] Capture scoped kind variables at type-checking phase (#16635) Message-ID: <6482ec011a62d_22621212ea97c03285b9@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/#16635-improve-errors at Glasgow Haskell Compiler / GHC Commits: 1f515a72 by Andrei Borzenkov at 2023-06-09T13:07:51+04:00 Capture scoped kind variables at type-checking phase (#16635) Like descibed in new Note [Type variable scoping errors during type check] in GHC.Tc.Types, I made ScopedTypeVariables work on type level like in term level. For now that only means, that the error about kind variables scoped into type are rejected at the elaboration time, because we can't generalize the type by adding type-level lambda - we simply have no one. - - - - - 30 changed files: - compiler/GHC/Hs/Type.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Errors/Types/PromotionErr.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Types/BasicTypes.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Types/Error/Codes.hs - testsuite/tests/dependent/should_fail/PromotedClass.stderr - testsuite/tests/dependent/should_fail/SelfDep.stderr - testsuite/tests/dependent/should_fail/T13780a.stderr - testsuite/tests/dependent/should_fail/T13780c.stderr - testsuite/tests/dependent/should_fail/T14845_compile.stderr - testsuite/tests/dependent/should_fail/T14845_fail1.stderr - testsuite/tests/dependent/should_fail/T14845_fail2.stderr - testsuite/tests/dependent/should_fail/T15215.stderr - testsuite/tests/dependent/should_fail/T15245.stderr - testsuite/tests/patsyn/should_fail/T11265.stderr - testsuite/tests/patsyn/should_fail/T9161-1.stderr - testsuite/tests/patsyn/should_fail/T9161-2.stderr - testsuite/tests/polykinds/PolyKinds06.stderr - testsuite/tests/polykinds/PolyKinds07.stderr - testsuite/tests/polykinds/T13625.stderr - testsuite/tests/polykinds/T15116.stderr - testsuite/tests/polykinds/T15116a.stderr - testsuite/tests/polykinds/T5716.stderr - testsuite/tests/polykinds/T5716a.stderr - testsuite/tests/polykinds/T6129.stderr - testsuite/tests/polykinds/T7433.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1f515a72b27be99e389af627c43c4541468c1534 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1f515a72b27be99e389af627c43c4541468c1534 You're receiving 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 Jun 9 09:12:26 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Fri, 09 Jun 2023 05:12:26 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23143 Message-ID: <6482ecfa94567_22621212c091503399f3@gitlab.mail> Ryan Scott pushed new branch wip/T23143 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23143 You're receiving 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 Jun 9 09:18:54 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Fri, 09 Jun 2023 05:18:54 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/#23434-wterm-variable-capture] Fix -Wterm-variable-capture scope (#23434) Message-ID: <6482ee7ee6718_226212130bd94435438@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/#23434-wterm-variable-capture at Glasgow Haskell Compiler / GHC Commits: 37540e05 by Andrei Borzenkov at 2023-06-09T13:18:45+04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 4 changed files: - compiler/GHC/Rename/HsType.hs - testsuite/tests/rename/should_compile/T22513b.stderr - + testsuite/tests/rename/should_compile/T23434.hs - testsuite/tests/rename/should_compile/all.T Changes: ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -386,7 +386,6 @@ rnImplicitTvOccs :: Maybe assoc -> RnM (a, FreeVars) rnImplicitTvOccs mb_assoc implicit_vs_with_dups thing_inside = do { let implicit_vs = nubN implicit_vs_with_dups - ; mapM_ warn_term_var_capture implicit_vs ; traceRn "rnImplicitTvOccs" $ vcat [ ppr implicit_vs_with_dups, ppr implicit_vs ] @@ -395,7 +394,7 @@ rnImplicitTvOccs mb_assoc implicit_vs_with_dups thing_inside -- See Note [Source locations for implicitly bound type variables]. ; loc <- getSrcSpanM ; let loc' = noAnnSrcSpan loc - ; vars <- mapM (newTyVarNameRn mb_assoc . L loc' . unLoc) implicit_vs + ; vars <- mapM (newTyVarNameRnImplicit mb_assoc . L loc' . unLoc) implicit_vs ; bindLocalNamesFV vars $ thing_inside vars } @@ -1136,6 +1135,7 @@ bindHsOuterTyVarBndrs doc mb_cls implicit_vars outer_bndrs thing_inside = thing_inside $ HsOuterExplicit { hso_xexplicit = noExtField , hso_bndrs = exp_bndrs' } +-- See Note [Term variable capture and implicit quantification] warn_term_var_capture :: LocatedN RdrName -> RnM () warn_term_var_capture lVar = do gbl_env <- getGlobalRdrEnv @@ -1242,15 +1242,68 @@ rnHsBndrVis :: HsBndrVis GhcPs -> HsBndrVis GhcRn rnHsBndrVis HsBndrRequired = HsBndrRequired rnHsBndrVis (HsBndrInvisible at) = HsBndrInvisible at -newTyVarNameRn :: Maybe a -- associated class - -> LocatedN RdrName -> RnM Name -newTyVarNameRn mb_assoc lrdr@(L _ rdr) +newTyVarNameRn, newTyVarNameRnImplicit + :: Maybe a -- associated class + -> LocatedN RdrName -> RnM Name +newTyVarNameRn mb_assoc = new_tv_name_rn mb_assoc newLocalBndrRn +newTyVarNameRnImplicit mb_assoc = new_tv_name_rn mb_assoc $ \lrdr -> + do { warn_term_var_capture lrdr + ; newLocalBndrRn lrdr } + +new_tv_name_rn :: Maybe a -- associated class + -> (LocatedN RdrName -> RnM Name) -- how to create a new name + -> (LocatedN RdrName -> RnM Name) +new_tv_name_rn Nothing cont lrdr = cont lrdr +new_tv_name_rn (Just _) cont lrdr@(L _ rdr) = do { rdr_env <- getLocalRdrEnv - ; case (mb_assoc, lookupLocalRdrEnv rdr_env rdr) of - (Just _, Just n) -> return n - -- Use the same Name as the parent class decl + ; case lookupLocalRdrEnv rdr_env rdr of + Just n -> return n -- Use the same Name as the parent class decl + _ -> cont lrdr } + +{- Note [Term variable capture and implicit quantification] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-Wterm-variable-capture is a warning introduced in GHC Proposal #281 "Visible forall in types of terms", +Section 7.3: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0281-visible-forall.rst#73implicit-quantification + +Its purpose is to notify users when implicit quantification occurs that would +stop working under RequiredTypeArguments (a future GHC extension). Example: + + a = 42 + id :: a -> a + +As it stands, the `a` in the signature `id :: a -> a` is considered free and +leads to implicit quantification, as if the user wrote `id :: forall a. a -> a`. +Under RequiredTypeArguments it will capture the term-level variable `a` (bound by `a = 42`), +leading to a type error. + +`warn_term_var_capture` detects this by demoting the namespace of the +implicitly quantified type variable (`TvName` becomes `VarName`) and looking it up +in the environment. But when do we call `warn_term_var_capture`? It's tempting +to do so at the start of `rnImplicitTvOccs`, as soon as we know our implicit +variables: + + rnImplicitTvOccs mb_assoc implicit_vs_with_dups thing_inside + = do { let implicit_vs = nubN implicit_vs_with_dups + ; mapM_ warn_term_var_capture implicit_vs + ... } + +This approach generates false positives (#23434) because it misses a corner +case: class variables in associated types. Consider the following example: + + k = 12 + class C k a where + type AT a :: k -> Type + +If we look at the signature for `AT` in isolation, the `k` looks like a free +variable, so it's passed to `rnImplicitTvOccs`. And if we passed it to +`warn_term_var_capture`, we would find the `k` bound by `k = 12` and report a warning. +But we don't want that: `k` is actually bound in the declaration header of the +parent class. + +The solution is to check if it's a class variable (this is done in `new_tv_name_rn`) +before we check for term variable capture. +-} - _ -> newLocalBndrRn lrdr } {- ********************************************************* * * ===================================== testsuite/tests/rename/should_compile/T22513b.stderr ===================================== @@ -1,4 +1,5 @@ -T22513b.hs:5:6: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513b.hs:5:1: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘id’ is implicitly quantified, even though another variable of the same name is in scope: ‘id’ imported from ‘Prelude’ at T22513b.hs:3:17-18 ===================================== testsuite/tests/rename/should_compile/T23434.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -Wterm-variable-capture #-} +module T23434 where + +import GHC.Types (Type) + +k = 12 + +class C k a where + type AT a :: k -> Type ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -211,3 +211,4 @@ test('GHCIImplicitImportNullaryRecordWildcard', combined_output, ghci_script, [' test('T22122', [expect_broken(22122), extra_files(['T22122_aux.hs'])], multimod_compile, ['T22122', '-v0']) test('T23240', [req_th, extra_files(['T23240_aux.hs'])], multimod_compile, ['T23240', '-v0']) test('T23318', normal, compile, ['-Wduplicate-exports']) +test('T23434', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/37540e05806e922419cf9cea64a2fa5ae160d414 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/37540e05806e922419cf9cea64a2fa5ae160d414 You're receiving 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 Jun 9 09:53:59 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 09 Jun 2023 05:53:59 -0400 Subject: [Git][ghc/ghc][wip/tsan/fixes] 2 commits: compiler: Ensure that array reads have necessary barriers Message-ID: <6482f6b79706b_2262121306668039698e@gitlab.mail> Ben Gamari pushed to branch wip/tsan/fixes at Glasgow Haskell Compiler / GHC Commits: db1049ef by Ben Gamari at 2023-06-09T05:51:45-04:00 compiler: Ensure that array reads have necessary barriers - - - - - 0570805b by Ben Gamari at 2023-06-09T05:53:49-04:00 Drop dead code - - - - - 2 changed files: - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/StgToCmm/Prim.hs Changes: ===================================== compiler/GHC/Cmm/Pipeline.hs ===================================== @@ -364,18 +364,6 @@ runUniqSM m = do us <- mkSplitUniqSupply 'u' return (initUs_ us m) - -dumpGraph :: Logger -> Platform -> Bool -> DumpFlag -> String -> CmmGraph -> IO () -dumpGraph logger platform do_linting flag name g = do - when do_linting $ do_lint g - dumpWith logger flag name FormatCMM (pdoc platform g) - where - do_lint g = case cmmLintGraph platform g of - Just err -> do { fatalErrorMsg logger err - ; ghcExit logger 1 - } - Nothing -> return () - dumpWith :: Logger -> DumpFlag -> String -> DumpFormat -> SDoc -> IO () dumpWith logger flag txt fmt sdoc = do putDumpFileMaybe logger flag txt fmt sdoc ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -2043,7 +2043,7 @@ doIndexOffAddrOp :: Maybe MachOp -> [CmmExpr] -> FCode () doIndexOffAddrOp maybe_post_read_cast rep [res] [addr,idx] - = mkBasicIndexedRead NaturallyAligned 0 maybe_post_read_cast rep res addr rep idx + = mkBasicIndexedRead False NaturallyAligned 0 maybe_post_read_cast rep res addr rep idx doIndexOffAddrOp _ _ _ _ = panic "GHC.StgToCmm.Prim: doIndexOffAddrOp" @@ -2055,7 +2055,7 @@ doIndexOffAddrOpAs :: Maybe MachOp -> FCode () doIndexOffAddrOpAs maybe_post_read_cast rep idx_rep [res] [addr,idx] = let alignment = alignmentFromTypes rep idx_rep - in mkBasicIndexedRead alignment 0 maybe_post_read_cast rep res addr idx_rep idx + in mkBasicIndexedRead False alignment 0 maybe_post_read_cast rep res addr idx_rep idx doIndexOffAddrOpAs _ _ _ _ _ = panic "GHC.StgToCmm.Prim: doIndexOffAddrOpAs" @@ -2067,7 +2067,7 @@ doIndexByteArrayOp :: Maybe MachOp doIndexByteArrayOp maybe_post_read_cast rep [res] [addr,idx] = do profile <- getProfile doByteArrayBoundsCheck idx addr rep rep - mkBasicIndexedRead NaturallyAligned (arrWordsHdrSize profile) maybe_post_read_cast rep res addr rep idx + mkBasicIndexedRead False NaturallyAligned (arrWordsHdrSize profile) maybe_post_read_cast rep res addr rep idx doIndexByteArrayOp _ _ _ _ = panic "GHC.StgToCmm.Prim: doIndexByteArrayOp" @@ -2081,7 +2081,7 @@ doIndexByteArrayOpAs maybe_post_read_cast rep idx_rep [res] [addr,idx] = do profile <- getProfile doByteArrayBoundsCheck idx addr idx_rep rep let alignment = alignmentFromTypes rep idx_rep - mkBasicIndexedRead alignment (arrWordsHdrSize profile) maybe_post_read_cast rep res addr idx_rep idx + mkBasicIndexedRead False alignment (arrWordsHdrSize profile) maybe_post_read_cast rep res addr idx_rep idx doIndexByteArrayOpAs _ _ _ _ _ = panic "GHC.StgToCmm.Prim: doIndexByteArrayOpAs" @@ -2093,7 +2093,7 @@ doReadPtrArrayOp res addr idx = do profile <- getProfile platform <- getPlatform doPtrArrayBoundsCheck idx addr - mkBasicIndexedRead NaturallyAligned (arrPtrsHdrSize profile) Nothing (gcWord platform) res addr (gcWord platform) idx + mkBasicIndexedRead True NaturallyAligned (arrPtrsHdrSize profile) Nothing (gcWord platform) res addr (gcWord platform) idx doWriteOffAddrOp :: Maybe MachOp -> CmmType @@ -2149,7 +2149,8 @@ doWritePtrArrayOp addr idx val (CmmMachOp (mo_wordUShr platform) [idx, mkIntExpr platform (pc_MUT_ARR_PTRS_CARD_BITS (platformConstants platform))]) ) (CmmLit (CmmInt 1 W8)) -mkBasicIndexedRead :: AlignmentSpec +mkBasicIndexedRead :: Bool -- Should this imply an acquire barrier + -> AlignmentSpec -> ByteOff -- Initial offset in bytes -> Maybe MachOp -- Optional result cast -> CmmType -- Type of element we are accessing @@ -2158,13 +2159,23 @@ mkBasicIndexedRead :: AlignmentSpec -> CmmType -- Type of element by which we are indexing -> CmmExpr -- Index -> FCode () -mkBasicIndexedRead alignment off Nothing ty res base idx_ty idx - = do platform <- getPlatform - emitAssign (CmmLocal res) (cmmLoadIndexOffExpr platform alignment off ty base idx_ty idx) -mkBasicIndexedRead alignment off (Just cast) ty res base idx_ty idx +mkBasicIndexedRead barrier alignment off mb_cast ty res base idx_ty idx = do platform <- getPlatform - emitAssign (CmmLocal res) (CmmMachOp cast [ - cmmLoadIndexOffExpr platform alignment off ty base idx_ty idx]) + let addr = cmmIndexOffExpr platform off (typeWidth idx_ty) base idx + result <- + if barrier + then do + res <- newTemp ty + emitPrimCall [res] (MO_AtomicRead (typeWidth ty) MemOrderAcquire) [addr] + return $ CmmReg (CmmLocal res) + else + return $ CmmLoad addr ty alignment + + let casted = + case mb_cast of + Just cast -> CmmMachOp cast [result] + Nothing -> result + emitAssign (CmmLocal res) casted mkBasicIndexedWrite :: Bool -- Should this imply a release barrier -> ByteOff -- Initial offset in bytes @@ -2994,7 +3005,7 @@ doReadSmallPtrArrayOp res addr idx = do profile <- getProfile platform <- getPlatform doSmallPtrArrayBoundsCheck idx addr - mkBasicIndexedRead NaturallyAligned (smallArrPtrsHdrSize profile) Nothing (gcWord platform) res addr + mkBasicIndexedRead True NaturallyAligned (smallArrPtrsHdrSize profile) Nothing (gcWord platform) res addr (gcWord platform) idx doWriteSmallPtrArrayOp :: CmmExpr @@ -3010,7 +3021,7 @@ doWriteSmallPtrArrayOp addr idx val = do -- Update remembered set for non-moving collector tmp <- newTemp ty - mkBasicIndexedRead NaturallyAligned (smallArrPtrsHdrSize profile) Nothing ty tmp addr ty idx + mkBasicIndexedRead False NaturallyAligned (smallArrPtrsHdrSize profile) Nothing ty tmp addr ty idx whenUpdRemSetEnabled $ emitUpdRemSetPush (CmmReg (CmmLocal tmp)) -- Write barrier needed due to #12469 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/db98923f70606b156f3cf82147ff6ca4172aed14...0570805bbc05765ebb1cf6c11bca25fd68563e0c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/db98923f70606b156f3cf82147ff6ca4172aed14...0570805bbc05765ebb1cf6c11bca25fd68563e0c You're receiving 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 Jun 9 09:54:55 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 09 Jun 2023 05:54:55 -0400 Subject: [Git][ghc/ghc][wip/tsan/fixes] Fix whitespace Message-ID: <6482f6ef13a2e_226212128656ac402515@gitlab.mail> Spam detection software, running on the system "mail.haskell.org", has identified this incoming email as possible spam. The original message has been attached to this so you can view it (if it isn't spam) or label similar future email. If you have any questions, see @@CONTACT_ADDRESS@@ for details. Content preview: Ben Gamari pushed to branch wip/tsan/fixes at Glasgow Haskell Compiler / GHC Commits: 3fe01c5a by Ben Gamari at 2023-06-09T05:54:46-04:00 Fix whitespace - - - - - [...] Content analysis details: (6.9 points, 5.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- -0.0 T_RP_MATCHES_RCVD Envelope sender domain matches handover relay domain 1.1 URI_HEX URI: URI hostname has long hexadecimal sequence 5.0 UNWANTED_LANGUAGE_BODY BODY: Message written in an undesired language 0.0 HTML_MESSAGE BODY: HTML included in message 0.8 BAYES_50 BODY: Bayes spam probability is 40 to 60% [score: 0.4777] 0.0 T_DKIM_INVALID DKIM-Signature header exists but is not valid The original message was not completely plain text, and may be unsafe to open with some email clients; in particular, it may contain a virus, or confirm that your address can receive spam. If you wish to view it, it may be safer to save it to a file and open it with an editor. -------------- next part -------------- An embedded message was scrubbed... From: "Ben Gamari (@bgamari)" Subject: [Git][ghc/ghc][wip/tsan/fixes] Fix whitespace Date: Fri, 09 Jun 2023 05:54:55 -0400 Size: 19136 URL: From gitlab at gitlab.haskell.org Fri Jun 9 09:57:02 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Fri, 09 Jun 2023 05:57:02 -0400 Subject: [Git][ghc/ghc][wip/int-index/hdk-register-tok] Register LHsToken in Parser.PostProcess.Haddock Message-ID: <6482f76ee21d2_226212130666944029ab@gitlab.mail> Andrei Borzenkov pushed to branch wip/int-index/hdk-register-tok at Glasgow Haskell Compiler / GHC Commits: e95b4eb4 by Vladislav Zavialov at 2023-06-09T13:56:50+04:00 Register LHsToken in Parser.PostProcess.Haddock - - - - - 4 changed files: - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.hs - testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr Changes: ===================================== compiler/GHC/Parser/Annotation.hs ===================================== @@ -15,7 +15,7 @@ module GHC.Parser.Annotation ( AddEpAnn(..), EpaLocation(..), epaLocationRealSrcSpan, epaLocationFromSrcAnn, TokenLocation(..), - getTokenSrcSpan, + getTokenSrcSpan, getTokenBufSpan, DeltaPos(..), deltaPos, getDeltaLine, EpAnn(..), Anchor(..), AnchorOperation(..), @@ -418,6 +418,11 @@ getTokenSrcSpan NoTokenLoc = noSrcSpan getTokenSrcSpan (TokenLoc EpaDelta{}) = noSrcSpan getTokenSrcSpan (TokenLoc (EpaSpan rspan mbufpos)) = RealSrcSpan rspan mbufpos +getTokenBufSpan :: TokenLocation -> Strict.Maybe BufSpan +getTokenBufSpan (TokenLoc (EpaSpan _ mbspan)) = mbspan +getTokenBufSpan (TokenLoc EpaDelta{}) = Strict.Nothing +getTokenBufSpan NoTokenLoc = Strict.Nothing + instance Outputable a => Outputable (GenLocated TokenLocation a) where ppr (L _ x) = ppr x ===================================== compiler/GHC/Parser/PostProcess/Haddock.hs ===================================== @@ -62,7 +62,6 @@ import Data.Traversable import Data.Maybe import Data.List.NonEmpty (nonEmpty) import qualified Data.List.NonEmpty as NE -import Control.Monad import Control.Monad.Trans.State.Strict import Control.Monad.Trans.Reader import Control.Monad.Trans.Writer @@ -249,15 +248,17 @@ instance HasHaddock (Located (HsModule GhcPs)) where -- module M where -- -- Only do this when the module header exists. - headerDocs <- - for @Maybe (hsmodName mod) $ \(L l_name _) -> - extendHdkA (locA l_name) $ liftHdkA $ do - -- todo: register keyword location of 'module', see Note [Register keyword location] - docs <- - inLocRange (locRangeTo (getBufPos (srcSpanStart (locA l_name)))) $ - takeHdkComments mkDocNext - dc <- selectDocString docs - pure $ lexLHsDocString <$> dc + headerDocs <- case modToks of + HsNoModTk -> pure Nothing + _ -> + liftHdkA $ do + docs <- + inLocRange (locRangeTo (getBufPos (srcSpanStart modSigTokenLocation))) $ + takeHdkComments mkDocNext + dc <- selectDocString docs + pure $ lexLHsDocString <$> dc + + traverse_ @Maybe registerHdkA (hsmodName mod) -- Step 2, process documentation comments in the export list: -- @@ -272,6 +273,7 @@ instance HasHaddock (Located (HsModule GhcPs)) where -- -- Only do this when the export list exists. hsmodExports' <- traverse @Maybe addHaddock (hsmodExports mod) + traverse_ @Strict.Maybe registerTokenHdkA whereTk -- Step 3, register the import section to reject invalid comments: -- @@ -295,7 +297,19 @@ instance HasHaddock (Located (HsModule GhcPs)) where pure $ L l_mod $ mod { hsmodExports = hsmodExports' , hsmodDecls = hsmodDecls' - , hsmodExt = (hsmodExt mod) { hsmodHaddockModHeader = join @Maybe headerDocs } } + , hsmodExt = (hsmodExt mod) { hsmodHaddockModHeader = headerDocs } } + where + modToks = hsmodHeaderTokens mod + + modSigTokenLocation = case modToks of + HsNoModTk -> noSrcSpan + HsSigTk sigTok _ -> getTokenSrcSpan $ getLoc sigTok + HsModTk modTok _ -> getTokenSrcSpan $ getLoc modTok + + whereTk = case modToks of + HsNoModTk -> Strict.Nothing + HsSigTk _ tok -> Strict.Just tok + HsModTk _ tok -> Strict.Just tok lexHsDocString :: HsDocString -> HsDoc GhcPs lexHsDocString = lexHsDoc parseIdentifier @@ -313,7 +327,6 @@ instance HasHaddock (LocatedL [LocatedA (IE GhcPs)]) where addHaddock (L l_exports exports) = extendHdkA (locA l_exports) $ do exports' <- addHaddockInterleaveItems NoLayoutInfo mkDocIE exports - registerLocHdkA (srcLocSpan (srcSpanEnd (locA l_exports))) -- Do not consume comments after the closing parenthesis pure $ L l_exports exports' -- Needed to use 'addHaddockInterleaveItems' in 'instance HasHaddock (Located [LIE GhcPs])'. @@ -481,13 +494,18 @@ instance HasHaddock (HsDecl GhcPs) where addHaddock (TyClD x decl) | DataDecl { tcdDExt, tcdTkNewOrData, tcdLName, tcdTyVars, tcdTkWhere, tcdFixity, tcdDataDefn = defn } <- decl = do + registerNewOrDataTokHdkA tcdTkNewOrData registerHdkA tcdLName + traverse_ @Strict.Maybe registerTokenHdkA tcdTkWhere defn' <- addHaddock defn pure $ TyClD x (DataDecl { tcdDExt, tcdTkNewOrData, tcdLName, tcdTyVars, tcdTkWhere, tcdFixity, tcdDataDefn = defn' }) + where + registerNewOrDataTokHdkA (NewTypeToken tok) = registerTokenHdkA tok + registerNewOrDataTokHdkA (DataTypeToken tok) = registerTokenHdkA tok -- Class declarations: -- @@ -502,8 +520,9 @@ instance HasHaddock (HsDecl GhcPs) where tcdCtxt, tcdLName, tcdTyVars, tcdFixity, tcdFDs, tcdTkWhere, tcdSigs, tcdMeths, tcdATs, tcdATDefs } <- decl = do + registerTokenHdkA tcdTkClass registerHdkA tcdLName - -- todo: register keyword location of 'where', see Note [Register keyword location] + traverse_ @Strict.Maybe registerTokenHdkA tcdTkWhere where_cls' <- addHaddockInterleaveItems tcdLayout (mkDocHsDecl tcdLayout) $ flattenBindsAndSigs (tcdMeths, tcdSigs, tcdATs, tcdATDefs, [], []) @@ -1158,6 +1177,13 @@ registerLocHdkA l = HdkA (getBufSpan l) (pure ()) registerHdkA :: GenLocated (SrcSpanAnn' a) e -> HdkA () registerHdkA a = registerLocHdkA (getLocA a) +-- Let the neighbours know about a token at this location. +-- Similar to registerLocHdkA and registerHdkA. +-- +-- See Note [Adding Haddock comments to the syntax tree]. +registerTokenHdkA :: LHsToken tok GhcPs -> HdkA () +registerTokenHdkA (L l _) = HdkA (getTokenBufSpan l) (pure ()) + -- Modify the action of a HdkA computation. hoistHdkA :: (HdkM a -> HdkM b) -> HdkA a -> HdkA b hoistHdkA f (HdkA l m) = HdkA l (f m) ===================================== testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.hs ===================================== @@ -1,16 +1,16 @@ {-# LANGUAGE GADTs #-} {-# OPTIONS -haddock -ddump-parsed-ast #-} --- Haddock comments in this test case should all be rejected, but they are not. --- --- This is a known issue. Users should avoid writing comments in such --- positions, as a future fix will disallow them. +-- Haddock comments in this test case all are rejected. -- -- See Note [Register keyword location] in GHC.Parser.PostProcess.Haddock module -- | Bad comment for the module - T17544_kw where + T17544_kw ( + Foo(..), + Bar(..), + Cls(..)) where data Foo -- | Bad comment for MkFoo where MkFoo :: Foo ===================================== testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr ===================================== @@ -10,8 +10,8 @@ { T17544_kw.hs:1:1 } (UnchangedAnchor)) (AnnsModule - [(AddEpAnn AnnModule (EpaSpan { T17544_kw.hs:11:1-6 })) - ,(AddEpAnn AnnWhere (EpaSpan { T17544_kw.hs:13:13-17 }))] + [(AddEpAnn AnnModule (EpaSpan { T17544_kw.hs:8:1-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544_kw.hs:13:12-16 }))] [] (Just ((,) @@ -23,33 +23,115 @@ (VirtualBraces (1)) (Nothing) - (Just - (L - { T17544_kw.hs:12:3-33 } - (WithHsDocIdentifiers - (MultiLineDocString - (HsDocStringNext) - (:| - (L - { T17544_kw.hs:12:7-33 } - (HsDocStringChunk - " Bad comment for the module")) - [])) - [])))) + (Nothing)) (HsModTk (L (TokenLoc - (EpaSpan { T17544_kw.hs:11:1-6 })) + (EpaSpan { T17544_kw.hs:8:1-6 })) (HsTok)) (L (TokenLoc - (EpaSpan { T17544_kw.hs:13:13-17 })) + (EpaSpan { T17544_kw.hs:13:12-16 })) (HsTok))) (Just (L - (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:13:3-11 }) + (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:10:3-11 }) {ModuleName: T17544_kw})) - (Nothing) + (Just + (L + (SrcSpanAnn (EpAnn + (Anchor + { T17544_kw.hs:(10,13)-(13,10) } + (UnchangedAnchor)) + (AnnList + (Nothing) + (Just + (AddEpAnn AnnOpenP (EpaSpan { T17544_kw.hs:10:13 }))) + (Just + (AddEpAnn AnnCloseP (EpaSpan { T17544_kw.hs:13:10 }))) + [] + []) + (EpaComments + [])) { T17544_kw.hs:(10,13)-(13,10) }) + [(L + (SrcSpanAnn (EpAnn + (Anchor + { T17544_kw.hs:11:3-9 } + (UnchangedAnchor)) + (AnnListItem + [(AddCommaAnn + (EpaSpan { T17544_kw.hs:11:10 }))]) + (EpaComments + [])) { T17544_kw.hs:11:3-9 }) + (IEThingAll + (EpAnn + (Anchor + { T17544_kw.hs:11:3-5 } + (UnchangedAnchor)) + [(AddEpAnn AnnDotdot (EpaSpan { T17544_kw.hs:11:7-8 })) + ,(AddEpAnn AnnOpenP (EpaSpan { T17544_kw.hs:11:6 })) + ,(AddEpAnn AnnCloseP (EpaSpan { T17544_kw.hs:11:9 })) + ,(AddEpAnn AnnDotdot (EpaSpan { T17544_kw.hs:11:7-8 }))] + (EpaComments + [])) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:11:3-5 }) + (IEName + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:11:3-5 }) + (Unqual + {OccName: Foo})))))) + ,(L + (SrcSpanAnn (EpAnn + (Anchor + { T17544_kw.hs:12:3-9 } + (UnchangedAnchor)) + (AnnListItem + [(AddCommaAnn + (EpaSpan { T17544_kw.hs:12:10 }))]) + (EpaComments + [])) { T17544_kw.hs:12:3-9 }) + (IEThingAll + (EpAnn + (Anchor + { T17544_kw.hs:12:3-5 } + (UnchangedAnchor)) + [(AddEpAnn AnnDotdot (EpaSpan { T17544_kw.hs:12:7-8 })) + ,(AddEpAnn AnnOpenP (EpaSpan { T17544_kw.hs:12:6 })) + ,(AddEpAnn AnnCloseP (EpaSpan { T17544_kw.hs:12:9 })) + ,(AddEpAnn AnnDotdot (EpaSpan { T17544_kw.hs:12:7-8 }))] + (EpaComments + [])) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:12:3-5 }) + (IEName + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:12:3-5 }) + (Unqual + {OccName: Bar})))))) + ,(L + (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:13:3-9 }) + (IEThingAll + (EpAnn + (Anchor + { T17544_kw.hs:13:3-5 } + (UnchangedAnchor)) + [(AddEpAnn AnnDotdot (EpaSpan { T17544_kw.hs:13:7-8 })) + ,(AddEpAnn AnnOpenP (EpaSpan { T17544_kw.hs:13:6 })) + ,(AddEpAnn AnnCloseP (EpaSpan { T17544_kw.hs:13:9 })) + ,(AddEpAnn AnnDotdot (EpaSpan { T17544_kw.hs:13:7-8 }))] + (EpaComments + [])) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:13:3-5 }) + (IEName + (NoExtField) + (L + (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:13:3-5 }) + (Unqual + {OccName: Cls}))))))])) [] [(L (SrcSpanAnn (EpAnn @@ -138,19 +220,7 @@ (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:16:18-20 }) (Unqual {OccName: Foo})))) - (Just - (L - { T17544_kw.hs:15:10-35 } - (WithHsDocIdentifiers - (MultiLineDocString - (HsDocStringNext) - (:| - (L - { T17544_kw.hs:15:14-35 } - (HsDocStringChunk - " Bad comment for MkFoo")) - [])) - [])))))]) + (Nothing)))]) [])))) ,(L (SrcSpanAnn (EpAnn @@ -265,19 +335,7 @@ (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:19:24-26 }) (Unqual {OccName: Bar})))) - (Just - (L - { T17544_kw.hs:18:13-38 } - (WithHsDocIdentifiers - (MultiLineDocString - (HsDocStringNext) - (:| - (L - { T17544_kw.hs:18:17-38 } - (HsDocStringChunk - " Bad comment for MkBar")) - [])) - [])))))) + (Nothing)))) [])))) ,(L (SrcSpanAnn (EpAnn @@ -378,20 +436,18 @@ []} [] [] - [(L - (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:22:5-34 }) - (DocCommentNext - (L - { T17544_kw.hs:22:5-34 } - (WithHsDocIdentifiers - (MultiLineDocString - (HsDocStringNext) - (:| - (L - { T17544_kw.hs:22:9-34 } - (HsDocStringChunk - " Bad comment for clsmethod")) - [])) - []))))])))])) + [])))])) + + + +T17544_kw.hs:9:3: warning: [GHC-94458] [-Winvalid-haddock] + A Haddock comment cannot appear in this position and will be ignored. + +T17544_kw.hs:15:10: warning: [GHC-94458] [-Winvalid-haddock] + A Haddock comment cannot appear in this position and will be ignored. +T17544_kw.hs:18:13: warning: [GHC-94458] [-Winvalid-haddock] + A Haddock comment cannot appear in this position and will be ignored. +T17544_kw.hs:22:5: warning: [GHC-94458] [-Winvalid-haddock] + A Haddock comment cannot appear in this position and will be ignored. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e95b4eb406ccc24ce1d30cea104b7ac04bdac3e6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e95b4eb406ccc24ce1d30cea104b7ac04bdac3e6 You're receiving 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 Jun 9 10:05:56 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 09 Jun 2023 06:05:56 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/js-number-note-refs Message-ID: <6482f98422b4a_226212130bd944412735@gitlab.mail> Ben Gamari pushed new branch wip/js-number-note-refs at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/js-number-note-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 Fri Jun 9 10:06:13 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 09 Jun 2023 06:06:13 -0400 Subject: [Git][ghc/ghc][wip/t23454] 26 commits: Big TcLclEnv and CtLoc refactoring Message-ID: <6482f995a64a7_22621212ea97c0412921@gitlab.mail> Matthew Pickering pushed to branch wip/t23454 at Glasgow Haskell Compiler / GHC Commits: 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 95d18388 by Matthew Pickering at 2023-06-09T11:05:42+01:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - compiler/GHC/Builtin/Names/TH.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Plugins.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5988803eb2d823cb95c0fbfd7f175f61761620b3...95d183883eea45c2d58df73f0c50722b558af457 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5988803eb2d823cb95c0fbfd7f175f61761620b3...95d183883eea45c2d58df73f0c50722b558af457 You're receiving 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 Jun 9 10:19:59 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Fri, 09 Jun 2023 06:19:59 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/#23434-wterm-variable-capture] Fix -Wterm-variable-capture scope (#23434) Message-ID: <6482fccf84922_e2555c4e786069d@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/#23434-wterm-variable-capture at Glasgow Haskell Compiler / GHC Commits: 3042a293 by Andrei Borzenkov at 2023-06-09T14:19:47+04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 3 changed files: - compiler/GHC/Rename/HsType.hs - + testsuite/tests/rename/should_compile/T23434.hs - testsuite/tests/rename/should_compile/all.T Changes: ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -386,7 +386,6 @@ rnImplicitTvOccs :: Maybe assoc -> RnM (a, FreeVars) rnImplicitTvOccs mb_assoc implicit_vs_with_dups thing_inside = do { let implicit_vs = nubN implicit_vs_with_dups - ; mapM_ warn_term_var_capture implicit_vs ; traceRn "rnImplicitTvOccs" $ vcat [ ppr implicit_vs_with_dups, ppr implicit_vs ] @@ -395,7 +394,7 @@ rnImplicitTvOccs mb_assoc implicit_vs_with_dups thing_inside -- See Note [Source locations for implicitly bound type variables]. ; loc <- getSrcSpanM ; let loc' = noAnnSrcSpan loc - ; vars <- mapM (newTyVarNameRn mb_assoc . L loc' . unLoc) implicit_vs + ; vars <- mapM (newTyVarNameRnImplicit mb_assoc . L loc' . unLoc) implicit_vs ; bindLocalNamesFV vars $ thing_inside vars } @@ -1136,6 +1135,7 @@ bindHsOuterTyVarBndrs doc mb_cls implicit_vars outer_bndrs thing_inside = thing_inside $ HsOuterExplicit { hso_xexplicit = noExtField , hso_bndrs = exp_bndrs' } +-- See Note [Term variable capture and implicit quantification] warn_term_var_capture :: LocatedN RdrName -> RnM () warn_term_var_capture lVar = do gbl_env <- getGlobalRdrEnv @@ -1242,15 +1242,68 @@ rnHsBndrVis :: HsBndrVis GhcPs -> HsBndrVis GhcRn rnHsBndrVis HsBndrRequired = HsBndrRequired rnHsBndrVis (HsBndrInvisible at) = HsBndrInvisible at -newTyVarNameRn :: Maybe a -- associated class - -> LocatedN RdrName -> RnM Name -newTyVarNameRn mb_assoc lrdr@(L _ rdr) +newTyVarNameRn, newTyVarNameRnImplicit + :: Maybe a -- associated class + -> LocatedN RdrName -> RnM Name +newTyVarNameRn mb_assoc = new_tv_name_rn mb_assoc newLocalBndrRn +newTyVarNameRnImplicit mb_assoc = new_tv_name_rn mb_assoc $ \lrdr -> + do { warn_term_var_capture lrdr + ; newLocalBndrRn lrdr } + +new_tv_name_rn :: Maybe a -- associated class + -> (LocatedN RdrName -> RnM Name) -- how to create a new name + -> (LocatedN RdrName -> RnM Name) +new_tv_name_rn Nothing cont lrdr = cont lrdr +new_tv_name_rn (Just _) cont lrdr@(L _ rdr) = do { rdr_env <- getLocalRdrEnv - ; case (mb_assoc, lookupLocalRdrEnv rdr_env rdr) of - (Just _, Just n) -> return n - -- Use the same Name as the parent class decl + ; case lookupLocalRdrEnv rdr_env rdr of + Just n -> return n -- Use the same Name as the parent class decl + _ -> cont lrdr } + +{- Note [Term variable capture and implicit quantification] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-Wterm-variable-capture is a warning introduced in GHC Proposal #281 "Visible forall in types of terms", +Section 7.3: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0281-visible-forall.rst#73implicit-quantification + +Its purpose is to notify users when implicit quantification occurs that would +stop working under RequiredTypeArguments (a future GHC extension). Example: + + a = 42 + id :: a -> a + +As it stands, the `a` in the signature `id :: a -> a` is considered free and +leads to implicit quantification, as if the user wrote `id :: forall a. a -> a`. +Under RequiredTypeArguments it will capture the term-level variable `a` (bound by `a = 42`), +leading to a type error. + +`warn_term_var_capture` detects this by demoting the namespace of the +implicitly quantified type variable (`TvName` becomes `VarName`) and looking it up +in the environment. But when do we call `warn_term_var_capture`? It's tempting +to do so at the start of `rnImplicitTvOccs`, as soon as we know our implicit +variables: + + rnImplicitTvOccs mb_assoc implicit_vs_with_dups thing_inside + = do { let implicit_vs = nubN implicit_vs_with_dups + ; mapM_ warn_term_var_capture implicit_vs + ... } + +This approach generates false positives (#23434) because it misses a corner +case: class variables in associated types. Consider the following example: + + k = 12 + class C k a where + type AT a :: k -> Type + +If we look at the signature for `AT` in isolation, the `k` looks like a free +variable, so it's passed to `rnImplicitTvOccs`. And if we passed it to +`warn_term_var_capture`, we would find the `k` bound by `k = 12` and report a warning. +But we don't want that: `k` is actually bound in the declaration header of the +parent class. + +The solution is to check if it's a class variable (this is done in `new_tv_name_rn`) +before we check for term variable capture. +-} - _ -> newLocalBndrRn lrdr } {- ********************************************************* * * ===================================== testsuite/tests/rename/should_compile/T23434.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -Wterm-variable-capture #-} +module T23434 where + +import GHC.Types (Type) + +k = 12 + +class C k a where + type AT a :: k -> Type ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -211,3 +211,4 @@ test('GHCIImplicitImportNullaryRecordWildcard', combined_output, ghci_script, [' test('T22122', [expect_broken(22122), extra_files(['T22122_aux.hs'])], multimod_compile, ['T22122', '-v0']) test('T23240', [req_th, extra_files(['T23240_aux.hs'])], multimod_compile, ['T23240', '-v0']) test('T23318', normal, compile, ['-Wduplicate-exports']) +test('T23434', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3042a2939d58ec0c0eb8d1a1df0839a4e3026000 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3042a2939d58ec0c0eb8d1a1df0839a4e3026000 You're receiving 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 Jun 9 11:57:19 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 09 Jun 2023 07:57:19 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Restore mingwex dependency on Windows Message-ID: <6483139f21585_e2555c4eb4944f7@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 4 changed files: - configure.ac - libraries/base/base.cabal - libraries/ghc-prim/ghc-prim.cabal - rts/RtsSymbols.c Changes: ===================================== configure.ac ===================================== @@ -917,6 +917,9 @@ AC_CHECK_DECLS([program_invocation_short_name], , , [#define _GNU_SOURCE 1 #include ]) +dnl ** check for mingwex library +AC_CHECK_LIB([mingwex],[closedir]) + dnl ** check for math library dnl Keep that check as early as possible. dnl as we need to know whether we need libm ===================================== libraries/base/base.cabal ===================================== @@ -398,6 +398,7 @@ Library if os(windows) -- Windows requires some extra libraries for linking because the RTS -- is no longer re-exporting them. + -- mingwex: provides GNU POSIX extensions that aren't provided by ucrt. -- 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 +411,7 @@ Library -- advapi32: provides advanced kernel functions extra-libraries: wsock32, user32, shell32, mingw32, kernel32, advapi32, - ws2_32, shlwapi, ole32, rpcrt4, ntdll + mingwex, 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/ghc-prim/ghc-prim.cabal ===================================== @@ -68,12 +68,13 @@ Library -- is no longer re-exporting them (see #11223) -- ucrt: standard C library. The RTS will automatically include this, -- but is added for completeness. + -- mingwex: provides GNU POSIX extensions that aren't provided by ucrt. -- 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, ucrt + extra-libraries: user32, mingw32, mingwex, ucrt if os(linux) -- we need libm, but for musl and other's we might need libc, as libm ===================================== rts/RtsSymbols.c ===================================== @@ -113,6 +113,26 @@ 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 @@ -150,17 +170,17 @@ extern char **environ; SymI_NeedsProto(__mingw_module_is_dll) \ RTS_WIN32_ONLY(SymI_NeedsProto(___chkstk_ms)) \ RTS_WIN64_ONLY(SymI_NeedsProto(___chkstk_ms)) \ - SymI_HasProto(__mingw_vsnwprintf) \ - /* ^^ Need to figure out why this is needed. */ \ + RTS_WIN64_ONLY(SymI_HasProto(__stdio_common_vswprintf_s)) \ + RTS_WIN64_ONLY(SymI_HasProto(__stdio_common_vswprintf)) \ + RTS_WIN64_ONLY(SymI_HasProto(_errno)) \ + /* see Note [Symbols for MinGW's printf] */ \ + SymI_HasProto(_lock_file) \ + SymI_HasProto(_unlock_file) \ /* See Note [_iob_func symbol] */ \ RTS_WIN64_ONLY(SymI_HasProto_redirect( \ __imp___acrt_iob_func, __rts_iob_func, STRENGTH_WEAK, SYM_TYPE_INDIRECT_DATA)) \ RTS_WIN32_ONLY(SymI_HasProto_redirect( \ - __imp____acrt_iob_func, __rts_iob_func, STRENGTH_WEAK, SYM_TYPE_INDIRECT_DATA)) \ - SymI_HasProto(__mingw_vsnwprintf) \ - /* ^^ Need to figure out why this is needed. */ \ - SymI_HasProto(__mingw_vfprintf) \ - /* ^^ Need to figure out why this is needed. */ + __imp____acrt_iob_func, __rts_iob_func, STRENGTH_WEAK, SYM_TYPE_INDIRECT_DATA)) #else #define RTS_MINGW_ONLY_SYMBOLS /**/ #endif View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/567b32e12cbae07bee78d66252e83a0ad08419be...289547580b6f2808ee123f106c3118b716486d5b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/567b32e12cbae07bee78d66252e83a0ad08419be...289547580b6f2808ee123f106c3118b716486d5b You're receiving 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 Jun 9 11:57:55 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 09 Jun 2023 07:57:55 -0400 Subject: [Git][ghc/ghc][master] Consistently use validity checks for TH conversion of data constructors Message-ID: <648313c3ce60b_e2555c4e789949a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - 9 changed files: - compiler/GHC/ThToHs.hs - compiler/Language/Haskell/Syntax/Decls.hs - + testsuite/tests/th/T22559a.hs - + testsuite/tests/th/T22559a.stderr - + testsuite/tests/th/T22559b.hs - + testsuite/tests/th/T22559b.stderr - + testsuite/tests/th/T22559c.hs - + testsuite/tests/th/T22559c.stderr - testsuite/tests/th/all.T Changes: ===================================== compiler/GHC/ThToHs.hs ===================================== @@ -277,17 +277,13 @@ cvtDec (DataD ctxt tc tvs ksig constrs derivs) cvtDec (NewtypeD ctxt tc tvs ksig constr derivs) = do { (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs ; ksig' <- cvtKind `traverse` ksig - ; let first_datacon = - case get_cons_names constr of - [] -> panic "cvtDec: empty list of constructors" - c:_ -> c - ; con' <- cvtConstr first_datacon cNameN constr + ; con' <- cvtDataDefnCons False ksig $ NewTypeCon constr ; derivs' <- cvtDerivs derivs ; let defn = HsDataDefn { dd_ext = noExtField , dd_cType = Nothing , dd_ctxt = mkHsContextMaybe ctxt' , dd_kindSig = ksig' - , dd_cons = NewTypeCon con' + , dd_cons = con' , dd_derivs = derivs' } ; returnJustLA $ TyClD noExtField $ DataDecl { tcdDExt = noAnn @@ -353,17 +349,13 @@ cvtDec (DataFamilyD tc tvs kind) cvtDec (DataInstD ctxt bndrs tys ksig constrs derivs) = do { (ctxt', tc', bndrs', typats') <- cvt_datainst_hdr ctxt bndrs tys ; ksig' <- cvtKind `traverse` ksig - ; let first_datacon = - case get_cons_names $ head constrs of - [] -> panic "cvtDec: empty list of constructors" - c:_ -> c - ; cons' <- mapM (cvtConstr first_datacon cNameN) constrs + ; cons' <- cvtDataDefnCons False ksig $ DataTypeCons False constrs ; derivs' <- cvtDerivs derivs ; let defn = HsDataDefn { dd_ext = noExtField , dd_cType = Nothing , dd_ctxt = mkHsContextMaybe ctxt' , dd_kindSig = ksig' - , dd_cons = DataTypeCons False cons' + , dd_cons = cons' , dd_derivs = derivs' } ; returnJustLA $ InstD noExtField $ DataFamInstD @@ -379,17 +371,14 @@ cvtDec (DataInstD ctxt bndrs tys ksig constrs derivs) cvtDec (NewtypeInstD ctxt bndrs tys ksig constr derivs) = do { (ctxt', tc', bndrs', typats') <- cvt_datainst_hdr ctxt bndrs tys ; ksig' <- cvtKind `traverse` ksig - ; let first_datacon = - case get_cons_names constr of - [] -> panic "cvtDec: empty list of constructors" - c:_ -> c - ; con' <- cvtConstr first_datacon cNameN constr + ; con' <- cvtDataDefnCons False ksig $ NewTypeCon constr ; derivs' <- cvtDerivs derivs ; let defn = HsDataDefn { dd_ext = noExtField , dd_cType = Nothing , dd_ctxt = mkHsContextMaybe ctxt' , dd_kindSig = ksig' - , dd_cons = NewTypeCon con', dd_derivs = derivs' } + , dd_cons = con' + , dd_derivs = derivs' } ; returnJustLA $ InstD noExtField $ DataFamInstD { dfid_ext = noExtField , dfid_inst = DataFamInstDecl { dfid_eqn = @@ -498,6 +487,28 @@ cvtGenDataDec :: Bool -> TH.Cxt -> TH.Name -> [TH.TyVarBndr TH.BndrVis] -> Maybe TH.Kind -> [TH.Con] -> [TH.DerivClause] -> CvtM (Maybe (LHsDecl GhcPs)) cvtGenDataDec type_data ctxt tc tvs ksig constrs derivs + = do { (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs + ; ksig' <- cvtKind `traverse` ksig + ; cons' <- cvtDataDefnCons type_data ksig $ + DataTypeCons type_data constrs + ; derivs' <- cvtDerivs derivs + ; let defn = HsDataDefn { dd_ext = noExtField + , dd_cType = Nothing + , dd_ctxt = mkHsContextMaybe ctxt' + , dd_kindSig = ksig' + , dd_cons = cons' + , dd_derivs = derivs' } + ; returnJustLA $ TyClD noExtField $ + DataDecl { tcdDExt = noAnn + , tcdLName = tc', tcdTyVars = tvs' + , tcdFixity = Prefix + , tcdDataDefn = defn } } + +-- Convert a set of data constructors. +cvtDataDefnCons :: + Bool -> Maybe TH.Kind -> + DataDefnCons TH.Con -> CvtM (DataDefnCons (LConDecl GhcPs)) +cvtDataDefnCons type_data ksig constrs = do { let isGadtCon (GadtC _ _ _) = True isGadtCon (RecGadtC _ _ _) = True isGadtCon (ForallC _ _ c) = isGadtCon c @@ -515,27 +526,16 @@ cvtGenDataDec type_data ctxt tc tvs ksig constrs derivs (failWith CannotMixGADTConsWith98Cons) ; unless (isNothing ksig || isGadtDecl) (failWith KindSigsOnlyAllowedOnGADTs) - ; (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs - ; ksig' <- cvtKind `traverse` ksig ; let first_datacon = - case get_cons_names $ head constrs of - [] -> panic "cvtGenDataDec: empty list of constructors" + case firstDataDefnCon constrs of + Nothing -> panic "cvtDataDefnCons: empty list of constructors" + Just con -> con + first_datacon_name = + case get_cons_names first_datacon of + [] -> panic "cvtDataDefnCons: data constructor with no names" c:_ -> c - ; cons' <- mapM (cvtConstr first_datacon con_name) constrs - - ; derivs' <- cvtDerivs derivs - ; let defn = HsDataDefn { dd_ext = noExtField - , dd_cType = Nothing - , dd_ctxt = mkHsContextMaybe ctxt' - , dd_kindSig = ksig' - , dd_cons = DataTypeCons type_data cons' - , dd_derivs = derivs' } - ; returnJustLA $ TyClD noExtField $ - DataDecl { tcdDExt = noAnn - , tcdLName = tc', tcdTyVars = tvs' - , tcdFixity = Prefix - , tcdDataDefn = defn } } + ; mapM (cvtConstr first_datacon_name con_name) constrs } ---------------- cvtTySynEqn :: TySynEqn -> CvtM (LTyFamInstEqn GhcPs) ===================================== compiler/Language/Haskell/Syntax/Decls.hs ===================================== @@ -30,7 +30,7 @@ module Language.Haskell.Syntax.Decls ( HsDecl(..), LHsDecl, HsDataDefn(..), HsDeriving, LHsFunDep, FunDep(..), HsDerivingClause(..), LHsDerivingClause, DerivClauseTys(..), LDerivClauseTys, NewOrData(..), DataDefnCons(..), dataDefnConsNewOrData, - isTypeDataDefnCons, + isTypeDataDefnCons, firstDataDefnCon, StandaloneKindSig(..), LStandaloneKindSig, -- ** Class or type declarations @@ -1040,6 +1040,11 @@ isTypeDataDefnCons :: DataDefnCons a -> Bool isTypeDataDefnCons (NewTypeCon _) = False isTypeDataDefnCons (DataTypeCons is_type_data _) = is_type_data +-- | Retrieve the first data constructor in a 'DataDefnCons' (if one exists). +firstDataDefnCon :: DataDefnCons a -> Maybe a +firstDataDefnCon (NewTypeCon con) = Just con +firstDataDefnCon (DataTypeCons _ cons) = listToMaybe cons + -- | Located data Constructor Declaration type LConDecl pass = XRec pass (ConDecl pass) -- ^ May have 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnSemi' when ===================================== testsuite/tests/th/T22559a.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TemplateHaskell #-} +module T22559a where + +import Language.Haskell.TH + +$(pure [NewtypeD + [] (mkName "D") [] (Just StarT) + (NormalC (mkName "MkD") + [( Bang NoSourceUnpackedness NoSourceStrictness + , ConT ''Int + )]) + []]) ===================================== testsuite/tests/th/T22559a.stderr ===================================== @@ -0,0 +1,4 @@ + +T22559a.hs:7:2: error: [GHC-40746] + Kind signatures are only allowed on GADTs + When splicing a TH declaration: newtype D :: * = MkD GHC.Types.Int ===================================== testsuite/tests/th/T22559b.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +module T22559b where + +import Language.Haskell.TH + +data family D + +$(pure [DataInstD + [] Nothing + (ConT (mkName "D")) (Just StarT) + [NormalC (mkName "MkD") + [( Bang NoSourceUnpackedness NoSourceStrictness + , ConT ''Int + )]] + []]) ===================================== testsuite/tests/th/T22559b.stderr ===================================== @@ -0,0 +1,5 @@ + +T22559b.hs:10:2: error: [GHC-40746] + Kind signatures are only allowed on GADTs + When splicing a TH declaration: + data instance D :: * = MkD GHC.Types.Int ===================================== testsuite/tests/th/T22559c.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +module T22559c where + +import Language.Haskell.TH + +data family D + +$(pure [NewtypeInstD + [] Nothing + (ConT (mkName "D")) (Just StarT) + (NormalC (mkName "MkD") + [( Bang NoSourceUnpackedness NoSourceStrictness + , ConT ''Int + )]) + []]) ===================================== testsuite/tests/th/T22559c.stderr ===================================== @@ -0,0 +1,5 @@ + +T22559c.hs:10:2: error: [GHC-40746] + Kind signatures are only allowed on GADTs + When splicing a TH declaration: + newtype instance D :: * = MkD GHC.Types.Int ===================================== testsuite/tests/th/all.T ===================================== @@ -573,3 +573,6 @@ test('TH_typed3', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('TH_typed4', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('TH_typed5', normal, compile_and_run, ['']) test('T21050', normal, compile_fail, ['']) +test('T22559a', normal, compile_fail, ['']) +test('T22559b', normal, compile_fail, ['']) +test('T22559c', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3ab0155b43e3a4a15217206a0731993b604fb958 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3ab0155b43e3a4a15217206a0731993b604fb958 You're receiving 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 Jun 9 12:23:50 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Fri, 09 Jun 2023 08:23:50 -0400 Subject: [Git][ghc/ghc][wip/or-pats] Play around with Match Message-ID: <648319d6b755a_e2555324eef81012ce@gitlab.mail> David pushed to branch wip/or-pats at Glasgow Haskell Compiler / GHC Commits: c93c3ddd by David Knothe at 2023-06-09T14:23:36+02:00 Play around with Match - - - - - 7 changed files: - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match.hs-boot - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Utils.hs Changes: ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -204,9 +204,7 @@ dsUnliftedBind (PatBind { pat_lhs = pat, pat_rhs = grhss do { match_nablas <- pmcGRHSs PatBindGuards grhss ; rhs <- dsGuarded grhss ty match_nablas ; let upat = unLoc pat - eqn = EqnInfo { eqn_pats = [upat], - eqn_orig = FromSource, - eqn_rhs = cantFailMatchResult body } + eqn = EqnMatch upat FromSource (EqnDone $ cantFailMatchResult body) ; var <- selectMatchVar ManyTy upat -- `var` will end up in a let binder, so the multiplicity -- doesn't matter. ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -21,13 +21,15 @@ module GHC.HsToCore.Match ) where +import GHC.Stack import GHC.Prelude import GHC.Platform import Language.Haskell.Syntax.Basic (Boxity(..)) import {-#SOURCE#-} GHC.HsToCore.Expr (dsExpr) - +import Data.List (intercalate) +import Debug.Trace import GHC.Types.Basic ( Origin(..), isGenerated ) import GHC.Types.SourceText import GHC.Driver.DynFlags @@ -178,9 +180,20 @@ with External names (#13043). See also Note [Localise pattern binders] in GHC.HsToCore.Utils -} +-- input: equationInfo +-- output: do call to `match` (recursing into matchNew) but group the first var beforehand +-- for the call to match, construct a EqnInfo with only a single pattern and put the recursive call into the eqn_rhs. + +--matchNew :: [MatchId] +-- -> Type +-- -> [EquationInfo] +-- -> Dsm (MatchResult CoreExpr) + + + type MatchId = Id -- See Note [Match Ids] -match :: [MatchId] -- ^ Variables rep\'ing the exprs we\'re matching with +match :: HasCallStack => [MatchId] -- ^ Variables rep\'ing the exprs we\'re matching with -- ^ See Note [Match Ids] -- -- ^ Note that the Match Ids carry not only a name, but @@ -192,11 +205,7 @@ match :: [MatchId] -- ^ Variables rep\'ing the exprs we\'re matching with match [] ty eqns = assertPpr (not (null eqns)) (ppr ty) $ - return (foldr1 combineMatchResults match_results) - where - match_results = [ assert (null (eqn_pats eqn)) $ - eqn_rhs eqn - | eqn <- eqns ] + combineRHSs (NEL.fromList eqns) match (v:vs) ty eqns -- Eqns *can* be empty = assertPpr (all (isInternalName . idName) vars) (ppr vars) $ @@ -207,11 +216,19 @@ match (v:vs) ty eqns -- Eqns *can* be empty ; (aux_binds, tidy_eqns) <- mapAndUnzipM (tidyEqnInfo v) eqns -- Group the equations and match each group in turn ; let grouped = groupEquations platform tidy_eqns + -- ; grouped' <- mapM (moveGroupVarsIntoRhs vs ty) grouped + ; let grouped' = grouped + + -- ; traceM ("Before moving: " ++ show (length grouped) ++ " groups:") + -- ; testPrint grouped + -- ; traceM ("After moving: " ++ show (length grouped') ++ " groups:") + -- ; testPrint grouped' + -- ; traceM "" -- print the view patterns that are commoned up to help debug - ; whenDOptM Opt_D_dump_view_pattern_commoning (debug grouped) + ; whenDOptM Opt_D_dump_view_pattern_commoning (debug grouped') - ; match_results <- match_groups grouped + ; match_results <- match_groups grouped' ; return $ foldr (.) id aux_binds <$> foldr1 combineMatchResults match_results } @@ -239,6 +256,7 @@ match (v:vs) ty eqns -- Eqns *can* be empty PgBang -> matchBangs vars ty (dropGroup eqns) PgCo {} -> matchCoercion vars ty (dropGroup eqns) PgView {} -> matchView vars ty (dropGroup eqns) + PgDistinct-> combineRHSs (dropGroup eqns) PgOr -> matchOr vars ty eq -- every or-pattern makes up a single PgOr group where eqns' = NEL.toList eqns ne l = case NEL.nonEmpty l of @@ -247,7 +265,19 @@ match (v:vs) ty eqns -- Eqns *can* be empty -- FIXME: we should also warn about view patterns that should be -- commoned up but are not - +{- + testPrint :: Applicative f => [NonEmpty (PatGroup, EquationInfo)] -> f () + testPrint groups = + traceM $ intercalate "\n" $ map + (\group -> intercalate " ; " $ map + (\(pg, eqn) -> (show pg ++ " " ++ (intercalate " " $ map (showSDocUnsafe . pprLPat . mklpat) (pats eqn)))) + (NEL.toList group)) + groups + where + pats (EqnMatch pat _ rest) = pat : pats rest + pats (EqnDone _) = [] + mklpat pat = L noSrcSpanA pat +-} -- print some stuff to see what's getting grouped -- use -dppr-debug to see the resolution of overloaded literals debug eqns = @@ -267,6 +297,10 @@ matchEmpty var res_ty mk_seq fail = return $ mkWildCase (Var var) (idScaledType var) res_ty [Alt DEFAULT [] fail] + +combineRHSs :: NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) +combineRHSs eqns = return $ foldr1 combineMatchResults $ map (\(EqnDone rhs) -> rhs) (NEL.toList eqns) + matchVariables :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) -- Real true variables, just like in matchVar, SLPJ p 94 -- No binding to do: they'll all be wildcards by now (done in tidy) @@ -319,12 +353,11 @@ matchOr (var :| vars) ty eqn = do { ; match [var] ty or_eqns -- todo: not if pats is empty }) } where - singleEqn expr (L _ pat) = EqnInfo { eqn_pats = [pat], eqn_orig = FromSource, eqn_rhs = pure expr } + singleEqn expr (L _ pat) = EqnMatch pat FromSource (EqnDone $ pure expr) -- decompose the first pattern and leave the rest alone decomposeFirstPat :: (Pat GhcTc -> Pat GhcTc) -> EquationInfo -> EquationInfo -decomposeFirstPat extractpat (eqn@(EqnInfo { eqn_pats = pat : pats })) - = eqn { eqn_pats = extractpat pat : pats} +decomposeFirstPat extract (EqnMatch pat orig rest) = EqnMatch (extract pat) orig rest decomposeFirstPat _ _ = panic "decomposeFirstPat" getCoPat, getBangPat, getViewPat :: Pat GhcTc -> Pat GhcTc @@ -408,7 +441,19 @@ only these which can be assigned a PatternGroup (see patGroup). -} -tidyEqnInfo :: Id -> EquationInfo +{- +moveGroupVarsIntoRhs :: HasCallStack => [Id] -> Type -> NonEmpty (PatGroup, EquationInfo) -> DsM (NonEmpty (PatGroup, EquationInfo)) +moveGroupVarsIntoRhs vs ty group = do + let (gp, eq) = NEL.head group + case eq of + EqnDone _ -> return group + EqnMatch pat orig _ -> do + let rest = NEL.map (\(_, EqnMatch _ _ rest) -> rest) group + rhs <- match vs ty (NEL.toList rest) + return $ NEL.singleton (gp, EqnMatch pat orig (EqnDone rhs)) +-} + +tidyEqnInfo :: HasCallStack => Id -> EquationInfo -> DsM (DsWrapper, EquationInfo) -- DsM'd because of internal call to dsLHsBinds -- and mkSelectorBinds. @@ -418,12 +463,11 @@ tidyEqnInfo :: Id -> EquationInfo -- POST CONDITION: head pattern in the EqnInfo is -- one of these for which patGroup is defined. -tidyEqnInfo _ (EqnInfo { eqn_pats = [] }) - = panic "tidyEqnInfo" +tidyEqnInfo _ (EqnDone r) = return (idDsWrapper, EqnDone r) -tidyEqnInfo v eqn@(EqnInfo { eqn_pats = pat : pats, eqn_orig = orig }) - = do { (wrap, pat') <- tidy1 v orig pat - ; return (wrap, eqn { eqn_pats = pat' : pats }) } +tidyEqnInfo v (EqnMatch pat orig rest) = do + (wrap, pat') <- tidy1 v orig pat + return (wrap, EqnMatch pat' orig rest) tidy1 :: Id -- The Id being scrutinised -> Origin -- Was this a pattern the user wrote? @@ -833,9 +877,7 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches -- from that knowledge (#18533) ; match_result <- updPmNablas pat_nablas $ dsGRHSs ctxt grhss rhs_ty rhss_nablas - ; return EqnInfo { eqn_pats = upats - , eqn_orig = FromSource - , eqn_rhs = match_result } } + ; return $ mkEqnInfo upats FromSource match_result } discard_warnings_if_generated orig = if isGenerated orig @@ -972,9 +1014,9 @@ matchSinglePatVar var mb_scrut ctx pat ty match_result addCoreScrutTmCs (maybeToList mb_scrut) [var] $ pmcPatBind (DsMatchContext ctx locn) var (unLoc pat) - ; let eqn_info = EqnInfo { eqn_pats = [unLoc (decideBangHood dflags pat)] - , eqn_orig = FromSource - , eqn_rhs = match_result } + ; let eqn_info = EqnMatch (unLoc (decideBangHood dflags pat)) + FromSource + (EqnDone match_result) ; match [var] ty [eqn_info] } @@ -1002,8 +1044,18 @@ data PatGroup | PgView (LHsExpr GhcTc) -- view pattern (e -> p): -- the LHsExpr is the expression e Type -- the Type is the type of p (equivalently, the result type of e) + | PgDistinct -- Group equations which are Done: no further grouping can be done with them | PgOr -- Or pattern +instance Show PatGroup where + show PgAny = "PgAny" + show (PgCon _) = "PgCon" + show (PgLit _) = "PgLit" + show (PgView _ _) = "PgView" + show PgOr = "PgOr" + show PgDistinct = "PgDistinct" + show _ = "PgOther" + {- Note [Don't use Literal for PgN] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Previously we had, as PatGroup constructors @@ -1030,7 +1082,7 @@ groupEquations :: Platform -> [EquationInfo] -> [NonEmpty (PatGroup, EquationInf -- (b) none of the gi are empty -- The ordering of equations is unchanged groupEquations platform eqns - = NEL.groupBy same_gp $ [(patGroup platform (firstPat eqn), eqn) | eqn <- eqns] + = NEL.groupBy same_gp $ [(patGroup platform (maybeFirstPat eqn), eqn) | eqn <- eqns] -- comprehension on NonEmpty where same_gp :: (PatGroup,EquationInfo) -> (PatGroup,EquationInfo) -> Bool @@ -1120,6 +1172,7 @@ sameGroup (PgCo t1) (PgCo t2) = t1 `eqType` t2 sameGroup (PgView e1 t1) (PgView e2 t2) = viewLExprEq (e1,t1) (e2,t2) -- ViewPats are in the same group iff the expressions -- are "equal"---conservatively, we use syntactic equality +sameGroup PgDistinct PgDistinct = True sameGroup _ _ = False -- An approximation of syntactic equality used for determining when view @@ -1246,15 +1299,19 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2 eq_list _ (_:_) [] = False eq_list eq (x:xs) (y:ys) = eq x y && eq_list eq xs ys -patGroup :: Platform -> Pat GhcTc -> PatGroup -patGroup _ (ConPat { pat_con = L _ con +patGroup :: Platform -> Maybe (Pat GhcTc) -> PatGroup +patGroup _ Nothing = PgDistinct +patGroup p (Just pat) = patGroup' p pat + +patGroup' :: Platform -> Pat GhcTc -> PatGroup +patGroup' _ (ConPat { pat_con = L _ con , pat_con_ext = ConPatTc { cpt_arg_tys = tys } }) - | RealDataCon dcon <- con = PgCon dcon - | PatSynCon psyn <- con = PgSyn psyn tys -patGroup _ (WildPat {}) = PgAny -patGroup _ (BangPat {}) = PgBang -patGroup _ (NPat _ (L _ (OverLit {ol_val=oval})) mb_neg _) = + | RealDataCon dcon <- con = PgCon dcon + | PatSynCon psyn <- con = PgSyn psyn tys +patGroup' _ (WildPat {}) = PgAny +patGroup' _ (BangPat {}) = PgBang +patGroup' _ (NPat _ (L _ (OverLit {ol_val=oval})) mb_neg _) = case (oval, isJust mb_neg) of (HsIntegral i, is_neg) -> PgN (integralFractionalLit is_neg (if is_neg then negate (il_value i) @@ -1264,17 +1321,17 @@ patGroup _ (NPat _ (L _ (OverLit {ol_val=oval})) mb_neg _) = | otherwise -> PgN f (HsIsString _ s, _) -> assert (isNothing mb_neg) $ PgOverS s -patGroup _ (NPlusKPat _ _ (L _ (OverLit {ol_val=oval})) _ _ _) = +patGroup' _ (NPlusKPat _ _ (L _ (OverLit {ol_val=oval})) _ _ _) = case oval of HsIntegral i -> PgNpK (il_value i) _ -> pprPanic "patGroup NPlusKPat" (ppr oval) -patGroup _ (ViewPat _ expr p) = PgView expr (hsPatType (unLoc p)) -patGroup platform (LitPat _ lit) = PgLit (hsLitKey platform lit) -patGroup platform (XPat ext) = case ext of +patGroup' _ (ViewPat _ expr p) = PgView expr (hsPatType (unLoc p)) +patGroup' platform (LitPat _ lit) = PgLit (hsLitKey platform lit) +patGroup' platform (XPat ext) = case ext of CoPat _ p _ -> PgCo (hsPatType p) -- Type of innelexp pattern - ExpansionPat _ p -> patGroup platform p -patGroup _ (OrPat {}) = PgOr -patGroup _ pat = pprPanic "patGroup" (ppr pat) + ExpansionPat _ p -> patGroup' platform p +patGroup' _ (OrPat {}) = PgOr +patGroup' _ pat = pprPanic "patGroup" (ppr pat) {- Note [Grouping overloaded literal patterns] ===================================== compiler/GHC/HsToCore/Match.hs-boot ===================================== @@ -1,5 +1,6 @@ module GHC.HsToCore.Match where +import GHC.Stack (HasCallStack) import GHC.Prelude import GHC.Types.Var ( Id ) import GHC.Tc.Utils.TcType ( Type ) @@ -8,7 +9,7 @@ import GHC.Core ( CoreExpr ) import GHC.Hs ( LPat, HsMatchContext, MatchGroup, LHsExpr ) import GHC.Hs.Extension ( GhcTc, GhcRn ) -match :: [Id] +match :: HasCallStack => [Id] -> Type -> [EquationInfo] -> DsM (MatchResult CoreExpr) ===================================== compiler/GHC/HsToCore/Match/Constructor.hs ===================================== @@ -153,24 +153,22 @@ matchOneConLike vars ty mult (eqn1 :| eqns) -- All eqns for a single construct ; return $ foldr1 (.) wraps <$> match_result } - shift (_, eqn@(EqnInfo - { eqn_pats = ConPat - { pat_args = args - , pat_con_ext = ConPatTc - { cpt_tvs = tvs - , cpt_dicts = ds - , cpt_binds = bind - } - } : pats - })) + shift (_, eqn@(EqnMatch (ConPat + { pat_args = args + , pat_con_ext = ConPatTc + { cpt_tvs = tvs + , cpt_dicts = ds + , cpt_binds = bind + }}) + _ rest + )) = do dsTcEvBinds bind $ \ds_bind -> return ( wrapBinds (tvs `zip` tvs1) . wrapBinds (ds `zip` dicts1) . mkCoreLets ds_bind - , eqn { eqn_orig = Generated - , eqn_pats = conArgPats val_arg_tys args ++ pats } + , mkEqnInfo (conArgPats val_arg_tys args ++ eqn_pats rest) Generated (eqn_rhs rest) ) - shift (_, (EqnInfo { eqn_pats = ps })) = pprPanic "matchOneCon/shift" (ppr ps) + shift (_, eqn) = pprPanic "matchOneCon/shift" (ppr eqn) ; let scaled_arg_tys = map (scaleScaled mult) val_arg_tys -- The 'val_arg_tys' are taken from the data type definition, they -- do not take into account the context multiplicity, therefore we ===================================== compiler/GHC/HsToCore/Match/Literal.hs ===================================== @@ -625,10 +625,10 @@ matchLiterals (var :| vars) ty sub_groups } where match_group :: NonEmpty EquationInfo -> DsM (Literal, MatchResult CoreExpr) - match_group eqns@(firstEqn :| _) + match_group eqns = do { dflags <- getDynFlags ; let platform = targetPlatform dflags - ; let LitPat _ hs_lit = firstPat firstEqn + ; let (EqnMatch (LitPat _ hs_lit) _ _) = NEL.head eqns ; match_result <- match vars ty (NEL.toList $ shiftEqns eqns) ; return (hsLitKey platform hs_lit, match_result) } @@ -726,7 +726,7 @@ matchNPlusKPats (var :| vars) ty (eqn1 :| eqns) fmap (foldr1 (.) wraps) $ match_result) } where - shift n1 eqn@(EqnInfo { eqn_pats = NPlusKPat _ (L _ n) _ _ _ _ : pats }) - = (wrapBind n n1, eqn { eqn_pats = pats }) + shift n1 eqn@(EqnMatch (NPlusKPat _ (L _ n) _ _ _ _) _ rest) + = (wrapBind n n1, rest) -- The wrapBind is a no-op for the first equation shift _ e = pprPanic "matchNPlusKPats/shift" (ppr e) ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -48,7 +48,8 @@ module GHC.HsToCore.Monad ( -- Data types DsMatchContext(..), - EquationInfo(..), MatchResult (..), runMatchResult, DsWrapper, idDsWrapper, + EquationInfo(..), mkEqnInfo, eqn_rhs, eqn_pats, + MatchResult (..), runMatchResult, DsWrapper, idDsWrapper, -- Trace injection pprRuntimeTrace @@ -130,7 +131,7 @@ data DsMatchContext instance Outputable DsMatchContext where ppr (DsMatchContext hs_match ss) = ppr ss <+> pprMatchContext hs_match -data EquationInfo +{-data EquationInfo = EqnInfo { eqn_pats :: [Pat GhcTc] -- ^ The patterns for an equation -- @@ -149,9 +150,22 @@ data EquationInfo , eqn_rhs :: MatchResult CoreExpr -- ^ What to do after match } +-} + +data EquationInfo = EqnMatch (Pat GhcTc) Origin EquationInfo | EqnDone (MatchResult CoreExpr) + +mkEqnInfo [] _ rhs = EqnDone rhs +mkEqnInfo (pat:pats) orig rhs = EqnMatch pat orig (mkEqnInfo pats orig rhs) + +eqn_pats :: EquationInfo -> [Pat GhcTc] +eqn_pats (EqnDone _) = [] +eqn_pats (EqnMatch pat _ rest) = pat : eqn_pats rest +eqn_rhs :: EquationInfo -> MatchResult CoreExpr +eqn_rhs (EqnDone rhs) = rhs +eqn_rhs (EqnMatch _ _ rest) = eqn_rhs rest instance Outputable EquationInfo where - ppr (EqnInfo pats _ _) = ppr pats + ppr = ppr . eqn_pats type DsWrapper = CoreExpr -> CoreExpr idDsWrapper :: DsWrapper ===================================== compiler/GHC/HsToCore/Utils.hs ===================================== @@ -15,7 +15,7 @@ This module exports some utility functions of no great interest. -- | Utility functions for constructing Core syntax, principally for desugaring module GHC.HsToCore.Utils ( EquationInfo(..), - firstPat, shiftEqns, + firstPat, maybeFirstPat, shiftEqns, MatchResult (..), CaseAlt(..), cantFailMatchResult, alwaysFailMatchResult, @@ -196,11 +196,16 @@ worthy of a type synonym and a few handy functions. -} firstPat :: EquationInfo -> Pat GhcTc -firstPat eqn = assert (notNull (eqn_pats eqn)) $ head (eqn_pats eqn) +firstPat (EqnMatch pat _ _) = pat +firstPat (EqnDone _) = error "firstPat: no patterns" + +maybeFirstPat :: EquationInfo -> Maybe (Pat GhcTc) +maybeFirstPat (EqnMatch pat _ _) = Just pat +maybeFirstPat (EqnDone _) = Nothing shiftEqns :: Functor f => f EquationInfo -> f EquationInfo -- Drop the first pattern in each equation -shiftEqns = fmap $ \eqn -> eqn { eqn_pats = tail (eqn_pats eqn) } +shiftEqns = fmap $ \(EqnMatch _ _ rest) -> rest -- Functions on MatchResult CoreExprs @@ -221,8 +226,8 @@ extractMatchResult match_result failure_expr = (shareFailureHandler match_result) combineMatchResults :: MatchResult CoreExpr -> MatchResult CoreExpr -> MatchResult CoreExpr -combineMatchResults match_result1@(MR_Infallible _) _ - = match_result1 +-- combineMatchResults match_result1@(MR_Infallible _) _ +-- = match_result1 combineMatchResults match_result1 match_result2 = -- if the first pattern needs a failure handler (i.e. if it is fallible), -- make it let-bind it bind it with `shareFailureHandler`. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c93c3ddd060ce347ad76731cdbcfb10da02b99dc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c93c3ddd060ce347ad76731cdbcfb10da02b99dc You're receiving 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 Jun 9 12:25:21 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Fri, 09 Jun 2023 08:25:21 -0400 Subject: [Git][ghc/ghc][wip/int-index/tok-where] 60 commits: Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) Message-ID: <64831a314d2e0_e2555324eef8102113@gitlab.mail> Andrei Borzenkov pushed to branch wip/int-index/tok-where at Glasgow Haskell Compiler / GHC Commits: 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2a3a4435 by Andrei Borzenkov at 2023-06-09T16:25:00+04:00 Use LHsToken for module, data, newtype, class, where in HsModule, DataDecl and ClassDecl types Updates the haddock submodule. - - - - - 30 changed files: - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types/Prim.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Data/Strict.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/72253c38be6cd759f1d7b2a98ed1c7cf944fce97...2a3a443585cc7d306fdc6ba05ec0e63d58527450 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/72253c38be6cd759f1d7b2a98ed1c7cf944fce97...2a3a443585cc7d306fdc6ba05ec0e63d58527450 You're receiving 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 Jun 9 12:29:00 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 09 Jun 2023 08:29:00 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Restore mingwex dependency on Windows Message-ID: <64831b0c84781_e2555355a50c112828@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - 7ae3cfa0 by Matthew Pickering at 2023-06-09T08:28:47-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - 291c57f2 by Matthew Pickering at 2023-06-09T08:28:47-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 06642a8b by Matthew Pickering at 2023-06-09T08:28:47-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - e5dd14da by Alexander McKenna at 2023-06-09T08:28:50-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 27 changed files: - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Utils/TmpFs.hs - compiler/Language/Haskell/Syntax/Decls.hs - configure.ac - docs/users_guide/9.8.1-notes.rst - docs/users_guide/debugging.rst - libraries/base/base.cabal - libraries/ghc-prim/ghc-prim.cabal - rts/RtsSymbols.c - testsuite/tests/driver/Makefile - + testsuite/tests/driver/T23339.hs - + testsuite/tests/driver/T23339.stdout - + testsuite/tests/driver/T23339B.hs - + testsuite/tests/driver/T23339B.stdout - testsuite/tests/driver/all.T - testsuite/tests/ghci/prog018/prog018.stdout - + testsuite/tests/th/T22559a.hs - + testsuite/tests/th/T22559a.stderr - + testsuite/tests/th/T22559b.hs - + testsuite/tests/th/T22559b.stderr - + testsuite/tests/th/T22559c.hs - + testsuite/tests/th/T22559c.stderr - testsuite/tests/th/all.T Changes: ===================================== compiler/GHC/Driver/Config/Core/Lint.hs ===================================== @@ -87,7 +87,7 @@ coreDumpFlag (CoreDoDemand {}) = Just Opt_D_dump_stranal coreDumpFlag CoreDoCpr = Just Opt_D_dump_cpranal coreDumpFlag CoreDoWorkerWrapper = Just Opt_D_dump_worker_wrapper coreDumpFlag CoreDoSpecialising = Just Opt_D_dump_spec -coreDumpFlag CoreDoSpecConstr = Just Opt_D_dump_spec +coreDumpFlag CoreDoSpecConstr = Just Opt_D_dump_spec_constr coreDumpFlag CoreCSE = Just Opt_D_dump_cse coreDumpFlag CoreDesugar = Just Opt_D_dump_ds_preopt coreDumpFlag CoreDesugarOpt = Just Opt_D_dump_ds ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -107,6 +107,7 @@ data DumpFlag | Opt_D_dump_simpl | Opt_D_dump_simpl_iterations | Opt_D_dump_spec + | Opt_D_dump_spec_constr | Opt_D_dump_prep | Opt_D_dump_late_cc | Opt_D_dump_stg_from_core -- ^ Initial STG (CoreToStg output) ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -782,16 +782,14 @@ load' mhmi_cache how_much diag_wrapper mHscMessage mod_graph = do worker_limit <- liftIO $ mkWorkerLimit dflags setSession $ hscUpdateHUG (unitEnv_map pruneHomeUnitEnv) hsc_env - (upsweep_ok, hsc_env1) <- withDeferredDiagnostics $ do + (upsweep_ok, new_deps) <- withDeferredDiagnostics $ do hsc_env <- getSession liftIO $ upsweep worker_limit hsc_env mhmi_cache diag_wrapper mHscMessage (toCache pruned_cache) build_plan - setSession hsc_env1 + modifySession (addDepsToHscEnv new_deps) case upsweep_ok of Failed -> loadFinish upsweep_ok Succeeded -> do liftIO $ debugTraceMsg logger 2 (text "Upsweep completely successful.") - -- Clean up after ourselves - liftIO $ cleanCurrentModuleTempFilesMaybe logger (hsc_tmpfs hsc_env1) dflags loadFinish upsweep_ok @@ -1262,14 +1260,13 @@ upsweep -> Maybe Messager -> M.Map ModNodeKeyWithUid HomeModInfo -> [BuildPlan] - -> IO (SuccessFlag, HscEnv) + -> IO (SuccessFlag, [HomeModInfo]) upsweep n_jobs hsc_env hmi_cache diag_wrapper mHscMessage old_hpt build_plan = do (cycle, pipelines, collect_result) <- interpretBuildPlan (hsc_HUG hsc_env) hmi_cache old_hpt build_plan runPipelines n_jobs hsc_env diag_wrapper mHscMessage pipelines res <- collect_result let completed = [m | Just (Just m) <- res] - let hsc_env' = addDepsToHscEnv completed hsc_env -- Handle any cycle in the original compilation graph and return the result -- of the upsweep. @@ -1277,10 +1274,10 @@ upsweep n_jobs hsc_env hmi_cache diag_wrapper mHscMessage old_hpt build_plan = d Just mss -> do let logger = hsc_logger hsc_env liftIO $ fatalErrorMsg logger (cyclicModuleErr mss) - return (Failed, hsc_env) + return (Failed, []) Nothing -> do let success_flag = successIf (all isJust res) - return (success_flag, hsc_env') + return (success_flag, completed) toCache :: [HomeModInfo] -> M.Map (ModNodeKeyWithUid) HomeModInfo toCache hmis = M.fromList ([(miKey $ hm_iface hmi, hmi) | hmi <- hmis]) @@ -2345,18 +2342,21 @@ withDeferredDiagnostics f = do let action = logMsg logger msgClass srcSpan msg case msgClass of MCDiagnostic SevWarning _reason _code - -> atomicModifyIORef' warnings $ \i -> (action: i, ()) + -> atomicModifyIORef' warnings $ \(!i) -> (action: i, ()) MCDiagnostic SevError _reason _code - -> atomicModifyIORef' errors $ \i -> (action: i, ()) + -> atomicModifyIORef' errors $ \(!i) -> (action: i, ()) MCFatal - -> atomicModifyIORef' fatals $ \i -> (action: i, ()) + -> atomicModifyIORef' fatals $ \(!i) -> (action: i, ()) _ -> action printDeferredDiagnostics = liftIO $ forM_ [warnings, errors, fatals] $ \ref -> do -- This IORef can leak when the dflags leaks, so let us always - -- reset the content. - actions <- atomicModifyIORef' ref $ \i -> ([], i) + -- reset the content. The lazy variant is used here as we want to force + -- this error if the IORef is ever accessed again, rather than now. + -- See #20981 for an issue which discusses this general issue. + let landmine = if debugIsOn then panic "withDeferredDiagnostics: use after free" else [] + actions <- atomicModifyIORef ref $ \i -> (landmine, i) sequence_ $ reverse actions MC.bracket @@ -2432,8 +2432,9 @@ cyclicModuleErr mss cleanCurrentModuleTempFilesMaybe :: MonadIO m => Logger -> TmpFs -> DynFlags -> m () cleanCurrentModuleTempFilesMaybe logger tmpfs dflags = - unless (gopt Opt_KeepTmpFiles dflags) $ - liftIO $ cleanCurrentModuleTempFiles logger tmpfs + if gopt Opt_KeepTmpFiles dflags + then liftIO $ keepCurrentModuleTempFiles logger tmpfs + else liftIO $ cleanCurrentModuleTempFiles logger tmpfs addDepsToHscEnv :: [HomeModInfo] -> HscEnv -> HscEnv ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -1425,6 +1425,8 @@ dynamic_flags_deps = [ (setDumpFlag Opt_D_dump_simpl_iterations) , make_ord_flag defGhcFlag "ddump-spec" (setDumpFlag Opt_D_dump_spec) + , make_ord_flag defGhcFlag "ddump-spec-constr" + (setDumpFlag Opt_D_dump_spec_constr) , make_ord_flag defGhcFlag "ddump-prep" (setDumpFlag Opt_D_dump_prep) , make_ord_flag defGhcFlag "ddump-late-cc" ===================================== compiler/GHC/ThToHs.hs ===================================== @@ -277,17 +277,13 @@ cvtDec (DataD ctxt tc tvs ksig constrs derivs) cvtDec (NewtypeD ctxt tc tvs ksig constr derivs) = do { (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs ; ksig' <- cvtKind `traverse` ksig - ; let first_datacon = - case get_cons_names constr of - [] -> panic "cvtDec: empty list of constructors" - c:_ -> c - ; con' <- cvtConstr first_datacon cNameN constr + ; con' <- cvtDataDefnCons False ksig $ NewTypeCon constr ; derivs' <- cvtDerivs derivs ; let defn = HsDataDefn { dd_ext = noExtField , dd_cType = Nothing , dd_ctxt = mkHsContextMaybe ctxt' , dd_kindSig = ksig' - , dd_cons = NewTypeCon con' + , dd_cons = con' , dd_derivs = derivs' } ; returnJustLA $ TyClD noExtField $ DataDecl { tcdDExt = noAnn @@ -353,17 +349,13 @@ cvtDec (DataFamilyD tc tvs kind) cvtDec (DataInstD ctxt bndrs tys ksig constrs derivs) = do { (ctxt', tc', bndrs', typats') <- cvt_datainst_hdr ctxt bndrs tys ; ksig' <- cvtKind `traverse` ksig - ; let first_datacon = - case get_cons_names $ head constrs of - [] -> panic "cvtDec: empty list of constructors" - c:_ -> c - ; cons' <- mapM (cvtConstr first_datacon cNameN) constrs + ; cons' <- cvtDataDefnCons False ksig $ DataTypeCons False constrs ; derivs' <- cvtDerivs derivs ; let defn = HsDataDefn { dd_ext = noExtField , dd_cType = Nothing , dd_ctxt = mkHsContextMaybe ctxt' , dd_kindSig = ksig' - , dd_cons = DataTypeCons False cons' + , dd_cons = cons' , dd_derivs = derivs' } ; returnJustLA $ InstD noExtField $ DataFamInstD @@ -379,17 +371,14 @@ cvtDec (DataInstD ctxt bndrs tys ksig constrs derivs) cvtDec (NewtypeInstD ctxt bndrs tys ksig constr derivs) = do { (ctxt', tc', bndrs', typats') <- cvt_datainst_hdr ctxt bndrs tys ; ksig' <- cvtKind `traverse` ksig - ; let first_datacon = - case get_cons_names constr of - [] -> panic "cvtDec: empty list of constructors" - c:_ -> c - ; con' <- cvtConstr first_datacon cNameN constr + ; con' <- cvtDataDefnCons False ksig $ NewTypeCon constr ; derivs' <- cvtDerivs derivs ; let defn = HsDataDefn { dd_ext = noExtField , dd_cType = Nothing , dd_ctxt = mkHsContextMaybe ctxt' , dd_kindSig = ksig' - , dd_cons = NewTypeCon con', dd_derivs = derivs' } + , dd_cons = con' + , dd_derivs = derivs' } ; returnJustLA $ InstD noExtField $ DataFamInstD { dfid_ext = noExtField , dfid_inst = DataFamInstDecl { dfid_eqn = @@ -498,6 +487,28 @@ cvtGenDataDec :: Bool -> TH.Cxt -> TH.Name -> [TH.TyVarBndr TH.BndrVis] -> Maybe TH.Kind -> [TH.Con] -> [TH.DerivClause] -> CvtM (Maybe (LHsDecl GhcPs)) cvtGenDataDec type_data ctxt tc tvs ksig constrs derivs + = do { (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs + ; ksig' <- cvtKind `traverse` ksig + ; cons' <- cvtDataDefnCons type_data ksig $ + DataTypeCons type_data constrs + ; derivs' <- cvtDerivs derivs + ; let defn = HsDataDefn { dd_ext = noExtField + , dd_cType = Nothing + , dd_ctxt = mkHsContextMaybe ctxt' + , dd_kindSig = ksig' + , dd_cons = cons' + , dd_derivs = derivs' } + ; returnJustLA $ TyClD noExtField $ + DataDecl { tcdDExt = noAnn + , tcdLName = tc', tcdTyVars = tvs' + , tcdFixity = Prefix + , tcdDataDefn = defn } } + +-- Convert a set of data constructors. +cvtDataDefnCons :: + Bool -> Maybe TH.Kind -> + DataDefnCons TH.Con -> CvtM (DataDefnCons (LConDecl GhcPs)) +cvtDataDefnCons type_data ksig constrs = do { let isGadtCon (GadtC _ _ _) = True isGadtCon (RecGadtC _ _ _) = True isGadtCon (ForallC _ _ c) = isGadtCon c @@ -515,27 +526,16 @@ cvtGenDataDec type_data ctxt tc tvs ksig constrs derivs (failWith CannotMixGADTConsWith98Cons) ; unless (isNothing ksig || isGadtDecl) (failWith KindSigsOnlyAllowedOnGADTs) - ; (ctxt', tc', tvs') <- cvt_tycl_hdr ctxt tc tvs - ; ksig' <- cvtKind `traverse` ksig ; let first_datacon = - case get_cons_names $ head constrs of - [] -> panic "cvtGenDataDec: empty list of constructors" + case firstDataDefnCon constrs of + Nothing -> panic "cvtDataDefnCons: empty list of constructors" + Just con -> con + first_datacon_name = + case get_cons_names first_datacon of + [] -> panic "cvtDataDefnCons: data constructor with no names" c:_ -> c - ; cons' <- mapM (cvtConstr first_datacon con_name) constrs - - ; derivs' <- cvtDerivs derivs - ; let defn = HsDataDefn { dd_ext = noExtField - , dd_cType = Nothing - , dd_ctxt = mkHsContextMaybe ctxt' - , dd_kindSig = ksig' - , dd_cons = DataTypeCons type_data cons' - , dd_derivs = derivs' } - ; returnJustLA $ TyClD noExtField $ - DataDecl { tcdDExt = noAnn - , tcdLName = tc', tcdTyVars = tvs' - , tcdFixity = Prefix - , tcdDataDefn = defn } } + ; mapM (cvtConstr first_datacon_name con_name) constrs } ---------------- cvtTySynEqn :: TySynEqn -> CvtM (LTyFamInstEqn GhcPs) ===================================== compiler/GHC/Utils/TmpFs.hs ===================================== @@ -13,6 +13,7 @@ module GHC.Utils.TmpFs , cleanTempDirs , cleanTempFiles , cleanCurrentModuleTempFiles + , keepCurrentModuleTempFiles , addFilesToClean , changeTempFilesLifetime , newTempName @@ -172,6 +173,32 @@ cleanTempFiles logger tmpfs , Set.toList cm_paths ++ Set.toList gs_paths) remove to_delete +-- | Keep all the paths in @tmp_files_to_clean@ and @tmp_subdirs_to_clean@ +-- that have lifetime TFL_CurrentModule. This function is used when `-keep-tmp-files` is +-- used in an OPTIONS_GHC pragma. +-- This function removes the temporary file from the TmpFs so we no longer remove +-- it at the env when cleanTempFiles is called. +keepCurrentModuleTempFiles :: HasCallStack => Logger -> TmpFs -> IO () +keepCurrentModuleTempFiles logger tmpfs + = mask_ + $ do to_keep_files <- keep (tmp_files_to_clean tmpfs) + to_keep_subdirs <- keep (tmp_subdirs_to_clean tmpfs) + -- Remove any folders which contain any files we want to keep from the + -- directories we are tracking. A new temporary directory will be created + -- the next time a temporary file is needed (by perhaps another module). + keepDirs (to_keep_files ++ to_keep_subdirs) (tmp_dirs_to_clean tmpfs) + where + keepDirs keeps ref = do + let keep_dirs = Set.fromList (map takeDirectory keeps) + atomicModifyIORef' ref $ \m -> (Map.filter (\fp -> fp `Set.notMember` keep_dirs) m, ()) + + keep ref = do + to_keep <- atomicModifyIORef' ref $ + \ptc at PathsToClean{ptcCurrentModule = cm_paths} -> + (ptc {ptcCurrentModule = Set.empty}, Set.toList cm_paths) + debugTraceMsg logger 2 (text "Keeping:" <+> hsep (map text to_keep)) + return to_keep + -- | Delete all paths in @tmp_files_to_clean@ and @tmp_subdirs_to_clean@ -- That have lifetime TFL_CurrentModule. -- If a file must be cleaned eventually, but must survive a ===================================== compiler/Language/Haskell/Syntax/Decls.hs ===================================== @@ -30,7 +30,7 @@ module Language.Haskell.Syntax.Decls ( HsDecl(..), LHsDecl, HsDataDefn(..), HsDeriving, LHsFunDep, FunDep(..), HsDerivingClause(..), LHsDerivingClause, DerivClauseTys(..), LDerivClauseTys, NewOrData(..), DataDefnCons(..), dataDefnConsNewOrData, - isTypeDataDefnCons, + isTypeDataDefnCons, firstDataDefnCon, StandaloneKindSig(..), LStandaloneKindSig, -- ** Class or type declarations @@ -1040,6 +1040,11 @@ isTypeDataDefnCons :: DataDefnCons a -> Bool isTypeDataDefnCons (NewTypeCon _) = False isTypeDataDefnCons (DataTypeCons is_type_data _) = is_type_data +-- | Retrieve the first data constructor in a 'DataDefnCons' (if one exists). +firstDataDefnCon :: DataDefnCons a -> Maybe a +firstDataDefnCon (NewTypeCon con) = Just con +firstDataDefnCon (DataTypeCons _ cons) = listToMaybe cons + -- | Located data Constructor Declaration type LConDecl pass = XRec pass (ConDecl pass) -- ^ May have 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnSemi' when ===================================== configure.ac ===================================== @@ -917,6 +917,9 @@ AC_CHECK_DECLS([program_invocation_short_name], , , [#define _GNU_SOURCE 1 #include ]) +dnl ** check for mingwex library +AC_CHECK_LIB([mingwex],[closedir]) + dnl ** check for math library dnl Keep that check as early as possible. dnl as we need to know whether we need libm ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -128,6 +128,10 @@ Compiler GHC used to accept the contradictory ``Int~Bool`` in the type signature, but reject the ``Int~Bool`` constraint that arises from typechecking the definition itself. Now it accepts both. More details in `GHC ticket #23413 `_, which gives examples of the previous inconsistency. GHC now implements the "PermissivePlan" described in that ticket. +- The `-ddump-spec` flag has been split into `-ddump-spec` and + `-ddump-spec-constr`, allowing only output from the typeclass specialiser or + `SpecConstr` to be seen if desired. + GHCi ~~~~ ===================================== docs/users_guide/debugging.rst ===================================== @@ -324,7 +324,15 @@ subexpression elimination pass. :shortdesc: Dump specialiser output :type: dynamic - Dump output of specialisation pass + Dump output of typeclass specialisation pass + +.. ghc-flag:: -ddump-spec-constr + :shortdesc: Dump specialiser output from SpecConstr + :type: dynamic + + :since: 9.8.1 + + Dump output of the SpecConstr specialisation pass .. ghc-flag:: -ddump-rules :shortdesc: Dump rewrite rules ===================================== libraries/base/base.cabal ===================================== @@ -398,6 +398,7 @@ Library if os(windows) -- Windows requires some extra libraries for linking because the RTS -- is no longer re-exporting them. + -- mingwex: provides GNU POSIX extensions that aren't provided by ucrt. -- 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 +411,7 @@ Library -- advapi32: provides advanced kernel functions extra-libraries: wsock32, user32, shell32, mingw32, kernel32, advapi32, - ws2_32, shlwapi, ole32, rpcrt4, ntdll + mingwex, 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/ghc-prim/ghc-prim.cabal ===================================== @@ -68,12 +68,13 @@ Library -- is no longer re-exporting them (see #11223) -- ucrt: standard C library. The RTS will automatically include this, -- but is added for completeness. + -- mingwex: provides GNU POSIX extensions that aren't provided by ucrt. -- 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, ucrt + extra-libraries: user32, mingw32, mingwex, ucrt if os(linux) -- we need libm, but for musl and other's we might need libc, as libm ===================================== rts/RtsSymbols.c ===================================== @@ -113,6 +113,26 @@ 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 @@ -150,17 +170,17 @@ extern char **environ; SymI_NeedsProto(__mingw_module_is_dll) \ RTS_WIN32_ONLY(SymI_NeedsProto(___chkstk_ms)) \ RTS_WIN64_ONLY(SymI_NeedsProto(___chkstk_ms)) \ - SymI_HasProto(__mingw_vsnwprintf) \ - /* ^^ Need to figure out why this is needed. */ \ + RTS_WIN64_ONLY(SymI_HasProto(__stdio_common_vswprintf_s)) \ + RTS_WIN64_ONLY(SymI_HasProto(__stdio_common_vswprintf)) \ + RTS_WIN64_ONLY(SymI_HasProto(_errno)) \ + /* see Note [Symbols for MinGW's printf] */ \ + SymI_HasProto(_lock_file) \ + SymI_HasProto(_unlock_file) \ /* See Note [_iob_func symbol] */ \ RTS_WIN64_ONLY(SymI_HasProto_redirect( \ __imp___acrt_iob_func, __rts_iob_func, STRENGTH_WEAK, SYM_TYPE_INDIRECT_DATA)) \ RTS_WIN32_ONLY(SymI_HasProto_redirect( \ - __imp____acrt_iob_func, __rts_iob_func, STRENGTH_WEAK, SYM_TYPE_INDIRECT_DATA)) \ - SymI_HasProto(__mingw_vsnwprintf) \ - /* ^^ Need to figure out why this is needed. */ \ - SymI_HasProto(__mingw_vfprintf) \ - /* ^^ Need to figure out why this is needed. */ + __imp____acrt_iob_func, __rts_iob_func, STRENGTH_WEAK, SYM_TYPE_INDIRECT_DATA)) #else #define RTS_MINGW_ONLY_SYMBOLS /**/ #endif ===================================== testsuite/tests/driver/Makefile ===================================== @@ -792,4 +792,21 @@ T22669: ! test -f T22669.o-boot +T23339: + $(RM) T23339.hi + $(RM) T23339$(OBJSUFFIX) + $(RM) -rf "$(PWD)/tmp" + mkdir -p tmp + "$(TEST_HC)" -tmpdir "$(PWD)/tmp" $(TEST_HC_OPTS) -v0 T23339.hs + find . -name "*.c" -exec cat {} \; | grep "init__ip_init" + +T23339B: + $(RM) T23339.hi + $(RM) T23339$(OBJSUFFIX) + $(RM) -rf "$(PWD)/tmp" + mkdir -p tmp + "$(TEST_HC)" -tmpdir "$(PWD)/tmp" $(TEST_HC_OPTS) -v0 T23339B.hs -finfo-table-map + # Check that the file is kept and is the right one + find . -name "*.c" -exec cat {} \; | grep "init__ip_init" + ===================================== testsuite/tests/driver/T23339.hs ===================================== @@ -0,0 +1,4 @@ +{-# OPTIONS_GHC -keep-tmp-files -finfo-table-map #-} +module T23339 where + +defn = id "T23339" ===================================== testsuite/tests/driver/T23339.stdout ===================================== @@ -0,0 +1 @@ +void T23339_init__ip_init (void) ===================================== testsuite/tests/driver/T23339B.hs ===================================== @@ -0,0 +1,5 @@ +module T23339B where + +import T23339 + +qux = id "abc" ===================================== testsuite/tests/driver/T23339B.stdout ===================================== @@ -0,0 +1 @@ +void T23339_init__ip_init (void) ===================================== testsuite/tests/driver/all.T ===================================== @@ -320,3 +320,5 @@ 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', js_skip, makefile_test, []) +test('T23339', js_skip, makefile_test, []) +test('T23339B', [extra_files(['T23339.hs']), js_skip], makefile_test, []) ===================================== testsuite/tests/ghci/prog018/prog018.stdout ===================================== @@ -19,4 +19,7 @@ C.hs:6:7: error: [GHC-88464] Variable not in scope: variableNotInScope :: () Failed, two modules loaded. [3 of 3] Compiling C ( C.hs, interpreted ) + +C.hs:6:7: error: [GHC-88464] + Variable not in scope: variableNotInScope :: () Failed, two modules loaded. ===================================== testsuite/tests/th/T22559a.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TemplateHaskell #-} +module T22559a where + +import Language.Haskell.TH + +$(pure [NewtypeD + [] (mkName "D") [] (Just StarT) + (NormalC (mkName "MkD") + [( Bang NoSourceUnpackedness NoSourceStrictness + , ConT ''Int + )]) + []]) ===================================== testsuite/tests/th/T22559a.stderr ===================================== @@ -0,0 +1,4 @@ + +T22559a.hs:7:2: error: [GHC-40746] + Kind signatures are only allowed on GADTs + When splicing a TH declaration: newtype D :: * = MkD GHC.Types.Int ===================================== testsuite/tests/th/T22559b.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +module T22559b where + +import Language.Haskell.TH + +data family D + +$(pure [DataInstD + [] Nothing + (ConT (mkName "D")) (Just StarT) + [NormalC (mkName "MkD") + [( Bang NoSourceUnpackedness NoSourceStrictness + , ConT ''Int + )]] + []]) ===================================== testsuite/tests/th/T22559b.stderr ===================================== @@ -0,0 +1,5 @@ + +T22559b.hs:10:2: error: [GHC-40746] + Kind signatures are only allowed on GADTs + When splicing a TH declaration: + data instance D :: * = MkD GHC.Types.Int ===================================== testsuite/tests/th/T22559c.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +module T22559c where + +import Language.Haskell.TH + +data family D + +$(pure [NewtypeInstD + [] Nothing + (ConT (mkName "D")) (Just StarT) + (NormalC (mkName "MkD") + [( Bang NoSourceUnpackedness NoSourceStrictness + , ConT ''Int + )]) + []]) ===================================== testsuite/tests/th/T22559c.stderr ===================================== @@ -0,0 +1,5 @@ + +T22559c.hs:10:2: error: [GHC-40746] + Kind signatures are only allowed on GADTs + When splicing a TH declaration: + newtype instance D :: * = MkD GHC.Types.Int ===================================== testsuite/tests/th/all.T ===================================== @@ -573,3 +573,6 @@ test('TH_typed3', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('TH_typed4', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('TH_typed5', normal, compile_and_run, ['']) test('T21050', normal, compile_fail, ['']) +test('T22559a', normal, compile_fail, ['']) +test('T22559b', normal, compile_fail, ['']) +test('T22559c', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/adb2a55afab372abea97365bf4f97074d921e6f5...e5dd14da021928830d0861907bf6369016f02795 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/adb2a55afab372abea97365bf4f97074d921e6f5...e5dd14da021928830d0861907bf6369016f02795 You're receiving 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 Jun 9 12:31:11 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Fri, 09 Jun 2023 08:31:11 -0400 Subject: [Git][ghc/ghc][wip/int-index/hdk-register-tok] 61 commits: Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) Message-ID: <64831b8fb6468_e2555355a50c12002@gitlab.mail> Andrei Borzenkov pushed to branch wip/int-index/hdk-register-tok at Glasgow Haskell Compiler / GHC Commits: 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2a3a4435 by Andrei Borzenkov at 2023-06-09T16:25:00+04:00 Use LHsToken for module, data, newtype, class, where in HsModule, DataDecl and ClassDecl types Updates the haddock submodule. - - - - - 5ebdca0c by Vladislav Zavialov at 2023-06-09T16:30:56+04:00 Register LHsToken in Parser.PostProcess.Haddock - - - - - 30 changed files: - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types/Prim.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Data/Strict.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e95b4eb406ccc24ce1d30cea104b7ac04bdac3e6...5ebdca0cdf567ba1b86ed6c7ed3d2f4d6f777124 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e95b4eb406ccc24ce1d30cea104b7ac04bdac3e6...5ebdca0cdf567ba1b86ed6c7ed3d2f4d6f777124 You're receiving 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 Jun 9 13:13:35 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Fri, 09 Jun 2023 09:13:35 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] Fix MulMayOflo for <= W32 Message-ID: <6483257f6dccc_e255531c5e8c1419e0@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: 2570820d by Sven Tennie at 2023-06-09T13:11:55+00:00 Fix MulMayOflo for <= W32 - - - - - 3 changed files: - compiler/GHC/CmmToAsm/RV64/CodeGen.hs - testsuite/tests/codeGen/should_run/MulMayOflo_cmm.cmm - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/CmmToAsm/RV64/CodeGen.hs ===================================== @@ -996,7 +996,7 @@ getRegister' config plat expr `appOL` code_y `appOL` signExtend (formatToWidth format_y) W32 reg_y reg_y `snocOL` annExpr expr (MUL (OpReg W32 dst) (OpReg W32 reg_x) (OpReg W32 reg_y)) - `appOL` signExtend W32 w dst narrowedReg + `appOL` signExtendAdjustPrecission W32 w dst narrowedReg `appOL` toOL [ ann (text "Check if the multiplied value fits in the narrowed register") @@ -1077,6 +1077,42 @@ signExtend w w' r r' = where shift = 64 - widthInBits w +-- | Sign extends to 64bit, if needed and reduces the precission to the target `Width` (@w'@) +-- +-- Source `Reg` @r@ stays untouched, while the conversion happens on destination +-- `Reg` @r'@. +signExtendAdjustPrecission :: Width -> Width -> Reg -> Reg -> OrdList Instr +signExtendAdjustPrecission w w' _r _r' | w > W64 || w' > W64 = pprPanic "Unexpected width (max is 64bit):" $ ppr w <> text "->" <+> ppr w' +signExtendAdjustPrecission w w' r r' | w == W64 && w' == W64 && r == r' = nilOL +signExtendAdjustPrecission w w' r r' | w == W64 && w' == W64 = unitOL $ MOV (OpReg w' r') (OpReg w r) +signExtendAdjustPrecission w w' r r' + | w == W32 && w' == W64 = + unitOL $ + ann + (text "sign-extend register (SEXT.W)" <+> ppr r <+> ppr w <> text "->" <> ppr w') + -- `ADDIW r r 0` is the pseudo-op SEXT.W + (ADD (OpReg w' r') (OpReg w r) (OpImm (ImmInt 0))) +signExtendAdjustPrecission w w' r r' | w > w' = + toOL + [ ann + (text "narrow register signed" <+> ppr r <> char ':' <> ppr w <> text "->" <> ppr r <> char ':' <> ppr w') + (LSL (OpReg w' r') (OpReg w r) (OpImm (ImmInt shift))), + -- signed (arithmetic) right shift + ASR (OpReg w' r') (OpReg w' r') (OpImm (ImmInt shift)) + ] + where + shift = 64 - widthInBits w' +signExtendAdjustPrecission w w' r r' = + toOL + [ ann + (text "sign extend register" <+> ppr r <> char ':' <> ppr w <> text "->" <> ppr r <> char ':' <> ppr w') + (LSL (OpReg w' r') (OpReg w r) (OpImm (ImmInt shift))), + -- signed (arithmetic) right shift + ASR (OpReg w' r') (OpReg w' r') (OpImm (ImmInt shift)) + ] + where + shift = 64 - widthInBits w + -- | Instructions to truncate the value in the given register from width @w@ -- to width @w'@. -- ===================================== testsuite/tests/codeGen/should_run/MulMayOflo_cmm.cmm ===================================== @@ -1,4 +1,77 @@ +// Suppress empty ASSERT() optimization +#define USE_ASSERTS_ALL_WAYS 1 + +#include "Cmm.h" + runCmmzh() { +// BEWARE: Cmm isn't really type checked. I.e. you may construct +// 256::I8, which is obviously wrong and let's to strange behaviour. + +// N.B. the contract of '%mulmayoflo' is a bit weak: +// "Return non-zero if there is any possibility that the signed multiply +// of a and b might overflow. Return zero only if you are absolutely sure +// that it won't overflow. If in doubt, return non-zero." (Stg.h) +// So, this test might be a bit too strict for some architectures as it +// expects a perfect implementation. + + // --- I8 + ASSERT(%mulmayoflo(1::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(0::I8, 0::I8) == 0::I8); + ASSERT(%mulmayoflo(-1::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(1::I8, -1::I8) == 0::I8); + ASSERT(%mulmayoflo(127::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(1::I8, 127::I8) == 0::I8); + ASSERT(%mulmayoflo(63::I8, 2::I8) == 0::I8); + ASSERT(%mulmayoflo(2::I8, 63::I8) == 0::I8); + ASSERT(%mulmayoflo(64::I8, 2::I8) > 0::I8); + ASSERT(%mulmayoflo(2::I8, 64::I8) > 0::I8); + ASSERT(%mulmayoflo(127::I8, -1::I8) == 0::I8); + ASSERT(%mulmayoflo(-1::I8, 127::I8) == 0::I8); + ASSERT(%mulmayoflo(-128::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(-64::I8, 2::I8) == 0::I8); + ASSERT(%mulmayoflo(2::I8, -64::I8) == 0::I8); + ASSERT(%mulmayoflo(-65::I8, 2::I8) > 0::I8); + ASSERT(%mulmayoflo(2::I8, -65::I8) > 0::I8); + + // --- I16 + ASSERT(%mulmayoflo(1::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(0::I16, 0::I16) == 0::I16); + ASSERT(%mulmayoflo(-1::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16, -1::I16) == 0::I16); + ASSERT(%mulmayoflo(32767::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16,32767 ::I16) == 0::I16); + ASSERT(%mulmayoflo(16383::I16, 2::I16) == 0::I16); + ASSERT(%mulmayoflo(2::I16, 16383::I16) == 0::I16); + ASSERT(%mulmayoflo(16384::I16, 2::I16) > 0::I16); + ASSERT(%mulmayoflo(2::I16, 16384::I16) > 0::I16); + ASSERT(%mulmayoflo(-16384::I16, 2::I16) == 0::I16); + ASSERT(%mulmayoflo(2::I16, -16384::I16) == 0::I16); + ASSERT(%mulmayoflo(-32768::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16, -32768::I16) == 0::I16); + + // -- I32 + ASSERT(%mulmayoflo(1::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(0::I32, 0::I32) == 0::I32); + ASSERT(%mulmayoflo(-1::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, -1::I32) == 0::I32); + ASSERT(%mulmayoflo(2147483647::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, 2147483647::I32) == 0::I32); + ASSERT(%mulmayoflo(-2147483648::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, -2147483648::I32) == 0::I32); + ASSERT(%mulmayoflo(2::I32, 1073741823::I32) == 0::I32); + ASSERT(%mulmayoflo(1073741823::I32, 2::I32) == 0::I32); + ASSERT(%mulmayoflo(2::I32, 1073741824::I32) > 0::I32); + ASSERT(%mulmayoflo(1073741824::I32, 2::I32) > 0::I32); + ASSERT(%mulmayoflo(2::I32, -1073741824::I32) == 0::I32); + ASSERT(%mulmayoflo(-1073741824::I32, 2::I32) == 0::I32); + ASSERT(%mulmayoflo(2::I32, -1073741826::I32) > 0::I32); + ASSERT(%mulmayoflo(-1073741826::I32, 2::I32) > 0::I32); + + // -- I64 + ASSERT(%mulmayoflo(1::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(0::I64, 0::I64) == 0::I64); + // Gives a linter error + // ASSERT(%mulmayoflo(1::I64, 1::I8) == 0); return(0); } ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -231,6 +231,6 @@ test('T22296',[only_ways(llvm_ways) test('T22798', normal, compile_and_run, ['-fregs-graph']) test('MulMayOflo', - [ omit_ways(['ghci']), js_skip], + [ omit_ways(['ghci']), js_skip, ignore_stdout], multi_compile_and_run, ['MulMayOflo', [('MulMayOflo_cmm.cmm', '')], '']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2570820d4da6af4cb155e9a3c0e6f964bc546245 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2570820d4da6af4cb155e9a3c0e6f964bc546245 You're receiving 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 Jun 9 13:33:30 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 09 Jun 2023 09:33:30 -0400 Subject: [Git][ghc/ghc][wip/tsan/fixes] Fix it Message-ID: <64832a2aecada_e25552e71f10150626@gitlab.mail> Spam detection software, running on the system "mail.haskell.org", has identified this incoming email as possible spam. The original message has been attached to this so you can view it (if it isn't spam) or label similar future email. If you have any questions, see @@CONTACT_ADDRESS@@ for details. Content preview: Ben Gamari pushed to branch wip/tsan/fixes at Glasgow Haskell Compiler / GHC Commits: 2e3ddc34 by Ben Gamari at 2023-06-09T09:25:41-04:00 Fix it - - - - - [...] Content analysis details: (6.9 points, 5.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- -0.0 T_RP_MATCHES_RCVD Envelope sender domain matches handover relay domain 1.1 URI_HEX URI: URI hostname has long hexadecimal sequence 5.0 UNWANTED_LANGUAGE_BODY BODY: Message written in an undesired language 0.0 HTML_MESSAGE BODY: HTML included in message 0.8 BAYES_50 BODY: Bayes spam probability is 40 to 60% [score: 0.4393] 0.0 T_DKIM_INVALID DKIM-Signature header exists but is not valid The original message was not completely plain text, and may be unsafe to open with some email clients; in particular, it may contain a virus, or confirm that your address can receive spam. If you wish to view it, it may be safer to save it to a file and open it with an editor. -------------- next part -------------- An embedded message was scrubbed... From: "Ben Gamari (@bgamari)" Subject: [Git][ghc/ghc][wip/tsan/fixes] Fix it Date: Fri, 09 Jun 2023 09:33:30 -0400 Size: 15553 URL: From gitlab at gitlab.haskell.org Fri Jun 9 14:39:50 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Fri, 09 Jun 2023 10:39:50 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] Fix & test MulMayOflo Message-ID: <648339b61318c_e25553543348182064@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: 93273fdd by Sven Tennie at 2023-06-09T14:39:03+00:00 Fix & test MulMayOflo - - - - - 3 changed files: - compiler/GHC/CmmToAsm/RV64/CodeGen.hs - testsuite/tests/codeGen/should_run/MulMayOflo_cmm.cmm - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/CmmToAsm/RV64/CodeGen.hs ===================================== @@ -954,14 +954,14 @@ getRegister' config plat expr code_x `appOL` signExtend (formatToWidth format_x) W64 reg_x reg_x `appOL` code_y - `appOL` signExtend (formatToWidth format_y) W64 reg_x reg_y + `appOL` signExtend (formatToWidth format_y) W64 reg_y reg_y `appOL` toOL [ annExpr expr (SMULH (OpReg w hi) (OpReg w reg_x) (OpReg w reg_y)), MUL (OpReg w lo) (OpReg w reg_x) (OpReg w reg_y), - ASR (OpReg w lo) (OpReg w reg_x) (OpImm (ImmInt (widthInBits W64 - 1))), + ASR (OpReg w lo) (OpReg w lo) (OpImm (ImmInt (widthInBits W64 - 1))), ann (text "Set flag if result of MULH contains more than sign bits.") - (SUB (OpReg w hi) (OpReg w hi) (OpReg w lo)), + (XOR (OpReg w hi) (OpReg w hi) (OpReg w lo)), CSET (OpReg w dst) (OpReg w hi) nonSense NE ] ) @@ -996,7 +996,7 @@ getRegister' config plat expr `appOL` code_y `appOL` signExtend (formatToWidth format_y) W32 reg_y reg_y `snocOL` annExpr expr (MUL (OpReg W32 dst) (OpReg W32 reg_x) (OpReg W32 reg_y)) - `appOL` signExtend W32 w dst narrowedReg + `appOL` signExtendAdjustPrecission W32 w dst narrowedReg `appOL` toOL [ ann (text "Check if the multiplied value fits in the narrowed register") @@ -1005,6 +1005,7 @@ getRegister' config plat expr ] ) else do + -- TODO: Can this case ever happen? Write a test for it! -- TODO: Can't we clobber reg_x and reg_y to save registers? lo <- getNewRegNat II64 hi <- getNewRegNat II64 @@ -1023,7 +1024,7 @@ getRegister' config plat expr `appOL` toOL [ annExpr expr (SMULH (OpReg w hi) (OpReg w reg_x) (OpReg w reg_y)), MUL (OpReg w lo) (OpReg w reg_x) (OpReg w reg_y), - ASR (OpReg w lo) (OpReg w reg_x) (OpImm (ImmInt (widthInBits W64 - 1))), + ASR (OpReg w lo) (OpReg w lo) (OpImm (ImmInt (widthInBits W64 - 1))), ann (text "Set flag if result of MULH contains more than sign bits.") (SUB (OpReg w hi) (OpReg w hi) (OpReg w lo)), @@ -1077,6 +1078,42 @@ signExtend w w' r r' = where shift = 64 - widthInBits w +-- | Sign extends to 64bit, if needed and reduces the precission to the target `Width` (@w'@) +-- +-- Source `Reg` @r@ stays untouched, while the conversion happens on destination +-- `Reg` @r'@. +signExtendAdjustPrecission :: Width -> Width -> Reg -> Reg -> OrdList Instr +signExtendAdjustPrecission w w' _r _r' | w > W64 || w' > W64 = pprPanic "Unexpected width (max is 64bit):" $ ppr w <> text "->" <+> ppr w' +signExtendAdjustPrecission w w' r r' | w == W64 && w' == W64 && r == r' = nilOL +signExtendAdjustPrecission w w' r r' | w == W64 && w' == W64 = unitOL $ MOV (OpReg w' r') (OpReg w r) +signExtendAdjustPrecission w w' r r' + | w == W32 && w' == W64 = + unitOL $ + ann + (text "sign-extend register (SEXT.W)" <+> ppr r <+> ppr w <> text "->" <> ppr w') + -- `ADDIW r r 0` is the pseudo-op SEXT.W + (ADD (OpReg w' r') (OpReg w r) (OpImm (ImmInt 0))) +signExtendAdjustPrecission w w' r r' | w > w' = + toOL + [ ann + (text "narrow register signed" <+> ppr r <> char ':' <> ppr w <> text "->" <> ppr r <> char ':' <> ppr w') + (LSL (OpReg w' r') (OpReg w r) (OpImm (ImmInt shift))), + -- signed (arithmetic) right shift + ASR (OpReg w' r') (OpReg w' r') (OpImm (ImmInt shift)) + ] + where + shift = 64 - widthInBits w' +signExtendAdjustPrecission w w' r r' = + toOL + [ ann + (text "sign extend register" <+> ppr r <> char ':' <> ppr w <> text "->" <> ppr r <> char ':' <> ppr w') + (LSL (OpReg w' r') (OpReg w r) (OpImm (ImmInt shift))), + -- signed (arithmetic) right shift + ASR (OpReg w' r') (OpReg w' r') (OpImm (ImmInt shift)) + ] + where + shift = 64 - widthInBits w + -- | Instructions to truncate the value in the given register from width @w@ -- to width @w'@. -- ===================================== testsuite/tests/codeGen/should_run/MulMayOflo_cmm.cmm ===================================== @@ -1,4 +1,91 @@ +// Suppress empty ASSERT() optimization +#define USE_ASSERTS_ALL_WAYS 1 + +#include "Cmm.h" + runCmmzh() { +// BEWARE: Cmm isn't really type checked. I.e. you may construct +// 256::I8, which is obviously wrong and let's to strange behaviour. + +// N.B. the contract of '%mulmayoflo' is a bit weak: +// "Return non-zero if there is any possibility that the signed multiply +// of a and b might overflow. Return zero only if you are absolutely sure +// that it won't overflow. If in doubt, return non-zero." (Stg.h) +// So, this test might be a bit too strict for some architectures as it +// expects a perfect implementation. + + // --- I8 + ASSERT(%mulmayoflo(1::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(0::I8, 0::I8) == 0::I8); + ASSERT(%mulmayoflo(-1::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(1::I8, -1::I8) == 0::I8); + ASSERT(%mulmayoflo(127::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(1::I8, 127::I8) == 0::I8); + ASSERT(%mulmayoflo(63::I8, 2::I8) == 0::I8); + ASSERT(%mulmayoflo(2::I8, 63::I8) == 0::I8); + ASSERT(%mulmayoflo(64::I8, 2::I8) > 0::I8); + ASSERT(%mulmayoflo(2::I8, 64::I8) > 0::I8); + ASSERT(%mulmayoflo(127::I8, -1::I8) == 0::I8); + ASSERT(%mulmayoflo(-1::I8, 127::I8) == 0::I8); + ASSERT(%mulmayoflo(-128::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(-64::I8, 2::I8) == 0::I8); + ASSERT(%mulmayoflo(2::I8, -64::I8) == 0::I8); + ASSERT(%mulmayoflo(-65::I8, 2::I8) > 0::I8); + ASSERT(%mulmayoflo(2::I8, -65::I8) > 0::I8); + + // --- I16 + ASSERT(%mulmayoflo(1::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(0::I16, 0::I16) == 0::I16); + ASSERT(%mulmayoflo(-1::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16, -1::I16) == 0::I16); + ASSERT(%mulmayoflo(32767::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16,32767 ::I16) == 0::I16); + ASSERT(%mulmayoflo(16383::I16, 2::I16) == 0::I16); + ASSERT(%mulmayoflo(2::I16, 16383::I16) == 0::I16); + ASSERT(%mulmayoflo(16384::I16, 2::I16) > 0::I16); + ASSERT(%mulmayoflo(2::I16, 16384::I16) > 0::I16); + ASSERT(%mulmayoflo(-16384::I16, 2::I16) == 0::I16); + ASSERT(%mulmayoflo(2::I16, -16384::I16) == 0::I16); + ASSERT(%mulmayoflo(-32768::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16, -32768::I16) == 0::I16); + + // -- I32 + ASSERT(%mulmayoflo(1::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(0::I32, 0::I32) == 0::I32); + ASSERT(%mulmayoflo(-1::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, -1::I32) == 0::I32); + ASSERT(%mulmayoflo(2147483647::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, 2147483647::I32) == 0::I32); + ASSERT(%mulmayoflo(-2147483648::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, -2147483648::I32) == 0::I32); + ASSERT(%mulmayoflo(2::I32, 1073741823::I32) == 0::I32); + ASSERT(%mulmayoflo(1073741823::I32, 2::I32) == 0::I32); + ASSERT(%mulmayoflo(2::I32, 1073741824::I32) > 0::I32); + ASSERT(%mulmayoflo(1073741824::I32, 2::I32) > 0::I32); + ASSERT(%mulmayoflo(2::I32, -1073741824::I32) == 0::I32); + ASSERT(%mulmayoflo(-1073741824::I32, 2::I32) == 0::I32); + ASSERT(%mulmayoflo(2::I32, -1073741825::I32) > 0::I32); + ASSERT(%mulmayoflo(-1073741825::I32, 2::I32) > 0::I32); + + // -- I64 + ASSERT(%mulmayoflo(1::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(0::I64, 0::I64) == 0::I64); + ASSERT(%mulmayoflo(-1::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(1::I64, -1::I64) == 0::I64); + ASSERT(%mulmayoflo(9223372036854775807::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(1::I64, 9223372036854775807::I64) == 0::I64); + ASSERT(%mulmayoflo(-9223372036854775808::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(1::I64, -9223372036854775808::I64) == 0::I64); + ASSERT(%mulmayoflo(4611686018427387903::I64, 2::I64) == 0::I64); + ASSERT(%mulmayoflo(2::I64, 4611686018427387903::I64) == 0::I64); + ASSERT(%mulmayoflo(-4611686018427387904::I64, 2::I64) == 0::I64); + ASSERT(%mulmayoflo(2::I64, -4611686018427387904::I64) == 0::I64); + ASSERT(%mulmayoflo(-4611686018427387905::I64, 2::I64) > 0::I64); + ASSERT(%mulmayoflo(2::I64, -4611686018427387905::I64) > 0::I64); + ASSERT(%mulmayoflo(4611686018427387904::I64, 2::I64) > 0::I64); + ASSERT(%mulmayoflo(2::I64, 4611686018427387904::I64) > 0::I64); + // Gives a linter error + // ASSERT(%mulmayoflo(1::I64, 1::I8) == 0); return(0); } ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -231,6 +231,6 @@ test('T22296',[only_ways(llvm_ways) test('T22798', normal, compile_and_run, ['-fregs-graph']) test('MulMayOflo', - [ omit_ways(['ghci']), js_skip], + [ omit_ways(['ghci']), js_skip, ignore_stdout], multi_compile_and_run, ['MulMayOflo', [('MulMayOflo_cmm.cmm', '')], '']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/93273fdd6931c0ba940b9435f46f0dbd5559fff6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/93273fdd6931c0ba940b9435f46f0dbd5559fff6 You're receiving 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 Jun 9 14:42:33 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Fri, 09 Jun 2023 10:42:33 -0400 Subject: [Git][ghc/ghc][wip/or-pats] Update Monad.hs Message-ID: <64833a5963567_e2555324edb8187245@gitlab.mail> David pushed to branch wip/or-pats at Glasgow Haskell Compiler / GHC Commits: 0ce8e9db by David at 2023-06-09T14:42:31+00:00 Update Monad.hs - - - - - 1 changed file: - compiler/GHC/HsToCore/Monad.hs Changes: ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -154,6 +154,7 @@ instance Outputable DsMatchContext where data EquationInfo = EqnMatch (Pat GhcTc) Origin EquationInfo | EqnDone (MatchResult CoreExpr) +mkEqnInfo :: [Pat GhcTc] -> Origin -> MatchResult CoreExpr -> EquationInfo mkEqnInfo [] _ rhs = EqnDone rhs mkEqnInfo (pat:pats) orig rhs = EqnMatch pat orig (mkEqnInfo pats orig rhs) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0ce8e9db366a28464869e6f1351015f2f3b1cce3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0ce8e9db366a28464869e6f1351015f2f3b1cce3 You're receiving 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 Jun 9 19:19:21 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 09 Jun 2023 15:19:21 -0400 Subject: [Git][ghc/ghc][master] 3 commits: Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma Message-ID: <64837b398c7d5_e25552e71f10213376@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 9 changed files: - compiler/GHC/Driver/Make.hs - compiler/GHC/Utils/TmpFs.hs - testsuite/tests/driver/Makefile - + testsuite/tests/driver/T23339.hs - + testsuite/tests/driver/T23339.stdout - + testsuite/tests/driver/T23339B.hs - + testsuite/tests/driver/T23339B.stdout - testsuite/tests/driver/all.T - testsuite/tests/ghci/prog018/prog018.stdout Changes: ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -782,16 +782,14 @@ load' mhmi_cache how_much diag_wrapper mHscMessage mod_graph = do worker_limit <- liftIO $ mkWorkerLimit dflags setSession $ hscUpdateHUG (unitEnv_map pruneHomeUnitEnv) hsc_env - (upsweep_ok, hsc_env1) <- withDeferredDiagnostics $ do + (upsweep_ok, new_deps) <- withDeferredDiagnostics $ do hsc_env <- getSession liftIO $ upsweep worker_limit hsc_env mhmi_cache diag_wrapper mHscMessage (toCache pruned_cache) build_plan - setSession hsc_env1 + modifySession (addDepsToHscEnv new_deps) case upsweep_ok of Failed -> loadFinish upsweep_ok Succeeded -> do liftIO $ debugTraceMsg logger 2 (text "Upsweep completely successful.") - -- Clean up after ourselves - liftIO $ cleanCurrentModuleTempFilesMaybe logger (hsc_tmpfs hsc_env1) dflags loadFinish upsweep_ok @@ -1262,14 +1260,13 @@ upsweep -> Maybe Messager -> M.Map ModNodeKeyWithUid HomeModInfo -> [BuildPlan] - -> IO (SuccessFlag, HscEnv) + -> IO (SuccessFlag, [HomeModInfo]) upsweep n_jobs hsc_env hmi_cache diag_wrapper mHscMessage old_hpt build_plan = do (cycle, pipelines, collect_result) <- interpretBuildPlan (hsc_HUG hsc_env) hmi_cache old_hpt build_plan runPipelines n_jobs hsc_env diag_wrapper mHscMessage pipelines res <- collect_result let completed = [m | Just (Just m) <- res] - let hsc_env' = addDepsToHscEnv completed hsc_env -- Handle any cycle in the original compilation graph and return the result -- of the upsweep. @@ -1277,10 +1274,10 @@ upsweep n_jobs hsc_env hmi_cache diag_wrapper mHscMessage old_hpt build_plan = d Just mss -> do let logger = hsc_logger hsc_env liftIO $ fatalErrorMsg logger (cyclicModuleErr mss) - return (Failed, hsc_env) + return (Failed, []) Nothing -> do let success_flag = successIf (all isJust res) - return (success_flag, hsc_env') + return (success_flag, completed) toCache :: [HomeModInfo] -> M.Map (ModNodeKeyWithUid) HomeModInfo toCache hmis = M.fromList ([(miKey $ hm_iface hmi, hmi) | hmi <- hmis]) @@ -2345,18 +2342,21 @@ withDeferredDiagnostics f = do let action = logMsg logger msgClass srcSpan msg case msgClass of MCDiagnostic SevWarning _reason _code - -> atomicModifyIORef' warnings $ \i -> (action: i, ()) + -> atomicModifyIORef' warnings $ \(!i) -> (action: i, ()) MCDiagnostic SevError _reason _code - -> atomicModifyIORef' errors $ \i -> (action: i, ()) + -> atomicModifyIORef' errors $ \(!i) -> (action: i, ()) MCFatal - -> atomicModifyIORef' fatals $ \i -> (action: i, ()) + -> atomicModifyIORef' fatals $ \(!i) -> (action: i, ()) _ -> action printDeferredDiagnostics = liftIO $ forM_ [warnings, errors, fatals] $ \ref -> do -- This IORef can leak when the dflags leaks, so let us always - -- reset the content. - actions <- atomicModifyIORef' ref $ \i -> ([], i) + -- reset the content. The lazy variant is used here as we want to force + -- this error if the IORef is ever accessed again, rather than now. + -- See #20981 for an issue which discusses this general issue. + let landmine = if debugIsOn then panic "withDeferredDiagnostics: use after free" else [] + actions <- atomicModifyIORef ref $ \i -> (landmine, i) sequence_ $ reverse actions MC.bracket @@ -2432,8 +2432,9 @@ cyclicModuleErr mss cleanCurrentModuleTempFilesMaybe :: MonadIO m => Logger -> TmpFs -> DynFlags -> m () cleanCurrentModuleTempFilesMaybe logger tmpfs dflags = - unless (gopt Opt_KeepTmpFiles dflags) $ - liftIO $ cleanCurrentModuleTempFiles logger tmpfs + if gopt Opt_KeepTmpFiles dflags + then liftIO $ keepCurrentModuleTempFiles logger tmpfs + else liftIO $ cleanCurrentModuleTempFiles logger tmpfs addDepsToHscEnv :: [HomeModInfo] -> HscEnv -> HscEnv ===================================== compiler/GHC/Utils/TmpFs.hs ===================================== @@ -13,6 +13,7 @@ module GHC.Utils.TmpFs , cleanTempDirs , cleanTempFiles , cleanCurrentModuleTempFiles + , keepCurrentModuleTempFiles , addFilesToClean , changeTempFilesLifetime , newTempName @@ -172,6 +173,32 @@ cleanTempFiles logger tmpfs , Set.toList cm_paths ++ Set.toList gs_paths) remove to_delete +-- | Keep all the paths in @tmp_files_to_clean@ and @tmp_subdirs_to_clean@ +-- that have lifetime TFL_CurrentModule. This function is used when `-keep-tmp-files` is +-- used in an OPTIONS_GHC pragma. +-- This function removes the temporary file from the TmpFs so we no longer remove +-- it at the env when cleanTempFiles is called. +keepCurrentModuleTempFiles :: HasCallStack => Logger -> TmpFs -> IO () +keepCurrentModuleTempFiles logger tmpfs + = mask_ + $ do to_keep_files <- keep (tmp_files_to_clean tmpfs) + to_keep_subdirs <- keep (tmp_subdirs_to_clean tmpfs) + -- Remove any folders which contain any files we want to keep from the + -- directories we are tracking. A new temporary directory will be created + -- the next time a temporary file is needed (by perhaps another module). + keepDirs (to_keep_files ++ to_keep_subdirs) (tmp_dirs_to_clean tmpfs) + where + keepDirs keeps ref = do + let keep_dirs = Set.fromList (map takeDirectory keeps) + atomicModifyIORef' ref $ \m -> (Map.filter (\fp -> fp `Set.notMember` keep_dirs) m, ()) + + keep ref = do + to_keep <- atomicModifyIORef' ref $ + \ptc at PathsToClean{ptcCurrentModule = cm_paths} -> + (ptc {ptcCurrentModule = Set.empty}, Set.toList cm_paths) + debugTraceMsg logger 2 (text "Keeping:" <+> hsep (map text to_keep)) + return to_keep + -- | Delete all paths in @tmp_files_to_clean@ and @tmp_subdirs_to_clean@ -- That have lifetime TFL_CurrentModule. -- If a file must be cleaned eventually, but must survive a ===================================== testsuite/tests/driver/Makefile ===================================== @@ -792,4 +792,21 @@ T22669: ! test -f T22669.o-boot +T23339: + $(RM) T23339.hi + $(RM) T23339$(OBJSUFFIX) + $(RM) -rf "$(PWD)/tmp" + mkdir -p tmp + "$(TEST_HC)" -tmpdir "$(PWD)/tmp" $(TEST_HC_OPTS) -v0 T23339.hs + find . -name "*.c" -exec cat {} \; | grep "init__ip_init" + +T23339B: + $(RM) T23339.hi + $(RM) T23339$(OBJSUFFIX) + $(RM) -rf "$(PWD)/tmp" + mkdir -p tmp + "$(TEST_HC)" -tmpdir "$(PWD)/tmp" $(TEST_HC_OPTS) -v0 T23339B.hs -finfo-table-map + # Check that the file is kept and is the right one + find . -name "*.c" -exec cat {} \; | grep "init__ip_init" + ===================================== testsuite/tests/driver/T23339.hs ===================================== @@ -0,0 +1,4 @@ +{-# OPTIONS_GHC -keep-tmp-files -finfo-table-map #-} +module T23339 where + +defn = id "T23339" ===================================== testsuite/tests/driver/T23339.stdout ===================================== @@ -0,0 +1 @@ +void T23339_init__ip_init (void) ===================================== testsuite/tests/driver/T23339B.hs ===================================== @@ -0,0 +1,5 @@ +module T23339B where + +import T23339 + +qux = id "abc" ===================================== testsuite/tests/driver/T23339B.stdout ===================================== @@ -0,0 +1 @@ +void T23339_init__ip_init (void) ===================================== testsuite/tests/driver/all.T ===================================== @@ -320,3 +320,5 @@ 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', js_skip, makefile_test, []) +test('T23339', js_skip, makefile_test, []) +test('T23339B', [extra_files(['T23339.hs']), js_skip], makefile_test, []) ===================================== testsuite/tests/ghci/prog018/prog018.stdout ===================================== @@ -19,4 +19,7 @@ C.hs:6:7: error: [GHC-88464] Variable not in scope: variableNotInScope :: () Failed, two modules loaded. [3 of 3] Compiling C ( C.hs, interpreted ) + +C.hs:6:7: error: [GHC-88464] + Variable not in scope: variableNotInScope :: () Failed, two modules loaded. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3ab0155b43e3a4a15217206a0731993b604fb958...432c736c19446a011fca1f9485c67761c991bd42 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3ab0155b43e3a4a15217206a0731993b604fb958...432c736c19446a011fca1f9485c67761c991bd42 You're receiving 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 Jun 9 19:20:01 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 09 Jun 2023 15:20:01 -0400 Subject: [Git][ghc/ghc][master] Dump `SpecConstr` specialisations separately Message-ID: <64837b6173df4_e2555355a50c2173e9@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 5 changed files: - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/debugging.rst Changes: ===================================== compiler/GHC/Driver/Config/Core/Lint.hs ===================================== @@ -87,7 +87,7 @@ coreDumpFlag (CoreDoDemand {}) = Just Opt_D_dump_stranal coreDumpFlag CoreDoCpr = Just Opt_D_dump_cpranal coreDumpFlag CoreDoWorkerWrapper = Just Opt_D_dump_worker_wrapper coreDumpFlag CoreDoSpecialising = Just Opt_D_dump_spec -coreDumpFlag CoreDoSpecConstr = Just Opt_D_dump_spec +coreDumpFlag CoreDoSpecConstr = Just Opt_D_dump_spec_constr coreDumpFlag CoreCSE = Just Opt_D_dump_cse coreDumpFlag CoreDesugar = Just Opt_D_dump_ds_preopt coreDumpFlag CoreDesugarOpt = Just Opt_D_dump_ds ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -107,6 +107,7 @@ data DumpFlag | Opt_D_dump_simpl | Opt_D_dump_simpl_iterations | Opt_D_dump_spec + | Opt_D_dump_spec_constr | Opt_D_dump_prep | Opt_D_dump_late_cc | Opt_D_dump_stg_from_core -- ^ Initial STG (CoreToStg output) ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -1425,6 +1425,8 @@ dynamic_flags_deps = [ (setDumpFlag Opt_D_dump_simpl_iterations) , make_ord_flag defGhcFlag "ddump-spec" (setDumpFlag Opt_D_dump_spec) + , make_ord_flag defGhcFlag "ddump-spec-constr" + (setDumpFlag Opt_D_dump_spec_constr) , make_ord_flag defGhcFlag "ddump-prep" (setDumpFlag Opt_D_dump_prep) , make_ord_flag defGhcFlag "ddump-late-cc" ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -128,6 +128,10 @@ Compiler GHC used to accept the contradictory ``Int~Bool`` in the type signature, but reject the ``Int~Bool`` constraint that arises from typechecking the definition itself. Now it accepts both. More details in `GHC ticket #23413 `_, which gives examples of the previous inconsistency. GHC now implements the "PermissivePlan" described in that ticket. +- The `-ddump-spec` flag has been split into `-ddump-spec` and + `-ddump-spec-constr`, allowing only output from the typeclass specialiser or + `SpecConstr` to be seen if desired. + GHCi ~~~~ ===================================== docs/users_guide/debugging.rst ===================================== @@ -324,7 +324,15 @@ subexpression elimination pass. :shortdesc: Dump specialiser output :type: dynamic - Dump output of specialisation pass + Dump output of typeclass specialisation pass + +.. ghc-flag:: -ddump-spec-constr + :shortdesc: Dump specialiser output from SpecConstr + :type: dynamic + + :since: 9.8.1 + + Dump output of the SpecConstr specialisation pass .. ghc-flag:: -ddump-rules :shortdesc: Dump rewrite rules View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/26013cdc40183c1b7ee4b5674750133d17f73a72 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/26013cdc40183c1b7ee4b5674750133d17f73a72 You're receiving 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 Jun 9 19:50:46 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 09 Jun 2023 15:50:46 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma Message-ID: <648382965197e_e2555cb4a580219021@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - d5adbbe4 by Matthew Pickering at 2023-06-09T15:50:34-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - d46dbc57 by Matthew Pickering at 2023-06-09T15:50:34-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 7204d3f8 by David Binder at 2023-06-09T15:50:37-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - 25 changed files: - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Utils/TmpFs.hs - compiler/ghc.cabal.in - docs/users_guide/9.8.1-notes.rst - docs/users_guide/debugging.rst - libraries/base/GHC/TypeLits.hs - libraries/base/GHC/TypeNats.hs - libraries/base/changelog.md - + libraries/base/tests/T23454.hs - + libraries/base/tests/T23454.stderr - libraries/base/tests/all.T - testsuite/tests/driver/Makefile - + testsuite/tests/driver/T23339.hs - + testsuite/tests/driver/T23339.stdout - + testsuite/tests/driver/T23339B.hs - + testsuite/tests/driver/T23339B.stdout - testsuite/tests/driver/all.T - testsuite/tests/ghci/prog018/prog018.stdout - testsuite/tests/ghci/scripts/T9181.stdout - testsuite/tests/overloadedrecflds/ghci/T13438.script - testsuite/tests/overloadedrecflds/ghci/T13438.stdout - testsuite/tests/overloadedrecflds/ghci/all.T Changes: ===================================== compiler/GHC/Driver/Config/Core/Lint.hs ===================================== @@ -87,7 +87,7 @@ coreDumpFlag (CoreDoDemand {}) = Just Opt_D_dump_stranal coreDumpFlag CoreDoCpr = Just Opt_D_dump_cpranal coreDumpFlag CoreDoWorkerWrapper = Just Opt_D_dump_worker_wrapper coreDumpFlag CoreDoSpecialising = Just Opt_D_dump_spec -coreDumpFlag CoreDoSpecConstr = Just Opt_D_dump_spec +coreDumpFlag CoreDoSpecConstr = Just Opt_D_dump_spec_constr coreDumpFlag CoreCSE = Just Opt_D_dump_cse coreDumpFlag CoreDesugar = Just Opt_D_dump_ds_preopt coreDumpFlag CoreDesugarOpt = Just Opt_D_dump_ds ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -107,6 +107,7 @@ data DumpFlag | Opt_D_dump_simpl | Opt_D_dump_simpl_iterations | Opt_D_dump_spec + | Opt_D_dump_spec_constr | Opt_D_dump_prep | Opt_D_dump_late_cc | Opt_D_dump_stg_from_core -- ^ Initial STG (CoreToStg output) ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -782,16 +782,14 @@ load' mhmi_cache how_much diag_wrapper mHscMessage mod_graph = do worker_limit <- liftIO $ mkWorkerLimit dflags setSession $ hscUpdateHUG (unitEnv_map pruneHomeUnitEnv) hsc_env - (upsweep_ok, hsc_env1) <- withDeferredDiagnostics $ do + (upsweep_ok, new_deps) <- withDeferredDiagnostics $ do hsc_env <- getSession liftIO $ upsweep worker_limit hsc_env mhmi_cache diag_wrapper mHscMessage (toCache pruned_cache) build_plan - setSession hsc_env1 + modifySession (addDepsToHscEnv new_deps) case upsweep_ok of Failed -> loadFinish upsweep_ok Succeeded -> do liftIO $ debugTraceMsg logger 2 (text "Upsweep completely successful.") - -- Clean up after ourselves - liftIO $ cleanCurrentModuleTempFilesMaybe logger (hsc_tmpfs hsc_env1) dflags loadFinish upsweep_ok @@ -1262,14 +1260,13 @@ upsweep -> Maybe Messager -> M.Map ModNodeKeyWithUid HomeModInfo -> [BuildPlan] - -> IO (SuccessFlag, HscEnv) + -> IO (SuccessFlag, [HomeModInfo]) upsweep n_jobs hsc_env hmi_cache diag_wrapper mHscMessage old_hpt build_plan = do (cycle, pipelines, collect_result) <- interpretBuildPlan (hsc_HUG hsc_env) hmi_cache old_hpt build_plan runPipelines n_jobs hsc_env diag_wrapper mHscMessage pipelines res <- collect_result let completed = [m | Just (Just m) <- res] - let hsc_env' = addDepsToHscEnv completed hsc_env -- Handle any cycle in the original compilation graph and return the result -- of the upsweep. @@ -1277,10 +1274,10 @@ upsweep n_jobs hsc_env hmi_cache diag_wrapper mHscMessage old_hpt build_plan = d Just mss -> do let logger = hsc_logger hsc_env liftIO $ fatalErrorMsg logger (cyclicModuleErr mss) - return (Failed, hsc_env) + return (Failed, []) Nothing -> do let success_flag = successIf (all isJust res) - return (success_flag, hsc_env') + return (success_flag, completed) toCache :: [HomeModInfo] -> M.Map (ModNodeKeyWithUid) HomeModInfo toCache hmis = M.fromList ([(miKey $ hm_iface hmi, hmi) | hmi <- hmis]) @@ -2345,18 +2342,21 @@ withDeferredDiagnostics f = do let action = logMsg logger msgClass srcSpan msg case msgClass of MCDiagnostic SevWarning _reason _code - -> atomicModifyIORef' warnings $ \i -> (action: i, ()) + -> atomicModifyIORef' warnings $ \(!i) -> (action: i, ()) MCDiagnostic SevError _reason _code - -> atomicModifyIORef' errors $ \i -> (action: i, ()) + -> atomicModifyIORef' errors $ \(!i) -> (action: i, ()) MCFatal - -> atomicModifyIORef' fatals $ \i -> (action: i, ()) + -> atomicModifyIORef' fatals $ \(!i) -> (action: i, ()) _ -> action printDeferredDiagnostics = liftIO $ forM_ [warnings, errors, fatals] $ \ref -> do -- This IORef can leak when the dflags leaks, so let us always - -- reset the content. - actions <- atomicModifyIORef' ref $ \i -> ([], i) + -- reset the content. The lazy variant is used here as we want to force + -- this error if the IORef is ever accessed again, rather than now. + -- See #20981 for an issue which discusses this general issue. + let landmine = if debugIsOn then panic "withDeferredDiagnostics: use after free" else [] + actions <- atomicModifyIORef ref $ \i -> (landmine, i) sequence_ $ reverse actions MC.bracket @@ -2432,8 +2432,9 @@ cyclicModuleErr mss cleanCurrentModuleTempFilesMaybe :: MonadIO m => Logger -> TmpFs -> DynFlags -> m () cleanCurrentModuleTempFilesMaybe logger tmpfs dflags = - unless (gopt Opt_KeepTmpFiles dflags) $ - liftIO $ cleanCurrentModuleTempFiles logger tmpfs + if gopt Opt_KeepTmpFiles dflags + then liftIO $ keepCurrentModuleTempFiles logger tmpfs + else liftIO $ cleanCurrentModuleTempFiles logger tmpfs addDepsToHscEnv :: [HomeModInfo] -> HscEnv -> HscEnv ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -1425,6 +1425,8 @@ dynamic_flags_deps = [ (setDumpFlag Opt_D_dump_simpl_iterations) , make_ord_flag defGhcFlag "ddump-spec" (setDumpFlag Opt_D_dump_spec) + , make_ord_flag defGhcFlag "ddump-spec-constr" + (setDumpFlag Opt_D_dump_spec_constr) , make_ord_flag defGhcFlag "ddump-prep" (setDumpFlag Opt_D_dump_prep) , make_ord_flag defGhcFlag "ddump-late-cc" ===================================== compiler/GHC/Utils/TmpFs.hs ===================================== @@ -13,6 +13,7 @@ module GHC.Utils.TmpFs , cleanTempDirs , cleanTempFiles , cleanCurrentModuleTempFiles + , keepCurrentModuleTempFiles , addFilesToClean , changeTempFilesLifetime , newTempName @@ -172,6 +173,32 @@ cleanTempFiles logger tmpfs , Set.toList cm_paths ++ Set.toList gs_paths) remove to_delete +-- | Keep all the paths in @tmp_files_to_clean@ and @tmp_subdirs_to_clean@ +-- that have lifetime TFL_CurrentModule. This function is used when `-keep-tmp-files` is +-- used in an OPTIONS_GHC pragma. +-- This function removes the temporary file from the TmpFs so we no longer remove +-- it at the env when cleanTempFiles is called. +keepCurrentModuleTempFiles :: HasCallStack => Logger -> TmpFs -> IO () +keepCurrentModuleTempFiles logger tmpfs + = mask_ + $ do to_keep_files <- keep (tmp_files_to_clean tmpfs) + to_keep_subdirs <- keep (tmp_subdirs_to_clean tmpfs) + -- Remove any folders which contain any files we want to keep from the + -- directories we are tracking. A new temporary directory will be created + -- the next time a temporary file is needed (by perhaps another module). + keepDirs (to_keep_files ++ to_keep_subdirs) (tmp_dirs_to_clean tmpfs) + where + keepDirs keeps ref = do + let keep_dirs = Set.fromList (map takeDirectory keeps) + atomicModifyIORef' ref $ \m -> (Map.filter (\fp -> fp `Set.notMember` keep_dirs) m, ()) + + keep ref = do + to_keep <- atomicModifyIORef' ref $ + \ptc at PathsToClean{ptcCurrentModule = cm_paths} -> + (ptc {ptcCurrentModule = Set.empty}, Set.toList cm_paths) + debugTraceMsg logger 2 (text "Keeping:" <+> hsep (map text to_keep)) + return to_keep + -- | Delete all paths in @tmp_files_to_clean@ and @tmp_subdirs_to_clean@ -- That have lifetime TFL_CurrentModule. -- If a file must be cleaned eventually, but must survive a ===================================== compiler/ghc.cabal.in ===================================== @@ -25,7 +25,6 @@ Build-Type: Custom extra-source-files: GHC/Builtin/primops.txt.pp - GHC/Builtin/bytearray-ops.txt.pp Unique.h CodeGen.Platform.h -- Shared with rts via hard-link at configure time. This is safer ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -128,6 +128,10 @@ Compiler GHC used to accept the contradictory ``Int~Bool`` in the type signature, but reject the ``Int~Bool`` constraint that arises from typechecking the definition itself. Now it accepts both. More details in `GHC ticket #23413 `_, which gives examples of the previous inconsistency. GHC now implements the "PermissivePlan" described in that ticket. +- The `-ddump-spec` flag has been split into `-ddump-spec` and + `-ddump-spec-constr`, allowing only output from the typeclass specialiser or + `SpecConstr` to be seen if desired. + GHCi ~~~~ ===================================== docs/users_guide/debugging.rst ===================================== @@ -324,7 +324,15 @@ subexpression elimination pass. :shortdesc: Dump specialiser output :type: dynamic - Dump output of specialisation pass + Dump output of typeclass specialisation pass + +.. ghc-flag:: -ddump-spec-constr + :shortdesc: Dump specialiser output from SpecConstr + :type: dynamic + + :since: 9.8.1 + + Dump output of the SpecConstr specialisation pass .. ghc-flag:: -ddump-rules :shortdesc: Dump rewrite rules ===================================== libraries/base/GHC/TypeLits.hs ===================================== @@ -15,6 +15,7 @@ {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE RoleAnnotations #-} {-| GHC's @DataKinds@ language extension lifts data constructors, natural @@ -340,6 +341,7 @@ withSomeSNat n k -- -- @since 4.18.0.0 newtype SSymbol (s :: Symbol) = UnsafeSSymbol String +type role SSymbol nominal -- | A explicitly bidirectional pattern synonym relating an 'SSymbol' to a -- 'KnownSymbol' constraint. @@ -442,6 +444,7 @@ withSomeSSymbol s k = k (UnsafeSSymbol s) -- -- @since 4.18.0.0 newtype SChar (s :: Char) = UnsafeSChar Char +type role SChar nominal -- | A explicitly bidirectional pattern synonym relating an 'SChar' to a -- 'KnownChar' constraint. ===================================== libraries/base/GHC/TypeNats.hs ===================================== @@ -16,6 +16,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE RoleAnnotations #-} {-| This module is an internal GHC module. It declares the constants used in the implementation of type-level natural numbers. The programmer interface @@ -344,6 +345,7 @@ cmpNat x y = case compare (natVal x) (natVal y) of -- -- @since 4.18.0.0 newtype SNat (n :: Nat) = UnsafeSNat Natural +type role SNat nominal -- | A explicitly bidirectional pattern synonym relating an 'SNat' to a -- 'KnownNat' constraint. ===================================== libraries/base/changelog.md ===================================== @@ -32,6 +32,7 @@ * Make `(&)` representation polymorphic in the return type ([CLC proposal #158](https://github.com/haskell/core-libraries-committee/issues/158)) * Implement `GHC.IORef.atomicSwapIORef` via a new dedicated primop `atomicSwapMutVar#` ([CLC proposal #139](https://github.com/haskell/core-libraries-committee/issues/139)) * Change codebuffers to use an unboxed implementation, while providing a compatibility layer using pattern synonyms. ([CLC proposal #134](https://github.com/haskell/core-libraries-committee/issues/134)) + * Add nominal role annotations to SNat/SSymbol/SChar ([CLC proposal #170](https://github.com/haskell/core-libraries-committee/issues/170)) ## 4.18.0.0 *March 2023* * Shipped with GHC 9.6.1 ===================================== libraries/base/tests/T23454.hs ===================================== @@ -0,0 +1,27 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} + +module T23454 where + +import Data.Coerce (coerce) +import Data.Kind (Type) +import Data.Type.Equality +import GHC.TypeNats + +bogus :: forall a b . KnownNat a => a :~: b +bogus = case testEquality (SNat @a) (coerce (SNat @a) :: SNat b) of + Just r -> r + Nothing -> error "bug fixed" + +type G :: Nat -> Type -> Type -> Type +type family G n s t where + G 0 s _ = s + G _ _ t = t + +newtype N n s t = MkN { unN :: G n s t } + +oops :: forall b s t . N 0 s t -> N b s t +oops x = gcastWith (bogus @0 @b) x + +unsafeCoerce :: s -> t +unsafeCoerce x = unN (oops @1 (MkN x)) ===================================== libraries/base/tests/T23454.stderr ===================================== @@ -0,0 +1,21 @@ + +T23454.hs:12:38: 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: + bogus :: forall (a :: Nat) (b :: Nat). KnownNat a => a :~: b + at T23454.hs:11:1-43 + ‘b’ is a rigid type variable bound by + the type signature for: + bogus :: forall (a :: Nat) (b :: Nat). KnownNat a => a :~: b + at T23454.hs:11:1-43 + • In the second argument of ‘testEquality’, namely + ‘(coerce (SNat @a) :: SNat b)’ + In the expression: + testEquality (SNat @a) (coerce (SNat @a) :: SNat b) + In the expression: + case testEquality (SNat @a) (coerce (SNat @a) :: SNat b) of + Just r -> r + Nothing -> error "bug fixed" + • Relevant bindings include + bogus :: a :~: b (bound at T23454.hs:12:1) ===================================== libraries/base/tests/all.T ===================================== @@ -300,3 +300,4 @@ test('listThreads1', normal, compile_and_run, ['']) test('inits1tails1', normal, compile_and_run, ['']) test('CLC149', normal, compile, ['']) test('AtomicSwapIORef', normal, compile_and_run, ['']) +test('T23454', normal, compile_fail, ['']) ===================================== testsuite/tests/driver/Makefile ===================================== @@ -792,4 +792,21 @@ T22669: ! test -f T22669.o-boot +T23339: + $(RM) T23339.hi + $(RM) T23339$(OBJSUFFIX) + $(RM) -rf "$(PWD)/tmp" + mkdir -p tmp + "$(TEST_HC)" -tmpdir "$(PWD)/tmp" $(TEST_HC_OPTS) -v0 T23339.hs + find . -name "*.c" -exec cat {} \; | grep "init__ip_init" + +T23339B: + $(RM) T23339.hi + $(RM) T23339$(OBJSUFFIX) + $(RM) -rf "$(PWD)/tmp" + mkdir -p tmp + "$(TEST_HC)" -tmpdir "$(PWD)/tmp" $(TEST_HC_OPTS) -v0 T23339B.hs -finfo-table-map + # Check that the file is kept and is the right one + find . -name "*.c" -exec cat {} \; | grep "init__ip_init" + ===================================== testsuite/tests/driver/T23339.hs ===================================== @@ -0,0 +1,4 @@ +{-# OPTIONS_GHC -keep-tmp-files -finfo-table-map #-} +module T23339 where + +defn = id "T23339" ===================================== testsuite/tests/driver/T23339.stdout ===================================== @@ -0,0 +1 @@ +void T23339_init__ip_init (void) ===================================== testsuite/tests/driver/T23339B.hs ===================================== @@ -0,0 +1,5 @@ +module T23339B where + +import T23339 + +qux = id "abc" ===================================== testsuite/tests/driver/T23339B.stdout ===================================== @@ -0,0 +1 @@ +void T23339_init__ip_init (void) ===================================== testsuite/tests/driver/all.T ===================================== @@ -320,3 +320,5 @@ 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', js_skip, makefile_test, []) +test('T23339', js_skip, makefile_test, []) +test('T23339B', [extra_files(['T23339.hs']), js_skip], makefile_test, []) ===================================== testsuite/tests/ghci/prog018/prog018.stdout ===================================== @@ -19,4 +19,7 @@ C.hs:6:7: error: [GHC-88464] Variable not in scope: variableNotInScope :: () Failed, two modules loaded. [3 of 3] Compiling C ( C.hs, interpreted ) + +C.hs:6:7: error: [GHC-88464] + Variable not in scope: variableNotInScope :: () Failed, two modules loaded. ===================================== testsuite/tests/ghci/scripts/T9181.stdout ===================================== @@ -18,12 +18,12 @@ type GHC.TypeLits.NatToChar :: GHC.Num.Natural.Natural -> Char type family GHC.TypeLits.NatToChar a pattern GHC.TypeLits.SChar :: () => GHC.TypeLits.KnownChar c => GHC.TypeLits.SChar c -type role GHC.TypeLits.SChar phantom +type role GHC.TypeLits.SChar nominal type GHC.TypeLits.SChar :: Char -> * newtype GHC.TypeLits.SChar s = GHC.TypeLits.UnsafeSChar Char pattern GHC.TypeLits.SSymbol :: () => GHC.TypeLits.KnownSymbol s => GHC.TypeLits.SSymbol s -type role GHC.TypeLits.SSymbol phantom +type role GHC.TypeLits.SSymbol nominal type GHC.TypeLits.SSymbol :: GHC.Types.Symbol -> * newtype GHC.TypeLits.SSymbol s = GHC.TypeLits.UnsafeSSymbol String type GHC.TypeLits.SomeChar :: * @@ -166,7 +166,7 @@ data Data.Type.Ord.OrderingI a b where Data.Type.Ord.OrderingI a b pattern GHC.TypeNats.SNat :: () => GHC.TypeNats.KnownNat n => GHC.TypeNats.SNat n -type role GHC.TypeNats.SNat phantom +type role GHC.TypeNats.SNat nominal type GHC.TypeNats.SNat :: GHC.TypeNats.Nat -> * newtype GHC.TypeNats.SNat n = GHC.TypeNats.UnsafeSNat GHC.Num.Natural.Natural ===================================== testsuite/tests/overloadedrecflds/ghci/T13438.script ===================================== @@ -1,5 +1,3 @@ :l T13438.hs :browse! T13438 :browse T13438 -:ctags -:!cat tags ===================================== testsuite/tests/overloadedrecflds/ghci/T13438.stdout ===================================== @@ -5,6 +5,3 @@ MkT :: Int -> T foo :: T -> Int type T :: * data T = MkT {foo :: Int} -foo T13438.hs 3;" v file: -MkT T13438.hs 3;" d -T T13438.hs 3;" t ===================================== testsuite/tests/overloadedrecflds/ghci/all.T ===================================== @@ -1,6 +1,6 @@ test('duplicaterecfldsghci01', combined_output, ghci_script, ['duplicaterecfldsghci01.script']) test('overloadedlabelsghci01', combined_output, ghci_script, ['overloadedlabelsghci01.script']) -test('T13438', [expect_broken(13438), combined_output], ghci_script, ['T13438.script']) +test('T13438', combined_output, ghci_script, ['T13438.script']) test('GHCiDRF', [extra_files(['GHCiDRF.hs']), combined_output], ghci_script, ['GHCiDRF.script']) test('T19322', combined_output, ghci_script, ['T19322.script']) test('T19314', combined_output, ghci_script, ['T19314.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e5dd14da021928830d0861907bf6369016f02795...7204d3f8c305e4569df9e3421fa2bff1ec8805b1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e5dd14da021928830d0861907bf6369016f02795...7204d3f8c305e4569df9e3421fa2bff1ec8805b1 You're receiving 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 Jun 9 21:17:10 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Fri, 09 Jun 2023 17:17:10 -0400 Subject: [Git][ghc/ghc][wip/expand-do] 31 commits: Update CODEOWNERS Message-ID: <648396d69b356_3b408bc506c365aa@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 77a3770c by Apoorv Ingle at 2023-06-09T15:48:46-05:00 Fixes #18324 #23147 Expands do notation before typechecking using `HsExpansion` - Adds testcases T18324, T18324b, DoubleMatch Expands - Do statements - Monadic do statements - monadic fix blocks - make sure fail is used for pattern match failures in bind statments - Makes sure unused binds generate warnings - runs the pattern match check in generated lambda exprs to avoid getting suprious pattern match failures. c.f. pmcheck/should_compile/DoubleMatch.hs - PopSrcSpan in HsExpr to pop error context - Discards default monad fail alternatives that are spuriously generated - Make sure we check for generated loc span for checking if the (>>) is user written or expanded for /do/ purposes - - - - - 66f81425 by Apoorv Ingle at 2023-06-09T15:48:46-05:00 - Add PopSrcSpan (XXExprGhcRn) in appropriate places while expanding statements - correct source spans displayed for warnDiscardedDoBindings - use `mkExpandStmt` to store original stmts along with expanded expr for using the right context for error message printing - improves error messages for applicative do - remove special case from isMatchContextPmChecked (long distance info is now properly propogated) - set correct src spans to statement expansions - Match ctxt while type checking HsLam is different if the lambda match is due to an expression generated from a do block - call tcExpr and not tcApp in PopSrcSpan so make sure impredicativity works fine - look into XExprs in tcInferAppHead_maybe for infering the type to make T18324 typecheck and run - - - - - 47fb4f78 by Apoorv Ingle at 2023-06-09T15:48:46-05:00 generate incomplete uni patterns warnings if the origin context is a generated do expansion - - - - - e1858b76 by Apoorv Ingle at 2023-06-09T15:48:46-05:00 use the correct bind operator for qualified rebindable rec do expansions - - - - - c585e179 by Apoorv Ingle at 2023-06-09T15:48:46-05:00 trying out changes to heralds - - - - - a329b590 by Apoorv Ingle at 2023-06-09T15:48:46-05:00 add location information for last statements - - - - - 70a7370e by Apoorv Ingle at 2023-06-09T15:48:46-05:00 do not pop context while checking the second argument to expanded (>>) - - - - - 8695c93d by Apoorv Ingle at 2023-06-09T15:48:46-05:00 adjusting the generated spans for proper error messages - - - - - c272b6e7 by Apoorv Ingle at 2023-06-09T15:48:46-05:00 change the addHeadCtxt to include the first statement of the do block for more precise error messages - - - - - a861f273 by Apoorv Ingle at 2023-06-09T15:48:46-05:00 - don't add any ctxt in addExprCtxt for `XExpr(ExpandedStmt{})` as it is not very useful, the statement ctxt is already added by `tcExpr` and `addHeadCtxt` - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - CODEOWNERS - HACKING.md - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Match.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e495b49f9084cc6d10150765b6b614854377174b...a861f2738afa376d5982709b6fd53ac492862360 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e495b49f9084cc6d10150765b6b614854377174b...a861f2738afa376d5982709b6fd53ac492862360 You're receiving 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 Jun 9 22:51:04 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 09 Jun 2023 18:51:04 -0400 Subject: [Git][ghc/ghc][master] Add role annotations to SNat, SSymbol and SChar Message-ID: <6483acd877ff4_3b408bc50a849065@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 7 changed files: - libraries/base/GHC/TypeLits.hs - libraries/base/GHC/TypeNats.hs - libraries/base/changelog.md - + libraries/base/tests/T23454.hs - + libraries/base/tests/T23454.stderr - libraries/base/tests/all.T - testsuite/tests/ghci/scripts/T9181.stdout Changes: ===================================== libraries/base/GHC/TypeLits.hs ===================================== @@ -15,6 +15,7 @@ {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE RoleAnnotations #-} {-| GHC's @DataKinds@ language extension lifts data constructors, natural @@ -340,6 +341,7 @@ withSomeSNat n k -- -- @since 4.18.0.0 newtype SSymbol (s :: Symbol) = UnsafeSSymbol String +type role SSymbol nominal -- | A explicitly bidirectional pattern synonym relating an 'SSymbol' to a -- 'KnownSymbol' constraint. @@ -442,6 +444,7 @@ withSomeSSymbol s k = k (UnsafeSSymbol s) -- -- @since 4.18.0.0 newtype SChar (s :: Char) = UnsafeSChar Char +type role SChar nominal -- | A explicitly bidirectional pattern synonym relating an 'SChar' to a -- 'KnownChar' constraint. ===================================== libraries/base/GHC/TypeNats.hs ===================================== @@ -16,6 +16,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE RoleAnnotations #-} {-| This module is an internal GHC module. It declares the constants used in the implementation of type-level natural numbers. The programmer interface @@ -344,6 +345,7 @@ cmpNat x y = case compare (natVal x) (natVal y) of -- -- @since 4.18.0.0 newtype SNat (n :: Nat) = UnsafeSNat Natural +type role SNat nominal -- | A explicitly bidirectional pattern synonym relating an 'SNat' to a -- 'KnownNat' constraint. ===================================== libraries/base/changelog.md ===================================== @@ -32,6 +32,7 @@ * Make `(&)` representation polymorphic in the return type ([CLC proposal #158](https://github.com/haskell/core-libraries-committee/issues/158)) * Implement `GHC.IORef.atomicSwapIORef` via a new dedicated primop `atomicSwapMutVar#` ([CLC proposal #139](https://github.com/haskell/core-libraries-committee/issues/139)) * Change codebuffers to use an unboxed implementation, while providing a compatibility layer using pattern synonyms. ([CLC proposal #134](https://github.com/haskell/core-libraries-committee/issues/134)) + * Add nominal role annotations to SNat/SSymbol/SChar ([CLC proposal #170](https://github.com/haskell/core-libraries-committee/issues/170)) ## 4.18.0.0 *March 2023* * Shipped with GHC 9.6.1 ===================================== libraries/base/tests/T23454.hs ===================================== @@ -0,0 +1,27 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} + +module T23454 where + +import Data.Coerce (coerce) +import Data.Kind (Type) +import Data.Type.Equality +import GHC.TypeNats + +bogus :: forall a b . KnownNat a => a :~: b +bogus = case testEquality (SNat @a) (coerce (SNat @a) :: SNat b) of + Just r -> r + Nothing -> error "bug fixed" + +type G :: Nat -> Type -> Type -> Type +type family G n s t where + G 0 s _ = s + G _ _ t = t + +newtype N n s t = MkN { unN :: G n s t } + +oops :: forall b s t . N 0 s t -> N b s t +oops x = gcastWith (bogus @0 @b) x + +unsafeCoerce :: s -> t +unsafeCoerce x = unN (oops @1 (MkN x)) ===================================== libraries/base/tests/T23454.stderr ===================================== @@ -0,0 +1,21 @@ + +T23454.hs:12:38: 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: + bogus :: forall (a :: Nat) (b :: Nat). KnownNat a => a :~: b + at T23454.hs:11:1-43 + ‘b’ is a rigid type variable bound by + the type signature for: + bogus :: forall (a :: Nat) (b :: Nat). KnownNat a => a :~: b + at T23454.hs:11:1-43 + • In the second argument of ‘testEquality’, namely + ‘(coerce (SNat @a) :: SNat b)’ + In the expression: + testEquality (SNat @a) (coerce (SNat @a) :: SNat b) + In the expression: + case testEquality (SNat @a) (coerce (SNat @a) :: SNat b) of + Just r -> r + Nothing -> error "bug fixed" + • Relevant bindings include + bogus :: a :~: b (bound at T23454.hs:12:1) ===================================== libraries/base/tests/all.T ===================================== @@ -300,3 +300,4 @@ test('listThreads1', normal, compile_and_run, ['']) test('inits1tails1', normal, compile_and_run, ['']) test('CLC149', normal, compile, ['']) test('AtomicSwapIORef', normal, compile_and_run, ['']) +test('T23454', normal, compile_fail, ['']) ===================================== testsuite/tests/ghci/scripts/T9181.stdout ===================================== @@ -18,12 +18,12 @@ type GHC.TypeLits.NatToChar :: GHC.Num.Natural.Natural -> Char type family GHC.TypeLits.NatToChar a pattern GHC.TypeLits.SChar :: () => GHC.TypeLits.KnownChar c => GHC.TypeLits.SChar c -type role GHC.TypeLits.SChar phantom +type role GHC.TypeLits.SChar nominal type GHC.TypeLits.SChar :: Char -> * newtype GHC.TypeLits.SChar s = GHC.TypeLits.UnsafeSChar Char pattern GHC.TypeLits.SSymbol :: () => GHC.TypeLits.KnownSymbol s => GHC.TypeLits.SSymbol s -type role GHC.TypeLits.SSymbol phantom +type role GHC.TypeLits.SSymbol nominal type GHC.TypeLits.SSymbol :: GHC.Types.Symbol -> * newtype GHC.TypeLits.SSymbol s = GHC.TypeLits.UnsafeSSymbol String type GHC.TypeLits.SomeChar :: * @@ -166,7 +166,7 @@ data Data.Type.Ord.OrderingI a b where Data.Type.Ord.OrderingI a b pattern GHC.TypeNats.SNat :: () => GHC.TypeNats.KnownNat n => GHC.TypeNats.SNat n -type role GHC.TypeNats.SNat phantom +type role GHC.TypeNats.SNat nominal type GHC.TypeNats.SNat :: GHC.TypeNats.Nat -> * newtype GHC.TypeNats.SNat n = GHC.TypeNats.UnsafeSNat GHC.Num.Natural.Natural View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4639100b5dd19fe2cabb36f7e457826e44a579aa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4639100b5dd19fe2cabb36f7e457826e44a579aa You're receiving 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 Jun 9 22:51:36 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 09 Jun 2023 18:51:36 -0400 Subject: [Git][ghc/ghc][master] Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in Message-ID: <6483acf8a9c21_3b408b313fd0053719@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 1 changed file: - compiler/ghc.cabal.in Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -25,7 +25,6 @@ Build-Type: Custom extra-source-files: GHC/Builtin/primops.txt.pp - GHC/Builtin/bytearray-ops.txt.pp Unique.h CodeGen.Platform.h -- Shared with rts via hard-link at configure time. This is safer View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9c0dcff72ff763828cacb6ff7af99899acfe06b4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9c0dcff72ff763828cacb6ff7af99899acfe06b4 You're receiving 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 Jun 9 22:52:23 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 09 Jun 2023 18:52:23 -0400 Subject: [Git][ghc/ghc][master] Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. Message-ID: <6483ad2766980_3b408bc50a8576d2@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - 3 changed files: - testsuite/tests/overloadedrecflds/ghci/T13438.script - testsuite/tests/overloadedrecflds/ghci/T13438.stdout - testsuite/tests/overloadedrecflds/ghci/all.T Changes: ===================================== testsuite/tests/overloadedrecflds/ghci/T13438.script ===================================== @@ -1,5 +1,3 @@ :l T13438.hs :browse! T13438 :browse T13438 -:ctags -:!cat tags ===================================== testsuite/tests/overloadedrecflds/ghci/T13438.stdout ===================================== @@ -5,6 +5,3 @@ MkT :: Int -> T foo :: T -> Int type T :: * data T = MkT {foo :: Int} -foo T13438.hs 3;" v file: -MkT T13438.hs 3;" d -T T13438.hs 3;" t ===================================== testsuite/tests/overloadedrecflds/ghci/all.T ===================================== @@ -1,6 +1,6 @@ test('duplicaterecfldsghci01', combined_output, ghci_script, ['duplicaterecfldsghci01.script']) test('overloadedlabelsghci01', combined_output, ghci_script, ['overloadedlabelsghci01.script']) -test('T13438', [expect_broken(13438), combined_output], ghci_script, ['T13438.script']) +test('T13438', combined_output, ghci_script, ['T13438.script']) test('GHCiDRF', [extra_files(['GHCiDRF.hs']), combined_output], ghci_script, ['GHCiDRF.script']) test('T19322', combined_output, ghci_script, ['T19322.script']) test('T19314', combined_output, ghci_script, ['T19314.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/273ff0c786965de805976e52c8367a036f4f8d95 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/273ff0c786965de805976e52c8367a036f4f8d95 You're receiving 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 Jun 10 07:09:45 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Sat, 10 Jun 2023 03:09:45 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/#23434-wterm-variable-capture] Fix -Wterm-variable-capture scope (#23434) Message-ID: <648421b9dbe17_3b408bc6cf0838e2@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/#23434-wterm-variable-capture at Glasgow Haskell Compiler / GHC Commits: 69c4be6d by Andrei Borzenkov at 2023-06-10T11:09:18+04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 11 changed files: - compiler/GHC/Rename/HsType.hs - testsuite/tests/rename/should_compile/T22513a.stderr - testsuite/tests/rename/should_compile/T22513b.stderr - testsuite/tests/rename/should_compile/T22513c.stderr - testsuite/tests/rename/should_compile/T22513d.stderr - testsuite/tests/rename/should_compile/T22513e.stderr - testsuite/tests/rename/should_compile/T22513f.stderr - testsuite/tests/rename/should_compile/T22513g.stderr - testsuite/tests/rename/should_compile/T22513h.stderr - + testsuite/tests/rename/should_compile/T23434.hs - testsuite/tests/rename/should_compile/all.T Changes: ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -386,7 +386,6 @@ rnImplicitTvOccs :: Maybe assoc -> RnM (a, FreeVars) rnImplicitTvOccs mb_assoc implicit_vs_with_dups thing_inside = do { let implicit_vs = nubN implicit_vs_with_dups - ; mapM_ warn_term_var_capture implicit_vs ; traceRn "rnImplicitTvOccs" $ vcat [ ppr implicit_vs_with_dups, ppr implicit_vs ] @@ -395,7 +394,7 @@ rnImplicitTvOccs mb_assoc implicit_vs_with_dups thing_inside -- See Note [Source locations for implicitly bound type variables]. ; loc <- getSrcSpanM ; let loc' = noAnnSrcSpan loc - ; vars <- mapM (newTyVarNameRn mb_assoc . L loc' . unLoc) implicit_vs + ; vars <- mapM (newTyVarNameRnImplicit mb_assoc . L loc' . unLoc) implicit_vs ; bindLocalNamesFV vars $ thing_inside vars } @@ -1136,6 +1135,7 @@ bindHsOuterTyVarBndrs doc mb_cls implicit_vars outer_bndrs thing_inside = thing_inside $ HsOuterExplicit { hso_xexplicit = noExtField , hso_bndrs = exp_bndrs' } +-- See Note [Term variable capture and implicit quantification] warn_term_var_capture :: LocatedN RdrName -> RnM () warn_term_var_capture lVar = do gbl_env <- getGlobalRdrEnv @@ -1242,15 +1242,68 @@ rnHsBndrVis :: HsBndrVis GhcPs -> HsBndrVis GhcRn rnHsBndrVis HsBndrRequired = HsBndrRequired rnHsBndrVis (HsBndrInvisible at) = HsBndrInvisible at -newTyVarNameRn :: Maybe a -- associated class - -> LocatedN RdrName -> RnM Name -newTyVarNameRn mb_assoc lrdr@(L _ rdr) +newTyVarNameRn, newTyVarNameRnImplicit + :: Maybe a -- associated class + -> LocatedN RdrName -> RnM Name +newTyVarNameRn mb_assoc = new_tv_name_rn mb_assoc newLocalBndrRn +newTyVarNameRnImplicit mb_assoc = new_tv_name_rn mb_assoc $ \lrdr -> + do { warn_term_var_capture lrdr + ; newLocalBndrRn lrdr } + +new_tv_name_rn :: Maybe a -- associated class + -> (LocatedN RdrName -> RnM Name) -- how to create a new name + -> (LocatedN RdrName -> RnM Name) +new_tv_name_rn Nothing cont lrdr = cont lrdr +new_tv_name_rn (Just _) cont lrdr@(L _ rdr) = do { rdr_env <- getLocalRdrEnv - ; case (mb_assoc, lookupLocalRdrEnv rdr_env rdr) of - (Just _, Just n) -> return n - -- Use the same Name as the parent class decl + ; case lookupLocalRdrEnv rdr_env rdr of + Just n -> return n -- Use the same Name as the parent class decl + _ -> cont lrdr } + +{- Note [Term variable capture and implicit quantification] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-Wterm-variable-capture is a warning introduced in GHC Proposal #281 "Visible forall in types of terms", +Section 7.3: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0281-visible-forall.rst#73implicit-quantification + +Its purpose is to notify users when implicit quantification occurs that would +stop working under RequiredTypeArguments (a future GHC extension). Example: + + a = 42 + id :: a -> a + +As it stands, the `a` in the signature `id :: a -> a` is considered free and +leads to implicit quantification, as if the user wrote `id :: forall a. a -> a`. +Under RequiredTypeArguments it will capture the term-level variable `a` (bound by `a = 42`), +leading to a type error. + +`warn_term_var_capture` detects this by demoting the namespace of the +implicitly quantified type variable (`TvName` becomes `VarName`) and looking it up +in the environment. But when do we call `warn_term_var_capture`? It's tempting +to do so at the start of `rnImplicitTvOccs`, as soon as we know our implicit +variables: + + rnImplicitTvOccs mb_assoc implicit_vs_with_dups thing_inside + = do { let implicit_vs = nubN implicit_vs_with_dups + ; mapM_ warn_term_var_capture implicit_vs + ... } + +This approach generates false positives (#23434) because it misses a corner +case: class variables in associated types. Consider the following example: + + k = 12 + class C k a where + type AT a :: k -> Type + +If we look at the signature for `AT` in isolation, the `k` looks like a free +variable, so it's passed to `rnImplicitTvOccs`. And if we passed it to +`warn_term_var_capture`, we would find the `k` bound by `k = 12` and report a warning. +But we don't want that: `k` is actually bound in the declaration header of the +parent class. + +The solution is to check if it's a class variable (this is done in `new_tv_name_rn`) +before we check for term variable capture. +-} - _ -> newLocalBndrRn lrdr } {- ********************************************************* * * ===================================== testsuite/tests/rename/should_compile/T22513a.stderr ===================================== @@ -1,6 +1,7 @@ -T22513a.hs:5:6: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513a.hs:5:1: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘a’ is implicitly quantified, even though another variable of the same name is in scope: - ‘a’ defined at T22513a.hs:3:1 + ‘a’ defined at T22513a.hs:3:1 This is not forward-compatible with a planned GHC extension, RequiredTypeArguments. - Suggested fix: Consider renaming the type variable. \ No newline at end of file + Suggested fix: Consider renaming the type variable. ===================================== testsuite/tests/rename/should_compile/T22513b.stderr ===================================== @@ -1,4 +1,5 @@ -T22513b.hs:5:6: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513b.hs:5:1: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘id’ is implicitly quantified, even though another variable of the same name is in scope: ‘id’ imported from ‘Prelude’ at T22513b.hs:3:17-18 ===================================== testsuite/tests/rename/should_compile/T22513c.stderr ===================================== @@ -1,4 +1,5 @@ -T22513c.hs:6:10: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513c.hs:6:5: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘a’ is implicitly quantified, even though another variable of the same name is in scope: ‘a’ defined at T22513c.hs:4:3 ===================================== testsuite/tests/rename/should_compile/T22513d.stderr ===================================== @@ -1,7 +1,8 @@ -T22513d.hs:3:28: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513d.hs:3:4: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘id’ is implicitly quantified, even though another variable of the same name is in scope: ‘id’ imported from ‘Prelude’ at T22513d.hs:1:8-14 (and originally defined in ‘GHC.Base’) This is not forward-compatible with a planned GHC extension, RequiredTypeArguments. - Suggested fix: Consider renaming the type variable. \ No newline at end of file + Suggested fix: Consider renaming the type variable. ===================================== testsuite/tests/rename/should_compile/T22513e.stderr ===================================== @@ -1,7 +1,8 @@ -T22513e.hs:3:14: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513e.hs:3:1: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘id’ is implicitly quantified, even though another variable of the same name is in scope: ‘id’ imported from ‘Prelude’ at T22513e.hs:1:8-14 (and originally defined in ‘GHC.Base’) This is not forward-compatible with a planned GHC extension, RequiredTypeArguments. - Suggested fix: Consider renaming the type variable. \ No newline at end of file + Suggested fix: Consider renaming the type variable. ===================================== testsuite/tests/rename/should_compile/T22513f.stderr ===================================== @@ -1,7 +1,8 @@ -T22513f.hs:5:25: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513f.hs:5:1: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘id’ is implicitly quantified, even though another variable of the same name is in scope: ‘id’ imported from ‘Prelude’ at T22513f.hs:1:8-14 (and originally defined in ‘GHC.Base’) This is not forward-compatible with a planned GHC extension, RequiredTypeArguments. - Suggested fix: Consider renaming the type variable. \ No newline at end of file + Suggested fix: Consider renaming the type variable. ===================================== testsuite/tests/rename/should_compile/T22513g.stderr ===================================== @@ -1,7 +1,8 @@ -T22513g.hs:5:15: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513g.hs:5:1: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘head’ is implicitly quantified, even though another variable of the same name is in scope: ‘head’ imported from ‘Prelude’ at T22513g.hs:2:8-14 (and originally defined in ‘GHC.List’) This is not forward-compatible with a planned GHC extension, RequiredTypeArguments. - Suggested fix: Consider renaming the type variable. \ No newline at end of file + Suggested fix: Consider renaming the type variable. ===================================== testsuite/tests/rename/should_compile/T22513h.stderr ===================================== @@ -1,7 +1,8 @@ -T22513h.hs:6:19: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513h.hs:6:10: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘id’ is implicitly quantified, even though another variable of the same name is in scope: ‘id’ imported from ‘Prelude’ at T22513h.hs:1:8-14 (and originally defined in ‘GHC.Base’) This is not forward-compatible with a planned GHC extension, RequiredTypeArguments. - Suggested fix: Consider renaming the type variable. \ No newline at end of file + Suggested fix: Consider renaming the type variable. ===================================== testsuite/tests/rename/should_compile/T23434.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -Wterm-variable-capture #-} +module T23434 where + +import GHC.Types (Type) + +k = 12 + +class C k a where + type AT a :: k -> Type ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -211,3 +211,4 @@ test('GHCIImplicitImportNullaryRecordWildcard', combined_output, ghci_script, [' test('T22122', [expect_broken(22122), extra_files(['T22122_aux.hs'])], multimod_compile, ['T22122', '-v0']) test('T23240', [req_th, extra_files(['T23240_aux.hs'])], multimod_compile, ['T23240', '-v0']) test('T23318', normal, compile, ['-Wduplicate-exports']) +test('T23434', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/69c4be6d0cdc146cb1d6b48979aeb37df61ac305 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/69c4be6d0cdc146cb1d6b48979aeb37df61ac305 You're receiving 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 Jun 10 09:57:31 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 10 Jun 2023 05:57:31 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Add role annotations to SNat, SSymbol and SChar Message-ID: <6484490b798c_3b408b3cab3609845e@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - 460c9efb by Andrei Borzenkov at 2023-06-10T05:57:20-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 229b60d3 by Jorge Mendes at 2023-06-10T05:57:23-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - 23 changed files: - compiler/GHC/Rename/HsType.hs - compiler/ghc.cabal.in - libraries/base/GHC/TypeLits.hs - libraries/base/GHC/TypeNats.hs - libraries/base/changelog.md - + libraries/base/tests/T23454.hs - + libraries/base/tests/T23454.stderr - libraries/base/tests/all.T - rts/js/mem.js - testsuite/tests/ghci/scripts/T9181.stdout - testsuite/tests/overloadedrecflds/ghci/T13438.script - testsuite/tests/overloadedrecflds/ghci/T13438.stdout - testsuite/tests/overloadedrecflds/ghci/all.T - testsuite/tests/rename/should_compile/T22513a.stderr - testsuite/tests/rename/should_compile/T22513b.stderr - testsuite/tests/rename/should_compile/T22513c.stderr - testsuite/tests/rename/should_compile/T22513d.stderr - testsuite/tests/rename/should_compile/T22513e.stderr - testsuite/tests/rename/should_compile/T22513f.stderr - testsuite/tests/rename/should_compile/T22513g.stderr - testsuite/tests/rename/should_compile/T22513h.stderr - + testsuite/tests/rename/should_compile/T23434.hs - testsuite/tests/rename/should_compile/all.T Changes: ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -386,7 +386,6 @@ rnImplicitTvOccs :: Maybe assoc -> RnM (a, FreeVars) rnImplicitTvOccs mb_assoc implicit_vs_with_dups thing_inside = do { let implicit_vs = nubN implicit_vs_with_dups - ; mapM_ warn_term_var_capture implicit_vs ; traceRn "rnImplicitTvOccs" $ vcat [ ppr implicit_vs_with_dups, ppr implicit_vs ] @@ -395,7 +394,7 @@ rnImplicitTvOccs mb_assoc implicit_vs_with_dups thing_inside -- See Note [Source locations for implicitly bound type variables]. ; loc <- getSrcSpanM ; let loc' = noAnnSrcSpan loc - ; vars <- mapM (newTyVarNameRn mb_assoc . L loc' . unLoc) implicit_vs + ; vars <- mapM (newTyVarNameRnImplicit mb_assoc . L loc' . unLoc) implicit_vs ; bindLocalNamesFV vars $ thing_inside vars } @@ -1136,6 +1135,7 @@ bindHsOuterTyVarBndrs doc mb_cls implicit_vars outer_bndrs thing_inside = thing_inside $ HsOuterExplicit { hso_xexplicit = noExtField , hso_bndrs = exp_bndrs' } +-- See Note [Term variable capture and implicit quantification] warn_term_var_capture :: LocatedN RdrName -> RnM () warn_term_var_capture lVar = do gbl_env <- getGlobalRdrEnv @@ -1242,15 +1242,68 @@ rnHsBndrVis :: HsBndrVis GhcPs -> HsBndrVis GhcRn rnHsBndrVis HsBndrRequired = HsBndrRequired rnHsBndrVis (HsBndrInvisible at) = HsBndrInvisible at -newTyVarNameRn :: Maybe a -- associated class - -> LocatedN RdrName -> RnM Name -newTyVarNameRn mb_assoc lrdr@(L _ rdr) +newTyVarNameRn, newTyVarNameRnImplicit + :: Maybe a -- associated class + -> LocatedN RdrName -> RnM Name +newTyVarNameRn mb_assoc = new_tv_name_rn mb_assoc newLocalBndrRn +newTyVarNameRnImplicit mb_assoc = new_tv_name_rn mb_assoc $ \lrdr -> + do { warn_term_var_capture lrdr + ; newLocalBndrRn lrdr } + +new_tv_name_rn :: Maybe a -- associated class + -> (LocatedN RdrName -> RnM Name) -- how to create a new name + -> (LocatedN RdrName -> RnM Name) +new_tv_name_rn Nothing cont lrdr = cont lrdr +new_tv_name_rn (Just _) cont lrdr@(L _ rdr) = do { rdr_env <- getLocalRdrEnv - ; case (mb_assoc, lookupLocalRdrEnv rdr_env rdr) of - (Just _, Just n) -> return n - -- Use the same Name as the parent class decl + ; case lookupLocalRdrEnv rdr_env rdr of + Just n -> return n -- Use the same Name as the parent class decl + _ -> cont lrdr } + +{- Note [Term variable capture and implicit quantification] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-Wterm-variable-capture is a warning introduced in GHC Proposal #281 "Visible forall in types of terms", +Section 7.3: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0281-visible-forall.rst#73implicit-quantification + +Its purpose is to notify users when implicit quantification occurs that would +stop working under RequiredTypeArguments (a future GHC extension). Example: + + a = 42 + id :: a -> a + +As it stands, the `a` in the signature `id :: a -> a` is considered free and +leads to implicit quantification, as if the user wrote `id :: forall a. a -> a`. +Under RequiredTypeArguments it will capture the term-level variable `a` (bound by `a = 42`), +leading to a type error. + +`warn_term_var_capture` detects this by demoting the namespace of the +implicitly quantified type variable (`TvName` becomes `VarName`) and looking it up +in the environment. But when do we call `warn_term_var_capture`? It's tempting +to do so at the start of `rnImplicitTvOccs`, as soon as we know our implicit +variables: + + rnImplicitTvOccs mb_assoc implicit_vs_with_dups thing_inside + = do { let implicit_vs = nubN implicit_vs_with_dups + ; mapM_ warn_term_var_capture implicit_vs + ... } + +This approach generates false positives (#23434) because it misses a corner +case: class variables in associated types. Consider the following example: + + k = 12 + class C k a where + type AT a :: k -> Type + +If we look at the signature for `AT` in isolation, the `k` looks like a free +variable, so it's passed to `rnImplicitTvOccs`. And if we passed it to +`warn_term_var_capture`, we would find the `k` bound by `k = 12` and report a warning. +But we don't want that: `k` is actually bound in the declaration header of the +parent class. + +The solution is to check if it's a class variable (this is done in `new_tv_name_rn`) +before we check for term variable capture. +-} - _ -> newLocalBndrRn lrdr } {- ********************************************************* * * ===================================== compiler/ghc.cabal.in ===================================== @@ -25,7 +25,6 @@ Build-Type: Custom extra-source-files: GHC/Builtin/primops.txt.pp - GHC/Builtin/bytearray-ops.txt.pp Unique.h CodeGen.Platform.h -- Shared with rts via hard-link at configure time. This is safer ===================================== libraries/base/GHC/TypeLits.hs ===================================== @@ -15,6 +15,7 @@ {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE RoleAnnotations #-} {-| GHC's @DataKinds@ language extension lifts data constructors, natural @@ -340,6 +341,7 @@ withSomeSNat n k -- -- @since 4.18.0.0 newtype SSymbol (s :: Symbol) = UnsafeSSymbol String +type role SSymbol nominal -- | A explicitly bidirectional pattern synonym relating an 'SSymbol' to a -- 'KnownSymbol' constraint. @@ -442,6 +444,7 @@ withSomeSSymbol s k = k (UnsafeSSymbol s) -- -- @since 4.18.0.0 newtype SChar (s :: Char) = UnsafeSChar Char +type role SChar nominal -- | A explicitly bidirectional pattern synonym relating an 'SChar' to a -- 'KnownChar' constraint. ===================================== libraries/base/GHC/TypeNats.hs ===================================== @@ -16,6 +16,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE RoleAnnotations #-} {-| This module is an internal GHC module. It declares the constants used in the implementation of type-level natural numbers. The programmer interface @@ -344,6 +345,7 @@ cmpNat x y = case compare (natVal x) (natVal y) of -- -- @since 4.18.0.0 newtype SNat (n :: Nat) = UnsafeSNat Natural +type role SNat nominal -- | A explicitly bidirectional pattern synonym relating an 'SNat' to a -- 'KnownNat' constraint. ===================================== libraries/base/changelog.md ===================================== @@ -32,6 +32,7 @@ * Make `(&)` representation polymorphic in the return type ([CLC proposal #158](https://github.com/haskell/core-libraries-committee/issues/158)) * Implement `GHC.IORef.atomicSwapIORef` via a new dedicated primop `atomicSwapMutVar#` ([CLC proposal #139](https://github.com/haskell/core-libraries-committee/issues/139)) * Change codebuffers to use an unboxed implementation, while providing a compatibility layer using pattern synonyms. ([CLC proposal #134](https://github.com/haskell/core-libraries-committee/issues/134)) + * Add nominal role annotations to SNat/SSymbol/SChar ([CLC proposal #170](https://github.com/haskell/core-libraries-committee/issues/170)) ## 4.18.0.0 *March 2023* * Shipped with GHC 9.6.1 ===================================== libraries/base/tests/T23454.hs ===================================== @@ -0,0 +1,27 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} + +module T23454 where + +import Data.Coerce (coerce) +import Data.Kind (Type) +import Data.Type.Equality +import GHC.TypeNats + +bogus :: forall a b . KnownNat a => a :~: b +bogus = case testEquality (SNat @a) (coerce (SNat @a) :: SNat b) of + Just r -> r + Nothing -> error "bug fixed" + +type G :: Nat -> Type -> Type -> Type +type family G n s t where + G 0 s _ = s + G _ _ t = t + +newtype N n s t = MkN { unN :: G n s t } + +oops :: forall b s t . N 0 s t -> N b s t +oops x = gcastWith (bogus @0 @b) x + +unsafeCoerce :: s -> t +unsafeCoerce x = unN (oops @1 (MkN x)) ===================================== libraries/base/tests/T23454.stderr ===================================== @@ -0,0 +1,21 @@ + +T23454.hs:12:38: 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: + bogus :: forall (a :: Nat) (b :: Nat). KnownNat a => a :~: b + at T23454.hs:11:1-43 + ‘b’ is a rigid type variable bound by + the type signature for: + bogus :: forall (a :: Nat) (b :: Nat). KnownNat a => a :~: b + at T23454.hs:11:1-43 + • In the second argument of ‘testEquality’, namely + ‘(coerce (SNat @a) :: SNat b)’ + In the expression: + testEquality (SNat @a) (coerce (SNat @a) :: SNat b) + In the expression: + case testEquality (SNat @a) (coerce (SNat @a) :: SNat b) of + Just r -> r + Nothing -> error "bug fixed" + • Relevant bindings include + bogus :: a :~: b (bound at T23454.hs:12:1) ===================================== libraries/base/tests/all.T ===================================== @@ -300,3 +300,4 @@ test('listThreads1', normal, compile_and_run, ['']) test('inits1tails1', normal, compile_and_run, ['']) test('CLC149', normal, compile, ['']) test('AtomicSwapIORef', normal, compile_and_run, ['']) +test('T23454', normal, compile_fail, ['']) ===================================== rts/js/mem.js ===================================== @@ -747,9 +747,6 @@ function h$setField(o,n,v) { case 45: o.d2.d45 = v; return; - case 45: - o.d2.d45 = v; - return; case 46: o.d2.d46 = v; return; ===================================== testsuite/tests/ghci/scripts/T9181.stdout ===================================== @@ -18,12 +18,12 @@ type GHC.TypeLits.NatToChar :: GHC.Num.Natural.Natural -> Char type family GHC.TypeLits.NatToChar a pattern GHC.TypeLits.SChar :: () => GHC.TypeLits.KnownChar c => GHC.TypeLits.SChar c -type role GHC.TypeLits.SChar phantom +type role GHC.TypeLits.SChar nominal type GHC.TypeLits.SChar :: Char -> * newtype GHC.TypeLits.SChar s = GHC.TypeLits.UnsafeSChar Char pattern GHC.TypeLits.SSymbol :: () => GHC.TypeLits.KnownSymbol s => GHC.TypeLits.SSymbol s -type role GHC.TypeLits.SSymbol phantom +type role GHC.TypeLits.SSymbol nominal type GHC.TypeLits.SSymbol :: GHC.Types.Symbol -> * newtype GHC.TypeLits.SSymbol s = GHC.TypeLits.UnsafeSSymbol String type GHC.TypeLits.SomeChar :: * @@ -166,7 +166,7 @@ data Data.Type.Ord.OrderingI a b where Data.Type.Ord.OrderingI a b pattern GHC.TypeNats.SNat :: () => GHC.TypeNats.KnownNat n => GHC.TypeNats.SNat n -type role GHC.TypeNats.SNat phantom +type role GHC.TypeNats.SNat nominal type GHC.TypeNats.SNat :: GHC.TypeNats.Nat -> * newtype GHC.TypeNats.SNat n = GHC.TypeNats.UnsafeSNat GHC.Num.Natural.Natural ===================================== testsuite/tests/overloadedrecflds/ghci/T13438.script ===================================== @@ -1,5 +1,3 @@ :l T13438.hs :browse! T13438 :browse T13438 -:ctags -:!cat tags ===================================== testsuite/tests/overloadedrecflds/ghci/T13438.stdout ===================================== @@ -5,6 +5,3 @@ MkT :: Int -> T foo :: T -> Int type T :: * data T = MkT {foo :: Int} -foo T13438.hs 3;" v file: -MkT T13438.hs 3;" d -T T13438.hs 3;" t ===================================== testsuite/tests/overloadedrecflds/ghci/all.T ===================================== @@ -1,6 +1,6 @@ test('duplicaterecfldsghci01', combined_output, ghci_script, ['duplicaterecfldsghci01.script']) test('overloadedlabelsghci01', combined_output, ghci_script, ['overloadedlabelsghci01.script']) -test('T13438', [expect_broken(13438), combined_output], ghci_script, ['T13438.script']) +test('T13438', combined_output, ghci_script, ['T13438.script']) test('GHCiDRF', [extra_files(['GHCiDRF.hs']), combined_output], ghci_script, ['GHCiDRF.script']) test('T19322', combined_output, ghci_script, ['T19322.script']) test('T19314', combined_output, ghci_script, ['T19314.script']) ===================================== testsuite/tests/rename/should_compile/T22513a.stderr ===================================== @@ -1,6 +1,7 @@ -T22513a.hs:5:6: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513a.hs:5:1: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘a’ is implicitly quantified, even though another variable of the same name is in scope: - ‘a’ defined at T22513a.hs:3:1 + ‘a’ defined at T22513a.hs:3:1 This is not forward-compatible with a planned GHC extension, RequiredTypeArguments. - Suggested fix: Consider renaming the type variable. \ No newline at end of file + Suggested fix: Consider renaming the type variable. ===================================== testsuite/tests/rename/should_compile/T22513b.stderr ===================================== @@ -1,4 +1,5 @@ -T22513b.hs:5:6: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513b.hs:5:1: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘id’ is implicitly quantified, even though another variable of the same name is in scope: ‘id’ imported from ‘Prelude’ at T22513b.hs:3:17-18 ===================================== testsuite/tests/rename/should_compile/T22513c.stderr ===================================== @@ -1,4 +1,5 @@ -T22513c.hs:6:10: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513c.hs:6:5: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘a’ is implicitly quantified, even though another variable of the same name is in scope: ‘a’ defined at T22513c.hs:4:3 ===================================== testsuite/tests/rename/should_compile/T22513d.stderr ===================================== @@ -1,7 +1,8 @@ -T22513d.hs:3:28: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513d.hs:3:4: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘id’ is implicitly quantified, even though another variable of the same name is in scope: ‘id’ imported from ‘Prelude’ at T22513d.hs:1:8-14 (and originally defined in ‘GHC.Base’) This is not forward-compatible with a planned GHC extension, RequiredTypeArguments. - Suggested fix: Consider renaming the type variable. \ No newline at end of file + Suggested fix: Consider renaming the type variable. ===================================== testsuite/tests/rename/should_compile/T22513e.stderr ===================================== @@ -1,7 +1,8 @@ -T22513e.hs:3:14: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513e.hs:3:1: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘id’ is implicitly quantified, even though another variable of the same name is in scope: ‘id’ imported from ‘Prelude’ at T22513e.hs:1:8-14 (and originally defined in ‘GHC.Base’) This is not forward-compatible with a planned GHC extension, RequiredTypeArguments. - Suggested fix: Consider renaming the type variable. \ No newline at end of file + Suggested fix: Consider renaming the type variable. ===================================== testsuite/tests/rename/should_compile/T22513f.stderr ===================================== @@ -1,7 +1,8 @@ -T22513f.hs:5:25: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513f.hs:5:1: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘id’ is implicitly quantified, even though another variable of the same name is in scope: ‘id’ imported from ‘Prelude’ at T22513f.hs:1:8-14 (and originally defined in ‘GHC.Base’) This is not forward-compatible with a planned GHC extension, RequiredTypeArguments. - Suggested fix: Consider renaming the type variable. \ No newline at end of file + Suggested fix: Consider renaming the type variable. ===================================== testsuite/tests/rename/should_compile/T22513g.stderr ===================================== @@ -1,7 +1,8 @@ -T22513g.hs:5:15: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513g.hs:5:1: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘head’ is implicitly quantified, even though another variable of the same name is in scope: ‘head’ imported from ‘Prelude’ at T22513g.hs:2:8-14 (and originally defined in ‘GHC.List’) This is not forward-compatible with a planned GHC extension, RequiredTypeArguments. - Suggested fix: Consider renaming the type variable. \ No newline at end of file + Suggested fix: Consider renaming the type variable. ===================================== testsuite/tests/rename/should_compile/T22513h.stderr ===================================== @@ -1,7 +1,8 @@ -T22513h.hs:6:19: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513h.hs:6:10: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘id’ is implicitly quantified, even though another variable of the same name is in scope: ‘id’ imported from ‘Prelude’ at T22513h.hs:1:8-14 (and originally defined in ‘GHC.Base’) This is not forward-compatible with a planned GHC extension, RequiredTypeArguments. - Suggested fix: Consider renaming the type variable. \ No newline at end of file + Suggested fix: Consider renaming the type variable. ===================================== testsuite/tests/rename/should_compile/T23434.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -Wterm-variable-capture #-} +module T23434 where + +import GHC.Types (Type) + +k = 12 + +class C k a where + type AT a :: k -> Type ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -211,3 +211,4 @@ test('GHCIImplicitImportNullaryRecordWildcard', combined_output, ghci_script, [' test('T22122', [expect_broken(22122), extra_files(['T22122_aux.hs'])], multimod_compile, ['T22122', '-v0']) test('T23240', [req_th, extra_files(['T23240_aux.hs'])], multimod_compile, ['T23240', '-v0']) test('T23318', normal, compile, ['-Wduplicate-exports']) +test('T23434', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7204d3f8c305e4569df9e3421fa2bff1ec8805b1...229b60d30c7a6dbafb9afc970d511c8c02191d78 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7204d3f8c305e4569df9e3421fa2bff1ec8805b1...229b60d30c7a6dbafb9afc970d511c8c02191d78 You're receiving 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 Jun 10 12:27:48 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 10 Jun 2023 08:27:48 -0400 Subject: [Git][ghc/ghc][master] Fix -Wterm-variable-capture scope (#23434) Message-ID: <64846c44522f7_3b408b404d34c146979@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 11 changed files: - compiler/GHC/Rename/HsType.hs - testsuite/tests/rename/should_compile/T22513a.stderr - testsuite/tests/rename/should_compile/T22513b.stderr - testsuite/tests/rename/should_compile/T22513c.stderr - testsuite/tests/rename/should_compile/T22513d.stderr - testsuite/tests/rename/should_compile/T22513e.stderr - testsuite/tests/rename/should_compile/T22513f.stderr - testsuite/tests/rename/should_compile/T22513g.stderr - testsuite/tests/rename/should_compile/T22513h.stderr - + testsuite/tests/rename/should_compile/T23434.hs - testsuite/tests/rename/should_compile/all.T Changes: ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -386,7 +386,6 @@ rnImplicitTvOccs :: Maybe assoc -> RnM (a, FreeVars) rnImplicitTvOccs mb_assoc implicit_vs_with_dups thing_inside = do { let implicit_vs = nubN implicit_vs_with_dups - ; mapM_ warn_term_var_capture implicit_vs ; traceRn "rnImplicitTvOccs" $ vcat [ ppr implicit_vs_with_dups, ppr implicit_vs ] @@ -395,7 +394,7 @@ rnImplicitTvOccs mb_assoc implicit_vs_with_dups thing_inside -- See Note [Source locations for implicitly bound type variables]. ; loc <- getSrcSpanM ; let loc' = noAnnSrcSpan loc - ; vars <- mapM (newTyVarNameRn mb_assoc . L loc' . unLoc) implicit_vs + ; vars <- mapM (newTyVarNameRnImplicit mb_assoc . L loc' . unLoc) implicit_vs ; bindLocalNamesFV vars $ thing_inside vars } @@ -1136,6 +1135,7 @@ bindHsOuterTyVarBndrs doc mb_cls implicit_vars outer_bndrs thing_inside = thing_inside $ HsOuterExplicit { hso_xexplicit = noExtField , hso_bndrs = exp_bndrs' } +-- See Note [Term variable capture and implicit quantification] warn_term_var_capture :: LocatedN RdrName -> RnM () warn_term_var_capture lVar = do gbl_env <- getGlobalRdrEnv @@ -1242,15 +1242,68 @@ rnHsBndrVis :: HsBndrVis GhcPs -> HsBndrVis GhcRn rnHsBndrVis HsBndrRequired = HsBndrRequired rnHsBndrVis (HsBndrInvisible at) = HsBndrInvisible at -newTyVarNameRn :: Maybe a -- associated class - -> LocatedN RdrName -> RnM Name -newTyVarNameRn mb_assoc lrdr@(L _ rdr) +newTyVarNameRn, newTyVarNameRnImplicit + :: Maybe a -- associated class + -> LocatedN RdrName -> RnM Name +newTyVarNameRn mb_assoc = new_tv_name_rn mb_assoc newLocalBndrRn +newTyVarNameRnImplicit mb_assoc = new_tv_name_rn mb_assoc $ \lrdr -> + do { warn_term_var_capture lrdr + ; newLocalBndrRn lrdr } + +new_tv_name_rn :: Maybe a -- associated class + -> (LocatedN RdrName -> RnM Name) -- how to create a new name + -> (LocatedN RdrName -> RnM Name) +new_tv_name_rn Nothing cont lrdr = cont lrdr +new_tv_name_rn (Just _) cont lrdr@(L _ rdr) = do { rdr_env <- getLocalRdrEnv - ; case (mb_assoc, lookupLocalRdrEnv rdr_env rdr) of - (Just _, Just n) -> return n - -- Use the same Name as the parent class decl + ; case lookupLocalRdrEnv rdr_env rdr of + Just n -> return n -- Use the same Name as the parent class decl + _ -> cont lrdr } + +{- Note [Term variable capture and implicit quantification] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-Wterm-variable-capture is a warning introduced in GHC Proposal #281 "Visible forall in types of terms", +Section 7.3: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0281-visible-forall.rst#73implicit-quantification + +Its purpose is to notify users when implicit quantification occurs that would +stop working under RequiredTypeArguments (a future GHC extension). Example: + + a = 42 + id :: a -> a + +As it stands, the `a` in the signature `id :: a -> a` is considered free and +leads to implicit quantification, as if the user wrote `id :: forall a. a -> a`. +Under RequiredTypeArguments it will capture the term-level variable `a` (bound by `a = 42`), +leading to a type error. + +`warn_term_var_capture` detects this by demoting the namespace of the +implicitly quantified type variable (`TvName` becomes `VarName`) and looking it up +in the environment. But when do we call `warn_term_var_capture`? It's tempting +to do so at the start of `rnImplicitTvOccs`, as soon as we know our implicit +variables: + + rnImplicitTvOccs mb_assoc implicit_vs_with_dups thing_inside + = do { let implicit_vs = nubN implicit_vs_with_dups + ; mapM_ warn_term_var_capture implicit_vs + ... } + +This approach generates false positives (#23434) because it misses a corner +case: class variables in associated types. Consider the following example: + + k = 12 + class C k a where + type AT a :: k -> Type + +If we look at the signature for `AT` in isolation, the `k` looks like a free +variable, so it's passed to `rnImplicitTvOccs`. And if we passed it to +`warn_term_var_capture`, we would find the `k` bound by `k = 12` and report a warning. +But we don't want that: `k` is actually bound in the declaration header of the +parent class. + +The solution is to check if it's a class variable (this is done in `new_tv_name_rn`) +before we check for term variable capture. +-} - _ -> newLocalBndrRn lrdr } {- ********************************************************* * * ===================================== testsuite/tests/rename/should_compile/T22513a.stderr ===================================== @@ -1,6 +1,7 @@ -T22513a.hs:5:6: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513a.hs:5:1: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘a’ is implicitly quantified, even though another variable of the same name is in scope: - ‘a’ defined at T22513a.hs:3:1 + ‘a’ defined at T22513a.hs:3:1 This is not forward-compatible with a planned GHC extension, RequiredTypeArguments. - Suggested fix: Consider renaming the type variable. \ No newline at end of file + Suggested fix: Consider renaming the type variable. ===================================== testsuite/tests/rename/should_compile/T22513b.stderr ===================================== @@ -1,4 +1,5 @@ -T22513b.hs:5:6: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513b.hs:5:1: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘id’ is implicitly quantified, even though another variable of the same name is in scope: ‘id’ imported from ‘Prelude’ at T22513b.hs:3:17-18 ===================================== testsuite/tests/rename/should_compile/T22513c.stderr ===================================== @@ -1,4 +1,5 @@ -T22513c.hs:6:10: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513c.hs:6:5: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘a’ is implicitly quantified, even though another variable of the same name is in scope: ‘a’ defined at T22513c.hs:4:3 ===================================== testsuite/tests/rename/should_compile/T22513d.stderr ===================================== @@ -1,7 +1,8 @@ -T22513d.hs:3:28: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513d.hs:3:4: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘id’ is implicitly quantified, even though another variable of the same name is in scope: ‘id’ imported from ‘Prelude’ at T22513d.hs:1:8-14 (and originally defined in ‘GHC.Base’) This is not forward-compatible with a planned GHC extension, RequiredTypeArguments. - Suggested fix: Consider renaming the type variable. \ No newline at end of file + Suggested fix: Consider renaming the type variable. ===================================== testsuite/tests/rename/should_compile/T22513e.stderr ===================================== @@ -1,7 +1,8 @@ -T22513e.hs:3:14: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513e.hs:3:1: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘id’ is implicitly quantified, even though another variable of the same name is in scope: ‘id’ imported from ‘Prelude’ at T22513e.hs:1:8-14 (and originally defined in ‘GHC.Base’) This is not forward-compatible with a planned GHC extension, RequiredTypeArguments. - Suggested fix: Consider renaming the type variable. \ No newline at end of file + Suggested fix: Consider renaming the type variable. ===================================== testsuite/tests/rename/should_compile/T22513f.stderr ===================================== @@ -1,7 +1,8 @@ -T22513f.hs:5:25: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513f.hs:5:1: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘id’ is implicitly quantified, even though another variable of the same name is in scope: ‘id’ imported from ‘Prelude’ at T22513f.hs:1:8-14 (and originally defined in ‘GHC.Base’) This is not forward-compatible with a planned GHC extension, RequiredTypeArguments. - Suggested fix: Consider renaming the type variable. \ No newline at end of file + Suggested fix: Consider renaming the type variable. ===================================== testsuite/tests/rename/should_compile/T22513g.stderr ===================================== @@ -1,7 +1,8 @@ -T22513g.hs:5:15: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513g.hs:5:1: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘head’ is implicitly quantified, even though another variable of the same name is in scope: ‘head’ imported from ‘Prelude’ at T22513g.hs:2:8-14 (and originally defined in ‘GHC.List’) This is not forward-compatible with a planned GHC extension, RequiredTypeArguments. - Suggested fix: Consider renaming the type variable. \ No newline at end of file + Suggested fix: Consider renaming the type variable. ===================================== testsuite/tests/rename/should_compile/T22513h.stderr ===================================== @@ -1,7 +1,8 @@ -T22513h.hs:6:19: warning: [GHC-54201] [-Wterm-variable-capture] + +T22513h.hs:6:10: warning: [GHC-54201] [-Wterm-variable-capture] The type variable ‘id’ is implicitly quantified, even though another variable of the same name is in scope: ‘id’ imported from ‘Prelude’ at T22513h.hs:1:8-14 (and originally defined in ‘GHC.Base’) This is not forward-compatible with a planned GHC extension, RequiredTypeArguments. - Suggested fix: Consider renaming the type variable. \ No newline at end of file + Suggested fix: Consider renaming the type variable. ===================================== testsuite/tests/rename/should_compile/T23434.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -Wterm-variable-capture #-} +module T23434 where + +import GHC.Types (Type) + +k = 12 + +class C k a where + type AT a :: k -> Type ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -211,3 +211,4 @@ test('GHCIImplicitImportNullaryRecordWildcard', combined_output, ghci_script, [' test('T22122', [expect_broken(22122), extra_files(['T22122_aux.hs'])], multimod_compile, ['T22122', '-v0']) test('T23240', [req_th, extra_files(['T23240_aux.hs'])], multimod_compile, ['T23240', '-v0']) test('T23318', normal, compile, ['-Wduplicate-exports']) +test('T23434', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b84a29005ac0b258e0bad04b0acf933b71bd6e98 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b84a29005ac0b258e0bad04b0acf933b71bd6e98 You're receiving 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 Jun 10 12:28:27 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sat, 10 Jun 2023 08:28:27 -0400 Subject: [Git][ghc/ghc][master] Remove redundant case statement in rts/js/mem.js. Message-ID: <64846c6b8ada9_3b408bcfd195015048c@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - 1 changed file: - rts/js/mem.js Changes: ===================================== rts/js/mem.js ===================================== @@ -747,9 +747,6 @@ function h$setField(o,n,v) { case 45: o.d2.d45 = v; return; - case 45: - o.d2.d45 = v; - return; case 46: o.d2.d46 = v; return; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9d1a8d87c2364321f27f4fc224a7042d5e47612d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9d1a8d87c2364321f27f4fc224a7042d5e47612d You're receiving 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 Jun 10 13:31:29 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sat, 10 Jun 2023 09:31:29 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/check-gc Message-ID: <64847b31818ec_3b408b139abee81810b9@gitlab.mail> Ben Gamari pushed new branch wip/check-gc at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/check-gc You're receiving 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 Jun 10 13:31:52 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sat, 10 Jun 2023 09:31:52 -0400 Subject: [Git][ghc/ghc][wip/tsan/fixes] 305 commits: testsuite/T20137: Avoid impl.-defined behavior Message-ID: <64847b48a8fab_3b408b13f9009818145a@gitlab.mail> Ben Gamari pushed to branch wip/tsan/fixes at Glasgow Haskell Compiler / GHC Commits: 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04: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. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04: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> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+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. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - adcea72c by Ben Gamari at 2023-06-10T09:31:39-04:00 compiler: Style fixes - - - - - d59ea988 by Ben Gamari at 2023-06-10T09:31:39-04:00 rts: Fix data race in threadPaused This only affects an assertion in the debug RTS, but it's a data race nevertheless. - - - - - ed6ff210 by Ben Gamari at 2023-06-10T09:31:39-04:00 rts: Silence spurious data races in ticky counters Previously we would use non-atomic accesses when bumping ticky counters, which would result in spurious data race reports from ThreadSanitizer when the threaded RTS was in use. - - - - - 45a3d222 by Ben Gamari at 2023-06-10T09:31:39-04:00 Improve TSAN documentation - - - - - 61e57ed5 by Ben Gamari at 2023-06-10T09:31:40-04:00 compiler/cmm: Ensure that dump output has proc name Previously dump output from the early Cmm passes would not be labelled with a proc label. - - - - - 3205c5d9 by Ben Gamari at 2023-06-10T09:31:40-04:00 cmm: Introduce MO_RelaxedRead In hand-written Cmm it can sometimes be necessary to atomically load from memory deep within an expression (e.g. see the `CHECK_GC` macro). This MachOp provides a convenient way to do so without breaking the expression into multiple statements. - - - - - 06756a24 by Ben Gamari at 2023-06-10T09:31:40-04:00 rts: Fix various data races - - - - - 51315b16 by Ben Gamari at 2023-06-10T09:31:40-04:00 base: use atomic write when updating timer manager - - - - - 2c7f9f61 by Ben Gamari at 2023-06-10T09:31:40-04:00 Use relaxed atomics to manipulate TSO status fields - - - - - e4bef492 by Ben Gamari at 2023-06-10T09:31:40-04:00 rts: Drop unnecessary atomic - - - - - 03e344ef by Ben Gamari at 2023-06-10T09:31:40-04:00 codeGen: Ensure that TSAN is aware of writeArray# write barriers - - - - - ca503000 by Ben Gamari at 2023-06-10T09:31:40-04:00 rts: Fix synchronization on thread blocking state - - - - - 7e639555 by Ben Gamari at 2023-06-10T09:31:40-04:00 rts: Relaxed load MutVar info table - - - - - 34b24299 by Ben Gamari at 2023-06-10T09:31:40-04:00 More principled treatment of acquire fences - - - - - 0773ab72 by Ben Gamari at 2023-06-10T09:31:40-04:00 IND - - - - - 611a8726 by Ben Gamari at 2023-06-10T09:31:40-04:00 Wordsmith Note - - - - - 7d9d2610 by Ben Gamari at 2023-06-10T09:31:40-04:00 Use relaxed accesses in ticky bumping - - - - - 343dd30c by Ben Gamari at 2023-06-10T09:31:40-04:00 Fix thunk update ordering Previously we attempted to ensure soundness of concurrent thunk update by synchronizing on the access of the thunk's info table pointer field. This was believed to be sufficient since the indirectee (which may expose a closure allocated by another core) would not be examined until the info table pointer update is complete. However, it turns out that this can result in data races in the presence of multiple threads racing a update a single thunk. For instance, consider this interleaving under the old scheme: Thread A Thread B --------- --------- t=0 Enter t 1 Push update frame 2 Begin evaluation 4 Pause thread 5 t.indirectee=tso 6 Release t.info=BLACKHOLE 7 ... (e.g. GC) 8 Resume thread 9 Finish evaluation 10 Relaxed t.indirectee=x 11 Load t.info 12 Acquire fence 13 Inspect t.indirectee 14 Release t.info=BLACKHOLE Here Thread A enters thunk `t` but is soon paused, resulting in `t` being lazily blackholed at t=6. Then, at t=10 Thread A finishes evaluation and updates `t.indirectee` with a relaxed store. Meanwhile, Thread B enters the blackhole. Under the old scheme this would introduce an acquire-fence but this would only synchronize with Thread A at t=6. Consequently, the result of the evaluation, `x`, is not visible to Thread B, introducing a data race. We fix this by treating the `indirectee` field as we do all other mutable fields. This means we must always access this field with acquire-loads and release-stores. See #23185. - - - - - 83503986 by Ben Gamari at 2023-06-10T09:31:40-04:00 Things - - - - - 885660be by Ben Gamari at 2023-06-10T09:31:40-04:00 rts/IPE: Fix unused mutex warning - - - - - 169f6b43 by Ben Gamari at 2023-06-10T09:31:40-04:00 rts: Relax info pointer stores - - - - - d92f7ec5 by Ben Gamari at 2023-06-10T09:31:40-04:00 TSAN: Rework handling of spilling - - - - - 2b247dc2 by Ben Gamari at 2023-06-10T09:31:40-04:00 hadrian: More debug information - - - - - ba5175a0 by Ben Gamari at 2023-06-10T09:31:40-04:00 hadrian: More selective TSAN instrumentation - - - - - 8a08898d by Ben Gamari at 2023-06-10T09:31:40-04:00 rts: Drop benign race - - - - - 3af3e454 by Ubuntu at 2023-06-10T09:31:40-04:00 rts: C++ fixes - - - - - eb95bfa5 by Ben Gamari at 2023-06-10T09:31:40-04:00 codeGen: Ensure that TSAN is aware of writeArray# write barriers - - - - - a427ac25 by Ben Gamari at 2023-06-10T09:31:40-04:00 More principled treatment of acquire fences - - - - - 66669b78 by Ubuntu at 2023-06-10T09:31:40-04:00 Work around #22451 - - - - - 98157789 by Ubuntu at 2023-06-10T09:31:40-04:00 llvm: Sequential consistency - - - - - 145a8b71 by Ubuntu at 2023-06-10T09:31:40-04:00 rts: sequential consistency - - - - - 500c0dc8 by Ubuntu at 2023-06-10T09:31:40-04:00 ghc-prim: Use C11 atomics - - - - - 32b5c335 by Ubuntu at 2023-06-10T09:31:40-04:00 Fix thunk update further - - - - - f3f69e22 by Ubuntu at 2023-06-10T09:31:40-04:00 Add acquire fence in WHITEHOLE - - - - - 60e856bb by Ubuntu at 2023-06-10T09:31:41-04:00 whitespace - - - - - cb602aec by Ubuntu at 2023-06-10T09:31:41-04:00 Note - - - - - d830e57d by Ben Gamari at 2023-06-10T09:31:41-04:00 STM: relaxed - - - - - de3fb985 by Ubuntu at 2023-06-10T09:31:41-04:00 Run script - - - - - fed0d249 by Ubuntu at 2023-06-10T09:31:41-04:00 Refine run script - - - - - 4b92cc40 by Ubuntu at 2023-06-10T09:31:41-04:00 run - - - - - 9292751c by Ubuntu at 2023-06-10T09:31:41-04:00 Disable selector optimisation - - - - - 7af4bf78 by Ben Gamari at 2023-06-10T09:31:41-04:00 ACQUIRE_FENCE - - - - - d0d2a21c by Ben Gamari at 2023-06-10T09:31:41-04:00 Add Note - - - - - 02d672a4 by Ben Gamari at 2023-06-10T09:31:41-04:00 STM: Acquire instead of seq-cst - - - - - 7f961b1e by Ben Gamari at 2023-06-10T09:31:41-04:00 Comment - - - - - 11a9442b by Ubuntu at 2023-06-10T09:31:41-04:00 Fix acquire fences on indirections - - - - - dac2542f by Ubuntu at 2023-06-10T09:31:41-04:00 STM - - - - - 163c891b by Ubuntu at 2023-06-10T09:31:41-04:00 comment fixes - - - - - cbad7e65 by Ben Gamari at 2023-06-10T09:31:41-04:00 hadrian: Fix - - - - - 34b8390f by Ben Gamari at 2023-06-10T09:31:41-04:00 rts: BLACKHOLE fix - - - - - d6ee9c80 by Ben Gamari at 2023-06-10T09:31:41-04:00 rts: TSO owner - - - - - 90456fb9 by Ben Gamari at 2023-06-10T09:31:41-04:00 updateThunk - - - - - 3cc9db9a by Ben Gamari at 2023-06-10T09:31:41-04:00 compiler: Ensure that array reads have necessary barriers - - - - - 3a8c3f41 by Ben Gamari at 2023-06-10T09:31:41-04:00 Drop dead code - - - - - 015651f3 by Ben Gamari at 2023-06-10T09:31:41-04:00 Fix whitespace - - - - - 295fc80b by Ben Gamari at 2023-06-10T09:31:41-04:00 Fix it - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - .gitlab/rel_eng/upload_ghc_libs.py - CODEOWNERS - HACKING.md - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Info.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2e3ddc340b56260a01264550bb405984e17f8dbc...295fc80bb5e0f20ec4477ad79f2b9af64c2191e3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2e3ddc340b56260a01264550bb405984e17f8dbc...295fc80bb5e0f20ec4477ad79f2b9af64c2191e3 You're receiving 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 Jun 10 13:57:35 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sat, 10 Jun 2023 09:57:35 -0400 Subject: [Git][ghc/ghc][wip/T23109] Allow SelCo for newtype classes Message-ID: <6484814f53435_3b408b141b407c1936a@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23109 at Glasgow Haskell Compiler / GHC Commits: 5121fc57 by Simon Peyton Jones at 2023-06-10T15:56:50+02:00 Allow SelCo for newtype classes Experimental change - - - - - 2 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/TyCon.hs Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -1307,7 +1307,7 @@ mkSubCo co = assertPpr (coercionRole co == Nominal) (ppr co <+> ppr (coercionRol isSubCo_maybe :: Coercion -> Maybe Coercion isSubCo_maybe (SubCo co) = Just co -isSubCo_maybe co = Nothing +isSubCo_maybe _ = Nothing -- | Changes a role, but only a downgrade. See Note [Role twiddling functions] downgradeRole_maybe :: Role -- ^ desired role ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -67,7 +67,7 @@ module GHC.Core.TyCon( isOpenTypeFamilyTyCon, isClosedSynFamilyTyConWithAxiom_maybe, tyConInjectivityInfo, isBuiltInSynFamTyCon_maybe, - isGadtSyntaxTyCon, isInjectiveTyCon, isGenerativeTyCon, isGenInjAlgRhs, + isGadtSyntaxTyCon, isInjectiveTyCon, isGenerativeTyCon, isTyConAssoc, tyConAssoc_maybe, tyConFlavourAssoc_maybe, isImplicitTyCon, isTyConWithSrcDataCons, @@ -1982,23 +1982,39 @@ isTypeDataTyCon (TyCon { tyConDetails = details }) -- See also Note [Decomposing TyConApp equalities] in "GHC.Tc.Solver.Canonical" isInjectiveTyCon :: TyCon -> Role -> Bool isInjectiveTyCon (TyCon { tyConDetails = details }) role - = go details role + = go details where - go _ Phantom = True -- Vacuously; (t1 ~P t2) holds for all t1, t2! - go (AlgTyCon {}) Nominal = True - go (AlgTyCon {algTcRhs = rhs}) Representational = isGenInjAlgRhs rhs - go (SynonymTyCon {}) _ = False - go (FamilyTyCon { famTcFlav = DataFamilyTyCon _ }) - Nominal = True - go (FamilyTyCon { famTcInj = Injective inj }) Nominal = and inj - go (FamilyTyCon {}) _ = False - go (PrimTyCon {}) _ = True - go (PromotedDataCon {}) _ = True - go (TcTyCon {}) _ = True + go _ | Phantom <- role = True -- Vacuously; (t1 ~P t2) holds for all t1, t2! + + go (AlgTyCon {algTcRhs = rhs, algTcFlavour = flav}) + | Nominal <- role = True + | Representational <- role = go_alg_rep rhs flav - -- Reply True for TcTyCon to minimise knock on type errors - -- See Note [How TcTyCons work] item (1) in GHC.Tc.TyCl + go (FamilyTyCon { famTcFlav = DataFamilyTyCon _ }) + | Nominal <- role = True + go (FamilyTyCon { famTcInj = Injective inj }) + | Nominal <- role = and inj + go (FamilyTyCon {}) = False + go (SynonymTyCon {}) = False + go (PrimTyCon {}) = True + go (PromotedDataCon {}) = True + go (TcTyCon {}) = True + -- Reply True for TcTyCon to minimise knock on type errors + -- See Note [How TcTyCons work] item (1) in GHC.Tc.TyCl + + -- go_alg_rep used only at Representational role + go_alg_rep (TupleTyCon {}) _ = True + go_alg_rep (SumTyCon {}) _ = True + go_alg_rep (DataTyCon {}) _ = True + go_alg_rep (AbstractTyCon {}) _ = False + go_alg_rep (NewTyCon {}) (ClassTyCon {}) = True -- See Note [Newtype classes] + go_alg_rep (NewTyCon {}) _ = False + +{- Note [Newtype classes] +~~~~~~~~~~~~~~~~~~~~~~~~~ +ToDo: write this up +-} -- | 'isGenerativeTyCon' is true of 'TyCon's for which this property holds -- (where r is the role passed in): @@ -2018,14 +2034,6 @@ isGenerativeTyCon tc@(TyCon { tyConDetails = details }) role -- In all other cases, injectivity implies generativity go r _ = isInjectiveTyCon tc r --- | Is this an 'AlgTyConRhs' of a 'TyCon' that is generative and injective --- with respect to representational equality? -isGenInjAlgRhs :: AlgTyConRhs -> Bool -isGenInjAlgRhs (TupleTyCon {}) = True -isGenInjAlgRhs (SumTyCon {}) = True -isGenInjAlgRhs (DataTyCon {}) = True -isGenInjAlgRhs (AbstractTyCon {}) = False -isGenInjAlgRhs (NewTyCon {}) = False -- | Is this 'TyCon' that for a @newtype@ isNewTyCon :: TyCon -> Bool View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5121fc57b1e074e37f6752b4fc8a2e2962cd9bce -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5121fc57b1e074e37f6752b4fc8a2e2962cd9bce You're receiving 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 Jun 10 14:00:08 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sat, 10 Jun 2023 10:00:08 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] Cleanup the MulMayOflo story Message-ID: <648481e8ba184_3b408b136193fc1941f1@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: 7cda1a55 by Sven Tennie at 2023-06-10T13:59:23+00:00 Cleanup the MulMayOflo story - - - - - 2 changed files: - compiler/GHC/CmmToAsm/RV64/CodeGen.hs - testsuite/tests/codeGen/should_run/MulMayOflo_cmm.cmm Changes: ===================================== compiler/GHC/CmmToAsm/RV64/CodeGen.hs ===================================== @@ -982,7 +982,7 @@ getRegister' config plat expr unitOL $ annExpr expr (ADD (OpReg w dst) zero (OpImm (ImmInt 0))) ) else do - let use32BitMul = width_x <= W32 && width_y <= W32 + let use32BitMul = w <= W32 && width_x <= W32 && width_y <= W32 nonSense = OpImm (ImmInt 0) if use32BitMul then do @@ -1004,43 +1004,14 @@ getRegister' config plat expr CSET (OpReg w dst) (OpReg w dst) nonSense NE ] ) - else do - -- TODO: Can this case ever happen? Write a test for it! - -- TODO: Can't we clobber reg_x and reg_y to save registers? - lo <- getNewRegNat II64 - hi <- getNewRegNat II64 - narrowedLo <- getNewRegNat II64 - - -- TODO: Overhaul CSET: 3rd operand isn't needed for SNEZ - let nonSense = OpImm (ImmInt 0) + else pure $ Any (intFormat w) ( \dst -> - code_x - `appOL` signExtend (formatToWidth format_x) W64 reg_x reg_x - `appOL` code_y - `appOL` signExtend (formatToWidth format_y) W64 reg_x reg_y - `appOL` toOL - [ annExpr expr (SMULH (OpReg w hi) (OpReg w reg_x) (OpReg w reg_y)), - MUL (OpReg w lo) (OpReg w reg_x) (OpReg w reg_y), - ASR (OpReg w lo) (OpReg w lo) (OpImm (ImmInt (widthInBits W64 - 1))), - ann - (text "Set flag if result of MULH contains more than sign bits.") - (SUB (OpReg w hi) (OpReg w hi) (OpReg w lo)), - CSET (OpReg w hi) (OpReg w hi) nonSense NE - ] - `appOL` signExtend W64 w lo narrowedLo - `appOL` toOL - [ ann - (text "Check if the multiplied value fits in the narrowed register") - (SUB (OpReg w narrowedLo) (OpReg w lo) (OpReg w narrowedLo)), - CSET (OpReg w narrowedLo) (OpReg w narrowedLo) nonSense NE, - ann - (text "Combine both overflow flags") - (OR (OpReg w dst) (OpReg w narrowedLo) (OpReg w hi)) - ] - ) + -- Do not handle this unlikely case. Just tell that it may overflow. + unitOL $ annExpr expr (ADD (OpReg w dst) zero (OpImm (ImmInt 1))) + ) -- | Instructions to sign-extend the value in the given register from width @w@ -- up to width @w'@. ===================================== testsuite/tests/codeGen/should_run/MulMayOflo_cmm.cmm ===================================== @@ -85,7 +85,5 @@ runCmmzh() { ASSERT(%mulmayoflo(4611686018427387904::I64, 2::I64) > 0::I64); ASSERT(%mulmayoflo(2::I64, 4611686018427387904::I64) > 0::I64); - // Gives a linter error - // ASSERT(%mulmayoflo(1::I64, 1::I8) == 0); return(0); } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7cda1a55c9faa5350e9da05a070b49163a6e722e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7cda1a55c9faa5350e9da05a070b49163a6e722e You're receiving 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 Jun 10 14:43:48 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sat, 10 Jun 2023 10:43:48 -0400 Subject: [Git][ghc/ghc][wip/T23109] Wibble Message-ID: <64848c2473dae_3b408b139abfd8208519@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23109 at Glasgow Haskell Compiler / GHC Commits: 6ed9ec4c by Simon Peyton Jones at 2023-06-10T16:43:33+02:00 Wibble - - - - - 1 changed file: - compiler/GHC/Tc/TyCl/Instance.hs Changes: ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -52,7 +52,7 @@ import GHC.Tc.Utils.Env import GHC.Tc.Gen.HsType import GHC.Tc.Utils.Unify import GHC.Builtin.Names ( unsatisfiableIdName ) -import GHC.Core ( Expr(..), mkApps, mkVarApps, mkLams ) +import GHC.Core ( Expr(..), mkVarApps ) import GHC.Core.Make ( nO_METHOD_BINDING_ERROR_ID ) -- import GHC.Core.Unfold.Make ( mkInlineUnfoldingWithArity, mkDFunUnfolding ) import GHC.Core.Unfold.Make (mkDFunUnfolding ) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6ed9ec4cf48e6089caf0fd94496ed509078a5645 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6ed9ec4cf48e6089caf0fd94496ed509078a5645 You're receiving 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 Jun 10 16:45:40 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sat, 10 Jun 2023 12:45:40 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] Implement MO_ReadBarrier and MO_WriteBarrier Message-ID: <6484a8b4815c3_3b408b139abed4218877@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: 0ca4e9c0 by Sven Tennie at 2023-06-10T16:43:51+00:00 Implement MO_ReadBarrier and MO_WriteBarrier The levels are taken from SMP.h write_barrier() and load_load_barrier(). - - - - - 3 changed files: - compiler/GHC/CmmToAsm/RV64/CodeGen.hs - compiler/GHC/CmmToAsm/RV64/Instr.hs - compiler/GHC/CmmToAsm/RV64/Ppr.hs Changes: ===================================== compiler/GHC/CmmToAsm/RV64/CodeGen.hs ===================================== @@ -1576,9 +1576,9 @@ genCCall target dest_regs arg_regs bid = do MO_U_Mul2 _w -> unsupported mop -- Memory Ordering - -- TODO DMBSY is probably *way* too much! - MO_ReadBarrier -> return (unitOL DMBSY, Nothing) - MO_WriteBarrier -> return (unitOL DMBSY, Nothing) + -- The concrete encoding is copied from load_load_barrier() and write_barrier() (SMP.h) + MO_ReadBarrier -> return (unitOL (DMBSY DmbRead), Nothing) + MO_WriteBarrier -> return (unitOL (DMBSY DmbWrite), Nothing) MO_Touch -> return (nilOL, Nothing) -- Keep variables live (when using interior pointers) -- Prefetch MO_Prefetch_Data _n -> return (nilOL, Nothing) -- Prefetch hint. ===================================== compiler/GHC/CmmToAsm/RV64/Instr.hs ===================================== @@ -132,7 +132,7 @@ regUsageOfInstr platform instr = case instr of -- LDP _ dst1 dst2 src -> usage (regOp src, regOp dst1 ++ regOp dst2) -- 8. Synchronization Instructions ------------------------------------------- - DMBSY -> usage ([], []) + DMBSY _ -> usage ([], []) -- 9. Floating Point Instructions -------------------------------------------- FCVT dst src -> usage (regOp src, regOp dst) @@ -268,7 +268,7 @@ patchRegsOfInstr instr env = case instr of -- LDP f o1 o2 o3 -> LDP f (patchOp o1) (patchOp o2) (patchOp o3) -- 8. Synchronization Instructions ----------------------------------------- - DMBSY -> DMBSY + DMBSY op -> DMBSY op -- 9. Floating Point Instructions ------------------------------------------ FCVT o1 o2 -> FCVT (patchOp o1) (patchOp o2) @@ -654,7 +654,7 @@ data Instr | BCOND Cond Operand Operand Target -- branch with condition. b. -- 8. Synchronization Instructions ----------------------------------------- - | DMBSY + | DMBSY DmbType -- 9. Floating Point Instructions -- Float ConVerT | FCVT Operand Operand @@ -665,6 +665,8 @@ data Instr -- Float ABSolute value | FABS Operand Operand +data DmbType = DmbRead | DmbWrite + instrCon :: Instr -> String instrCon i = case i of ===================================== compiler/GHC/CmmToAsm/RV64/Ppr.hs ===================================== @@ -649,7 +649,9 @@ pprInstr platform instr = case instr of -- LDP _f o1 o2 o3 -> op3 (text "\tldp") o1 o2 o3 -- 8. Synchronization Instructions ------------------------------------------- - DMBSY -> line $ text "\tdmb sy" + DMBSY DmbRead -> line $ text "\tfence r,r" + DMBSY DmbWrite -> line $ text "\tfence w,w" + -- 9. Floating Point Instructions -------------------------------------------- FCVT o1 o2 -> op2 (text "\tfcvt") o1 o2 SCVTF o1 o2 -> op2 (text "\tscvtf") o1 o2 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0ca4e9c0e0b12a249671c7159e173a881c71581b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0ca4e9c0e0b12a249671c7159e173a881c71581b You're receiving 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 Jun 10 18:26:09 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sat, 10 Jun 2023 14:26:09 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/tsan/no-barriers Message-ID: <6484c0418b86e_3b408b139abed4230794@gitlab.mail> Ben Gamari pushed new branch wip/tsan/no-barriers at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/tsan/no-barriers You're receiving 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 Jun 11 09:58:33 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Sun, 11 Jun 2023 05:58:33 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T20076 Message-ID: <64859ac9554cf_111d63c560c115224@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/T20076 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T20076 You're receiving 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 Jun 11 10:16:42 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sun, 11 Jun 2023 06:16:42 -0400 Subject: [Git][ghc/ghc][wip/tsan/no-barriers] 7 commits: compiler: Drop MO_WriteBarrier Message-ID: <64859f0a32290_111d63c5ad013021@gitlab.mail> Sven Tennie pushed to branch wip/tsan/no-barriers at Glasgow Haskell Compiler / GHC Commits: b0e633cf by Ben Gamari at 2023-06-11T10:10:56+00:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier This is no longer used. - - - - - b43a6791 by Ben Gamari at 2023-06-11T10:11:02+00:00 rts: Drop load_store_barrier() This is no longer used. - - - - - 775848fd by Ben Gamari at 2023-06-11T10:11:02+00:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - a2711661 by Ben Gamari at 2023-06-11T10:11:02+00:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 73d90662 by Ben Gamari at 2023-06-11T10:11:02+00:00 compiler: Drop MO_ReadBarrier - - - - - 65f5752f by Ben Gamari at 2023-06-11T10:11:02+00:00 rts: Drop load_load_barrier This is no longer used. - - - - - f96a528f by Sven Tennie at 2023-06-11T10:15:18+00:00 Fix MO_ReleaseFence & MO_AcquireFence LLVM genCall Type error. - - - - - 22 changed files: - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - rts/CloneStack.c - rts/PrimOps.cmm - rts/RaiseAsync.c - rts/RtsSymbols.c - rts/Sparks.c - rts/TopHandler.c - rts/include/Cmm.h - rts/include/Stg.h - rts/include/stg/SMP.h - rts/sm/Evac.c - rts/sm/GC.c - rts/sm/GCAux.c - rts/sm/Sanity.c - testsuite/tests/rts/testwsdeque.c Changes: ===================================== compiler/GHC/Cmm/MachOp.hs ===================================== @@ -670,7 +670,6 @@ data CallishMachOp | MO_SubIntC Width | MO_U_Mul2 Width - | MO_ReadBarrier | MO_WriteBarrier | MO_Touch -- Keep variables live (when using interior pointers) ===================================== compiler/GHC/Cmm/Parser.y ===================================== @@ -1119,7 +1119,6 @@ callishMachOps platform = listToUFM $ ( "acquire_fence", (MO_AcquireFence,)), ( "release_fence", (MO_ReleaseFence,)), - ( "read_barrier", (MO_ReadBarrier,)), ( "write_barrier", (MO_WriteBarrier,)), ( "memcpy", memcpyLikeTweakArgs MO_Memcpy ), ( "memset", memcpyLikeTweakArgs MO_Memset ), ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -1561,7 +1561,6 @@ genCCall target dest_regs arg_regs bid = do MO_AcquireFence -> return (unitOL DMBISH, Nothing) MO_ReleaseFence -> return (unitOL DMBISH, Nothing) -- TODO DMBSY is probably *way* too much! - MO_ReadBarrier -> return (unitOL DMBSY, Nothing) MO_WriteBarrier -> return (unitOL DMBSY, Nothing) MO_Touch -> return (nilOL, Nothing) -- Keep variables live (when using interior pointers) -- Prefetch ===================================== compiler/GHC/CmmToAsm/PPC/CodeGen.hs ===================================== @@ -1131,8 +1131,6 @@ genCCall (PrimTarget MO_AcquireFence) _ _ genCCall (PrimTarget MO_ReleaseFence) _ _ = return $ unitOL LWSYNC -genCCall (PrimTarget MO_ReadBarrier) _ _ - = return $ unitOL LWSYNC genCCall (PrimTarget MO_WriteBarrier) _ _ = return $ unitOL LWSYNC @@ -2099,7 +2097,6 @@ genCCall' config gcp target dest_regs args MO_AddIntC {} -> unsupported MO_SubIntC {} -> unsupported MO_U_Mul2 {} -> unsupported - MO_ReadBarrier -> unsupported MO_WriteBarrier -> unsupported MO_Touch -> unsupported MO_Prefetch_Data _ -> unsupported ===================================== compiler/GHC/CmmToAsm/Wasm/FromCmm.hs ===================================== @@ -1188,7 +1188,6 @@ lower_CallishMachOp lbl MO_F32_Sqrt rs xs = lower_CMO_Un_Homo lbl "sqrtf" rs xs lower_CallishMachOp lbl (MO_UF_Conv w0) rs xs = lower_MO_UF_Conv lbl w0 rs xs lower_CallishMachOp _ MO_AcquireFence _ _ = pure $ WasmStatements WasmNop lower_CallishMachOp _ MO_ReleaseFence _ _ = pure $ WasmStatements WasmNop -lower_CallishMachOp _ MO_ReadBarrier _ _ = pure $ WasmStatements WasmNop lower_CallishMachOp _ MO_WriteBarrier _ _ = pure $ WasmStatements WasmNop lower_CallishMachOp _ MO_Touch _ _ = pure $ WasmStatements WasmNop lower_CallishMachOp _ (MO_Prefetch_Data {}) _ _ = pure $ WasmStatements WasmNop ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -2162,7 +2162,6 @@ genSimplePrim bid (MO_Memcmp align) [res] [dst,src,n] = genMemCmp bid a genSimplePrim bid (MO_Memset align) [] [dst,c,n] = genMemSet bid align dst c n genSimplePrim _ MO_AcquireFence [] [] = return nilOL -- barriers compile to no code on x86/x86-64; genSimplePrim _ MO_ReleaseFence [] [] = return nilOL -- we keep it this long in order to prevent earlier optimisations. -genSimplePrim _ MO_ReadBarrier [] [] = return nilOL -- barriers compile to no code on x86/x86-64; genSimplePrim _ MO_WriteBarrier [] [] = return nilOL -- we keep it this long in order to prevent earlier optimisations. genSimplePrim _ MO_Touch [] [_] = return nilOL genSimplePrim _ (MO_Prefetch_Data n) [] [src] = genPrefetchData n src ===================================== compiler/GHC/CmmToC.hs ===================================== @@ -951,7 +951,6 @@ pprCallishMachOp_for_C mop MO_F32_Fabs -> text "fabsf" MO_AcquireFence -> unsupported MO_ReleaseFence -> unsupported - MO_ReadBarrier -> text "load_load_barrier" MO_WriteBarrier -> text "write_barrier" MO_Memcpy _ -> text "__builtin_memcpy" MO_Memset _ -> text "__builtin_memset" ===================================== compiler/GHC/CmmToLlvm/CodeGen.hs ===================================== @@ -191,14 +191,11 @@ genCall :: ForeignTarget -> [CmmFormal] -> [CmmActual] -> LlvmM StmtData -- Barriers need to be handled specially as they are implemented as LLVM -- intrinsic functions. -genCall (PrimTarget MO_AcquireFence) _ _ = +genCall (PrimTarget MO_AcquireFence) _ _ = runStmtsDecls $ statement $ Fence False SyncAcquire -genCall (PrimTarget MO_ReleaseFence) _ _ = +genCall (PrimTarget MO_ReleaseFence) _ _ = runStmtsDecls $ statement $ Fence False SyncRelease -genCall (PrimTarget MO_ReadBarrier) _ _ = - barrierUnless [ArchX86, ArchX86_64] - genCall (PrimTarget MO_WriteBarrier) _ _ = barrierUnless [ArchX86, ArchX86_64] @@ -1013,7 +1010,6 @@ cmmPrimOpFunctions mop = do -- We support MO_U_Mul2 through ordinary LLVM mul instruction, see the -- appropriate case of genCall. MO_U_Mul2 {} -> unsupported - MO_ReadBarrier -> unsupported MO_WriteBarrier -> unsupported MO_Touch -> unsupported MO_UF_Conv _ -> unsupported ===================================== rts/CloneStack.c ===================================== @@ -74,9 +74,7 @@ void sendCloneStackMessage(StgTSO *tso, HsStablePtr mvar) { msg = (MessageCloneStack *)allocate(srcCapability, sizeofW(MessageCloneStack)); msg->tso = tso; msg->result = (StgMVar*)deRefStablePtr(mvar); - SET_HDR(msg, &stg_MSG_CLONE_STACK_info, CCS_SYSTEM); - // Ensure that writes constructing Message are committed before sending. - write_barrier(); + SET_HDR_RELEASE(msg, &stg_MSG_CLONE_STACK_info, CCS_SYSTEM); sendMessage(srcCapability, tso->cap, (Message *)msg); } ===================================== rts/PrimOps.cmm ===================================== @@ -2505,8 +2505,8 @@ stg_unpackClosurezh ( P_ closure ) { W_ info, ptrs, nptrs, p, ptrs_arr, dat_arr; MAYBE_GC_P(stg_unpackClosurezh, closure); - info = %GET_STD_INFO(UNTAG(closure)); - prim_read_barrier; + info = GET_INFO_ACQUIRE(UNTAG(closure)); + info = INFO_PTR_TO_INFO_TABLE(info); ptrs = TO_W_(%INFO_PTRS(info)); nptrs = TO_W_(%INFO_NPTRS(info)); @@ -2820,8 +2820,7 @@ stg_noDuplicatezh /* no arg list: explicit stack layout */ stg_getApStackValzh ( P_ ap_stack, W_ offset ) { W_ ap_stackinfo; - ap_stackinfo = %INFO_PTR(UNTAG(ap_stack)); - prim_read_barrier; + ap_stackinfo = GET_INFO_ACQUIRE(UNTAG(ap_stack)); if (ap_stackinfo == stg_AP_STACK_info) { return (1,StgAP_STACK_payload(ap_stack,offset)); } else { ===================================== rts/RaiseAsync.c ===================================== @@ -238,7 +238,7 @@ throwToMsg (Capability *cap, MessageThrowTo *msg) goto check_target; retry: - write_barrier(); + RELEASE_FENCE(); // TODO: is this necessary? debugTrace(DEBUG_sched, "throwTo: retrying..."); check_target: @@ -874,9 +874,10 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception, ap->payload[i] = (StgClosure *)*sp++; } - write_barrier(); // XXX: Necessary? SET_HDR(ap,&stg_AP_STACK_info, ((StgClosure *)frame)->header.prof.ccs /* ToDo */); + // N.B. This will be made visible by updateThunk below, which + // implies a release memory barrier. TICK_ALLOC_UP_THK(AP_STACK_sizeW(words),0); //IF_DEBUG(scheduler, ===================================== rts/RtsSymbols.c ===================================== @@ -910,8 +910,6 @@ extern char **environ; SymI_HasProto(hs_spt_keys) \ SymI_HasProto(hs_spt_key_count) \ SymI_HasProto(write_barrier) \ - SymI_HasProto(store_load_barrier) \ - SymI_HasProto(load_load_barrier) \ SymI_HasProto(cas) \ SymI_HasProto(_assertFail) \ SymI_HasProto(keepCAFs) \ ===================================== rts/Sparks.c ===================================== @@ -209,8 +209,7 @@ pruneSparkQueue (bool nonmovingMarkFinished, Capability *cap) cap->spark_stats.fizzled++; traceEventSparkFizzle(cap); } else { - info = RELAXED_LOAD(&spark->header.info); - load_load_barrier(); + info = ACQUIRE_LOAD(&spark->header.info); if (IS_FORWARDING_PTR(info)) { tmp = (StgClosure*)UN_FORWARDING_PTR(info); /* if valuable work: shift inside the pool */ ===================================== rts/TopHandler.c ===================================== @@ -32,8 +32,7 @@ StgTSO *getTopHandlerThread(void) { // topHandlerPtr was never initialised return NULL; } - const StgInfoTable *info = weak->header.info; - load_load_barrier(); + const StgInfoTable *info = ACQUIRE_LOAD(&weak->header.info); if (info == &stg_WEAK_info) { StgClosure *key = ((StgWeak*)weak)->key; ===================================== rts/include/Cmm.h ===================================== @@ -681,7 +681,6 @@ // For discussion of how these are used to fence heap object // accesses see Note [Heap memory barriers] in SMP.h. #if defined(THREADED_RTS) -#define prim_read_barrier prim %read_barrier() #define prim_write_barrier prim %write_barrier() // See Note [ThreadSanitizer and fences] @@ -690,8 +689,6 @@ #else -#define prim_read_barrier /* nothing */ -#define prim_write_barrier /* nothing */ #define RELEASE_FENCE /* nothing */ #define ACQUIRE_FENCE /* nothing */ #endif /* THREADED_RTS */ ===================================== rts/include/Stg.h ===================================== @@ -392,7 +392,7 @@ external prototype return neither of these types to workaround #11395. #endif #include "stg/Prim.h" /* ghc-prim fallbacks */ -#include "stg/SMP.h" // write_barrier() inline is required +#include "stg/SMP.h" /* ----------------------------------------------------------------------------- Moving Floats and Doubles ===================================== rts/include/stg/SMP.h ===================================== @@ -108,20 +108,14 @@ EXTERN_INLINE void busy_wait_nop(void); /* * Various kinds of memory barrier. * write_barrier: prevents future stores occurring before preceding stores. - * store_load_barrier: prevents future loads occurring before preceding stores. - * load_load_barrier: prevents future loads occurring before earlier loads. * * Reference for these: "The JSR-133 Cookbook for Compiler Writers" * http://gee.cs.oswego.edu/dl/jmm/cookbook.html * * To check whether you got these right, try the test in * testsuite/tests/rts/testwsdeque.c - * This tests the work-stealing deque implementation, which relies on - * properly working store_load and load_load memory barriers. */ EXTERN_INLINE void write_barrier(void); -EXTERN_INLINE void store_load_barrier(void); -EXTERN_INLINE void load_load_barrier(void); /* * Note [Heap memory barriers] @@ -354,7 +348,7 @@ EXTERN_INLINE void load_load_barrier(void); * Exchange the value pointed to by p with w and return the former. This * function is used to acquire a lock. An acquire memory barrier is sufficient * for a lock operation because corresponding unlock operation issues a - * store-store barrier (write_barrier()) immediately before releasing the lock. + * store-store barrier (release-store) immediately before releasing the lock. */ EXTERN_INLINE StgWord xchg(StgPtr p, StgWord w) @@ -496,58 +490,6 @@ write_barrier(void) { #endif } -EXTERN_INLINE void -store_load_barrier(void) { -#if defined(NOSMP) - return; -#elif defined(i386_HOST_ARCH) - __asm__ __volatile__ ("lock; addl $0,0(%%esp)" : : : "memory"); -#elif defined(x86_64_HOST_ARCH) - __asm__ __volatile__ ("lock; addq $0,0(%%rsp)" : : : "memory"); -#elif defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) \ - || defined(powerpc64le_HOST_ARCH) - __asm__ __volatile__ ("sync" : : : "memory"); -#elif defined(s390x_HOST_ARCH) - __asm__ __volatile__ ("bcr 14,0" : : : "memory"); -#elif defined(arm_HOST_ARCH) - __asm__ __volatile__ ("dmb" : : : "memory"); -#elif defined(aarch64_HOST_ARCH) - __asm__ __volatile__ ("dmb sy" : : : "memory"); -#elif defined(riscv64_HOST_ARCH) - __asm__ __volatile__ ("fence w,r" : : : "memory"); -#elif defined(loongarch64_HOST_ARCH) - __asm__ __volatile__ ("dbar 0" : : : "memory"); -#else -#error memory barriers unimplemented on this architecture -#endif -} - -EXTERN_INLINE void -load_load_barrier(void) { -#if defined(NOSMP) - return; -#elif defined(i386_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(x86_64_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) \ - || defined(powerpc64le_HOST_ARCH) - __asm__ __volatile__ ("lwsync" : : : "memory"); -#elif defined(s390x_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(arm_HOST_ARCH) - __asm__ __volatile__ ("dmb" : : : "memory"); -#elif defined(aarch64_HOST_ARCH) - __asm__ __volatile__ ("dmb ld" : : : "memory"); -#elif defined(riscv64_HOST_ARCH) - __asm__ __volatile__ ("fence r,r" : : : "memory"); -#elif defined(loongarch64_HOST_ARCH) - __asm__ __volatile__ ("dbar 0" : : : "memory"); -#else -#error memory barriers unimplemented on this architecture -#endif -} - // Load a pointer from a memory location that might be being modified // concurrently. This prevents the compiler from optimising away // multiple loads of the memory location, as it might otherwise do in @@ -587,11 +529,7 @@ load_load_barrier(void) { #else /* !THREADED_RTS */ EXTERN_INLINE void write_barrier(void); -EXTERN_INLINE void store_load_barrier(void); -EXTERN_INLINE void load_load_barrier(void); EXTERN_INLINE void write_barrier () {} /* nothing */ -EXTERN_INLINE void store_load_barrier() {} /* nothing */ -EXTERN_INLINE void load_load_barrier () {} /* nothing */ // Relaxed atomic operations #define RELAXED_LOAD(ptr) *ptr ===================================== rts/sm/Evac.c ===================================== @@ -1394,8 +1394,7 @@ selector_loop: // the same selector thunk. SET_INFO((StgClosure*)p, (StgInfoTable *)info_ptr); OVERWRITING_CLOSURE((StgClosure*)p); - SET_INFO((StgClosure*)p, &stg_WHITEHOLE_info); - write_barrier(); + SET_INFO_RELEASE((StgClosure*)p, &stg_WHITEHOLE_info); #if defined(PARALLEL_GC) abort(); // LDV is incompatible with parallel GC #endif ===================================== rts/sm/GC.c ===================================== @@ -1508,7 +1508,6 @@ waitForGcThreads (Capability *cap, bool idle_cap[]) if (i == me || idle_cap[i]) { continue; } if (SEQ_CST_LOAD(&gc_threads[i]->wakeup) != GC_THREAD_STANDING_BY) { prodCapability(getCapability(i), cap->running_task); - write_barrier(); interruptCapability(getCapability(i)); } } ===================================== rts/sm/GCAux.c ===================================== @@ -91,8 +91,8 @@ isAlive(StgClosure *p) return TAG_CLOSURE(tag,(StgClosure*)UN_FORWARDING_PTR(info)); } + ACQUIRE_FENCE_ON(&q->header.info); info = INFO_PTR_TO_STRUCT(info); - load_load_barrier(); switch (info->type) { ===================================== rts/sm/Sanity.c ===================================== @@ -355,8 +355,7 @@ checkClosure( const StgClosure* p ) p = UNTAG_CONST_CLOSURE(p); - info = p->header.info; - load_load_barrier(); + info = ACQUIRE_LOAD(&p->header.info); if (IS_FORWARDING_PTR(info)) { barf("checkClosure: found EVACUATED closure %d", info->type); @@ -367,7 +366,6 @@ checkClosure( const StgClosure* p ) #endif info = INFO_PTR_TO_STRUCT(info); - load_load_barrier(); switch (info->type) { @@ -772,8 +770,7 @@ checkSTACK (StgStack *stack) void checkTSO(StgTSO *tso) { - const StgInfoTable *info = (const StgInfoTable*) tso->_link->header.info; - load_load_barrier(); + const StgInfoTable *info = (const StgInfoTable*) ACQUIRE_LOAD(&tso->_link)->header.info; ASSERT(tso->_link == END_TSO_QUEUE || info == &stg_MVAR_TSO_QUEUE_info || ===================================== testsuite/tests/rts/testwsdeque.c ===================================== @@ -34,47 +34,25 @@ void * myStealWSDeque_ (WSDeque *q, uint32_t n) { void * stolen; - StgWord b,t; // Can't do this on someone else's spark pool: // ASSERT_WSDEQUE_INVARIANTS(q); // NB. these loads must be ordered, otherwise there is a race // between steal and pop. - t = q->top; - load_load_barrier(); - b = q->bottom; + StgWord t = ACQUIRE_LOAD(&q->top); + SEQ_CST_FENCE(); + StgWord b = ACQUIRE_LOAD(&q->bottom); - // NB. b and t are unsigned; we need a signed value for the test - // below, because it is possible that t > b during a - // concurrent popWSQueue() operation. - if ((long)b - (long)t <= 0 ) { - return NULL; /* already looks empty, abort */ + void *result = NULL; + if (t < b) { + /* Non-empty queue */ + result = RELAXED_LOAD(&q->elements[t % q->size]); + if (!cas_top(q, t, t+1)) { + return NULL; + } } - // NB. the load of q->bottom must be ordered before the load of - // q->elements[t & q-> moduloSize]. See comment "KG:..." below - // and Ticket #13633. - load_load_barrier(); - /* now access array, see pushBottom() */ - stolen = q->elements[t & q->moduloSize]; - - /* now decide whether we have won */ - if ( !(CASTOP(&(q->top),t,t+1)) ) { - /* lost the race, someone else has changed top in the meantime */ - return NULL; - } /* else: OK, top has been incremented by the cas call */ - - // debugBelch("stealWSDeque_: t=%d b=%d\n", t, b); - -// Can't do this on someone else's spark pool: -// ASSERT_WSDEQUE_INVARIANTS(q); - - bufs[n] ++; - if (bufs[n] == BUF) { bufs[n] = 0; } - last_b[n][bufs[n]] = b; - last_t[n][bufs[n]] = t; - last_v[n][bufs[n]] = (StgWord)stolen; - return stolen; + return result; } void * View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c8005700afd112e8f7429c210609e7651950da60...f96a528ffe6242771ce4725b7979a750b6b38279 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c8005700afd112e8f7429c210609e7651950da60...f96a528ffe6242771ce4725b7979a750b6b38279 You're receiving 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 Jun 11 10:44:20 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sun, 11 Jun 2023 06:44:20 -0400 Subject: [Git][ghc/ghc][wip/tsan/no-barriers] 7 commits: compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE Message-ID: <6485a584afd8c_111d63c5ae41514f5@gitlab.mail> Sven Tennie pushed to branch wip/tsan/no-barriers at Glasgow Haskell Compiler / GHC Commits: 245ef4b7 by Ben Gamari at 2023-06-11T10:43:44+00:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - 29edbfce by Ben Gamari at 2023-06-11T10:43:59+00:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier This is no longer used. - - - - - 4daba583 by Ben Gamari at 2023-06-11T10:43:59+00:00 rts: Drop load_store_barrier() This is no longer used. - - - - - 5b1a7fa5 by Ben Gamari at 2023-06-11T10:43:59+00:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 335c0afe by Ben Gamari at 2023-06-11T10:43:59+00:00 rts: Eliminate remaining uses of load_load_barrier - - - - - d4d74e13 by Ben Gamari at 2023-06-11T10:43:59+00:00 compiler: Drop MO_ReadBarrier - - - - - c7795e1f by Ben Gamari at 2023-06-11T10:43:59+00:00 rts: Drop load_load_barrier This is no longer used. - - - - - 24 changed files: - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - rts/CloneStack.c - rts/PrimOps.cmm - rts/RaiseAsync.c - rts/RtsSymbols.c - rts/Sparks.c - rts/TopHandler.c - rts/include/Cmm.h - rts/include/Stg.h - rts/include/stg/SMP.h - rts/sm/Evac.c - rts/sm/GC.c - rts/sm/GCAux.c - rts/sm/Sanity.c - testsuite/tests/rts/testwsdeque.c Changes: ===================================== compiler/GHC/Cmm/MachOp.hs ===================================== @@ -670,7 +670,6 @@ data CallishMachOp | MO_SubIntC Width | MO_U_Mul2 Width - | MO_ReadBarrier | MO_WriteBarrier | MO_Touch -- Keep variables live (when using interior pointers) @@ -701,6 +700,9 @@ data CallishMachOp | MO_BSwap Width | MO_BRev Width + | MO_AcquireFence + | MO_ReleaseFence + -- | Atomic read-modify-write. Arguments are @[dest, n]@. | MO_AtomicRMW Width AtomicMachOp -- | Atomic read. Arguments are @[addr]@. ===================================== compiler/GHC/Cmm/Parser.y ===================================== @@ -1117,7 +1117,8 @@ callishMachOps platform = listToUFM $ ( "fabs32f", (MO_F32_Fabs,) ), ( "sqrt32f", (MO_F32_Sqrt,) ), - ( "read_barrier", (MO_ReadBarrier,)), + ( "acquire_fence", (MO_AcquireFence,)), + ( "release_fence", (MO_ReleaseFence,)), ( "write_barrier", (MO_WriteBarrier,)), ( "memcpy", memcpyLikeTweakArgs MO_Memcpy ), ( "memset", memcpyLikeTweakArgs MO_Memset ), ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -1558,8 +1558,9 @@ genCCall target dest_regs arg_regs bid = do MO_U_Mul2 _w -> unsupported mop -- Memory Ordering + MO_AcquireFence -> return (unitOL DMBISH, Nothing) + MO_ReleaseFence -> return (unitOL DMBISH, Nothing) -- TODO DMBSY is probably *way* too much! - MO_ReadBarrier -> return (unitOL DMBSY, Nothing) MO_WriteBarrier -> return (unitOL DMBSY, Nothing) MO_Touch -> return (nilOL, Nothing) -- Keep variables live (when using interior pointers) -- Prefetch ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -136,6 +136,7 @@ regUsageOfInstr platform instr = case instr of -- 8. Synchronization Instructions ------------------------------------------- DMBSY -> usage ([], []) + DMBISH -> usage ([], []) -- 9. Floating Point Instructions -------------------------------------------- FCVT dst src -> usage (regOp src, regOp dst) @@ -276,6 +277,7 @@ patchRegsOfInstr instr env = case instr of -- 8. Synchronization Instructions ----------------------------------------- DMBSY -> DMBSY + DMBISH -> DMBISH -- 9. Floating Point Instructions ------------------------------------------ FCVT o1 o2 -> FCVT (patchOp o1) (patchOp o2) @@ -645,6 +647,7 @@ data Instr -- 8. Synchronization Instructions ----------------------------------------- | DMBSY + | DMBISH -- 9. Floating Point Instructions -- Float ConVerT | FCVT Operand Operand @@ -724,6 +727,7 @@ instrCon i = BL{} -> "BL" BCOND{} -> "BCOND" DMBSY{} -> "DMBSY" + DMBISH{} -> "DMBISH" FCVT{} -> "FCVT" SCVTF{} -> "SCVTF" FCVTZS{} -> "FCVTZS" ===================================== compiler/GHC/CmmToAsm/AArch64/Ppr.hs ===================================== @@ -530,6 +530,7 @@ pprInstr platform instr = case instr of -- 8. Synchronization Instructions ------------------------------------------- DMBSY -> line $ text "\tdmb sy" + DMBISH -> line $ text "\tdmb ish" -- 9. Floating Point Instructions -------------------------------------------- FCVT o1 o2 -> op2 (text "\tfcvt") o1 o2 SCVTF o1 o2 -> op2 (text "\tscvtf") o1 o2 ===================================== compiler/GHC/CmmToAsm/PPC/CodeGen.hs ===================================== @@ -1126,8 +1126,11 @@ genCCall :: ForeignTarget -- function to call -> [CmmFormal] -- where to put the result -> [CmmActual] -- arguments (of mixed type) -> NatM InstrBlock -genCCall (PrimTarget MO_ReadBarrier) _ _ +genCCall (PrimTarget MO_AcquireFence) _ _ = return $ unitOL LWSYNC +genCCall (PrimTarget MO_ReleaseFence) _ _ + = return $ unitOL LWSYNC + genCCall (PrimTarget MO_WriteBarrier) _ _ = return $ unitOL LWSYNC @@ -2094,8 +2097,9 @@ genCCall' config gcp target dest_regs args MO_AddIntC {} -> unsupported MO_SubIntC {} -> unsupported MO_U_Mul2 {} -> unsupported - MO_ReadBarrier -> unsupported MO_WriteBarrier -> unsupported + MO_AcquireFence -> unsupported + MO_ReleaseFence -> unsupported MO_Touch -> unsupported MO_Prefetch_Data _ -> unsupported unsupported = panic ("outOfLineCmmOp: " ++ show mop ===================================== compiler/GHC/CmmToAsm/Wasm/FromCmm.hs ===================================== @@ -1186,7 +1186,8 @@ lower_CallishMachOp lbl MO_F32_ExpM1 rs xs = lower_CallishMachOp lbl MO_F32_Fabs rs xs = lower_CMO_Un_Homo lbl "fabsf" rs xs lower_CallishMachOp lbl MO_F32_Sqrt rs xs = lower_CMO_Un_Homo lbl "sqrtf" rs xs lower_CallishMachOp lbl (MO_UF_Conv w0) rs xs = lower_MO_UF_Conv lbl w0 rs xs -lower_CallishMachOp _ MO_ReadBarrier _ _ = pure $ WasmStatements WasmNop +lower_CallishMachOp _ MO_AcquireFence _ _ = pure $ WasmStatements WasmNop +lower_CallishMachOp _ MO_ReleaseFence _ _ = pure $ WasmStatements WasmNop lower_CallishMachOp _ MO_WriteBarrier _ _ = pure $ WasmStatements WasmNop lower_CallishMachOp _ MO_Touch _ _ = pure $ WasmStatements WasmNop lower_CallishMachOp _ (MO_Prefetch_Data {}) _ _ = pure $ WasmStatements WasmNop ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -2160,7 +2160,8 @@ genSimplePrim bid (MO_Memcpy align) [] [dst,src,n] = genMemCpy bid a genSimplePrim bid (MO_Memmove align) [] [dst,src,n] = genMemMove bid align dst src n genSimplePrim bid (MO_Memcmp align) [res] [dst,src,n] = genMemCmp bid align res dst src n genSimplePrim bid (MO_Memset align) [] [dst,c,n] = genMemSet bid align dst c n -genSimplePrim _ MO_ReadBarrier [] [] = return nilOL -- barriers compile to no code on x86/x86-64; +genSimplePrim _ MO_AcquireFence [] [] = return nilOL -- barriers compile to no code on x86/x86-64; +genSimplePrim _ MO_ReleaseFence [] [] = return nilOL -- we keep it this long in order to prevent earlier optimisations. genSimplePrim _ MO_WriteBarrier [] [] = return nilOL -- we keep it this long in order to prevent earlier optimisations. genSimplePrim _ MO_Touch [] [_] = return nilOL genSimplePrim _ (MO_Prefetch_Data n) [] [src] = genPrefetchData n src ===================================== compiler/GHC/CmmToC.hs ===================================== @@ -261,6 +261,11 @@ pprStmt platform stmt = CmmUnsafeForeignCall (PrimTarget MO_Touch) _results _args -> empty CmmUnsafeForeignCall (PrimTarget (MO_Prefetch_Data _)) _results _args -> empty + CmmUnsafeForeignCall (PrimTarget MO_ReleaseFence) [] [] -> + text "__atomic_thread_fence(__ATOMIC_RELEASE);" + CmmUnsafeForeignCall (PrimTarget MO_AcquireFence) [] [] -> + text "__atomic_thread_fence(__ATOMIC_ACQUIRE);" + CmmUnsafeForeignCall target@(PrimTarget op) results args -> fn_call where @@ -944,7 +949,8 @@ pprCallishMachOp_for_C mop MO_F32_ExpM1 -> text "expm1f" MO_F32_Sqrt -> text "sqrtf" MO_F32_Fabs -> text "fabsf" - MO_ReadBarrier -> text "load_load_barrier" + MO_AcquireFence -> unsupported + MO_ReleaseFence -> unsupported MO_WriteBarrier -> text "write_barrier" MO_Memcpy _ -> text "__builtin_memcpy" MO_Memset _ -> text "__builtin_memset" ===================================== compiler/GHC/CmmToLlvm/CodeGen.hs ===================================== @@ -191,8 +191,10 @@ genCall :: ForeignTarget -> [CmmFormal] -> [CmmActual] -> LlvmM StmtData -- Barriers need to be handled specially as they are implemented as LLVM -- intrinsic functions. -genCall (PrimTarget MO_ReadBarrier) _ _ = - barrierUnless [ArchX86, ArchX86_64] +genCall (PrimTarget MO_AcquireFence) _ _ = runStmtsDecls $ + statement $ Fence False SyncAcquire +genCall (PrimTarget MO_ReleaseFence) _ _ = runStmtsDecls $ + statement $ Fence False SyncRelease genCall (PrimTarget MO_WriteBarrier) _ _ = barrierUnless [ArchX86, ArchX86_64] @@ -1008,8 +1010,9 @@ cmmPrimOpFunctions mop = do -- We support MO_U_Mul2 through ordinary LLVM mul instruction, see the -- appropriate case of genCall. MO_U_Mul2 {} -> unsupported - MO_ReadBarrier -> unsupported MO_WriteBarrier -> unsupported + MO_ReleaseFence -> unsupported + MO_AcquireFence -> unsupported MO_Touch -> unsupported MO_UF_Conv _ -> unsupported ===================================== rts/CloneStack.c ===================================== @@ -74,9 +74,7 @@ void sendCloneStackMessage(StgTSO *tso, HsStablePtr mvar) { msg = (MessageCloneStack *)allocate(srcCapability, sizeofW(MessageCloneStack)); msg->tso = tso; msg->result = (StgMVar*)deRefStablePtr(mvar); - SET_HDR(msg, &stg_MSG_CLONE_STACK_info, CCS_SYSTEM); - // Ensure that writes constructing Message are committed before sending. - write_barrier(); + SET_HDR_RELEASE(msg, &stg_MSG_CLONE_STACK_info, CCS_SYSTEM); sendMessage(srcCapability, tso->cap, (Message *)msg); } ===================================== rts/PrimOps.cmm ===================================== @@ -2505,8 +2505,8 @@ stg_unpackClosurezh ( P_ closure ) { W_ info, ptrs, nptrs, p, ptrs_arr, dat_arr; MAYBE_GC_P(stg_unpackClosurezh, closure); - info = %GET_STD_INFO(UNTAG(closure)); - prim_read_barrier; + info = GET_INFO_ACQUIRE(UNTAG(closure)); + info = INFO_PTR_TO_INFO_TABLE(info); ptrs = TO_W_(%INFO_PTRS(info)); nptrs = TO_W_(%INFO_NPTRS(info)); @@ -2820,8 +2820,7 @@ stg_noDuplicatezh /* no arg list: explicit stack layout */ stg_getApStackValzh ( P_ ap_stack, W_ offset ) { W_ ap_stackinfo; - ap_stackinfo = %INFO_PTR(UNTAG(ap_stack)); - prim_read_barrier; + ap_stackinfo = GET_INFO_ACQUIRE(UNTAG(ap_stack)); if (ap_stackinfo == stg_AP_STACK_info) { return (1,StgAP_STACK_payload(ap_stack,offset)); } else { ===================================== rts/RaiseAsync.c ===================================== @@ -238,7 +238,7 @@ throwToMsg (Capability *cap, MessageThrowTo *msg) goto check_target; retry: - write_barrier(); + RELEASE_FENCE(); // TODO: is this necessary? debugTrace(DEBUG_sched, "throwTo: retrying..."); check_target: @@ -874,9 +874,10 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception, ap->payload[i] = (StgClosure *)*sp++; } - write_barrier(); // XXX: Necessary? SET_HDR(ap,&stg_AP_STACK_info, ((StgClosure *)frame)->header.prof.ccs /* ToDo */); + // N.B. This will be made visible by updateThunk below, which + // implies a release memory barrier. TICK_ALLOC_UP_THK(AP_STACK_sizeW(words),0); //IF_DEBUG(scheduler, ===================================== rts/RtsSymbols.c ===================================== @@ -910,8 +910,6 @@ extern char **environ; SymI_HasProto(hs_spt_keys) \ SymI_HasProto(hs_spt_key_count) \ SymI_HasProto(write_barrier) \ - SymI_HasProto(store_load_barrier) \ - SymI_HasProto(load_load_barrier) \ SymI_HasProto(cas) \ SymI_HasProto(_assertFail) \ SymI_HasProto(keepCAFs) \ ===================================== rts/Sparks.c ===================================== @@ -209,8 +209,7 @@ pruneSparkQueue (bool nonmovingMarkFinished, Capability *cap) cap->spark_stats.fizzled++; traceEventSparkFizzle(cap); } else { - info = RELAXED_LOAD(&spark->header.info); - load_load_barrier(); + info = ACQUIRE_LOAD(&spark->header.info); if (IS_FORWARDING_PTR(info)) { tmp = (StgClosure*)UN_FORWARDING_PTR(info); /* if valuable work: shift inside the pool */ ===================================== rts/TopHandler.c ===================================== @@ -32,8 +32,7 @@ StgTSO *getTopHandlerThread(void) { // topHandlerPtr was never initialised return NULL; } - const StgInfoTable *info = weak->header.info; - load_load_barrier(); + const StgInfoTable *info = ACQUIRE_LOAD(&weak->header.info); if (info == &stg_WEAK_info) { StgClosure *key = ((StgWeak*)weak)->key; ===================================== rts/include/Cmm.h ===================================== @@ -681,17 +681,14 @@ // For discussion of how these are used to fence heap object // accesses see Note [Heap memory barriers] in SMP.h. #if defined(THREADED_RTS) -#define prim_read_barrier prim %read_barrier() #define prim_write_barrier prim %write_barrier() // See Note [ThreadSanitizer and fences] -#define RELEASE_FENCE prim %write_barrier() -#define ACQUIRE_FENCE prim %read_barrier() +#define RELEASE_FENCE prim %release_fence() +#define ACQUIRE_FENCE prim %acquire_fence() #else -#define prim_read_barrier /* nothing */ -#define prim_write_barrier /* nothing */ #define RELEASE_FENCE /* nothing */ #define ACQUIRE_FENCE /* nothing */ #endif /* THREADED_RTS */ ===================================== rts/include/Stg.h ===================================== @@ -392,7 +392,7 @@ external prototype return neither of these types to workaround #11395. #endif #include "stg/Prim.h" /* ghc-prim fallbacks */ -#include "stg/SMP.h" // write_barrier() inline is required +#include "stg/SMP.h" /* ----------------------------------------------------------------------------- Moving Floats and Doubles ===================================== rts/include/stg/SMP.h ===================================== @@ -108,20 +108,14 @@ EXTERN_INLINE void busy_wait_nop(void); /* * Various kinds of memory barrier. * write_barrier: prevents future stores occurring before preceding stores. - * store_load_barrier: prevents future loads occurring before preceding stores. - * load_load_barrier: prevents future loads occurring before earlier loads. * * Reference for these: "The JSR-133 Cookbook for Compiler Writers" * http://gee.cs.oswego.edu/dl/jmm/cookbook.html * * To check whether you got these right, try the test in * testsuite/tests/rts/testwsdeque.c - * This tests the work-stealing deque implementation, which relies on - * properly working store_load and load_load memory barriers. */ EXTERN_INLINE void write_barrier(void); -EXTERN_INLINE void store_load_barrier(void); -EXTERN_INLINE void load_load_barrier(void); /* * Note [Heap memory barriers] @@ -354,7 +348,7 @@ EXTERN_INLINE void load_load_barrier(void); * Exchange the value pointed to by p with w and return the former. This * function is used to acquire a lock. An acquire memory barrier is sufficient * for a lock operation because corresponding unlock operation issues a - * store-store barrier (write_barrier()) immediately before releasing the lock. + * store-store barrier (release-store) immediately before releasing the lock. */ EXTERN_INLINE StgWord xchg(StgPtr p, StgWord w) @@ -496,58 +490,6 @@ write_barrier(void) { #endif } -EXTERN_INLINE void -store_load_barrier(void) { -#if defined(NOSMP) - return; -#elif defined(i386_HOST_ARCH) - __asm__ __volatile__ ("lock; addl $0,0(%%esp)" : : : "memory"); -#elif defined(x86_64_HOST_ARCH) - __asm__ __volatile__ ("lock; addq $0,0(%%rsp)" : : : "memory"); -#elif defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) \ - || defined(powerpc64le_HOST_ARCH) - __asm__ __volatile__ ("sync" : : : "memory"); -#elif defined(s390x_HOST_ARCH) - __asm__ __volatile__ ("bcr 14,0" : : : "memory"); -#elif defined(arm_HOST_ARCH) - __asm__ __volatile__ ("dmb" : : : "memory"); -#elif defined(aarch64_HOST_ARCH) - __asm__ __volatile__ ("dmb sy" : : : "memory"); -#elif defined(riscv64_HOST_ARCH) - __asm__ __volatile__ ("fence w,r" : : : "memory"); -#elif defined(loongarch64_HOST_ARCH) - __asm__ __volatile__ ("dbar 0" : : : "memory"); -#else -#error memory barriers unimplemented on this architecture -#endif -} - -EXTERN_INLINE void -load_load_barrier(void) { -#if defined(NOSMP) - return; -#elif defined(i386_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(x86_64_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) \ - || defined(powerpc64le_HOST_ARCH) - __asm__ __volatile__ ("lwsync" : : : "memory"); -#elif defined(s390x_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(arm_HOST_ARCH) - __asm__ __volatile__ ("dmb" : : : "memory"); -#elif defined(aarch64_HOST_ARCH) - __asm__ __volatile__ ("dmb ld" : : : "memory"); -#elif defined(riscv64_HOST_ARCH) - __asm__ __volatile__ ("fence r,r" : : : "memory"); -#elif defined(loongarch64_HOST_ARCH) - __asm__ __volatile__ ("dbar 0" : : : "memory"); -#else -#error memory barriers unimplemented on this architecture -#endif -} - // Load a pointer from a memory location that might be being modified // concurrently. This prevents the compiler from optimising away // multiple loads of the memory location, as it might otherwise do in @@ -587,11 +529,7 @@ load_load_barrier(void) { #else /* !THREADED_RTS */ EXTERN_INLINE void write_barrier(void); -EXTERN_INLINE void store_load_barrier(void); -EXTERN_INLINE void load_load_barrier(void); EXTERN_INLINE void write_barrier () {} /* nothing */ -EXTERN_INLINE void store_load_barrier() {} /* nothing */ -EXTERN_INLINE void load_load_barrier () {} /* nothing */ // Relaxed atomic operations #define RELAXED_LOAD(ptr) *ptr ===================================== rts/sm/Evac.c ===================================== @@ -1394,8 +1394,7 @@ selector_loop: // the same selector thunk. SET_INFO((StgClosure*)p, (StgInfoTable *)info_ptr); OVERWRITING_CLOSURE((StgClosure*)p); - SET_INFO((StgClosure*)p, &stg_WHITEHOLE_info); - write_barrier(); + SET_INFO_RELEASE((StgClosure*)p, &stg_WHITEHOLE_info); #if defined(PARALLEL_GC) abort(); // LDV is incompatible with parallel GC #endif ===================================== rts/sm/GC.c ===================================== @@ -1508,7 +1508,6 @@ waitForGcThreads (Capability *cap, bool idle_cap[]) if (i == me || idle_cap[i]) { continue; } if (SEQ_CST_LOAD(&gc_threads[i]->wakeup) != GC_THREAD_STANDING_BY) { prodCapability(getCapability(i), cap->running_task); - write_barrier(); interruptCapability(getCapability(i)); } } ===================================== rts/sm/GCAux.c ===================================== @@ -91,8 +91,8 @@ isAlive(StgClosure *p) return TAG_CLOSURE(tag,(StgClosure*)UN_FORWARDING_PTR(info)); } + ACQUIRE_FENCE_ON(&q->header.info); info = INFO_PTR_TO_STRUCT(info); - load_load_barrier(); switch (info->type) { ===================================== rts/sm/Sanity.c ===================================== @@ -355,8 +355,7 @@ checkClosure( const StgClosure* p ) p = UNTAG_CONST_CLOSURE(p); - info = p->header.info; - load_load_barrier(); + info = ACQUIRE_LOAD(&p->header.info); if (IS_FORWARDING_PTR(info)) { barf("checkClosure: found EVACUATED closure %d", info->type); @@ -367,7 +366,6 @@ checkClosure( const StgClosure* p ) #endif info = INFO_PTR_TO_STRUCT(info); - load_load_barrier(); switch (info->type) { @@ -772,8 +770,7 @@ checkSTACK (StgStack *stack) void checkTSO(StgTSO *tso) { - const StgInfoTable *info = (const StgInfoTable*) tso->_link->header.info; - load_load_barrier(); + const StgInfoTable *info = (const StgInfoTable*) ACQUIRE_LOAD(&tso->_link)->header.info; ASSERT(tso->_link == END_TSO_QUEUE || info == &stg_MVAR_TSO_QUEUE_info || ===================================== testsuite/tests/rts/testwsdeque.c ===================================== @@ -34,47 +34,25 @@ void * myStealWSDeque_ (WSDeque *q, uint32_t n) { void * stolen; - StgWord b,t; // Can't do this on someone else's spark pool: // ASSERT_WSDEQUE_INVARIANTS(q); // NB. these loads must be ordered, otherwise there is a race // between steal and pop. - t = q->top; - load_load_barrier(); - b = q->bottom; + StgWord t = ACQUIRE_LOAD(&q->top); + SEQ_CST_FENCE(); + StgWord b = ACQUIRE_LOAD(&q->bottom); - // NB. b and t are unsigned; we need a signed value for the test - // below, because it is possible that t > b during a - // concurrent popWSQueue() operation. - if ((long)b - (long)t <= 0 ) { - return NULL; /* already looks empty, abort */ + void *result = NULL; + if (t < b) { + /* Non-empty queue */ + result = RELAXED_LOAD(&q->elements[t % q->size]); + if (!cas_top(q, t, t+1)) { + return NULL; + } } - // NB. the load of q->bottom must be ordered before the load of - // q->elements[t & q-> moduloSize]. See comment "KG:..." below - // and Ticket #13633. - load_load_barrier(); - /* now access array, see pushBottom() */ - stolen = q->elements[t & q->moduloSize]; - - /* now decide whether we have won */ - if ( !(CASTOP(&(q->top),t,t+1)) ) { - /* lost the race, someone else has changed top in the meantime */ - return NULL; - } /* else: OK, top has been incremented by the cas call */ - - // debugBelch("stealWSDeque_: t=%d b=%d\n", t, b); - -// Can't do this on someone else's spark pool: -// ASSERT_WSDEQUE_INVARIANTS(q); - - bufs[n] ++; - if (bufs[n] == BUF) { bufs[n] = 0; } - last_b[n][bufs[n]] = b; - last_t[n][bufs[n]] = t; - last_v[n][bufs[n]] = (StgWord)stolen; - return stolen; + return result; } void * View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f96a528ffe6242771ce4725b7979a750b6b38279...c7795e1f7b1329fc82d731a48cddd0b6f0900c6b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f96a528ffe6242771ce4725b7979a750b6b38279...c7795e1f7b1329fc82d731a48cddd0b6f0900c6b You're receiving 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 Jun 11 11:03:39 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 11 Jun 2023 07:03:39 -0400 Subject: [Git][ghc/ghc][wip/T23210] 155 commits: Replace the implementation of CodeBuffers with unboxed types Message-ID: <6485aa0b49e1e_111d63dc1d7f4157043@gitlab.mail> Ben Gamari pushed to branch wip/T23210 at Glasgow Haskell Compiler / GHC Commits: fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - e459f77e by Ben Gamari at 2023-06-11T07:00:01-04:00 rts: Tighten up invariants of PACK - - - - - 54ea1e2d by Ben Gamari at 2023-06-11T07:03:30-04:00 StgToByteCode: Don't assume that data con workers are nullary Previously StgToByteCode assumed that all data-con workers were of a nullary representation. This is not a valid assumption, as seen in #23210, where an unsaturated application of a unary data constructor's worker resulted in invalid bytecode. Sadly, I have not yet been able to reduce a minimal testcase for this. Fixes #23210. - - - - - 7c44b201 by Ben Gamari at 2023-06-11T07:03:30-04:00 StgToByteCode: Fix handling of Addr# literals Previously we assumed that all unlifted types were Addr#. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - HACKING.md - compiler/GHC.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types/Prim.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CallerCC.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/204c825fdc937c99371c330c6d56d2cf69fa7e42...7c44b201ff859a17058d6e4efacfd0f760a993af -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/204c825fdc937c99371c330c6d56d2cf69fa7e42...7c44b201ff859a17058d6e4efacfd0f760a993af You're receiving 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 Jun 11 11:17:37 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sun, 11 Jun 2023 07:17:37 -0400 Subject: [Git][ghc/ghc][wip/tsan/no-barriers] 6 commits: compiler: Drop MO_WriteBarrier Message-ID: <6485ad51e0c15_111d63c7c40159770@gitlab.mail> Sven Tennie pushed to branch wip/tsan/no-barriers at Glasgow Haskell Compiler / GHC Commits: 5a686e5e by Sven Tennie at 2023-06-11T11:09:53+00:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier This is no longer used. - - - - - 1bdbcea4 by Ben Gamari at 2023-06-11T11:10:38+00:00 rts: Drop load_store_barrier() This is no longer used. - - - - - 23e1a70f by Ben Gamari at 2023-06-11T11:10:38+00:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 2233111e by Ben Gamari at 2023-06-11T11:10:39+00:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 7c50fbc8 by Sven Tennie at 2023-06-11T11:16:25+00:00 compiler: Drop MO_ReadBarrier - - - - - c2af6875 by Ben Gamari at 2023-06-11T11:17:00+00:00 rts: Drop load_load_barrier This is no longer used. - - - - - 18 changed files: - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/StgToCmm/Prim.hs - rts/PrimOps.cmm - rts/RtsSymbols.c - rts/Sparks.c - rts/TopHandler.c - rts/include/Cmm.h - rts/include/stg/SMP.h - rts/sm/GCAux.c - rts/sm/Sanity.c - testsuite/tests/rts/testwsdeque.c Changes: ===================================== compiler/GHC/Cmm/MachOp.hs ===================================== @@ -670,8 +670,6 @@ data CallishMachOp | MO_SubIntC Width | MO_U_Mul2 Width - | MO_ReadBarrier - | MO_WriteBarrier | MO_Touch -- Keep variables live (when using interior pointers) -- Prefetch ===================================== compiler/GHC/Cmm/Parser.y ===================================== @@ -1119,8 +1119,6 @@ callishMachOps platform = listToUFM $ ( "acquire_fence", (MO_AcquireFence,)), ( "release_fence", (MO_ReleaseFence,)), - ( "read_barrier", (MO_ReadBarrier,)), - ( "write_barrier", (MO_WriteBarrier,)), ( "memcpy", memcpyLikeTweakArgs MO_Memcpy ), ( "memset", memcpyLikeTweakArgs MO_Memset ), ( "memmove", memcpyLikeTweakArgs MO_Memmove ), ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -1560,9 +1560,6 @@ genCCall target dest_regs arg_regs bid = do -- Memory Ordering MO_AcquireFence -> return (unitOL DMBISH, Nothing) MO_ReleaseFence -> return (unitOL DMBISH, Nothing) - -- TODO DMBSY is probably *way* too much! - MO_ReadBarrier -> return (unitOL DMBSY, Nothing) - MO_WriteBarrier -> return (unitOL DMBSY, Nothing) MO_Touch -> return (nilOL, Nothing) -- Keep variables live (when using interior pointers) -- Prefetch MO_Prefetch_Data _n -> return (nilOL, Nothing) -- Prefetch hint. ===================================== compiler/GHC/CmmToAsm/PPC/CodeGen.hs ===================================== @@ -1131,11 +1131,6 @@ genCCall (PrimTarget MO_AcquireFence) _ _ genCCall (PrimTarget MO_ReleaseFence) _ _ = return $ unitOL LWSYNC -genCCall (PrimTarget MO_ReadBarrier) _ _ - = return $ unitOL LWSYNC -genCCall (PrimTarget MO_WriteBarrier) _ _ - = return $ unitOL LWSYNC - genCCall (PrimTarget MO_Touch) _ _ = return $ nilOL @@ -2099,8 +2094,6 @@ genCCall' config gcp target dest_regs args MO_AddIntC {} -> unsupported MO_SubIntC {} -> unsupported MO_U_Mul2 {} -> unsupported - MO_ReadBarrier -> unsupported - MO_WriteBarrier -> unsupported MO_AcquireFence -> unsupported MO_ReleaseFence -> unsupported MO_Touch -> unsupported ===================================== compiler/GHC/CmmToAsm/Wasm/FromCmm.hs ===================================== @@ -1188,8 +1188,6 @@ lower_CallishMachOp lbl MO_F32_Sqrt rs xs = lower_CMO_Un_Homo lbl "sqrtf" rs xs lower_CallishMachOp lbl (MO_UF_Conv w0) rs xs = lower_MO_UF_Conv lbl w0 rs xs lower_CallishMachOp _ MO_AcquireFence _ _ = pure $ WasmStatements WasmNop lower_CallishMachOp _ MO_ReleaseFence _ _ = pure $ WasmStatements WasmNop -lower_CallishMachOp _ MO_ReadBarrier _ _ = pure $ WasmStatements WasmNop -lower_CallishMachOp _ MO_WriteBarrier _ _ = pure $ WasmStatements WasmNop lower_CallishMachOp _ MO_Touch _ _ = pure $ WasmStatements WasmNop lower_CallishMachOp _ (MO_Prefetch_Data {}) _ _ = pure $ WasmStatements WasmNop lower_CallishMachOp lbl (MO_Memcpy {}) [] xs = do ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -2162,8 +2162,6 @@ genSimplePrim bid (MO_Memcmp align) [res] [dst,src,n] = genMemCmp bid a genSimplePrim bid (MO_Memset align) [] [dst,c,n] = genMemSet bid align dst c n genSimplePrim _ MO_AcquireFence [] [] = return nilOL -- barriers compile to no code on x86/x86-64; genSimplePrim _ MO_ReleaseFence [] [] = return nilOL -- we keep it this long in order to prevent earlier optimisations. -genSimplePrim _ MO_ReadBarrier [] [] = return nilOL -- barriers compile to no code on x86/x86-64; -genSimplePrim _ MO_WriteBarrier [] [] = return nilOL -- we keep it this long in order to prevent earlier optimisations. genSimplePrim _ MO_Touch [] [_] = return nilOL genSimplePrim _ (MO_Prefetch_Data n) [] [src] = genPrefetchData n src genSimplePrim _ (MO_BSwap width) [dst] [src] = genByteSwap width dst src ===================================== compiler/GHC/CmmToC.hs ===================================== @@ -951,8 +951,6 @@ pprCallishMachOp_for_C mop MO_F32_Fabs -> text "fabsf" MO_AcquireFence -> unsupported MO_ReleaseFence -> unsupported - MO_ReadBarrier -> text "load_load_barrier" - MO_WriteBarrier -> text "write_barrier" MO_Memcpy _ -> text "__builtin_memcpy" MO_Memset _ -> text "__builtin_memset" MO_Memmove _ -> text "__builtin_memmove" ===================================== compiler/GHC/CmmToLlvm/CodeGen.hs ===================================== @@ -171,21 +171,6 @@ getInstrinct fname retTy parTys = fty = LMFunction funSig in getInstrinct2 fname fty --- | Memory barrier instruction for LLVM >= 3.0 -barrier :: LlvmM StmtData -barrier = do - let s = Fence False SyncSeqCst - return (unitOL s, []) - --- | Insert a 'barrier', unless the target platform is in the provided list of --- exceptions (where no code will be emitted instead). -barrierUnless :: [Arch] -> LlvmM StmtData -barrierUnless exs = do - platform <- getPlatform - if platformArch platform `elem` exs - then return (nilOL, []) - else barrier - -- | Foreign Calls genCall :: ForeignTarget -> [CmmFormal] -> [CmmActual] -> LlvmM StmtData @@ -196,15 +181,6 @@ genCall (PrimTarget MO_AcquireFence) _ _ = runStmtsDecls $ genCall (PrimTarget MO_ReleaseFence) _ _ = runStmtsDecls $ statement $ Fence False SyncRelease -genCall (PrimTarget MO_ReadBarrier) _ _ = - barrierUnless [ArchX86, ArchX86_64] - -genCall (PrimTarget MO_WriteBarrier) _ _ = - barrierUnless [ArchX86, ArchX86_64] - -genCall (PrimTarget MO_Touch) _ _ = - return (nilOL, []) - genCall (PrimTarget (MO_UF_Conv w)) [dst] [e] = runStmtsDecls $ do dstV <- getCmmRegW (CmmLocal dst) let ty = cmmToLlvmType $ localRegType dst @@ -1013,8 +989,6 @@ cmmPrimOpFunctions mop = do -- We support MO_U_Mul2 through ordinary LLVM mul instruction, see the -- appropriate case of genCall. MO_U_Mul2 {} -> unsupported - MO_ReadBarrier -> unsupported - MO_WriteBarrier -> unsupported MO_ReleaseFence -> unsupported MO_AcquireFence -> unsupported MO_Touch -> unsupported ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -2177,7 +2177,7 @@ doWritePtrArrayOp addr idx val -- This write barrier is to ensure that the heap writes to the object -- referred to by val have happened before we write val into the array. -- See #12469 for details. - emitPrimCall [] MO_WriteBarrier [] + emitPrimCall [] MO_AcquireFence [] mkBasicIndexedWrite hdr_size addr ty idx val emit (setInfo addr (CmmLit (CmmLabel mkMAP_DIRTY_infoLabel))) @@ -3048,7 +3048,7 @@ doWriteSmallPtrArrayOp addr idx val = do mkBasicIndexedRead NaturallyAligned (smallArrPtrsHdrSize profile) Nothing ty tmp addr ty idx whenUpdRemSetEnabled $ emitUpdRemSetPush (CmmReg (CmmLocal tmp)) - emitPrimCall [] MO_WriteBarrier [] -- #12469 + emitPrimCall [] MO_AcquireFence [] -- #12469 mkBasicIndexedWrite (smallArrPtrsHdrSize profile) addr ty idx val emit (setInfo addr (CmmLit (CmmLabel mkSMAP_DIRTY_infoLabel))) ===================================== rts/PrimOps.cmm ===================================== @@ -2505,8 +2505,8 @@ stg_unpackClosurezh ( P_ closure ) { W_ info, ptrs, nptrs, p, ptrs_arr, dat_arr; MAYBE_GC_P(stg_unpackClosurezh, closure); - info = %GET_STD_INFO(UNTAG(closure)); - prim_read_barrier; + info = GET_INFO_ACQUIRE(UNTAG(closure)); + info = INFO_PTR_TO_INFO_TABLE(info); ptrs = TO_W_(%INFO_PTRS(info)); nptrs = TO_W_(%INFO_NPTRS(info)); @@ -2820,8 +2820,7 @@ stg_noDuplicatezh /* no arg list: explicit stack layout */ stg_getApStackValzh ( P_ ap_stack, W_ offset ) { W_ ap_stackinfo; - ap_stackinfo = %INFO_PTR(UNTAG(ap_stack)); - prim_read_barrier; + ap_stackinfo = GET_INFO_ACQUIRE(UNTAG(ap_stack)); if (ap_stackinfo == stg_AP_STACK_info) { return (1,StgAP_STACK_payload(ap_stack,offset)); } else { ===================================== rts/RtsSymbols.c ===================================== @@ -910,8 +910,6 @@ extern char **environ; SymI_HasProto(hs_spt_keys) \ SymI_HasProto(hs_spt_key_count) \ SymI_HasProto(write_barrier) \ - SymI_HasProto(store_load_barrier) \ - SymI_HasProto(load_load_barrier) \ SymI_HasProto(cas) \ SymI_HasProto(_assertFail) \ SymI_HasProto(keepCAFs) \ ===================================== rts/Sparks.c ===================================== @@ -209,8 +209,7 @@ pruneSparkQueue (bool nonmovingMarkFinished, Capability *cap) cap->spark_stats.fizzled++; traceEventSparkFizzle(cap); } else { - info = RELAXED_LOAD(&spark->header.info); - load_load_barrier(); + info = ACQUIRE_LOAD(&spark->header.info); if (IS_FORWARDING_PTR(info)) { tmp = (StgClosure*)UN_FORWARDING_PTR(info); /* if valuable work: shift inside the pool */ ===================================== rts/TopHandler.c ===================================== @@ -32,8 +32,7 @@ StgTSO *getTopHandlerThread(void) { // topHandlerPtr was never initialised return NULL; } - const StgInfoTable *info = weak->header.info; - load_load_barrier(); + const StgInfoTable *info = ACQUIRE_LOAD(&weak->header.info); if (info == &stg_WEAK_info) { StgClosure *key = ((StgWeak*)weak)->key; ===================================== rts/include/Cmm.h ===================================== @@ -681,7 +681,6 @@ // For discussion of how these are used to fence heap object // accesses see Note [Heap memory barriers] in SMP.h. #if defined(THREADED_RTS) -#define prim_read_barrier prim %read_barrier() #define prim_write_barrier prim %write_barrier() // See Note [ThreadSanitizer and fences] @@ -690,8 +689,6 @@ #else -#define prim_read_barrier /* nothing */ -#define prim_write_barrier /* nothing */ #define RELEASE_FENCE /* nothing */ #define ACQUIRE_FENCE /* nothing */ #endif /* THREADED_RTS */ ===================================== rts/include/stg/SMP.h ===================================== @@ -108,20 +108,14 @@ EXTERN_INLINE void busy_wait_nop(void); /* * Various kinds of memory barrier. * write_barrier: prevents future stores occurring before preceding stores. - * store_load_barrier: prevents future loads occurring before preceding stores. - * load_load_barrier: prevents future loads occurring before earlier loads. * * Reference for these: "The JSR-133 Cookbook for Compiler Writers" * http://gee.cs.oswego.edu/dl/jmm/cookbook.html * * To check whether you got these right, try the test in * testsuite/tests/rts/testwsdeque.c - * This tests the work-stealing deque implementation, which relies on - * properly working store_load and load_load memory barriers. */ EXTERN_INLINE void write_barrier(void); -EXTERN_INLINE void store_load_barrier(void); -EXTERN_INLINE void load_load_barrier(void); /* * Note [Heap memory barriers] @@ -496,58 +490,6 @@ write_barrier(void) { #endif } -EXTERN_INLINE void -store_load_barrier(void) { -#if defined(NOSMP) - return; -#elif defined(i386_HOST_ARCH) - __asm__ __volatile__ ("lock; addl $0,0(%%esp)" : : : "memory"); -#elif defined(x86_64_HOST_ARCH) - __asm__ __volatile__ ("lock; addq $0,0(%%rsp)" : : : "memory"); -#elif defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) \ - || defined(powerpc64le_HOST_ARCH) - __asm__ __volatile__ ("sync" : : : "memory"); -#elif defined(s390x_HOST_ARCH) - __asm__ __volatile__ ("bcr 14,0" : : : "memory"); -#elif defined(arm_HOST_ARCH) - __asm__ __volatile__ ("dmb" : : : "memory"); -#elif defined(aarch64_HOST_ARCH) - __asm__ __volatile__ ("dmb sy" : : : "memory"); -#elif defined(riscv64_HOST_ARCH) - __asm__ __volatile__ ("fence w,r" : : : "memory"); -#elif defined(loongarch64_HOST_ARCH) - __asm__ __volatile__ ("dbar 0" : : : "memory"); -#else -#error memory barriers unimplemented on this architecture -#endif -} - -EXTERN_INLINE void -load_load_barrier(void) { -#if defined(NOSMP) - return; -#elif defined(i386_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(x86_64_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) \ - || defined(powerpc64le_HOST_ARCH) - __asm__ __volatile__ ("lwsync" : : : "memory"); -#elif defined(s390x_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(arm_HOST_ARCH) - __asm__ __volatile__ ("dmb" : : : "memory"); -#elif defined(aarch64_HOST_ARCH) - __asm__ __volatile__ ("dmb ld" : : : "memory"); -#elif defined(riscv64_HOST_ARCH) - __asm__ __volatile__ ("fence r,r" : : : "memory"); -#elif defined(loongarch64_HOST_ARCH) - __asm__ __volatile__ ("dbar 0" : : : "memory"); -#else -#error memory barriers unimplemented on this architecture -#endif -} - // Load a pointer from a memory location that might be being modified // concurrently. This prevents the compiler from optimising away // multiple loads of the memory location, as it might otherwise do in @@ -587,11 +529,7 @@ load_load_barrier(void) { #else /* !THREADED_RTS */ EXTERN_INLINE void write_barrier(void); -EXTERN_INLINE void store_load_barrier(void); -EXTERN_INLINE void load_load_barrier(void); EXTERN_INLINE void write_barrier () {} /* nothing */ -EXTERN_INLINE void store_load_barrier() {} /* nothing */ -EXTERN_INLINE void load_load_barrier () {} /* nothing */ // Relaxed atomic operations #define RELAXED_LOAD(ptr) *ptr ===================================== rts/sm/GCAux.c ===================================== @@ -91,8 +91,8 @@ isAlive(StgClosure *p) return TAG_CLOSURE(tag,(StgClosure*)UN_FORWARDING_PTR(info)); } + ACQUIRE_FENCE_ON(&q->header.info); info = INFO_PTR_TO_STRUCT(info); - load_load_barrier(); switch (info->type) { ===================================== rts/sm/Sanity.c ===================================== @@ -355,8 +355,7 @@ checkClosure( const StgClosure* p ) p = UNTAG_CONST_CLOSURE(p); - info = p->header.info; - load_load_barrier(); + info = ACQUIRE_LOAD(&p->header.info); if (IS_FORWARDING_PTR(info)) { barf("checkClosure: found EVACUATED closure %d", info->type); @@ -367,7 +366,6 @@ checkClosure( const StgClosure* p ) #endif info = INFO_PTR_TO_STRUCT(info); - load_load_barrier(); switch (info->type) { @@ -772,8 +770,7 @@ checkSTACK (StgStack *stack) void checkTSO(StgTSO *tso) { - const StgInfoTable *info = (const StgInfoTable*) tso->_link->header.info; - load_load_barrier(); + const StgInfoTable *info = (const StgInfoTable*) ACQUIRE_LOAD(&tso->_link)->header.info; ASSERT(tso->_link == END_TSO_QUEUE || info == &stg_MVAR_TSO_QUEUE_info || ===================================== testsuite/tests/rts/testwsdeque.c ===================================== @@ -34,47 +34,25 @@ void * myStealWSDeque_ (WSDeque *q, uint32_t n) { void * stolen; - StgWord b,t; // Can't do this on someone else's spark pool: // ASSERT_WSDEQUE_INVARIANTS(q); // NB. these loads must be ordered, otherwise there is a race // between steal and pop. - t = q->top; - load_load_barrier(); - b = q->bottom; + StgWord t = ACQUIRE_LOAD(&q->top); + SEQ_CST_FENCE(); + StgWord b = ACQUIRE_LOAD(&q->bottom); - // NB. b and t are unsigned; we need a signed value for the test - // below, because it is possible that t > b during a - // concurrent popWSQueue() operation. - if ((long)b - (long)t <= 0 ) { - return NULL; /* already looks empty, abort */ + void *result = NULL; + if (t < b) { + /* Non-empty queue */ + result = RELAXED_LOAD(&q->elements[t % q->size]); + if (!cas_top(q, t, t+1)) { + return NULL; + } } - // NB. the load of q->bottom must be ordered before the load of - // q->elements[t & q-> moduloSize]. See comment "KG:..." below - // and Ticket #13633. - load_load_barrier(); - /* now access array, see pushBottom() */ - stolen = q->elements[t & q->moduloSize]; - - /* now decide whether we have won */ - if ( !(CASTOP(&(q->top),t,t+1)) ) { - /* lost the race, someone else has changed top in the meantime */ - return NULL; - } /* else: OK, top has been incremented by the cas call */ - - // debugBelch("stealWSDeque_: t=%d b=%d\n", t, b); - -// Can't do this on someone else's spark pool: -// ASSERT_WSDEQUE_INVARIANTS(q); - - bufs[n] ++; - if (bufs[n] == BUF) { bufs[n] = 0; } - last_b[n][bufs[n]] = b; - last_t[n][bufs[n]] = t; - last_v[n][bufs[n]] = (StgWord)stolen; - return stolen; + return result; } void * View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c7795e1f7b1329fc82d731a48cddd0b6f0900c6b...c2af6875d84404724a864eba3be278d77d1d5837 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c7795e1f7b1329fc82d731a48cddd0b6f0900c6b...c2af6875d84404724a864eba3be278d77d1d5837 You're receiving 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 Jun 11 11:37:09 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 11 Jun 2023 07:37:09 -0400 Subject: [Git][ghc/ghc][wip/T23210] 2 commits: StgToByteCode: Don't assume that data con workers are nullary Message-ID: <6485b1e590459_111d63c55f81626c9@gitlab.mail> Ben Gamari pushed to branch wip/T23210 at Glasgow Haskell Compiler / GHC Commits: 07770c4d by Ben Gamari at 2023-06-11T07:36:54-04:00 StgToByteCode: Don't assume that data con workers are nullary Previously StgToByteCode assumed that all data-con workers were of a nullary representation. This is not a valid assumption, as seen in #23210, where an unsaturated application of a unary data constructor's worker resulted in invalid bytecode. Sadly, I have not yet been able to reduce a minimal testcase for this. Fixes #23210. - - - - - acb14ce5 by Ben Gamari at 2023-06-11T07:36:54-04:00 StgToByteCode: Fix handling of Addr# literals Previously we assumed that all unlifted types were Addr#. - - - - - 3 changed files: - compiler/GHC/Stg/Utils.hs - compiler/GHC/StgToByteCode.hs - rts/Interpreter.c Changes: ===================================== compiler/GHC/Stg/Utils.hs ===================================== @@ -9,6 +9,7 @@ module GHC.Stg.Utils , idArgs , mkUnarisedId, mkUnarisedIds + , hasNoNonZeroWidthArguments ) where import GHC.Prelude @@ -16,6 +17,7 @@ import GHC.Prelude import GHC.Types.Id import GHC.Core.Type import GHC.Core.TyCon +import GHC.Core.Multiplicity ( scaledThing ) import GHC.Core.DataCon import GHC.Core ( AltCon(..) ) import GHC.Types.Tickish @@ -31,6 +33,13 @@ import GHC.Utils.Panic import GHC.Data.FastString +-- | Returns whether there are any arguments with a non-zero-width runtime +-- representation. +-- +-- Returns True if the datacon has no or /just/ zero-width arguments. +hasNoNonZeroWidthArgs :: DataCon -> Bool +hasNoNonZeroWidthArgs = all (isZeroBitTy . scaledThing) . dataConRepArgTys + mkUnarisedIds :: MonadUnique m => FastString -> [UnaryType] -> m [Id] mkUnarisedIds fs tys = mapM (mkUnarisedId fs) tys ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -18,6 +18,8 @@ import GHC.Prelude import GHC.Driver.DynFlags import GHC.Driver.Env +import GHC.Stg.Utils (hasNoNonZeroWidthArguments) + import GHC.ByteCode.Instr import GHC.ByteCode.Asm import GHC.ByteCode.Types @@ -1821,20 +1823,16 @@ pushAtom d p (StgVarArg var) -- PUSH_G doesn't tag constructors. So we use PACK here -- if we are dealing with nullary constructor. case isDataConWorkId_maybe var of - Just con -> do - massert (isNullaryRepDataCon con) - return (unitOL (PACK con 0), szb) + Just con | hasNoNonZeroWidthArguments con -> do + return (unitOL (PACK con 0), szb) - Nothing -- see Note [Generating code for top-level string literal bindings] - | isUnliftedType (idType var) -> do - massert (idType var `eqType` addrPrimTy) + _ | idType var `eqType` addrPrimTy -> return (unitOL (PUSH_ADDR (getName var)), szb) | otherwise -> do return (unitOL (PUSH_G (getName var)), szb) - pushAtom _ _ (StgLitArg lit) = pushLiteral True lit pushLiteral :: Bool -> Literal -> BcM (BCInstrList, ByteOff) ===================================== rts/Interpreter.c ===================================== @@ -1687,7 +1687,6 @@ run_BCO: // n_nptrs=1, n_ptrs=0. ASSERT(n_ptrs + n_nptrs == n_words || (n_nptrs == 1 && n_ptrs == 0)); ASSERT(n_ptrs + n_nptrs > 0); - //ASSERT(n_words > 0); // We shouldn't ever need to allocate nullary constructors for (int i = 0; i < n_words; i++) { con->payload[i] = (StgClosure*)SpW(i); } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7c44b201ff859a17058d6e4efacfd0f760a993af...acb14ce56814a17ee700acdb23fc5c1684cc5f90 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7c44b201ff859a17058d6e4efacfd0f760a993af...acb14ce56814a17ee700acdb23fc5c1684cc5f90 You're receiving 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 Jun 11 11:38:14 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 11 Jun 2023 07:38:14 -0400 Subject: [Git][ghc/ghc][wip/T23210] 2 commits: StgToByteCode: Don't assume that data con workers are nullary Message-ID: <6485b22699331_111d63c5aa816345@gitlab.mail> Ben Gamari pushed to branch wip/T23210 at Glasgow Haskell Compiler / GHC Commits: a1e32455 by Ben Gamari at 2023-06-11T07:38:08-04:00 StgToByteCode: Don't assume that data con workers are nullary Previously StgToByteCode assumed that all data-con workers were of a nullary representation. This is not a valid assumption, as seen in #23210, where an unsaturated application of a unary data constructor's worker resulted in invalid bytecode. Sadly, I have not yet been able to reduce a minimal testcase for this. Fixes #23210. - - - - - e4e7f5d6 by Ben Gamari at 2023-06-11T07:38:08-04:00 StgToByteCode: Fix handling of Addr# literals Previously we assumed that all unlifted types were Addr#. - - - - - 3 changed files: - compiler/GHC/Stg/Utils.hs - compiler/GHC/StgToByteCode.hs - rts/Interpreter.c Changes: ===================================== compiler/GHC/Stg/Utils.hs ===================================== @@ -9,6 +9,7 @@ module GHC.Stg.Utils , idArgs , mkUnarisedId, mkUnarisedIds + , hasNoNonZeroWidthArgs ) where import GHC.Prelude @@ -16,6 +17,7 @@ import GHC.Prelude import GHC.Types.Id import GHC.Core.Type import GHC.Core.TyCon +import GHC.Core.Multiplicity ( scaledThing ) import GHC.Core.DataCon import GHC.Core ( AltCon(..) ) import GHC.Types.Tickish @@ -31,6 +33,13 @@ import GHC.Utils.Panic import GHC.Data.FastString +-- | Returns whether there are any arguments with a non-zero-width runtime +-- representation. +-- +-- Returns True if the datacon has no or /just/ zero-width arguments. +hasNoNonZeroWidthArgs :: DataCon -> Bool +hasNoNonZeroWidthArgs = all (isZeroBitTy . scaledThing) . dataConRepArgTys + mkUnarisedIds :: MonadUnique m => FastString -> [UnaryType] -> m [Id] mkUnarisedIds fs tys = mapM (mkUnarisedId fs) tys ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -18,6 +18,8 @@ import GHC.Prelude import GHC.Driver.DynFlags import GHC.Driver.Env +import GHC.Stg.Utils (hasNoNonZeroWidthArgs) + import GHC.ByteCode.Instr import GHC.ByteCode.Asm import GHC.ByteCode.Types @@ -1821,20 +1823,16 @@ pushAtom d p (StgVarArg var) -- PUSH_G doesn't tag constructors. So we use PACK here -- if we are dealing with nullary constructor. case isDataConWorkId_maybe var of - Just con -> do - massert (isNullaryRepDataCon con) - return (unitOL (PACK con 0), szb) + Just con | hasNoNonZeroWidthArgs con -> do + return (unitOL (PACK con 0), szb) - Nothing -- see Note [Generating code for top-level string literal bindings] - | isUnliftedType (idType var) -> do - massert (idType var `eqType` addrPrimTy) + _ | idType var `eqType` addrPrimTy -> return (unitOL (PUSH_ADDR (getName var)), szb) | otherwise -> do return (unitOL (PUSH_G (getName var)), szb) - pushAtom _ _ (StgLitArg lit) = pushLiteral True lit pushLiteral :: Bool -> Literal -> BcM (BCInstrList, ByteOff) ===================================== rts/Interpreter.c ===================================== @@ -1687,7 +1687,6 @@ run_BCO: // n_nptrs=1, n_ptrs=0. ASSERT(n_ptrs + n_nptrs == n_words || (n_nptrs == 1 && n_ptrs == 0)); ASSERT(n_ptrs + n_nptrs > 0); - //ASSERT(n_words > 0); // We shouldn't ever need to allocate nullary constructors for (int i = 0; i < n_words; i++) { con->payload[i] = (StgClosure*)SpW(i); } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/acb14ce56814a17ee700acdb23fc5c1684cc5f90...e4e7f5d674e9fb3286e29c9b41837dc68ad07ba8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/acb14ce56814a17ee700acdb23fc5c1684cc5f90...e4e7f5d674e9fb3286e29c9b41837dc68ad07ba8 You're receiving 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 Jun 11 12:06:19 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Sun, 11 Jun 2023 08:06:19 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/romes/eqsat-pmc Message-ID: <6485b8bb5856c_111d63e06bdc4180534@gitlab.mail> Rodrigo Mesquita pushed new branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/eqsat-pmc You're receiving 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 Jun 11 12:27:37 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Sun, 11 Jun 2023 08:27:37 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23505 Message-ID: <6485bdb968ef7_111d63c7c4019882d@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/T23505 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23505 You're receiving 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 Jun 11 12:31:33 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Sun, 11 Jun 2023 08:31:33 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/T23505 Message-ID: <6485bea55ffb0_111d635437d8199022@gitlab.mail> Krzysztof Gogolewski deleted branch wip/T23505 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 Jun 11 12:36:14 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Sun, 11 Jun 2023 08:36:14 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23176 Message-ID: <6485bfbe45bd0_111d63e06bdc4199223@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/T23176 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23176 You're receiving 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 Jun 11 13:35:16 2023 From: gitlab at gitlab.haskell.org (Ziyang Liu (@zliu41)) Date: Sun, 11 Jun 2023 09:35:16 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/zliu41/sm_builtin_rules Message-ID: <6485cd947e845_111d635437d821970@gitlab.mail> Ziyang Liu pushed new branch wip/zliu41/sm_builtin_rules at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/zliu41/sm_builtin_rules You're receiving 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 Jun 11 13:35:54 2023 From: gitlab at gitlab.haskell.org (Ziyang Liu (@zliu41)) Date: Sun, 11 Jun 2023 09:35:54 -0400 Subject: [Git][ghc/ghc][wip/zliu41/sm_builtin_rules] sm_builtin_rules Message-ID: <6485cdbadc04c_111d63e06bdc42201ac@gitlab.mail> Ziyang Liu pushed to branch wip/zliu41/sm_builtin_rules at Glasgow Haskell Compiler / GHC Commits: a780d7c1 by Ziyang Liu at 2023-06-11T15:35:45+02:00 sm_builtin_rules - - - - - 9 changed files: - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Driver/Config/Core/Opt/Simplify.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs Changes: ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -138,6 +138,7 @@ getCoreToDo dflags hpt_rule_base extra_vars late_specialise = gopt Opt_LateSpecialise dflags static_args = gopt Opt_StaticArgumentTransformation dflags rules_on = gopt Opt_EnableRewriteRules dflags + builtin_rules_on = gopt Opt_EnableBuiltinRules dflags ww_on = gopt Opt_WorkerWrapper dflags static_ptrs = xopt LangExt.StaticPointers dflags profiling = ways dflags `hasWay` WayProf ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -239,34 +239,36 @@ seUnfoldingOpts env = sm_uf_opts (seMode env) -- See Note [The environments of the Simplify pass] data SimplMode = SimplMode -- See comments in GHC.Core.Opt.Simplify.Monad - { sm_phase :: !CompilerPhase - , sm_names :: ![String] -- ^ Name(s) of the phase - , sm_rules :: !Bool -- ^ Whether RULES are enabled - , sm_inline :: !Bool -- ^ Whether inlining is enabled - , sm_eta_expand :: !Bool -- ^ Whether eta-expansion is enabled - , sm_cast_swizzle :: !Bool -- ^ Do we swizzle casts past lambdas? - , 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_float_enable :: !FloatEnable -- ^ Whether to enable floating out + { sm_phase :: !CompilerPhase + , sm_names :: ![String] -- ^ Name(s) of the phase + , sm_rules :: !Bool -- ^ Whether RULES are enabled + , sm_builtin_rules :: !Bool -- ^ Whether built-in rules are enabled + , sm_inline :: !Bool -- ^ Whether inlining is enabled + , sm_eta_expand :: !Bool -- ^ Whether eta-expansion is enabled + , sm_cast_swizzle :: !Bool -- ^ Do we swizzle casts past lambdas? + , 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_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 ppr (SimplMode { sm_phase = p , sm_names = ss - , sm_rules = r, sm_inline = i - , sm_cast_swizzle = cs + , sm_rules = r, sm_builtin_rules = br + , sm_inline = i, sm_cast_swizzle = cs , sm_eta_expand = eta, sm_case_case = cc }) = text "SimplMode" <+> braces ( sep [ text "Phase =" <+> ppr p <+> brackets (text (concat $ intersperse "," ss)) <> comma , pp_flag i (text "inline") <> comma , pp_flag r (text "rules") <> comma + , pp_flag br (text "builtin-rules") <> comma , pp_flag eta (text "eta-expand") <> comma , pp_flag cs (text "cast-swizzle") <> comma , pp_flag cc (text "case-of-case") ]) ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -2484,7 +2484,8 @@ tryRules env rules fn args call_cont -} | Just (rule, rule_rhs) <- lookupRule ropts (getUnfoldingInRuleMatch env) - (activeRule (seMode env)) fn + (activeRule (seMode env)) + (sm_builtin_rules (seMode env)) fn (argInfoAppArgs args) rules -- Fire a rule for the function = do { logger <- getLogger ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -1822,7 +1822,7 @@ specLookupRule :: SpecEnv -> Id -> [CoreExpr] -> CompilerPhase -- Look up rules as if we were in this phase -> [CoreRule] -> Maybe (CoreRule, CoreExpr) specLookupRule env fn args phase rules - = lookupRule ropts in_scope_env is_active fn args rules + = lookupRule ropts in_scope_env is_active True fn args rules where dflags = se_dflags env in_scope = getSubstInScope (se_subst env) ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -523,6 +523,7 @@ map. -- successful. lookupRule :: RuleOpts -> InScopeEnv -> (Activation -> Bool) -- When rule is active + -> Bool -- Whether builtin rules are active -> Id -- Function head -> [CoreExpr] -- Args -> [CoreRule] -- Rules @@ -530,7 +531,7 @@ lookupRule :: RuleOpts -> InScopeEnv -- See Note [Extra args in the target] -- See comments on matchRule -lookupRule opts rule_env@(ISE in_scope _) is_active fn args rules +lookupRule opts rule_env@(ISE in_scope _) is_active builtin_is_active fn args rules = -- pprTrace "lookupRule" (ppr fn <+> ppr args $$ ppr rules $$ ppr in_scope) $ case go [] rules of [] -> Nothing @@ -547,7 +548,7 @@ lookupRule opts rule_env@(ISE in_scope _) is_active fn args rules go :: [(CoreRule,CoreExpr)] -> [CoreRule] -> [(CoreRule,CoreExpr)] go ms [] = ms go ms (r:rs) - | Just e <- matchRule opts rule_env is_active fn args' rough_args r + | Just e <- matchRule opts rule_env is_active builtin_is_active fn args' rough_args r = go ((r,mkTicks ticks e):ms) rs | otherwise = -- pprTrace "match failed" (ppr r $$ ppr args $$ @@ -645,7 +646,7 @@ start, in general eta expansion wastes work. SLPJ July 99 -} ------------------------------------ -matchRule :: RuleOpts -> InScopeEnv -> (Activation -> Bool) +matchRule :: RuleOpts -> InScopeEnv -> (Activation -> Bool) -> Bool -> Id -> [CoreExpr] -> [Maybe Name] -> CoreRule -> Maybe CoreExpr @@ -674,14 +675,13 @@ matchRule :: RuleOpts -> InScopeEnv -> (Activation -> Bool) -- NB: The 'surplus' argument e4 in the input is simply dropped. -- See Note [Extra args in the target] -matchRule opts rule_env _is_active fn args _rough_args +matchRule opts rule_env _is_active builtin_is_active fn args _rough_args (BuiltinRule { ru_try = match_fn }) --- Built-in rules can't be switched off, it seems - = case match_fn opts rule_env fn args of - Nothing -> Nothing - Just expr -> Just expr + = if builtin_is_active + then match_fn opts rule_env fn args + else Nothing -matchRule _ rule_env is_active _ args rough_args +matchRule _ rule_env is_active _ _ args rough_args (Rule { ru_name = rule_name, ru_act = act, ru_rough = tpl_tops , ru_bndrs = tpl_vars, ru_args = tpl_args, ru_rhs = rhs }) | not (is_active act) = Nothing @@ -1870,7 +1870,7 @@ ruleAppCheck_help env fn args rules rule_info opts rule | Just _ <- matchRule opts (ISE emptyInScopeSet (rc_id_unf env)) - noBlackList fn args rough_args rule + noBlackList True fn args rough_args rule = text "matches (which is very peculiar!)" rule_info _ (BuiltinRule {}) = text "does not match" ===================================== compiler/GHC/Driver/Config/Core/Opt/Simplify.hs ===================================== @@ -61,6 +61,7 @@ initSimplMode dflags phase name = SimplMode { sm_names = [name] , sm_phase = phase , sm_rules = gopt Opt_EnableRewriteRules dflags + , sm_builtin_rules = gopt Opt_EnableRewriteRules dflags , sm_eta_expand = gopt Opt_DoLambdaEtaExpansion dflags , sm_cast_swizzle = True , sm_inline = True ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -1273,7 +1273,7 @@ optLevelFlags -- see Note [Documenting optimisation flags] -- to 'build' but don't run the simplifier passes that -- would rewrite them back to cons cells! This seems -- silly, and matters for the GHCi debugger. - + , ([0,1,2], Opt_EnableBuiltinRules) , ([1,2], Opt_FloatIn) , ([1,2], Opt_FullLaziness) , ([1,2], Opt_IgnoreAsserts) ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -271,6 +271,7 @@ data GeneralFlag | Opt_UnboxSmallStrictFields | Opt_DictsCheap | Opt_EnableRewriteRules -- Apply rewrite rules during simplification + | Opt_EnableBuiltinRules -- Apply built-in rules during simplification | Opt_EnableThSpliceWarnings -- Enable warnings for TH splices | Opt_RegsGraph -- do graph coloring register allocation | Opt_RegsIterative -- do iterative coalescing graph coloring register allocation @@ -516,6 +517,7 @@ optimisationFlags = EnumSet.fromList , Opt_UnboxSmallStrictFields , Opt_DictsCheap , Opt_EnableRewriteRules + , Opt_EnableBuiltinRules , Opt_RegsGraph , Opt_RegsIterative , Opt_PedanticBottoms ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2340,6 +2340,7 @@ fFlagsDeps = [ flagSpec "eager-blackholing" Opt_EagerBlackHoling, flagSpec "embed-manifest" Opt_EmbedManifest, flagSpec "enable-rewrite-rules" Opt_EnableRewriteRules, + flagSpec "enable-builtin-rules" Opt_EnableBuiltinRules, flagSpec "enable-th-splice-warnings" Opt_EnableThSpliceWarnings, flagSpec "error-spans" Opt_ErrorSpans, flagSpec "excess-precision" Opt_ExcessPrecision, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a780d7c119072b702aea81d2927048f1bcbd791d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a780d7c119072b702aea81d2927048f1bcbd791d You're receiving 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 Jun 11 14:59:25 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sun, 11 Jun 2023 10:59:25 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] Implement MO_AtomicRead and MO_AtomicWrite Message-ID: <6485e14db0c7a_111d63e06bdc425553e@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: 5b3c11e1 by Sven Tennie at 2023-06-11T14:58:14+00:00 Implement MO_AtomicRead and MO_AtomicWrite - - - - - 4 changed files: - compiler/GHC/CmmToAsm/RV64/CodeGen.hs - compiler/GHC/CmmToAsm/RV64/Cond.hs - compiler/GHC/CmmToAsm/RV64/Instr.hs - compiler/GHC/CmmToAsm/RV64/Ppr.hs Changes: ===================================== compiler/GHC/CmmToAsm/RV64/CodeGen.hs ===================================== @@ -1577,8 +1577,12 @@ genCCall target dest_regs arg_regs bid = do -- Memory Ordering -- The concrete encoding is copied from load_load_barrier() and write_barrier() (SMP.h) - MO_ReadBarrier -> return (unitOL (DMBSY DmbRead), Nothing) - MO_WriteBarrier -> return (unitOL (DMBSY DmbWrite), Nothing) + -- TODO: This needs to be changed for https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10628 + -- The related C functions are: + -- atomic_thread_fence(memory_order_acquire); + -- atomic_thread_fence(memory_order_release); + MO_ReadBarrier -> return (unitOL (DMBSY DmbRead DmbRead), Nothing) + MO_WriteBarrier -> return (unitOL (DMBSY DmbWrite DmbWrite), Nothing) MO_Touch -> return (nilOL, Nothing) -- Keep variables live (when using interior pointers) -- Prefetch MO_Prefetch_Data _n -> return (nilOL, Nothing) -- Prefetch hint. @@ -1606,32 +1610,53 @@ genCCall target dest_regs arg_regs bid = do MO_BSwap w -> mkCCall (bSwapLabel w) MO_BRev w -> mkCCall (bRevLabel w) - -- -- Atomic read-modify-write. - MO_AtomicRead w ord + -- Atomic read-modify-write. + mo@(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 - _ -> panic "no proper atomic write support" -- LDAR + -- See __atomic_load_n (in C) + let instrs = case ord of + MemOrderRelaxed -> unitOL $ ann moDescr (LDR (intFormat w) (OpReg w dst) (OpAddr $ AddrReg p)) + MemOrderAcquire -> toOL [ + ann moDescr (LDR (intFormat w) (OpReg w dst) (OpAddr $ AddrReg p)), + DMBSY DmbRead DmbReadWrite + ] + MemOrderSeqCst -> toOL [ + ann moDescr (DMBSY DmbReadWrite DmbReadWrite), + LDR (intFormat w) (OpReg w dst) (OpAddr $ AddrReg p), + DMBSY DmbRead DmbReadWrite + ] + MemOrderRelease -> panic $ "Unexpected MemOrderRelease on an AtomicRead: " ++ show mo dst = getRegisterReg platform (CmmLocal dst_reg) + moDescr = (text . show) mo code = - code_p `snocOL` - instr (intFormat w) (OpReg w dst) (OpAddr $ AddrReg p) + code_p `appOL` + instrs return (code, Nothing) | otherwise -> panic "mal-formed AtomicRead" - MO_AtomicWrite w ord + mo@(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 - _ -> panic "no proper atomic write support" -- STLR + -- See __atomic_store_n (in C) + let instrs = case ord of + MemOrderRelaxed -> unitOL $ ann moDescr (STR fmt_val (OpReg w val) (OpAddr $ AddrReg p)) + MemOrderSeqCst -> toOL [ + ann moDescr (DMBSY DmbReadWrite DmbWrite), + STR fmt_val (OpReg w val) (OpAddr $ AddrReg p) + ] + MemOrderRelease -> toOL [ + ann moDescr (DMBSY DmbReadWrite DmbWrite), + STR fmt_val (OpReg w val) (OpAddr $ AddrReg p) + ] + MemOrderAcquire -> panic $ "Unexpected MemOrderAcquire on an AtomicWrite" ++ show mo + moDescr = (text . show) mo code = code_p `appOL` - code_val `snocOL` - instr fmt_val (OpReg w val) (OpAddr $ AddrReg p) + code_val `appOL` + instrs return (code, Nothing) | otherwise -> panic "mal-formed AtomicWrite" MO_AtomicRMW w amop -> mkCCall (atomicRMWLabel w amop) ===================================== compiler/GHC/CmmToAsm/RV64/Cond.hs ===================================== @@ -65,4 +65,4 @@ data Cond | NEVER -- b.nv | VS -- oVerflow set | VC -- oVerflow clear - deriving Eq + deriving (Eq, Show) ===================================== compiler/GHC/CmmToAsm/RV64/Instr.hs ===================================== @@ -132,7 +132,7 @@ regUsageOfInstr platform instr = case instr of -- LDP _ dst1 dst2 src -> usage (regOp src, regOp dst1 ++ regOp dst2) -- 8. Synchronization Instructions ------------------------------------------- - DMBSY _ -> usage ([], []) + DMBSY _ _ -> usage ([], []) -- 9. Floating Point Instructions -------------------------------------------- FCVT dst src -> usage (regOp src, regOp dst) @@ -268,7 +268,7 @@ patchRegsOfInstr instr env = case instr of -- LDP f o1 o2 o3 -> LDP f (patchOp o1) (patchOp o2) (patchOp o3) -- 8. Synchronization Instructions ----------------------------------------- - DMBSY op -> DMBSY op + DMBSY o1 o2 -> DMBSY o1 o2 -- 9. Floating Point Instructions ------------------------------------------ FCVT o1 o2 -> FCVT (patchOp o1) (patchOp o2) @@ -654,7 +654,7 @@ data Instr | BCOND Cond Operand Operand Target -- branch with condition. b. -- 8. Synchronization Instructions ----------------------------------------- - | DMBSY DmbType + | DMBSY DmbType DmbType -- 9. Floating Point Instructions -- Float ConVerT | FCVT Operand Operand @@ -665,7 +665,7 @@ data Instr -- Float ABSolute value | FABS Operand Operand -data DmbType = DmbRead | DmbWrite +data DmbType = DmbRead | DmbWrite | DmbReadWrite instrCon :: Instr -> String instrCon i = ===================================== compiler/GHC/CmmToAsm/RV64/Ppr.hs ===================================== @@ -561,6 +561,7 @@ pprInstr platform instr = case instr of ULE -> line $ text "\tbgeu" <+> pprOp platform r <> comma <+> pprOp platform l <> comma <+> getLabel platform t UGE -> line $ text "\tbgeu" <+> pprOp platform l <> comma <+> pprOp platform r <> comma <+> getLabel platform t UGT -> line $ text "\tbltu" <+> pprOp platform r <> comma <+> pprOp platform l <> comma <+> getLabel platform t + _ -> panic $ "RV64.ppr: unhandled BCOND conditional: " ++ show c BCOND _ _ _ (TReg _) -> panic "RV64.ppr: No conditional branching to registers!" @@ -583,7 +584,7 @@ pprInstr platform instr = case instr of UGE -> lines_ [ sltuFor l r <+> pprOp platform o <> comma <+> pprOp platform l <> comma <+> pprOp platform r , text "\txori" <+> pprOp platform o <> comma <+> pprOp platform o <> comma <+> text "1" ] UGT -> lines_ [ sltuFor l r <+> pprOp platform o <> comma <+> pprOp platform r <> comma <+> pprOp platform l ] - _ -> panic "RV64.ppr: unhandled CSET conditional" + _ -> panic $ "RV64.ppr: unhandled CSET conditional: " ++ show c where subFor l r | (OpImm _) <- r = text "\taddi" <+> pprOp platform o <> comma <+> pprOp platform l <> comma <+> pprOp platform (negOp r) | (OpImm _) <- l = panic "RV64.ppr: Cannot SUB IMM _" @@ -649,8 +650,7 @@ pprInstr platform instr = case instr of -- LDP _f o1 o2 o3 -> op3 (text "\tldp") o1 o2 o3 -- 8. Synchronization Instructions ------------------------------------------- - DMBSY DmbRead -> line $ text "\tfence r,r" - DMBSY DmbWrite -> line $ text "\tfence w,w" + DMBSY r w -> line $ text "\tfence" <+> pprDmbType r <> char ',' <+> pprDmbType w -- 9. Floating Point Instructions -------------------------------------------- FCVT o1 o2 -> op2 (text "\tfcvt") o1 o2 @@ -664,6 +664,9 @@ pprInstr platform instr = case instr of -- op_ldr o1 rest = line $ text "\tld" <+> pprOp platform o1 <> comma <+> rest <+> text "(" <> pprOp platform o1 <> text ")" -- op_adrp o1 rest = line $ text "\tauipc" <+> pprOp platform o1 <> comma <+> rest -- op_add o1 rest = line $ text "\taddi" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> rest + pprDmbType DmbRead = text "r" + pprDmbType DmbWrite = text "w" + pprDmbType DmbReadWrite = text "rw" pprBcond :: IsLine doc => Cond -> doc pprBcond c = text "b." <> pprCond c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5b3c11e1935acb269023329105284605aab8f7a5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5b3c11e1935acb269023329105284605aab8f7a5 You're receiving 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 Jun 11 15:52:52 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Sun, 11 Jun 2023 11:52:52 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] Compiler working with e-graph Message-ID: <6485edd412832_111d63c7c2c2656e3@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: 682e4587 by Rodrigo Mesquita at 2023-06-11T17:52:40+02:00 Compiler working with e-graph - - - - - 4 changed files: - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/Types/Unique/SDFM.hs - libraries/hegg Changes: ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -93,12 +93,19 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.State.Strict import Data.Coerce import Data.Either (partitionEithers) +import Data.Bifunctor (first) import Data.Foldable (foldlM, minimumBy, toList) import Data.Monoid (Any(..)) import Data.List (sortBy, find) import qualified Data.List.NonEmpty as NE import Data.Ord (comparing) +import Data.Functor.Const +import Data.Equality.Analysis (Analysis(..)) +import Data.Equality.Graph (EGraph) +import Data.Equality.Utils (Fix(..)) +import qualified Data.Equality.Graph as EG + -- -- * Main exports -- @@ -685,32 +692,38 @@ filterUnliftedFields con args = -- ⊥. addBotCt :: Nabla -> Id -> MaybeT DsM Nabla addBotCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x = do - let (y, vi at VI { vi_bot = bot }) = lookupVarInfoNT (nabla_tm_st nabla) x - case bot of - IsNotBot -> mzero -- There was x ≁ ⊥. Contradiction! - IsBot -> pure nabla -- There already is x ~ ⊥. Nothing left to do - MaybeBot -- We add x ~ ⊥ - | definitelyUnliftedType (idType x) - -- Case (3) in Note [Strict fields and variables of unlifted type] - -> mzero -- unlifted vars can never be ⊥ - | otherwise - -> do - let vi' = vi{ vi_bot = IsBot } - pure nabla{ nabla_tm_st = ts{ts_facts = addToUSDFM env y vi' } } + let (xid, env') = EG.represent (Fix $ Const x) env + env'' <- EG.adjustF go xid env' + pure nabla{nabla_tm_st = ts{ts_facts = env''}} + where + go :: VarInfo -> MaybeT DsM VarInfo + go vi at VI { vi_bot = bot } + = case bot of + IsNotBot -> mzero -- There was x ≁ ⊥. Contradiction! + IsBot -> pure vi -- There already is x ~ ⊥. Nothing left to do + MaybeBot -- We add x ~ ⊥ + | definitelyUnliftedType (idType x) + -- Case (3) in Note [Strict fields and variables of unlifted type] + -> mzero -- unlifted vars can never be ⊥ + | otherwise + -> do + pure vi{ vi_bot = IsBot } -- | Adds the constraint @x ~/ ⊥@ to 'Nabla'. Quite similar to 'addNotConCt', -- but only cares for the ⊥ "constructor". addNotBotCt :: Nabla -> Id -> MaybeT DsM Nabla addNotBotCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts=env} } x = do - let (y, vi at VI { vi_bot = bot }) = lookupVarInfoNT (nabla_tm_st nabla) x + let (xid, env') = EG.represent (Fix $ Const x) env + -- ROMES:TODO: This could be all be a function passed to adjust + let (y, vi at VI { vi_bot = bot }, TmSt{ts_facts=env''}) = lookupVarInfoNT (ts{ts_facts=env'}) x -- ROMES:TODO: this will represent x again (quite cheap still), but whatever for now case bot of IsBot -> mzero -- There was x ~ ⊥. Contradiction! - IsNotBot -> pure nabla -- There already is x ≁ ⊥. Nothing left to do + IsNotBot -> pure nabla -- There already is x ≁ ⊥. Nothing left to do (ROMES:TODO missing env') MaybeBot -> do -- We add x ≁ ⊥ and test if x is still inhabited -- Mark dirty for a delayed inhabitation test let vi' = vi{ vi_bot = IsNotBot} pure $ markDirty y - $ nabla{ nabla_tm_st = ts{ ts_facts = addToUSDFM env y vi' } } + $ nabla{ nabla_tm_st = ts{ ts_facts = EG.adjust (const vi') xid env''} } -- | Record a @x ~/ K@ constraint, e.g. that a particular 'Id' @x@ can't -- take the shape of a 'PmAltCon' @K@ in the 'Nabla' and return @Nothing@ if @@ -769,7 +782,10 @@ hasRequiredTheta _ = False -- See Note [TmState invariants]. addConCt :: Nabla -> Id -> PmAltCon -> [TyVar] -> [Id] -> MaybeT DsM Nabla addConCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x alt tvs args = do - let vi@(VI _ pos neg bot _) = lookupVarInfo ts x + let (xid, env') = EG.represent (Fix $ Const x) env + -- ROMES:TODO: Omssions of updates on ts_facts on nabla are fine, but not perfect. Get it consistent + -- ROMES:TODO: Also looks like a function on varinfo (adjust) + let (vi@(VI _ pos neg bot _), TmSt{ts_facts=env''}) = lookupVarInfo (ts{ts_facts=env'}) x -- First try to refute with a negative fact guard (not (elemPmAltConSet alt neg)) -- Then see if any of the other solutions (remember: each of them is an @@ -788,7 +804,7 @@ addConCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x alt tvs args = Nothing -> do let pos' = PACA alt tvs args : pos let nabla_with bot' = - nabla{ nabla_tm_st = ts{ts_facts = addToUSDFM env x (vi{vi_pos = pos', vi_bot = bot'})} } + nabla{ nabla_tm_st = ts{ts_facts = EG.adjust (const (vi{vi_pos = pos', vi_bot = bot'})) xid env''} } -- Do (2) in Note [Coverage checking Newtype matches] case (alt, args) of (PmAltConLike (RealDataCon dc), [y]) | isNewDataCon dc -> @@ -817,11 +833,13 @@ equateTys ts us = -- -- See Note [TmState invariants]. addVarCt :: Nabla -> Id -> Id -> MaybeT DsM Nabla +-- This is where equality-graphs really come into play. addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = - case equateUSDFM env x y of - (Nothing, env') -> pure (nabla{ nabla_tm_st = ts{ ts_facts = env' } }) + -- ROMES:TODO: equate auxiliary var that finds both vars, and lookups up the domain associated. However, I think we no longer should have Just/Nothing but rather always store emptyVarInfo for new e-nodes + -- equate should also update e-graph, basically re-implement "equateUSDFM" in terms of the e-graph, or inline it or so + case equate env x y of -- Add the constraints we had for x to y - (Just vi_x, env') -> do + (vi_x, env') -> do let nabla_equated = nabla{ nabla_tm_st = ts{ts_facts = env'} } -- and then gradually merge every positive fact we have on x into y let add_pos nabla (PACA cl tvs args) = addConCt nabla y cl tvs args @@ -829,6 +847,25 @@ addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = -- Do the same for negative info let add_neg nabla nalt = addNotConCt nabla y nalt foldlM add_neg nabla_pos (pmAltConSetElems (vi_neg vi_x)) + where + -- | @equate env x y@ makes @x@ and @y@ point to the same entry, + -- thereby merging @x@'s class with @y@'s. + -- If both @x@ and @y@ are in the domain of the map, then @y@'s entry will be + -- chosen as the new entry and @x@'s old entry will be returned. + -- + -- Examples in terms of the model (see 'UniqSDFM'): + -- >>> equate [] u1 u2 == (Nothing, [({u1,u2}, Nothing)]) + -- >>> equate [({u1,u3}, Just ele1)] u3 u4 == (Nothing, [({u1,u3,u4}, Just ele1)]) + -- >>> equate [({u1,u3}, Just ele1)] u4 u3 == (Nothing, [({u1,u3,u4}, Just ele1)]) + -- >>> equate [({u1,u3}, Just ele1), ({u2}, Just ele2)] u3 u2 == (Just ele1, [({u2,u1,u3}, Just ele2)]) + equate :: EGraph VarInfo (Const Id) -> Id -> Id -> (VarInfo, EGraph VarInfo (Const Id)) + equate eg x y = do + let (xid, eg') = EG.represent (Fix $ Const x) eg + (yid, eg'') = EG.represent (Fix $ Const y) eg' + (_, eg''') = EG.merge xid yid eg'' + in (EG.lookup xid eg', eg''') + -- Note: lookup in eg', because it's before the merge. + -- | Inspects a 'PmCoreCt' @let x = e@ by recording constraints for @x@ based -- on the shape of the 'CoreExpr' @e at . Examples: @@ -955,6 +992,7 @@ modifyT f = StateT $ fmap ((,) ()) . f -- there weren't any such constraints. representCoreExpr :: Nabla -> CoreExpr -> DsM (Id, Nabla) representCoreExpr nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_reps = reps } } e +-- ROMES:TODO: Represent | Just rep <- lookupCoreMap reps key = pure (rep, nabla) | otherwise = do rep <- mkPmId (exprType e) @@ -1281,12 +1319,14 @@ traverseDirty f ts at TmSt{ts_facts = env, ts_dirty = dirty} = where go [] env = pure ts{ts_facts=env} go (x:xs) !env = do - vi' <- f (lookupVarInfo ts x) - go xs (addToUSDFM env x vi') + let (vi, TmSt{ts_facts=env'}) = lookupVarInfo ts x + vi' <- f vi -- todo: lookupvar should really return the xid + let (xid,env'') = EG.represent (Fix $ Const x) env' -- ROMES:TODO: really, a helper functoin for representing Ids + go xs (EG.adjust (const vi') xid env'') traverseAll :: Monad m => (VarInfo -> m VarInfo) -> TmState -> m TmState traverseAll f ts at TmSt{ts_facts = env} = do - env' <- traverseUSDFM f env + env' <- EG.traverseAnalysisData f env pure ts{ts_facts = env'} -- | Makes sure the given 'Nabla' is still inhabited, by trying to instantiate @@ -1321,6 +1361,9 @@ inhabitationTest fuel old_ty_st nabla at MkNabla{ nabla_tm_st = ts } = {-# SCC "in instantiate (fuel-1) nabla_not_dirty vi _ -> pure vi +-- ROMES:TODO: The dirty shortcutting bit seems like the bookeeping on nodes to +-- upward merge, perhaps we can rid of it too + -- | Checks whether the given 'VarInfo' needs to be tested for inhabitants. -- Returns `False` when we can skip the inhabitation test, presuming it would -- say "yes" anyway. See Note [Shortcutting the inhabitation test]. @@ -1393,7 +1436,7 @@ instCompleteSets fuel nabla vi = {-# SCC "instCompleteSets" #-} do let x = vi_id vi (rcm, nabla) <- lift (addNormalisedTypeMatches nabla x) nabla <- foldM (\nabla cls -> instCompleteSet fuel nabla x cls) nabla (getRcm rcm) - pure (lookupVarInfo (nabla_tm_st nabla) x) + pure (fst $ lookupVarInfo (nabla_tm_st nabla) x) anyConLikeSolution :: (ConLike -> Bool) -> [PmAltConApp] -> Bool anyConLikeSolution p = any (go . paca_con) @@ -1422,7 +1465,7 @@ instCompleteSet fuel nabla x cs | otherwise = {-# SCC "instCompleteSet" #-} go nabla (sorted_candidates cs) where - vi = lookupVarInfo (nabla_tm_st nabla) x + (vi, _env') = lookupVarInfo (nabla_tm_st nabla) x sorted_candidates :: CompleteMatch -> [ConLike] sorted_candidates cm @@ -1911,7 +1954,7 @@ generateInhabitingPatterns _ _ 0 _ = pure [] generateInhabitingPatterns _ [] _ nabla = pure [nabla] generateInhabitingPatterns mode (x:xs) n nabla = do tracePm "generateInhabitingPatterns" (ppr mode <+> ppr n <+> ppr (x:xs) $$ ppr nabla) - let VI _ pos neg _ _ = lookupVarInfo (nabla_tm_st nabla) x + let (VI _ pos neg _ _, _env') = lookupVarInfo (nabla_tm_st nabla) x case pos of _:_ -> do -- Example for multiple solutions (must involve a PatSyn): @@ -1949,7 +1992,7 @@ generateInhabitingPatterns mode (x:xs) n nabla = do case mb_stuff of Nothing -> pure [] Just (y, newty_nabla) -> do - let vi = lookupVarInfo (nabla_tm_st newty_nabla) y + let (vi, _env) = lookupVarInfo (nabla_tm_st newty_nabla) y env <- dsGetFamInstEnvs rcm <- case splitReprTyConApp_maybe env rep_ty of Just (tc, _, _) -> addTyConMatches tc (vi_rcm vi) ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -1,3 +1,6 @@ +{-# OPTIONS_GHC -Wno-orphans #-} -- Oh god, ROMES:TODO +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} @@ -44,7 +47,6 @@ import GHC.Data.FastString import GHC.Types.Id import GHC.Types.Var.Set import GHC.Types.Unique.DSet -import GHC.Types.Unique.SDFM import GHC.Types.Name import GHC.Core.DataCon import GHC.Core.ConLike @@ -75,6 +77,12 @@ import Data.Ratio import GHC.Real (Ratio(..)) import qualified Data.Semigroup as Semi +import Data.Functor.Const +import Data.Equality.Analysis (Analysis(..)) +import Data.Equality.Graph (EGraph) +import Data.Equality.Utils (Fix(..)) +import qualified Data.Equality.Graph as EG + -- import GHC.Driver.Ppr -- @@ -138,18 +146,23 @@ initTyState = TySt 0 emptyInert -- See Note [TmState invariants] in "GHC.HsToCore.Pmc.Solver". data TmState = TmSt - { ts_facts :: !(UniqSDFM Id VarInfo) + { ts_facts :: !(EGraph VarInfo (Const Id)) -- ROMES:TODO: The Id here is because we don't merge yet ts_reps into the e-graph; so we simply have Ids as E-nodes -- ^ Facts about term variables. Deterministic env, so that we generate -- deterministic error messages. +-- ROMES:TODO: ts_reps perhaps too as well... but a first iteration should map CoreMap to ClassId, and replace just ts_facts. , ts_reps :: !(CoreMap Id) -- ^ An environment for looking up whether we already encountered semantically -- equivalent expressions that we want to represent by the same 'Id' -- representative. +-- ROMES:TODO: ts_dirty looks a bit to me like the bookeeping needed to know +-- which nodes to upward merge, perhaps we can get rid of it too. , ts_dirty :: !DIdSet -- ^ Which 'VarInfo' needs to be checked for inhabitants because of new -- negative constraints (e.g. @x ≁ ⊥@ or @x ≁ K@). } +instance EG.Language (Const Id) + -- | Information about an 'Id'. Stores positive ('vi_pos') facts, like @x ~ Just 42@, -- and negative ('vi_neg') facts, like "x is not (:)". -- Also caches the type ('vi_ty'), the 'ResidualCompleteMatches' of a COMPLETE set @@ -202,6 +215,18 @@ data VarInfo -- to recognise completion of a COMPLETE set efficiently for large enums. } +-- | This instance is seriously wrong for general purpose, it's just required for instancing Analysis. +-- There ought to be a better way. +instance Eq VarInfo where + (==) _ _ = False +instance Analysis VarInfo (Const Id) where + {-# INLINE makeA #-} + {-# INLINE joinA #-} + makeA (Const id) = emptyVarInfo id + -- romes: so currently, variables are joined in 'addVarCt' manually by getting the old value of $x$ and assuming the value of $y$ was chosen. + -- That's obviously bad now, it'd be much more clearer to do it here. It's just the nabla threading that's more trouble + joinA _a b = b + data PmAltConApp = PACA { paca_con :: !PmAltCon @@ -227,7 +252,7 @@ instance Outputable BotInfo where -- | Not user-facing. instance Outputable TmState where - ppr (TmSt state reps dirty) = ppr state $$ ppr reps $$ ppr dirty + ppr (TmSt _state reps dirty) = text "" $$ ppr reps $$ ppr dirty -- | Not user-facing. instance Outputable VarInfo where @@ -248,7 +273,7 @@ instance Outputable VarInfo where -- | Initial state of the term oracle. initTmState :: TmState -initTmState = TmSt emptyUSDFM emptyCoreMap emptyDVarSet +initTmState = TmSt EG.emptyEGraph emptyCoreMap emptyDVarSet -- | A data type that caches for the 'VarInfo' of @x@ the results of querying -- 'dsGetCompleteMatches' and then striking out all occurrences of @K@ for @@ -300,9 +325,17 @@ emptyVarInfo x , vi_rcm = emptyRCM } -lookupVarInfo :: TmState -> Id -> VarInfo --- (lookupVarInfo tms x) tells what we know about 'x' -lookupVarInfo (TmSt env _ _) x = fromMaybe (emptyVarInfo x) (lookupUSDFM env x) +-- | @lookupVarInfo tms x@ tells what we know about 'x' +--- romes: TODO: lookupVarInfo should also return the ClassId the Id was represented in..., that'd make things better +lookupVarInfo :: TmState -> Id -> (VarInfo, TmState) +lookupVarInfo tm@(TmSt env _ _) x + -- = fromMaybe (emptyVarInfo x) (lookupUSDFM env x) + -- ROMES:TODO Kind of an issue here, we could have a lookup operation on e-graphs but it'd be good to make it faster + -- We will want to assume every Id is mapped to VarInfo, with emptyVarInfo as the default rather than Maybe + -- I'm just unsure if the Id always exists or not. + -- Then again this shouldn't be Id, but rather ClassId§ + = let (i,env') = EG.represent (Fix $ Const x) env + in (EG.lookup i env', tm{ts_facts=env'}) -- | Like @lookupVarInfo ts x@, but @lookupVarInfo ts x = (y, vi)@ also looks -- through newtype constructors. We have @x ~ N1 (... (Nk y))@ such that the @@ -314,22 +347,27 @@ lookupVarInfo (TmSt env _ _) x = fromMaybe (emptyVarInfo x) (lookupUSDFM env x) -- modulo type normalisation! -- -- See also Note [Coverage checking Newtype matches] in GHC.HsToCore.Pmc.Solver. -lookupVarInfoNT :: TmState -> Id -> (Id, VarInfo) +lookupVarInfoNT :: TmState -> Id -> (Id, VarInfo, TmState) lookupVarInfoNT ts x = case lookupVarInfo ts x of - VI{ vi_pos = as_newtype -> Just y } -> lookupVarInfoNT ts y - res -> (x, res) + (VI{ vi_pos = as_newtype -> Just y },ts') + -> lookupVarInfoNT ts' y + (res,ts') + -> (x, res, ts') where as_newtype = listToMaybe . mapMaybe go go PACA{paca_con = PmAltConLike (RealDataCon dc), paca_ids = [y]} | isNewDataCon dc = Just y go _ = Nothing +-- ROMES:TODO: What does this do, how to update? trvVarInfo :: Functor f => (VarInfo -> f (a, VarInfo)) -> Nabla -> Id -> f (a, Nabla) -trvVarInfo f nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts = env} } x - = set_vi <$> f (lookupVarInfo ts x) +trvVarInfo f nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts = _env} } x + -- ROMES:TODO: adjust on the EG, instead of fetching? the (a,) bit is not trivial + = let (vi, ts'@TmSt{ts_facts = env'}) = lookupVarInfo ts x + set_vi (a, vi') = + (a, nabla{ nabla_tm_st = ts'{ ts_facts = let (i,env'') = EG.represent (Fix $ Const $ vi_id vi') env' in EG.adjust (const vi') i env'' } }) + in set_vi <$> f vi where - set_vi (a, vi') = - (a, nabla{ nabla_tm_st = ts{ ts_facts = addToUSDFM env (vi_id vi') vi' } }) ------------------------------------------------ -- * Exported utility functions querying 'Nabla' @@ -338,7 +376,9 @@ lookupRefuts :: Nabla -> Id -> [PmAltCon] -- Unfortunately we need the extra bit of polymorphism and the unfortunate -- duplication of lookupVarInfo here. lookupRefuts MkNabla{ nabla_tm_st = ts } x = - pmAltConSetElems $ vi_neg $ lookupVarInfo ts x + -- bimap (pmAltConSetElems . vi_neg) (\ts' -> nabla{nabla_tm_st=ts'}) $ lookupVarInfo ts x + -- ROMES:TODO: It's a bit unfortunate we forget the representation of $x$, but OK + pmAltConSetElems $ vi_neg $ fst $ lookupVarInfo ts x isDataConSolution :: PmAltConApp -> Bool isDataConSolution PACA{paca_con = PmAltConLike (RealDataCon _)} = True @@ -347,11 +387,12 @@ isDataConSolution _ = False -- @lookupSolution nabla x@ picks a single solution ('vi_pos') of @x@ from -- possibly many, preferring 'RealDataCon' solutions whenever possible. lookupSolution :: Nabla -> Id -> Maybe PmAltConApp -lookupSolution nabla x = case vi_pos (lookupVarInfo (nabla_tm_st nabla) x) of - [] -> Nothing - pos@(x:_) - | Just sol <- find isDataConSolution pos -> Just sol - | otherwise -> Just x +lookupSolution nabla x = case vi_pos $ fst $ lookupVarInfo (nabla_tm_st nabla) x of + -- ROMES:TODO: It's a bit unfortunate we forget the representation of $x$, but OK + [] -> Nothing + pos@(x:_) + | Just sol <- find isDataConSolution pos -> Just sol + | otherwise -> Just x -------------------------------------------------------------------------------- -- The rest is just providing an IR for (overloaded!) literals and AltCons that ===================================== compiler/GHC/Types/Unique/SDFM.hs ===================================== @@ -82,6 +82,7 @@ lookupUSDFM usdfm x = snd (lookupReprAndEntryUSDFM usdfm x) -- >>> equateUSDFM [({u1,u3}, Just ele1)] u3 u4 == (Nothing, [({u1,u3,u4}, Just ele1)]) -- >>> equateUSDFM [({u1,u3}, Just ele1)] u4 u3 == (Nothing, [({u1,u3,u4}, Just ele1)]) -- >>> equateUSDFM [({u1,u3}, Just ele1), ({u2}, Just ele2)] u3 u2 == (Just ele1, [({u2,u1,u3}, Just ele2)]) +-- ROMES:TODO: Are all USDFM functions just for the PMC Nabla TM? equateUSDFM :: Uniquable key => UniqSDFM key ele -> key -> key -> (Maybe ele, UniqSDFM key ele) equateUSDFM usdfm@(USDFM env) x y = ===================================== libraries/hegg ===================================== @@ -1 +1 @@ -Subproject commit ec0f55ce20bee83738ed29dcd5fb4159f9e90df4 +Subproject commit 67453e7735fdfc9e6212c607ba3ed855d525d349 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/682e45875964144de3df47f0e6d88e60055a2633 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/682e45875964144de3df47f0e6d88e60055a2633 You're receiving 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 Jun 11 16:04:01 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sun, 11 Jun 2023 12:04:01 -0400 Subject: [Git][ghc/ghc][wip/tsan/no-barriers] 10 commits: compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE Message-ID: <6485f0712e907_111d63c7c2c266033@gitlab.mail> Sven Tennie pushed to branch wip/tsan/no-barriers at Glasgow Haskell Compiler / GHC Commits: 94e25428 by Ben Gamari at 2023-06-11T15:50:40+00:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE Fix - - - - - 518393ca by Ben Gamari at 2023-06-11T15:50:45+00:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier This is no longer used. - - - - - 41267c93 by Sven Tennie at 2023-06-11T15:50:45+00:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier This is no longer used. - - - - - 84606145 by Ben Gamari at 2023-06-11T15:50:45+00:00 rts: Drop load_store_barrier() This is no longer used. - - - - - 166b0c4f by Ben Gamari at 2023-06-11T15:50:45+00:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - d6162538 by Ben Gamari at 2023-06-11T15:50:45+00:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 99ed8f56 by Sven Tennie at 2023-06-11T15:51:40+00:00 compiler: Drop MO_ReadBarrier - - - - - d4b3ae06 by Ben Gamari at 2023-06-11T15:51:44+00:00 rts: Drop load_load_barrier This is no longer used. - - - - - 7e6f36ff by Sven Tennie at 2023-06-11T15:52:55+00:00 FIX drop write barrier - - - - - 8d6a72d5 by Sven Tennie at 2023-06-11T16:03:23+00:00 Replace non-existant macro - - - - - 25 changed files: - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/StgToCmm/Prim.hs - rts/CloneStack.c - rts/PrimOps.cmm - rts/RaiseAsync.c - rts/RtsSymbols.c - rts/Sparks.c - rts/TopHandler.c - rts/include/Cmm.h - rts/include/Stg.h - rts/include/stg/SMP.h - rts/sm/Evac.c - rts/sm/GC.c - rts/sm/GCAux.c - rts/sm/Sanity.c - testsuite/tests/rts/testwsdeque.c Changes: ===================================== compiler/GHC/Cmm/MachOp.hs ===================================== @@ -670,8 +670,6 @@ data CallishMachOp | MO_SubIntC Width | MO_U_Mul2 Width - | MO_ReadBarrier - | MO_WriteBarrier | MO_Touch -- Keep variables live (when using interior pointers) -- Prefetch @@ -701,6 +699,9 @@ data CallishMachOp | MO_BSwap Width | MO_BRev Width + | MO_AcquireFence + | MO_ReleaseFence + -- | Atomic read-modify-write. Arguments are @[dest, n]@. | MO_AtomicRMW Width AtomicMachOp -- | Atomic read. Arguments are @[addr]@. ===================================== compiler/GHC/Cmm/Parser.y ===================================== @@ -1117,8 +1117,9 @@ callishMachOps platform = listToUFM $ ( "fabs32f", (MO_F32_Fabs,) ), ( "sqrt32f", (MO_F32_Sqrt,) ), - ( "read_barrier", (MO_ReadBarrier,)), - ( "write_barrier", (MO_WriteBarrier,)), + -- TODO: Rename to acquire_fence and release_fence + ( "fence_acquire", (MO_AcquireFence,)), + ( "fence_release", (MO_ReleaseFence,)), ( "memcpy", memcpyLikeTweakArgs MO_Memcpy ), ( "memset", memcpyLikeTweakArgs MO_Memset ), ( "memmove", memcpyLikeTweakArgs MO_Memmove ), ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -1558,9 +1558,8 @@ genCCall target dest_regs arg_regs bid = do MO_U_Mul2 _w -> unsupported mop -- Memory Ordering - -- TODO DMBSY is probably *way* too much! - MO_ReadBarrier -> return (unitOL DMBSY, Nothing) - MO_WriteBarrier -> return (unitOL DMBSY, Nothing) + MO_AcquireFence -> return (unitOL DMBISH, Nothing) + MO_ReleaseFence -> return (unitOL DMBISH, Nothing) MO_Touch -> return (nilOL, Nothing) -- Keep variables live (when using interior pointers) -- Prefetch MO_Prefetch_Data _n -> return (nilOL, Nothing) -- Prefetch hint. ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -136,6 +136,7 @@ regUsageOfInstr platform instr = case instr of -- 8. Synchronization Instructions ------------------------------------------- DMBSY -> usage ([], []) + DMBISH -> usage ([], []) -- 9. Floating Point Instructions -------------------------------------------- FCVT dst src -> usage (regOp src, regOp dst) @@ -276,6 +277,7 @@ patchRegsOfInstr instr env = case instr of -- 8. Synchronization Instructions ----------------------------------------- DMBSY -> DMBSY + DMBISH -> DMBISH -- 9. Floating Point Instructions ------------------------------------------ FCVT o1 o2 -> FCVT (patchOp o1) (patchOp o2) @@ -645,6 +647,7 @@ data Instr -- 8. Synchronization Instructions ----------------------------------------- | DMBSY + | DMBISH -- 9. Floating Point Instructions -- Float ConVerT | FCVT Operand Operand @@ -724,6 +727,7 @@ instrCon i = BL{} -> "BL" BCOND{} -> "BCOND" DMBSY{} -> "DMBSY" + DMBISH{} -> "DMBISH" FCVT{} -> "FCVT" SCVTF{} -> "SCVTF" FCVTZS{} -> "FCVTZS" ===================================== compiler/GHC/CmmToAsm/AArch64/Ppr.hs ===================================== @@ -530,6 +530,7 @@ pprInstr platform instr = case instr of -- 8. Synchronization Instructions ------------------------------------------- DMBSY -> line $ text "\tdmb sy" + DMBISH -> line $ text "\tdmb ish" -- 9. Floating Point Instructions -------------------------------------------- FCVT o1 o2 -> op2 (text "\tfcvt") o1 o2 SCVTF o1 o2 -> op2 (text "\tscvtf") o1 o2 ===================================== compiler/GHC/CmmToAsm/PPC/CodeGen.hs ===================================== @@ -1126,9 +1126,9 @@ genCCall :: ForeignTarget -- function to call -> [CmmFormal] -- where to put the result -> [CmmActual] -- arguments (of mixed type) -> NatM InstrBlock -genCCall (PrimTarget MO_ReadBarrier) _ _ +genCCall (PrimTarget MO_AcquireFence) _ _ = return $ unitOL LWSYNC -genCCall (PrimTarget MO_WriteBarrier) _ _ +genCCall (PrimTarget MO_ReleaseFence) _ _ = return $ unitOL LWSYNC genCCall (PrimTarget MO_Touch) _ _ @@ -2094,8 +2094,8 @@ genCCall' config gcp target dest_regs args MO_AddIntC {} -> unsupported MO_SubIntC {} -> unsupported MO_U_Mul2 {} -> unsupported - MO_ReadBarrier -> unsupported - MO_WriteBarrier -> unsupported + MO_AcquireFence -> unsupported + MO_ReleaseFence -> unsupported MO_Touch -> unsupported MO_Prefetch_Data _ -> unsupported unsupported = panic ("outOfLineCmmOp: " ++ show mop ===================================== compiler/GHC/CmmToAsm/Wasm/FromCmm.hs ===================================== @@ -1186,8 +1186,8 @@ lower_CallishMachOp lbl MO_F32_ExpM1 rs xs = lower_CallishMachOp lbl MO_F32_Fabs rs xs = lower_CMO_Un_Homo lbl "fabsf" rs xs lower_CallishMachOp lbl MO_F32_Sqrt rs xs = lower_CMO_Un_Homo lbl "sqrtf" rs xs lower_CallishMachOp lbl (MO_UF_Conv w0) rs xs = lower_MO_UF_Conv lbl w0 rs xs -lower_CallishMachOp _ MO_ReadBarrier _ _ = pure $ WasmStatements WasmNop -lower_CallishMachOp _ MO_WriteBarrier _ _ = pure $ WasmStatements WasmNop +lower_CallishMachOp _ MO_AcquireFence _ _ = pure $ WasmStatements WasmNop +lower_CallishMachOp _ MO_ReleaseFence _ _ = pure $ WasmStatements WasmNop lower_CallishMachOp _ MO_Touch _ _ = pure $ WasmStatements WasmNop lower_CallishMachOp _ (MO_Prefetch_Data {}) _ _ = pure $ WasmStatements WasmNop lower_CallishMachOp lbl (MO_Memcpy {}) [] xs = do ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -2160,8 +2160,8 @@ genSimplePrim bid (MO_Memcpy align) [] [dst,src,n] = genMemCpy bid a genSimplePrim bid (MO_Memmove align) [] [dst,src,n] = genMemMove bid align dst src n genSimplePrim bid (MO_Memcmp align) [res] [dst,src,n] = genMemCmp bid align res dst src n genSimplePrim bid (MO_Memset align) [] [dst,c,n] = genMemSet bid align dst c n -genSimplePrim _ MO_ReadBarrier [] [] = return nilOL -- barriers compile to no code on x86/x86-64; -genSimplePrim _ MO_WriteBarrier [] [] = return nilOL -- we keep it this long in order to prevent earlier optimisations. +genSimplePrim _ MO_AcquireFence [] [] = return nilOL -- barriers compile to no code on x86/x86-64; +genSimplePrim _ MO_ReleaseFence [] [] = return nilOL -- we keep it this long in order to prevent earlier optimisations. genSimplePrim _ MO_Touch [] [_] = return nilOL genSimplePrim _ (MO_Prefetch_Data n) [] [src] = genPrefetchData n src genSimplePrim _ (MO_BSwap width) [dst] [src] = genByteSwap width dst src ===================================== compiler/GHC/CmmToC.hs ===================================== @@ -261,6 +261,11 @@ pprStmt platform stmt = CmmUnsafeForeignCall (PrimTarget MO_Touch) _results _args -> empty CmmUnsafeForeignCall (PrimTarget (MO_Prefetch_Data _)) _results _args -> empty + CmmUnsafeForeignCall (PrimTarget MO_ReleaseFence) [] [] -> + text "__atomic_thread_fence(__ATOMIC_RELEASE);" + CmmUnsafeForeignCall (PrimTarget MO_AcquireFence) [] [] -> + text "__atomic_thread_fence(__ATOMIC_ACQUIRE);" + CmmUnsafeForeignCall target@(PrimTarget op) results args -> fn_call where @@ -944,8 +949,8 @@ pprCallishMachOp_for_C mop MO_F32_ExpM1 -> text "expm1f" MO_F32_Sqrt -> text "sqrtf" MO_F32_Fabs -> text "fabsf" - MO_ReadBarrier -> text "load_load_barrier" - MO_WriteBarrier -> text "write_barrier" + MO_AcquireFence -> unsupported + MO_ReleaseFence -> unsupported MO_Memcpy _ -> text "__builtin_memcpy" MO_Memset _ -> text "__builtin_memset" MO_Memmove _ -> text "__builtin_memmove" ===================================== compiler/GHC/CmmToLlvm/CodeGen.hs ===================================== @@ -171,34 +171,15 @@ getInstrinct fname retTy parTys = fty = LMFunction funSig in getInstrinct2 fname fty --- | Memory barrier instruction for LLVM >= 3.0 -barrier :: LlvmM StmtData -barrier = do - let s = Fence False SyncSeqCst - return (unitOL s, []) - --- | Insert a 'barrier', unless the target platform is in the provided list of --- exceptions (where no code will be emitted instead). -barrierUnless :: [Arch] -> LlvmM StmtData -barrierUnless exs = do - platform <- getPlatform - if platformArch platform `elem` exs - then return (nilOL, []) - else barrier - -- | Foreign Calls genCall :: ForeignTarget -> [CmmFormal] -> [CmmActual] -> LlvmM StmtData -- Barriers need to be handled specially as they are implemented as LLVM -- intrinsic functions. -genCall (PrimTarget MO_ReadBarrier) _ _ = - barrierUnless [ArchX86, ArchX86_64] - -genCall (PrimTarget MO_WriteBarrier) _ _ = - barrierUnless [ArchX86, ArchX86_64] - -genCall (PrimTarget MO_Touch) _ _ = - return (nilOL, []) +genCall (PrimTarget MO_AcquireFence) _ _ = runStmtsDecls $ + statement $ Fence False SyncAcquire +genCall (PrimTarget MO_ReleaseFence) _ _ = runStmtsDecls $ + statement $ Fence False SyncRelease genCall (PrimTarget (MO_UF_Conv w)) [dst] [e] = runStmtsDecls $ do dstV <- getCmmRegW (CmmLocal dst) @@ -1008,8 +989,8 @@ cmmPrimOpFunctions mop = do -- We support MO_U_Mul2 through ordinary LLVM mul instruction, see the -- appropriate case of genCall. MO_U_Mul2 {} -> unsupported - MO_ReadBarrier -> unsupported - MO_WriteBarrier -> unsupported + MO_ReleaseFence -> unsupported + MO_AcquireFence -> unsupported MO_Touch -> unsupported MO_UF_Conv _ -> unsupported ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -2177,7 +2177,7 @@ doWritePtrArrayOp addr idx val -- This write barrier is to ensure that the heap writes to the object -- referred to by val have happened before we write val into the array. -- See #12469 for details. - emitPrimCall [] MO_WriteBarrier [] + emitPrimCall [] MO_AcquireFence [] mkBasicIndexedWrite hdr_size addr ty idx val emit (setInfo addr (CmmLit (CmmLabel mkMAP_DIRTY_infoLabel))) @@ -3048,7 +3048,7 @@ doWriteSmallPtrArrayOp addr idx val = do mkBasicIndexedRead NaturallyAligned (smallArrPtrsHdrSize profile) Nothing ty tmp addr ty idx whenUpdRemSetEnabled $ emitUpdRemSetPush (CmmReg (CmmLocal tmp)) - emitPrimCall [] MO_WriteBarrier [] -- #12469 + emitPrimCall [] MO_AcquireFence [] -- #12469 mkBasicIndexedWrite (smallArrPtrsHdrSize profile) addr ty idx val emit (setInfo addr (CmmLit (CmmLabel mkSMAP_DIRTY_infoLabel))) ===================================== rts/CloneStack.c ===================================== @@ -74,9 +74,7 @@ void sendCloneStackMessage(StgTSO *tso, HsStablePtr mvar) { msg = (MessageCloneStack *)allocate(srcCapability, sizeofW(MessageCloneStack)); msg->tso = tso; msg->result = (StgMVar*)deRefStablePtr(mvar); - SET_HDR(msg, &stg_MSG_CLONE_STACK_info, CCS_SYSTEM); - // Ensure that writes constructing Message are committed before sending. - write_barrier(); + SET_HDR_RELEASE(msg, &stg_MSG_CLONE_STACK_info, CCS_SYSTEM); sendMessage(srcCapability, tso->cap, (Message *)msg); } ===================================== rts/PrimOps.cmm ===================================== @@ -2505,8 +2505,9 @@ stg_unpackClosurezh ( P_ closure ) { W_ info, ptrs, nptrs, p, ptrs_arr, dat_arr; MAYBE_GC_P(stg_unpackClosurezh, closure); - info = %GET_STD_INFO(UNTAG(closure)); - prim_read_barrier; + info = GET_INFO_ACQUIRE(UNTAG(closure)); + // TODO: Is this correct? + info = %STD_INFO(info); ptrs = TO_W_(%INFO_PTRS(info)); nptrs = TO_W_(%INFO_NPTRS(info)); @@ -2820,8 +2821,7 @@ stg_noDuplicatezh /* no arg list: explicit stack layout */ stg_getApStackValzh ( P_ ap_stack, W_ offset ) { W_ ap_stackinfo; - ap_stackinfo = %INFO_PTR(UNTAG(ap_stack)); - prim_read_barrier; + ap_stackinfo = GET_INFO_ACQUIRE(UNTAG(ap_stack)); if (ap_stackinfo == stg_AP_STACK_info) { return (1,StgAP_STACK_payload(ap_stack,offset)); } else { ===================================== rts/RaiseAsync.c ===================================== @@ -238,7 +238,7 @@ throwToMsg (Capability *cap, MessageThrowTo *msg) goto check_target; retry: - write_barrier(); + RELEASE_FENCE(); // TODO: is this necessary? debugTrace(DEBUG_sched, "throwTo: retrying..."); check_target: @@ -874,9 +874,10 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception, ap->payload[i] = (StgClosure *)*sp++; } - write_barrier(); // XXX: Necessary? SET_HDR(ap,&stg_AP_STACK_info, ((StgClosure *)frame)->header.prof.ccs /* ToDo */); + // N.B. This will be made visible by updateThunk below, which + // implies a release memory barrier. TICK_ALLOC_UP_THK(AP_STACK_sizeW(words),0); //IF_DEBUG(scheduler, ===================================== rts/RtsSymbols.c ===================================== @@ -909,9 +909,6 @@ extern char **environ; SymI_HasProto(hs_spt_remove) \ SymI_HasProto(hs_spt_keys) \ SymI_HasProto(hs_spt_key_count) \ - SymI_HasProto(write_barrier) \ - SymI_HasProto(store_load_barrier) \ - SymI_HasProto(load_load_barrier) \ SymI_HasProto(cas) \ SymI_HasProto(_assertFail) \ SymI_HasProto(keepCAFs) \ ===================================== rts/Sparks.c ===================================== @@ -209,8 +209,7 @@ pruneSparkQueue (bool nonmovingMarkFinished, Capability *cap) cap->spark_stats.fizzled++; traceEventSparkFizzle(cap); } else { - info = RELAXED_LOAD(&spark->header.info); - load_load_barrier(); + info = ACQUIRE_LOAD(&spark->header.info); if (IS_FORWARDING_PTR(info)) { tmp = (StgClosure*)UN_FORWARDING_PTR(info); /* if valuable work: shift inside the pool */ ===================================== rts/TopHandler.c ===================================== @@ -32,8 +32,7 @@ StgTSO *getTopHandlerThread(void) { // topHandlerPtr was never initialised return NULL; } - const StgInfoTable *info = weak->header.info; - load_load_barrier(); + const StgInfoTable *info = ACQUIRE_LOAD(&weak->header.info); if (info == &stg_WEAK_info) { StgClosure *key = ((StgWeak*)weak)->key; ===================================== rts/include/Cmm.h ===================================== @@ -677,21 +677,18 @@ * explicit ordered accesses to make ordering apparent to TSAN. */ -// Memory barriers. +// Memory barriers // For discussion of how these are used to fence heap object // accesses see Note [Heap memory barriers] in SMP.h. #if defined(THREADED_RTS) -#define prim_read_barrier prim %read_barrier() #define prim_write_barrier prim %write_barrier() // See Note [ThreadSanitizer and fences] -#define RELEASE_FENCE prim %write_barrier() -#define ACQUIRE_FENCE prim %read_barrier() +#define RELEASE_FENCE prim %fence_release(); +#define ACQUIRE_FENCE prim %fence_acquire(); #else -#define prim_read_barrier /* nothing */ -#define prim_write_barrier /* nothing */ #define RELEASE_FENCE /* nothing */ #define ACQUIRE_FENCE /* nothing */ #endif /* THREADED_RTS */ ===================================== rts/include/Stg.h ===================================== @@ -392,7 +392,7 @@ external prototype return neither of these types to workaround #11395. #endif #include "stg/Prim.h" /* ghc-prim fallbacks */ -#include "stg/SMP.h" // write_barrier() inline is required +#include "stg/SMP.h" /* ----------------------------------------------------------------------------- Moving Floats and Doubles ===================================== rts/include/stg/SMP.h ===================================== @@ -44,11 +44,6 @@ void arm_atomic_spin_unlock(void); ------------------------------------------------------------------------- */ #if !IN_STG_CODE || IN_STGCRUN -// We only want the barriers, e.g. write_barrier(), declared in .hc -// files. Defining the other inline functions here causes type -// mismatch errors from gcc, because the generated C code is assuming -// that there are no prototypes in scope. - /* * The atomic exchange operation: xchg(p,w) exchanges the value * pointed to by p with the value w, returning the old value. @@ -105,24 +100,6 @@ EXTERN_INLINE void busy_wait_nop(void); #endif // !IN_STG_CODE -/* - * Various kinds of memory barrier. - * write_barrier: prevents future stores occurring before preceding stores. - * store_load_barrier: prevents future loads occurring before preceding stores. - * load_load_barrier: prevents future loads occurring before earlier loads. - * - * Reference for these: "The JSR-133 Cookbook for Compiler Writers" - * http://gee.cs.oswego.edu/dl/jmm/cookbook.html - * - * To check whether you got these right, try the test in - * testsuite/tests/rts/testwsdeque.c - * This tests the work-stealing deque implementation, which relies on - * properly working store_load and load_load memory barriers. - */ -EXTERN_INLINE void write_barrier(void); -EXTERN_INLINE void store_load_barrier(void); -EXTERN_INLINE void load_load_barrier(void); - /* * Note [Heap memory barriers] * ~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -354,7 +331,7 @@ EXTERN_INLINE void load_load_barrier(void); * Exchange the value pointed to by p with w and return the former. This * function is used to acquire a lock. An acquire memory barrier is sufficient * for a lock operation because corresponding unlock operation issues a - * store-store barrier (write_barrier()) immediately before releasing the lock. + * store-store barrier (release-store) immediately before releasing the lock. */ EXTERN_INLINE StgWord xchg(StgPtr p, StgWord w) @@ -463,91 +440,6 @@ busy_wait_nop(void) #endif // !IN_STG_CODE -/* - * We need to tell both the compiler AND the CPU about the barriers. - * It's no good preventing the CPU from reordering the operations if - * the compiler has already done so - hence the "memory" restriction - * on each of the barriers below. - */ -EXTERN_INLINE void -write_barrier(void) { -#if defined(NOSMP) - return; -#elif defined(TSAN_ENABLED) - // RELEASE is a bit stronger than the store-store barrier provided by - // write_barrier, consequently we only use this case as a conservative - // approximation when using ThreadSanitizer. See Note [ThreadSanitizer]. - __atomic_thread_fence(__ATOMIC_RELEASE); -#elif defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) \ - || defined(powerpc64le_HOST_ARCH) - __asm__ __volatile__ ("lwsync" : : : "memory"); -#elif defined(s390x_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH) - __asm__ __volatile__ ("dmb st" : : : "memory"); -#elif defined(riscv64_HOST_ARCH) - __asm__ __volatile__ ("fence w,w" : : : "memory"); -#elif defined(loongarch64_HOST_ARCH) - __asm__ __volatile__ ("dbar 0" : : : "memory"); -#else -#error memory barriers unimplemented on this architecture -#endif -} - -EXTERN_INLINE void -store_load_barrier(void) { -#if defined(NOSMP) - return; -#elif defined(i386_HOST_ARCH) - __asm__ __volatile__ ("lock; addl $0,0(%%esp)" : : : "memory"); -#elif defined(x86_64_HOST_ARCH) - __asm__ __volatile__ ("lock; addq $0,0(%%rsp)" : : : "memory"); -#elif defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) \ - || defined(powerpc64le_HOST_ARCH) - __asm__ __volatile__ ("sync" : : : "memory"); -#elif defined(s390x_HOST_ARCH) - __asm__ __volatile__ ("bcr 14,0" : : : "memory"); -#elif defined(arm_HOST_ARCH) - __asm__ __volatile__ ("dmb" : : : "memory"); -#elif defined(aarch64_HOST_ARCH) - __asm__ __volatile__ ("dmb sy" : : : "memory"); -#elif defined(riscv64_HOST_ARCH) - __asm__ __volatile__ ("fence w,r" : : : "memory"); -#elif defined(loongarch64_HOST_ARCH) - __asm__ __volatile__ ("dbar 0" : : : "memory"); -#else -#error memory barriers unimplemented on this architecture -#endif -} - -EXTERN_INLINE void -load_load_barrier(void) { -#if defined(NOSMP) - return; -#elif defined(i386_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(x86_64_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) \ - || defined(powerpc64le_HOST_ARCH) - __asm__ __volatile__ ("lwsync" : : : "memory"); -#elif defined(s390x_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(arm_HOST_ARCH) - __asm__ __volatile__ ("dmb" : : : "memory"); -#elif defined(aarch64_HOST_ARCH) - __asm__ __volatile__ ("dmb ld" : : : "memory"); -#elif defined(riscv64_HOST_ARCH) - __asm__ __volatile__ ("fence r,r" : : : "memory"); -#elif defined(loongarch64_HOST_ARCH) - __asm__ __volatile__ ("dbar 0" : : : "memory"); -#else -#error memory barriers unimplemented on this architecture -#endif -} - // Load a pointer from a memory location that might be being modified // concurrently. This prevents the compiler from optimising away // multiple loads of the memory location, as it might otherwise do in @@ -586,13 +478,6 @@ load_load_barrier(void) { /* ---------------------------------------------------------------------- */ #else /* !THREADED_RTS */ -EXTERN_INLINE void write_barrier(void); -EXTERN_INLINE void store_load_barrier(void); -EXTERN_INLINE void load_load_barrier(void); -EXTERN_INLINE void write_barrier () {} /* nothing */ -EXTERN_INLINE void store_load_barrier() {} /* nothing */ -EXTERN_INLINE void load_load_barrier () {} /* nothing */ - // Relaxed atomic operations #define RELAXED_LOAD(ptr) *ptr #define RELAXED_STORE(ptr,val) *ptr = val ===================================== rts/sm/Evac.c ===================================== @@ -1394,8 +1394,7 @@ selector_loop: // the same selector thunk. SET_INFO((StgClosure*)p, (StgInfoTable *)info_ptr); OVERWRITING_CLOSURE((StgClosure*)p); - SET_INFO((StgClosure*)p, &stg_WHITEHOLE_info); - write_barrier(); + SET_INFO_RELEASE((StgClosure*)p, &stg_WHITEHOLE_info); #if defined(PARALLEL_GC) abort(); // LDV is incompatible with parallel GC #endif ===================================== rts/sm/GC.c ===================================== @@ -1508,7 +1508,6 @@ waitForGcThreads (Capability *cap, bool idle_cap[]) if (i == me || idle_cap[i]) { continue; } if (SEQ_CST_LOAD(&gc_threads[i]->wakeup) != GC_THREAD_STANDING_BY) { prodCapability(getCapability(i), cap->running_task); - write_barrier(); interruptCapability(getCapability(i)); } } ===================================== rts/sm/GCAux.c ===================================== @@ -91,8 +91,9 @@ isAlive(StgClosure *p) return TAG_CLOSURE(tag,(StgClosure*)UN_FORWARDING_PTR(info)); } + // TODO: Is this correct? + ACQUIRE_LOAD(&q->header.info); info = INFO_PTR_TO_STRUCT(info); - load_load_barrier(); switch (info->type) { ===================================== rts/sm/Sanity.c ===================================== @@ -355,8 +355,7 @@ checkClosure( const StgClosure* p ) p = UNTAG_CONST_CLOSURE(p); - info = p->header.info; - load_load_barrier(); + info = ACQUIRE_LOAD(&p->header.info); if (IS_FORWARDING_PTR(info)) { barf("checkClosure: found EVACUATED closure %d", info->type); @@ -367,7 +366,6 @@ checkClosure( const StgClosure* p ) #endif info = INFO_PTR_TO_STRUCT(info); - load_load_barrier(); switch (info->type) { @@ -772,8 +770,7 @@ checkSTACK (StgStack *stack) void checkTSO(StgTSO *tso) { - const StgInfoTable *info = (const StgInfoTable*) tso->_link->header.info; - load_load_barrier(); + const StgInfoTable *info = (const StgInfoTable*) ACQUIRE_LOAD(&tso->_link)->header.info; ASSERT(tso->_link == END_TSO_QUEUE || info == &stg_MVAR_TSO_QUEUE_info || ===================================== testsuite/tests/rts/testwsdeque.c ===================================== @@ -34,47 +34,25 @@ void * myStealWSDeque_ (WSDeque *q, uint32_t n) { void * stolen; - StgWord b,t; // Can't do this on someone else's spark pool: // ASSERT_WSDEQUE_INVARIANTS(q); // NB. these loads must be ordered, otherwise there is a race // between steal and pop. - t = q->top; - load_load_barrier(); - b = q->bottom; + StgWord t = ACQUIRE_LOAD(&q->top); + SEQ_CST_FENCE(); + StgWord b = ACQUIRE_LOAD(&q->bottom); - // NB. b and t are unsigned; we need a signed value for the test - // below, because it is possible that t > b during a - // concurrent popWSQueue() operation. - if ((long)b - (long)t <= 0 ) { - return NULL; /* already looks empty, abort */ + void *result = NULL; + if (t < b) { + /* Non-empty queue */ + result = RELAXED_LOAD(&q->elements[t % q->size]); + if (!cas_top(q, t, t+1)) { + return NULL; + } } - // NB. the load of q->bottom must be ordered before the load of - // q->elements[t & q-> moduloSize]. See comment "KG:..." below - // and Ticket #13633. - load_load_barrier(); - /* now access array, see pushBottom() */ - stolen = q->elements[t & q->moduloSize]; - - /* now decide whether we have won */ - if ( !(CASTOP(&(q->top),t,t+1)) ) { - /* lost the race, someone else has changed top in the meantime */ - return NULL; - } /* else: OK, top has been incremented by the cas call */ - - // debugBelch("stealWSDeque_: t=%d b=%d\n", t, b); - -// Can't do this on someone else's spark pool: -// ASSERT_WSDEQUE_INVARIANTS(q); - - bufs[n] ++; - if (bufs[n] == BUF) { bufs[n] = 0; } - last_b[n][bufs[n]] = b; - last_t[n][bufs[n]] = t; - last_v[n][bufs[n]] = (StgWord)stolen; - return stolen; + return result; } void * View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c2af6875d84404724a864eba3be278d77d1d5837...8d6a72d52a3ec5c56174cc034583466fa406d0f4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c2af6875d84404724a864eba3be278d77d1d5837...8d6a72d52a3ec5c56174cc034583466fa406d0f4 You're receiving 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 Jun 11 16:13:00 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sun, 11 Jun 2023 12:13:00 -0400 Subject: [Git][ghc/ghc][wip/tsan/no-barriers] 7 commits: compiler: Drop MO_WriteBarrier Message-ID: <6485f28ceaec9_111d63c55e42666ac@gitlab.mail> Sven Tennie pushed to branch wip/tsan/no-barriers at Glasgow Haskell Compiler / GHC Commits: dc21307d by Ben Gamari at 2023-06-11T16:05:22+00:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - a3f6c586 by Ben Gamari at 2023-06-11T16:05:40+00:00 rts: Drop load_store_barrier() This is no longer used. - - - - - cd128c18 by Ben Gamari at 2023-06-11T16:05:40+00:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - e7824177 by Ben Gamari at 2023-06-11T16:06:50+00:00 rts: Eliminate remaining uses of load_load_barrier - - - - - abb01e73 by Sven Tennie at 2023-06-11T16:07:03+00:00 compiler: Drop MO_ReadBarrier - - - - - 5a3d2f4e by Ben Gamari at 2023-06-11T16:07:03+00:00 rts: Drop load_load_barrier This is no longer used. - - - - - deaef0bb by Sven Tennie at 2023-06-11T16:08:39+00:00 Delete write_barrier function - - - - - 23 changed files: - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/StgToCmm/Prim.hs - rts/CloneStack.c - rts/PrimOps.cmm - rts/RaiseAsync.c - rts/RtsSymbols.c - rts/Sparks.c - rts/TopHandler.c - rts/include/Cmm.h - rts/include/Stg.h - rts/include/stg/SMP.h - rts/sm/Evac.c - rts/sm/GC.c - rts/sm/GCAux.c - rts/sm/Sanity.c - testsuite/tests/rts/testwsdeque.c Changes: ===================================== compiler/GHC/Cmm/MachOp.hs ===================================== @@ -670,8 +670,6 @@ data CallishMachOp | MO_SubIntC Width | MO_U_Mul2 Width - | MO_ReadBarrier - | MO_WriteBarrier | MO_Touch -- Keep variables live (when using interior pointers) -- Prefetch ===================================== compiler/GHC/Cmm/Parser.y ===================================== @@ -1120,8 +1120,6 @@ callishMachOps platform = listToUFM $ -- TODO: Rename to acquire_fence and release_fence ( "fence_acquire", (MO_AcquireFence,)), ( "fence_release", (MO_ReleaseFence,)), - ( "read_barrier", (MO_ReadBarrier,)), - ( "write_barrier", (MO_WriteBarrier,)), ( "memcpy", memcpyLikeTweakArgs MO_Memcpy ), ( "memset", memcpyLikeTweakArgs MO_Memset ), ( "memmove", memcpyLikeTweakArgs MO_Memmove ), ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -1560,9 +1560,6 @@ genCCall target dest_regs arg_regs bid = do -- Memory Ordering MO_AcquireFence -> return (unitOL DMBISH, Nothing) MO_ReleaseFence -> return (unitOL DMBISH, Nothing) - -- TODO DMBSY is probably *way* too much! - MO_ReadBarrier -> return (unitOL DMBSY, Nothing) - MO_WriteBarrier -> return (unitOL DMBSY, Nothing) MO_Touch -> return (nilOL, Nothing) -- Keep variables live (when using interior pointers) -- Prefetch MO_Prefetch_Data _n -> return (nilOL, Nothing) -- Prefetch hint. ===================================== compiler/GHC/CmmToAsm/PPC/CodeGen.hs ===================================== @@ -1131,11 +1131,6 @@ genCCall (PrimTarget MO_AcquireFence) _ _ genCCall (PrimTarget MO_ReleaseFence) _ _ = return $ unitOL LWSYNC -genCCall (PrimTarget MO_ReadBarrier) _ _ - = return $ unitOL LWSYNC -genCCall (PrimTarget MO_WriteBarrier) _ _ - = return $ unitOL LWSYNC - genCCall (PrimTarget MO_Touch) _ _ = return $ nilOL @@ -2099,8 +2094,6 @@ genCCall' config gcp target dest_regs args MO_AddIntC {} -> unsupported MO_SubIntC {} -> unsupported MO_U_Mul2 {} -> unsupported - MO_ReadBarrier -> unsupported - MO_WriteBarrier -> unsupported MO_AcquireFence -> unsupported MO_ReleaseFence -> unsupported MO_Touch -> unsupported ===================================== compiler/GHC/CmmToAsm/Wasm/FromCmm.hs ===================================== @@ -1188,8 +1188,6 @@ lower_CallishMachOp lbl MO_F32_Sqrt rs xs = lower_CMO_Un_Homo lbl "sqrtf" rs xs lower_CallishMachOp lbl (MO_UF_Conv w0) rs xs = lower_MO_UF_Conv lbl w0 rs xs lower_CallishMachOp _ MO_AcquireFence _ _ = pure $ WasmStatements WasmNop lower_CallishMachOp _ MO_ReleaseFence _ _ = pure $ WasmStatements WasmNop -lower_CallishMachOp _ MO_ReadBarrier _ _ = pure $ WasmStatements WasmNop -lower_CallishMachOp _ MO_WriteBarrier _ _ = pure $ WasmStatements WasmNop lower_CallishMachOp _ MO_Touch _ _ = pure $ WasmStatements WasmNop lower_CallishMachOp _ (MO_Prefetch_Data {}) _ _ = pure $ WasmStatements WasmNop lower_CallishMachOp lbl (MO_Memcpy {}) [] xs = do ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -2162,8 +2162,6 @@ genSimplePrim bid (MO_Memcmp align) [res] [dst,src,n] = genMemCmp bid a genSimplePrim bid (MO_Memset align) [] [dst,c,n] = genMemSet bid align dst c n genSimplePrim _ MO_AcquireFence [] [] = return nilOL -- barriers compile to no code on x86/x86-64; genSimplePrim _ MO_ReleaseFence [] [] = return nilOL -- we keep it this long in order to prevent earlier optimisations. -genSimplePrim _ MO_ReadBarrier [] [] = return nilOL -- barriers compile to no code on x86/x86-64; -genSimplePrim _ MO_WriteBarrier [] [] = return nilOL -- we keep it this long in order to prevent earlier optimisations. genSimplePrim _ MO_Touch [] [_] = return nilOL genSimplePrim _ (MO_Prefetch_Data n) [] [src] = genPrefetchData n src genSimplePrim _ (MO_BSwap width) [dst] [src] = genByteSwap width dst src ===================================== compiler/GHC/CmmToC.hs ===================================== @@ -951,8 +951,6 @@ pprCallishMachOp_for_C mop MO_F32_Fabs -> text "fabsf" MO_AcquireFence -> unsupported MO_ReleaseFence -> unsupported - MO_ReadBarrier -> text "load_load_barrier" - MO_WriteBarrier -> text "write_barrier" MO_Memcpy _ -> text "__builtin_memcpy" MO_Memset _ -> text "__builtin_memset" MO_Memmove _ -> text "__builtin_memmove" ===================================== compiler/GHC/CmmToLlvm/CodeGen.hs ===================================== @@ -171,21 +171,6 @@ getInstrinct fname retTy parTys = fty = LMFunction funSig in getInstrinct2 fname fty --- | Memory barrier instruction for LLVM >= 3.0 -barrier :: LlvmM StmtData -barrier = do - let s = Fence False SyncSeqCst - return (unitOL s, []) - --- | Insert a 'barrier', unless the target platform is in the provided list of --- exceptions (where no code will be emitted instead). -barrierUnless :: [Arch] -> LlvmM StmtData -barrierUnless exs = do - platform <- getPlatform - if platformArch platform `elem` exs - then return (nilOL, []) - else barrier - -- | Foreign Calls genCall :: ForeignTarget -> [CmmFormal] -> [CmmActual] -> LlvmM StmtData @@ -196,15 +181,6 @@ genCall (PrimTarget MO_AcquireFence) _ _ = runStmtsDecls $ genCall (PrimTarget MO_ReleaseFence) _ _ = runStmtsDecls $ statement $ Fence False SyncRelease -genCall (PrimTarget MO_ReadBarrier) _ _ = - barrierUnless [ArchX86, ArchX86_64] - -genCall (PrimTarget MO_WriteBarrier) _ _ = - barrierUnless [ArchX86, ArchX86_64] - -genCall (PrimTarget MO_Touch) _ _ = - return (nilOL, []) - genCall (PrimTarget (MO_UF_Conv w)) [dst] [e] = runStmtsDecls $ do dstV <- getCmmRegW (CmmLocal dst) let ty = cmmToLlvmType $ localRegType dst @@ -1013,8 +989,6 @@ cmmPrimOpFunctions mop = do -- We support MO_U_Mul2 through ordinary LLVM mul instruction, see the -- appropriate case of genCall. MO_U_Mul2 {} -> unsupported - MO_ReadBarrier -> unsupported - MO_WriteBarrier -> unsupported MO_ReleaseFence -> unsupported MO_AcquireFence -> unsupported MO_Touch -> unsupported ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -2177,7 +2177,7 @@ doWritePtrArrayOp addr idx val -- This write barrier is to ensure that the heap writes to the object -- referred to by val have happened before we write val into the array. -- See #12469 for details. - emitPrimCall [] MO_WriteBarrier [] + emitPrimCall [] MO_AcquireFence [] mkBasicIndexedWrite hdr_size addr ty idx val emit (setInfo addr (CmmLit (CmmLabel mkMAP_DIRTY_infoLabel))) @@ -3048,7 +3048,7 @@ doWriteSmallPtrArrayOp addr idx val = do mkBasicIndexedRead NaturallyAligned (smallArrPtrsHdrSize profile) Nothing ty tmp addr ty idx whenUpdRemSetEnabled $ emitUpdRemSetPush (CmmReg (CmmLocal tmp)) - emitPrimCall [] MO_WriteBarrier [] -- #12469 + emitPrimCall [] MO_AcquireFence [] -- #12469 mkBasicIndexedWrite (smallArrPtrsHdrSize profile) addr ty idx val emit (setInfo addr (CmmLit (CmmLabel mkSMAP_DIRTY_infoLabel))) ===================================== rts/CloneStack.c ===================================== @@ -74,9 +74,7 @@ void sendCloneStackMessage(StgTSO *tso, HsStablePtr mvar) { msg = (MessageCloneStack *)allocate(srcCapability, sizeofW(MessageCloneStack)); msg->tso = tso; msg->result = (StgMVar*)deRefStablePtr(mvar); - SET_HDR(msg, &stg_MSG_CLONE_STACK_info, CCS_SYSTEM); - // Ensure that writes constructing Message are committed before sending. - write_barrier(); + SET_HDR_RELEASE(msg, &stg_MSG_CLONE_STACK_info, CCS_SYSTEM); sendMessage(srcCapability, tso->cap, (Message *)msg); } ===================================== rts/PrimOps.cmm ===================================== @@ -2505,8 +2505,9 @@ stg_unpackClosurezh ( P_ closure ) { W_ info, ptrs, nptrs, p, ptrs_arr, dat_arr; MAYBE_GC_P(stg_unpackClosurezh, closure); - info = %GET_STD_INFO(UNTAG(closure)); - prim_read_barrier; + info = GET_INFO_ACQUIRE(UNTAG(closure)); + // TODO: Is this correct? + info = %STD_INFO(info); ptrs = TO_W_(%INFO_PTRS(info)); nptrs = TO_W_(%INFO_NPTRS(info)); @@ -2820,8 +2821,7 @@ stg_noDuplicatezh /* no arg list: explicit stack layout */ stg_getApStackValzh ( P_ ap_stack, W_ offset ) { W_ ap_stackinfo; - ap_stackinfo = %INFO_PTR(UNTAG(ap_stack)); - prim_read_barrier; + ap_stackinfo = GET_INFO_ACQUIRE(UNTAG(ap_stack)); if (ap_stackinfo == stg_AP_STACK_info) { return (1,StgAP_STACK_payload(ap_stack,offset)); } else { ===================================== rts/RaiseAsync.c ===================================== @@ -238,7 +238,7 @@ throwToMsg (Capability *cap, MessageThrowTo *msg) goto check_target; retry: - write_barrier(); + RELEASE_FENCE(); // TODO: is this necessary? debugTrace(DEBUG_sched, "throwTo: retrying..."); check_target: @@ -874,9 +874,10 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception, ap->payload[i] = (StgClosure *)*sp++; } - write_barrier(); // XXX: Necessary? SET_HDR(ap,&stg_AP_STACK_info, ((StgClosure *)frame)->header.prof.ccs /* ToDo */); + // N.B. This will be made visible by updateThunk below, which + // implies a release memory barrier. TICK_ALLOC_UP_THK(AP_STACK_sizeW(words),0); //IF_DEBUG(scheduler, ===================================== rts/RtsSymbols.c ===================================== @@ -909,9 +909,6 @@ extern char **environ; SymI_HasProto(hs_spt_remove) \ SymI_HasProto(hs_spt_keys) \ SymI_HasProto(hs_spt_key_count) \ - SymI_HasProto(write_barrier) \ - SymI_HasProto(store_load_barrier) \ - SymI_HasProto(load_load_barrier) \ SymI_HasProto(cas) \ SymI_HasProto(_assertFail) \ SymI_HasProto(keepCAFs) \ ===================================== rts/Sparks.c ===================================== @@ -209,8 +209,7 @@ pruneSparkQueue (bool nonmovingMarkFinished, Capability *cap) cap->spark_stats.fizzled++; traceEventSparkFizzle(cap); } else { - info = RELAXED_LOAD(&spark->header.info); - load_load_barrier(); + info = ACQUIRE_LOAD(&spark->header.info); if (IS_FORWARDING_PTR(info)) { tmp = (StgClosure*)UN_FORWARDING_PTR(info); /* if valuable work: shift inside the pool */ ===================================== rts/TopHandler.c ===================================== @@ -32,8 +32,7 @@ StgTSO *getTopHandlerThread(void) { // topHandlerPtr was never initialised return NULL; } - const StgInfoTable *info = weak->header.info; - load_load_barrier(); + const StgInfoTable *info = ACQUIRE_LOAD(&weak->header.info); if (info == &stg_WEAK_info) { StgClosure *key = ((StgWeak*)weak)->key; ===================================== rts/include/Cmm.h ===================================== @@ -681,7 +681,6 @@ // For discussion of how these are used to fence heap object // accesses see Note [Heap memory barriers] in SMP.h. #if defined(THREADED_RTS) -#define prim_read_barrier prim %read_barrier() #define prim_write_barrier prim %write_barrier() // See Note [ThreadSanitizer and fences] @@ -690,8 +689,6 @@ #else -#define prim_read_barrier /* nothing */ -#define prim_write_barrier /* nothing */ #define RELEASE_FENCE /* nothing */ #define ACQUIRE_FENCE /* nothing */ #endif /* THREADED_RTS */ ===================================== rts/include/Stg.h ===================================== @@ -392,7 +392,7 @@ external prototype return neither of these types to workaround #11395. #endif #include "stg/Prim.h" /* ghc-prim fallbacks */ -#include "stg/SMP.h" // write_barrier() inline is required +#include "stg/SMP.h" /* ----------------------------------------------------------------------------- Moving Floats and Doubles ===================================== rts/include/stg/SMP.h ===================================== @@ -44,11 +44,6 @@ void arm_atomic_spin_unlock(void); ------------------------------------------------------------------------- */ #if !IN_STG_CODE || IN_STGCRUN -// We only want the barriers, e.g. write_barrier(), declared in .hc -// files. Defining the other inline functions here causes type -// mismatch errors from gcc, because the generated C code is assuming -// that there are no prototypes in scope. - /* * The atomic exchange operation: xchg(p,w) exchanges the value * pointed to by p with the value w, returning the old value. @@ -105,24 +100,6 @@ EXTERN_INLINE void busy_wait_nop(void); #endif // !IN_STG_CODE -/* - * Various kinds of memory barrier. - * write_barrier: prevents future stores occurring before preceding stores. - * store_load_barrier: prevents future loads occurring before preceding stores. - * load_load_barrier: prevents future loads occurring before earlier loads. - * - * Reference for these: "The JSR-133 Cookbook for Compiler Writers" - * http://gee.cs.oswego.edu/dl/jmm/cookbook.html - * - * To check whether you got these right, try the test in - * testsuite/tests/rts/testwsdeque.c - * This tests the work-stealing deque implementation, which relies on - * properly working store_load and load_load memory barriers. - */ -EXTERN_INLINE void write_barrier(void); -EXTERN_INLINE void store_load_barrier(void); -EXTERN_INLINE void load_load_barrier(void); - /* * Note [Heap memory barriers] * ~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -354,7 +331,7 @@ EXTERN_INLINE void load_load_barrier(void); * Exchange the value pointed to by p with w and return the former. This * function is used to acquire a lock. An acquire memory barrier is sufficient * for a lock operation because corresponding unlock operation issues a - * store-store barrier (write_barrier()) immediately before releasing the lock. + * store-store barrier (release-store) immediately before releasing the lock. */ EXTERN_INLINE StgWord xchg(StgPtr p, StgWord w) @@ -463,91 +440,6 @@ busy_wait_nop(void) #endif // !IN_STG_CODE -/* - * We need to tell both the compiler AND the CPU about the barriers. - * It's no good preventing the CPU from reordering the operations if - * the compiler has already done so - hence the "memory" restriction - * on each of the barriers below. - */ -EXTERN_INLINE void -write_barrier(void) { -#if defined(NOSMP) - return; -#elif defined(TSAN_ENABLED) - // RELEASE is a bit stronger than the store-store barrier provided by - // write_barrier, consequently we only use this case as a conservative - // approximation when using ThreadSanitizer. See Note [ThreadSanitizer]. - __atomic_thread_fence(__ATOMIC_RELEASE); -#elif defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) \ - || defined(powerpc64le_HOST_ARCH) - __asm__ __volatile__ ("lwsync" : : : "memory"); -#elif defined(s390x_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH) - __asm__ __volatile__ ("dmb st" : : : "memory"); -#elif defined(riscv64_HOST_ARCH) - __asm__ __volatile__ ("fence w,w" : : : "memory"); -#elif defined(loongarch64_HOST_ARCH) - __asm__ __volatile__ ("dbar 0" : : : "memory"); -#else -#error memory barriers unimplemented on this architecture -#endif -} - -EXTERN_INLINE void -store_load_barrier(void) { -#if defined(NOSMP) - return; -#elif defined(i386_HOST_ARCH) - __asm__ __volatile__ ("lock; addl $0,0(%%esp)" : : : "memory"); -#elif defined(x86_64_HOST_ARCH) - __asm__ __volatile__ ("lock; addq $0,0(%%rsp)" : : : "memory"); -#elif defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) \ - || defined(powerpc64le_HOST_ARCH) - __asm__ __volatile__ ("sync" : : : "memory"); -#elif defined(s390x_HOST_ARCH) - __asm__ __volatile__ ("bcr 14,0" : : : "memory"); -#elif defined(arm_HOST_ARCH) - __asm__ __volatile__ ("dmb" : : : "memory"); -#elif defined(aarch64_HOST_ARCH) - __asm__ __volatile__ ("dmb sy" : : : "memory"); -#elif defined(riscv64_HOST_ARCH) - __asm__ __volatile__ ("fence w,r" : : : "memory"); -#elif defined(loongarch64_HOST_ARCH) - __asm__ __volatile__ ("dbar 0" : : : "memory"); -#else -#error memory barriers unimplemented on this architecture -#endif -} - -EXTERN_INLINE void -load_load_barrier(void) { -#if defined(NOSMP) - return; -#elif defined(i386_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(x86_64_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) \ - || defined(powerpc64le_HOST_ARCH) - __asm__ __volatile__ ("lwsync" : : : "memory"); -#elif defined(s390x_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(arm_HOST_ARCH) - __asm__ __volatile__ ("dmb" : : : "memory"); -#elif defined(aarch64_HOST_ARCH) - __asm__ __volatile__ ("dmb ld" : : : "memory"); -#elif defined(riscv64_HOST_ARCH) - __asm__ __volatile__ ("fence r,r" : : : "memory"); -#elif defined(loongarch64_HOST_ARCH) - __asm__ __volatile__ ("dbar 0" : : : "memory"); -#else -#error memory barriers unimplemented on this architecture -#endif -} - // Load a pointer from a memory location that might be being modified // concurrently. This prevents the compiler from optimising away // multiple loads of the memory location, as it might otherwise do in @@ -586,13 +478,6 @@ load_load_barrier(void) { /* ---------------------------------------------------------------------- */ #else /* !THREADED_RTS */ -EXTERN_INLINE void write_barrier(void); -EXTERN_INLINE void store_load_barrier(void); -EXTERN_INLINE void load_load_barrier(void); -EXTERN_INLINE void write_barrier () {} /* nothing */ -EXTERN_INLINE void store_load_barrier() {} /* nothing */ -EXTERN_INLINE void load_load_barrier () {} /* nothing */ - // Relaxed atomic operations #define RELAXED_LOAD(ptr) *ptr #define RELAXED_STORE(ptr,val) *ptr = val ===================================== rts/sm/Evac.c ===================================== @@ -1394,8 +1394,7 @@ selector_loop: // the same selector thunk. SET_INFO((StgClosure*)p, (StgInfoTable *)info_ptr); OVERWRITING_CLOSURE((StgClosure*)p); - SET_INFO((StgClosure*)p, &stg_WHITEHOLE_info); - write_barrier(); + SET_INFO_RELEASE((StgClosure*)p, &stg_WHITEHOLE_info); #if defined(PARALLEL_GC) abort(); // LDV is incompatible with parallel GC #endif ===================================== rts/sm/GC.c ===================================== @@ -1508,7 +1508,6 @@ waitForGcThreads (Capability *cap, bool idle_cap[]) if (i == me || idle_cap[i]) { continue; } if (SEQ_CST_LOAD(&gc_threads[i]->wakeup) != GC_THREAD_STANDING_BY) { prodCapability(getCapability(i), cap->running_task); - write_barrier(); interruptCapability(getCapability(i)); } } ===================================== rts/sm/GCAux.c ===================================== @@ -91,8 +91,9 @@ isAlive(StgClosure *p) return TAG_CLOSURE(tag,(StgClosure*)UN_FORWARDING_PTR(info)); } + // TODO: Is this correct? + ACQUIRE_LOAD(&q->header.info); info = INFO_PTR_TO_STRUCT(info); - load_load_barrier(); switch (info->type) { ===================================== rts/sm/Sanity.c ===================================== @@ -355,8 +355,7 @@ checkClosure( const StgClosure* p ) p = UNTAG_CONST_CLOSURE(p); - info = p->header.info; - load_load_barrier(); + info = ACQUIRE_LOAD(&p->header.info); if (IS_FORWARDING_PTR(info)) { barf("checkClosure: found EVACUATED closure %d", info->type); @@ -367,7 +366,6 @@ checkClosure( const StgClosure* p ) #endif info = INFO_PTR_TO_STRUCT(info); - load_load_barrier(); switch (info->type) { @@ -772,8 +770,7 @@ checkSTACK (StgStack *stack) void checkTSO(StgTSO *tso) { - const StgInfoTable *info = (const StgInfoTable*) tso->_link->header.info; - load_load_barrier(); + const StgInfoTable *info = (const StgInfoTable*) ACQUIRE_LOAD(&tso->_link)->header.info; ASSERT(tso->_link == END_TSO_QUEUE || info == &stg_MVAR_TSO_QUEUE_info || ===================================== testsuite/tests/rts/testwsdeque.c ===================================== @@ -34,47 +34,25 @@ void * myStealWSDeque_ (WSDeque *q, uint32_t n) { void * stolen; - StgWord b,t; // Can't do this on someone else's spark pool: // ASSERT_WSDEQUE_INVARIANTS(q); // NB. these loads must be ordered, otherwise there is a race // between steal and pop. - t = q->top; - load_load_barrier(); - b = q->bottom; + StgWord t = ACQUIRE_LOAD(&q->top); + SEQ_CST_FENCE(); + StgWord b = ACQUIRE_LOAD(&q->bottom); - // NB. b and t are unsigned; we need a signed value for the test - // below, because it is possible that t > b during a - // concurrent popWSQueue() operation. - if ((long)b - (long)t <= 0 ) { - return NULL; /* already looks empty, abort */ + void *result = NULL; + if (t < b) { + /* Non-empty queue */ + result = RELAXED_LOAD(&q->elements[t % q->size]); + if (!cas_top(q, t, t+1)) { + return NULL; + } } - // NB. the load of q->bottom must be ordered before the load of - // q->elements[t & q-> moduloSize]. See comment "KG:..." below - // and Ticket #13633. - load_load_barrier(); - /* now access array, see pushBottom() */ - stolen = q->elements[t & q->moduloSize]; - - /* now decide whether we have won */ - if ( !(CASTOP(&(q->top),t,t+1)) ) { - /* lost the race, someone else has changed top in the meantime */ - return NULL; - } /* else: OK, top has been incremented by the cas call */ - - // debugBelch("stealWSDeque_: t=%d b=%d\n", t, b); - -// Can't do this on someone else's spark pool: -// ASSERT_WSDEQUE_INVARIANTS(q); - - bufs[n] ++; - if (bufs[n] == BUF) { bufs[n] = 0; } - last_b[n][bufs[n]] = b; - last_t[n][bufs[n]] = t; - last_v[n][bufs[n]] = (StgWord)stolen; - return stolen; + return result; } void * View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8d6a72d52a3ec5c56174cc034583466fa406d0f4...deaef0bb4dfce1fb0a28498b19758e92fac82787 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8d6a72d52a3ec5c56174cc034583466fa406d0f4...deaef0bb4dfce1fb0a28498b19758e92fac82787 You're receiving 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 Jun 11 18:50:18 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Sun, 11 Jun 2023 14:50:18 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] Compiler working with e-graph Message-ID: <6486176a10867_111d63dc1d7f428162e@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: e47b9368 by Rodrigo Mesquita at 2023-06-11T20:50:06+02:00 Compiler working with e-graph - - - - - 4 changed files: - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/Types/Unique/SDFM.hs - libraries/hegg Changes: ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -49,7 +49,6 @@ import GHC.Data.Bag import GHC.Types.CompleteMatch import GHC.Types.Unique.Set import GHC.Types.Unique.DSet -import GHC.Types.Unique.SDFM import GHC.Types.Id import GHC.Types.Name import GHC.Types.Var (EvVar) @@ -99,6 +98,11 @@ import Data.List (sortBy, find) import qualified Data.List.NonEmpty as NE import Data.Ord (comparing) +import Data.Functor.Const +import Data.Equality.Graph (EGraph) +import Data.Equality.Utils (Fix(..)) +import qualified Data.Equality.Graph as EG + -- -- * Main exports -- @@ -685,32 +689,38 @@ filterUnliftedFields con args = -- ⊥. addBotCt :: Nabla -> Id -> MaybeT DsM Nabla addBotCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x = do - let (y, vi at VI { vi_bot = bot }) = lookupVarInfoNT (nabla_tm_st nabla) x - case bot of - IsNotBot -> mzero -- There was x ≁ ⊥. Contradiction! - IsBot -> pure nabla -- There already is x ~ ⊥. Nothing left to do - MaybeBot -- We add x ~ ⊥ - | definitelyUnliftedType (idType x) - -- Case (3) in Note [Strict fields and variables of unlifted type] - -> mzero -- unlifted vars can never be ⊥ - | otherwise - -> do - let vi' = vi{ vi_bot = IsBot } - pure nabla{ nabla_tm_st = ts{ts_facts = addToUSDFM env y vi' } } + let (xid, env') = EG.represent (Fix $ Const x) env + env'' <- EG.adjustF go xid env' + pure nabla{nabla_tm_st = ts{ts_facts = env''}} + where + go :: VarInfo -> MaybeT DsM VarInfo + go vi at VI { vi_bot = bot } + = case bot of + IsNotBot -> mzero -- There was x ≁ ⊥. Contradiction! + IsBot -> pure vi -- There already is x ~ ⊥. Nothing left to do + MaybeBot -- We add x ~ ⊥ + | definitelyUnliftedType (idType x) + -- Case (3) in Note [Strict fields and variables of unlifted type] + -> mzero -- unlifted vars can never be ⊥ + | otherwise + -> do + pure vi{ vi_bot = IsBot } -- | Adds the constraint @x ~/ ⊥@ to 'Nabla'. Quite similar to 'addNotConCt', -- but only cares for the ⊥ "constructor". addNotBotCt :: Nabla -> Id -> MaybeT DsM Nabla addNotBotCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts=env} } x = do - let (y, vi at VI { vi_bot = bot }) = lookupVarInfoNT (nabla_tm_st nabla) x + let (xid, env') = EG.represent (Fix $ Const x) env + -- ROMES:TODO: This could be all be a function passed to adjust + let (y, vi at VI { vi_bot = bot }, TmSt{ts_facts=env''}) = lookupVarInfoNT (ts{ts_facts=env'}) x -- ROMES:TODO: this will represent x again (quite cheap still), but whatever for now case bot of IsBot -> mzero -- There was x ~ ⊥. Contradiction! - IsNotBot -> pure nabla -- There already is x ≁ ⊥. Nothing left to do + IsNotBot -> pure nabla -- There already is x ≁ ⊥. Nothing left to do (ROMES:TODO missing env') MaybeBot -> do -- We add x ≁ ⊥ and test if x is still inhabited -- Mark dirty for a delayed inhabitation test let vi' = vi{ vi_bot = IsNotBot} pure $ markDirty y - $ nabla{ nabla_tm_st = ts{ ts_facts = addToUSDFM env y vi' } } + $ nabla{ nabla_tm_st = ts{ ts_facts = EG.adjust (const vi') xid env''} } -- | Record a @x ~/ K@ constraint, e.g. that a particular 'Id' @x@ can't -- take the shape of a 'PmAltCon' @K@ in the 'Nabla' and return @Nothing@ if @@ -769,7 +779,10 @@ hasRequiredTheta _ = False -- See Note [TmState invariants]. addConCt :: Nabla -> Id -> PmAltCon -> [TyVar] -> [Id] -> MaybeT DsM Nabla addConCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x alt tvs args = do - let vi@(VI _ pos neg bot _) = lookupVarInfo ts x + let (xid, env') = EG.represent (Fix $ Const x) env + -- ROMES:TODO: Omssions of updates on ts_facts on nabla are fine, but not perfect. Get it consistent + -- ROMES:TODO: Also looks like a function on varinfo (adjust) + let (vi@(VI _ pos neg bot _), TmSt{ts_facts=env''}) = lookupVarInfo (ts{ts_facts=env'}) x -- First try to refute with a negative fact guard (not (elemPmAltConSet alt neg)) -- Then see if any of the other solutions (remember: each of them is an @@ -788,7 +801,7 @@ addConCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x alt tvs args = Nothing -> do let pos' = PACA alt tvs args : pos let nabla_with bot' = - nabla{ nabla_tm_st = ts{ts_facts = addToUSDFM env x (vi{vi_pos = pos', vi_bot = bot'})} } + nabla{ nabla_tm_st = ts{ts_facts = EG.adjust (const (vi{vi_pos = pos', vi_bot = bot'})) xid env''} } -- Do (2) in Note [Coverage checking Newtype matches] case (alt, args) of (PmAltConLike (RealDataCon dc), [y]) | isNewDataCon dc -> @@ -817,11 +830,13 @@ equateTys ts us = -- -- See Note [TmState invariants]. addVarCt :: Nabla -> Id -> Id -> MaybeT DsM Nabla +-- This is where equality-graphs really come into play. addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = - case equateUSDFM env x y of - (Nothing, env') -> pure (nabla{ nabla_tm_st = ts{ ts_facts = env' } }) + -- ROMES:TODO: equate auxiliary var that finds both vars, and lookups up the domain associated. However, I think we no longer should have Just/Nothing but rather always store emptyVarInfo for new e-nodes + -- equate should also update e-graph, basically re-implement "equateUSDFM" in terms of the e-graph, or inline it or so + case equate env x y of -- Add the constraints we had for x to y - (Just vi_x, env') -> do + (vi_x, env') -> do let nabla_equated = nabla{ nabla_tm_st = ts{ts_facts = env'} } -- and then gradually merge every positive fact we have on x into y let add_pos nabla (PACA cl tvs args) = addConCt nabla y cl tvs args @@ -829,6 +844,25 @@ addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = -- Do the same for negative info let add_neg nabla nalt = addNotConCt nabla y nalt foldlM add_neg nabla_pos (pmAltConSetElems (vi_neg vi_x)) + where + -- | @equate env x y@ makes @x@ and @y@ point to the same entry, + -- thereby merging @x@'s class with @y@'s. + -- If both @x@ and @y@ are in the domain of the map, then @y@'s entry will be + -- chosen as the new entry and @x@'s old entry will be returned. + -- + -- Examples in terms of the model (see 'UniqSDFM'): + -- >>> equate [] u1 u2 == (Nothing, [({u1,u2}, Nothing)]) + -- >>> equate [({u1,u3}, Just ele1)] u3 u4 == (Nothing, [({u1,u3,u4}, Just ele1)]) + -- >>> equate [({u1,u3}, Just ele1)] u4 u3 == (Nothing, [({u1,u3,u4}, Just ele1)]) + -- >>> equate [({u1,u3}, Just ele1), ({u2}, Just ele2)] u3 u2 == (Just ele1, [({u2,u1,u3}, Just ele2)]) + equate :: EGraph VarInfo (Const Id) -> Id -> Id -> (VarInfo, EGraph VarInfo (Const Id)) + equate eg x y = do + let (xid, eg') = EG.represent (Fix $ Const x) eg + (yid, eg'') = EG.represent (Fix $ Const y) eg' + (_, eg''') = EG.merge xid yid eg'' + in (EG.lookup xid eg', eg''') + -- Note: lookup in eg', because it's before the merge. + -- | Inspects a 'PmCoreCt' @let x = e@ by recording constraints for @x@ based -- on the shape of the 'CoreExpr' @e at . Examples: @@ -955,6 +989,7 @@ modifyT f = StateT $ fmap ((,) ()) . f -- there weren't any such constraints. representCoreExpr :: Nabla -> CoreExpr -> DsM (Id, Nabla) representCoreExpr nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_reps = reps } } e +-- ROMES:TODO: Represent | Just rep <- lookupCoreMap reps key = pure (rep, nabla) | otherwise = do rep <- mkPmId (exprType e) @@ -1280,13 +1315,15 @@ traverseDirty f ts at TmSt{ts_facts = env, ts_dirty = dirty} = go (uniqDSetToList dirty) env where go [] env = pure ts{ts_facts=env} - go (x:xs) !env = do - vi' <- f (lookupVarInfo ts x) - go xs (addToUSDFM env x vi') + go (x:xs) !_env = do + let (vi, TmSt{ts_facts=env'}) = lookupVarInfo ts x + vi' <- f vi -- todo: lookupvar should really return the xid + let (xid,env'') = EG.represent (Fix $ Const x) env' -- ROMES:TODO: really, a helper functoin for representing Ids + go xs (EG.adjust (const vi') xid env'') traverseAll :: Monad m => (VarInfo -> m VarInfo) -> TmState -> m TmState traverseAll f ts at TmSt{ts_facts = env} = do - env' <- traverseUSDFM f env + env' <- EG.traverseAnalysisData f env pure ts{ts_facts = env'} -- | Makes sure the given 'Nabla' is still inhabited, by trying to instantiate @@ -1321,6 +1358,9 @@ inhabitationTest fuel old_ty_st nabla at MkNabla{ nabla_tm_st = ts } = {-# SCC "in instantiate (fuel-1) nabla_not_dirty vi _ -> pure vi +-- ROMES:TODO: The dirty shortcutting bit seems like the bookeeping on nodes to +-- upward merge, perhaps we can rid of it too + -- | Checks whether the given 'VarInfo' needs to be tested for inhabitants. -- Returns `False` when we can skip the inhabitation test, presuming it would -- say "yes" anyway. See Note [Shortcutting the inhabitation test]. @@ -1393,7 +1433,7 @@ instCompleteSets fuel nabla vi = {-# SCC "instCompleteSets" #-} do let x = vi_id vi (rcm, nabla) <- lift (addNormalisedTypeMatches nabla x) nabla <- foldM (\nabla cls -> instCompleteSet fuel nabla x cls) nabla (getRcm rcm) - pure (lookupVarInfo (nabla_tm_st nabla) x) + pure (fst $ lookupVarInfo (nabla_tm_st nabla) x) anyConLikeSolution :: (ConLike -> Bool) -> [PmAltConApp] -> Bool anyConLikeSolution p = any (go . paca_con) @@ -1422,7 +1462,7 @@ instCompleteSet fuel nabla x cs | otherwise = {-# SCC "instCompleteSet" #-} go nabla (sorted_candidates cs) where - vi = lookupVarInfo (nabla_tm_st nabla) x + (vi, _env') = lookupVarInfo (nabla_tm_st nabla) x sorted_candidates :: CompleteMatch -> [ConLike] sorted_candidates cm @@ -1911,7 +1951,7 @@ generateInhabitingPatterns _ _ 0 _ = pure [] generateInhabitingPatterns _ [] _ nabla = pure [nabla] generateInhabitingPatterns mode (x:xs) n nabla = do tracePm "generateInhabitingPatterns" (ppr mode <+> ppr n <+> ppr (x:xs) $$ ppr nabla) - let VI _ pos neg _ _ = lookupVarInfo (nabla_tm_st nabla) x + let (VI _ pos neg _ _, _env') = lookupVarInfo (nabla_tm_st nabla) x case pos of _:_ -> do -- Example for multiple solutions (must involve a PatSyn): @@ -1949,7 +1989,7 @@ generateInhabitingPatterns mode (x:xs) n nabla = do case mb_stuff of Nothing -> pure [] Just (y, newty_nabla) -> do - let vi = lookupVarInfo (nabla_tm_st newty_nabla) y + let (vi, _env) = lookupVarInfo (nabla_tm_st newty_nabla) y env <- dsGetFamInstEnvs rcm <- case splitReprTyConApp_maybe env rep_ty of Just (tc, _, _) -> addTyConMatches tc (vi_rcm vi) ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -1,3 +1,6 @@ +{-# OPTIONS_GHC -Wno-orphans #-} -- Oh god, ROMES:TODO +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} @@ -44,7 +47,6 @@ import GHC.Data.FastString import GHC.Types.Id import GHC.Types.Var.Set import GHC.Types.Unique.DSet -import GHC.Types.Unique.SDFM import GHC.Types.Name import GHC.Core.DataCon import GHC.Core.ConLike @@ -75,6 +77,12 @@ import Data.Ratio import GHC.Real (Ratio(..)) import qualified Data.Semigroup as Semi +import Data.Functor.Const +import Data.Equality.Analysis (Analysis(..)) +import Data.Equality.Graph (EGraph) +import Data.Equality.Utils (Fix(..)) +import qualified Data.Equality.Graph as EG + -- import GHC.Driver.Ppr -- @@ -138,18 +146,23 @@ initTyState = TySt 0 emptyInert -- See Note [TmState invariants] in "GHC.HsToCore.Pmc.Solver". data TmState = TmSt - { ts_facts :: !(UniqSDFM Id VarInfo) + { ts_facts :: !(EGraph VarInfo (Const Id)) -- ROMES:TODO: The Id here is because we don't merge yet ts_reps into the e-graph; so we simply have Ids as E-nodes -- ^ Facts about term variables. Deterministic env, so that we generate -- deterministic error messages. +-- ROMES:TODO: ts_reps perhaps too as well... but a first iteration should map CoreMap to ClassId, and replace just ts_facts. , ts_reps :: !(CoreMap Id) -- ^ An environment for looking up whether we already encountered semantically -- equivalent expressions that we want to represent by the same 'Id' -- representative. +-- ROMES:TODO: ts_dirty looks a bit to me like the bookeeping needed to know +-- which nodes to upward merge, perhaps we can get rid of it too. , ts_dirty :: !DIdSet -- ^ Which 'VarInfo' needs to be checked for inhabitants because of new -- negative constraints (e.g. @x ≁ ⊥@ or @x ≁ K@). } +instance EG.Language (Const Id) + -- | Information about an 'Id'. Stores positive ('vi_pos') facts, like @x ~ Just 42@, -- and negative ('vi_neg') facts, like "x is not (:)". -- Also caches the type ('vi_ty'), the 'ResidualCompleteMatches' of a COMPLETE set @@ -202,6 +215,18 @@ data VarInfo -- to recognise completion of a COMPLETE set efficiently for large enums. } +-- | This instance is seriously wrong for general purpose, it's just required for instancing Analysis. +-- There ought to be a better way. +instance Eq VarInfo where + (==) _ _ = False +instance Analysis VarInfo (Const Id) where + {-# INLINE makeA #-} + {-# INLINE joinA #-} + makeA (Const id) = emptyVarInfo id + -- romes: so currently, variables are joined in 'addVarCt' manually by getting the old value of $x$ and assuming the value of $y$ was chosen. + -- That's obviously bad now, it'd be much more clearer to do it here. It's just the nabla threading that's more trouble + joinA _a b = b + data PmAltConApp = PACA { paca_con :: !PmAltCon @@ -227,7 +252,7 @@ instance Outputable BotInfo where -- | Not user-facing. instance Outputable TmState where - ppr (TmSt state reps dirty) = ppr state $$ ppr reps $$ ppr dirty + ppr (TmSt _state reps dirty) = text "" $$ ppr reps $$ ppr dirty -- | Not user-facing. instance Outputable VarInfo where @@ -248,7 +273,7 @@ instance Outputable VarInfo where -- | Initial state of the term oracle. initTmState :: TmState -initTmState = TmSt emptyUSDFM emptyCoreMap emptyDVarSet +initTmState = TmSt EG.emptyEGraph emptyCoreMap emptyDVarSet -- | A data type that caches for the 'VarInfo' of @x@ the results of querying -- 'dsGetCompleteMatches' and then striking out all occurrences of @K@ for @@ -300,9 +325,17 @@ emptyVarInfo x , vi_rcm = emptyRCM } -lookupVarInfo :: TmState -> Id -> VarInfo --- (lookupVarInfo tms x) tells what we know about 'x' -lookupVarInfo (TmSt env _ _) x = fromMaybe (emptyVarInfo x) (lookupUSDFM env x) +-- | @lookupVarInfo tms x@ tells what we know about 'x' +--- romes: TODO: lookupVarInfo should also return the ClassId the Id was represented in..., that'd make things better +lookupVarInfo :: TmState -> Id -> (VarInfo, TmState) +lookupVarInfo tm@(TmSt env _ _) x + -- = fromMaybe (emptyVarInfo x) (lookupUSDFM env x) + -- ROMES:TODO Kind of an issue here, we could have a lookup operation on e-graphs but it'd be good to make it faster + -- We will want to assume every Id is mapped to VarInfo, with emptyVarInfo as the default rather than Maybe + -- I'm just unsure if the Id always exists or not. + -- Then again this shouldn't be Id, but rather ClassId§ + = let (i,env') = EG.represent (Fix $ Const x) env + in (EG.lookup i env', tm{ts_facts=env'}) -- | Like @lookupVarInfo ts x@, but @lookupVarInfo ts x = (y, vi)@ also looks -- through newtype constructors. We have @x ~ N1 (... (Nk y))@ such that the @@ -314,22 +347,27 @@ lookupVarInfo (TmSt env _ _) x = fromMaybe (emptyVarInfo x) (lookupUSDFM env x) -- modulo type normalisation! -- -- See also Note [Coverage checking Newtype matches] in GHC.HsToCore.Pmc.Solver. -lookupVarInfoNT :: TmState -> Id -> (Id, VarInfo) +lookupVarInfoNT :: TmState -> Id -> (Id, VarInfo, TmState) lookupVarInfoNT ts x = case lookupVarInfo ts x of - VI{ vi_pos = as_newtype -> Just y } -> lookupVarInfoNT ts y - res -> (x, res) + (VI{ vi_pos = as_newtype -> Just y },ts') + -> lookupVarInfoNT ts' y + (res,ts') + -> (x, res, ts') where as_newtype = listToMaybe . mapMaybe go go PACA{paca_con = PmAltConLike (RealDataCon dc), paca_ids = [y]} | isNewDataCon dc = Just y go _ = Nothing +-- ROMES:TODO: What does this do, how to update? trvVarInfo :: Functor f => (VarInfo -> f (a, VarInfo)) -> Nabla -> Id -> f (a, Nabla) -trvVarInfo f nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts = env} } x - = set_vi <$> f (lookupVarInfo ts x) +trvVarInfo f nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts = _env} } x + -- ROMES:TODO: adjust on the EG, instead of fetching? the (a,) bit is not trivial + = let (vi, ts'@TmSt{ts_facts = env'}) = lookupVarInfo ts x + set_vi (a, vi') = + (a, nabla{ nabla_tm_st = ts'{ ts_facts = let (i,env'') = EG.represent (Fix $ Const $ vi_id vi') env' in EG.adjust (const vi') i env'' } }) + in set_vi <$> f vi where - set_vi (a, vi') = - (a, nabla{ nabla_tm_st = ts{ ts_facts = addToUSDFM env (vi_id vi') vi' } }) ------------------------------------------------ -- * Exported utility functions querying 'Nabla' @@ -338,7 +376,9 @@ lookupRefuts :: Nabla -> Id -> [PmAltCon] -- Unfortunately we need the extra bit of polymorphism and the unfortunate -- duplication of lookupVarInfo here. lookupRefuts MkNabla{ nabla_tm_st = ts } x = - pmAltConSetElems $ vi_neg $ lookupVarInfo ts x + -- bimap (pmAltConSetElems . vi_neg) (\ts' -> nabla{nabla_tm_st=ts'}) $ lookupVarInfo ts x + -- ROMES:TODO: It's a bit unfortunate we forget the representation of $x$, but OK + pmAltConSetElems $ vi_neg $ fst $ lookupVarInfo ts x isDataConSolution :: PmAltConApp -> Bool isDataConSolution PACA{paca_con = PmAltConLike (RealDataCon _)} = True @@ -347,11 +387,12 @@ isDataConSolution _ = False -- @lookupSolution nabla x@ picks a single solution ('vi_pos') of @x@ from -- possibly many, preferring 'RealDataCon' solutions whenever possible. lookupSolution :: Nabla -> Id -> Maybe PmAltConApp -lookupSolution nabla x = case vi_pos (lookupVarInfo (nabla_tm_st nabla) x) of - [] -> Nothing - pos@(x:_) - | Just sol <- find isDataConSolution pos -> Just sol - | otherwise -> Just x +lookupSolution nabla x = case vi_pos $ fst $ lookupVarInfo (nabla_tm_st nabla) x of + -- ROMES:TODO: It's a bit unfortunate we forget the representation of $x$, but OK + [] -> Nothing + pos@(x:_) + | Just sol <- find isDataConSolution pos -> Just sol + | otherwise -> Just x -------------------------------------------------------------------------------- -- The rest is just providing an IR for (overloaded!) literals and AltCons that ===================================== compiler/GHC/Types/Unique/SDFM.hs ===================================== @@ -82,6 +82,7 @@ lookupUSDFM usdfm x = snd (lookupReprAndEntryUSDFM usdfm x) -- >>> equateUSDFM [({u1,u3}, Just ele1)] u3 u4 == (Nothing, [({u1,u3,u4}, Just ele1)]) -- >>> equateUSDFM [({u1,u3}, Just ele1)] u4 u3 == (Nothing, [({u1,u3,u4}, Just ele1)]) -- >>> equateUSDFM [({u1,u3}, Just ele1), ({u2}, Just ele2)] u3 u2 == (Just ele1, [({u2,u1,u3}, Just ele2)]) +-- ROMES:TODO: Are all USDFM functions just for the PMC Nabla TM? equateUSDFM :: Uniquable key => UniqSDFM key ele -> key -> key -> (Maybe ele, UniqSDFM key ele) equateUSDFM usdfm@(USDFM env) x y = ===================================== libraries/hegg ===================================== @@ -1 +1 @@ -Subproject commit ec0f55ce20bee83738ed29dcd5fb4159f9e90df4 +Subproject commit 67453e7735fdfc9e6212c607ba3ed855d525d349 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e47b9368a23a41cd77bf2510df0add03a5252201 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e47b9368a23a41cd77bf2510df0add03a5252201 You're receiving 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 Jun 11 19:52:00 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Sun, 11 Jun 2023 15:52:00 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] Compiler working with e-graph Message-ID: <648625e069fa4_111d63c55e428495c@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: d0575935 by Rodrigo Mesquita at 2023-06-11T21:51:42+02:00 Compiler working with e-graph - - - - - 4 changed files: - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/Types/Unique/SDFM.hs - libraries/hegg Changes: ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -49,7 +49,6 @@ import GHC.Data.Bag import GHC.Types.CompleteMatch import GHC.Types.Unique.Set import GHC.Types.Unique.DSet -import GHC.Types.Unique.SDFM import GHC.Types.Id import GHC.Types.Name import GHC.Types.Var (EvVar) @@ -99,6 +98,11 @@ import Data.List (sortBy, find) import qualified Data.List.NonEmpty as NE import Data.Ord (comparing) +import Data.Functor.Const +import Data.Equality.Graph (EGraph) +import Data.Equality.Utils (Fix(..)) +import qualified Data.Equality.Graph as EG + -- -- * Main exports -- @@ -685,32 +689,38 @@ filterUnliftedFields con args = -- ⊥. addBotCt :: Nabla -> Id -> MaybeT DsM Nabla addBotCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x = do - let (y, vi at VI { vi_bot = bot }) = lookupVarInfoNT (nabla_tm_st nabla) x - case bot of - IsNotBot -> mzero -- There was x ≁ ⊥. Contradiction! - IsBot -> pure nabla -- There already is x ~ ⊥. Nothing left to do - MaybeBot -- We add x ~ ⊥ - | definitelyUnliftedType (idType x) - -- Case (3) in Note [Strict fields and variables of unlifted type] - -> mzero -- unlifted vars can never be ⊥ - | otherwise - -> do - let vi' = vi{ vi_bot = IsBot } - pure nabla{ nabla_tm_st = ts{ts_facts = addToUSDFM env y vi' } } + let (xid, env') = EG.represent (Fix $ Const x) env + env'' <- EG.adjustF go xid env' + pure nabla{nabla_tm_st = ts{ts_facts = env''}} + where + go :: VarInfo -> MaybeT DsM VarInfo + go vi at VI { vi_bot = bot } + = case bot of + IsNotBot -> mzero -- There was x ≁ ⊥. Contradiction! + IsBot -> pure vi -- There already is x ~ ⊥. Nothing left to do + MaybeBot -- We add x ~ ⊥ + | definitelyUnliftedType (idType x) + -- Case (3) in Note [Strict fields and variables of unlifted type] + -> mzero -- unlifted vars can never be ⊥ + | otherwise + -> do + pure vi{ vi_bot = IsBot } -- | Adds the constraint @x ~/ ⊥@ to 'Nabla'. Quite similar to 'addNotConCt', -- but only cares for the ⊥ "constructor". addNotBotCt :: Nabla -> Id -> MaybeT DsM Nabla addNotBotCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts=env} } x = do - let (y, vi at VI { vi_bot = bot }) = lookupVarInfoNT (nabla_tm_st nabla) x + let (xid, env') = EG.represent (Fix $ Const x) env + -- ROMES:TODO: This could be all be a function passed to adjust + let (y, vi at VI { vi_bot = bot }, TmSt{ts_facts=env''}) = lookupVarInfoNT (ts{ts_facts=env'}) x -- ROMES:TODO: this will represent x again (quite cheap still), but whatever for now case bot of IsBot -> mzero -- There was x ~ ⊥. Contradiction! - IsNotBot -> pure nabla -- There already is x ≁ ⊥. Nothing left to do + IsNotBot -> pure nabla -- There already is x ≁ ⊥. Nothing left to do (ROMES:TODO missing env') MaybeBot -> do -- We add x ≁ ⊥ and test if x is still inhabited -- Mark dirty for a delayed inhabitation test let vi' = vi{ vi_bot = IsNotBot} pure $ markDirty y - $ nabla{ nabla_tm_st = ts{ ts_facts = addToUSDFM env y vi' } } + $ nabla{ nabla_tm_st = ts{ ts_facts = EG.adjust (const vi') xid env''} } -- | Record a @x ~/ K@ constraint, e.g. that a particular 'Id' @x@ can't -- take the shape of a 'PmAltCon' @K@ in the 'Nabla' and return @Nothing@ if @@ -769,7 +779,10 @@ hasRequiredTheta _ = False -- See Note [TmState invariants]. addConCt :: Nabla -> Id -> PmAltCon -> [TyVar] -> [Id] -> MaybeT DsM Nabla addConCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x alt tvs args = do - let vi@(VI _ pos neg bot _) = lookupVarInfo ts x + let (xid, env') = EG.represent (Fix $ Const x) env + -- ROMES:TODO: Omssions of updates on ts_facts on nabla are fine, but not perfect. Get it consistent + -- ROMES:TODO: Also looks like a function on varinfo (adjust) + let (vi@(VI _ pos neg bot _), TmSt{ts_facts=env''}) = lookupVarInfo (ts{ts_facts=env'}) x -- First try to refute with a negative fact guard (not (elemPmAltConSet alt neg)) -- Then see if any of the other solutions (remember: each of them is an @@ -788,7 +801,7 @@ addConCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x alt tvs args = Nothing -> do let pos' = PACA alt tvs args : pos let nabla_with bot' = - nabla{ nabla_tm_st = ts{ts_facts = addToUSDFM env x (vi{vi_pos = pos', vi_bot = bot'})} } + nabla{ nabla_tm_st = ts{ts_facts = EG.adjust (const (vi{vi_pos = pos', vi_bot = bot'})) xid env''} } -- Do (2) in Note [Coverage checking Newtype matches] case (alt, args) of (PmAltConLike (RealDataCon dc), [y]) | isNewDataCon dc -> @@ -817,11 +830,13 @@ equateTys ts us = -- -- See Note [TmState invariants]. addVarCt :: Nabla -> Id -> Id -> MaybeT DsM Nabla +-- This is where equality-graphs really come into play. addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = - case equateUSDFM env x y of - (Nothing, env') -> pure (nabla{ nabla_tm_st = ts{ ts_facts = env' } }) + -- ROMES:TODO: equate auxiliary var that finds both vars, and lookups up the domain associated. However, I think we no longer should have Just/Nothing but rather always store emptyVarInfo for new e-nodes + -- equate should also update e-graph, basically re-implement "equateUSDFM" in terms of the e-graph, or inline it or so + case equate env x y of -- Add the constraints we had for x to y - (Just vi_x, env') -> do + (vi_x, env') -> do let nabla_equated = nabla{ nabla_tm_st = ts{ts_facts = env'} } -- and then gradually merge every positive fact we have on x into y let add_pos nabla (PACA cl tvs args) = addConCt nabla y cl tvs args @@ -829,6 +844,25 @@ addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = -- Do the same for negative info let add_neg nabla nalt = addNotConCt nabla y nalt foldlM add_neg nabla_pos (pmAltConSetElems (vi_neg vi_x)) + where + -- @equate env x y@ makes @x@ and @y@ point to the same entry, + -- thereby merging @x@'s class with @y@'s. + -- If both @x@ and @y@ are in the domain of the map, then @y@'s entry will be + -- chosen as the new entry and @x@'s old entry will be returned. + -- + -- Examples in terms of the model (see 'UniqSDFM'): + -- >>> equate [] u1 u2 == (Nothing, [({u1,u2}, Nothing)]) + -- >>> equate [({u1,u3}, Just ele1)] u3 u4 == (Nothing, [({u1,u3,u4}, Just ele1)]) + -- >>> equate [({u1,u3}, Just ele1)] u4 u3 == (Nothing, [({u1,u3,u4}, Just ele1)]) + -- >>> equate [({u1,u3}, Just ele1), ({u2}, Just ele2)] u3 u2 == (Just ele1, [({u2,u1,u3}, Just ele2)]) + equate :: EGraph VarInfo (Const Id) -> Id -> Id -> (VarInfo, EGraph VarInfo (Const Id)) + equate eg x y = do + let (xid, eg') = EG.represent (Fix $ Const x) eg + (yid, eg'') = EG.represent (Fix $ Const y) eg' + (_, eg''') = EG.merge xid yid eg'' + in (EG.lookup xid eg', eg''') + -- Note: lookup in eg', because it's before the merge. + -- | Inspects a 'PmCoreCt' @let x = e@ by recording constraints for @x@ based -- on the shape of the 'CoreExpr' @e at . Examples: @@ -955,6 +989,7 @@ modifyT f = StateT $ fmap ((,) ()) . f -- there weren't any such constraints. representCoreExpr :: Nabla -> CoreExpr -> DsM (Id, Nabla) representCoreExpr nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_reps = reps } } e +-- ROMES:TODO: Represent | Just rep <- lookupCoreMap reps key = pure (rep, nabla) | otherwise = do rep <- mkPmId (exprType e) @@ -1280,13 +1315,15 @@ traverseDirty f ts at TmSt{ts_facts = env, ts_dirty = dirty} = go (uniqDSetToList dirty) env where go [] env = pure ts{ts_facts=env} - go (x:xs) !env = do - vi' <- f (lookupVarInfo ts x) - go xs (addToUSDFM env x vi') + go (x:xs) !_env = do + let (vi, TmSt{ts_facts=env'}) = lookupVarInfo ts x + vi' <- f vi -- todo: lookupvar should really return the xid + let (xid,env'') = EG.represent (Fix $ Const x) env' -- ROMES:TODO: really, a helper functoin for representing Ids + go xs (EG.adjust (const vi') xid env'') traverseAll :: Monad m => (VarInfo -> m VarInfo) -> TmState -> m TmState traverseAll f ts at TmSt{ts_facts = env} = do - env' <- traverseUSDFM f env + env' <- EG.traverseAnalysisData f env pure ts{ts_facts = env'} -- | Makes sure the given 'Nabla' is still inhabited, by trying to instantiate @@ -1321,6 +1358,9 @@ inhabitationTest fuel old_ty_st nabla at MkNabla{ nabla_tm_st = ts } = {-# SCC "in instantiate (fuel-1) nabla_not_dirty vi _ -> pure vi +-- ROMES:TODO: The dirty shortcutting bit seems like the bookeeping on nodes to +-- upward merge, perhaps we can rid of it too + -- | Checks whether the given 'VarInfo' needs to be tested for inhabitants. -- Returns `False` when we can skip the inhabitation test, presuming it would -- say "yes" anyway. See Note [Shortcutting the inhabitation test]. @@ -1393,7 +1433,7 @@ instCompleteSets fuel nabla vi = {-# SCC "instCompleteSets" #-} do let x = vi_id vi (rcm, nabla) <- lift (addNormalisedTypeMatches nabla x) nabla <- foldM (\nabla cls -> instCompleteSet fuel nabla x cls) nabla (getRcm rcm) - pure (lookupVarInfo (nabla_tm_st nabla) x) + pure (fst $ lookupVarInfo (nabla_tm_st nabla) x) anyConLikeSolution :: (ConLike -> Bool) -> [PmAltConApp] -> Bool anyConLikeSolution p = any (go . paca_con) @@ -1422,7 +1462,7 @@ instCompleteSet fuel nabla x cs | otherwise = {-# SCC "instCompleteSet" #-} go nabla (sorted_candidates cs) where - vi = lookupVarInfo (nabla_tm_st nabla) x + (vi, _env') = lookupVarInfo (nabla_tm_st nabla) x sorted_candidates :: CompleteMatch -> [ConLike] sorted_candidates cm @@ -1911,7 +1951,7 @@ generateInhabitingPatterns _ _ 0 _ = pure [] generateInhabitingPatterns _ [] _ nabla = pure [nabla] generateInhabitingPatterns mode (x:xs) n nabla = do tracePm "generateInhabitingPatterns" (ppr mode <+> ppr n <+> ppr (x:xs) $$ ppr nabla) - let VI _ pos neg _ _ = lookupVarInfo (nabla_tm_st nabla) x + let (VI _ pos neg _ _, _env') = lookupVarInfo (nabla_tm_st nabla) x case pos of _:_ -> do -- Example for multiple solutions (must involve a PatSyn): @@ -1949,7 +1989,7 @@ generateInhabitingPatterns mode (x:xs) n nabla = do case mb_stuff of Nothing -> pure [] Just (y, newty_nabla) -> do - let vi = lookupVarInfo (nabla_tm_st newty_nabla) y + let (vi, _env) = lookupVarInfo (nabla_tm_st newty_nabla) y env <- dsGetFamInstEnvs rcm <- case splitReprTyConApp_maybe env rep_ty of Just (tc, _, _) -> addTyConMatches tc (vi_rcm vi) ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -1,3 +1,6 @@ +{-# OPTIONS_GHC -Wno-orphans #-} -- Oh god, ROMES:TODO +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} @@ -44,7 +47,6 @@ import GHC.Data.FastString import GHC.Types.Id import GHC.Types.Var.Set import GHC.Types.Unique.DSet -import GHC.Types.Unique.SDFM import GHC.Types.Name import GHC.Core.DataCon import GHC.Core.ConLike @@ -75,6 +77,12 @@ import Data.Ratio import GHC.Real (Ratio(..)) import qualified Data.Semigroup as Semi +import Data.Functor.Const +import Data.Equality.Analysis (Analysis(..)) +import Data.Equality.Graph (EGraph) +import Data.Equality.Utils (Fix(..)) +import qualified Data.Equality.Graph as EG + -- import GHC.Driver.Ppr -- @@ -138,18 +146,23 @@ initTyState = TySt 0 emptyInert -- See Note [TmState invariants] in "GHC.HsToCore.Pmc.Solver". data TmState = TmSt - { ts_facts :: !(UniqSDFM Id VarInfo) + { ts_facts :: !(EGraph VarInfo (Const Id)) -- ROMES:TODO: The Id here is because we don't merge yet ts_reps into the e-graph; so we simply have Ids as E-nodes -- ^ Facts about term variables. Deterministic env, so that we generate -- deterministic error messages. +-- ROMES:TODO: ts_reps perhaps too as well... but a first iteration should map CoreMap to ClassId, and replace just ts_facts. , ts_reps :: !(CoreMap Id) -- ^ An environment for looking up whether we already encountered semantically -- equivalent expressions that we want to represent by the same 'Id' -- representative. +-- ROMES:TODO: ts_dirty looks a bit to me like the bookeeping needed to know +-- which nodes to upward merge, perhaps we can get rid of it too. , ts_dirty :: !DIdSet -- ^ Which 'VarInfo' needs to be checked for inhabitants because of new -- negative constraints (e.g. @x ≁ ⊥@ or @x ≁ K@). } +instance EG.Language (Const Id) + -- | Information about an 'Id'. Stores positive ('vi_pos') facts, like @x ~ Just 42@, -- and negative ('vi_neg') facts, like "x is not (:)". -- Also caches the type ('vi_ty'), the 'ResidualCompleteMatches' of a COMPLETE set @@ -202,6 +215,18 @@ data VarInfo -- to recognise completion of a COMPLETE set efficiently for large enums. } +-- | This instance is seriously wrong for general purpose, it's just required for instancing Analysis. +-- There ought to be a better way. +instance Eq VarInfo where + (==) _ _ = False +instance Analysis VarInfo (Const Id) where + {-# INLINE makeA #-} + {-# INLINE joinA #-} + makeA (Const id) = emptyVarInfo id + -- romes: so currently, variables are joined in 'addVarCt' manually by getting the old value of $x$ and assuming the value of $y$ was chosen. + -- That's obviously bad now, it'd be much more clearer to do it here. It's just the nabla threading that's more trouble + joinA _a b = b + data PmAltConApp = PACA { paca_con :: !PmAltCon @@ -227,7 +252,7 @@ instance Outputable BotInfo where -- | Not user-facing. instance Outputable TmState where - ppr (TmSt state reps dirty) = ppr state $$ ppr reps $$ ppr dirty + ppr (TmSt _state reps dirty) = text "" $$ ppr reps $$ ppr dirty -- | Not user-facing. instance Outputable VarInfo where @@ -248,7 +273,7 @@ instance Outputable VarInfo where -- | Initial state of the term oracle. initTmState :: TmState -initTmState = TmSt emptyUSDFM emptyCoreMap emptyDVarSet +initTmState = TmSt EG.emptyEGraph emptyCoreMap emptyDVarSet -- | A data type that caches for the 'VarInfo' of @x@ the results of querying -- 'dsGetCompleteMatches' and then striking out all occurrences of @K@ for @@ -300,9 +325,17 @@ emptyVarInfo x , vi_rcm = emptyRCM } -lookupVarInfo :: TmState -> Id -> VarInfo --- (lookupVarInfo tms x) tells what we know about 'x' -lookupVarInfo (TmSt env _ _) x = fromMaybe (emptyVarInfo x) (lookupUSDFM env x) +-- | @lookupVarInfo tms x@ tells what we know about 'x' +--- romes: TODO: lookupVarInfo should also return the ClassId the Id was represented in..., that'd make things better +lookupVarInfo :: TmState -> Id -> (VarInfo, TmState) +lookupVarInfo tm@(TmSt env _ _) x + -- = fromMaybe (emptyVarInfo x) (lookupUSDFM env x) + -- ROMES:TODO Kind of an issue here, we could have a lookup operation on e-graphs but it'd be good to make it faster + -- We will want to assume every Id is mapped to VarInfo, with emptyVarInfo as the default rather than Maybe + -- I'm just unsure if the Id always exists or not. + -- Then again this shouldn't be Id, but rather ClassId§ + = let (i,env') = EG.represent (Fix $ Const x) env + in (EG.lookup i env', tm{ts_facts=env'}) -- | Like @lookupVarInfo ts x@, but @lookupVarInfo ts x = (y, vi)@ also looks -- through newtype constructors. We have @x ~ N1 (... (Nk y))@ such that the @@ -314,22 +347,27 @@ lookupVarInfo (TmSt env _ _) x = fromMaybe (emptyVarInfo x) (lookupUSDFM env x) -- modulo type normalisation! -- -- See also Note [Coverage checking Newtype matches] in GHC.HsToCore.Pmc.Solver. -lookupVarInfoNT :: TmState -> Id -> (Id, VarInfo) +lookupVarInfoNT :: TmState -> Id -> (Id, VarInfo, TmState) lookupVarInfoNT ts x = case lookupVarInfo ts x of - VI{ vi_pos = as_newtype -> Just y } -> lookupVarInfoNT ts y - res -> (x, res) + (VI{ vi_pos = as_newtype -> Just y },ts') + -> lookupVarInfoNT ts' y + (res,ts') + -> (x, res, ts') where as_newtype = listToMaybe . mapMaybe go go PACA{paca_con = PmAltConLike (RealDataCon dc), paca_ids = [y]} | isNewDataCon dc = Just y go _ = Nothing +-- ROMES:TODO: What does this do, how to update? trvVarInfo :: Functor f => (VarInfo -> f (a, VarInfo)) -> Nabla -> Id -> f (a, Nabla) -trvVarInfo f nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts = env} } x - = set_vi <$> f (lookupVarInfo ts x) +trvVarInfo f nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts = _env} } x + -- ROMES:TODO: adjust on the EG, instead of fetching? the (a,) bit is not trivial + = let (vi, ts'@TmSt{ts_facts = env'}) = lookupVarInfo ts x + set_vi (a, vi') = + (a, nabla{ nabla_tm_st = ts'{ ts_facts = let (i,env'') = EG.represent (Fix $ Const $ vi_id vi') env' in EG.adjust (const vi') i env'' } }) + in set_vi <$> f vi where - set_vi (a, vi') = - (a, nabla{ nabla_tm_st = ts{ ts_facts = addToUSDFM env (vi_id vi') vi' } }) ------------------------------------------------ -- * Exported utility functions querying 'Nabla' @@ -338,7 +376,9 @@ lookupRefuts :: Nabla -> Id -> [PmAltCon] -- Unfortunately we need the extra bit of polymorphism and the unfortunate -- duplication of lookupVarInfo here. lookupRefuts MkNabla{ nabla_tm_st = ts } x = - pmAltConSetElems $ vi_neg $ lookupVarInfo ts x + -- bimap (pmAltConSetElems . vi_neg) (\ts' -> nabla{nabla_tm_st=ts'}) $ lookupVarInfo ts x + -- ROMES:TODO: It's a bit unfortunate we forget the representation of $x$, but OK + pmAltConSetElems $ vi_neg $ fst $ lookupVarInfo ts x isDataConSolution :: PmAltConApp -> Bool isDataConSolution PACA{paca_con = PmAltConLike (RealDataCon _)} = True @@ -347,11 +387,12 @@ isDataConSolution _ = False -- @lookupSolution nabla x@ picks a single solution ('vi_pos') of @x@ from -- possibly many, preferring 'RealDataCon' solutions whenever possible. lookupSolution :: Nabla -> Id -> Maybe PmAltConApp -lookupSolution nabla x = case vi_pos (lookupVarInfo (nabla_tm_st nabla) x) of - [] -> Nothing - pos@(x:_) - | Just sol <- find isDataConSolution pos -> Just sol - | otherwise -> Just x +lookupSolution nabla x = case vi_pos $ fst $ lookupVarInfo (nabla_tm_st nabla) x of + -- ROMES:TODO: It's a bit unfortunate we forget the representation of $x$, but OK + [] -> Nothing + pos@(x:_) + | Just sol <- find isDataConSolution pos -> Just sol + | otherwise -> Just x -------------------------------------------------------------------------------- -- The rest is just providing an IR for (overloaded!) literals and AltCons that ===================================== compiler/GHC/Types/Unique/SDFM.hs ===================================== @@ -82,6 +82,7 @@ lookupUSDFM usdfm x = snd (lookupReprAndEntryUSDFM usdfm x) -- >>> equateUSDFM [({u1,u3}, Just ele1)] u3 u4 == (Nothing, [({u1,u3,u4}, Just ele1)]) -- >>> equateUSDFM [({u1,u3}, Just ele1)] u4 u3 == (Nothing, [({u1,u3,u4}, Just ele1)]) -- >>> equateUSDFM [({u1,u3}, Just ele1), ({u2}, Just ele2)] u3 u2 == (Just ele1, [({u2,u1,u3}, Just ele2)]) +-- ROMES:TODO: Are all USDFM functions just for the PMC Nabla TM? equateUSDFM :: Uniquable key => UniqSDFM key ele -> key -> key -> (Maybe ele, UniqSDFM key ele) equateUSDFM usdfm@(USDFM env) x y = ===================================== libraries/hegg ===================================== @@ -1 +1 @@ -Subproject commit ec0f55ce20bee83738ed29dcd5fb4159f9e90df4 +Subproject commit 67453e7735fdfc9e6212c607ba3ed855d525d349 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d0575935ff754d76fd358ba6229e7fc6c798801b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d0575935ff754d76fd358ba6229e7fc6c798801b You're receiving 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 Jun 11 22:27:05 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Sun, 11 Jun 2023 18:27:05 -0400 Subject: [Git][ghc/ghc][wip/T23176] Use tcInferFRR to prevent bad generalisation Message-ID: <64864a393ed11_111d63c7c2c299766@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/T23176 at Glasgow Haskell Compiler / GHC Commits: 85f3796d by Krzysztof Gogolewski at 2023-06-12T00:26:33+02:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - 5 changed files: - compiler/GHC/Tc/Gen/Bind.hs - testsuite/tests/polykinds/T22743.stderr - + testsuite/tests/rep-poly/T23176.hs - + testsuite/tests/rep-poly/T23176.stderr - testsuite/tests/rep-poly/all.T Changes: ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -1210,20 +1210,10 @@ This check, mkInferredPolyId, is really in the wrong place: `inferred_poly_ty` doesn't obey the PKTI and it would be better not to generalise it in the first place; see #20686. But for now it works. -How else could we avoid generalising over escaping type variables? I -considered: - -* Adjust the generalisation in GHC.Tc.Solver to directly check for - escaping kind variables; instead, promote or default them. But that - gets into the defaulting swamp and is a non-trivial and unforced - change, so I have left it alone for now. - -* When inferring the type of a binding, in `tcMonoBinds`, we create - an ExpSigmaType with `tcInfer`. If we simply gave it an ir_frr field - that said "must have fixed runtime rep", then the kind would be made - Concrete; and we never generalise over Concrete variables. A bit - more indirect, but we need the "don't generalise over Concrete variables" - stuff anyway. +I considered adjusting the generalisation in GHC.Tc.Solver to directly check for +escaping kind variables; instead, promoting or defaulting them. But that +gets into the defaulting swamp and is a non-trivial and unforced +change, so I have left it alone for now. Note [Impedance matching] ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1312,7 +1302,7 @@ tcMonoBinds is_rec sig_fn no_gen , Nothing <- sig_fn name -- ...with no type signature = setSrcSpanA b_loc $ do { ((co_fn, matches'), rhs_ty') - <- tcInfer $ \ exp_ty -> + <- tcInferFRR (FRRBinder name) $ \ exp_ty -> tcExtendBinderStack [TcIdBndr_ExpType name exp_ty NotTopLevel] $ -- We extend the error context even for a non-recursive -- function so that in type error messages we show the @@ -1334,7 +1324,7 @@ tcMonoBinds is_rec sig_fn no_gen | NonRecursive <- is_rec -- ...binder isn't mentioned in RHS , all (isNothing . sig_fn) bndrs = addErrCtxt (patMonoBindsCtxt pat grhss) $ - do { (grhss', pat_ty) <- tcInfer $ \ exp_ty -> + do { (grhss', pat_ty) <- tcInferFRR FRRPatBind $ \ exp_ty -> tcGRHSsPat grhss exp_ty ; let exp_pat_ty :: Scaled ExpSigmaTypeFRR ===================================== testsuite/tests/polykinds/T22743.stderr ===================================== @@ -1,7 +1,10 @@ -T22743.hs:10:1: error: [GHC-31147] - • Quantified type's kind mentions quantified type variable - type: ‘forall {f :: * -> RuntimeRep} {g} {a :: TYPE (f g)}. a’ - where the body of the forall has this kind: ‘TYPE (f g)’ - • When checking the inferred type - x :: forall {f :: * -> RuntimeRep} {g} {a :: TYPE (f g)}. a +T22743.hs:10:1: error: [GHC-52083] + The binder ‘x’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T22743.hs:10:1: error: [GHC-52083] + The binder ‘x’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. ===================================== testsuite/tests/rep-poly/T23176.hs ===================================== @@ -0,0 +1,6 @@ +module T23176 where + +import GHC.Exts + +f = outOfScope :: (_ :: TYPE (r s)) +(g :: _) = outOfScope :: (_ :: TYPE (r s)) ===================================== testsuite/tests/rep-poly/T23176.stderr ===================================== @@ -0,0 +1,30 @@ + +T23176.hs:5:1: error: [GHC-52083] + The binder ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23176.hs:5:1: error: [GHC-52083] + The binder ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23176.hs:5:1: error: [GHC-52083] + The binder ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23176.hs:6:1: error: [GHC-52083] + The pattern binding + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23176.hs:6:1: error: [GHC-52083] + The pattern binding + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23176.hs:6:1: error: [GHC-52083] + The pattern binding + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. ===================================== testsuite/tests/rep-poly/all.T ===================================== @@ -118,3 +118,4 @@ test('T21650_b', normal, compile_fail, ['-Wno-deprecated-flags']) ## test('T23051', normal, compile_fail, ['']) test('T23153', normal, compile_fail, ['']) test('T23154', normal, compile_fail, ['']) +test('T23176', normal, compile_fail, ['-XPartialTypeSignatures -fdefer-out-of-scope-variables']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/85f3796dba381f0a5e1af45bd7257dd1d92a0480 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/85f3796dba381f0a5e1af45bd7257dd1d92a0480 You're receiving 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 Jun 12 08:58:52 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 12 Jun 2023 04:58:52 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: Fix -Wterm-variable-capture scope (#23434) Message-ID: <6486de4c20f4d_111d63c560c363488@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - 53b05d09 by Oleg Grenrus at 2023-06-12T04:58:25-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to cache the "effective" (small) diagnosticReason, which is then used for pretty-printing of the diagnostic. - - - - - 12b48c9d by Matthew Pickering at 2023-06-12T04:58:36-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - 7d931a46 by Rodrigo Mesquita at 2023-06-12T04:58:36-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 9bc85075 by Victor Cacciari Miraldo at 2023-06-12T04:58:40-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - fe955ff5 by Emily Martins at 2023-06-12T04:58:44-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - 34c93b0b by Victor Cacciari Miraldo at 2023-06-12T04:58:46-04:00 Add regression test for 17328 - - - - - b3c6d543 by Victor Cacciari Miraldo at 2023-06-12T04:58:46-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 30 changed files: - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Utils/Error.hs - configure.ac - distrib/configure.ac.in - docs/users_guide/9.8.1-notes.rst - docs/users_guide/ghci.rst - ghc/GHCi/UI.hs - − ghc/GHCi/UI/Tags.hs - ghc/ghc-bin.cabal.in - libraries/base/Data/Fixed.hs - libraries/base/tests/IO/all.T - libraries/base/tests/all.T - libraries/ghc-compact/tests/all.T - libraries/ghc-heap/tests/all.T - libraries/hpc - libraries/process - + m4/fp_cc_ignore_unused_args.m4 - rts/js/mem.js - testsuite/config/ghc - testsuite/driver/testlib.py - testsuite/tests/cmm/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/229b60d30c7a6dbafb9afc970d511c8c02191d78...b3c6d543c12ec40ac779e8c114f548fe70f70356 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/229b60d30c7a6dbafb9afc970d511c8c02191d78...b3c6d543c12ec40ac779e8c114f548fe70f70356 You're receiving 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 Jun 12 10:07:49 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Mon, 12 Jun 2023 06:07:49 -0400 Subject: [Git][ghc/ghc][wip/tsan/no-barriers] 8 commits: compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE Message-ID: <6486ee75f28d2_111d63c7c40413090@gitlab.mail> Sven Tennie pushed to branch wip/tsan/no-barriers at Glasgow Haskell Compiler / GHC Commits: 8def77f5 by Ben Gamari at 2023-06-12T09:59:21+00:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - fe5e6c3e by Ben Gamari at 2023-06-12T09:59:35+00:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - ab74a337 by Ben Gamari at 2023-06-12T09:59:35+00:00 rts: Drop load_store_barrier() This is no longer used. - - - - - 0e3e7996 by Ben Gamari at 2023-06-12T10:04:24+00:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 95ca4cda by Ben Gamari at 2023-06-12T10:04:38+00:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 600e68d9 by Sven Tennie at 2023-06-12T10:06:49+00:00 compiler: Drop MO_ReadBarrier - - - - - 60991d31 by Ben Gamari at 2023-06-12T10:07:03+00:00 rts: Drop load_load_barrier This is no longer used. - - - - - b0705cc5 by Sven Tennie at 2023-06-12T10:07:03+00:00 Delete write_barrier function - - - - - 25 changed files: - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/StgToCmm/Prim.hs - rts/CloneStack.c - rts/PrimOps.cmm - rts/RaiseAsync.c - rts/RtsSymbols.c - rts/Sparks.c - rts/TopHandler.c - rts/include/Cmm.h - rts/include/Stg.h - rts/include/stg/SMP.h - rts/sm/Evac.c - rts/sm/GC.c - rts/sm/GCAux.c - rts/sm/Sanity.c - testsuite/tests/rts/testwsdeque.c Changes: ===================================== compiler/GHC/Cmm/MachOp.hs ===================================== @@ -670,8 +670,6 @@ data CallishMachOp | MO_SubIntC Width | MO_U_Mul2 Width - | MO_ReadBarrier - | MO_WriteBarrier | MO_Touch -- Keep variables live (when using interior pointers) -- Prefetch @@ -701,6 +699,9 @@ data CallishMachOp | MO_BSwap Width | MO_BRev Width + | MO_AcquireFence + | MO_ReleaseFence + -- | Atomic read-modify-write. Arguments are @[dest, n]@. | MO_AtomicRMW Width AtomicMachOp -- | Atomic read. Arguments are @[addr]@. ===================================== compiler/GHC/Cmm/Parser.y ===================================== @@ -1117,8 +1117,11 @@ callishMachOps platform = listToUFM $ ( "fabs32f", (MO_F32_Fabs,) ), ( "sqrt32f", (MO_F32_Sqrt,) ), - ( "read_barrier", (MO_ReadBarrier,)), - ( "write_barrier", (MO_WriteBarrier,)), + -- TODO: It would be nice to rename the following operations to + -- acquire_fence and release_fence. Be aware that there'll be issues + -- with an overlapping token ('acquire') in the lexer. + ( "fence_acquire", (MO_AcquireFence,)), + ( "fence_release", (MO_ReleaseFence,)), ( "memcpy", memcpyLikeTweakArgs MO_Memcpy ), ( "memset", memcpyLikeTweakArgs MO_Memset ), ( "memmove", memcpyLikeTweakArgs MO_Memmove ), ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -1558,9 +1558,8 @@ genCCall target dest_regs arg_regs bid = do MO_U_Mul2 _w -> unsupported mop -- Memory Ordering - -- TODO DMBSY is probably *way* too much! - MO_ReadBarrier -> return (unitOL DMBSY, Nothing) - MO_WriteBarrier -> return (unitOL DMBSY, Nothing) + MO_AcquireFence -> return (unitOL DMBISH, Nothing) + MO_ReleaseFence -> return (unitOL DMBISH, Nothing) MO_Touch -> return (nilOL, Nothing) -- Keep variables live (when using interior pointers) -- Prefetch MO_Prefetch_Data _n -> return (nilOL, Nothing) -- Prefetch hint. ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -136,6 +136,7 @@ regUsageOfInstr platform instr = case instr of -- 8. Synchronization Instructions ------------------------------------------- DMBSY -> usage ([], []) + DMBISH -> usage ([], []) -- 9. Floating Point Instructions -------------------------------------------- FCVT dst src -> usage (regOp src, regOp dst) @@ -276,6 +277,7 @@ patchRegsOfInstr instr env = case instr of -- 8. Synchronization Instructions ----------------------------------------- DMBSY -> DMBSY + DMBISH -> DMBISH -- 9. Floating Point Instructions ------------------------------------------ FCVT o1 o2 -> FCVT (patchOp o1) (patchOp o2) @@ -645,6 +647,7 @@ data Instr -- 8. Synchronization Instructions ----------------------------------------- | DMBSY + | DMBISH -- 9. Floating Point Instructions -- Float ConVerT | FCVT Operand Operand @@ -724,6 +727,7 @@ instrCon i = BL{} -> "BL" BCOND{} -> "BCOND" DMBSY{} -> "DMBSY" + DMBISH{} -> "DMBISH" FCVT{} -> "FCVT" SCVTF{} -> "SCVTF" FCVTZS{} -> "FCVTZS" ===================================== compiler/GHC/CmmToAsm/AArch64/Ppr.hs ===================================== @@ -530,6 +530,7 @@ pprInstr platform instr = case instr of -- 8. Synchronization Instructions ------------------------------------------- DMBSY -> line $ text "\tdmb sy" + DMBISH -> line $ text "\tdmb ish" -- 9. Floating Point Instructions -------------------------------------------- FCVT o1 o2 -> op2 (text "\tfcvt") o1 o2 SCVTF o1 o2 -> op2 (text "\tscvtf") o1 o2 ===================================== compiler/GHC/CmmToAsm/PPC/CodeGen.hs ===================================== @@ -1126,9 +1126,9 @@ genCCall :: ForeignTarget -- function to call -> [CmmFormal] -- where to put the result -> [CmmActual] -- arguments (of mixed type) -> NatM InstrBlock -genCCall (PrimTarget MO_ReadBarrier) _ _ +genCCall (PrimTarget MO_AcquireFence) _ _ = return $ unitOL LWSYNC -genCCall (PrimTarget MO_WriteBarrier) _ _ +genCCall (PrimTarget MO_ReleaseFence) _ _ = return $ unitOL LWSYNC genCCall (PrimTarget MO_Touch) _ _ @@ -2094,8 +2094,8 @@ genCCall' config gcp target dest_regs args MO_AddIntC {} -> unsupported MO_SubIntC {} -> unsupported MO_U_Mul2 {} -> unsupported - MO_ReadBarrier -> unsupported - MO_WriteBarrier -> unsupported + MO_AcquireFence -> unsupported + MO_ReleaseFence -> unsupported MO_Touch -> unsupported MO_Prefetch_Data _ -> unsupported unsupported = panic ("outOfLineCmmOp: " ++ show mop ===================================== compiler/GHC/CmmToAsm/Wasm/FromCmm.hs ===================================== @@ -1186,8 +1186,8 @@ lower_CallishMachOp lbl MO_F32_ExpM1 rs xs = lower_CallishMachOp lbl MO_F32_Fabs rs xs = lower_CMO_Un_Homo lbl "fabsf" rs xs lower_CallishMachOp lbl MO_F32_Sqrt rs xs = lower_CMO_Un_Homo lbl "sqrtf" rs xs lower_CallishMachOp lbl (MO_UF_Conv w0) rs xs = lower_MO_UF_Conv lbl w0 rs xs -lower_CallishMachOp _ MO_ReadBarrier _ _ = pure $ WasmStatements WasmNop -lower_CallishMachOp _ MO_WriteBarrier _ _ = pure $ WasmStatements WasmNop +lower_CallishMachOp _ MO_AcquireFence _ _ = pure $ WasmStatements WasmNop +lower_CallishMachOp _ MO_ReleaseFence _ _ = pure $ WasmStatements WasmNop lower_CallishMachOp _ MO_Touch _ _ = pure $ WasmStatements WasmNop lower_CallishMachOp _ (MO_Prefetch_Data {}) _ _ = pure $ WasmStatements WasmNop lower_CallishMachOp lbl (MO_Memcpy {}) [] xs = do ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -2160,8 +2160,8 @@ genSimplePrim bid (MO_Memcpy align) [] [dst,src,n] = genMemCpy bid a genSimplePrim bid (MO_Memmove align) [] [dst,src,n] = genMemMove bid align dst src n genSimplePrim bid (MO_Memcmp align) [res] [dst,src,n] = genMemCmp bid align res dst src n genSimplePrim bid (MO_Memset align) [] [dst,c,n] = genMemSet bid align dst c n -genSimplePrim _ MO_ReadBarrier [] [] = return nilOL -- barriers compile to no code on x86/x86-64; -genSimplePrim _ MO_WriteBarrier [] [] = return nilOL -- we keep it this long in order to prevent earlier optimisations. +genSimplePrim _ MO_AcquireFence [] [] = return nilOL -- barriers compile to no code on x86/x86-64; +genSimplePrim _ MO_ReleaseFence [] [] = return nilOL -- we keep it this long in order to prevent earlier optimisations. genSimplePrim _ MO_Touch [] [_] = return nilOL genSimplePrim _ (MO_Prefetch_Data n) [] [src] = genPrefetchData n src genSimplePrim _ (MO_BSwap width) [dst] [src] = genByteSwap width dst src ===================================== compiler/GHC/CmmToC.hs ===================================== @@ -261,6 +261,11 @@ pprStmt platform stmt = CmmUnsafeForeignCall (PrimTarget MO_Touch) _results _args -> empty CmmUnsafeForeignCall (PrimTarget (MO_Prefetch_Data _)) _results _args -> empty + CmmUnsafeForeignCall (PrimTarget MO_ReleaseFence) [] [] -> + text "__atomic_thread_fence(__ATOMIC_RELEASE);" + CmmUnsafeForeignCall (PrimTarget MO_AcquireFence) [] [] -> + text "__atomic_thread_fence(__ATOMIC_ACQUIRE);" + CmmUnsafeForeignCall target@(PrimTarget op) results args -> fn_call where @@ -944,8 +949,8 @@ pprCallishMachOp_for_C mop MO_F32_ExpM1 -> text "expm1f" MO_F32_Sqrt -> text "sqrtf" MO_F32_Fabs -> text "fabsf" - MO_ReadBarrier -> text "load_load_barrier" - MO_WriteBarrier -> text "write_barrier" + MO_AcquireFence -> unsupported + MO_ReleaseFence -> unsupported MO_Memcpy _ -> text "__builtin_memcpy" MO_Memset _ -> text "__builtin_memset" MO_Memmove _ -> text "__builtin_memmove" ===================================== compiler/GHC/CmmToLlvm/CodeGen.hs ===================================== @@ -171,34 +171,15 @@ getInstrinct fname retTy parTys = fty = LMFunction funSig in getInstrinct2 fname fty --- | Memory barrier instruction for LLVM >= 3.0 -barrier :: LlvmM StmtData -barrier = do - let s = Fence False SyncSeqCst - return (unitOL s, []) - --- | Insert a 'barrier', unless the target platform is in the provided list of --- exceptions (where no code will be emitted instead). -barrierUnless :: [Arch] -> LlvmM StmtData -barrierUnless exs = do - platform <- getPlatform - if platformArch platform `elem` exs - then return (nilOL, []) - else barrier - -- | Foreign Calls genCall :: ForeignTarget -> [CmmFormal] -> [CmmActual] -> LlvmM StmtData -- Barriers need to be handled specially as they are implemented as LLVM -- intrinsic functions. -genCall (PrimTarget MO_ReadBarrier) _ _ = - barrierUnless [ArchX86, ArchX86_64] - -genCall (PrimTarget MO_WriteBarrier) _ _ = - barrierUnless [ArchX86, ArchX86_64] - -genCall (PrimTarget MO_Touch) _ _ = - return (nilOL, []) +genCall (PrimTarget MO_AcquireFence) _ _ = runStmtsDecls $ + statement $ Fence False SyncAcquire +genCall (PrimTarget MO_ReleaseFence) _ _ = runStmtsDecls $ + statement $ Fence False SyncRelease genCall (PrimTarget (MO_UF_Conv w)) [dst] [e] = runStmtsDecls $ do dstV <- getCmmRegW (CmmLocal dst) @@ -1008,8 +989,8 @@ cmmPrimOpFunctions mop = do -- We support MO_U_Mul2 through ordinary LLVM mul instruction, see the -- appropriate case of genCall. MO_U_Mul2 {} -> unsupported - MO_ReadBarrier -> unsupported - MO_WriteBarrier -> unsupported + MO_ReleaseFence -> unsupported + MO_AcquireFence -> unsupported MO_Touch -> unsupported MO_UF_Conv _ -> unsupported ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -2177,7 +2177,7 @@ doWritePtrArrayOp addr idx val -- This write barrier is to ensure that the heap writes to the object -- referred to by val have happened before we write val into the array. -- See #12469 for details. - emitPrimCall [] MO_WriteBarrier [] + emitPrimCall [] MO_AcquireFence [] mkBasicIndexedWrite hdr_size addr ty idx val emit (setInfo addr (CmmLit (CmmLabel mkMAP_DIRTY_infoLabel))) @@ -3048,7 +3048,7 @@ doWriteSmallPtrArrayOp addr idx val = do mkBasicIndexedRead NaturallyAligned (smallArrPtrsHdrSize profile) Nothing ty tmp addr ty idx whenUpdRemSetEnabled $ emitUpdRemSetPush (CmmReg (CmmLocal tmp)) - emitPrimCall [] MO_WriteBarrier [] -- #12469 + emitPrimCall [] MO_AcquireFence [] -- #12469 mkBasicIndexedWrite (smallArrPtrsHdrSize profile) addr ty idx val emit (setInfo addr (CmmLit (CmmLabel mkSMAP_DIRTY_infoLabel))) ===================================== rts/CloneStack.c ===================================== @@ -74,9 +74,7 @@ void sendCloneStackMessage(StgTSO *tso, HsStablePtr mvar) { msg = (MessageCloneStack *)allocate(srcCapability, sizeofW(MessageCloneStack)); msg->tso = tso; msg->result = (StgMVar*)deRefStablePtr(mvar); - SET_HDR(msg, &stg_MSG_CLONE_STACK_info, CCS_SYSTEM); - // Ensure that writes constructing Message are committed before sending. - write_barrier(); + SET_HDR_RELEASE(msg, &stg_MSG_CLONE_STACK_info, CCS_SYSTEM); sendMessage(srcCapability, tso->cap, (Message *)msg); } ===================================== rts/PrimOps.cmm ===================================== @@ -2505,8 +2505,8 @@ stg_unpackClosurezh ( P_ closure ) { W_ info, ptrs, nptrs, p, ptrs_arr, dat_arr; MAYBE_GC_P(stg_unpackClosurezh, closure); - info = %GET_STD_INFO(UNTAG(closure)); - prim_read_barrier; + info = GET_INFO_ACQUIRE(UNTAG(closure)); + info = %STD_INFO(info); ptrs = TO_W_(%INFO_PTRS(info)); nptrs = TO_W_(%INFO_NPTRS(info)); @@ -2820,8 +2820,7 @@ stg_noDuplicatezh /* no arg list: explicit stack layout */ stg_getApStackValzh ( P_ ap_stack, W_ offset ) { W_ ap_stackinfo; - ap_stackinfo = %INFO_PTR(UNTAG(ap_stack)); - prim_read_barrier; + ap_stackinfo = GET_INFO_ACQUIRE(UNTAG(ap_stack)); if (ap_stackinfo == stg_AP_STACK_info) { return (1,StgAP_STACK_payload(ap_stack,offset)); } else { ===================================== rts/RaiseAsync.c ===================================== @@ -238,7 +238,7 @@ throwToMsg (Capability *cap, MessageThrowTo *msg) goto check_target; retry: - write_barrier(); + RELEASE_FENCE(); debugTrace(DEBUG_sched, "throwTo: retrying..."); check_target: @@ -874,9 +874,10 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception, ap->payload[i] = (StgClosure *)*sp++; } - write_barrier(); // XXX: Necessary? SET_HDR(ap,&stg_AP_STACK_info, ((StgClosure *)frame)->header.prof.ccs /* ToDo */); + // N.B. This will be made visible by updateThunk below, which + // implies a release memory barrier. TICK_ALLOC_UP_THK(AP_STACK_sizeW(words),0); //IF_DEBUG(scheduler, ===================================== rts/RtsSymbols.c ===================================== @@ -909,9 +909,6 @@ extern char **environ; SymI_HasProto(hs_spt_remove) \ SymI_HasProto(hs_spt_keys) \ SymI_HasProto(hs_spt_key_count) \ - SymI_HasProto(write_barrier) \ - SymI_HasProto(store_load_barrier) \ - SymI_HasProto(load_load_barrier) \ SymI_HasProto(cas) \ SymI_HasProto(_assertFail) \ SymI_HasProto(keepCAFs) \ ===================================== rts/Sparks.c ===================================== @@ -209,8 +209,7 @@ pruneSparkQueue (bool nonmovingMarkFinished, Capability *cap) cap->spark_stats.fizzled++; traceEventSparkFizzle(cap); } else { - info = RELAXED_LOAD(&spark->header.info); - load_load_barrier(); + info = ACQUIRE_LOAD(&spark->header.info); if (IS_FORWARDING_PTR(info)) { tmp = (StgClosure*)UN_FORWARDING_PTR(info); /* if valuable work: shift inside the pool */ ===================================== rts/TopHandler.c ===================================== @@ -32,8 +32,7 @@ StgTSO *getTopHandlerThread(void) { // topHandlerPtr was never initialised return NULL; } - const StgInfoTable *info = weak->header.info; - load_load_barrier(); + const StgInfoTable *info = ACQUIRE_LOAD(&weak->header.info); if (info == &stg_WEAK_info) { StgClosure *key = ((StgWeak*)weak)->key; ===================================== rts/include/Cmm.h ===================================== @@ -677,21 +677,18 @@ * explicit ordered accesses to make ordering apparent to TSAN. */ -// Memory barriers. +// Memory barriers // For discussion of how these are used to fence heap object // accesses see Note [Heap memory barriers] in SMP.h. #if defined(THREADED_RTS) -#define prim_read_barrier prim %read_barrier() #define prim_write_barrier prim %write_barrier() // See Note [ThreadSanitizer and fences] -#define RELEASE_FENCE prim %write_barrier() -#define ACQUIRE_FENCE prim %read_barrier() +#define RELEASE_FENCE prim %fence_release(); +#define ACQUIRE_FENCE prim %fence_acquire(); #else -#define prim_read_barrier /* nothing */ -#define prim_write_barrier /* nothing */ #define RELEASE_FENCE /* nothing */ #define ACQUIRE_FENCE /* nothing */ #endif /* THREADED_RTS */ ===================================== rts/include/Stg.h ===================================== @@ -392,7 +392,7 @@ external prototype return neither of these types to workaround #11395. #endif #include "stg/Prim.h" /* ghc-prim fallbacks */ -#include "stg/SMP.h" // write_barrier() inline is required +#include "stg/SMP.h" /* ----------------------------------------------------------------------------- Moving Floats and Doubles ===================================== rts/include/stg/SMP.h ===================================== @@ -44,11 +44,6 @@ void arm_atomic_spin_unlock(void); ------------------------------------------------------------------------- */ #if !IN_STG_CODE || IN_STGCRUN -// We only want the barriers, e.g. write_barrier(), declared in .hc -// files. Defining the other inline functions here causes type -// mismatch errors from gcc, because the generated C code is assuming -// that there are no prototypes in scope. - /* * The atomic exchange operation: xchg(p,w) exchanges the value * pointed to by p with the value w, returning the old value. @@ -105,24 +100,6 @@ EXTERN_INLINE void busy_wait_nop(void); #endif // !IN_STG_CODE -/* - * Various kinds of memory barrier. - * write_barrier: prevents future stores occurring before preceding stores. - * store_load_barrier: prevents future loads occurring before preceding stores. - * load_load_barrier: prevents future loads occurring before earlier loads. - * - * Reference for these: "The JSR-133 Cookbook for Compiler Writers" - * http://gee.cs.oswego.edu/dl/jmm/cookbook.html - * - * To check whether you got these right, try the test in - * testsuite/tests/rts/testwsdeque.c - * This tests the work-stealing deque implementation, which relies on - * properly working store_load and load_load memory barriers. - */ -EXTERN_INLINE void write_barrier(void); -EXTERN_INLINE void store_load_barrier(void); -EXTERN_INLINE void load_load_barrier(void); - /* * Note [Heap memory barriers] * ~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -354,7 +331,7 @@ EXTERN_INLINE void load_load_barrier(void); * Exchange the value pointed to by p with w and return the former. This * function is used to acquire a lock. An acquire memory barrier is sufficient * for a lock operation because corresponding unlock operation issues a - * store-store barrier (write_barrier()) immediately before releasing the lock. + * store-store barrier (release-store) immediately before releasing the lock. */ EXTERN_INLINE StgWord xchg(StgPtr p, StgWord w) @@ -463,91 +440,6 @@ busy_wait_nop(void) #endif // !IN_STG_CODE -/* - * We need to tell both the compiler AND the CPU about the barriers. - * It's no good preventing the CPU from reordering the operations if - * the compiler has already done so - hence the "memory" restriction - * on each of the barriers below. - */ -EXTERN_INLINE void -write_barrier(void) { -#if defined(NOSMP) - return; -#elif defined(TSAN_ENABLED) - // RELEASE is a bit stronger than the store-store barrier provided by - // write_barrier, consequently we only use this case as a conservative - // approximation when using ThreadSanitizer. See Note [ThreadSanitizer]. - __atomic_thread_fence(__ATOMIC_RELEASE); -#elif defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) \ - || defined(powerpc64le_HOST_ARCH) - __asm__ __volatile__ ("lwsync" : : : "memory"); -#elif defined(s390x_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH) - __asm__ __volatile__ ("dmb st" : : : "memory"); -#elif defined(riscv64_HOST_ARCH) - __asm__ __volatile__ ("fence w,w" : : : "memory"); -#elif defined(loongarch64_HOST_ARCH) - __asm__ __volatile__ ("dbar 0" : : : "memory"); -#else -#error memory barriers unimplemented on this architecture -#endif -} - -EXTERN_INLINE void -store_load_barrier(void) { -#if defined(NOSMP) - return; -#elif defined(i386_HOST_ARCH) - __asm__ __volatile__ ("lock; addl $0,0(%%esp)" : : : "memory"); -#elif defined(x86_64_HOST_ARCH) - __asm__ __volatile__ ("lock; addq $0,0(%%rsp)" : : : "memory"); -#elif defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) \ - || defined(powerpc64le_HOST_ARCH) - __asm__ __volatile__ ("sync" : : : "memory"); -#elif defined(s390x_HOST_ARCH) - __asm__ __volatile__ ("bcr 14,0" : : : "memory"); -#elif defined(arm_HOST_ARCH) - __asm__ __volatile__ ("dmb" : : : "memory"); -#elif defined(aarch64_HOST_ARCH) - __asm__ __volatile__ ("dmb sy" : : : "memory"); -#elif defined(riscv64_HOST_ARCH) - __asm__ __volatile__ ("fence w,r" : : : "memory"); -#elif defined(loongarch64_HOST_ARCH) - __asm__ __volatile__ ("dbar 0" : : : "memory"); -#else -#error memory barriers unimplemented on this architecture -#endif -} - -EXTERN_INLINE void -load_load_barrier(void) { -#if defined(NOSMP) - return; -#elif defined(i386_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(x86_64_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) \ - || defined(powerpc64le_HOST_ARCH) - __asm__ __volatile__ ("lwsync" : : : "memory"); -#elif defined(s390x_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(arm_HOST_ARCH) - __asm__ __volatile__ ("dmb" : : : "memory"); -#elif defined(aarch64_HOST_ARCH) - __asm__ __volatile__ ("dmb ld" : : : "memory"); -#elif defined(riscv64_HOST_ARCH) - __asm__ __volatile__ ("fence r,r" : : : "memory"); -#elif defined(loongarch64_HOST_ARCH) - __asm__ __volatile__ ("dbar 0" : : : "memory"); -#else -#error memory barriers unimplemented on this architecture -#endif -} - // Load a pointer from a memory location that might be being modified // concurrently. This prevents the compiler from optimising away // multiple loads of the memory location, as it might otherwise do in @@ -586,13 +478,6 @@ load_load_barrier(void) { /* ---------------------------------------------------------------------- */ #else /* !THREADED_RTS */ -EXTERN_INLINE void write_barrier(void); -EXTERN_INLINE void store_load_barrier(void); -EXTERN_INLINE void load_load_barrier(void); -EXTERN_INLINE void write_barrier () {} /* nothing */ -EXTERN_INLINE void store_load_barrier() {} /* nothing */ -EXTERN_INLINE void load_load_barrier () {} /* nothing */ - // Relaxed atomic operations #define RELAXED_LOAD(ptr) *ptr #define RELAXED_STORE(ptr,val) *ptr = val ===================================== rts/sm/Evac.c ===================================== @@ -1394,8 +1394,7 @@ selector_loop: // the same selector thunk. SET_INFO((StgClosure*)p, (StgInfoTable *)info_ptr); OVERWRITING_CLOSURE((StgClosure*)p); - SET_INFO((StgClosure*)p, &stg_WHITEHOLE_info); - write_barrier(); + SET_INFO_RELEASE((StgClosure*)p, &stg_WHITEHOLE_info); #if defined(PARALLEL_GC) abort(); // LDV is incompatible with parallel GC #endif ===================================== rts/sm/GC.c ===================================== @@ -1508,7 +1508,6 @@ waitForGcThreads (Capability *cap, bool idle_cap[]) if (i == me || idle_cap[i]) { continue; } if (SEQ_CST_LOAD(&gc_threads[i]->wakeup) != GC_THREAD_STANDING_BY) { prodCapability(getCapability(i), cap->running_task); - write_barrier(); interruptCapability(getCapability(i)); } } ===================================== rts/sm/GCAux.c ===================================== @@ -91,8 +91,8 @@ isAlive(StgClosure *p) return TAG_CLOSURE(tag,(StgClosure*)UN_FORWARDING_PTR(info)); } + ACQUIRE_LOAD(&q->header.info); info = INFO_PTR_TO_STRUCT(info); - load_load_barrier(); switch (info->type) { ===================================== rts/sm/Sanity.c ===================================== @@ -355,8 +355,7 @@ checkClosure( const StgClosure* p ) p = UNTAG_CONST_CLOSURE(p); - info = p->header.info; - load_load_barrier(); + info = ACQUIRE_LOAD(&p->header.info); if (IS_FORWARDING_PTR(info)) { barf("checkClosure: found EVACUATED closure %d", info->type); @@ -367,7 +366,6 @@ checkClosure( const StgClosure* p ) #endif info = INFO_PTR_TO_STRUCT(info); - load_load_barrier(); switch (info->type) { @@ -772,8 +770,7 @@ checkSTACK (StgStack *stack) void checkTSO(StgTSO *tso) { - const StgInfoTable *info = (const StgInfoTable*) tso->_link->header.info; - load_load_barrier(); + const StgInfoTable *info = (const StgInfoTable*) ACQUIRE_LOAD(&tso->_link)->header.info; ASSERT(tso->_link == END_TSO_QUEUE || info == &stg_MVAR_TSO_QUEUE_info || ===================================== testsuite/tests/rts/testwsdeque.c ===================================== @@ -34,47 +34,25 @@ void * myStealWSDeque_ (WSDeque *q, uint32_t n) { void * stolen; - StgWord b,t; // Can't do this on someone else's spark pool: // ASSERT_WSDEQUE_INVARIANTS(q); // NB. these loads must be ordered, otherwise there is a race // between steal and pop. - t = q->top; - load_load_barrier(); - b = q->bottom; + StgWord t = ACQUIRE_LOAD(&q->top); + SEQ_CST_FENCE(); + StgWord b = ACQUIRE_LOAD(&q->bottom); - // NB. b and t are unsigned; we need a signed value for the test - // below, because it is possible that t > b during a - // concurrent popWSQueue() operation. - if ((long)b - (long)t <= 0 ) { - return NULL; /* already looks empty, abort */ + void *result = NULL; + if (t < b) { + /* Non-empty queue */ + result = RELAXED_LOAD(&q->elements[t % q->size]); + if (!cas_top(q, t, t+1)) { + return NULL; + } } - // NB. the load of q->bottom must be ordered before the load of - // q->elements[t & q-> moduloSize]. See comment "KG:..." below - // and Ticket #13633. - load_load_barrier(); - /* now access array, see pushBottom() */ - stolen = q->elements[t & q->moduloSize]; - - /* now decide whether we have won */ - if ( !(CASTOP(&(q->top),t,t+1)) ) { - /* lost the race, someone else has changed top in the meantime */ - return NULL; - } /* else: OK, top has been incremented by the cas call */ - - // debugBelch("stealWSDeque_: t=%d b=%d\n", t, b); - -// Can't do this on someone else's spark pool: -// ASSERT_WSDEQUE_INVARIANTS(q); - - bufs[n] ++; - if (bufs[n] == BUF) { bufs[n] = 0; } - last_b[n][bufs[n]] = b; - last_t[n][bufs[n]] = t; - last_v[n][bufs[n]] = (StgWord)stolen; - return stolen; + return result; } void * View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/deaef0bb4dfce1fb0a28498b19758e92fac82787...b0705cc5b9cbe73746584487c024050104f571c8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/deaef0bb4dfce1fb0a28498b19758e92fac82787...b0705cc5b9cbe73746584487c024050104f571c8 You're receiving 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 Jun 12 10:12:57 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Mon, 12 Jun 2023 06:12:57 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/sand-witch/DIB-instances Message-ID: <6486efa9c696c_111d63c7c2c4136d1@gitlab.mail> Andrei Borzenkov pushed new branch wip/sand-witch/DIB-instances at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sand-witch/DIB-instances You're receiving 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 Jun 12 10:24:11 2023 From: gitlab at gitlab.haskell.org (HugoPeters1024 (@HugoPeters1024)) Date: Mon, 12 Jun 2023 06:24:11 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/bang-20204 Message-ID: <6486f24be2eae_111d63c560c4225e0@gitlab.mail> HugoPeters1024 pushed new branch wip/bang-20204 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/bang-20204 You're receiving 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 Jun 12 10:27:36 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 12 Jun 2023 06:27:36 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/t23511 Message-ID: <6486f318e7bfd_111d63139244e84263f9@gitlab.mail> Matthew Pickering pushed new branch wip/t23511 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/t23511 You're receiving 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 Jun 12 10:31:56 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 12 Jun 2023 06:31:56 -0400 Subject: [Git][ghc/ghc][wip/t23511] 13 commits: Restore mingwex dependency on Windows Message-ID: <6486f41c2c44c_111d63c5aa84342fb@gitlab.mail> Matthew Pickering pushed to branch wip/t23511 at Glasgow Haskell Compiler / GHC Commits: 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - d6528a1e by Matthew Pickering at 2023-06-12T10:31:53+00:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Utils/TmpFs.hs - compiler/Language/Haskell/Syntax/Decls.hs - compiler/ghc.cabal.in - configure.ac - docs/users_guide/9.8.1-notes.rst - docs/users_guide/debugging.rst - libraries/base/GHC/TypeLits.hs - libraries/base/GHC/TypeNats.hs - libraries/base/base.cabal - libraries/base/changelog.md - + libraries/base/tests/T23454.hs - + libraries/base/tests/T23454.stderr - libraries/base/tests/all.T - libraries/ghc-prim/ghc-prim.cabal - rts/RtsSymbols.c - rts/js/mem.js - testsuite/tests/driver/Makefile - + testsuite/tests/driver/T23339.hs - + testsuite/tests/driver/T23339.stdout - + testsuite/tests/driver/T23339B.hs - + testsuite/tests/driver/T23339B.stdout - testsuite/tests/driver/all.T - testsuite/tests/ghci/prog018/prog018.stdout The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/61de162852ad28967626bcc3be72af09e598d921...d6528a1e995ed01e93c4a0c9c7e108f3ca5e5423 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/61de162852ad28967626bcc3be72af09e598d921...d6528a1e995ed01e93c4a0c9c7e108f3ca5e5423 You're receiving 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 Jun 12 11:30:07 2023 From: gitlab at gitlab.haskell.org (Ben Price (@brprice)) Date: Mon, 12 Jun 2023 07:30:07 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/global-local-mismatch-info Message-ID: <648701bf17fc3_111d63c7c2c459270@gitlab.mail> Ben Price pushed new branch wip/global-local-mismatch-info at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/global-local-mismatch-info You're receiving 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 Jun 12 11:41:01 2023 From: gitlab at gitlab.haskell.org (Ben Price (@brprice)) Date: Mon, 12 Jun 2023 07:41:01 -0400 Subject: [Git][ghc/ghc][wip/global-local-mismatch-info] 42 commits: [hadrian] Fix multiline synopsis rendering Message-ID: <6487044dafba5_111d63c55f84693d3@gitlab.mail> Ben Price pushed to branch wip/global-local-mismatch-info at Glasgow Haskell Compiler / GHC Commits: f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - 0b6c1bf0 by Ben Price at 2023-06-12T12:40:46+01:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - HACKING.md - compiler/GHC/Builtin/Names/TH.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Plugins.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Errors/Types.hs - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/71fb460b5927d4fcec9509f949f41b51a4d6a0bb...0b6c1bf053a0c53fb25d5699e07754c85a470405 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/71fb460b5927d4fcec9509f949f41b51a4d6a0bb...0b6c1bf053a0c53fb25d5699e07754c85a470405 You're receiving 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 Jun 12 12:35:39 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Mon, 12 Jun 2023 08:35:39 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/supersven/cleanup_mkSpillInstr_mkLoadInstr Message-ID: <6487111bede61_1af13ac568410033@gitlab.mail> Sven Tennie pushed new branch wip/supersven/cleanup_mkSpillInstr_mkLoadInstr at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/supersven/cleanup_mkSpillInstr_mkLoadInstr You're receiving 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 Jun 12 12:37:17 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Mon, 12 Jun 2023 08:37:17 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/sand-witch/dib-instances Message-ID: <6487117d3a220_1af13ac568410287@gitlab.mail> Andrei Borzenkov pushed new branch wip/sand-witch/dib-instances at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sand-witch/dib-instances You're receiving 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 Jun 12 12:54:56 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Mon, 12 Jun 2023 08:54:56 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/modern-STV-extension-shuffling] Extension shuffling (#23291) Message-ID: <648715a0ebb75_1af13ac56fc408a6@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/modern-STV-extension-shuffling at Glasgow Haskell Compiler / GHC Commits: cbfdab32 by Andrei Borzenkov at 2023-06-12T16:54:28+04:00 Extension shuffling (#23291) Where introduced 3 new extensions: - PatternSignatures - ExtendedForAllScope - MethodTypeVariables Tasks of ScopedTypeVariables extension were distributed between PatternSignatures, ExtendedForAllScope and MethodTypeVariables according to the proposal. Now ScopedTypeVaribles only implies these three exntesions. - - - - - 29 changed files: - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/expected-undocumented-flags.txt - docs/users_guide/exts/explicit_forall.rst - docs/users_guide/exts/gadt.rst - docs/users_guide/exts/scoped_type_variables.rst - docs/users_guide/exts/type_abstractions.rst - libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs - testsuite/tests/driver/T4437.hs - testsuite/tests/rename/should_fail/T11663.stderr - testsuite/tests/showIface/DocsInHiFile1.stdout - testsuite/tests/showIface/DocsInHiFileTH.stdout - testsuite/tests/showIface/HaddockIssue849.stdout - testsuite/tests/showIface/HaddockOpts.stdout - testsuite/tests/showIface/LanguageExts.stdout - testsuite/tests/showIface/MagicHashInHaddocks.stdout - testsuite/tests/showIface/NoExportList.stdout - testsuite/tests/showIface/PragmaDocs.stdout - testsuite/tests/showIface/ReExports.stdout - testsuite/tests/typecheck/should_fail/PatSynExistential.stderr Changes: ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -1417,7 +1417,13 @@ languageExtensions (Just GHC2021) LangExt.PostfixOperators, LangExt.RankNTypes, LangExt.ScopedTypeVariables, - LangExt.TypeAbstractions, -- implied by ScopedTypeVariables according to GHC Proposal #448 "Modern Scoped Type Variables" + + -- implied by ScopedTypeVariables according to GHC Proposal #448 "Modern Scoped Type Variables" + LangExt.TypeAbstractions, + LangExt.PatternSignatures, + LangExt.MethodTypeVariables, + LangExt.ExtendedForAllScope, + LangExt.StandaloneDeriving, LangExt.StandaloneKindSignatures, LangExt.TupleSections, ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2673,8 +2673,9 @@ xFlagsDeps = [ flagSpec "ParallelListComp" LangExt.ParallelListComp, flagSpec "PartialTypeSignatures" LangExt.PartialTypeSignatures, flagSpec "PatternGuards" LangExt.PatternGuards, - depFlagSpec' "PatternSignatures" LangExt.ScopedTypeVariables - (deprecatedForExtension "ScopedTypeVariables"), + flagSpec "PatternSignatures" LangExt.PatternSignatures, + flagSpec "MethodTypeVariables" LangExt.MethodTypeVariables, + flagSpec "ExtendedForAllScope" LangExt.ExtendedForAllScope, flagSpec "PatternSynonyms" LangExt.PatternSynonyms, flagSpec "PolyKinds" LangExt.PolyKinds, flagSpec "PolymorphicComponents" LangExt.RankNTypes, @@ -2767,6 +2768,9 @@ impliedXFlags -- In accordance with GHC Proposal #448 "Modern Scoped Type Variables" , (LangExt.ScopedTypeVariables, turnOn, LangExt.TypeAbstractions) + , (LangExt.ScopedTypeVariables, turnOn, LangExt.PatternSignatures) + , (LangExt.ScopedTypeVariables, turnOn, LangExt.MethodTypeVariables) + , (LangExt.ScopedTypeVariables, turnOn, LangExt.ExtendedForAllScope) , (LangExt.RebindableSyntax, turnOff, LangExt.ImplicitPrelude) -- NB: turn off! ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -830,9 +830,9 @@ enabled. For example, the following will be rejected: instance (Eq a => Show (Maybe a)) where ... This restriction is partly motivated by an unusual quirk of instance -declarations. Namely, if ScopedTypeVariables is enabled, then the type -variables from the top of an instance will scope over the bodies of the -instance methods, /even if the type variables are implicitly quantified/. +declarations. Namely, if MethodTypeVariables (implied by ScopedTypeVariables) is enabled, +then the type variables from the top of an instance will scope over the bodies +of the instance methods, /even if the type variables are implicitly quantified/. For example, GHC will accept the following: instance Monoid a => Monoid (Identity a) where @@ -852,20 +852,20 @@ Somewhat surprisingly, old versions of GHC would accept the instance above. Even though the `forall` only quantifies `a`, the outermost parentheses mean that the `forall` is nested, and per the forall-or-nothing rule, this means that implicit quantification would occur. Therefore, the `a` is explicitly -bound and the `b` is implicitly bound. Moreover, ScopedTypeVariables would -bring /both/ sorts of type variables into scope over the body of `m`. +bound and the `b` is implicitly bound. Moreover, MethodTypeVariables +would bring /both/ sorts of type variables into scope over the body of `m`. How utterly confusing! To avoid this sort of confusion, we simply disallow nested `forall`s in instance types, which makes things like the instance above become illegal. For the sake of consistency, we also disallow nested contexts, even though they -don't have the same strange interaction with ScopedTypeVariables. +don't have the same strange interaction with MethodTypeVariables. Just as we forbid nested `forall`s and contexts in normal instance declarations, we also forbid them in SPECIALISE instance pragmas (#18455). -Unlike normal instance declarations, ScopedTypeVariables don't have any impact -on SPECIALISE instance pragmas, but we use the same validity checks for -SPECIALISE instance pragmas anyway to be consistent. +Unlike normal instance declarations, MethodTypeVariables +don't have any impact on SPECIALISE instance pragmas, but we use the same +validity checks for SPECIALISE instance pragmas anyway to be consistent. ----- -- Wrinkle: Derived instances @@ -874,7 +874,7 @@ SPECIALISE instance pragmas anyway to be consistent. `deriving` clauses and standalone `deriving` declarations also permit bringing type variables into scope, either through explicit or implicit quantification. Unlike in the tops of instance declarations, however, one does not need to -enable ScopedTypeVariables for this to take effect. +enable MethodTypeVariables for this to take effect. Just as GHC forbids nested `forall`s in the top of instance declarations, it also forbids them in types involved with `deriving`: ===================================== compiler/GHC/Rename/Bind.hs ===================================== @@ -920,7 +920,8 @@ rnMethodBinds is_cls_decl cls ktv_names binds sigs -- Rename the bindings RHSs. Again there's an issue about whether the -- type variables from the class/instance head are in scope. -- Answer no in Haskell 2010, but yes if you have -XScopedTypeVariables - ; (binds'', bind_fvs) <- bindSigTyVarsFV ktv_names $ + -- or -XMethodTypeVariables + ; (binds'', bind_fvs) <- bindClassInstanceHeadTyVarsFV ktv_names $ do { binds_w_dus <- mapBagM (rnLBind (mkScopedTvFn other_sigs')) binds' ; let bind_fvs = foldr (\(_,_,fv1) fv2 -> fv1 `plusFV` fv2) emptyFVs binds_w_dus ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -31,7 +31,8 @@ module GHC.Rename.HsType ( -- Binding related stuff bindHsOuterTyVarBndrs, bindHsForAllTelescope, bindLHsTyVarBndr, bindLHsTyVarBndrs, WarnUnusedForalls(..), - rnImplicitTvOccs, bindSigTyVarsFV, bindHsQTyVars, + rnImplicitTvOccs, bindSigTyVarsFV, bindClassInstanceHeadTyVarsFV , + bindHsQTyVars, FreeKiTyVars, filterInScopeM, extractHsTyRdrTyVars, extractHsTyRdrTyVarsKindVars, extractHsTysRdrTyVars, extractRdrKindSigVars, @@ -150,20 +151,27 @@ rnHsPatSigType :: HsPatSigTypeScoping -> (HsPatSigType GhcRn -> RnM (a, FreeVars)) -> RnM (a, FreeVars) -- Used for --- - Pattern type signatures, which are only allowed with ScopedTypeVariables +-- - Pattern type signatures, which are only allowed with PatternSignatures -- - Signatures on binders in a RULE, which are allowed even if --- ScopedTypeVariables isn't enabled +-- PatternSignatures isn't enabled -- Wildcards are allowed -- -- See Note [Pattern signature binders and scoping] in GHC.Hs.Type rnHsPatSigType scoping ctx sig_ty thing_inside - = do { ty_sig_okay <- xoptM LangExt.ScopedTypeVariables + = do { ty_sig_okay <- xoptM LangExt.PatternSignatures + ; free_var_should_bind <- xoptM LangExt.ScopedTypeVariables ; checkErr ty_sig_okay (unexpectedPatSigTypeErr sig_ty) ; free_vars <- filterInScopeM (extractHsTyRdrTyVars pat_sig_ty) ; (nwc_rdrs', tv_rdrs) <- partition_nwcs free_vars ; let nwc_rdrs = nubN nwc_rdrs' implicit_bndrs = case scoping of - AlwaysBind -> tv_rdrs + AlwaysBind -> + -- `PatternSignatures` doesn't enable binding of + -- free type variables in pattern signatures. + -- That does `ScopedTypeVariables`. + if free_var_should_bind + then tv_rdrs + else [] NeverBind -> [] ; rnImplicitTvOccs Nothing implicit_bndrs $ \ imp_tvs -> do { (nwcs, pat_sig_ty', fvs1) <- rnWcBody ctx nwc_rdrs pat_sig_ty @@ -900,18 +908,25 @@ notInKinds _ _ = return () * * ***************************************************** -} -bindSigTyVarsFV :: [Name] - -> RnM (a, FreeVars) - -> RnM (a, FreeVars) -- Used just before renaming the defn of a function -- with a separate type signature, to bring its tyvars into scope --- With no -XScopedTypeVariables, this is a no-op +-- With no -XExtendedForAllScope/-XMethodTypeVariables, this is a no-op +bindSigTyVarsFV, bindClassInstanceHeadTyVarsFV :: [Name] + -> RnM (a, FreeVars) + -> RnM (a, FreeVars) + bindSigTyVarsFV tvs thing_inside - = do { scoped_tyvars <- xoptM LangExt.ScopedTypeVariables - ; if not scoped_tyvars then - thing_inside - else - bindLocalNamesFV tvs thing_inside } + = do { extended_for_all_scope <- xoptM LangExt.ExtendedForAllScope + ; if extended_for_all_scope + then bindLocalNamesFV tvs thing_inside + else thing_inside } + +bindClassInstanceHeadTyVarsFV tvs thing_inside + = do { method_type_variables <- xoptM LangExt.MethodTypeVariables + ; if method_type_variables + then bindLocalNamesFV tvs thing_inside + else thing_inside } + --------------- bindHsQTyVars :: forall a b. ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -198,7 +198,8 @@ rnSrcDecls group@(HsGroup { hs_valds = val_decls, -- (H) Rename Everything else - (rn_rule_decls, src_fvs2) <- setXOptM LangExt.ScopedTypeVariables $ + (rn_rule_decls, src_fvs2) <- setXOptM LangExt.PatternSignatures $ + setXOptM LangExt.ScopedTypeVariables $ rnList rnHsRuleDecls rule_decls ; -- Inside RULES, scoped type variables are on (rn_foreign_decls, src_fvs3) <- rnList rnHsForeignDecl foreign_decls ; ===================================== compiler/GHC/Tc/Deriv.hs ===================================== @@ -273,6 +273,9 @@ renameDeriv inst_infos bagBinds setXOptM LangExt.EmptyCase $ -- Derived decls (for empty types) can have -- case x of {} + setXOptM LangExt.MethodTypeVariables $ + setXOptM LangExt.PatternSignatures $ + setXOptM LangExt.ExtendedForAllScope $ setXOptM LangExt.ScopedTypeVariables $ setXOptM LangExt.KindSignatures $ -- Derived decls (for newtype-deriving) can use ScopedTypeVariables & ===================================== compiler/GHC/Tc/Deriv/Generate.hs ===================================== @@ -1875,9 +1875,9 @@ of the method. For example, recall: join In the example above, it is imperative that the `a` in the instance signature -for `join` scope over the body of `join` by way of ScopedTypeVariables. -This might sound obvious, but note that in gen_Newtype_binds, which is -responsible for generating the code above, the type in `join`'s instance +for `join` scope over the body of `join` by way of ExtendedForallScope (implied +by ScopedTypeVariables). This might sound obvious, but note that in gen_Newtype_binds, +which is responsible for generating the code above, the type in `join`'s instance signature is given as a Core type, whereas gen_Newtype_binds will eventually produce HsBinds (i.e., source Haskell) that is renamed and typechecked. We must ensure that `a` is in scope over the body of `join` during renaming ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1636,9 +1636,7 @@ instance Diagnostic TcRnMessage where nest 4 (text "in the section:" <+> quotes (ppr section))] TcRnUnexpectedPatSigType ty - -> mkSimpleDecorated $ - hang (text "Illegal type signature:" <+> quotes (ppr ty)) - 2 (text "Type signatures are only allowed in patterns with ScopedTypeVariables") + -> mkSimpleDecorated $ text "Illegal type signature:" <+> quotes (ppr ty) TcRnIllegalKindSignature ty -> mkSimpleDecorated $ text "Illegal kind signature:" <+> quotes (ppr ty) @@ -3040,7 +3038,7 @@ instance Diagnostic TcRnMessage where TcRnSectionPrecedenceError{} -> noHints TcRnUnexpectedPatSigType{} - -> [suggestExtension LangExt.ScopedTypeVariables] + -> [suggestExtension LangExt.PatternSignatures] TcRnIllegalKindSignature{} -> [suggestExtension LangExt.KindSignatures] TcRnUnusedQuantifiedTypeVar{} ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -2388,7 +2388,7 @@ data TcRnMessage where -> TcRnMessage {-| TcRnUnexpectedPatSigType is an error occurring when there is - a type signature in a pattern without -XScopedTypeVariables extension + a type signature in a pattern without -XPatternSignatures extension Examples: f (a :: Bool) = ... ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -18,6 +18,11 @@ Language data T @k (a :: k) @(j :: Type) (b :: j) This feature is guarded behind :extension:`TypeAbstractions`. + +- :extension:`ScopedTypeVariables` was split into several new extensions: + :extension:`PatternSignatures`, :extension:`ExtendedForAllScope`, :extension:`MethodTypeVariables`. + You can set :extension:`ScopedTypeVariables` to enable them all or enable them individually + for more fine-grained control of features that you want to have. Compiler ~~~~~~~~ ===================================== docs/users_guide/expected-undocumented-flags.txt ===================================== @@ -14,7 +14,6 @@ -XMonomorphismRestriction -XParallelArrays -XPatternGuards --XPatternSignatures -XPolymorphicComponents -XRecordPuns -XRelaxedLayout ===================================== docs/users_guide/exts/explicit_forall.rst ===================================== @@ -114,7 +114,7 @@ The ``forall``-or-nothing rule takes effect in the following places: Notes: -- :ref:`pattern-type-sigs` are a notable example of a place where +- :extension:`PatternSignatures` are a notable example of a place where types do *not* obey the ``forall``-or-nothing rule. For example, GHC will accept the following: :: ===================================== docs/users_guide/exts/gadt.rst ===================================== @@ -194,7 +194,7 @@ also sets :extension:`GADTSyntax` and :extension:`MonoLocalBinds`. In the function clause for ``g``, GHC first checks ``MkF``, the outermost pattern, followed by the inner ``Nothing`` pattern. This outside-in order - can interact somewhat counterintuitively with :ref:`pattern-type-sigs`. + can interact somewhat counterintuitively with :extension:`PatternSignatures`. Consider the following variation of ``g``: :: g2 :: F a a -> a ===================================== docs/users_guide/exts/scoped_type_variables.rst ===================================== @@ -6,9 +6,13 @@ Lexically scoped type variables =============================== .. extension:: ScopedTypeVariables - :shortdesc: Enable lexically-scoped type variables. + :shortdesc: Enable lexically-scoped type variables everywhere. - :implies: :extension:`ExplicitForAll` + :implies: :extension:`ExplicitForAll`, + :extension:`PatternSignatures`, + :extension:`ExtendedForAllScope`, + :extension:`MethodTypeVariables`, + :extension:`TypeAbstractions` :since: 6.8.1 @@ -26,7 +30,7 @@ Lexically scoped type variables To trigger those forms of :extension:`ScopedTypeVariables`, the ``forall`` must appear against the top-level signature (or outer expression) but *not* against nested signatures referring to the same type variables. - Explicit ``forall`` is not always required -- see :ref:`pattern signature equivalent ` for the example in this section, or :ref:`pattern-type-sigs`. + Explicit ``forall`` is not always required -- see :ref:`pattern signature equivalent ` for the example in this section, or :extension:`PatternSignatures`. GHC supports *lexically scoped type variables*, without which some type signatures are simply impossible to write. For example: :: @@ -48,7 +52,7 @@ possible to do so. .. _pattern-equiv-form: -An equivalent form for that example, avoiding explicit ``forall`` uses :ref:`pattern-type-sigs`: :: +An equivalent form for that example, avoiding explicit ``forall`` uses :extension:`PatternSignatures`: :: f :: [a] -> [a] f (xs :: [aa]) = xs ++ ys @@ -84,9 +88,9 @@ A *lexically scoped type variable* can be bound by: - An expression type signature (:ref:`exp-type-sigs`) -- A pattern type signature (:ref:`pattern-type-sigs`) +- A pattern type signature (:extension:`PatternSignatures`) -- Class and instance declarations (:ref:`cls-inst-scoped-tyvars`) +- Class and instance declarations (:extension:`MethodTypeVariables`) In Haskell, a programmer-written type signature is implicitly quantified over its free type variables (`Section @@ -100,14 +104,31 @@ scope is *not* universally quantified. For example, if type variable (e :: b -> b) means (e :: forall b. b->b) (e :: a -> b) means (e :: forall b. a->b) +Extended ForAll Scope +===================== + +.. extension:: ExtendedForAllScope + :shortdesc: Enable lexically-scoped type variables in function bindings, + pattern synonyms and expression type signatures. + + :since: 9.8.1 + + :implied by: :extension:`ScopedTypeVariables` + + :status: Included in :extension:`GHC2021` + + Enable lexical scoping of type variables explicitly introduced with + a ``forall`` in function bindings, pattern synonyms and expression type signatures. + .. _decl-type-sigs: Declaration type signatures --------------------------- -A declaration type signature that has *explicit* quantification (using -``forall``) brings into scope the explicitly-quantified type variables, -in the definition of the named function. For example: :: +When :extension:`ExtendedForAllScope` is enabled, a declaration type signature +that has *explicit* quantification (using ``forall``) brings into scope the +explicitly-quantified type variables, in the definition of the named function. +For example: :: f :: forall a. [a] -> [a] f (x:xs) = xs ++ [ x :: a ] @@ -171,9 +192,9 @@ This only happens if: Expression type signatures -------------------------- -An expression type signature that has *explicit* quantification (using -``forall``) brings into scope the explicitly-quantified type variables, -in the annotated expression. For example: :: +When :extension:`ExtendedForAllScope` is enabled, an expression type signature +that has *explicit* quantification (using ``forall``) brings into scope the +explicitly-quantified type variables, in the annotated expression. For example: :: f = runST ( (op >>= \(x :: STRef s Int) -> g x) :: forall s. ST s Bool ) @@ -181,13 +202,22 @@ Here, the type signature ``forall s. ST s Bool`` brings the type variable ``s`` into scope, in the annotated expression ``(op >>= \(x :: STRef s Int) -> g x)``. -.. _pattern-type-sigs: +Pattern Signatures +================== + +.. extension:: PatternSignatures + :shortdesc: Allow type signatures in patterns. -Pattern type signatures ------------------------ + :since: 9.8.1 -A type signature may occur in any pattern; this is a *pattern type -signature*. For example: :: + :implied by: :extension:`ScopedTypeVariables` + + :status: Included in :extension:`GHC2021` + + Allow type signatures and type variable bindings in patterns. + +When :extension:`PatternSignatures` is enabled, a type signature may occur +in any pattern; this is a *pattern type signature*. For example: :: -- f and g assume that 'a' is already in scope f = \(x::Int, y::a) -> x @@ -259,12 +289,21 @@ they are both legal whether or not ``a`` is already in scope. They differ in that *if* ``a`` is already in scope, the signature constrains the pattern, rather than the pattern binding the variable. -.. _cls-inst-scoped-tyvars: +Method Type Variables +===================== + +.. extension:: MethodTypeVariables + :shortdesc: Enable lexically-scoped type variables in class and instance declarations. + + :since: 9.8.1 + + :implied by: :extension:`ScopedTypeVariables` + + :status: Included in :extension:`GHC2021` -Class and instance declarations -------------------------------- + Enable lexical scoping of type variables explicitly introduced by class and instance heads. -:extension:`ScopedTypeVariables` allow the type variables bound by the top of a +:extension:`MethodTypeVariables` allow the type variables bound by the top of a ``class`` or ``instance`` declaration to scope over the methods defined in the ``where`` part. Unlike :ref:`decl-type-sigs`, type variables from class and instance declarations can be lexically scoped without an explicit ``forall`` @@ -286,11 +325,11 @@ declaration; see :ref:`explicit-foralls`). For example: :: instance forall b. C b => C [b] where op xs = reverse (head (xs :: [[b]])) -While :extension:`ScopedTypeVariables` is required for type variables from the +While :extension:`MethodTypeVariables` is required for type variables from the top of a class or instance declaration to scope over the /bodies/ of the methods, it is not required for the type variables to scope over the /type signatures/ of the methods. For example, the following will be accepted without -explicitly enabling :extension:`ScopedTypeVariables`: :: +explicitly enabling :extension:`MethodTypeVariables`: :: class D a where m :: [a] -> a @@ -302,11 +341,11 @@ explicitly enabling :extension:`ScopedTypeVariables`: :: Note that writing ``m :: [a] -> [a]`` requires the use of the :extension:`InstanceSigs` extension. -Similarly, :extension:`ScopedTypeVariables` is not required for type variables +Similarly, :extension:`MethodTypeVariables` is not required for type variables from the top of the class or instance declaration to scope over associated type families, which only requires the :extension:`TypeFamilies` extension. For instance, the following will be accepted without explicitly enabling -:extension:`ScopedTypeVariables`: :: +:extension:`MethodTypeVariables`: :: class E a where type T a ===================================== docs/users_guide/exts/type_abstractions.rst ===================================== @@ -6,6 +6,8 @@ Type abstractions :since: 9.8.1 + :implied by: :extension:`ScopedTypeVariables` + :status: Partially implemented Allow the use of type abstraction syntax. ===================================== libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs ===================================== @@ -153,6 +153,9 @@ data Extension | OverloadedRecordUpdate | TypeAbstractions | ExtendedLiterals + | PatternSignatures + | ExtendedForAllScope + | MethodTypeVariables deriving (Eq, Enum, Show, Generic, Bounded) -- 'Ord' and 'Bounded' are provided for GHC API users (see discussions -- in https://gitlab.haskell.org/ghc/ghc/merge_requests/2707 and ===================================== testsuite/tests/driver/T4437.hs ===================================== @@ -38,7 +38,9 @@ check title expected got expectedGhcOnlyExtensions :: [String] expectedGhcOnlyExtensions = [ "TypeAbstractions", - "ExtendedLiterals" + "ExtendedLiterals", + "MethodTypeVariables", + "ExtendedForAllScope" ] expectedCabalOnlyExtensions :: [String] ===================================== testsuite/tests/rename/should_fail/T11663.stderr ===================================== @@ -1,20 +1,16 @@ T11663.hs:6:12: error: [GHC-74097] Illegal type signature: ‘Int’ - Type signatures are only allowed in patterns with ScopedTypeVariables - Suggested fix: Perhaps you intended to use ScopedTypeVariables + Suggested fix: Perhaps you intended to use PatternSignatures T11663.hs:7:9: error: [GHC-74097] Illegal type signature: ‘Int’ - Type signatures are only allowed in patterns with ScopedTypeVariables - Suggested fix: Perhaps you intended to use ScopedTypeVariables + Suggested fix: Perhaps you intended to use PatternSignatures T11663.hs:8:22: error: [GHC-74097] Illegal type signature: ‘Int’ - Type signatures are only allowed in patterns with ScopedTypeVariables - Suggested fix: Perhaps you intended to use ScopedTypeVariables + Suggested fix: Perhaps you intended to use PatternSignatures T11663.hs:9:32: error: [GHC-74097] Illegal type signature: ‘Int’ - Type signatures are only allowed in patterns with ScopedTypeVariables - Suggested fix: Perhaps you intended to use ScopedTypeVariables + Suggested fix: Perhaps you intended to use PatternSignatures ===================================== testsuite/tests/showIface/DocsInHiFile1.stdout ===================================== @@ -144,5 +144,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/DocsInHiFileTH.stdout ===================================== @@ -287,5 +287,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/HaddockIssue849.stdout ===================================== @@ -67,5 +67,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/HaddockOpts.stdout ===================================== @@ -59,5 +59,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/LanguageExts.stdout ===================================== @@ -23,4 +23,3 @@ docs: CUSKs FieldSelectors extensible fields: - ===================================== testsuite/tests/showIface/MagicHashInHaddocks.stdout ===================================== @@ -69,5 +69,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/NoExportList.stdout ===================================== @@ -95,5 +95,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/PragmaDocs.stdout ===================================== @@ -69,5 +69,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/showIface/ReExports.stdout ===================================== @@ -66,5 +66,7 @@ docs: StandaloneKindSignatures FieldSelectors TypeAbstractions + PatternSignatures + ExtendedForAllScope + MethodTypeVariables extensible fields: - ===================================== testsuite/tests/typecheck/should_fail/PatSynExistential.stderr ===================================== @@ -1,4 +1,5 @@ -PatSynExistential.hs:6:1: [GHC-33973] - The result type of the signature for ‘P’, namely ‘x -> Maybe x’ + +PatSynExistential.hs:6:1: error: [GHC-33973] + • The result type of the signature for ‘P’, namely ‘x -> Maybe x’ mentions existential type variable ‘x’ - In the declaration for pattern synonym ‘P’ + • In the declaration for pattern synonym ‘P’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cbfdab32c42f8e88d60b97539d6f8b5b2c3e3845 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cbfdab32c42f8e88d60b97539d6f8b5b2c3e3845 You're receiving 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 Jun 12 13:01:28 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Mon, 12 Jun 2023 09:01:28 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/DIB-instances] Implement the -Wimplicit-rhs-quantification warning (#23510) Message-ID: <64871728c7038_1af13ac56fc49634@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/DIB-instances at Glasgow Haskell Compiler / GHC Commits: 4909734e by Andrei Borzenkov at 2023-06-12T17:01:01+04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 18 changed files: - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - docs/users_guide/using-warnings.rst - testsuite/tests/dependent/should_compile/T16391a.hs - testsuite/tests/ghci/scripts/ghci024.stdout - + testsuite/tests/rename/should_compile/T23510b.hs - testsuite/tests/rename/should_compile/all.T - + testsuite/tests/rename/should_fail/T23510a.hs - + testsuite/tests/rename/should_fail/T23510a.stderr - testsuite/tests/rename/should_fail/all.T - testsuite/tests/typecheck/should_compile/T13343.hs Changes: ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -641,6 +641,7 @@ data WarningFlag = | Opt_WarnLoopySuperclassSolve -- Since 9.6 | Opt_WarnTermVariableCapture -- Since 9.8 | Opt_WarnMissingRoleAnnotations -- Since 9.8 + | Opt_WarnImplicitRhsQuantification -- Since 9.10 deriving (Eq, Ord, Show, Enum) -- | Return the names of a WarningFlag @@ -748,6 +749,7 @@ warnFlagNames wflag = case wflag of Opt_WarnLoopySuperclassSolve -> "loopy-superclass-solve" :| [] Opt_WarnTypeEqualityRequiresOperators -> "type-equality-requires-operators" :| [] Opt_WarnMissingRoleAnnotations -> "missing-role-annotations" :| [] + Opt_WarnImplicitRhsQuantification -> "implicit-rhs-quantification" :| [] -- ----------------------------------------------------------------------------- -- Standard sets of warning options @@ -939,6 +941,7 @@ minusWcompatOpts , Opt_WarnNonCanonicalMonadInstances , Opt_WarnCompatUnqualifiedImports , Opt_WarnTypeEqualityOutOfScope + , Opt_WarnImplicitRhsQuantification ] -- | Things you get with -Wunused-binds ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2259,7 +2259,8 @@ wWarningFlagsDeps = mconcat [ warnSpec Opt_WarnTypeEqualityOutOfScope, warnSpec Opt_WarnTypeEqualityRequiresOperators, warnSpec Opt_WarnTermVariableCapture, - warnSpec Opt_WarnMissingRoleAnnotations + warnSpec Opt_WarnMissingRoleAnnotations, + warnSpec Opt_WarnImplicitRhsQuantification ] warningGroupsDeps :: [(Deprecation, FlagSpec WarningGroup)] ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -918,8 +918,8 @@ bindHsQTyVars :: forall a b. -> Maybe a -- Just _ => an associated type decl -> FreeKiTyVars -- Kind variables from scope -> LHsQTyVars GhcPs - -> (LHsQTyVars GhcRn -> Bool -> RnM (b, FreeVars)) - -- The Bool is True <=> all kind variables used in the + -> (LHsQTyVars GhcRn -> FreeKiTyVars -> RnM (b, FreeVars)) + -- The FreeKiTyVars is null <=> all kind variables used in the -- kind signature are bound on the left. Reason: -- the last clause of Note [CUSKs: complete user-supplied kind signatures] -- in GHC.Hs.Decls @@ -942,7 +942,6 @@ bindHsQTyVars doc mb_assoc body_kv_occs hsq_bndrs thing_inside bndr_kv_occs ++ body_kv_occs body_remaining = filterFreeVarsToBind bndr_kv_occs $ filterFreeVarsToBind bndrs body_kv_occs - all_bound_on_lhs = null body_remaining ; traceRn "checkMixedVars3" $ vcat [ text "bndrs" <+> ppr hs_tv_bndrs @@ -969,7 +968,7 @@ bindHsQTyVars doc mb_assoc body_kv_occs hsq_bndrs thing_inside ; traceRn "bindHsQTyVars" (ppr hsq_bndrs $$ ppr implicit_kv_nms $$ ppr rn_bndrs) ; thing_inside (HsQTvs { hsq_ext = implicit_kv_nms , hsq_explicit = rn_bndrs }) - all_bound_on_lhs } } + body_remaining } } where hs_tv_bndrs = hsQTvExplicit hsq_bndrs ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -1709,11 +1709,16 @@ rnTyClDecl (SynDecl { tcdLName = tycon, tcdTyVars = tyvars, ; let kvs = extractHsTyRdrTyVarsKindVars rhs doc = TySynCtx tycon ; traceRn "rntycl-ty" (ppr tycon <+> ppr kvs) - ; bindHsQTyVars doc Nothing kvs tyvars $ \ tyvars' _ -> - do { (rhs', fvs) <- rnTySyn doc rhs + ; bindHsQTyVars doc Nothing kvs tyvars $ \ tyvars' free_rhs_kvs -> + do { mapM_ warn_implicit_kvs (nubL free_rhs_kvs) + ; (rhs', fvs) <- rnTySyn doc rhs ; return (SynDecl { tcdLName = tycon', tcdTyVars = tyvars' , tcdFixity = fixity , tcdRhs = rhs', tcdSExt = fvs }, fvs) } } + where + warn_implicit_kvs :: LocatedN RdrName -> RnM () + warn_implicit_kvs kv = + addErrAt (getLocA kv) (TcRnImplicitRhsQuantification kv) -- "data", "newtype" declarations rnTyClDecl (DataDecl @@ -1725,12 +1730,12 @@ rnTyClDecl (DataDecl doc = TyDataCtx tycon new_or_data = dataDefnConsNewOrData cons ; traceRn "rntycl-data" (ppr tycon <+> ppr kvs) - ; bindHsQTyVars doc Nothing kvs tyvars $ \ tyvars' no_rhs_kvs -> + ; bindHsQTyVars doc Nothing kvs tyvars $ \ tyvars' free_rhs_kvs -> do { (defn', fvs) <- rnDataDefn doc defn - ; cusk <- data_decl_has_cusk tyvars' new_or_data no_rhs_kvs kind_sig + ; cusk <- data_decl_has_cusk tyvars' new_or_data (null free_rhs_kvs) kind_sig ; let rn_info = DataDeclRn { tcdDataCusk = cusk , tcdFVs = fvs } - ; traceRn "rndata" (ppr tycon <+> ppr cusk <+> ppr no_rhs_kvs) + ; traceRn "rndata" (ppr tycon <+> ppr cusk <+> ppr free_rhs_kvs) ; return (DataDecl { tcdLName = tycon' , tcdTyVars = tyvars' , tcdFixity = fixity ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1851,6 +1851,11 @@ instance Diagnostic TcRnMessage where , text "or a complete user-supplied kind (CUSK, legacy feature)" , text "is required to use invisible binders." ] + TcRnImplicitRhsQuantification kv -> mkSimpleDecorated $ + vcat [ text "The variable" <+> quotes (ppr kv) <+> text "occurs free on the RHS of the type declaration" + , text "In the future GHC will no longer implicitly quantify over such variables" + ] + diagnosticReason = \case TcRnUnknownMessage m -> diagnosticReason m @@ -2467,6 +2472,8 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnInvisBndrWithoutSig{} -> ErrorWithoutFlag + TcRnImplicitRhsQuantification{} + -> WarningWithFlag Opt_WarnImplicitRhsQuantification diagnosticHints = \case TcRnUnknownMessage m @@ -3130,6 +3137,8 @@ instance Diagnostic TcRnMessage where -> noHints TcRnInvisBndrWithoutSig name _ -> [SuggestAddStandaloneKindSignature name] + TcRnImplicitRhsQuantification kv + -> [SuggestBindTyVarOnLhs (unLoc kv)] diagnosticCode :: TcRnMessage -> Maybe DiagnosticCode diagnosticCode = constructorCode ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -4094,6 +4094,23 @@ data TcRnMessage where -} TcRnMissingRoleAnnotation :: Name -> [Role] -> TcRnMessage + {-| TcRnImplicitRhsQuantification is a warning that occurs when GHC implicitly + quantifies over a type variable that occurs free on the RHS of the type declaration + that is not mentioned on the LHS + + Example: + + type T = 'Nothing :: Maybe a + + Controlled by flags: + - Wimplicit-rhs-quantification + + Test cases: + T23510a + T23510b + -} + TcRnImplicitRhsQuantification :: LocatedN RdrName -> TcRnMessage + deriving Generic ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -591,6 +591,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnArityMismatch" = 27346 GhcDiagnosticCode "TcRnSimplifiableConstraint" = 62412 GhcDiagnosticCode "TcRnIllegalQuasiQuotes" = 77343 + GhcDiagnosticCode "TcRnImplicitRhsQuantification" = 16382 -- TcRnTypeApplicationsDisabled GhcDiagnosticCode "TypeApplication" = 23482 ===================================== compiler/GHC/Types/Hint.hs ===================================== @@ -465,6 +465,9 @@ data GhcHint {-| Suggest eta-reducing a type synonym used in the implementation of abstract data. -} | SuggestEtaReduceAbsDataTySyn TyCon + {-| Suggest binding the type variable on the LHS of the type declaration + -} + | SuggestBindTyVarOnLhs RdrName -- | An 'InstantiationSuggestion' for a '.hsig' file. This is generated -- by GHC in case of a 'DriverUnexpectedSignature' and suggests a way ===================================== compiler/GHC/Types/Hint/Ppr.hs ===================================== @@ -251,6 +251,8 @@ instance Outputable GhcHint where SuggestEtaReduceAbsDataTySyn tc -> text "If possible, eta-reduce the type synonym" <+> ppr_tc <+> text "so that it is nullary." where ppr_tc = quotes (ppr $ tyConName tc) + SuggestBindTyVarOnLhs tv + -> text "Bind" <+> quotes (ppr tv) <+> text "on the LHS of the type declaration" perhapsAsPat :: SDoc perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace" ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -166,6 +166,7 @@ as ``-Wno-...`` for every individual warning in the group. * :ghc-flag:`-Wnoncanonical-monad-instances` * :ghc-flag:`-Wcompat-unqualified-imports` * :ghc-flag:`-Wtype-equality-out-of-scope` + * :ghc-flag:`-Wimplicit-rhs-quantification` .. ghc-flag:: -w :shortdesc: disable all warnings @@ -2415,6 +2416,28 @@ of ``-W(no-)*``. In other words the type-class role cannot be accidentally left representational or phantom, which could affected the code correctness. +.. ghc-flag:: -Wimplicit-rhs-quantification + :shortdesc: warn when type variables on the RHS of a type synonym are implicitly quantified + :type: dynamic + :reverse: -Wno-implicit-rhs-quantification + :category: + + :since: 9.10 + :default: off + + In accordance with `GHC Proposal #425 + `__, + GHC will stop implicitly quantifying over type variables that occur free on the + right-hand side of a type synonym but are not mentioned on the left-hand side. + Type synonym declarations that rely on this form of quantification should be rewritten with invisible binders. + + For example: :: + + type T1 :: forall a . Maybe a + type T1 = 'Nothing :: Maybe a -- old + type T1 @a = 'Nothing :: Maybe a -- new + + This warning detects code that will be affected by this breaking change. If you're feeling really paranoid, the :ghc-flag:`-dcore-lint` option is a good choice. It turns on heavyweight intra-pass sanity-checking within GHC. (It checks GHC's ===================================== testsuite/tests/dependent/should_compile/T16391a.hs ===================================== @@ -9,7 +9,8 @@ import Data.Kind type Const (a :: Type) (b :: Type) = a type family F :: Const Type a where F = Int -type TS = (Int :: Const Type a) +type TS :: forall a . Const Type a +type TS @a = (Int :: Const Type a) data T1 :: Const Type a where MkT1 :: T1 data T2 :: Const Type a -> Type where ===================================== testsuite/tests/ghci/scripts/ghci024.stdout ===================================== @@ -18,6 +18,7 @@ warning settings: -Wsemigroup -Wcompat-unqualified-imports -Wtype-equality-out-of-scope + -Wimplicit-rhs-quantification ~~~~~~~~~~ Testing :set -a options currently set: none. base language is: GHC2021 ===================================== testsuite/tests/rename/should_compile/T23510b.hs ===================================== @@ -0,0 +1,14 @@ +{-# OPTIONS -Wimplicit-rhs-quantification #-} +{-# LANGUAGE DataKinds, TypeAbstractions #-} +module T23510b where + +import Data.Proxy + +type T1 :: forall k . Maybe k +type T1 @a = 'Nothing :: Maybe a + +type T2 :: forall k j . k -> Either k j +type T2 @a @b = 'Left :: a -> Either a b + +type T3 :: forall {k} (d :: k) . Proxy k +type T3 @(a :: k) = 'Proxy :: Proxy k ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -212,3 +212,4 @@ test('T22122', [expect_broken(22122), extra_files(['T22122_aux.hs'])], multimod_ test('T23240', [req_th, extra_files(['T23240_aux.hs'])], multimod_compile, ['T23240', '-v0']) test('T23318', normal, compile, ['-Wduplicate-exports']) test('T23434', normal, compile, ['']) +test('T23510b', normal, compile, ['']) ===================================== testsuite/tests/rename/should_fail/T23510a.hs ===================================== @@ -0,0 +1,17 @@ +{-# OPTIONS -Wimplicit-rhs-quantification #-} +{-# LANGUAGE DataKinds #-} +module T23510a where + +import Data.Proxy +import GHC.Types + +type T1 = 'Nothing :: Maybe a + +type T2 = 'Left :: a -> Either a b + +type T3 = 'Proxy :: Proxy k + +type Const (a :: Type) (b :: Type) = a +type TS = (Int :: Const Type a) + +type Bad = (forall (v1 :: RuntimeRep) (a1 :: TYPE v). a1) :: TYPE v ===================================== testsuite/tests/rename/should_fail/T23510a.stderr ===================================== @@ -0,0 +1,30 @@ + +T23510a.hs:8:29: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘a’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘a’ on the LHS of the type declaration + +T23510a.hs:10:20: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘a’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘a’ on the LHS of the type declaration + +T23510a.hs:10:34: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘b’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘b’ on the LHS of the type declaration + +T23510a.hs:12:27: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘k’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘k’ on the LHS of the type declaration + +T23510a.hs:15:30: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘a’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘a’ on the LHS of the type declaration + +T23510a.hs:17:67: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘v’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘v’ on the LHS of the type declaration ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -198,3 +198,4 @@ test('RnUnexpectedStandaloneDeriving', normal, compile_fail, ['']) test('RnStupidThetaInGadt', normal, compile_fail, ['']) test('PackageImportsDisabled', normal, compile_fail, ['']) test('ImportLookupIllegal', normal, compile_fail, ['']) +test('T23510a', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_compile/T13343.hs ===================================== @@ -4,6 +4,7 @@ module Bug where import GHC.Exts -type Bad = (forall (v1 :: RuntimeRep) (a1 :: TYPE v). a1) :: TYPE v +type Bad :: forall v . TYPE v +type Bad @v = (forall (v1 :: RuntimeRep) (a1 :: TYPE v). a1) :: TYPE v --- should be accepted because GHC will generalize over v. Note v /= v1. +-- Note v /= v1. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4909734e5a3494954d9c5f6bfdc6959a449e53f5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4909734e5a3494954d9c5f6bfdc6959a449e53f5 You're receiving 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 Jun 12 13:08:44 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Mon, 12 Jun 2023 09:08:44 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/DIB-instances] Implement the -Wimplicit-rhs-quantification warning (#23510) Message-ID: <648718dcbf0ca_1af13ac56fc57251@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/DIB-instances at Glasgow Haskell Compiler / GHC Commits: e2c49dce by Andrei Borzenkov at 2023-06-12T17:08:29+04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 18 changed files: - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - docs/users_guide/using-warnings.rst - testsuite/tests/dependent/should_compile/T16391a.hs - testsuite/tests/ghci/scripts/ghci024.stdout - + testsuite/tests/rename/should_compile/T23510b.hs - testsuite/tests/rename/should_compile/all.T - + testsuite/tests/rename/should_fail/T23510a.hs - + testsuite/tests/rename/should_fail/T23510a.stderr - testsuite/tests/rename/should_fail/all.T - testsuite/tests/typecheck/should_compile/T13343.hs Changes: ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -641,6 +641,7 @@ data WarningFlag = | Opt_WarnLoopySuperclassSolve -- Since 9.6 | Opt_WarnTermVariableCapture -- Since 9.8 | Opt_WarnMissingRoleAnnotations -- Since 9.8 + | Opt_WarnImplicitRhsQuantification -- Since 9.10 deriving (Eq, Ord, Show, Enum) -- | Return the names of a WarningFlag @@ -748,6 +749,7 @@ warnFlagNames wflag = case wflag of Opt_WarnLoopySuperclassSolve -> "loopy-superclass-solve" :| [] Opt_WarnTypeEqualityRequiresOperators -> "type-equality-requires-operators" :| [] Opt_WarnMissingRoleAnnotations -> "missing-role-annotations" :| [] + Opt_WarnImplicitRhsQuantification -> "implicit-rhs-quantification" :| [] -- ----------------------------------------------------------------------------- -- Standard sets of warning options @@ -939,6 +941,7 @@ minusWcompatOpts , Opt_WarnNonCanonicalMonadInstances , Opt_WarnCompatUnqualifiedImports , Opt_WarnTypeEqualityOutOfScope + , Opt_WarnImplicitRhsQuantification ] -- | Things you get with -Wunused-binds ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2259,7 +2259,8 @@ wWarningFlagsDeps = mconcat [ warnSpec Opt_WarnTypeEqualityOutOfScope, warnSpec Opt_WarnTypeEqualityRequiresOperators, warnSpec Opt_WarnTermVariableCapture, - warnSpec Opt_WarnMissingRoleAnnotations + warnSpec Opt_WarnMissingRoleAnnotations, + warnSpec Opt_WarnImplicitRhsQuantification ] warningGroupsDeps :: [(Deprecation, FlagSpec WarningGroup)] ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -918,8 +918,8 @@ bindHsQTyVars :: forall a b. -> Maybe a -- Just _ => an associated type decl -> FreeKiTyVars -- Kind variables from scope -> LHsQTyVars GhcPs - -> (LHsQTyVars GhcRn -> Bool -> RnM (b, FreeVars)) - -- The Bool is True <=> all kind variables used in the + -> (LHsQTyVars GhcRn -> FreeKiTyVars -> RnM (b, FreeVars)) + -- The FreeKiTyVars is null <=> all kind variables used in the -- kind signature are bound on the left. Reason: -- the last clause of Note [CUSKs: complete user-supplied kind signatures] -- in GHC.Hs.Decls @@ -942,7 +942,6 @@ bindHsQTyVars doc mb_assoc body_kv_occs hsq_bndrs thing_inside bndr_kv_occs ++ body_kv_occs body_remaining = filterFreeVarsToBind bndr_kv_occs $ filterFreeVarsToBind bndrs body_kv_occs - all_bound_on_lhs = null body_remaining ; traceRn "checkMixedVars3" $ vcat [ text "bndrs" <+> ppr hs_tv_bndrs @@ -969,7 +968,7 @@ bindHsQTyVars doc mb_assoc body_kv_occs hsq_bndrs thing_inside ; traceRn "bindHsQTyVars" (ppr hsq_bndrs $$ ppr implicit_kv_nms $$ ppr rn_bndrs) ; thing_inside (HsQTvs { hsq_ext = implicit_kv_nms , hsq_explicit = rn_bndrs }) - all_bound_on_lhs } } + body_remaining } } where hs_tv_bndrs = hsQTvExplicit hsq_bndrs @@ -1802,12 +1801,15 @@ one exists: The logic resides in extractHsTyRdrTyVarsKindVars. We use it both for type synonyms and type family instances. -This is something of a stopgap solution until we can explicitly bind invisible +This was a stopgap solution until we could explicitly bind invisible type/kind variables: type TySyn3 :: forall a. Maybe a type TySyn3 @a = 'Just ('Nothing :: Maybe a) +Now that the new syntax was proposed in #425 and implemented in 9.8, we issue a warning +-Wimplicit-rhs-quantification for TySyn2 and TySyn4 and will eventually disallow them. + Note [Implicit quantification in type synonyms: non-taken alternatives] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -1709,11 +1709,16 @@ rnTyClDecl (SynDecl { tcdLName = tycon, tcdTyVars = tyvars, ; let kvs = extractHsTyRdrTyVarsKindVars rhs doc = TySynCtx tycon ; traceRn "rntycl-ty" (ppr tycon <+> ppr kvs) - ; bindHsQTyVars doc Nothing kvs tyvars $ \ tyvars' _ -> - do { (rhs', fvs) <- rnTySyn doc rhs + ; bindHsQTyVars doc Nothing kvs tyvars $ \ tyvars' free_rhs_kvs -> + do { mapM_ warn_implicit_kvs (nubL free_rhs_kvs) + ; (rhs', fvs) <- rnTySyn doc rhs ; return (SynDecl { tcdLName = tycon', tcdTyVars = tyvars' , tcdFixity = fixity , tcdRhs = rhs', tcdSExt = fvs }, fvs) } } + where + warn_implicit_kvs :: LocatedN RdrName -> RnM () + warn_implicit_kvs kv = + addErrAt (getLocA kv) (TcRnImplicitRhsQuantification kv) -- "data", "newtype" declarations rnTyClDecl (DataDecl @@ -1725,12 +1730,12 @@ rnTyClDecl (DataDecl doc = TyDataCtx tycon new_or_data = dataDefnConsNewOrData cons ; traceRn "rntycl-data" (ppr tycon <+> ppr kvs) - ; bindHsQTyVars doc Nothing kvs tyvars $ \ tyvars' no_rhs_kvs -> + ; bindHsQTyVars doc Nothing kvs tyvars $ \ tyvars' free_rhs_kvs -> do { (defn', fvs) <- rnDataDefn doc defn - ; cusk <- data_decl_has_cusk tyvars' new_or_data no_rhs_kvs kind_sig + ; cusk <- data_decl_has_cusk tyvars' new_or_data (null free_rhs_kvs) kind_sig ; let rn_info = DataDeclRn { tcdDataCusk = cusk , tcdFVs = fvs } - ; traceRn "rndata" (ppr tycon <+> ppr cusk <+> ppr no_rhs_kvs) + ; traceRn "rndata" (ppr tycon <+> ppr cusk <+> ppr free_rhs_kvs) ; return (DataDecl { tcdLName = tycon' , tcdTyVars = tyvars' , tcdFixity = fixity ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1851,6 +1851,11 @@ instance Diagnostic TcRnMessage where , text "or a complete user-supplied kind (CUSK, legacy feature)" , text "is required to use invisible binders." ] + TcRnImplicitRhsQuantification kv -> mkSimpleDecorated $ + vcat [ text "The variable" <+> quotes (ppr kv) <+> text "occurs free on the RHS of the type declaration" + , text "In the future GHC will no longer implicitly quantify over such variables" + ] + diagnosticReason = \case TcRnUnknownMessage m -> diagnosticReason m @@ -2467,6 +2472,8 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnInvisBndrWithoutSig{} -> ErrorWithoutFlag + TcRnImplicitRhsQuantification{} + -> WarningWithFlag Opt_WarnImplicitRhsQuantification diagnosticHints = \case TcRnUnknownMessage m @@ -3130,6 +3137,8 @@ instance Diagnostic TcRnMessage where -> noHints TcRnInvisBndrWithoutSig name _ -> [SuggestAddStandaloneKindSignature name] + TcRnImplicitRhsQuantification kv + -> [SuggestBindTyVarOnLhs (unLoc kv)] diagnosticCode :: TcRnMessage -> Maybe DiagnosticCode diagnosticCode = constructorCode ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -4094,6 +4094,23 @@ data TcRnMessage where -} TcRnMissingRoleAnnotation :: Name -> [Role] -> TcRnMessage + {-| TcRnImplicitRhsQuantification is a warning that occurs when GHC implicitly + quantifies over a type variable that occurs free on the RHS of the type declaration + that is not mentioned on the LHS + + Example: + + type T = 'Nothing :: Maybe a + + Controlled by flags: + - Wimplicit-rhs-quantification + + Test cases: + T23510a + T23510b + -} + TcRnImplicitRhsQuantification :: LocatedN RdrName -> TcRnMessage + deriving Generic ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -591,6 +591,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnArityMismatch" = 27346 GhcDiagnosticCode "TcRnSimplifiableConstraint" = 62412 GhcDiagnosticCode "TcRnIllegalQuasiQuotes" = 77343 + GhcDiagnosticCode "TcRnImplicitRhsQuantification" = 16382 -- TcRnTypeApplicationsDisabled GhcDiagnosticCode "TypeApplication" = 23482 ===================================== compiler/GHC/Types/Hint.hs ===================================== @@ -465,6 +465,9 @@ data GhcHint {-| Suggest eta-reducing a type synonym used in the implementation of abstract data. -} | SuggestEtaReduceAbsDataTySyn TyCon + {-| Suggest binding the type variable on the LHS of the type declaration + -} + | SuggestBindTyVarOnLhs RdrName -- | An 'InstantiationSuggestion' for a '.hsig' file. This is generated -- by GHC in case of a 'DriverUnexpectedSignature' and suggests a way ===================================== compiler/GHC/Types/Hint/Ppr.hs ===================================== @@ -251,6 +251,8 @@ instance Outputable GhcHint where SuggestEtaReduceAbsDataTySyn tc -> text "If possible, eta-reduce the type synonym" <+> ppr_tc <+> text "so that it is nullary." where ppr_tc = quotes (ppr $ tyConName tc) + SuggestBindTyVarOnLhs tv + -> text "Bind" <+> quotes (ppr tv) <+> text "on the LHS of the type declaration" perhapsAsPat :: SDoc perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace" ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -166,6 +166,7 @@ as ``-Wno-...`` for every individual warning in the group. * :ghc-flag:`-Wnoncanonical-monad-instances` * :ghc-flag:`-Wcompat-unqualified-imports` * :ghc-flag:`-Wtype-equality-out-of-scope` + * :ghc-flag:`-Wimplicit-rhs-quantification` .. ghc-flag:: -w :shortdesc: disable all warnings @@ -2415,6 +2416,28 @@ of ``-W(no-)*``. In other words the type-class role cannot be accidentally left representational or phantom, which could affected the code correctness. +.. ghc-flag:: -Wimplicit-rhs-quantification + :shortdesc: warn when type variables on the RHS of a type synonym are implicitly quantified + :type: dynamic + :reverse: -Wno-implicit-rhs-quantification + :category: + + :since: 9.10 + :default: off + + In accordance with `GHC Proposal #425 + `__, + GHC will stop implicitly quantifying over type variables that occur free on the + right-hand side of a type synonym but are not mentioned on the left-hand side. + Type synonym declarations that rely on this form of quantification should be rewritten with invisible binders. + + For example: :: + + type T1 :: forall a . Maybe a + type T1 = 'Nothing :: Maybe a -- old + type T1 @a = 'Nothing :: Maybe a -- new + + This warning detects code that will be affected by this breaking change. If you're feeling really paranoid, the :ghc-flag:`-dcore-lint` option is a good choice. It turns on heavyweight intra-pass sanity-checking within GHC. (It checks GHC's ===================================== testsuite/tests/dependent/should_compile/T16391a.hs ===================================== @@ -9,7 +9,8 @@ import Data.Kind type Const (a :: Type) (b :: Type) = a type family F :: Const Type a where F = Int -type TS = (Int :: Const Type a) +type TS :: forall a . Const Type a +type TS @a = (Int :: Const Type a) data T1 :: Const Type a where MkT1 :: T1 data T2 :: Const Type a -> Type where ===================================== testsuite/tests/ghci/scripts/ghci024.stdout ===================================== @@ -18,6 +18,7 @@ warning settings: -Wsemigroup -Wcompat-unqualified-imports -Wtype-equality-out-of-scope + -Wimplicit-rhs-quantification ~~~~~~~~~~ Testing :set -a options currently set: none. base language is: GHC2021 ===================================== testsuite/tests/rename/should_compile/T23510b.hs ===================================== @@ -0,0 +1,14 @@ +{-# OPTIONS -Wimplicit-rhs-quantification #-} +{-# LANGUAGE DataKinds, TypeAbstractions #-} +module T23510b where + +import Data.Proxy + +type T1 :: forall k . Maybe k +type T1 @a = 'Nothing :: Maybe a + +type T2 :: forall k j . k -> Either k j +type T2 @a @b = 'Left :: a -> Either a b + +type T3 :: forall {k} (d :: k) . Proxy k +type T3 @(a :: k) = 'Proxy :: Proxy k ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -212,3 +212,4 @@ test('T22122', [expect_broken(22122), extra_files(['T22122_aux.hs'])], multimod_ test('T23240', [req_th, extra_files(['T23240_aux.hs'])], multimod_compile, ['T23240', '-v0']) test('T23318', normal, compile, ['-Wduplicate-exports']) test('T23434', normal, compile, ['']) +test('T23510b', normal, compile, ['']) ===================================== testsuite/tests/rename/should_fail/T23510a.hs ===================================== @@ -0,0 +1,17 @@ +{-# OPTIONS -Wimplicit-rhs-quantification #-} +{-# LANGUAGE DataKinds #-} +module T23510a where + +import Data.Proxy +import GHC.Types + +type T1 = 'Nothing :: Maybe a + +type T2 = 'Left :: a -> Either a b + +type T3 = 'Proxy :: Proxy k + +type Const (a :: Type) (b :: Type) = a +type TS = (Int :: Const Type a) + +type Bad = (forall (v1 :: RuntimeRep) (a1 :: TYPE v). a1) :: TYPE v ===================================== testsuite/tests/rename/should_fail/T23510a.stderr ===================================== @@ -0,0 +1,30 @@ + +T23510a.hs:8:29: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘a’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘a’ on the LHS of the type declaration + +T23510a.hs:10:20: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘a’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘a’ on the LHS of the type declaration + +T23510a.hs:10:34: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘b’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘b’ on the LHS of the type declaration + +T23510a.hs:12:27: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘k’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘k’ on the LHS of the type declaration + +T23510a.hs:15:30: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘a’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘a’ on the LHS of the type declaration + +T23510a.hs:17:67: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘v’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘v’ on the LHS of the type declaration ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -198,3 +198,4 @@ test('RnUnexpectedStandaloneDeriving', normal, compile_fail, ['']) test('RnStupidThetaInGadt', normal, compile_fail, ['']) test('PackageImportsDisabled', normal, compile_fail, ['']) test('ImportLookupIllegal', normal, compile_fail, ['']) +test('T23510a', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_compile/T13343.hs ===================================== @@ -4,6 +4,7 @@ module Bug where import GHC.Exts -type Bad = (forall (v1 :: RuntimeRep) (a1 :: TYPE v). a1) :: TYPE v +type Bad :: forall v . TYPE v +type Bad @v = (forall (v1 :: RuntimeRep) (a1 :: TYPE v). a1) :: TYPE v --- should be accepted because GHC will generalize over v. Note v /= v1. +-- Note v /= v1. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e2c49dce45b11f18d24b082edd9bcba25fad82a1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e2c49dce45b11f18d24b082edd9bcba25fad82a1 You're receiving 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 Jun 12 13:10:36 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Mon, 12 Jun 2023 09:10:36 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/DIB-instances] Implement the -Wimplicit-rhs-quantification warning (#23510) Message-ID: <6487194c22ad_1af13ac56d459484@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/DIB-instances at Glasgow Haskell Compiler / GHC Commits: 2198ffd5 by Andrei Borzenkov at 2023-06-12T17:10:23+04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 18 changed files: - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - docs/users_guide/using-warnings.rst - testsuite/tests/dependent/should_compile/T16391a.hs - testsuite/tests/ghci/scripts/ghci024.stdout - + testsuite/tests/rename/should_compile/T23510b.hs - testsuite/tests/rename/should_compile/all.T - + testsuite/tests/rename/should_fail/T23510a.hs - + testsuite/tests/rename/should_fail/T23510a.stderr - testsuite/tests/rename/should_fail/all.T - testsuite/tests/typecheck/should_compile/T13343.hs Changes: ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -641,6 +641,7 @@ data WarningFlag = | Opt_WarnLoopySuperclassSolve -- Since 9.6 | Opt_WarnTermVariableCapture -- Since 9.8 | Opt_WarnMissingRoleAnnotations -- Since 9.8 + | Opt_WarnImplicitRhsQuantification -- Since 9.8 deriving (Eq, Ord, Show, Enum) -- | Return the names of a WarningFlag @@ -748,6 +749,7 @@ warnFlagNames wflag = case wflag of Opt_WarnLoopySuperclassSolve -> "loopy-superclass-solve" :| [] Opt_WarnTypeEqualityRequiresOperators -> "type-equality-requires-operators" :| [] Opt_WarnMissingRoleAnnotations -> "missing-role-annotations" :| [] + Opt_WarnImplicitRhsQuantification -> "implicit-rhs-quantification" :| [] -- ----------------------------------------------------------------------------- -- Standard sets of warning options @@ -939,6 +941,7 @@ minusWcompatOpts , Opt_WarnNonCanonicalMonadInstances , Opt_WarnCompatUnqualifiedImports , Opt_WarnTypeEqualityOutOfScope + , Opt_WarnImplicitRhsQuantification ] -- | Things you get with -Wunused-binds ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2259,7 +2259,8 @@ wWarningFlagsDeps = mconcat [ warnSpec Opt_WarnTypeEqualityOutOfScope, warnSpec Opt_WarnTypeEqualityRequiresOperators, warnSpec Opt_WarnTermVariableCapture, - warnSpec Opt_WarnMissingRoleAnnotations + warnSpec Opt_WarnMissingRoleAnnotations, + warnSpec Opt_WarnImplicitRhsQuantification ] warningGroupsDeps :: [(Deprecation, FlagSpec WarningGroup)] ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -918,8 +918,8 @@ bindHsQTyVars :: forall a b. -> Maybe a -- Just _ => an associated type decl -> FreeKiTyVars -- Kind variables from scope -> LHsQTyVars GhcPs - -> (LHsQTyVars GhcRn -> Bool -> RnM (b, FreeVars)) - -- The Bool is True <=> all kind variables used in the + -> (LHsQTyVars GhcRn -> FreeKiTyVars -> RnM (b, FreeVars)) + -- The FreeKiTyVars is null <=> all kind variables used in the -- kind signature are bound on the left. Reason: -- the last clause of Note [CUSKs: complete user-supplied kind signatures] -- in GHC.Hs.Decls @@ -942,7 +942,6 @@ bindHsQTyVars doc mb_assoc body_kv_occs hsq_bndrs thing_inside bndr_kv_occs ++ body_kv_occs body_remaining = filterFreeVarsToBind bndr_kv_occs $ filterFreeVarsToBind bndrs body_kv_occs - all_bound_on_lhs = null body_remaining ; traceRn "checkMixedVars3" $ vcat [ text "bndrs" <+> ppr hs_tv_bndrs @@ -969,7 +968,7 @@ bindHsQTyVars doc mb_assoc body_kv_occs hsq_bndrs thing_inside ; traceRn "bindHsQTyVars" (ppr hsq_bndrs $$ ppr implicit_kv_nms $$ ppr rn_bndrs) ; thing_inside (HsQTvs { hsq_ext = implicit_kv_nms , hsq_explicit = rn_bndrs }) - all_bound_on_lhs } } + body_remaining } } where hs_tv_bndrs = hsQTvExplicit hsq_bndrs @@ -1802,12 +1801,15 @@ one exists: The logic resides in extractHsTyRdrTyVarsKindVars. We use it both for type synonyms and type family instances. -This is something of a stopgap solution until we can explicitly bind invisible +This was a stopgap solution until we could explicitly bind invisible type/kind variables: type TySyn3 :: forall a. Maybe a type TySyn3 @a = 'Just ('Nothing :: Maybe a) +Now that the new syntax was proposed in #425 and implemented in 9.8, we issue a warning +-Wimplicit-rhs-quantification for TySyn2 and TySyn4 and will eventually disallow them. + Note [Implicit quantification in type synonyms: non-taken alternatives] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -1709,11 +1709,16 @@ rnTyClDecl (SynDecl { tcdLName = tycon, tcdTyVars = tyvars, ; let kvs = extractHsTyRdrTyVarsKindVars rhs doc = TySynCtx tycon ; traceRn "rntycl-ty" (ppr tycon <+> ppr kvs) - ; bindHsQTyVars doc Nothing kvs tyvars $ \ tyvars' _ -> - do { (rhs', fvs) <- rnTySyn doc rhs + ; bindHsQTyVars doc Nothing kvs tyvars $ \ tyvars' free_rhs_kvs -> + do { mapM_ warn_implicit_kvs (nubL free_rhs_kvs) + ; (rhs', fvs) <- rnTySyn doc rhs ; return (SynDecl { tcdLName = tycon', tcdTyVars = tyvars' , tcdFixity = fixity , tcdRhs = rhs', tcdSExt = fvs }, fvs) } } + where + warn_implicit_kvs :: LocatedN RdrName -> RnM () + warn_implicit_kvs kv = + addErrAt (getLocA kv) (TcRnImplicitRhsQuantification kv) -- "data", "newtype" declarations rnTyClDecl (DataDecl @@ -1725,12 +1730,12 @@ rnTyClDecl (DataDecl doc = TyDataCtx tycon new_or_data = dataDefnConsNewOrData cons ; traceRn "rntycl-data" (ppr tycon <+> ppr kvs) - ; bindHsQTyVars doc Nothing kvs tyvars $ \ tyvars' no_rhs_kvs -> + ; bindHsQTyVars doc Nothing kvs tyvars $ \ tyvars' free_rhs_kvs -> do { (defn', fvs) <- rnDataDefn doc defn - ; cusk <- data_decl_has_cusk tyvars' new_or_data no_rhs_kvs kind_sig + ; cusk <- data_decl_has_cusk tyvars' new_or_data (null free_rhs_kvs) kind_sig ; let rn_info = DataDeclRn { tcdDataCusk = cusk , tcdFVs = fvs } - ; traceRn "rndata" (ppr tycon <+> ppr cusk <+> ppr no_rhs_kvs) + ; traceRn "rndata" (ppr tycon <+> ppr cusk <+> ppr free_rhs_kvs) ; return (DataDecl { tcdLName = tycon' , tcdTyVars = tyvars' , tcdFixity = fixity ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1851,6 +1851,11 @@ instance Diagnostic TcRnMessage where , text "or a complete user-supplied kind (CUSK, legacy feature)" , text "is required to use invisible binders." ] + TcRnImplicitRhsQuantification kv -> mkSimpleDecorated $ + vcat [ text "The variable" <+> quotes (ppr kv) <+> text "occurs free on the RHS of the type declaration" + , text "In the future GHC will no longer implicitly quantify over such variables" + ] + diagnosticReason = \case TcRnUnknownMessage m -> diagnosticReason m @@ -2467,6 +2472,8 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnInvisBndrWithoutSig{} -> ErrorWithoutFlag + TcRnImplicitRhsQuantification{} + -> WarningWithFlag Opt_WarnImplicitRhsQuantification diagnosticHints = \case TcRnUnknownMessage m @@ -3130,6 +3137,8 @@ instance Diagnostic TcRnMessage where -> noHints TcRnInvisBndrWithoutSig name _ -> [SuggestAddStandaloneKindSignature name] + TcRnImplicitRhsQuantification kv + -> [SuggestBindTyVarOnLhs (unLoc kv)] diagnosticCode :: TcRnMessage -> Maybe DiagnosticCode diagnosticCode = constructorCode ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -4094,6 +4094,23 @@ data TcRnMessage where -} TcRnMissingRoleAnnotation :: Name -> [Role] -> TcRnMessage + {-| TcRnImplicitRhsQuantification is a warning that occurs when GHC implicitly + quantifies over a type variable that occurs free on the RHS of the type declaration + that is not mentioned on the LHS + + Example: + + type T = 'Nothing :: Maybe a + + Controlled by flags: + - Wimplicit-rhs-quantification + + Test cases: + T23510a + T23510b + -} + TcRnImplicitRhsQuantification :: LocatedN RdrName -> TcRnMessage + deriving Generic ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -591,6 +591,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnArityMismatch" = 27346 GhcDiagnosticCode "TcRnSimplifiableConstraint" = 62412 GhcDiagnosticCode "TcRnIllegalQuasiQuotes" = 77343 + GhcDiagnosticCode "TcRnImplicitRhsQuantification" = 16382 -- TcRnTypeApplicationsDisabled GhcDiagnosticCode "TypeApplication" = 23482 ===================================== compiler/GHC/Types/Hint.hs ===================================== @@ -465,6 +465,9 @@ data GhcHint {-| Suggest eta-reducing a type synonym used in the implementation of abstract data. -} | SuggestEtaReduceAbsDataTySyn TyCon + {-| Suggest binding the type variable on the LHS of the type declaration + -} + | SuggestBindTyVarOnLhs RdrName -- | An 'InstantiationSuggestion' for a '.hsig' file. This is generated -- by GHC in case of a 'DriverUnexpectedSignature' and suggests a way ===================================== compiler/GHC/Types/Hint/Ppr.hs ===================================== @@ -251,6 +251,8 @@ instance Outputable GhcHint where SuggestEtaReduceAbsDataTySyn tc -> text "If possible, eta-reduce the type synonym" <+> ppr_tc <+> text "so that it is nullary." where ppr_tc = quotes (ppr $ tyConName tc) + SuggestBindTyVarOnLhs tv + -> text "Bind" <+> quotes (ppr tv) <+> text "on the LHS of the type declaration" perhapsAsPat :: SDoc perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace" ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -166,6 +166,7 @@ as ``-Wno-...`` for every individual warning in the group. * :ghc-flag:`-Wnoncanonical-monad-instances` * :ghc-flag:`-Wcompat-unqualified-imports` * :ghc-flag:`-Wtype-equality-out-of-scope` + * :ghc-flag:`-Wimplicit-rhs-quantification` .. ghc-flag:: -w :shortdesc: disable all warnings @@ -2415,6 +2416,28 @@ of ``-W(no-)*``. In other words the type-class role cannot be accidentally left representational or phantom, which could affected the code correctness. +.. ghc-flag:: -Wimplicit-rhs-quantification + :shortdesc: warn when type variables on the RHS of a type synonym are implicitly quantified + :type: dynamic + :reverse: -Wno-implicit-rhs-quantification + :category: + + :since: 9.8 + :default: off + + In accordance with `GHC Proposal #425 + `__, + GHC will stop implicitly quantifying over type variables that occur free on the + right-hand side of a type synonym but are not mentioned on the left-hand side. + Type synonym declarations that rely on this form of quantification should be rewritten with invisible binders. + + For example: :: + + type T1 :: forall a . Maybe a + type T1 = 'Nothing :: Maybe a -- old + type T1 @a = 'Nothing :: Maybe a -- new + + This warning detects code that will be affected by this breaking change. If you're feeling really paranoid, the :ghc-flag:`-dcore-lint` option is a good choice. It turns on heavyweight intra-pass sanity-checking within GHC. (It checks GHC's ===================================== testsuite/tests/dependent/should_compile/T16391a.hs ===================================== @@ -9,7 +9,8 @@ import Data.Kind type Const (a :: Type) (b :: Type) = a type family F :: Const Type a where F = Int -type TS = (Int :: Const Type a) +type TS :: forall a . Const Type a +type TS @a = (Int :: Const Type a) data T1 :: Const Type a where MkT1 :: T1 data T2 :: Const Type a -> Type where ===================================== testsuite/tests/ghci/scripts/ghci024.stdout ===================================== @@ -18,6 +18,7 @@ warning settings: -Wsemigroup -Wcompat-unqualified-imports -Wtype-equality-out-of-scope + -Wimplicit-rhs-quantification ~~~~~~~~~~ Testing :set -a options currently set: none. base language is: GHC2021 ===================================== testsuite/tests/rename/should_compile/T23510b.hs ===================================== @@ -0,0 +1,14 @@ +{-# OPTIONS -Wimplicit-rhs-quantification #-} +{-# LANGUAGE DataKinds, TypeAbstractions #-} +module T23510b where + +import Data.Proxy + +type T1 :: forall k . Maybe k +type T1 @a = 'Nothing :: Maybe a + +type T2 :: forall k j . k -> Either k j +type T2 @a @b = 'Left :: a -> Either a b + +type T3 :: forall {k} (d :: k) . Proxy k +type T3 @(a :: k) = 'Proxy :: Proxy k ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -212,3 +212,4 @@ test('T22122', [expect_broken(22122), extra_files(['T22122_aux.hs'])], multimod_ test('T23240', [req_th, extra_files(['T23240_aux.hs'])], multimod_compile, ['T23240', '-v0']) test('T23318', normal, compile, ['-Wduplicate-exports']) test('T23434', normal, compile, ['']) +test('T23510b', normal, compile, ['']) ===================================== testsuite/tests/rename/should_fail/T23510a.hs ===================================== @@ -0,0 +1,17 @@ +{-# OPTIONS -Wimplicit-rhs-quantification #-} +{-# LANGUAGE DataKinds #-} +module T23510a where + +import Data.Proxy +import GHC.Types + +type T1 = 'Nothing :: Maybe a + +type T2 = 'Left :: a -> Either a b + +type T3 = 'Proxy :: Proxy k + +type Const (a :: Type) (b :: Type) = a +type TS = (Int :: Const Type a) + +type Bad = (forall (v1 :: RuntimeRep) (a1 :: TYPE v). a1) :: TYPE v ===================================== testsuite/tests/rename/should_fail/T23510a.stderr ===================================== @@ -0,0 +1,30 @@ + +T23510a.hs:8:29: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘a’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘a’ on the LHS of the type declaration + +T23510a.hs:10:20: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘a’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘a’ on the LHS of the type declaration + +T23510a.hs:10:34: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘b’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘b’ on the LHS of the type declaration + +T23510a.hs:12:27: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘k’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘k’ on the LHS of the type declaration + +T23510a.hs:15:30: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘a’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘a’ on the LHS of the type declaration + +T23510a.hs:17:67: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘v’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘v’ on the LHS of the type declaration ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -198,3 +198,4 @@ test('RnUnexpectedStandaloneDeriving', normal, compile_fail, ['']) test('RnStupidThetaInGadt', normal, compile_fail, ['']) test('PackageImportsDisabled', normal, compile_fail, ['']) test('ImportLookupIllegal', normal, compile_fail, ['']) +test('T23510a', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_compile/T13343.hs ===================================== @@ -4,6 +4,7 @@ module Bug where import GHC.Exts -type Bad = (forall (v1 :: RuntimeRep) (a1 :: TYPE v). a1) :: TYPE v +type Bad :: forall v . TYPE v +type Bad @v = (forall (v1 :: RuntimeRep) (a1 :: TYPE v). a1) :: TYPE v --- should be accepted because GHC will generalize over v. Note v /= v1. +-- Note v /= v1. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2198ffd53001d9a17ca1d53927b50f50592fbc8b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2198ffd53001d9a17ca1d53927b50f50592fbc8b You're receiving 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 Jun 12 14:20:42 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Mon, 12 Jun 2023 10:20:42 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] Implement register -> stack spilling Message-ID: <648729bac265a_1af13ac56fc112784@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: 33bb0b5a by Sven Tennie at 2023-06-12T14:20:03+00:00 Implement register -> stack spilling - - - - - 1 changed file: - compiler/GHC/CmmToAsm/RV64/Instr.hs Changes: ===================================== compiler/GHC/CmmToAsm/RV64/Instr.hs ===================================== @@ -350,33 +350,31 @@ patchJumpInstr instr patchF -- always points to the top of the stack, and we can't use it for computation. -- -- | An instruction to spill a register into a spill slot. -mkSpillInstr - :: HasCallStack - => NCGConfig - -> Reg -- register to spill - -> Int -- current stack delta - -> Int -- spill slot to use - -> [Instr] - +mkSpillInstr :: + HasCallStack => + NCGConfig -> + Reg -> -- register to spill + Int -> -- current stack delta + Int -> -- spill slot to use + [Instr] mkSpillInstr config reg delta slot = - case (spillSlotToOffset config slot) - delta of - imm | -256 <= imm && imm <= 255 -> [ mkStrSp imm ] - imm | imm > 0 && imm .&. 0x7 == 0x0 && imm <= 0xfff -> [ mkStrSp imm ] - imm | imm > 0xfff && imm <= 0xffffff && imm .&. 0x7 == 0x0 -> [ mkIp0SpillAddr (imm .&~. 0xfff) - , mkStrIp0 (imm .&. 0xfff) - ] - imm -> pprPanic "mkSpillInstr" (text "Unable to spill into" <+> int imm) - where - a .&~. b = a .&. (complement b) - - fmt = case reg of - RegReal (RealRegSingle n) | n < 32 -> II64 - _ -> FF64 - mkIp0SpillAddr imm = ANN (text "Spill: IP0 <- SP + " <> int imm) $ ADD ip0 sp (OpImm (ImmInt imm)) - mkStrSp imm = ANN (text "Spill@" <> int (off - delta)) $ STR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 2) (ImmInt imm))) - mkStrIp0 imm = ANN (text "Spill@" <> int (off - delta)) $ STR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 16) (ImmInt imm))) + case off - delta of + imm | fitsIn12bitImm imm -> [mkStrSpImm imm] + imm -> + [ movImmToIp0 imm, + addSpToIp0, + mkStrIp0 + ] + where + fmt = case reg of + RegReal (RealRegSingle n) | n < 32 -> II64 + _ -> FF64 + mkStrSpImm imm = ANN (text "Spill@" <> int (off - delta)) $ STR fmt (OpReg W64 reg) (OpAddr (AddrRegImm sp_reg (ImmInt imm))) + movImmToIp0 imm = ANN (text "Spill: IP0 <- " <> int imm) $ MOV ip0 (OpImm (ImmInt imm)) + addSpToIp0 = ANN (text "Spill: IP0 <- SP + IP0 ") $ ADD ip0 ip0 sp + mkStrIp0 = ANN (text "Spill@" <> int (off - delta)) $ STR fmt (OpReg W64 reg) (OpAddr (AddrReg ip0_reg)) - off = spillSlotToOffset config slot + off = spillSlotToOffset config slot mkLoadInstr :: NCGConfig @@ -386,27 +384,25 @@ mkLoadInstr -> [Instr] mkLoadInstr config reg delta slot = - case (spillSlotToOffset config slot) - delta of - imm | -256 <= imm && imm <= 255 -> [ mkLdrSp imm ] - imm | imm > 0 && imm .&. 0x7 == 0x0 && imm <= 0xfff -> [ mkLdrSp imm ] - imm | imm > 0xfff && imm <= 0xffffff && imm .&. 0x7 == 0x0 -> [ mkIp0SpillAddr (imm .&~. 0xfff) - , mkLdrIp0 (imm .&. 0xfff) - ] - imm -> pprPanic "mkSpillInstr" (text "Unable to spill into" <+> int imm) - where - a .&~. b = a .&. (complement b) - - fmt = case reg of - RegReal (RealRegSingle n) | n < 32 -> II64 - _ -> FF64 - - mkIp0SpillAddr imm = ANN (text "Reload: IP0 <- SP + " <> int imm) $ ADD ip0 sp (OpImm (ImmInt imm)) - mkLdrSp imm = ANN (text "Reload@" <> int (off - delta)) $ LDR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 2) (ImmInt imm))) - mkLdrIp0 imm = ANN (text "Reload@" <> int (off - delta)) $ LDR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 16) (ImmInt imm))) + case off - delta of + imm | fitsIn12bitImm imm -> [mkLdrSpImm imm] + imm -> + [ movImmToIp0 imm, + addSpToIp0, + mkLdrIp0 + ] + where + fmt = case reg of + RegReal (RealRegSingle n) | n < 32 -> II64 + _ -> FF64 + mkLdrSpImm imm = ANN (text "Reload@" <> int (off - delta)) $ LDR fmt (OpReg W64 reg) (OpAddr (AddrRegImm sp_reg (ImmInt imm))) + movImmToIp0 imm = ANN (text "Reload: IP0 <- " <> int imm) $ MOV ip0 (OpImm (ImmInt imm)) + addSpToIp0 = ANN (text "Reload: IP0 <- SP + IP0 ") $ ADD ip0 ip0 sp + mkLdrIp0 = ANN (text "Reload@" <> int (off - delta)) $ LDR fmt (OpReg W64 reg) (OpAddr (AddrReg ip0_reg)) - off = spillSlotToOffset config slot + off = spillSlotToOffset config slot --------------------------------------------------------------------------------- + -------------------------------------------------------------------------------- -- | See if this instruction is telling us the current C stack delta takeDeltaInstr :: Instr -> Maybe Int takeDeltaInstr (ANN _ i) = takeDeltaInstr i @@ -770,6 +766,7 @@ ra_reg, sp_reg :: Reg zero_reg = RegReal (RealRegSingle 0) ra_reg = RegReal (RealRegSingle 1) sp_reg = RegReal (RealRegSingle 2) +ip0_reg = RegReal (RealRegSingle 16) zero, sp, ip0 :: Operand zero = OpReg W64 zero_reg @@ -779,7 +776,7 @@ gp = OpReg W64 (RegReal (RealRegSingle 3)) tp = OpReg W64 (RegReal (RealRegSingle 4)) fp = OpReg W64 (RegReal (RealRegSingle 8)) -ip0 = OpReg W64 (RegReal (RealRegSingle 16)) +ip0 = OpReg W64 ip0_reg _x :: Int -> Operand _x i = OpReg W64 (RegReal (RealRegSingle i)) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/33bb0b5a34566839b1e9bccb18e7e90e750b110d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/33bb0b5a34566839b1e9bccb18e7e90e750b110d You're receiving 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 Jun 12 14:32:26 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Mon, 12 Jun 2023 10:32:26 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/supersven/fix_trivColorable_aarch64 Message-ID: <64872c7af2baf_1af13ac56e8120799@gitlab.mail> Sven Tennie pushed new branch wip/supersven/fix_trivColorable_aarch64 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/supersven/fix_trivColorable_aarch64 You're receiving 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 Jun 12 14:51:53 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Mon, 12 Jun 2023 10:51:53 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] Add free reg counts for trivColorable Message-ID: <6487310930b12_1af13ac56841269c1@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: deff328f by Sven Tennie at 2023-06-12T14:47:33+00:00 Add free reg counts for trivColorable - - - - - 1 changed file: - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs Changes: ===================================== compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs ===================================== @@ -115,7 +115,7 @@ trivColorable platform virtualRegSqueeze realRegSqueeze RcInteger conflicts excl ArchMipseb -> panic "trivColorable ArchMipseb" ArchMipsel -> panic "trivColorable ArchMipsel" ArchS390X -> panic "trivColorable ArchS390X" - ArchRISCV64 -> panic "trivColorable ArchRISCV64" + ArchRISCV64 -> 15 ArchLoongArch64->panic "trivColorable ArchLoongArch64" ArchJavaScript-> panic "trivColorable ArchJavaScript" ArchWasm32 -> panic "trivColorable ArchWasm32" @@ -150,7 +150,7 @@ trivColorable platform virtualRegSqueeze realRegSqueeze RcFloat conflicts exclus ArchMipseb -> panic "trivColorable ArchMipseb" ArchMipsel -> panic "trivColorable ArchMipsel" ArchS390X -> panic "trivColorable ArchS390X" - ArchRISCV64 -> panic "trivColorable ArchRISCV64" + ArchRISCV64 -> 0 ArchLoongArch64->panic "trivColorable ArchLoongArch64" ArchJavaScript-> panic "trivColorable ArchJavaScript" ArchWasm32 -> panic "trivColorable ArchWasm32" @@ -184,7 +184,7 @@ trivColorable platform virtualRegSqueeze realRegSqueeze RcDouble conflicts exclu ArchMipseb -> panic "trivColorable ArchMipseb" ArchMipsel -> panic "trivColorable ArchMipsel" ArchS390X -> panic "trivColorable ArchS390X" - ArchRISCV64 -> panic "trivColorable ArchRISCV64" + ArchRISCV64 -> 26 ArchLoongArch64->panic "trivColorable ArchLoongArch64" ArchJavaScript-> panic "trivColorable ArchJavaScript" ArchWasm32 -> panic "trivColorable ArchWasm32" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/deff328fd8c52d8a98e1f87f5db37afeef7735fa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/deff328fd8c52d8a98e1f87f5db37afeef7735fa You're receiving 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 Jun 12 19:25:56 2023 From: gitlab at gitlab.haskell.org (Melanie Brown (@mixphix)) Date: Mon, 12 Jun 2023 15:25:56 -0400 Subject: [Git][ghc/ghc][wip/clc-86] 273 commits: hadrian: Pass haddock file arguments in a response file Message-ID: <648771448f89c_1af13a3a2d3e01910da@gitlab.mail> Melanie Brown pushed to branch wip/clc-86 at Glasgow Haskell Compiler / GHC Commits: f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04: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. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04: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> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+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. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - 1d669e25 by Melanie Brown at 2023-06-12T15:25:48-04:00 merge changelogs - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - .gitlab/rel_eng/upload_ghc_libs.py - .gitmodules - CODEOWNERS - HACKING.md - cabal.project-reinstall - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/055f5daf6728917fee5bb0b5aed99852fb8c6a28...1d669e2574926d5052767c57e8c8775efc105ac1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/055f5daf6728917fee5bb0b5aed99852fb8c6a28...1d669e2574926d5052767c57e8c8775efc105ac1 You're receiving 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 Jun 13 06:12:00 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 13 Jun 2023 02:12:00 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 10 commits: Change WarningWithFlag to plural WarningWithFlags Message-ID: <648808b05bd0_396d94c57d893478@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: dad1616a by Oleg Grenrus at 2023-06-13T02:11:22-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - 4cdb7409 by Matthew Pickering at 2023-06-13T02:11:33-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - cad7a5aa by Rodrigo Mesquita at 2023-06-13T02:11:34-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 6bcfbe8c by Victor Cacciari Miraldo at 2023-06-13T02:11:38-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - feea9d39 by Ryan Scott at 2023-06-13T02:11:38-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - 2a70d6d5 by Emily Martins at 2023-06-13T02:11:42-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - 3db67af3 by Victor Cacciari Miraldo at 2023-06-13T02:11:44-04:00 Add regression test for 17328 - - - - - faffa9dc by Victor Cacciari Miraldo at 2023-06-13T02:11:44-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - f55f5f03 by Philip Hazelden at 2023-06-13T02:11:48-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 737b84d6 by David Binder at 2023-06-13T02:11:53-04:00 Add testcase for error GHC-00711 to testsuite - - - - - 30 changed files: - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Utils/Error.hs - configure.ac - distrib/configure.ac.in - docs/users_guide/9.8.1-notes.rst - docs/users_guide/ghci.rst - ghc/GHCi/UI.hs - − ghc/GHCi/UI/Tags.hs - ghc/ghc-bin.cabal.in - libraries/base/Data/Fixed.hs - libraries/base/tests/IO/all.T - libraries/base/tests/all.T - libraries/ghc-compact/tests/all.T - libraries/ghc-heap/tests/all.T - libraries/hpc - libraries/process - + m4/fp_cc_ignore_unused_args.m4 - testsuite/config/ghc - testsuite/driver/testlib.py - testsuite/tests/cmm/should_run/all.T - testsuite/tests/cmm/should_run/machops/all.T - testsuite/tests/codeGen/should_fail/all.T - testsuite/tests/codeGen/should_run/T20137/T20137.hs - testsuite/tests/codeGen/should_run/T20137/T20137C.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b3c6d543c12ec40ac779e8c114f548fe70f70356...737b84d6b2d98d946074a2f75d2b97b68a7218cb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b3c6d543c12ec40ac779e8c114f548fe70f70356...737b84d6b2d98d946074a2f75d2b97b68a7218cb You're receiving 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 Jun 13 08:09:23 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Tue, 13 Jun 2023 04:09:23 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/int-index/th-code-saks Message-ID: <648824336666b_29cce46cff34104154@gitlab.mail> Vladislav Zavialov pushed new branch wip/int-index/th-code-saks at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/int-index/th-code-saks You're receiving 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 Jun 13 08:44:09 2023 From: gitlab at gitlab.haskell.org (Josh Meredith (@JoshMeredith)) Date: Tue, 13 Jun 2023 04:44:09 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/js-InfiniteListFusion Message-ID: <64882c59ab74_29cce4c5e54122813@gitlab.mail> Josh Meredith pushed new branch wip/js-InfiniteListFusion at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/js-InfiniteListFusion You're receiving 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 Jun 13 09:30:37 2023 From: gitlab at gitlab.haskell.org (=?UTF-8?B?R2VyZ8WRIMOJcmRpIChAY2FjdHVzKQ==?=) Date: Tue, 13 Jun 2023 05:30:37 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/issue-23516 Message-ID: <6488373de0f37_29cce4c5e7c132094@gitlab.mail> Gergő Érdi pushed new branch wip/issue-23516 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/issue-23516 You're receiving 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 Jun 13 10:13:53 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Tue, 13 Jun 2023 06:13:53 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/dib-instances] Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) Message-ID: <648841614c725_29cce4c5698141595@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/dib-instances at Glasgow Haskell Compiler / GHC Commits: cc3663eb by Andrei Borzenkov at 2023-06-13T14:13:39+04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 14 changed files: - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - testsuite/tests/indexed-types/should_compile/T14131.hs - testsuite/tests/indexed-types/should_compile/T15852.hs - testsuite/tests/indexed-types/should_compile/T15852.stderr - testsuite/tests/indexed-types/should_fail/T14230.hs - testsuite/tests/indexed-types/should_fail/T7938.hs - testsuite/tests/indexed-types/should_fail/T7938.stderr - + testsuite/tests/rename/should_compile/T23512b.hs - testsuite/tests/rename/should_compile/all.T - + testsuite/tests/rename/should_fail/T23512a.hs - + testsuite/tests/rename/should_fail/T23512a.stderr - testsuite/tests/rename/should_fail/all.T - testsuite/tests/typecheck/should_fail/T15797.hs Changes: ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -1799,8 +1799,7 @@ one exists: a free variable 'a', which we implicitly quantify over. That is why we can also use it to the left of the double colon: 'Left a -The logic resides in extractHsTyRdrTyVarsKindVars. We use it both for type -synonyms and type family instances. +The logic resides in extractHsTyRdrTyVarsKindVars. This is something of a stopgap solution until we can explicitly bind invisible type/kind variables: ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -634,14 +634,10 @@ rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds rnFamEqn :: HsDocContext -> AssocTyFamInfo - -> FreeKiTyVars - -- ^ Additional kind variables to implicitly bind if there is no - -- explicit forall. (See the comments on @all_imp_vars@ below for a - -- more detailed explanation.) -> FamEqn GhcPs rhs -> (HsDocContext -> rhs -> RnM (rhs', FreeVars)) -> RnM (FamEqn GhcRn rhs', FreeVars) -rnFamEqn doc atfi extra_kvars +rnFamEqn doc atfi (FamEqn { feqn_tycon = tycon , feqn_bndrs = outer_bndrs , feqn_pats = pats @@ -652,19 +648,8 @@ rnFamEqn doc atfi extra_kvars -- all_imp_vars represent the implicitly bound type variables. This is -- empty if we have an explicit `forall` (see -- Note [forall-or-nothing rule] in GHC.Hs.Type), which means - -- ignoring: - -- - -- - pat_kity_vars, the free variables mentioned in the type patterns - -- on the LHS of the equation, and - -- - extra_kvars, which is one of the following: - -- * For type family instances, extra_kvars are the free kind - -- variables mentioned in an outermost kind signature on the RHS - -- of the equation. - -- (See Note [Implicit quantification in type synonyms] in - -- GHC.Rename.HsType.) - -- * For data family instances, extra_kvars are the free kind - -- variables mentioned in the explicit return kind, if one is - -- provided. (e.g., the `k` in `data instance T :: k -> Type`). + -- ignoring pat_kity_vars, the free variables mentioned in the type patterns + -- on the LHS of the equation -- -- Some examples: -- @@ -678,8 +663,6 @@ rnFamEqn doc atfi extra_kvars -- type family G :: Maybe a -- type instance forall a. G = (Nothing :: Maybe a) -- -- all_imp_vars = [] - -- type instance G = (Nothing :: Maybe a) - -- -- all_imp_vars = [a] -- -- data family H :: k -> Type -- data instance forall k. H :: k -> Type where ... @@ -690,7 +673,7 @@ rnFamEqn doc atfi extra_kvars -- -- For associated type family instances, exclude the type variables -- bound by the instance head with filterInScopeM (#19649). - ; all_imp_vars <- filterInScopeM $ pat_kity_vars ++ extra_kvars + ; all_imp_vars <- filterInScopeM $ pat_kity_vars ; bindHsOuterTyVarBndrs doc mb_cls all_imp_vars outer_bndrs $ \rn_outer_bndrs -> do { (pats', pat_fvs) <- rnLHsTypeArgs (FamPatCtx tycon) pats @@ -727,21 +710,12 @@ rnFamEqn doc atfi extra_kvars -- associated family instance but not bound on the LHS, then reject -- that type variable as being out of scope. -- See Note [Renaming associated types]. - -- Per that Note, the LHS type variables consist of: - -- - -- - The variables mentioned in the instance's type patterns - -- (pat_fvs), and - -- - -- - The variables mentioned in an outermost kind signature on the - -- RHS. This is a subset of `rhs_fvs`. To compute it, we look up - -- each RdrName in `extra_kvars` to find its corresponding Name in - -- the LocalRdrEnv. - ; extra_kvar_nms <- mapMaybeM (lookupLocalOccRn_maybe . unLoc) extra_kvars - ; let lhs_bound_vars = pat_fvs `extendNameSetList` extra_kvar_nms - improperly_scoped cls_tkv = + -- Per that Note, the LHS type variables consist of the variables + -- mentioned in the instance's type patterns (pat_fvs) + ; let improperly_scoped cls_tkv = cls_tkv `elemNameSet` rhs_fvs -- Mentioned on the RHS... - && not (cls_tkv `elemNameSet` lhs_bound_vars) + && not (cls_tkv `elemNameSet` pat_fvs) -- ...but not bound on the LHS. bad_tvs = filter improperly_scoped inst_head_tvs ; unless (null bad_tvs) (addErr (TcRnBadAssocRhs bad_tvs)) @@ -786,7 +760,7 @@ rnFamEqn doc atfi extra_kvars -- -- type instance F a b c = Either a b -- ^^^^^ - lhs_loc = case map lhsTypeArgSrcSpan pats ++ map getLocA extra_kvars of + lhs_loc = case map lhsTypeArgSrcSpan pats of [] -> panic "rnFamEqn.lhs_loc" [loc] -> loc (loc:locs) -> loc `combineSrcSpans` last locs @@ -845,10 +819,9 @@ data ClosedTyFamInfo rnTyFamInstEqn :: AssocTyFamInfo -> TyFamInstEqn GhcPs -> RnM (TyFamInstEqn GhcRn, FreeVars) -rnTyFamInstEqn atfi eqn@(FamEqn { feqn_tycon = tycon, feqn_rhs = rhs }) - = rnFamEqn (TySynCtx tycon) atfi extra_kvs eqn rnTySyn - where - extra_kvs = extractHsTyRdrTyVarsKindVars rhs +rnTyFamInstEqn atfi eqn@(FamEqn { feqn_tycon = tycon }) + = rnFamEqn (TySynCtx tycon) atfi eqn rnTySyn + rnTyFamDefltDecl :: Name -> TyFamDefltDecl GhcPs @@ -859,11 +832,9 @@ rnDataFamInstDecl :: AssocTyFamInfo -> DataFamInstDecl GhcPs -> RnM (DataFamInstDecl GhcRn, FreeVars) rnDataFamInstDecl atfi (DataFamInstDecl { dfid_eqn = - eqn@(FamEqn { feqn_tycon = tycon - , feqn_rhs = rhs })}) - = do { let extra_kvs = extractDataDefnKindVars rhs - ; (eqn', fvs) <- - rnFamEqn (TyDataCtx tycon) atfi extra_kvs eqn rnDataDefn + eqn@(FamEqn { feqn_tycon = tycon })}) + = do { (eqn', fvs) <- + rnFamEqn (TyDataCtx tycon) atfi eqn rnDataDefn ; return (DataFamInstDecl { dfid_eqn = eqn' }, fvs) } -- Renaming of the associated types in instances. @@ -949,10 +920,7 @@ a class, we must check that all of the type variables mentioned on the RHS are properly scoped. Specifically, the rule is this: Every variable mentioned on the RHS of a type instance declaration - (whether associated or not) must be either - * Mentioned on the LHS, or - * Mentioned in an outermost kind signature on the RHS - (see Note [Implicit quantification in type synonyms]) + (whether associated or not) must be mentioned on the LHS Here is a simple example of something we should reject: @@ -962,8 +930,7 @@ Here is a simple example of something we should reject: type F Int x = z Here, `z` is mentioned on the RHS of the associated instance without being -mentioned on the LHS, nor is `z` mentioned in an outermost kind signature. The -renamer will reject `z` as being out of scope without much fuss. +mentioned on the LHS. The renamer will reject `z` as being out of scope without much fuss. Things get slightly trickier when the instance header itself binds type variables. Consider this example (adapted from #5515): @@ -1055,10 +1022,8 @@ Some additional wrinkles: Note that the `o` in the `Codomain 'KProxy` instance should be considered improperly scoped. It does not meet the criteria for being explicitly - quantified, as it is not mentioned by name on the LHS, nor does it meet the - criteria for being implicitly quantified, as it is used in a RHS kind - signature that is not outermost (see Note [Implicit quantification in type - synonyms]). However, `o` /is/ bound by the instance header, so if this + quantified, as it is not mentioned by name on the LHS. + However, `o` /is/ bound by the instance header, so if this program is not rejected by the renamer, the typechecker would treat it as though you had written this: @@ -1070,6 +1035,11 @@ Some additional wrinkles: If the user really wants the latter, it is simple enough to communicate their intent by mentioning `o` on the LHS by name. +* Previously we had to add type variables from the outermost kind signature on RHS to + the scope of associated type family instance, i.e. GHC did implicit quantification over them. + But with changes described in GHC Proposal #425 "Invisible binders in type declarations" + we don't need to do that anymore. + Note [Type family equations and occurrences] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In most data/type family equations, the type family name used in the equation ===================================== testsuite/tests/indexed-types/should_compile/T14131.hs ===================================== @@ -9,21 +9,21 @@ import Data.Kind import Data.Proxy data family Nat :: k -> k -> Type -newtype instance Nat :: (k -> Type) -> (k -> Type) -> Type where +newtype instance Nat :: forall k . (k -> Type) -> (k -> Type) -> Type where Nat :: (forall xx. f xx -> g xx) -> Nat f g type family F :: Maybe a -type instance F = (Nothing :: Maybe a) +type instance F @a = (Nothing :: Maybe a) class C k where data CD :: k -> k -> Type type CT :: k instance C (Maybe a) where - data CD :: Maybe a -> Maybe a -> Type where + data CD @(Maybe a) :: Maybe a -> Maybe a -> Type where CD :: forall a (m :: Maybe a) (n :: Maybe a). Proxy m -> Proxy n -> CD m n - type CT = (Nothing :: Maybe a) + type CT @(Maybe a) = (Nothing :: Maybe a) class Z k where type ZT :: Maybe k - type ZT = (Nothing :: Maybe k) + type ZT @k = (Nothing :: Maybe k) ===================================== testsuite/tests/indexed-types/should_compile/T15852.hs ===================================== @@ -7,4 +7,4 @@ import Data.Kind import Data.Proxy data family DF a (b :: k) -data instance DF (Proxy c) :: Proxy j -> Type +data instance DF @(Proxy j) (Proxy c) :: Proxy j -> Type ===================================== testsuite/tests/indexed-types/should_compile/T15852.stderr ===================================== @@ -3,10 +3,10 @@ TYPE CONSTRUCTORS roles nominal nominal nominal COERCION AXIOMS axiom T15852.D:R:DFProxyProxy0 :: - forall k1 k2 (c :: k1) (j :: k2). - DF (Proxy c) = T15852.R:DFProxyProxy k1 k2 c j + forall k1 k2 (j :: k1) (c :: k2). + DF (Proxy c) = T15852.R:DFProxyProxy k1 k2 j c FAMILY INSTANCES - data instance forall {k1} {k2} {c :: k1} {j :: k2}. + data instance forall {k1} {k2} {j :: k1} {c :: k2}. DF (Proxy c) -- Defined at T15852.hs:10:15 Dependent modules: [] -Dependent packages: [base-4.17.0.0] +Dependent packages: [base-4.18.0.0] ===================================== testsuite/tests/indexed-types/should_fail/T14230.hs ===================================== @@ -8,4 +8,4 @@ class C k where data CD :: k -> k -> * instance C (Maybe a) where - data CD :: (k -> *) -> (k -> *) -> * + data forall k . CD :: (k -> *) -> (k -> *) -> * ===================================== testsuite/tests/indexed-types/should_fail/T7938.hs ===================================== @@ -9,4 +9,4 @@ class Foo (a :: k1) (b :: k2) where type Bar a instance Foo (a :: k1) (b :: k2) where - type Bar a = (KP :: KProxy k2) + type forall k2 . Bar a = (KP :: KProxy k2) ===================================== testsuite/tests/indexed-types/should_fail/T7938.stderr ===================================== @@ -1,5 +1,5 @@ -T7938.hs:12:17: error: [GHC-83865] +T7938.hs:12:29: error: [GHC-83865] • Expected a type, but ‘KP :: KProxy k2’ has kind ‘KProxy k2’ • In the type ‘(KP :: KProxy k2)’ In the type instance declaration for ‘Bar’ ===================================== testsuite/tests/rename/should_compile/T23512b.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies, TypeAbstractions #-} +module T23512b where +import GHC.Types + +type family F2 a :: k +type instance F2 @(j -> j) Int = Any :: j -> j + +type family F3 a :: k +type instance forall j. F3 Int = Any :: j -> j ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -212,3 +212,4 @@ test('T22122', [expect_broken(22122), extra_files(['T22122_aux.hs'])], multimod_ test('T23240', [req_th, extra_files(['T23240_aux.hs'])], multimod_compile, ['T23240', '-v0']) test('T23318', normal, compile, ['-Wduplicate-exports']) test('T23434', normal, compile, ['']) +test('T23512b', normal, compile, ['']) ===================================== testsuite/tests/rename/should_fail/T23512a.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies #-} +module T23512a where +import GHC.Types + +type family F1 a :: k +type instance F1 Int = Any :: j -> j + +data family D :: k -> Type +data instance D :: k -> Type ===================================== testsuite/tests/rename/should_fail/T23512a.stderr ===================================== @@ -0,0 +1,6 @@ + +T23512a.hs:6:31: error: [GHC-76037] Not in scope: type variable ‘j’ + +T23512a.hs:6:36: error: [GHC-76037] Not in scope: type variable ‘j’ + +T23512a.hs:9:20: error: [GHC-76037] Not in scope: type variable ‘k’ ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -198,3 +198,4 @@ test('RnUnexpectedStandaloneDeriving', normal, compile_fail, ['']) test('RnStupidThetaInGadt', normal, compile_fail, ['']) test('PackageImportsDisabled', normal, compile_fail, ['']) test('ImportLookupIllegal', normal, compile_fail, ['']) +test('T23512a', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/T15797.hs ===================================== @@ -13,7 +13,7 @@ import Data.Kind class Ríki (obj :: Type) where type Obj :: obj -> Constraint - type Obj = Bæ @k :: k -> Constraint + type forall k . Obj = Bæ @k :: k -> Constraint class Bæ (a :: k) instance Bæ @k (a :: k) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cc3663eb3ffcfcd2762fdc490ef2a718f66bbc5a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cc3663eb3ffcfcd2762fdc490ef2a718f66bbc5a You're receiving 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 Jun 13 13:42:52 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 13 Jun 2023 09:42:52 -0400 Subject: [Git][ghc/ghc][master] Change WarningWithFlag to plural WarningWithFlags Message-ID: <6488725c7eef3_29cce48f2a2818132@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - 7 changed files: - compiler/GHC/Driver/Errors.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Utils/Error.hs - testsuite/tests/plugins/T20803-plugin/AddErrorPlugin.hs Changes: ===================================== compiler/GHC/Driver/Errors.hs ===================================== @@ -17,11 +17,12 @@ printMessages :: forall a . Diagnostic a => Logger -> DiagnosticOpts a -> DiagOp printMessages logger msg_opts opts msgs = sequence_ [ let style = mkErrStyle name_ppr_ctx ctx = (diag_ppr_ctx opts) { sdocStyle = style } - in logMsg logger (MCDiagnostic sev (diagnosticReason dia) (diagnosticCode dia)) s $ + in logMsg logger (MCDiagnostic sev reason (diagnosticCode dia)) s $ updSDocContext (\_ -> ctx) (messageWithHints dia) | MsgEnvelope { errMsgSpan = s, errMsgDiagnostic = dia, errMsgSeverity = sev, + errMsgReason = reason, errMsgContext = name_ppr_ctx } <- sortMsgBag (Just opts) (getMessages msgs) ] where ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -1635,9 +1635,7 @@ There are four warning flags in play: -- inferred type of the function warnMissingSignatures :: TcGblEnv -> RnM () warnMissingSignatures gbl_env - = do { warn_binds <- woptM Opt_WarnMissingSignatures - ; warn_pat_syns <- woptM Opt_WarnMissingPatternSynonymSignatures - ; let exports = availsToNameSet (tcg_exports gbl_env) + = do { let exports = availsToNameSet (tcg_exports gbl_env) sig_ns = tcg_sigs gbl_env -- We use sig_ns to exclude top-level bindings that are generated by GHC binds = collectHsBindsBinders CollNoDictBinders $ tcg_binds gbl_env @@ -1652,7 +1650,7 @@ warnMissingSignatures gbl_env do { env <- liftZonkM $ tcInitTidyEnv -- Why not use emptyTidyEnv? ; let (_, ty) = tidyOpenType env (idType id) missing = MissingTopLevelBindingSig name ty - diag = TcRnMissingSignature missing exported warn_binds + diag = TcRnMissingSignature missing exported ; addDiagnosticAt (getSrcSpan name) diag } where name = idName id @@ -1664,7 +1662,7 @@ warnMissingSignatures gbl_env add_patsyn_warn ps = when (not_ghc_generated name) $ addDiagnosticAt (getSrcSpan name) - (TcRnMissingSignature missing exported warn_pat_syns) + (TcRnMissingSignature missing exported) where name = patSynName ps missing = MissingPatSynSig ps @@ -1700,7 +1698,7 @@ warnMissingKindSignatures gbl_env addDiagnosticAt (getSrcSpan name) diag where name = tyConName tyCon - diag = TcRnMissingSignature missing exported False + diag = TcRnMissingSignature missing exported missing = MissingTyConKindSig tyCon cusks_enabled exported = if name `elemNameSet` exports then IsExported ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -352,7 +352,7 @@ instance Diagnostic TcRnMessage where = sep [ quotes (ppr n), text "should really be", quotes (ppr rhs_ty) ] | otherwise = empty - TcRnMissingSignature what _ _ -> + TcRnMissingSignature what _ -> mkSimpleDecorated $ case what of MissingPatSynSig p -> @@ -1939,8 +1939,8 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnPartialTypeSigBadQuantifier{} -> ErrorWithoutFlag - TcRnMissingSignature what exported overridden - -> WarningWithFlag $ missingSignatureWarningFlag what exported overridden + TcRnMissingSignature what exported + -> WarningWithFlags $ missingSignatureWarningFlags what exported TcRnPolymorphicBinderMissingSig{} -> WarningWithFlag Opt_WarnMissingLocalSignatures TcRnOverloadedSig{} @@ -3310,22 +3310,19 @@ formatExportItemError exportedThing reason = , quotes exportedThing , text reason ] --- | What warning flag is associated with the given missing signature? -missingSignatureWarningFlag :: MissingSignature -> Exported -> Bool -> WarningFlag -missingSignatureWarningFlag (MissingTopLevelBindingSig {}) exported overridden - | IsExported <- exported - , not overridden - = Opt_WarnMissingExportedSignatures - | otherwise - = Opt_WarnMissingSignatures -missingSignatureWarningFlag (MissingPatSynSig {}) exported overridden - | IsExported <- exported - , not overridden - = Opt_WarnMissingExportedPatternSynonymSignatures - | otherwise - = Opt_WarnMissingPatternSynonymSignatures -missingSignatureWarningFlag (MissingTyConKindSig {}) _ _ - = Opt_WarnMissingKindSignatures +-- | What warning flags are associated with the given missing signature? +missingSignatureWarningFlags :: MissingSignature -> Exported -> NonEmpty WarningFlag +missingSignatureWarningFlags (MissingTopLevelBindingSig {}) exported + -- We prefer "bigger" warnings first: #14794 + -- + -- See Note [Warnings controlled by multiple flags] + = Opt_WarnMissingSignatures :| + [ Opt_WarnMissingExportedSignatures | IsExported == exported ] +missingSignatureWarningFlags (MissingPatSynSig {}) exported + = Opt_WarnMissingPatternSynonymSignatures :| + [ Opt_WarnMissingExportedPatternSynonymSignatures | IsExported == exported ] +missingSignatureWarningFlags (MissingTyConKindSig {}) _ + = Opt_WarnMissingKindSignatures :| [] useDerivingStrategies :: GhcHint useDerivingStrategies = ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -941,8 +941,6 @@ data TcRnMessage where -} TcRnMissingSignature :: MissingSignature -> Exported - -> Bool -- ^ True: -Wmissing-signatures overrides -Wmissing-exported-signatures, - -- or -Wmissing-pattern-synonym-signatures overrides -Wmissing-exported-pattern-synonym-signatures -> TcRnMessage {-| TcRnPolymorphicBinderMissingSig is a warning controlled by -Wmissing-local-signatures @@ -4494,6 +4492,7 @@ data MissingSignature data Exported = IsNotExported | IsExported + deriving Eq instance Outputable Exported where ppr IsNotExported = text "IsNotExported" ===================================== compiler/GHC/Types/Error.hs ===================================== @@ -8,6 +8,7 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE PatternSynonyms #-} module GHC.Types.Error ( -- * Messages @@ -32,7 +33,8 @@ module GHC.Types.Error , mkUnknownDiagnostic , embedUnknownDiagnostic , DiagnosticMessage (..) - , DiagnosticReason (..) + , DiagnosticReason (WarningWithFlag, ..) + , ResolvedDiagnosticReason(..) , DiagnosticHint (..) , mkPlainDiagnostic , mkPlainError @@ -103,6 +105,7 @@ import GHC.Unit.Module.Warnings (WarningCategory) import Data.Bifunctor import Data.Foldable ( fold ) +import Data.List.NonEmpty ( NonEmpty (..) ) import qualified Data.List.NonEmpty as NE import Data.List ( intercalate ) import Data.Typeable ( Typeable ) @@ -159,7 +162,10 @@ instance Diagnostic e => Outputable (Messages e) where ppr msgs = braces (vcat (map ppr_one (bagToList (getMessages msgs)))) where ppr_one :: MsgEnvelope e -> SDoc - ppr_one envelope = pprDiagnostic (errMsgDiagnostic envelope) + ppr_one envelope = + vcat [ text "Resolved:" <+> ppr (errMsgReason envelope), + pprDiagnostic (errMsgDiagnostic envelope) + ] {- Note [Discarding Messages] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -363,7 +369,7 @@ mkDecoratedError hints docs = DiagnosticMessage (mkDecorated docs) ErrorWithoutF data DiagnosticReason = WarningWithoutFlag -- ^ Born as a warning. - | WarningWithFlag !WarningFlag + | WarningWithFlags !(NE.NonEmpty WarningFlag) -- ^ Warning was enabled with the flag. | WarningWithCategory !WarningCategory -- ^ Warning was enabled with a custom category. @@ -371,13 +377,67 @@ data DiagnosticReason -- ^ Born as an error. deriving (Eq, Show) +-- | Like a 'DiagnosticReason', but resolved against a specific set of `DynFlags` to +-- work out which warning flag actually enabled this warning. +newtype ResolvedDiagnosticReason + = ResolvedDiagnosticReason { resolvedDiagnosticReason :: DiagnosticReason } + +-- | The single warning case 'DiagnosticReason' is very common. +pattern WarningWithFlag :: WarningFlag -> DiagnosticReason +pattern WarningWithFlag w = WarningWithFlags (w :| []) + +{- +Note [Warnings controlled by multiple flags] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Diagnostics that started life as flag-controlled warnings have a +'diagnosticReason' of 'WarningWithFlags', giving the flags that control the +warning. Usually there is only one flag, but in a few cases multiple flags +apply. Where there are more than one, they are listed highest-priority first. + +For example, the same exported binding may give rise to a warning if either +`-Wmissing-signatures` or `-Wmissing-exported-signatures` is enabled. Here +`-Wmissing-signatures` has higher priority, because we want to mention it if +before are enabled. See `missingSignatureWarningFlags` for the specific logic +in this case. + +When reporting such a warning to the user, it is important to mention the +correct flag (e.g. `-Wmissing-signatures` if it is enabled, or +`-Wmissing-exported-signatures` if only the latter is enabled). Thus +`diag_reason_severity` filters the `DiagnosticReason` based on the currently +active `DiagOpts`. For a `WarningWithFlags` it returns only the flags that are +enabled; it leaves other `DiagnosticReason`s unchanged. This is then wrapped +in a `ResolvedDiagnosticReason` newtype which records that this filtering has +taken place. + +If we have `-Wmissing-signatures -Werror=missing-exported-signatures` we want +the error to mention `-Werror=missing-exported-signatures` (even though +`-Wmissing-signatures` would normally take precedence). Thus if there are any +fatal warnings, `diag_reason_severity` returns those alone. + +The `MsgEnvelope` stores the filtered `ResolvedDiagnosticReason` listing only the +relevant flags for subsequent display. + + +Side note: we do not treat `-Wmissing-signatures` as a warning group that +includes `-Wmissing-exported-signatures`, because + + (a) this would require us to provide a flag for the complement, and + + (b) currently, in `-Wmissing-exported-signatures -Wno-missing-signatures`, the + latter option does not switch off the former. +-} + instance Outputable DiagnosticReason where ppr = \case WarningWithoutFlag -> text "WarningWithoutFlag" - WarningWithFlag wf -> text ("WarningWithFlag " ++ show wf) + WarningWithFlags wf -> text ("WarningWithFlags " ++ show wf) WarningWithCategory cat -> text "WarningWithCategory" <+> ppr cat ErrorWithoutFlag -> text "ErrorWithoutFlag" +instance Outputable ResolvedDiagnosticReason where + ppr = ppr . resolvedDiagnosticReason + -- | An envelope for GHC's facts about a running program, parameterised over the -- /domain-specific/ (i.e. parsing, typecheck-renaming, etc) diagnostics. -- @@ -392,6 +452,10 @@ data MsgEnvelope e = MsgEnvelope , errMsgContext :: NamePprCtx , errMsgDiagnostic :: e , errMsgSeverity :: Severity + , errMsgReason :: ResolvedDiagnosticReason + -- ^ The actual reason caused this message + -- + -- See Note [Warnings controlled by multiple flags] } deriving (Functor, Foldable, Traversable) -- | The class for a diagnostic message. The main purpose is to classify a @@ -410,7 +474,7 @@ data MessageClass -- ^ Log messages intended for end users. -- No file\/line\/column stuff. - | MCDiagnostic Severity DiagnosticReason (Maybe DiagnosticCode) + | MCDiagnostic Severity ResolvedDiagnosticReason (Maybe DiagnosticCode) -- ^ Diagnostics from the compiler. This constructor is very powerful as -- it allows the construction of a 'MessageClass' with a completely -- arbitrary permutation of 'Severity' and 'DiagnosticReason'. As such, @@ -464,7 +528,7 @@ data Severity -- don't want to see. See Note [Suppressing Messages] | SevWarning | SevError - deriving (Eq, Show) + deriving (Eq, Ord, Show) instance Outputable Severity where ppr = \case @@ -532,8 +596,9 @@ mkLocMessageWarningGroups show_warn_groups msg_class locn msg warning_flag_doc = case msg_class of MCDiagnostic sev reason _code - | Just msg <- flag_msg sev reason -> brackets msg - _ -> empty + | Just msg <- flag_msg sev (resolvedDiagnosticReason reason) + -> brackets msg + _ -> empty code_doc = case msg_class of @@ -546,7 +611,7 @@ mkLocMessageWarningGroups show_warn_groups msg_class locn msg -- in a log file, e.g. with -ddump-tc-trace. It should not -- happen otherwise, though. flag_msg SevError WarningWithoutFlag = Just (col "-Werror") - flag_msg SevError (WarningWithFlag wflag) = + flag_msg SevError (WarningWithFlags (wflag :| _)) = let name = NE.head (warnFlagNames wflag) in Just $ col ("-W" ++ name) <+> warn_flag_grp (smallestWarningGroups wflag) <> comma @@ -558,7 +623,7 @@ mkLocMessageWarningGroups show_warn_groups msg_class locn msg <+> coloured msg_colour (text "-Werror=" <> ppr cat) flag_msg SevError ErrorWithoutFlag = Nothing flag_msg SevWarning WarningWithoutFlag = Nothing - flag_msg SevWarning (WarningWithFlag wflag) = + flag_msg SevWarning (WarningWithFlags (wflag :| _)) = let name = NE.head (warnFlagNames wflag) in Just (col ("-W" ++ name) <+> warn_flag_grp (smallestWarningGroups wflag)) flag_msg SevWarning (WarningWithCategory cat) = @@ -689,7 +754,7 @@ later classify and report them appropriately (in the driver). -- | Returns 'True' if this is, intrinsically, a failure. See -- Note [Intrinsic And Extrinsic Failures]. isIntrinsicErrorMessage :: Diagnostic e => MsgEnvelope e -> Bool -isIntrinsicErrorMessage = (==) ErrorWithoutFlag . diagnosticReason . errMsgDiagnostic +isIntrinsicErrorMessage = (==) ErrorWithoutFlag . resolvedDiagnosticReason . errMsgReason isWarningMessage :: Diagnostic e => MsgEnvelope e -> Bool isWarningMessage = not . isIntrinsicErrorMessage ===================================== compiler/GHC/Utils/Error.hs ===================================== @@ -90,6 +90,8 @@ import Control.Monad.IO.Class import Control.Monad.Catch as MC (handle) import GHC.Conc ( getAllocationCounter ) import System.CPUTime +import Data.List.NonEmpty (NonEmpty (..)) +import qualified Data.List.NonEmpty as NE data DiagOpts = DiagOpts { diag_warning_flags :: !(EnumSet WarningFlag) -- ^ Enabled warnings @@ -132,32 +134,49 @@ diag_fatal_wopt_custom wflag opts = wflag `elemWarningCategorySet` diag_fatal_cu -- i.e. with a 'DiagOpts \"snapshot\" taken as close as possible to where a -- particular diagnostic message is built, otherwise the computed 'Severity' might -- not be correct, due to the mutable nature of the 'DynFlags' in GHC. +-- +-- diagReasonSeverity :: DiagOpts -> DiagnosticReason -> Severity -diagReasonSeverity opts reason = case reason of - WarningWithFlag wflag - | not (diag_wopt wflag opts) -> SevIgnore - | diag_fatal_wopt wflag opts -> SevError - | otherwise -> SevWarning +diagReasonSeverity opts reason = fst (diag_reason_severity opts reason) + +-- Like the diagReasonSeverity but the second half of the pair is a small +-- ReasolvedDiagnosticReason which would cause the diagnostic to be triggered with the +-- same severity. +-- +-- See Note [Warnings controlled by multiple flags] +-- +diag_reason_severity :: DiagOpts -> DiagnosticReason -> (Severity, ResolvedDiagnosticReason) +diag_reason_severity opts reason = fmap ResolvedDiagnosticReason $ case reason of + WarningWithFlags wflags -> case wflags' of + [] -> (SevIgnore, reason) + w : ws -> case wflagsE of + [] -> (SevWarning, WarningWithFlags (w :| ws)) + e : es -> (SevError, WarningWithFlags (e :| es)) + where + wflags' = NE.filter (\wflag -> diag_wopt wflag opts) wflags + wflagsE = filter (\wflag -> diag_fatal_wopt wflag opts) wflags' + WarningWithCategory wcat - | not (diag_wopt_custom wcat opts) -> SevIgnore - | diag_fatal_wopt_custom wcat opts -> SevError - | otherwise -> SevWarning + | not (diag_wopt_custom wcat opts) -> (SevIgnore, reason) + | diag_fatal_wopt_custom wcat opts -> (SevError, reason) + | otherwise -> (SevWarning, reason) WarningWithoutFlag - | diag_warn_is_error opts -> SevError - | otherwise -> SevWarning + | diag_warn_is_error opts -> (SevError, reason) + | otherwise -> (SevWarning, reason) ErrorWithoutFlag - -> SevError - + -> (SevError, reason) -- | Make a 'MessageClass' for a given 'DiagnosticReason', consulting the --- 'DiagOpts. +-- 'DiagOpts'. mkMCDiagnostic :: DiagOpts -> DiagnosticReason -> Maybe DiagnosticCode -> MessageClass -mkMCDiagnostic opts reason code = MCDiagnostic (diagReasonSeverity opts reason) reason code +mkMCDiagnostic opts reason code = MCDiagnostic sev reason' code + where + (sev, reason') = diag_reason_severity opts reason -- | Varation of 'mkMCDiagnostic' which can be used when we are /sure/ the -- input 'DiagnosticReason' /is/ 'ErrorWithoutFlag' and there is no diagnostic code. errorDiagnostic :: MessageClass -errorDiagnostic = MCDiagnostic SevError ErrorWithoutFlag Nothing +errorDiagnostic = MCDiagnostic SevError (ResolvedDiagnosticReason ErrorWithoutFlag) Nothing -- -- Creating MsgEnvelope(s) @@ -168,13 +187,15 @@ mk_msg_envelope => Severity -> SrcSpan -> NamePprCtx + -> ResolvedDiagnosticReason -> e -> MsgEnvelope e -mk_msg_envelope severity locn name_ppr_ctx err +mk_msg_envelope severity locn name_ppr_ctx reason err = MsgEnvelope { errMsgSpan = locn , errMsgContext = name_ppr_ctx , errMsgDiagnostic = err , errMsgSeverity = severity + , errMsgReason = reason } -- | Wrap a 'Diagnostic' in a 'MsgEnvelope', recording its location. @@ -188,7 +209,9 @@ mkMsgEnvelope -> e -> MsgEnvelope e mkMsgEnvelope opts locn name_ppr_ctx err - = mk_msg_envelope (diagReasonSeverity opts (diagnosticReason err)) locn name_ppr_ctx err + = mk_msg_envelope sev locn name_ppr_ctx reason err + where + (sev, reason) = diag_reason_severity opts (diagnosticReason err) -- | Wrap a 'Diagnostic' in a 'MsgEnvelope', recording its location. -- Precondition: the diagnostic is, in fact, an error. That is, @@ -199,7 +222,7 @@ mkErrorMsgEnvelope :: Diagnostic e -> e -> MsgEnvelope e mkErrorMsgEnvelope locn name_ppr_ctx msg = - assert (diagnosticReason msg == ErrorWithoutFlag) $ mk_msg_envelope SevError locn name_ppr_ctx msg + assert (diagnosticReason msg == ErrorWithoutFlag) $ mk_msg_envelope SevError locn name_ppr_ctx (ResolvedDiagnosticReason ErrorWithoutFlag) msg -- | Variant that doesn't care about qualified/unqualified names. mkPlainMsgEnvelope :: Diagnostic e @@ -217,7 +240,7 @@ mkPlainErrorMsgEnvelope :: Diagnostic e -> e -> MsgEnvelope e mkPlainErrorMsgEnvelope locn msg = - mk_msg_envelope SevError locn alwaysQualify msg + mk_msg_envelope SevError locn alwaysQualify (ResolvedDiagnosticReason ErrorWithoutFlag) msg ------------------------- data Validity' a @@ -273,10 +296,11 @@ pprLocMsgEnvelope :: Diagnostic e => DiagnosticOpts e -> MsgEnvelope e -> SDoc pprLocMsgEnvelope opts (MsgEnvelope { errMsgSpan = s , errMsgDiagnostic = e , errMsgSeverity = sev - , errMsgContext = name_ppr_ctx }) + , errMsgContext = name_ppr_ctx + , errMsgReason = reason }) = withErrStyle name_ppr_ctx $ mkLocMessage - (MCDiagnostic sev (diagnosticReason e) (diagnosticCode e)) + (MCDiagnostic sev reason (diagnosticCode e)) s (formatBulleted $ diagnosticMessage opts e) ===================================== testsuite/tests/plugins/T20803-plugin/AddErrorPlugin.hs ===================================== @@ -7,6 +7,7 @@ module AddErrorPlugin where import GHC.Plugins import GHC.Types.Error +import GHC.Utils.Error import GHC.Hs import GHC.Data.Bag import GHC.Parser.Errors.Types @@ -25,9 +26,7 @@ parsedAction _ _ (ParsedResult pm msgs) = do liftIO $ hFlush stdout pure (ParsedResult pm msgs{psErrors = mkMessages $ unitBag err}) where - err = MsgEnvelope - { errMsgSpan = UnhelpfulSpan UnhelpfulNoLocationInfo - , errMsgContext = alwaysQualify - , errMsgDiagnostic = PsErrEmptyLambda - , errMsgSeverity = SevError - } + err = mkErrorMsgEnvelope + (UnhelpfulSpan UnhelpfulNoLocationInfo) + alwaysQualify + PsErrEmptyLambda View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a1f350e24733e28465c53ed3f5c2b5481b97dc69 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a1f350e24733e28465c53ed3f5c2b5481b97dc69 You're receiving 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 Jun 13 13:43:23 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 13 Jun 2023 09:43:23 -0400 Subject: [Git][ghc/ghc][master] Add a test Way for running ghci with Core optimizations Message-ID: <6488727bcf2bd_29cce4c569818492b@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - 30 changed files: - libraries/base/tests/IO/all.T - libraries/base/tests/all.T - libraries/ghc-compact/tests/all.T - libraries/ghc-heap/tests/all.T - libraries/hpc - libraries/process - testsuite/config/ghc - testsuite/driver/testlib.py - testsuite/tests/cmm/should_run/all.T - testsuite/tests/cmm/should_run/machops/all.T - testsuite/tests/codeGen/should_fail/all.T - testsuite/tests/codeGen/should_run/T20137/T20137.hs - testsuite/tests/codeGen/should_run/T20137/T20137C.c - testsuite/tests/codeGen/should_run/T20137/all.T - testsuite/tests/codeGen/should_run/T20735/all.T - testsuite/tests/codeGen/should_run/T23146/all.T - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/concurrent/should_run/all.T - testsuite/tests/deriving/should_fail/all.T - testsuite/tests/deriving/should_run/all.T - testsuite/tests/driver/all.T - testsuite/tests/ffi/should_compile/all.T - testsuite/tests/ffi/should_run/all.T - testsuite/tests/ghc-api/all.T - testsuite/tests/ghc-api/target-contents/all.T - testsuite/tests/ghci.debugger/scripts/all.T - testsuite/tests/ghci.debugger/scripts/print007.script - − testsuite/tests/ghci.debugger/scripts/print007.stderr - testsuite/tests/ghci/caf_crash/all.T - testsuite/tests/ghci/scripts/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ec01f0ec5877f5cacb4c3a6ba3f18d2d0d900f9c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ec01f0ec5877f5cacb4c3a6ba3f18d2d0d900f9c You're receiving 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 Jun 13 13:44:01 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 13 Jun 2023 09:44:01 -0400 Subject: [Git][ghc/ghc][master] Configure -Qunused-arguments instead of hardcoding it Message-ID: <648872a1b491a_29cce4c5e54188584@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 4 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - configure.ac - distrib/configure.ac.in - + m4/fp_cc_ignore_unused_args.m4 Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -292,11 +292,7 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do -- LLVM from version 3.0 onwards doesn't support the OS X system -- assembler, so we use clang as the assembler instead. (#5636) - let (as_prog, get_asm_info) = - ( applyAssemblerProg $ backendAssemblerProg (backend dflags) - , applyAssemblerInfoGetter $ backendAssemblerInfoGetter (backend dflags) - ) - asmInfo <- get_asm_info logger dflags platform + let as_prog = applyAssemblerProg $ backendAssemblerProg (backend dflags) let cmdline_include_paths = includePaths dflags let pic_c_flags = picCCOpts dflags @@ -330,9 +326,6 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do ++ [ GHC.SysTools.Option "-Wa,--no-type-check" | platformArch (targetPlatform dflags) == ArchWasm32] - ++ (if any (asmInfo ==) [Clang, AppleClang, AppleClang51] - then [GHC.SysTools.Option "-Qunused-arguments"] - else []) ++ [ GHC.SysTools.Option "-x" , if with_cpp then GHC.SysTools.Option "assembler-with-cpp" @@ -400,19 +393,6 @@ runForeignJsPhase pipe_env hsc_env _location input_fn = do return output_fn -applyAssemblerInfoGetter - :: DefunctionalizedAssemblerInfoGetter - -> Logger -> DynFlags -> Platform -> IO CompilerInfo -applyAssemblerInfoGetter StandardAssemblerInfoGetter logger dflags _platform = - getAssemblerInfo logger dflags -applyAssemblerInfoGetter JSAssemblerInfoGetter _ _ _ = - pure Emscripten -applyAssemblerInfoGetter DarwinClangAssemblerInfoGetter logger dflags platform = - if platformOS platform == OSDarwin then - pure Clang - else - getAssemblerInfo logger dflags - applyAssemblerProg :: DefunctionalizedAssemblerProg -> Logger -> DynFlags -> Platform -> [Option] -> IO () ===================================== configure.ac ===================================== @@ -664,6 +664,12 @@ FP_CC_SUPPORTS_TARGET([$CC_STAGE0], [CONF_CC_OPTS_STAGE0], [CONF_CXX_OPTS_STAGE0 FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINKER_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINKER_OPTS_STAGE2]) +dnl Pass -Qunused-arguments or otherwise GHC will have very noisy invocations of Clang +dnl TODO: Do we need -Qunused-arguments in CXX and GCC linker too? +FP_CC_IGNORE_UNUSED_ARGS([$CC_STAGE0], [CONF_CC_OPTS_STAGE0]) +FP_CC_IGNORE_UNUSED_ARGS([$CC], [CONF_CC_OPTS_STAGE1]) +FP_CC_IGNORE_UNUSED_ARGS([$CC], [CONF_CC_OPTS_STAGE2]) + # See rules/distdir-way-opts.mk for details. # Flags passed to the C compiler AC_SUBST(CONF_CC_OPTS_STAGE0) ===================================== distrib/configure.ac.in ===================================== @@ -223,6 +223,10 @@ dnl CONF_CC_OPTS_STAGE[12] accordingly. FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINK_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINK_OPTS_STAGE2]) +dnl Pass -Qunused-arguments or otherwise GHC will have very noisy invocations of Clang +FP_CC_IGNORE_UNUSED_ARGS([$CC], [CONF_CC_OPTS_STAGE1]) +FP_CC_IGNORE_UNUSED_ARGS([$CC], [CONF_CC_OPTS_STAGE2]) + dnl TargetWordSize for settings file AC_CHECK_SIZEOF(void *, 4) if test "x$ac_cv_sizeof_void_p" = "x0"; then ===================================== m4/fp_cc_ignore_unused_args.m4 ===================================== @@ -0,0 +1,31 @@ +# FP_CC_IGNORE_UNUSED_ARGS +# ------------------------ +# GHC tends to produce command-lines with unused arguments that elicit +# warnings from Clang. Clang offers the @-Qunused-arguments@ flag to silence +# these. See #11684. +# +# The primary effect of this is updating CONF_CC_OPTS_STAGE[12] to explicitly +# pass -Qunused-arguments to Clang, since otherwise Cc invocations by GHC will +# be very noisy +# +# $1 = CC +# $2 = CC_OPTS variable +AC_DEFUN([FP_CC_IGNORE_UNUSED_ARGS], +[ + AC_MSG_CHECKING([whether $1 supports -Qunused-arguments]) + echo 'int main() { return 0; }' > conftest.c + if $1 -Qunused-arguments -Werror conftest.c > /dev/null 2>&1 ; then + CONF_CC_SUPPORTS_TARGET=YES + AC_MSG_RESULT([yes]) + else + CONF_CC_SUPPORTS_TARGET=NO + AC_MSG_RESULT([no]) + fi + rm -f conftest.c conftest + + if test $CONF_CC_SUPPORTS_TARGET = YES ; then + $2="$$2 -Qunused-arguments" + fi +]) + + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c6741e72f639f4d8e650b5f7c374aac498218584 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c6741e72f639f4d8e650b5f7c374aac498218584 You're receiving 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 Jun 13 13:44:43 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 13 Jun 2023 09:44:43 -0400 Subject: [Git][ghc/ghc][master] Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion Message-ID: <648872cb35853_29cce46cff3419383d@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 1 changed file: - libraries/base/Data/Fixed.hs Changes: ===================================== libraries/base/Data/Fixed.hs ===================================== @@ -21,6 +21,13 @@ -- This module also contains generalisations of 'div', 'mod', and 'divMod' to -- work with any 'Real' instance. -- +-- Automatic conversion between different 'Fixed' can be performed through +-- 'realToFrac', bear in mind that converting to a fixed with a smaller +-- resolution will truncate the number, losing information. +-- +-- >>> realToFrac (0.123456 :: Pico) :: Milli +-- 0.123 +-- ----------------------------------------------------------------------------- module Data.Fixed View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0128db8744da2d015f84eb3881ffcf573547abce -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0128db8744da2d015f84eb3881ffcf573547abce You're receiving 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 Jun 13 13:45:16 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 13 Jun 2023 09:45:16 -0400 Subject: [Git][ghc/ghc][master] Add regression test for #23143 Message-ID: <648872ec9707c_29cce47811d3c1991d0@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - 2 changed files: - + testsuite/tests/quantified-constraints/T23143.hs - testsuite/tests/quantified-constraints/all.T Changes: ===================================== testsuite/tests/quantified-constraints/T23143.hs ===================================== @@ -0,0 +1,39 @@ +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +{-# OPTIONS_GHC -Wredundant-constraints #-} + +module T23143 where + +import Data.Coerce + +newtype A a = MkA a + +class Pointed a where + point :: a + +class (forall a. Pointed a => Pointed (t a)) => T t where + points :: Pointed a => t a + +instance Pointed a => Pointed (A a) where + point = MkA point + +instance T A where + points = point + +newtype B a = MkB (A a) + deriving newtype (Pointed, T) + +newtype C a = MkC (A a) + +instance Pointed a => Pointed (C a) where + point :: C a + point = coerce @(A a) @(C a) (point @(A a)) + +instance T C where + points :: forall a. Pointed a => C a + points = coerce @(A a) @(C a) (points @A) ===================================== testsuite/tests/quantified-constraints/all.T ===================================== @@ -41,5 +41,6 @@ test('T22216d', normal, compile, ['']) test('T22216e', normal, compile, ['']) test('T22223', normal, compile, ['']) test('T19690', normal, compile_fail, ['']) +test('T23143', normal, compile, ['']) test('T23333', normal, compile, ['']) test('T23323', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/95b69cfb3d601eb3e6c5b1727c4cfef25ab87d68 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/95b69cfb3d601eb3e6c5b1727c4cfef25ab87d68 You're receiving 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 Jun 13 13:45:27 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Tue, 13 Jun 2023 09:45:27 -0400 Subject: [Git][ghc/ghc][wip/js-th] 36 commits: Generate Addr# access ops programmatically Message-ID: <648872f7a7a31_29cce478d120419932c@gitlab.mail> Sylvain Henry pushed to branch wip/js-th at Glasgow Haskell Compiler / GHC Commits: 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - 014a06eb by Sylvain Henry at 2023-06-13T15:50:53+02: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> - - - - - abeb5d19 by Sylvain Henry at 2023-06-13T15:50:53+02:00 Don't use getKey - - - - - 782e91a9 by Sylvain Henry at 2023-06-13T15:50:53+02:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - 62271c0d by Sylvain Henry at 2023-06-13T15:50:53+02:00 Fix some recompilation avoidance tests - - - - - 997cb25a by Sylvain Henry at 2023-06-13T15:50:53+02:00 TH_import_loop is now broken as expected - - - - - 0de58ca1 by Sylvain Henry at 2023-06-13T15:50:53+02:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 28 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - HACKING.md - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/TyCon.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Linker/Loader.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/Runtime/Context.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/578744088ffdfda149ae7f1ddfadbc4b7e30cd31...0de58ca1b9076a6c12b43ba426233fe8581a8a9c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/578744088ffdfda149ae7f1ddfadbc4b7e30cd31...0de58ca1b9076a6c12b43ba426233fe8581a8a9c You're receiving 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 Jun 13 13:46:10 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 13 Jun 2023 09:46:10 -0400 Subject: [Git][ghc/ghc][master] delete GHCi.UI.Tags module and remove remaining references Message-ID: <6488732295fe8_29cce47b1d12020406a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - 5 changed files: - docs/users_guide/9.8.1-notes.rst - docs/users_guide/ghci.rst - ghc/GHCi/UI.hs - − ghc/GHCi/UI/Tags.hs - ghc/ghc-bin.cabal.in Changes: ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -135,6 +135,7 @@ Compiler GHCi ~~~~ +- The deprecated `:ctags` and `:etags` GHCi commands have been removed. See this `wiki page `_ if you want to add a macro to recover similar functionality. Runtime system ~~~~~~~~~~~~~~ ===================================== docs/users_guide/ghci.rst ===================================== @@ -2357,15 +2357,6 @@ commonly used commands. the current breakpoint for the next ``⟨ignoreCount⟩`` iterations. See command :ghci-cmd:`:ignore`. -.. ghci-cmd:: :ctags; [⟨filename⟩] - - Generates a "tags" file for Vi-style editors (:ghci-cmd:`:ctags`) or - Emacs-style editors (:ghci-cmd:`:etags`). If no filename is specified, the - default ``tags`` or ``TAGS`` is used, respectively. Tags for all the - functions, constructors and types in the currently loaded modules - are created. All modules must be interpreted for these commands to - work. - .. ghci-cmd:: :def;[!] ⟨name⟩ ⟨expr⟩ :ghci-cmd:`:def` is used to define new commands, or macros, in GHCi. The @@ -2468,10 +2459,6 @@ commonly used commands. disabled breakpoints. Enabling a break point will reset its ``ignore count`` to 0. (See :ghci-cmd:`:ignore`) -.. ghci-cmd:: :etags - - See :ghci-cmd:`:ctags`. - .. ghci-cmd:: :force; ⟨identifier⟩ ... Prints the value of ⟨identifier⟩ in the same way as :ghci-cmd:`:print`. ===================================== ghc/GHCi/UI.hs ===================================== @@ -33,7 +33,6 @@ module GHCi.UI ( -- GHCi import qualified GHCi.UI.Monad as GhciMonad ( args, runStmt, runDecls' ) import GHCi.UI.Monad hiding ( args, runStmt ) -import GHCi.UI.Tags import GHCi.UI.Info import GHCi.UI.Exception import GHC.Runtime.Debugger @@ -211,8 +210,6 @@ ghciCommands = map mkCmd [ ("check", keepGoing' checkModule, completeHomeModule), ("continue", keepGoing continueCmd, noCompletion), ("cmd", keepGoing cmdCmd, completeExpression), - ("ctags", keepGoing createCTagsWithLineNumbersCmd, completeFilename), - ("ctags!", keepGoing createCTagsWithRegExesCmd, completeFilename), ("def", keepGoing (defineMacro False), completeExpression), ("def!", keepGoing (defineMacro True), completeExpression), ("delete", keepGoing deleteCmd, noCompletion), @@ -220,7 +217,6 @@ ghciCommands = map mkCmd [ ("doc", keepGoing' docCmd, completeIdentifier), ("edit", keepGoingMulti' editFile, completeFilename), ("enable", keepGoing enableCmd, noCompletion), - ("etags", keepGoing createETagsFileCmd, completeFilename), ("force", keepGoing forceCmd, completeExpression), ("forward", keepGoing forwardCmd, noCompletion), ("help", keepGoingMulti help, noCompletion), @@ -360,15 +356,12 @@ defFullHelpText = " :cd change directory to \n" ++ " :cmd run the commands returned by ::IO String\n" ++ " :complete [] list completions for partial input string\n" ++ - " :ctags[!] [] create tags file for Vi (default: \"tags\")\n" ++ - " (!: use regex instead of line number)\n" ++ " :def[!] define command : (later defined command has\n" ++ " precedence, :: is always a builtin command)\n" ++ " (!: redefine an existing command name)\n" ++ " :doc display docs for the given name (experimental)\n" ++ " :edit edit file\n" ++ " :edit edit last module\n" ++ - " :etags [] create tags file for Emacs (default: \"TAGS\")\n" ++ " :help, :? display this list of commands\n" ++ " :info[!] [ ...] display information about the given names\n" ++ " (!: do not filter instances)\n" ++ ===================================== ghc/GHCi/UI/Tags.hs deleted ===================================== @@ -1,215 +0,0 @@ ------------------------------------------------------------------------------ --- --- GHCi's :ctags and :etags commands --- --- (c) The GHC Team 2005-2007 --- ------------------------------------------------------------------------------ - -{-# OPTIONS_GHC -fno-warn-name-shadowing #-} -module GHCi.UI.Tags ( - createCTagsWithLineNumbersCmd, - createCTagsWithRegExesCmd, - createETagsFileCmd -) where - -import GHC.Utils.Exception -import GHC -import GHCi.UI.Monad - --- ToDo: figure out whether we need these, and put something appropriate --- into the GHC API instead -import GHC.Types.Name (nameOccName) -import GHC.Types.Name.Occurrence (occNameString) -import GHC.Core.ConLike -import GHC.Utils.Monad -import GHC.Data.FastString - -import Control.Monad -import Data.Function -import Data.List (sort, sortOn) -import qualified Data.List.NonEmpty as NE -import Data.Maybe -import Data.Ord -import GHC.Driver.Phases -import GHC.Utils.Panic -import Prelude -import System.Directory -import System.IO -import System.IO.Error - ------------------------------------------------------------------------------ --- create tags file for currently loaded modules. - -createCTagsWithLineNumbersCmd, createCTagsWithRegExesCmd, - createETagsFileCmd :: String -> GHCi () - -createCTagsWithLineNumbersCmd "" = - ghciCreateTagsFile CTagsWithLineNumbers "tags" -createCTagsWithLineNumbersCmd file = - ghciCreateTagsFile CTagsWithLineNumbers file - -createCTagsWithRegExesCmd "" = - ghciCreateTagsFile CTagsWithRegExes "tags" -createCTagsWithRegExesCmd file = - ghciCreateTagsFile CTagsWithRegExes file - -createETagsFileCmd "" = ghciCreateTagsFile ETags "TAGS" -createETagsFileCmd file = ghciCreateTagsFile ETags file - -data TagsKind = ETags | CTagsWithLineNumbers | CTagsWithRegExes - -ghciCreateTagsFile :: TagsKind -> FilePath -> GHCi () -ghciCreateTagsFile kind file = do - liftIO $ putStrLn "Tags generation from GHCi will be deprecated in GHC 9.8" - liftIO $ putStrLn "Use the method described in https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/GHCi/Tags" - createTagsFile kind file - --- ToDo: --- - remove restriction that all modules must be interpreted --- (problem: we don't know source locations for entities unless --- we compiled the module. --- --- - extract createTagsFile so it can be used from the command-line --- (probably need to fix first problem before this is useful). --- -createTagsFile :: TagsKind -> FilePath -> GHCi () -createTagsFile tagskind tagsFile = do - graph <- GHC.getModuleGraph - mtags <- mapM listModuleTags (map GHC.ms_mod $ GHC.mgModSummaries graph) - either_res <- liftIO $ collateAndWriteTags tagskind tagsFile $ concat mtags - case either_res of - Left e -> liftIO $ hPutStrLn stderr $ ioeGetErrorString e - Right _ -> return () - - -listModuleTags :: GHC.Module -> GHCi [TagInfo] -listModuleTags m = do - is_interpreted <- GHC.moduleIsInterpreted m - -- should we just skip these? - when (not is_interpreted) $ - let mName = GHC.moduleNameString (GHC.moduleName m) in - throwGhcException (CmdLineError ("module '" ++ mName ++ "' is not interpreted")) - mbModInfo <- GHC.getModuleInfo m - case mbModInfo of - Nothing -> return [] - Just mInfo -> do - let names = fromMaybe [] $ GHC.modInfoTopLevelScope mInfo - let localNames = filter ((m==) . nameModule) names - mbTyThings <- mapM GHC.lookupName localNames - return $! [ tagInfo exported kind name realLoc - | tyThing <- catMaybes mbTyThings - , let name = getName tyThing - , let exported = GHC.modInfoIsExportedName mInfo name - , let kind = tyThing2TagKind tyThing - , let loc = srcSpanStart (nameSrcSpan name) - , RealSrcLoc realLoc _ <- [loc] - ] - - where - tyThing2TagKind (AnId _) = 'v' - tyThing2TagKind (AConLike RealDataCon{}) = 'd' - tyThing2TagKind (AConLike PatSynCon{}) = 'p' - tyThing2TagKind (ATyCon _) = 't' - tyThing2TagKind (ACoAxiom _) = 'x' - - -data TagInfo = TagInfo - { tagExported :: Bool -- is tag exported - , tagKind :: Char -- tag kind - , tagName :: String -- tag name - , tagFile :: String -- file name - , tagLine :: Int -- line number - , tagCol :: Int -- column number - , tagSrcInfo :: Maybe (String,Integer) -- source code line and char offset - } - - --- get tag info, for later translation into Vim or Emacs style -tagInfo :: Bool -> Char -> Name -> RealSrcLoc - -> TagInfo -tagInfo exported kind name loc - = TagInfo exported kind - (occNameString $ nameOccName name) - (unpackFS (srcLocFile loc)) - (srcLocLine loc) (srcLocCol loc) Nothing - --- throw an exception when someone tries to overwrite existing source file (fix for #10989) -writeTagsSafely :: FilePath -> String -> IO () -writeTagsSafely file str = do - dfe <- doesFileExist file - if dfe && isSourceFilename file - then throwGhcException (CmdLineError (file ++ " is existing source file. " ++ - "Please specify another file name to store tags data")) - else writeFile file str - -collateAndWriteTags :: TagsKind -> FilePath -> [TagInfo] -> IO (Either IOError ()) --- ctags style with the Ex expression being just the line number, Vim et al -collateAndWriteTags CTagsWithLineNumbers file tagInfos = do - let tags = unlines $ sort $ map showCTag tagInfos - tryIO (writeTagsSafely file tags) - --- ctags style with the Ex expression being a regex searching the line, Vim et al -collateAndWriteTags CTagsWithRegExes file tagInfos = do -- ctags style, Vim et al - tagInfoGroups <- makeTagGroupsWithSrcInfo tagInfos - let tags = unlines $ sort $ map showCTag $ concat tagInfoGroups - tryIO (writeTagsSafely file tags) - -collateAndWriteTags ETags file tagInfos = do -- etags style, Emacs/XEmacs - tagInfoGroups <- makeTagGroupsWithSrcInfo $ filter tagExported tagInfos - let tagGroups = map processGroup tagInfoGroups - tryIO (writeTagsSafely file $ concat tagGroups) - - where - processGroup [] = throwGhcException (CmdLineError "empty tag file group??") - processGroup group@(tagInfo:_) = - let tags = unlines $ map showETag group in - "\x0c\n" ++ tagFile tagInfo ++ "," ++ show (length tags) ++ "\n" ++ tags - - -makeTagGroupsWithSrcInfo :: [TagInfo] -> IO [[TagInfo]] -makeTagGroupsWithSrcInfo tagInfos = do - let groups = NE.groupAllWith tagFile tagInfos - mapM addTagSrcInfo groups - - where - addTagSrcInfo group@(tagInfo NE.:| _) = do - file <- readFile $ tagFile tagInfo - let sortedGroup = sortOn tagLine (NE.toList group) - return $ perFile sortedGroup 1 0 $ lines file - - perFile allTags@(tag:tags) cnt pos allLs@(l:ls) - | tagLine tag > cnt = - perFile allTags (cnt+1) (pos+fromIntegral(length l)) ls - | tagLine tag == cnt = - tag{ tagSrcInfo = Just(l,pos) } : perFile tags cnt pos allLs - perFile _ _ _ _ = [] - - --- ctags format, for Vim et al -showCTag :: TagInfo -> String -showCTag ti = - tagName ti ++ "\t" ++ tagFile ti ++ "\t" ++ tagCmd ++ ";\"\t" ++ - tagKind ti : ( if tagExported ti then "" else "\tfile:" ) - - where - tagCmd = - case tagSrcInfo ti of - Nothing -> show $ tagLine ti - Just (srcLine,_) -> "/^"++ foldr escapeSlashes [] srcLine ++"$/" - - where - escapeSlashes '/' r = '\\' : '/' : r - escapeSlashes '\\' r = '\\' : '\\' : r - escapeSlashes c r = c : r - - --- etags format, for Emacs/XEmacs -showETag :: TagInfo -> String -showETag TagInfo{ tagName = tag, tagLine = lineNo, tagCol = colNo, - tagSrcInfo = Just (srcLine,charPos) } - = take (colNo - 1) srcLine ++ tag - ++ "\x7f" ++ tag - ++ "\x01" ++ show lineNo - ++ "," ++ show charPos -showETag _ = throwGhcException (CmdLineError "missing source file info in showETag") ===================================== ghc/ghc-bin.cabal.in ===================================== @@ -68,7 +68,6 @@ Executable ghc GHCi.UI GHCi.UI.Info GHCi.UI.Monad - GHCi.UI.Tags GHCi.UI.Exception GHCi.Util Other-Extensions: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ed2dbdcab3272ac8d81075ef60920096d2481fb3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ed2dbdcab3272ac8d81075ef60920096d2481fb3 You're receiving 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 Jun 13 13:46:50 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 13 Jun 2023 09:46:50 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Add regression test for 17328 Message-ID: <6488734a3c535_29cce46cff3420977d@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 4 changed files: - compiler/GHC/Tc/Deriv.hs - + testsuite/tests/deriving/should_compile/T17328.hs - + testsuite/tests/deriving/should_compile/T17328a.hs - testsuite/tests/deriving/should_compile/all.T Changes: ===================================== compiler/GHC/Tc/Deriv.hs ===================================== @@ -1960,9 +1960,13 @@ doDerivInstErrorChecks1 mechanism = case mechanism of DerivSpecStock{dsm_stock_dit = dit} -> data_cons_in_scope_check dit - DerivSpecNewtype{dsm_newtype_dit = dit} - -> do atf_coerce_based_error_checks - data_cons_in_scope_check dit + -- No need to 'data_cons_in_scope_check' for newtype deriving. + -- Additionally, we also don't need to mark the constructos as + -- used because newtypes are handled separately elsewhere. + -- See Note [Tracking unused binding and imports] in GHC.Tc.Types + -- or #17328 for more. + DerivSpecNewtype{} + -> atf_coerce_based_error_checks DerivSpecAnyClass{} -> pure () DerivSpecVia{} ===================================== testsuite/tests/deriving/should_compile/T17328.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE DerivingStrategies, StandaloneDeriving, GeneralizedNewtypeDeriving, + DerivingVia #-} + +module T17328 where + +import T17328a ( N1, N2(..) ) + +import Data.Coerce + +deriving newtype instance Eq N1 + ===================================== testsuite/tests/deriving/should_compile/T17328a.hs ===================================== @@ -0,0 +1,8 @@ +module T17328a where + +newtype N1 = MkN1 N2 + +newtype N2 = MkN2 N1 + +instance Eq N2 where + (==) = const (const False) ===================================== testsuite/tests/deriving/should_compile/all.T ===================================== @@ -142,3 +142,4 @@ test('T22167', normal, compile, ['']) test('T22696a', normal, compile, ['']) test('T22696c', normal, compile, ['']) test('T23329', normal, multimod_compile, ['T23329', '-v0']) +test('T17328', [extra_files(['T17328a.hs'])], multimod_compile, ['T17328', '-v0']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ed2dbdcab3272ac8d81075ef60920096d2481fb3...de58080c9d488c17519f64b633b171ec46ce65f0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ed2dbdcab3272ac8d81075ef60920096d2481fb3...de58080c9d488c17519f64b633b171ec46ce65f0 You're receiving 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 Jun 13 13:47:29 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 13 Jun 2023 09:47:29 -0400 Subject: [Git][ghc/ghc][master] Don't suggest `DeriveAnyClass` when instance can't be derived. Message-ID: <64887371216cd_29cce4c5e7c21699b@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 6 changed files: - compiler/GHC/Tc/Deriv.hs - testsuite/tests/deriving/should_fail/T11509_1.stderr - + testsuite/tests/deriving/should_fail/T19692.hs - + testsuite/tests/deriving/should_fail/T19692.stderr - testsuite/tests/deriving/should_fail/all.T - testsuite/tests/generics/T5462No1.stderr Changes: ===================================== compiler/GHC/Tc/Deriv.hs ===================================== @@ -65,6 +65,7 @@ import GHC.Utils.Logger import GHC.Data.Bag import GHC.Utils.FV as FV (fvVarList, unionFV, mkFVs) import qualified GHC.LanguageExtensions as LangExt +import GHC.Data.BooleanFormula ( isUnsatisfied ) import Control.Monad import Control.Monad.Trans.Class @@ -1442,19 +1443,24 @@ mk_eqn_no_strategy = do -- See Note [DerivEnv and DerivSpecMechanism] in GHC.Tc.Deriv.Utils whenIsJust (hasStockDeriving cls) $ \_ -> expectNonDataFamTyCon dit - mk_eqn_originative dit + mk_eqn_originative cls dit | otherwise -> mk_eqn_anyclass where -- Use heuristics (checkOriginativeSideConditions) to determine whether -- stock or anyclass deriving should be used. - mk_eqn_originative :: DerivInstTys -> DerivM EarlyDerivSpec - mk_eqn_originative dit@(DerivInstTys { dit_tc = tc - , dit_rep_tc = rep_tc }) = do + mk_eqn_originative :: Class -> DerivInstTys -> DerivM EarlyDerivSpec + mk_eqn_originative cls dit@(DerivInstTys { dit_tc = tc + , dit_rep_tc = rep_tc }) = do dflags <- getDynFlags - let isDeriveAnyClassEnabled = - deriveAnyClassEnabled (xopt LangExt.DeriveAnyClass dflags) + let isDeriveAnyClassEnabled + | canSafelyDeriveAnyClass cls + = deriveAnyClassEnabled (xopt LangExt.DeriveAnyClass dflags) + | otherwise + -- Pretend that the extension is enabled so that we won't suggest + -- enabling it. + = YesDeriveAnyClassEnabled -- See Note [Deriving instances for classes themselves] let dac_error @@ -1471,6 +1477,12 @@ mk_eqn_no_strategy = do , dsm_stock_gen_fns = gen_fns } CanDeriveAnyClass -> mk_eqn_from_mechanism DerivSpecAnyClass + canSafelyDeriveAnyClass cls = + -- If the set of minimal required definitions is nonempty, + -- `DeriveAnyClass` will generate an instance with undefined methods or + -- associated types, so don't suggest enabling it. + isNothing $ isUnsatisfied (const False) (classMinimalDef cls) + {- ************************************************************************ * * ===================================== testsuite/tests/deriving/should_fail/T11509_1.stderr ===================================== @@ -5,4 +5,3 @@ T11509_1.hs:53:1: error: [GHC-23244] if DeriveAnyClass is enabled • In the stand-alone deriving instance for ‘(Typeable a, SC (Serializable a)) => SC (Serializable (MyList a))’ - Suggested fix: Perhaps you intended to use DeriveAnyClass ===================================== testsuite/tests/deriving/should_fail/T19692.hs ===================================== @@ -0,0 +1,63 @@ +{-# LANGUAGE AllowAmbiguousTypes, DefaultSignatures, DerivingStrategies #-} + +module T19692 where + +-- Should not suggest enabling DeriveAnyClass +class C1 a where + x1 :: a -> Int +data G1 = G1 deriving C1 +data G1' = G1' +deriving instance C1 G1' + +-- These should all suggest doing that +class C2 a +data G2 = G2 deriving C2 +data G2' = G2' +deriving instance C2 G2' + +class C3 a where + x3 :: a -> Int + x3 _ = 0 +data G3 = G3 deriving C3 +data G3' = G3' +deriving instance C3 G3' + +class C4 a where + x4 :: a -> Int + default x4 :: Eq a => a -> Int + x4 _ = 0 +data G4 = G4 deriving C4 +data G4' = G4' +deriving instance C4 G4' + +-- These cases use a different code path. These ones should suggest enabling it: +class C5 +deriving instance C5 + +class C6 a +deriving instance C6 a + +-- These ones ideally shouldn't, but currently do: +class C7 a where + x7 :: a -> Int +deriving instance C7 a + +class C8 where + x8 :: Int +deriving instance C8 + +-- "Making an instance for a typeclass" is also handled specially. Should +-- suggest: +class C9 a +deriving instance C9 Eq + +-- Should not suggest: +class C10 a where + x10 :: a Int => Int +deriving instance C10 Eq + +-- And "anyclass specifically asked for" is different again. We want to suggest +-- even if it would generate a warning. +data G11 = G11 Int deriving anyclass Eq +data G11' = G11' Int +deriving anyclass instance Eq G11' ===================================== testsuite/tests/deriving/should_fail/T19692.stderr ===================================== @@ -0,0 +1,91 @@ + +T19692.hs:8:23: error: [GHC-00158] + • Can't make a derived instance of ‘C1 G1’: + ‘C1’ is not a stock derivable class (Eq, Show, etc.) + • In the data declaration for ‘G1’ + +T19692.hs:10:1: error: [GHC-00158] + • Can't make a derived instance of ‘C1 G1'’: + ‘C1’ is not a stock derivable class (Eq, Show, etc.) + • In the stand-alone deriving instance for ‘C1 G1'’ + +T19692.hs:14:23: error: [GHC-00158] + • Can't make a derived instance of ‘C2 G2’: + ‘C2’ is not a stock derivable class (Eq, Show, etc.) + • In the data declaration for ‘G2’ + Suggested fix: Perhaps you intended to use DeriveAnyClass + +T19692.hs:16:1: error: [GHC-00158] + • Can't make a derived instance of ‘C2 G2'’: + ‘C2’ is not a stock derivable class (Eq, Show, etc.) + • In the stand-alone deriving instance for ‘C2 G2'’ + Suggested fix: Perhaps you intended to use DeriveAnyClass + +T19692.hs:21:23: error: [GHC-00158] + • Can't make a derived instance of ‘C3 G3’: + ‘C3’ is not a stock derivable class (Eq, Show, etc.) + • In the data declaration for ‘G3’ + Suggested fix: Perhaps you intended to use DeriveAnyClass + +T19692.hs:23:1: error: [GHC-00158] + • Can't make a derived instance of ‘C3 G3'’: + ‘C3’ is not a stock derivable class (Eq, Show, etc.) + • In the stand-alone deriving instance for ‘C3 G3'’ + Suggested fix: Perhaps you intended to use DeriveAnyClass + +T19692.hs:29:23: error: [GHC-00158] + • Can't make a derived instance of ‘C4 G4’: + ‘C4’ is not a stock derivable class (Eq, Show, etc.) + • In the data declaration for ‘G4’ + Suggested fix: Perhaps you intended to use DeriveAnyClass + +T19692.hs:31:1: error: [GHC-00158] + • Can't make a derived instance of ‘C4 G4'’: + ‘C4’ is not a stock derivable class (Eq, Show, etc.) + • In the stand-alone deriving instance for ‘C4 G4'’ + Suggested fix: Perhaps you intended to use DeriveAnyClass + +T19692.hs:35:1: error: [GHC-38178] + • Can't make a derived instance of ‘C5’: + • In the stand-alone deriving instance for ‘C5’ + Suggested fix: Perhaps you intended to use DeriveAnyClass + +T19692.hs:38:1: error: [GHC-38178] + • Can't make a derived instance of ‘C6 a’: + • In the stand-alone deriving instance for ‘C6 a’ + Suggested fix: Perhaps you intended to use DeriveAnyClass + +T19692.hs:43:1: error: [GHC-38178] + • Can't make a derived instance of ‘C7 a’: + • In the stand-alone deriving instance for ‘C7 a’ + Suggested fix: Perhaps you intended to use DeriveAnyClass + +T19692.hs:47:1: error: [GHC-38178] + • Can't make a derived instance of ‘C8’: + • In the stand-alone deriving instance for ‘C8’ + Suggested fix: Perhaps you intended to use DeriveAnyClass + +T19692.hs:52:1: error: [GHC-23244] + • Can't make a derived instance of ‘C9 Eq’: + ‘Eq’ is a type class, and can only have a derived instance + if DeriveAnyClass is enabled + • In the stand-alone deriving instance for ‘C9 Eq’ + Suggested fix: Perhaps you intended to use DeriveAnyClass + +T19692.hs:57:1: error: [GHC-23244] + • Can't make a derived instance of ‘C10 Eq’: + ‘Eq’ is a type class, and can only have a derived instance + if DeriveAnyClass is enabled + • In the stand-alone deriving instance for ‘C10 Eq’ + +T19692.hs:61:38: error: [GHC-38178] + • Can't make a derived instance of + ‘Eq G11’ with the anyclass strategy: + • In the data declaration for ‘G11’ + Suggested fix: Perhaps you intended to use DeriveAnyClass + +T19692.hs:63:1: error: [GHC-38178] + • Can't make a derived instance of + ‘Eq G11'’ with the anyclass strategy: + • In the stand-alone deriving instance for ‘Eq G11'’ + Suggested fix: Perhaps you intended to use DeriveAnyClass ===================================== testsuite/tests/deriving/should_fail/all.T ===================================== @@ -76,6 +76,7 @@ test('T14916', normal, compile_fail, ['']) test('T16181', normal, compile_fail, ['']) test('T16923', normal, compile_fail, ['']) test('T18127b', normal, compile_fail, ['']) +test('T19692', normal, compile_fail, ['']) test('deriving-via-fail', normal, compile_fail, ['']) test('deriving-via-fail2', normal, compile_fail, ['']) test('deriving-via-fail3', normal, compile_fail, ['']) ===================================== testsuite/tests/generics/T5462No1.stderr ===================================== @@ -1,5 +1,5 @@ -[1 of 2] Compiling GFunctor ( GFunctor\GFunctor.hs, out_T5462No1\GFunctor.o ) -[2 of 2] Compiling T5462No1 ( T5462No1.hs, out_T5462No1\T5462No1.o ) +[1 of 2] Compiling GFunctor ( GFunctor/GFunctor.hs, out_T5462No1/GFunctor.o ) +[2 of 2] Compiling T5462No1 ( T5462No1.hs, out_T5462No1/T5462No1.o ) T5462No1.hs:25:42: error: [GHC-82023] • Can't make a derived instance of ‘GFunctor F’: @@ -13,7 +13,6 @@ T5462No1.hs:27:23: error: [GHC-00158] • Can't make a derived instance of ‘C1 G’: ‘C1’ is not a stock derivable class (Eq, Show, etc.) • In the data declaration for ‘G’ - Suggested fix: Perhaps you intended to use DeriveAnyClass T5462No1.hs:28:23: error: [GHC-00158] • Can't make a derived instance of ‘C2 H’: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5e3c2b055d47a4748a84b9df8c9fb59acaeee49c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5e3c2b055d47a4748a84b9df8c9fb59acaeee49c You're receiving 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 Jun 13 13:48:16 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 13 Jun 2023 09:48:16 -0400 Subject: [Git][ghc/ghc][master] Add testcase for error GHC-00711 to testsuite Message-ID: <648873a0bb77f_29cce48053dd82221e3@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - 4 changed files: - compiler/GHC/Tc/Errors/Types.hs - testsuite/tests/rename/should_fail/all.T - + testsuite/tests/rename/should_fail/rnfail058.hs - + testsuite/tests/rename/should_fail/rnfail058.stderr Changes: ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -523,10 +523,13 @@ data TcRnMessage where a warning is declared twice. Examples(s): - None. + {-# DEPRECATED foo "Don't use me" #-} + {-# DEPRECATED foo "Don't use me" #-} + foo :: Int + foo = 2 Test cases: - None. + rename/should_fail/rnfail058 -} TcRnDuplicateWarningDecls :: !(LocatedN RdrName) -> !RdrName -> TcRnMessage ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -58,6 +58,7 @@ test('rnfail054', normal, compile_fail, ['']) test('rnfail055', [extra_files(['RnFail055.hs', 'RnFail055.hs-boot', 'RnFail055_aux.hs'])], multimod_compile_fail, ['RnFail055', '-v0']) test('rnfail056', normal, compile_fail, ['']) test('rnfail057', normal, compile_fail, ['']) +test('rnfail058', normal, compile_fail, ['']) test('rn_dup', normal, compile_fail, ['']) test('T495', normal, compile_fail, ['']) ===================================== testsuite/tests/rename/should_fail/rnfail058.hs ===================================== @@ -0,0 +1,6 @@ +module MultipleWarnings where + +{-# DEPRECATED foo "Don't use me" #-} +{-# DEPRECATED foo "Don't use me" #-} +foo :: Int +foo = 2 \ No newline at end of file ===================================== testsuite/tests/rename/should_fail/rnfail058.stderr ===================================== @@ -0,0 +1,4 @@ + +rnfail058.hs:4:16: error: [GHC-00711] + Multiple warning declarations for ‘foo’ + also at rnfail058.hs:3:16-18 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/80a0b0992bdf9d8c056341795c36aff9499515bf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/80a0b0992bdf9d8c056341795c36aff9499515bf You're receiving 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 Jun 13 14:04:38 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Tue, 13 Jun 2023 10:04:38 -0400 Subject: [Git][ghc/ghc][wip/js-th] 16 commits: Change WarningWithFlag to plural WarningWithFlags Message-ID: <64887776c2115_29cce480bc4f02370b3@gitlab.mail> Sylvain Henry pushed to branch wip/js-th at Glasgow Haskell Compiler / GHC Commits: a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - 1c6e23b4 by Sylvain Henry at 2023-06-13T16:09:43+02: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> - - - - - 3b11dcb1 by Sylvain Henry at 2023-06-13T16:09:56+02:00 Don't use getKey - - - - - 3844c803 by Sylvain Henry at 2023-06-13T16:09:56+02:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - 63081421 by Sylvain Henry at 2023-06-13T16:09:56+02:00 Fix some recompilation avoidance tests - - - - - 56ef2659 by Sylvain Henry at 2023-06-13T16:09:56+02:00 TH_import_loop is now broken as expected - - - - - 525a9447 by Sylvain Henry at 2023-06-13T16:09:56+02:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 28 changed files: - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Runtime/Context.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/Stg/FVs.hs - compiler/GHC/Stg/Pipeline.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/Types.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Splice.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0de58ca1b9076a6c12b43ba426233fe8581a8a9c...525a94473c4b0e6e572ecbe8a178972fa1b127e0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0de58ca1b9076a6c12b43ba426233fe8581a8a9c...525a94473c4b0e6e572ecbe8a178972fa1b127e0 You're receiving 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 Jun 13 14:36:54 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Tue, 13 Jun 2023 10:36:54 -0400 Subject: [Git][ghc/ghc][wip/T20138] 71 commits: Allow CPR on unrestricted constructors Message-ID: <64887f068fd39_29cce48e93c042645e8@gitlab.mail> Sebastian Graf pushed to branch wip/T20138 at Glasgow Haskell Compiler / GHC Commits: 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - 46884ca9 by Sebastian Graf at 2023-06-13T16:35:16+02:00 Simplifier: Combine identical alts using local equalities and unfoldings (#20138) See `Note [Combine identical alternatives: Unfoldings]` for details. Fixes #20138. - - - - - 30 changed files: - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - HACKING.md - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types/Prim.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Plugins.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/b23123936ae3b935c2ae097ecabc79abe11153e4...46884ca936db7c308bea4bafe5ab3ba6ccd02ee9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b23123936ae3b935c2ae097ecabc79abe11153e4...46884ca936db7c308bea4bafe5ab3ba6ccd02ee9 You're receiving 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 Jun 13 14:38:27 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Tue, 13 Jun 2023 10:38:27 -0400 Subject: [Git][ghc/ghc][wip/T23176] Use tcInferFRR to prevent bad generalisation Message-ID: <64887f639a376_29cce48d0f4642693c3@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/T23176 at Glasgow Haskell Compiler / GHC Commits: 4b89bb54 by Krzysztof Gogolewski at 2023-06-13T16:38:15+02:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - 5 changed files: - compiler/GHC/Tc/Gen/Bind.hs - testsuite/tests/polykinds/T22743.stderr - + testsuite/tests/rep-poly/T23176.hs - + testsuite/tests/rep-poly/T23176.stderr - testsuite/tests/rep-poly/all.T Changes: ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -1210,20 +1210,10 @@ This check, mkInferredPolyId, is really in the wrong place: `inferred_poly_ty` doesn't obey the PKTI and it would be better not to generalise it in the first place; see #20686. But for now it works. -How else could we avoid generalising over escaping type variables? I -considered: - -* Adjust the generalisation in GHC.Tc.Solver to directly check for - escaping kind variables; instead, promote or default them. But that - gets into the defaulting swamp and is a non-trivial and unforced - change, so I have left it alone for now. - -* When inferring the type of a binding, in `tcMonoBinds`, we create - an ExpSigmaType with `tcInfer`. If we simply gave it an ir_frr field - that said "must have fixed runtime rep", then the kind would be made - Concrete; and we never generalise over Concrete variables. A bit - more indirect, but we need the "don't generalise over Concrete variables" - stuff anyway. +I considered adjusting the generalisation in GHC.Tc.Solver to directly check for +escaping kind variables; instead, promoting or defaulting them. But that +gets into the defaulting swamp and is a non-trivial and unforced +change, so I have left it alone for now. Note [Impedance matching] ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1312,7 +1302,9 @@ tcMonoBinds is_rec sig_fn no_gen , Nothing <- sig_fn name -- ...with no type signature = setSrcSpanA b_loc $ do { ((co_fn, matches'), rhs_ty') - <- tcInfer $ \ exp_ty -> + <- tcInferFRR (FRRBinder name) $ \ exp_ty -> + -- tcInferFRR: the type of a let-binder must have + -- a fixed runtime rep. See #23176 tcExtendBinderStack [TcIdBndr_ExpType name exp_ty NotTopLevel] $ -- We extend the error context even for a non-recursive -- function so that in type error messages we show the @@ -1334,7 +1326,9 @@ tcMonoBinds is_rec sig_fn no_gen | NonRecursive <- is_rec -- ...binder isn't mentioned in RHS , all (isNothing . sig_fn) bndrs = addErrCtxt (patMonoBindsCtxt pat grhss) $ - do { (grhss', pat_ty) <- tcInfer $ \ exp_ty -> + do { (grhss', pat_ty) <- tcInferFRR FRRPatBind $ \ exp_ty -> + -- tcInferFRR: the type of each let-binder must have + -- a fixed runtime rep. See #23176 tcGRHSsPat grhss exp_ty ; let exp_pat_ty :: Scaled ExpSigmaTypeFRR ===================================== testsuite/tests/polykinds/T22743.stderr ===================================== @@ -1,7 +1,10 @@ -T22743.hs:10:1: error: [GHC-31147] - • Quantified type's kind mentions quantified type variable - type: ‘forall {f :: * -> RuntimeRep} {g} {a :: TYPE (f g)}. a’ - where the body of the forall has this kind: ‘TYPE (f g)’ - • When checking the inferred type - x :: forall {f :: * -> RuntimeRep} {g} {a :: TYPE (f g)}. a +T22743.hs:10:1: error: [GHC-52083] + The binder ‘x’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T22743.hs:10:1: error: [GHC-52083] + The binder ‘x’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. ===================================== testsuite/tests/rep-poly/T23176.hs ===================================== @@ -0,0 +1,6 @@ +module T23176 where + +import GHC.Exts + +f = outOfScope :: (_ :: TYPE (r s)) +(g :: _) = outOfScope :: (_ :: TYPE (r s)) ===================================== testsuite/tests/rep-poly/T23176.stderr ===================================== @@ -0,0 +1,30 @@ + +T23176.hs:5:1: error: [GHC-52083] + The binder ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23176.hs:5:1: error: [GHC-52083] + The binder ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23176.hs:5:1: error: [GHC-52083] + The binder ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23176.hs:6:1: error: [GHC-52083] + The pattern binding + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23176.hs:6:1: error: [GHC-52083] + The pattern binding + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23176.hs:6:1: error: [GHC-52083] + The pattern binding + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. ===================================== testsuite/tests/rep-poly/all.T ===================================== @@ -118,3 +118,4 @@ test('T21650_b', normal, compile_fail, ['-Wno-deprecated-flags']) ## test('T23051', normal, compile_fail, ['']) test('T23153', normal, compile_fail, ['']) test('T23154', normal, compile_fail, ['']) +test('T23176', normal, compile_fail, ['-XPartialTypeSignatures -fdefer-out-of-scope-variables']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4b89bb54a1d1d6a7b30a6bbfd21eed5d85506813 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4b89bb54a1d1d6a7b30a6bbfd21eed5d85506813 You're receiving 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 Jun 13 14:47:40 2023 From: gitlab at gitlab.haskell.org (Sebastian Graf (@sgraf812)) Date: Tue, 13 Jun 2023 10:47:40 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23047 Message-ID: <6488818ced85f_29cce4833bc94294086@gitlab.mail> Sebastian Graf pushed new branch wip/T23047 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23047 You're receiving 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 Jun 13 14:49:49 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 13 Jun 2023 10:49:49 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 12 commits: Change WarningWithFlag to plural WarningWithFlags Message-ID: <6488820d18bc9_29cce48e880c02995f8@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - 83c084a8 by Krzysztof Gogolewski at 2023-06-13T10:49:43-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - 32303824 by Matthew Pickering at 2023-06-13T10:49:43-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Utils/Error.hs - configure.ac - distrib/configure.ac.in - docs/users_guide/9.8.1-notes.rst - docs/users_guide/ghci.rst - ghc/GHCi/UI.hs - − ghc/GHCi/UI/Tags.hs - ghc/ghc-bin.cabal.in - libraries/base/Data/Fixed.hs - libraries/base/tests/IO/all.T - libraries/base/tests/all.T - libraries/ghc-compact/tests/all.T - libraries/ghc-heap/tests/all.T - libraries/hpc - libraries/process - + m4/fp_cc_ignore_unused_args.m4 - testsuite/config/ghc - testsuite/driver/testlib.py - testsuite/tests/cmm/should_run/all.T - testsuite/tests/cmm/should_run/machops/all.T - testsuite/tests/codeGen/should_fail/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/737b84d6b2d98d946074a2f75d2b97b68a7218cb...323038244f520507759dc5b7c52c8ec8aa8df8ff -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/737b84d6b2d98d946074a2f75d2b97b68a7218cb...323038244f520507759dc5b7c52c8ec8aa8df8ff You're receiving 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 Jun 13 19:46:53 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Tue, 13 Jun 2023 15:46:53 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/dib-instances] Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) Message-ID: <6488c7ad9d19e_29cce49054890371737@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/dib-instances at Glasgow Haskell Compiler / GHC Commits: 95cc703e by Andrei Borzenkov at 2023-06-13T23:46:41+04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 14 changed files: - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - testsuite/tests/indexed-types/should_compile/T14131.hs - testsuite/tests/indexed-types/should_compile/T15852.hs - testsuite/tests/indexed-types/should_compile/T15852.stderr - testsuite/tests/indexed-types/should_fail/T14230.hs - testsuite/tests/indexed-types/should_fail/T7938.hs - testsuite/tests/indexed-types/should_fail/T7938.stderr - + testsuite/tests/rename/should_compile/T23512b.hs - testsuite/tests/rename/should_compile/all.T - + testsuite/tests/rename/should_fail/T23512a.hs - + testsuite/tests/rename/should_fail/T23512a.stderr - testsuite/tests/rename/should_fail/all.T - testsuite/tests/typecheck/should_fail/T15797.hs Changes: ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -1799,8 +1799,7 @@ one exists: a free variable 'a', which we implicitly quantify over. That is why we can also use it to the left of the double colon: 'Left a -The logic resides in extractHsTyRdrTyVarsKindVars. We use it both for type -synonyms and type family instances. +The logic resides in extractHsTyRdrTyVarsKindVars. This is something of a stopgap solution until we can explicitly bind invisible type/kind variables: ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -634,14 +634,10 @@ rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds rnFamEqn :: HsDocContext -> AssocTyFamInfo - -> FreeKiTyVars - -- ^ Additional kind variables to implicitly bind if there is no - -- explicit forall. (See the comments on @all_imp_vars@ below for a - -- more detailed explanation.) -> FamEqn GhcPs rhs -> (HsDocContext -> rhs -> RnM (rhs', FreeVars)) -> RnM (FamEqn GhcRn rhs', FreeVars) -rnFamEqn doc atfi extra_kvars +rnFamEqn doc atfi (FamEqn { feqn_tycon = tycon , feqn_bndrs = outer_bndrs , feqn_pats = pats @@ -652,19 +648,8 @@ rnFamEqn doc atfi extra_kvars -- all_imp_vars represent the implicitly bound type variables. This is -- empty if we have an explicit `forall` (see -- Note [forall-or-nothing rule] in GHC.Hs.Type), which means - -- ignoring: - -- - -- - pat_kity_vars, the free variables mentioned in the type patterns - -- on the LHS of the equation, and - -- - extra_kvars, which is one of the following: - -- * For type family instances, extra_kvars are the free kind - -- variables mentioned in an outermost kind signature on the RHS - -- of the equation. - -- (See Note [Implicit quantification in type synonyms] in - -- GHC.Rename.HsType.) - -- * For data family instances, extra_kvars are the free kind - -- variables mentioned in the explicit return kind, if one is - -- provided. (e.g., the `k` in `data instance T :: k -> Type`). + -- ignoring pat_kity_vars, the free variables mentioned in the type patterns + -- on the LHS of the equation -- -- Some examples: -- @@ -678,8 +663,6 @@ rnFamEqn doc atfi extra_kvars -- type family G :: Maybe a -- type instance forall a. G = (Nothing :: Maybe a) -- -- all_imp_vars = [] - -- type instance G = (Nothing :: Maybe a) - -- -- all_imp_vars = [a] -- -- data family H :: k -> Type -- data instance forall k. H :: k -> Type where ... @@ -690,7 +673,7 @@ rnFamEqn doc atfi extra_kvars -- -- For associated type family instances, exclude the type variables -- bound by the instance head with filterInScopeM (#19649). - ; all_imp_vars <- filterInScopeM $ pat_kity_vars ++ extra_kvars + ; all_imp_vars <- filterInScopeM $ pat_kity_vars ; bindHsOuterTyVarBndrs doc mb_cls all_imp_vars outer_bndrs $ \rn_outer_bndrs -> do { (pats', pat_fvs) <- rnLHsTypeArgs (FamPatCtx tycon) pats @@ -727,21 +710,12 @@ rnFamEqn doc atfi extra_kvars -- associated family instance but not bound on the LHS, then reject -- that type variable as being out of scope. -- See Note [Renaming associated types]. - -- Per that Note, the LHS type variables consist of: - -- - -- - The variables mentioned in the instance's type patterns - -- (pat_fvs), and - -- - -- - The variables mentioned in an outermost kind signature on the - -- RHS. This is a subset of `rhs_fvs`. To compute it, we look up - -- each RdrName in `extra_kvars` to find its corresponding Name in - -- the LocalRdrEnv. - ; extra_kvar_nms <- mapMaybeM (lookupLocalOccRn_maybe . unLoc) extra_kvars - ; let lhs_bound_vars = pat_fvs `extendNameSetList` extra_kvar_nms - improperly_scoped cls_tkv = + -- Per that Note, the LHS type variables consist of the variables + -- mentioned in the instance's type patterns (pat_fvs) + ; let improperly_scoped cls_tkv = cls_tkv `elemNameSet` rhs_fvs -- Mentioned on the RHS... - && not (cls_tkv `elemNameSet` lhs_bound_vars) + && not (cls_tkv `elemNameSet` pat_fvs) -- ...but not bound on the LHS. bad_tvs = filter improperly_scoped inst_head_tvs ; unless (null bad_tvs) (addErr (TcRnBadAssocRhs bad_tvs)) @@ -786,7 +760,7 @@ rnFamEqn doc atfi extra_kvars -- -- type instance F a b c = Either a b -- ^^^^^ - lhs_loc = case map lhsTypeArgSrcSpan pats ++ map getLocA extra_kvars of + lhs_loc = case map lhsTypeArgSrcSpan pats of [] -> panic "rnFamEqn.lhs_loc" [loc] -> loc (loc:locs) -> loc `combineSrcSpans` last locs @@ -845,10 +819,9 @@ data ClosedTyFamInfo rnTyFamInstEqn :: AssocTyFamInfo -> TyFamInstEqn GhcPs -> RnM (TyFamInstEqn GhcRn, FreeVars) -rnTyFamInstEqn atfi eqn@(FamEqn { feqn_tycon = tycon, feqn_rhs = rhs }) - = rnFamEqn (TySynCtx tycon) atfi extra_kvs eqn rnTySyn - where - extra_kvs = extractHsTyRdrTyVarsKindVars rhs +rnTyFamInstEqn atfi eqn@(FamEqn { feqn_tycon = tycon }) + = rnFamEqn (TySynCtx tycon) atfi eqn rnTySyn + rnTyFamDefltDecl :: Name -> TyFamDefltDecl GhcPs @@ -859,11 +832,9 @@ rnDataFamInstDecl :: AssocTyFamInfo -> DataFamInstDecl GhcPs -> RnM (DataFamInstDecl GhcRn, FreeVars) rnDataFamInstDecl atfi (DataFamInstDecl { dfid_eqn = - eqn@(FamEqn { feqn_tycon = tycon - , feqn_rhs = rhs })}) - = do { let extra_kvs = extractDataDefnKindVars rhs - ; (eqn', fvs) <- - rnFamEqn (TyDataCtx tycon) atfi extra_kvs eqn rnDataDefn + eqn@(FamEqn { feqn_tycon = tycon })}) + = do { (eqn', fvs) <- + rnFamEqn (TyDataCtx tycon) atfi eqn rnDataDefn ; return (DataFamInstDecl { dfid_eqn = eqn' }, fvs) } -- Renaming of the associated types in instances. @@ -949,10 +920,7 @@ a class, we must check that all of the type variables mentioned on the RHS are properly scoped. Specifically, the rule is this: Every variable mentioned on the RHS of a type instance declaration - (whether associated or not) must be either - * Mentioned on the LHS, or - * Mentioned in an outermost kind signature on the RHS - (see Note [Implicit quantification in type synonyms]) + (whether associated or not) must be mentioned on the LHS Here is a simple example of something we should reject: @@ -962,8 +930,7 @@ Here is a simple example of something we should reject: type F Int x = z Here, `z` is mentioned on the RHS of the associated instance without being -mentioned on the LHS, nor is `z` mentioned in an outermost kind signature. The -renamer will reject `z` as being out of scope without much fuss. +mentioned on the LHS. The renamer will reject `z` as being out of scope without much fuss. Things get slightly trickier when the instance header itself binds type variables. Consider this example (adapted from #5515): @@ -1055,10 +1022,8 @@ Some additional wrinkles: Note that the `o` in the `Codomain 'KProxy` instance should be considered improperly scoped. It does not meet the criteria for being explicitly - quantified, as it is not mentioned by name on the LHS, nor does it meet the - criteria for being implicitly quantified, as it is used in a RHS kind - signature that is not outermost (see Note [Implicit quantification in type - synonyms]). However, `o` /is/ bound by the instance header, so if this + quantified, as it is not mentioned by name on the LHS. + However, `o` /is/ bound by the instance header, so if this program is not rejected by the renamer, the typechecker would treat it as though you had written this: @@ -1070,6 +1035,12 @@ Some additional wrinkles: If the user really wants the latter, it is simple enough to communicate their intent by mentioning `o` on the LHS by name. +* Historical note: Previously we had to add type variables from the outermost + kind signature on the RHS to the scope of associated type family instance, + i.e. GHC did implicit quantification over them. But now that we implement + GHC Proposal #425 "Invisible binders in type declarations" + we don't need to do this anymore. + Note [Type family equations and occurrences] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In most data/type family equations, the type family name used in the equation ===================================== testsuite/tests/indexed-types/should_compile/T14131.hs ===================================== @@ -9,21 +9,21 @@ import Data.Kind import Data.Proxy data family Nat :: k -> k -> Type -newtype instance Nat :: (k -> Type) -> (k -> Type) -> Type where +newtype instance Nat :: forall k . (k -> Type) -> (k -> Type) -> Type where Nat :: (forall xx. f xx -> g xx) -> Nat f g type family F :: Maybe a -type instance F = (Nothing :: Maybe a) +type instance F @a = (Nothing :: Maybe a) class C k where data CD :: k -> k -> Type type CT :: k instance C (Maybe a) where - data CD :: Maybe a -> Maybe a -> Type where + data CD @(Maybe a) :: Maybe a -> Maybe a -> Type where CD :: forall a (m :: Maybe a) (n :: Maybe a). Proxy m -> Proxy n -> CD m n - type CT = (Nothing :: Maybe a) + type CT @(Maybe a) = (Nothing :: Maybe a) class Z k where type ZT :: Maybe k - type ZT = (Nothing :: Maybe k) + type ZT @k = (Nothing :: Maybe k) ===================================== testsuite/tests/indexed-types/should_compile/T15852.hs ===================================== @@ -7,4 +7,4 @@ import Data.Kind import Data.Proxy data family DF a (b :: k) -data instance DF (Proxy c) :: Proxy j -> Type +data instance DF @(Proxy j) (Proxy c) :: Proxy j -> Type ===================================== testsuite/tests/indexed-types/should_compile/T15852.stderr ===================================== @@ -3,10 +3,10 @@ TYPE CONSTRUCTORS roles nominal nominal nominal COERCION AXIOMS axiom T15852.D:R:DFProxyProxy0 :: - forall k1 k2 (c :: k1) (j :: k2). - DF (Proxy c) = T15852.R:DFProxyProxy k1 k2 c j + forall k1 k2 (j :: k1) (c :: k2). + DF (Proxy c) = T15852.R:DFProxyProxy k1 k2 j c FAMILY INSTANCES - data instance forall {k1} {k2} {c :: k1} {j :: k2}. + data instance forall {k1} {k2} {j :: k1} {c :: k2}. DF (Proxy c) -- Defined at T15852.hs:10:15 Dependent modules: [] -Dependent packages: [base-4.17.0.0] +Dependent packages: [base-4.18.0.0] ===================================== testsuite/tests/indexed-types/should_fail/T14230.hs ===================================== @@ -8,4 +8,4 @@ class C k where data CD :: k -> k -> * instance C (Maybe a) where - data CD :: (k -> *) -> (k -> *) -> * + data forall k . CD :: (k -> *) -> (k -> *) -> * ===================================== testsuite/tests/indexed-types/should_fail/T7938.hs ===================================== @@ -9,4 +9,4 @@ class Foo (a :: k1) (b :: k2) where type Bar a instance Foo (a :: k1) (b :: k2) where - type Bar a = (KP :: KProxy k2) + type forall k2 . Bar a = (KP :: KProxy k2) ===================================== testsuite/tests/indexed-types/should_fail/T7938.stderr ===================================== @@ -1,5 +1,5 @@ -T7938.hs:12:17: error: [GHC-83865] +T7938.hs:12:29: error: [GHC-83865] • Expected a type, but ‘KP :: KProxy k2’ has kind ‘KProxy k2’ • In the type ‘(KP :: KProxy k2)’ In the type instance declaration for ‘Bar’ ===================================== testsuite/tests/rename/should_compile/T23512b.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies, TypeAbstractions #-} +module T23512b where +import GHC.Types + +type family F2 a :: k +type instance F2 @(j -> j) Int = Any :: j -> j + +type family F3 a :: k +type instance forall j. F3 Int = Any :: j -> j ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -212,3 +212,4 @@ test('T22122', [expect_broken(22122), extra_files(['T22122_aux.hs'])], multimod_ test('T23240', [req_th, extra_files(['T23240_aux.hs'])], multimod_compile, ['T23240', '-v0']) test('T23318', normal, compile, ['-Wduplicate-exports']) test('T23434', normal, compile, ['']) +test('T23512b', normal, compile, ['']) ===================================== testsuite/tests/rename/should_fail/T23512a.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies #-} +module T23512a where +import GHC.Types + +type family F1 a :: k +type instance F1 Int = Any :: j -> j + +data family D :: k -> Type +data instance D :: k -> Type ===================================== testsuite/tests/rename/should_fail/T23512a.stderr ===================================== @@ -0,0 +1,6 @@ + +T23512a.hs:6:31: error: [GHC-76037] Not in scope: type variable ‘j’ + +T23512a.hs:6:36: error: [GHC-76037] Not in scope: type variable ‘j’ + +T23512a.hs:9:20: error: [GHC-76037] Not in scope: type variable ‘k’ ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -198,3 +198,4 @@ test('RnUnexpectedStandaloneDeriving', normal, compile_fail, ['']) test('RnStupidThetaInGadt', normal, compile_fail, ['']) test('PackageImportsDisabled', normal, compile_fail, ['']) test('ImportLookupIllegal', normal, compile_fail, ['']) +test('T23512a', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/T15797.hs ===================================== @@ -13,7 +13,7 @@ import Data.Kind class Ríki (obj :: Type) where type Obj :: obj -> Constraint - type Obj = Bæ @k :: k -> Constraint + type forall k . Obj = Bæ @k :: k -> Constraint class Bæ (a :: k) instance Bæ @k (a :: k) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/95cc703e035bf9562c01853d29418be35d26d2f5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/95cc703e035bf9562c01853d29418be35d26d2f5 You're receiving 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 Jun 13 20:20:45 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Tue, 13 Jun 2023 16:20:45 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/int-index/caneqnc-deep-forall Message-ID: <6488cf9d5290e_17653dc596879322@gitlab.mail> Vladislav Zavialov pushed new branch wip/int-index/caneqnc-deep-forall at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/int-index/caneqnc-deep-forall You're receiving 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 Jun 14 01:07:15 2023 From: gitlab at gitlab.haskell.org (=?UTF-8?B?R2VyZ8WRIMOJcmRpIChAY2FjdHVzKQ==?=) Date: Tue, 13 Jun 2023 21:07:15 -0400 Subject: [Git][ghc/ghc][wip/issue-23516] Add `IfaceWarnings` to represent the `ModIface`-storable parts Message-ID: <648912c3b2d76_17653d10c98f098713@gitlab.mail> Gergő Érdi pushed to branch wip/issue-23516 at Glasgow Haskell Compiler / GHC Commits: e60e57d5 by Gergő Érdi at 2023-06-14T02:07:03+01:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 8 changed files: - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Types/SourceText.hs - compiler/GHC/Unit/Module/ModIface.hs - compiler/GHC/Unit/Module/Warnings.hs Changes: ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -102,7 +102,6 @@ import GHC.Types.PkgQual import GHC.Unit.External import GHC.Unit.Module -import GHC.Unit.Module.Warnings import GHC.Unit.Module.ModIface import GHC.Unit.Module.Deps import GHC.Unit.State @@ -1206,16 +1205,6 @@ pprTrustInfo trust = text "trusted:" <+> ppr trust pprTrustPkg :: Bool -> SDoc pprTrustPkg tpkg = text "require own pkg trusted:" <+> ppr tpkg -instance Outputable (Warnings pass) where - ppr = pprWarns - -pprWarns :: Warnings pass -> SDoc -pprWarns NoWarnings = Outputable.empty -pprWarns (WarnAll txt) = text "Warn all" <+> ppr txt -pprWarns (WarnSome prs) = text "Warnings:" - <+> vcat (map pprWarning prs) - where pprWarning (name, txt) = ppr name <+> ppr txt - pprIfaceAnnotation :: IfaceAnnotation -> SDoc pprIfaceAnnotation (IfaceAnnotation { ifAnnotatedTarget = target, ifAnnotatedValue = serialized }) = ppr target <+> text "annotated by" <+> ppr serialized ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -66,6 +66,8 @@ import GHC.Types.SourceFile import GHC.Types.TyThing import GHC.Types.HpcInfo import GHC.Types.CompleteMatch +import GHC.Types.SourceText +import GHC.Types.SrcLoc ( unLoc ) import GHC.Utils.Outputable import GHC.Utils.Panic @@ -291,7 +293,7 @@ mkIface_ hsc_env -- The order of fixities returned from nonDetNameEnvElts is not -- deterministic, so we sort by OccName to canonicalize it. -- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM for more details. - warns = src_warns + warns = toIfaceWarnings src_warns iface_rules = map coreRuleToIfaceRule rules iface_insts = map instanceToIfaceInst $ fixSafeInstances safe_mode (instEnvElts insts) iface_fam_insts = map famInstToIfaceFamInst fam_insts @@ -393,6 +395,21 @@ ifaceRoughMatchTcs tcs = map do_rough tcs do_rough (RM_KnownTc n) = Just (toIfaceTyCon_name n) -------------------------- +toIfaceWarnings :: Warnings GhcRn -> IfaceWarnings +toIfaceWarnings NoWarnings = IfNoWarnings +toIfaceWarnings (WarnAll txt) = IfWarnAll (toIfaceWarningTxt txt) +toIfaceWarnings (WarnSome prs) = IfWarnSome [(occ, toIfaceWarningTxt txt) | (occ, txt) <- prs] + +toIfaceWarningTxt :: WarningTxt GhcRn -> IfaceWarningTxt +toIfaceWarningTxt (WarningTxt mb_cat src strs) = IfWarningTxt (unLoc <$> mb_cat) (unLoc src) (map (toIfaceStringLiteralWithNames . unLoc) strs) +toIfaceWarningTxt (DeprecatedTxt src strs) = IfDeprecatedTxt (unLoc src) (map (toIfaceStringLiteralWithNames . unLoc) strs) + +toIfaceStringLiteralWithNames :: WithHsDocIdentifiers StringLiteral GhcRn -> (IfaceStringLiteral, [IfExtName]) +toIfaceStringLiteralWithNames (WithHsDocIdentifiers src names) = (toIfaceStringLiteral src, map unLoc names) + +toIfaceStringLiteral :: StringLiteral -> IfaceStringLiteral +toIfaceStringLiteral (StringLiteral sl fs _) = IfStringLiteral sl fs + coreRuleToIfaceRule :: CoreRule -> IfaceRule -- A plugin that installs a BuiltinRule in a CoreDoPluginPass should -- ensure that there's another CoreDoPluginPass that removes the rule. ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -962,7 +962,7 @@ addFingerprints hsc_env iface0 eps <- hscEPS hsc_env let decls = mi_decls iface0 - warn_fn = mkIfaceWarnCache (mi_warns iface0) + warn_fn = mkIfaceWarnCache (fromIfaceWarnings $ mi_warns iface0) fix_fn = mkIfaceFixCache (mi_fixities iface0) -- The ABI of a declaration represents everything that is made ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -16,6 +16,7 @@ module GHC.Iface.Syntax ( IfaceBindingX(..), IfaceMaybeRhs(..), IfaceConAlt(..), IfaceIdInfo, IfaceIdDetails(..), IfaceUnfolding(..), IfGuidance(..), IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget, + IfaceWarnings(..), IfaceWarningTxt(..), IfaceStringLiteral(..), IfaceClsInst(..), IfaceFamInst(..), IfaceTickish(..), IfaceClassBody(..), IfaceBang(..), @@ -32,6 +33,7 @@ module GHC.Iface.Syntax ( -- Misc ifaceDeclImplicitBndrs, visibleIfConDecls, ifaceDeclFingerprints, + fromIfaceWarnings, -- Free Names freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst, @@ -65,13 +67,17 @@ import GHC.Types.ForeignCall import GHC.Types.Annotations( AnnPayload, AnnTarget ) import GHC.Types.Basic import GHC.Unit.Module +import GHC.Unit.Module.Warnings import GHC.Types.SrcLoc +import GHC.Types.SourceText import GHC.Data.BooleanFormula ( BooleanFormula, pprBooleanFormula, isTrue ) import GHC.Types.Var( VarBndr(..), binderVar, tyVarSpecToBinders, visArgTypeLike ) import GHC.Core.TyCon ( Role (..), Injectivity(..), tyConBndrVisForAllTyFlag ) import GHC.Core.DataCon (SrcStrictness(..), SrcUnpackedness(..)) import GHC.Builtin.Types ( constraintKindTyConName ) import GHC.Stg.InferTags.TagSig +import GHC.Hs.Extension ( GhcRn ) +import GHC.Hs.Doc ( WithHsDocIdentifiers(..) ) import GHC.Utils.Lexeme (isLexSym) import GHC.Utils.Fingerprint @@ -323,6 +329,18 @@ data IfaceRule ifRuleOrph :: IsOrphan -- Just like IfaceClsInst } +data IfaceWarnings + = IfNoWarnings + | IfWarnAll IfaceWarningTxt + | IfWarnSome [(OccName, IfaceWarningTxt)] + +data IfaceWarningTxt + = IfWarningTxt (Maybe WarningCategory) SourceText [(IfaceStringLiteral, [IfExtName])] + | IfDeprecatedTxt SourceText [(IfaceStringLiteral, [IfExtName])] + +data IfaceStringLiteral + = IfStringLiteral SourceText FastString + data IfaceAnnotation = IfaceAnnotation { ifAnnotatedTarget :: IfaceAnnTarget, @@ -549,6 +567,24 @@ ifaceDeclFingerprints hash decl unsafeDupablePerformIO . computeFingerprint (panic "ifaceDeclFingerprints") +fromIfaceWarnings :: IfaceWarnings -> Warnings GhcRn +fromIfaceWarnings = \case + IfNoWarnings -> NoWarnings + IfWarnAll txt -> WarnAll (fromIfaceWarningTxt txt) + IfWarnSome prs -> WarnSome [(occ, fromIfaceWarningTxt txt) | (occ, txt) <- prs] + +fromIfaceWarningTxt :: IfaceWarningTxt -> WarningTxt GhcRn +fromIfaceWarningTxt = \case + IfWarningTxt mb_cat src strs -> WarningTxt (noLoc <$> mb_cat) (noLoc src) (noLoc <$> map fromIfaceStringLiteralWithNames strs) + IfDeprecatedTxt src strs -> DeprecatedTxt (noLoc src) (noLoc <$> map fromIfaceStringLiteralWithNames strs) + +fromIfaceStringLiteralWithNames :: (IfaceStringLiteral, [IfExtName]) -> WithHsDocIdentifiers StringLiteral GhcRn +fromIfaceStringLiteralWithNames (str, names) = WithHsDocIdentifiers (fromIfaceStringLiteral str) (map noLoc names) + +fromIfaceStringLiteral :: IfaceStringLiteral -> StringLiteral +fromIfaceStringLiteral (IfStringLiteral st fs) = StringLiteral st fs Nothing + + {- ************************************************************************ * * @@ -700,6 +736,23 @@ pprAxBranch pp_tc idx (IfaceAxBranch { ifaxbTyVars = tvs text "--" <+> text "incompatible with:" <+> pprWithCommas (\incomp -> text "#" <> ppr incomp) incomps +instance Outputable IfaceWarnings where + ppr = \case + IfNoWarnings -> empty + IfWarnAll txt -> text "Warn all" <+> ppr txt + IfWarnSome prs -> text "Warnings:" <+> vcat [ppr name <+> ppr txt | (name, txt) <- prs] + +instance Outputable IfaceWarningTxt where + ppr = \case + IfWarningTxt _ _ ws -> pp_ws ws + IfDeprecatedTxt _ ds -> pp_ws ds + where + pp_ws [msg] = ppr (snd msg) + pp_ws msgs = brackets $ vcat . punctuate comma . map (ppr . snd) $ msgs + +instance Outputable IfaceStringLiteral where + ppr (IfStringLiteral st fs) = pprWithSourceText st (ftext fs) + instance Outputable IfaceAnnotation where ppr (IfaceAnnotation target value) = ppr target <+> colon <+> ppr value @@ -2236,6 +2289,28 @@ instance Binary IfaceRule where a8 <- get bh return (IfaceRule a1 a2 a3 a4 a5 a6 a7 a8) +instance Binary IfaceWarnings where + put_ bh = \case + IfNoWarnings -> putByte bh 0 + IfWarnAll txt -> putByte bh 1 *> put_ bh txt + IfWarnSome prs -> putByte bh 2 *> put_ bh prs + get bh = getByte bh >>= \case + 0 -> pure IfNoWarnings + 1 -> pure IfWarnAll <*> get bh + _ -> pure IfWarnSome <*> get bh + +instance Binary IfaceWarningTxt where + put_ bh = \case + IfWarningTxt a1 a2 a3 -> putByte bh 0 *> put_ bh a1 *> put_ bh a2 *> put_ bh a3 + IfDeprecatedTxt a1 a2 -> putByte bh 1 *> put_ bh a1 *> put_ bh a2 + get bh = getByte bh >>= \case + 0 -> pure IfWarningTxt <*> get bh <*> get bh <*> get bh + _ -> pure IfDeprecatedTxt <*> get bh <*> get bh + +instance Binary IfaceStringLiteral where + put_ bh (IfStringLiteral a1 a2) = put_ bh a1 *> put_ bh a2 + get bh = IfStringLiteral <$> get bh <*> get bh + instance Binary IfaceAnnotation where put_ bh (IfaceAnnotation a1 a2) = do put_ bh a1 @@ -2786,5 +2861,19 @@ instance NFData IfaceClsInst where rnf (IfaceClsInst f1 f2 f3 f4 f5) = f1 `seq` rnf f2 `seq` rnf f3 `seq` f4 `seq` f5 `seq` () +instance NFData IfaceWarnings where + rnf = \case + IfNoWarnings -> () + IfWarnAll txt -> rnf txt + IfWarnSome txts -> rnf txts + +instance NFData IfaceWarningTxt where + rnf = \case + IfWarningTxt f1 f2 f3 -> rnf f1 `seq` rnf f2 `seq` rnf f3 + IfDeprecatedTxt f1 f2 -> rnf f1 `seq` rnf f2 + +instance NFData IfaceStringLiteral where + rnf (IfStringLiteral f1 f2) = rnf f1 `seq` rnf f2 + instance NFData IfaceAnnotation where rnf (IfaceAnnotation f1 f2) = f1 `seq` f2 `seq` () ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -47,6 +47,7 @@ import GHC.Tc.Zonk.TcType ( tcInitTidyEnv ) import GHC.Hs import GHC.Iface.Load ( loadSrcInterface ) +import GHC.Iface.Syntax ( fromIfaceWarnings ) import GHC.Builtin.Names import GHC.Parser.PostProcess ( setRdrNameSpace ) import GHC.Core.Type @@ -422,7 +423,7 @@ rnImportDecl this_mod imports = calculateAvails home_unit other_home_units iface mod_safe' want_boot (ImportedByUser imv) -- Complain if we import a deprecated module - case mi_warns iface of + case fromIfaceWarnings (mi_warns iface) of WarnAll txt -> addDiagnostic (TcRnDeprecatedModule imp_mod_name txt) _ -> return () ===================================== compiler/GHC/Types/SourceText.hs ===================================== @@ -1,5 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RecordWildCards #-} -- | Source text -- @@ -39,6 +41,7 @@ import Data.Function (on) import Data.Data import GHC.Real ( Ratio(..) ) import GHC.Types.SrcLoc +import Control.DeepSeq {- Note [Pragma source text] @@ -107,6 +110,11 @@ instance Outputable SourceText where ppr (SourceText s) = text "SourceText" <+> ftext s ppr NoSourceText = text "NoSourceText" +instance NFData SourceText where + rnf = \case + SourceText s -> rnf s + NoSourceText -> () + instance Binary SourceText where put_ bh NoSourceText = putByte bh 0 put_ bh (SourceText s) = do @@ -315,12 +323,3 @@ instance Eq StringLiteral where instance Outputable StringLiteral where ppr sl = pprWithSourceText (sl_st sl) (ftext $ sl_fs sl) - -instance Binary StringLiteral where - put_ bh (StringLiteral st fs _) = do - put_ bh st - put_ bh fs - get bh = do - st <- get bh - fs <- get bh - return (StringLiteral st fs Nothing) ===================================== compiler/GHC/Unit/Module/ModIface.hs ===================================== @@ -185,7 +185,7 @@ data ModIface_ (phase :: ModIfacePhase) -- ^ Fixities -- NOT STRICT! we read this field lazily from the interface file - mi_warns :: (Warnings GhcRn), + mi_warns :: IfaceWarnings, -- ^ Warnings -- NOT STRICT! we read this field lazily from the interface file @@ -479,7 +479,7 @@ instance Binary ModIface where mi_finsts = hasFamInsts, mi_exp_hash = exp_hash, mi_orphan_hash = orphan_hash, - mi_warn_fn = mkIfaceWarnCache warns, + mi_warn_fn = mkIfaceWarnCache $ fromIfaceWarnings warns, mi_fix_fn = mkIfaceFixCache fixities, mi_hash_fn = mkIfaceHashCache decls }}) @@ -498,7 +498,7 @@ emptyPartialModIface mod mi_exports = [], mi_used_th = False, mi_fixities = [], - mi_warns = NoWarnings, + mi_warns = IfNoWarnings, mi_anns = [], mi_insts = [], mi_fam_insts = [], @@ -567,7 +567,7 @@ instance ( NFData (IfaceBackendExts (phase :: ModIfacePhase)) `seq` mi_exports `seq` rnf mi_used_th `seq` mi_fixities - `seq` mi_warns + `seq` rnf mi_warns `seq` rnf mi_anns `seq` rnf mi_decls `seq` rnf mi_extra_decls ===================================== compiler/GHC/Unit/Module/Warnings.hs ===================================== @@ -5,6 +5,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE LambdaCase #-} -- | Warnings for a module module GHC.Unit.Module.Warnings @@ -40,7 +41,6 @@ import GHC.Types.SrcLoc import GHC.Types.Unique import GHC.Types.Unique.Set import GHC.Hs.Doc -import GHC.Hs.Extension import GHC.Utils.Outputable import GHC.Utils.Binary @@ -51,6 +51,7 @@ import Language.Haskell.Syntax.Extension import Data.Data import Data.List (isPrefixOf) import GHC.Generics ( Generic ) +import Control.DeepSeq {- @@ -103,7 +104,7 @@ the possibility of them being infinite. -- See Note [Warning categories] newtype WarningCategory = WarningCategory FastString - deriving (Binary, Data, Eq, Outputable, Show, Uniquable) + deriving (Binary, Data, Eq, Outputable, Show, Uniquable, NFData) mkWarningCategory :: FastString -> WarningCategory mkWarningCategory = WarningCategory @@ -203,29 +204,6 @@ instance Outputable (WarningTxt pass) where NoSourceText -> pp_ws ds SourceText src -> ftext src <+> pp_ws ds <+> text "#-}" -instance Binary (WarningTxt GhcRn) where - put_ bh (WarningTxt c s w) = do - putByte bh 0 - put_ bh $ unLoc <$> c - put_ bh $ unLoc s - put_ bh $ unLoc <$> w - put_ bh (DeprecatedTxt s d) = do - putByte bh 1 - put_ bh $ unLoc s - put_ bh $ unLoc <$> d - - get bh = do - h <- getByte bh - case h of - 0 -> do c <- fmap noLoc <$> get bh - s <- noLoc <$> get bh - w <- fmap noLoc <$> get bh - return (WarningTxt c s w) - _ -> do s <- noLoc <$> get bh - d <- fmap noLoc <$> get bh - return (DeprecatedTxt s d) - - pp_ws :: [Located (WithHsDocIdentifiers StringLiteral pass)] -> SDoc pp_ws [l] = ppr $ unLoc l pp_ws ws @@ -271,24 +249,6 @@ data Warnings pass deriving instance Eq (IdP pass) => Eq (Warnings pass) -instance Binary (Warnings GhcRn) where - put_ bh NoWarnings = putByte bh 0 - put_ bh (WarnAll t) = do - putByte bh 1 - put_ bh t - put_ bh (WarnSome ts) = do - putByte bh 2 - put_ bh ts - - get bh = do - h <- getByte bh - case h of - 0 -> return NoWarnings - 1 -> do aa <- get bh - return (WarnAll aa) - _ -> do aa <- get bh - return (WarnSome aa) - -- | Constructs the cache for the 'mi_warn_fn' field of a 'ModIface' mkIfaceWarnCache :: Warnings p -> OccName -> Maybe (WarningTxt p) mkIfaceWarnCache NoWarnings = \_ -> Nothing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e60e57d5e3e2979fc91edd2c9bc62c41b4311041 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e60e57d5e3e2979fc91edd2c9bc62c41b4311041 You're receiving 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 Jun 14 03:41:20 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 13 Jun 2023 23:41:20 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: Add -Wmissing-poly-kind-signatures Message-ID: <648936e0626b1_17653dc59681057c@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: fd9858df by Oleg Grenrus at 2023-06-13T23:40:42-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - 06ac8c3f by doyougnu at 2023-06-13T23:40:56-04:00 ci: special case in req_host_target_ghc for JS - - - - - bf8fa982 by Gergo ERDI at 2023-06-13T23:41:01-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - ec0983c6 by Krzysztof Gogolewski at 2023-06-13T23:41:02-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - 5830b128 by Krzysztof Gogolewski at 2023-06-13T23:41:02-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - cbab72d6 by Matthew Pickering at 2023-06-13T23:41:03-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - c1a09b6a by Vladislav Zavialov at 2023-06-13T23:41:03-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - 8b5202ab by Tom Ellis at 2023-06-13T23:41:05-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 79870853 by Tom Ellis at 2023-06-13T23:41:05-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 28 changed files: - .gitlab-ci.yml - compiler/GHC/Core/Type.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Monad.hs - docs/users_guide/using-warnings.rst - libraries/base/GHC/TypeLits/Internal.hs - libraries/base/GHC/TypeNats/Internal.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - testsuite/driver/testlib.py - testsuite/tests/polykinds/T22743.stderr - + testsuite/tests/rep-poly/T23176.hs - + testsuite/tests/rep-poly/T23176.stderr - testsuite/tests/rep-poly/all.T - testsuite/tests/typecheck/should_fail/T23427.hs - testsuite/tests/typecheck/should_fail/T23427.stderr - + testsuite/tests/warnings/should_compile/T22826.hs - + testsuite/tests/warnings/should_compile/T22826.stderr - testsuite/tests/warnings/should_compile/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -718,6 +718,12 @@ hackage-lint: - job: nightly-x86_64-linux-deb10-numa-slow-validate optional: true artifacts: false + - job: nightly-aarch64-linux-deb10-validate + optional: true + artifacts: false + - job: aarch64-linux-deb10-validate + optional: true + artifacts: false extends: .hackage variables: SLOW_VALIDATE: 1 @@ -733,6 +739,9 @@ hackage-label-lint: - job: x86_64-linux-deb10-numa-slow-validate optional: true artifacts: false + - job: aarch64-linux-deb10-validate + optional: true + artifacts: false extends: .hackage variables: SLOW_VALIDATE: 1 @@ -747,6 +756,9 @@ nightly-hackage-lint: - job: nightly-x86_64-linux-deb10-numa-slow-validate optional: true artifacts: false + - job: nightly-aarch64-linux-deb10-validate + optional: true + artifacts: false rules: - if: $NIGHTLY variables: @@ -761,6 +773,9 @@ nightly-hackage-perf: - job: nightly-x86_64-linux-fedora33-release optional: true artifacts: false + - job: nightly-aarch64-linux-deb10-validate + optional: true + artifacts: false rules: - if: $NIGHTLY variables: @@ -777,6 +792,9 @@ release-hackage-lint: - job: release-x86_64-linux-fedora33-release optional: true artifacts: false + - job: release-aarch64-linux-deb10-release+no_split_sections + optional: true + artifacts: false rules: - if: '$RELEASE_JOB == "yes"' extends: .hackage ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -111,6 +111,7 @@ module GHC.Core.Type ( isTyVarTy, isFunTy, isCoercionTy, isCoercionTy_maybe, isForAllTy, isForAllTy_ty, isForAllTy_co, + isForAllTy_invis_ty, isPiTy, isTauTy, isFamFreeTy, isCoVarType, isAtomicTy, @@ -1891,6 +1892,15 @@ isForAllTy_ty ty | otherwise = False +-- | Like `isForAllTy`, but returns True only if it is an inferred tyvar binder +isForAllTy_invis_ty :: Type -> Bool +isForAllTy_invis_ty ty + | ForAllTy (Bndr tv (Invisible InferredSpec)) _ <- coreFullView ty + , isTyVar tv + = True + + | otherwise = False + -- | Like `isForAllTy`, but returns True only if it is a covar binder isForAllTy_co :: Type -> Bool isForAllTy_co ty ===================================== compiler/GHC/Data/BooleanFormula.hs ===================================== @@ -24,8 +24,7 @@ import Data.Data import GHC.Utils.Monad import GHC.Utils.Outputable -import GHC.Utils.Binary -import GHC.Parser.Annotation ( LocatedL, noLocA ) +import GHC.Parser.Annotation ( LocatedL ) import GHC.Types.SrcLoc import GHC.Types.Unique import GHC.Types.Unique.Set @@ -243,22 +242,3 @@ pprBooleanFormulaNormal = go go (Or []) = keyword $ text "FALSE" go (Or xs) = fsep $ intersperse vbar (map (go . unLoc) xs) go (Parens x) = parens (go $ unLoc x) - - ----------------------------------------------------------------------- --- Binary ----------------------------------------------------------------------- - -instance Binary a => Binary (BooleanFormula a) where - put_ bh (Var x) = putByte bh 0 >> put_ bh x - put_ bh (And xs) = putByte bh 1 >> put_ bh (unLoc <$> xs) - put_ bh (Or xs) = putByte bh 2 >> put_ bh (unLoc <$> xs) - put_ bh (Parens x) = putByte bh 3 >> put_ bh (unLoc x) - - get bh = do - h <- getByte bh - case h of - 0 -> Var <$> get bh - 1 -> And . fmap noLocA <$> get bh - 2 -> Or . fmap noLocA <$> get bh - _ -> Parens . noLocA <$> get bh ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -631,6 +631,7 @@ data WarningFlag = | Opt_WarnAmbiguousFields -- Since 9.2 | Opt_WarnImplicitLift -- Since 9.2 | Opt_WarnMissingKindSignatures -- Since 9.2 + | Opt_WarnMissingPolyKindSignatures -- Since 9.8 | Opt_WarnMissingExportedPatternSynonymSignatures -- since 9.2 | Opt_WarnRedundantStrictnessFlags -- Since 9.4 | Opt_WarnForallIdentifier -- Since 9.4 @@ -685,6 +686,7 @@ warnFlagNames wflag = case wflag of Opt_WarnSemigroup -> "semigroup" :| [] Opt_WarnMissingSignatures -> "missing-signatures" :| [] Opt_WarnMissingKindSignatures -> "missing-kind-signatures" :| [] + Opt_WarnMissingPolyKindSignatures -> "missing-poly-kind-signatures" :| [] Opt_WarnMissingExportedSignatures -> "missing-exported-signatures" :| [] Opt_WarnMonomorphism -> "monomorphism-restriction" :| [] Opt_WarnNameShadowing -> "name-shadowing" :| [] ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2192,6 +2192,7 @@ wWarningFlagsDeps = mconcat [ warnSpec Opt_WarnSemigroup, warnSpec Opt_WarnMissingSignatures, warnSpec Opt_WarnMissingKindSignatures, + warnSpec Opt_WarnMissingPolyKindSignatures, subWarnSpec "missing-exported-sigs" Opt_WarnMissingExportedSignatures "it is replaced by -Wmissing-exported-signatures", ===================================== compiler/GHC/Iface/Decl.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE NondecreasingIndentation #-} +{-# LANGUAGE LambdaCase #-} {- (c) The University of Glasgow 2006-2008 @@ -12,6 +13,7 @@ module GHC.Iface.Decl ( coAxiomToIfaceDecl , tyThingToIfaceDecl -- Converting things to their Iface equivalents + , toIfaceBooleanFormula ) where @@ -38,12 +40,14 @@ import GHC.Types.Var import GHC.Types.Name import GHC.Types.Basic import GHC.Types.TyThing +import GHC.Types.SrcLoc import GHC.Utils.Panic.Plain import GHC.Utils.Misc import GHC.Data.FastString import GHC.Data.Maybe +import GHC.Data.BooleanFormula import Data.List ( findIndex, mapAccumL ) @@ -284,7 +288,7 @@ classToIfaceDecl env clas ifClassCtxt = tidyToIfaceContext env1 sc_theta, ifATs = map toIfaceAT clas_ats, ifSigs = map toIfaceClassOp op_stuff, - ifMinDef = fmap getOccFS (classMinimalDef clas) + ifMinDef = toIfaceBooleanFormula $ fmap getOccFS (classMinimalDef clas) } (env1, tc_binders) = tidyTyConBinders env (tyConBinders tycon) @@ -332,3 +336,10 @@ tidyTyConBinders = mapAccumL tidyTyConBinder tidyTyVar :: TidyEnv -> TyVar -> FastString tidyTyVar (_, subst) tv = toIfaceTyVar (lookupVarEnv subst tv `orElse` tv) + +toIfaceBooleanFormula :: BooleanFormula IfLclName -> IfaceBooleanFormula +toIfaceBooleanFormula = \case + Var nm -> IfVar nm + And bfs -> IfAnd (map (toIfaceBooleanFormula . unLoc) bfs) + Or bfs -> IfOr (map (toIfaceBooleanFormula . unLoc) bfs) + Parens bf -> IfParens (toIfaceBooleanFormula . unLoc $ bf) ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -17,7 +17,7 @@ module GHC.Iface.Syntax ( IfaceIdInfo, IfaceIdDetails(..), IfaceUnfolding(..), IfGuidance(..), IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget, IfaceClsInst(..), IfaceFamInst(..), IfaceTickish(..), - IfaceClassBody(..), + IfaceClassBody(..), IfaceBooleanFormula(..), IfaceBang(..), IfaceSrcBang(..), SrcUnpackedness(..), SrcStrictness(..), IfaceAxBranch(..), @@ -32,6 +32,7 @@ module GHC.Iface.Syntax ( -- Misc ifaceDeclImplicitBndrs, visibleIfConDecls, ifaceDeclFingerprints, + fromIfaceBooleanFormula, -- Free Names freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst, @@ -66,12 +67,13 @@ import GHC.Types.Annotations( AnnPayload, AnnTarget ) import GHC.Types.Basic import GHC.Unit.Module import GHC.Types.SrcLoc -import GHC.Data.BooleanFormula ( BooleanFormula, pprBooleanFormula, isTrue ) +import GHC.Data.BooleanFormula ( BooleanFormula(..), pprBooleanFormula, isTrue ) import GHC.Types.Var( VarBndr(..), binderVar, tyVarSpecToBinders, visArgTypeLike ) import GHC.Core.TyCon ( Role (..), Injectivity(..), tyConBndrVisForAllTyFlag ) import GHC.Core.DataCon (SrcStrictness(..), SrcUnpackedness(..)) import GHC.Builtin.Types ( constraintKindTyConName ) import GHC.Stg.InferTags.TagSig +import GHC.Parser.Annotation (noLocA) import GHC.Utils.Lexeme (isLexSym) import GHC.Utils.Fingerprint @@ -191,9 +193,22 @@ data IfaceClassBody ifClassCtxt :: IfaceContext, -- Super classes ifATs :: [IfaceAT], -- Associated type families ifSigs :: [IfaceClassOp], -- Method signatures - ifMinDef :: BooleanFormula IfLclName -- Minimal complete definition + ifMinDef :: IfaceBooleanFormula -- Minimal complete definition } +data IfaceBooleanFormula + = IfVar IfLclName + | IfAnd [IfaceBooleanFormula] + | IfOr [IfaceBooleanFormula] + | IfParens IfaceBooleanFormula + +fromIfaceBooleanFormula :: IfaceBooleanFormula -> BooleanFormula IfLclName +fromIfaceBooleanFormula = \case + IfVar nm -> Var nm + IfAnd ibfs -> And (map (noLocA . fromIfaceBooleanFormula) ibfs) + IfOr ibfs -> Or (map (noLocA . fromIfaceBooleanFormula) ibfs) + IfParens ibf -> Parens (noLocA . fromIfaceBooleanFormula $ ibf) + data IfaceTyConParent = IfNoParent | IfDataInstance @@ -930,7 +945,7 @@ pprIfaceDecl ss (IfaceClass { ifName = clas , pprClassStandaloneKindSig ss clas (mkIfaceTyConKind binders constraintIfaceKind) , text "class" <+> pprIfaceDeclHead suppress_bndr_sig context ss clas binders <+> pprFundeps fds <+> pp_where , nest 2 (vcat [ vcat asocs, vcat dsigs - , ppShowAllSubs ss (pprMinDef minDef)])] + , ppShowAllSubs ss (pprMinDef $ fromIfaceBooleanFormula minDef)])] where pp_where = ppShowRhs ss $ ppUnless (null sigs && null ats) (text "where") @@ -2038,6 +2053,20 @@ instance Binary IfaceDecl where ifBody = IfAbstractClass }) _ -> panic (unwords ["Unknown IfaceDecl tag:", show h]) +instance Binary IfaceBooleanFormula where + put_ bh = \case + IfVar a1 -> putByte bh 0 >> put_ bh a1 + IfAnd a1 -> putByte bh 1 >> put_ bh a1 + IfOr a1 -> putByte bh 2 >> put_ bh a1 + IfParens a1 -> putByte bh 3 >> put_ bh a1 + + get bh = do + getByte bh >>= \case + 0 -> IfVar <$> get bh + 1 -> IfAnd <$> get bh + 2 -> IfOr <$> get bh + _ -> IfParens <$> get bh + {- Note [Lazy deserialization of IfaceId] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The use of lazyPut and lazyGet in the IfaceId Binary instance is @@ -2650,7 +2679,14 @@ instance NFData IfaceAxBranch where instance NFData IfaceClassBody where rnf = \case IfAbstractClass -> () - IfConcreteClass f1 f2 f3 f4 -> rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` f4 `seq` () + IfConcreteClass f1 f2 f3 f4 -> rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` () + +instance NFData IfaceBooleanFormula where + rnf = \case + IfVar f1 -> rnf f1 + IfAnd f1 -> rnf f1 + IfOr f1 -> rnf f1 + IfParens f1 -> rnf f1 instance NFData IfaceAT where rnf (IfaceAT f1 f2) = rnf f1 `seq` rnf f2 ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -44,6 +44,7 @@ import GHC.Driver.Config.Core.Lint ( initLintConfig ) import GHC.Builtin.Types.Literals(typeNatCoAxiomRules) import GHC.Builtin.Types +import GHC.Iface.Decl (toIfaceBooleanFormula) import GHC.Iface.Syntax import GHC.Iface.Load import GHC.Iface.Env @@ -290,7 +291,7 @@ mergeIfaceDecl d1 d2 (mkNameEnv [ (n, op) | op@(IfaceClassOp n _ _) <- ops2 ]) in d1 { ifBody = (ifBody d1) { ifSigs = ops, - ifMinDef = BF.mkOr [noLocA bf1, noLocA bf2] + ifMinDef = toIfaceBooleanFormula . BF.mkOr . map (noLocA . fromIfaceBooleanFormula) $ [bf1, bf2] } } `withRolesFrom` d2 -- It doesn't matter; we'll check for consistency later when @@ -773,7 +774,7 @@ tc_iface_decl _parent ignore_prags ifBody = IfConcreteClass { ifClassCtxt = rdr_ctxt, ifATs = rdr_ats, ifSigs = rdr_sigs, - ifMinDef = mindef_occ + ifMinDef = if_mindef }}) = bindIfaceTyConBinders binders $ \ binders' -> do { traceIf (text "tc-iface-class1" <+> ppr tc_name) @@ -782,6 +783,7 @@ tc_iface_decl _parent ignore_prags ; sigs <- mapM tc_sig rdr_sigs ; fds <- mapM tc_fd rdr_fds ; traceIf (text "tc-iface-class3" <+> ppr tc_name) + ; let mindef_occ = fromIfaceBooleanFormula if_mindef ; mindef <- traverse (lookupIfaceTop . mkVarOccFS) mindef_occ ; cls <- fixM $ \ cls -> do { ats <- mapM (tc_at cls) rdr_ats ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -1689,12 +1689,13 @@ warnMissingKindSignatures gbl_env tcs = tcg_tcs gbl_env ksig_ns = tcg_ksigs gbl_env exports = availsToNameSet (tcg_exports gbl_env) - not_ghc_generated :: Name -> Bool - not_ghc_generated name = name `elemNameSet` ksig_ns + + has_kind_signature :: Name -> Bool + has_kind_signature name = name `elemNameSet` ksig_ns add_ty_warn :: Bool -> TyCon -> RnM () add_ty_warn cusks_enabled tyCon = - when (not_ghc_generated name) $ + when (has_kind_signature name) $ addDiagnosticAt (getSrcSpan name) diag where name = tyConName tyCon ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -3321,8 +3321,8 @@ missingSignatureWarningFlags (MissingTopLevelBindingSig {}) exported missingSignatureWarningFlags (MissingPatSynSig {}) exported = Opt_WarnMissingPatternSynonymSignatures :| [ Opt_WarnMissingExportedPatternSynonymSignatures | IsExported == exported ] -missingSignatureWarningFlags (MissingTyConKindSig {}) _ - = Opt_WarnMissingKindSignatures :| [] +missingSignatureWarningFlags (MissingTyConKindSig ty_con _) _ + = Opt_WarnMissingKindSignatures :| [Opt_WarnMissingPolyKindSignatures | isForAllTy_invis_ty (tyConKind ty_con) ] useDerivingStrategies :: GhcHint useDerivingStrategies = ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -936,6 +936,7 @@ data TcRnMessage where -Wmissing-pattern-synonym-signatures -Wmissing-exported-pattern-synonym-signatures -Wmissing-kind-signatures + -Wmissing-poly-kind-signatures Test cases: T11077 (top-level bindings) ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -1210,20 +1210,10 @@ This check, mkInferredPolyId, is really in the wrong place: `inferred_poly_ty` doesn't obey the PKTI and it would be better not to generalise it in the first place; see #20686. But for now it works. -How else could we avoid generalising over escaping type variables? I -considered: - -* Adjust the generalisation in GHC.Tc.Solver to directly check for - escaping kind variables; instead, promote or default them. But that - gets into the defaulting swamp and is a non-trivial and unforced - change, so I have left it alone for now. - -* When inferring the type of a binding, in `tcMonoBinds`, we create - an ExpSigmaType with `tcInfer`. If we simply gave it an ir_frr field - that said "must have fixed runtime rep", then the kind would be made - Concrete; and we never generalise over Concrete variables. A bit - more indirect, but we need the "don't generalise over Concrete variables" - stuff anyway. +I considered adjusting the generalisation in GHC.Tc.Solver to directly check for +escaping kind variables; instead, promoting or defaulting them. But that +gets into the defaulting swamp and is a non-trivial and unforced +change, so I have left it alone for now. Note [Impedance matching] ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1312,7 +1302,9 @@ tcMonoBinds is_rec sig_fn no_gen , Nothing <- sig_fn name -- ...with no type signature = setSrcSpanA b_loc $ do { ((co_fn, matches'), rhs_ty') - <- tcInfer $ \ exp_ty -> + <- tcInferFRR (FRRBinder name) $ \ exp_ty -> + -- tcInferFRR: the type of a let-binder must have + -- a fixed runtime rep. See #23176 tcExtendBinderStack [TcIdBndr_ExpType name exp_ty NotTopLevel] $ -- We extend the error context even for a non-recursive -- function so that in type error messages we show the @@ -1334,7 +1326,9 @@ tcMonoBinds is_rec sig_fn no_gen | NonRecursive <- is_rec -- ...binder isn't mentioned in RHS , all (isNothing . sig_fn) bndrs = addErrCtxt (patMonoBindsCtxt pat grhss) $ - do { (grhss', pat_ty) <- tcInfer $ \ exp_ty -> + do { (grhss', pat_ty) <- tcInferFRR FRRPatBind $ \ exp_ty -> + -- tcInferFRR: the type of each let-binder must have + -- a fixed runtime rep. See #23176 tcGRHSsPat grhss exp_ty ; let exp_pat_ty :: Scaled ExpSigmaTypeFRR ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -830,7 +830,7 @@ pprCtOrigin (InstProvidedOrigin mod cls_inst) pprCtOrigin (ImpedanceMatching x) = vcat [ text "arising when matching required constraints" - , text "in a recursive group involving" <+> quotes (ppr x)] + , text "in a group involving" <+> quotes (ppr x)] pprCtOrigin (CycleBreakerOrigin orig) = pprCtOrigin orig ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -1543,6 +1543,17 @@ tryTcDiscardingErrs recover thing_inside tidy up the message; we then use it to tidy the context messages -} +{- + +Note [Reporting warning diagnostics] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We use functions below to report warnings. For the most part, +we do /not/ need to check any warning flags before doing so. +See https://gitlab.haskell.org/ghc/ghc/-/wikis/Errors-as-(structured)-values +for the design. + +-} + addErrTc :: TcRnMessage -> TcM () addErrTc err_msg = do { env0 <- liftZonkM tcInitTidyEnv ; addErrTcM (env0, err_msg) } ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -1324,6 +1324,31 @@ of ``-W(no-)*``. the parent class a standalone kind signature or CUSK is sufficient to fix the warning for the class's associated type families as well. +.. ghc-flag:: -Wmissing-poly-kind-signatures + :shortdesc: warn when inferred polykinded type or class declaration don't have kind signatures nor CUSKs + :type: dynamic + :reverse: -Wno-missing-poly-kind-signatures + :category: + + :since: 9.8 + :default: off + + .. index:: + single: kind signatures, missing + + This is a restricted version of :ghc-flag:`-Wmissing-kind-signatures`. + + It warns when a declaration defines a type constructor that lacks a :ref:`standalone kind signature ` + and whose inferred kind is polymorphic (which happens with `-PolyKinds`. For example :: + + data T a = MkT (a -> Int) -- T :: Type -> Type + -- Not polymorphic, hence no warning + data W f a = MkW (f a) -- W :: forall k. (k->Type) -> k -> Type + -- Polymorphic, hence warning! + + It is useful to catch accidentally polykinded types, or to make that polymorphism explicit, + without requiring a kind signature for every type. + .. ghc-flag:: -Wmissing-exported-pattern-synonym-signatures :shortdesc: warn about pattern synonyms without signatures, only if they are exported ===================================== libraries/base/GHC/TypeLits/Internal.hs ===================================== @@ -5,9 +5,14 @@ {-# OPTIONS_HADDOCK not-home #-} {-| -This module exports the Type Literal kinds as well as the comparison type -families for those kinds. It is needed to prevent module cycles while still -allowing these identifiers to be imported in 'Data.Type.Ord'. +DO NOT USE THIS MODULE. Use "GHC.TypeLits" instead. + +This module is internal-only and was exposed by accident. It may be +removed without warning in a future version. + +(The technical reason for this module's existence is that it is needed +to prevent module cycles while still allowing these identifiers to be +imported in 'Data.Type.Ord'.) @since 4.16.0.0 -} ===================================== libraries/base/GHC/TypeNats/Internal.hs ===================================== @@ -5,9 +5,14 @@ {-# OPTIONS_HADDOCK not-home #-} {-| -This module exports the Type Nat kind as well as the comparison type -family for that kinds. It is needed to prevent module cycles while still -allowing these identifiers to be imported in 'Data.Type.Ord'. +DO NOT USE THIS MODULE. Use "GHC.TypeNats" instead. + +This module is internal-only and was exposed by accident. It may be +removed without warning in a future version. + +(The technical reason for this module's existence is that it is needed +to prevent module cycles while still allowing these identifiers to be +imported in 'Data.Type.Ord'.) @since 4.16.0.0 -} ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -8,6 +8,7 @@ {-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-} {-# LANGUAGE TemplateHaskellQuotes #-} +{-# LANGUAGE StandaloneKindSignatures #-} ----------------------------------------------------------------------------- -- | @@ -57,6 +58,7 @@ import GHC.CString ( unpackCString# ) import GHC.Generics ( Generic ) import GHC.Types ( Int(..), Word(..), Char(..), Double(..), Float(..), TYPE, RuntimeRep(..), Multiplicity (..) ) +import qualified Data.Kind as Kind (Type) import GHC.Prim ( Int#, Word#, Char#, Double#, Float#, Addr# ) import GHC.Ptr ( Ptr, plusPtr ) import GHC.Lexeme ( startsVarSym, startsVarId ) @@ -332,8 +334,9 @@ instance Quote Q where -- ----------------------------------------------------- +type TExp :: TYPE r -> Kind.Type type role TExp nominal -- See Note [Role of TExp] -newtype TExp (a :: TYPE (r :: RuntimeRep)) = TExp +newtype TExp a = TExp { unType :: Exp -- ^ Underlying untyped Template Haskell expression } -- ^ Typed wrapper around an 'Exp'. @@ -376,8 +379,9 @@ The splice will evaluate to (MkAge 3) and you can't add that to -- Code constructor +type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type type role Code representational nominal -- See Note [Role of TExp] -newtype Code m (a :: TYPE (r :: RuntimeRep)) = Code +newtype Code m a = Code { examineCode :: m (TExp a) -- ^ Underlying monadic value } -- ^ Represents an expression which has type @a@, built in monadic context @m at . Built on top of 'TExp', typed ===================================== testsuite/driver/testlib.py ===================================== @@ -327,12 +327,13 @@ def req_process( name, opts ): def req_host_target_ghc( name, opts ): """ - When testing a cross GHC, some test cases require a host GHC as - well (e.g. for compiling custom Setup.hs). This is not supported - yet (#23236), so for the time being we skip them when testing - cross GHCs. + When testing a cross GHC, some test cases require a host GHC as well (e.g. + for compiling custom Setup.hs). This is not supported yet (#23236), so for + the time being we skip them when testing cross GHCs. However, this is not + the case for the JS backend. The JS backend is a cross-compiler that + produces code that the host can run. """ - if isCross(): + if isCross() and not js_arch(): opts.skip = True def ignore_stdout(name, opts): ===================================== testsuite/tests/polykinds/T22743.stderr ===================================== @@ -1,7 +1,10 @@ -T22743.hs:10:1: error: [GHC-31147] - • Quantified type's kind mentions quantified type variable - type: ‘forall {f :: * -> RuntimeRep} {g} {a :: TYPE (f g)}. a’ - where the body of the forall has this kind: ‘TYPE (f g)’ - • When checking the inferred type - x :: forall {f :: * -> RuntimeRep} {g} {a :: TYPE (f g)}. a +T22743.hs:10:1: error: [GHC-52083] + The binder ‘x’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T22743.hs:10:1: error: [GHC-52083] + The binder ‘x’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. ===================================== testsuite/tests/rep-poly/T23176.hs ===================================== @@ -0,0 +1,6 @@ +module T23176 where + +import GHC.Exts + +f = outOfScope :: (_ :: TYPE (r s)) +(g :: _) = outOfScope :: (_ :: TYPE (r s)) ===================================== testsuite/tests/rep-poly/T23176.stderr ===================================== @@ -0,0 +1,30 @@ + +T23176.hs:5:1: error: [GHC-52083] + The binder ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23176.hs:5:1: error: [GHC-52083] + The binder ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23176.hs:5:1: error: [GHC-52083] + The binder ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23176.hs:6:1: error: [GHC-52083] + The pattern binding + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23176.hs:6:1: error: [GHC-52083] + The pattern binding + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23176.hs:6:1: error: [GHC-52083] + The pattern binding + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. ===================================== testsuite/tests/rep-poly/all.T ===================================== @@ -118,3 +118,4 @@ test('T21650_b', normal, compile_fail, ['-Wno-deprecated-flags']) ## test('T23051', normal, compile_fail, ['']) test('T23153', normal, compile_fail, ['']) test('T23154', normal, compile_fail, ['']) +test('T23176', normal, compile_fail, ['-XPartialTypeSignatures -fdefer-out-of-scope-variables']) ===================================== testsuite/tests/typecheck/should_fail/T23427.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} module T23427 where class C a where @@ -8,3 +9,7 @@ indent n = doText n where doText x = const (f x) doTail doTail _ = const n doText + +-- Test case from #20076 +x :: Num a => a +(x, y) = (1.2, 3.4) ===================================== testsuite/tests/typecheck/should_fail/T23427.stderr ===================================== @@ -1,12 +1,12 @@ -T23427.hs:9:7: error: [GHC-39999] +T23427.hs:10:7: error: [GHC-39999] • Could not deduce ‘C a0’ arising when matching required constraints - in a recursive group involving ‘doTail’ + in a group involving ‘doTail’ from the context: C a bound by the type signature for: indent :: forall a. C a => a -> a - at T23427.hs:6:1-23 + at T23427.hs:7:1-23 The type variable ‘a0’ is ambiguous • In an equation for ‘indent’: indent n @@ -14,3 +14,12 @@ T23427.hs:9:7: error: [GHC-39999] where doText x = const (f x) doTail doTail _ = const n doText + +T23427.hs:15:1: error: [GHC-39999] + Could not deduce ‘Fractional a’ + arising when matching required constraints + in a group involving ‘x’ + from the context: Num a + bound by the inferred type for ‘x’: + forall a. Num a => a + at T23427.hs:15:1-19 ===================================== testsuite/tests/warnings/should_compile/T22826.hs ===================================== @@ -0,0 +1,53 @@ +{-# OPTIONS_GHC -Wmissing-poly-kind-signatures #-} +{-# LANGUAGE GADTs, PolyKinds, TypeFamilies #-} +-- without standalone kind signatures or cusks: warnings +module T22826 where + +import Data.Kind (Type) + +-- type family +type family Id x where + Id Int = Int + +-- class definition +class Functor f => Alt f where + () :: f a -> f a -> f a + +-- polykinded class +class EqP f where + eqp :: f a -> f b -> Bool + +-- type alias +type Arr a b = a -> b +type B = Bool + +-- Haskell98 data +data YesNo = Yes | No +data V2 a = V2 a a + +-- GADT +data Free f a where + Pure :: a -> Free f a + Ap :: f b -> Free f (b -> a) -> Free f a + +-- data family +data family D1 a + +-- polykinded data +data Proxy a = Proxy + +-- associated type family +class C a where + type AT a b + +-- polykinded type with partial kind spec +-- not warned: PolyKinds don't add variables here +data D (k :: Type) a (b :: k) where + D :: [a] -> D k a b + +-- polykinded type without kind signature, which is polymorphic, +-- but PolyKinds won't change it. +data E a k b = MkE a (VProxy k b) + +type VProxy :: forall k -> k -> Type +data VProxy k a = MkVP ===================================== testsuite/tests/warnings/should_compile/T22826.stderr ===================================== @@ -0,0 +1,12 @@ + +T22826.hs:17:1: warning: [GHC-38417] [-Wmissing-poly-kind-signatures] + Top-level type constructor with no standalone kind signature: + type EqP :: forall {k}. (k -> *) -> Constraint + +T22826.hs:37:1: warning: [GHC-38417] [-Wmissing-poly-kind-signatures] + Top-level type constructor with no standalone kind signature: + type Proxy :: forall {k}. k -> * + +T22826.hs:40:1: warning: [GHC-38417] [-Wmissing-poly-kind-signatures] + Top-level type constructor with no standalone kind signature: + type C :: forall {k}. k -> Constraint ===================================== testsuite/tests/warnings/should_compile/all.T ===================================== @@ -64,3 +64,4 @@ test('DodgyImports', normal, compile, ['-Wdodgy-imports']) test('DodgyImports_hiding', normal, compile, ['-Wdodgy-imports']) test('T22702a', normal, compile, ['']) test('T22702b', normal, compile, ['']) +test('T22826', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/323038244f520507759dc5b7c52c8ec8aa8df8ff...79870853c232867acbfbd180fe33a93893e0384a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/323038244f520507759dc5b7c52c8ec8aa8df8ff...79870853c232867acbfbd180fe33a93893e0384a You're receiving 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 Jun 14 06:49:59 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Wed, 14 Jun 2023 02:49:59 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/DIB-instances] Implement the -Wimplicit-rhs-quantification warning (#23510) Message-ID: <648963172ca32_17653dc59a4127847@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/DIB-instances at Glasgow Haskell Compiler / GHC Commits: 2b491c39 by Andrei Borzenkov at 2023-06-14T10:49:42+04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 18 changed files: - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - docs/users_guide/using-warnings.rst - testsuite/tests/dependent/should_compile/T16391a.hs - testsuite/tests/ghci/scripts/ghci024.stdout - + testsuite/tests/rename/should_compile/T23510b.hs - testsuite/tests/rename/should_compile/all.T - + testsuite/tests/rename/should_fail/T23510a.hs - + testsuite/tests/rename/should_fail/T23510a.stderr - testsuite/tests/rename/should_fail/all.T - testsuite/tests/typecheck/should_compile/T13343.hs Changes: ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -641,6 +641,7 @@ data WarningFlag = | Opt_WarnLoopySuperclassSolve -- Since 9.6 | Opt_WarnTermVariableCapture -- Since 9.8 | Opt_WarnMissingRoleAnnotations -- Since 9.8 + | Opt_WarnImplicitRhsQuantification -- Since 9.8 deriving (Eq, Ord, Show, Enum) -- | Return the names of a WarningFlag @@ -748,6 +749,7 @@ warnFlagNames wflag = case wflag of Opt_WarnLoopySuperclassSolve -> "loopy-superclass-solve" :| [] Opt_WarnTypeEqualityRequiresOperators -> "type-equality-requires-operators" :| [] Opt_WarnMissingRoleAnnotations -> "missing-role-annotations" :| [] + Opt_WarnImplicitRhsQuantification -> "implicit-rhs-quantification" :| [] -- ----------------------------------------------------------------------------- -- Standard sets of warning options @@ -939,6 +941,7 @@ minusWcompatOpts , Opt_WarnNonCanonicalMonadInstances , Opt_WarnCompatUnqualifiedImports , Opt_WarnTypeEqualityOutOfScope + , Opt_WarnImplicitRhsQuantification ] -- | Things you get with -Wunused-binds ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2259,7 +2259,8 @@ wWarningFlagsDeps = mconcat [ warnSpec Opt_WarnTypeEqualityOutOfScope, warnSpec Opt_WarnTypeEqualityRequiresOperators, warnSpec Opt_WarnTermVariableCapture, - warnSpec Opt_WarnMissingRoleAnnotations + warnSpec Opt_WarnMissingRoleAnnotations, + warnSpec Opt_WarnImplicitRhsQuantification ] warningGroupsDeps :: [(Deprecation, FlagSpec WarningGroup)] ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -918,8 +918,8 @@ bindHsQTyVars :: forall a b. -> Maybe a -- Just _ => an associated type decl -> FreeKiTyVars -- Kind variables from scope -> LHsQTyVars GhcPs - -> (LHsQTyVars GhcRn -> Bool -> RnM (b, FreeVars)) - -- The Bool is True <=> all kind variables used in the + -> (LHsQTyVars GhcRn -> FreeKiTyVars -> RnM (b, FreeVars)) + -- The FreeKiTyVars is null <=> all kind variables used in the -- kind signature are bound on the left. Reason: -- the last clause of Note [CUSKs: complete user-supplied kind signatures] -- in GHC.Hs.Decls @@ -942,7 +942,6 @@ bindHsQTyVars doc mb_assoc body_kv_occs hsq_bndrs thing_inside bndr_kv_occs ++ body_kv_occs body_remaining = filterFreeVarsToBind bndr_kv_occs $ filterFreeVarsToBind bndrs body_kv_occs - all_bound_on_lhs = null body_remaining ; traceRn "checkMixedVars3" $ vcat [ text "bndrs" <+> ppr hs_tv_bndrs @@ -969,7 +968,7 @@ bindHsQTyVars doc mb_assoc body_kv_occs hsq_bndrs thing_inside ; traceRn "bindHsQTyVars" (ppr hsq_bndrs $$ ppr implicit_kv_nms $$ ppr rn_bndrs) ; thing_inside (HsQTvs { hsq_ext = implicit_kv_nms , hsq_explicit = rn_bndrs }) - all_bound_on_lhs } } + body_remaining } } where hs_tv_bndrs = hsQTvExplicit hsq_bndrs @@ -1802,12 +1801,15 @@ one exists: The logic resides in extractHsTyRdrTyVarsKindVars. We use it both for type synonyms and type family instances. -This is something of a stopgap solution until we can explicitly bind invisible +This was a stopgap solution until we could explicitly bind invisible type/kind variables: type TySyn3 :: forall a. Maybe a type TySyn3 @a = 'Just ('Nothing :: Maybe a) +Now that the new syntax was proposed in #425 and implemented in 9.8, we issue a warning +-Wimplicit-rhs-quantification for TySyn2 and TySyn4 and will eventually disallow them. + Note [Implicit quantification in type synonyms: non-taken alternatives] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -1709,11 +1709,16 @@ rnTyClDecl (SynDecl { tcdLName = tycon, tcdTyVars = tyvars, ; let kvs = extractHsTyRdrTyVarsKindVars rhs doc = TySynCtx tycon ; traceRn "rntycl-ty" (ppr tycon <+> ppr kvs) - ; bindHsQTyVars doc Nothing kvs tyvars $ \ tyvars' _ -> - do { (rhs', fvs) <- rnTySyn doc rhs + ; bindHsQTyVars doc Nothing kvs tyvars $ \ tyvars' free_rhs_kvs -> + do { mapM_ warn_implicit_kvs (nubL free_rhs_kvs) + ; (rhs', fvs) <- rnTySyn doc rhs ; return (SynDecl { tcdLName = tycon', tcdTyVars = tyvars' , tcdFixity = fixity , tcdRhs = rhs', tcdSExt = fvs }, fvs) } } + where + warn_implicit_kvs :: LocatedN RdrName -> RnM () + warn_implicit_kvs kv = + addDiagnosticAt (getLocA kv) (TcRnImplicitRhsQuantification kv) -- "data", "newtype" declarations rnTyClDecl (DataDecl @@ -1725,12 +1730,12 @@ rnTyClDecl (DataDecl doc = TyDataCtx tycon new_or_data = dataDefnConsNewOrData cons ; traceRn "rntycl-data" (ppr tycon <+> ppr kvs) - ; bindHsQTyVars doc Nothing kvs tyvars $ \ tyvars' no_rhs_kvs -> + ; bindHsQTyVars doc Nothing kvs tyvars $ \ tyvars' free_rhs_kvs -> do { (defn', fvs) <- rnDataDefn doc defn - ; cusk <- data_decl_has_cusk tyvars' new_or_data no_rhs_kvs kind_sig + ; cusk <- data_decl_has_cusk tyvars' new_or_data (null free_rhs_kvs) kind_sig ; let rn_info = DataDeclRn { tcdDataCusk = cusk , tcdFVs = fvs } - ; traceRn "rndata" (ppr tycon <+> ppr cusk <+> ppr no_rhs_kvs) + ; traceRn "rndata" (ppr tycon <+> ppr cusk <+> ppr free_rhs_kvs) ; return (DataDecl { tcdLName = tycon' , tcdTyVars = tyvars' , tcdFixity = fixity ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1851,6 +1851,11 @@ instance Diagnostic TcRnMessage where , text "or a complete user-supplied kind (CUSK, legacy feature)" , text "is required to use invisible binders." ] + TcRnImplicitRhsQuantification kv -> mkSimpleDecorated $ + vcat [ text "The variable" <+> quotes (ppr kv) <+> text "occurs free on the RHS of the type declaration" + , text "In the future GHC will no longer implicitly quantify over such variables" + ] + diagnosticReason = \case TcRnUnknownMessage m -> diagnosticReason m @@ -2467,6 +2472,8 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnInvisBndrWithoutSig{} -> ErrorWithoutFlag + TcRnImplicitRhsQuantification{} + -> WarningWithFlag Opt_WarnImplicitRhsQuantification diagnosticHints = \case TcRnUnknownMessage m @@ -3130,6 +3137,8 @@ instance Diagnostic TcRnMessage where -> noHints TcRnInvisBndrWithoutSig name _ -> [SuggestAddStandaloneKindSignature name] + TcRnImplicitRhsQuantification kv + -> [SuggestBindTyVarOnLhs (unLoc kv)] diagnosticCode :: TcRnMessage -> Maybe DiagnosticCode diagnosticCode = constructorCode ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -4094,6 +4094,23 @@ data TcRnMessage where -} TcRnMissingRoleAnnotation :: Name -> [Role] -> TcRnMessage + {-| TcRnImplicitRhsQuantification is a warning that occurs when GHC implicitly + quantifies over a type variable that occurs free on the RHS of the type declaration + that is not mentioned on the LHS + + Example: + + type T = 'Nothing :: Maybe a + + Controlled by flags: + - Wimplicit-rhs-quantification + + Test cases: + T23510a + T23510b + -} + TcRnImplicitRhsQuantification :: LocatedN RdrName -> TcRnMessage + deriving Generic ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -591,6 +591,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnArityMismatch" = 27346 GhcDiagnosticCode "TcRnSimplifiableConstraint" = 62412 GhcDiagnosticCode "TcRnIllegalQuasiQuotes" = 77343 + GhcDiagnosticCode "TcRnImplicitRhsQuantification" = 16382 -- TcRnTypeApplicationsDisabled GhcDiagnosticCode "TypeApplication" = 23482 ===================================== compiler/GHC/Types/Hint.hs ===================================== @@ -465,6 +465,9 @@ data GhcHint {-| Suggest eta-reducing a type synonym used in the implementation of abstract data. -} | SuggestEtaReduceAbsDataTySyn TyCon + {-| Suggest binding the type variable on the LHS of the type declaration + -} + | SuggestBindTyVarOnLhs RdrName -- | An 'InstantiationSuggestion' for a '.hsig' file. This is generated -- by GHC in case of a 'DriverUnexpectedSignature' and suggests a way ===================================== compiler/GHC/Types/Hint/Ppr.hs ===================================== @@ -251,6 +251,8 @@ instance Outputable GhcHint where SuggestEtaReduceAbsDataTySyn tc -> text "If possible, eta-reduce the type synonym" <+> ppr_tc <+> text "so that it is nullary." where ppr_tc = quotes (ppr $ tyConName tc) + SuggestBindTyVarOnLhs tv + -> text "Bind" <+> quotes (ppr tv) <+> text "on the LHS of the type declaration" perhapsAsPat :: SDoc perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace" ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -166,6 +166,7 @@ as ``-Wno-...`` for every individual warning in the group. * :ghc-flag:`-Wnoncanonical-monad-instances` * :ghc-flag:`-Wcompat-unqualified-imports` * :ghc-flag:`-Wtype-equality-out-of-scope` + * :ghc-flag:`-Wimplicit-rhs-quantification` .. ghc-flag:: -w :shortdesc: disable all warnings @@ -2415,6 +2416,28 @@ of ``-W(no-)*``. In other words the type-class role cannot be accidentally left representational or phantom, which could affected the code correctness. +.. ghc-flag:: -Wimplicit-rhs-quantification + :shortdesc: warn when type variables on the RHS of a type synonym are implicitly quantified + :type: dynamic + :reverse: -Wno-implicit-rhs-quantification + :category: + + :since: 9.8 + :default: off + + In accordance with `GHC Proposal #425 + `__, + GHC will stop implicitly quantifying over type variables that occur free on the + right-hand side of a type synonym but are not mentioned on the left-hand side. + Type synonym declarations that rely on this form of quantification should be rewritten with invisible binders. + + For example: :: + + type T1 :: forall a . Maybe a + type T1 = 'Nothing :: Maybe a -- old + type T1 @a = 'Nothing :: Maybe a -- new + + This warning detects code that will be affected by this breaking change. If you're feeling really paranoid, the :ghc-flag:`-dcore-lint` option is a good choice. It turns on heavyweight intra-pass sanity-checking within GHC. (It checks GHC's ===================================== testsuite/tests/dependent/should_compile/T16391a.hs ===================================== @@ -9,7 +9,8 @@ import Data.Kind type Const (a :: Type) (b :: Type) = a type family F :: Const Type a where F = Int -type TS = (Int :: Const Type a) +type TS :: forall a . Const Type a +type TS @a = (Int :: Const Type a) data T1 :: Const Type a where MkT1 :: T1 data T2 :: Const Type a -> Type where ===================================== testsuite/tests/ghci/scripts/ghci024.stdout ===================================== @@ -18,6 +18,7 @@ warning settings: -Wsemigroup -Wcompat-unqualified-imports -Wtype-equality-out-of-scope + -Wimplicit-rhs-quantification ~~~~~~~~~~ Testing :set -a options currently set: none. base language is: GHC2021 ===================================== testsuite/tests/rename/should_compile/T23510b.hs ===================================== @@ -0,0 +1,14 @@ +{-# OPTIONS -Wimplicit-rhs-quantification #-} +{-# LANGUAGE DataKinds, TypeAbstractions #-} +module T23510b where + +import Data.Proxy + +type T1 :: forall k . Maybe k +type T1 @a = 'Nothing :: Maybe a + +type T2 :: forall k j . k -> Either k j +type T2 @a @b = 'Left :: a -> Either a b + +type T3 :: forall {k} (d :: k) . Proxy k +type T3 @(a :: k) = 'Proxy :: Proxy k ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -212,3 +212,4 @@ test('T22122', [expect_broken(22122), extra_files(['T22122_aux.hs'])], multimod_ test('T23240', [req_th, extra_files(['T23240_aux.hs'])], multimod_compile, ['T23240', '-v0']) test('T23318', normal, compile, ['-Wduplicate-exports']) test('T23434', normal, compile, ['']) +test('T23510b', normal, compile, ['']) ===================================== testsuite/tests/rename/should_fail/T23510a.hs ===================================== @@ -0,0 +1,17 @@ +{-# OPTIONS -Wimplicit-rhs-quantification #-} +{-# LANGUAGE DataKinds #-} +module T23510a where + +import Data.Proxy +import GHC.Types + +type T1 = 'Nothing :: Maybe a + +type T2 = 'Left :: a -> Either a b + +type T3 = 'Proxy :: Proxy k + +type Const (a :: Type) (b :: Type) = a +type TS = (Int :: Const Type a) + +type Bad = (forall (v1 :: RuntimeRep) (a1 :: TYPE v). a1) :: TYPE v ===================================== testsuite/tests/rename/should_fail/T23510a.stderr ===================================== @@ -0,0 +1,30 @@ + +T23510a.hs:8:29: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘a’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘a’ on the LHS of the type declaration + +T23510a.hs:10:20: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘a’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘a’ on the LHS of the type declaration + +T23510a.hs:10:34: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘b’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘b’ on the LHS of the type declaration + +T23510a.hs:12:27: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘k’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘k’ on the LHS of the type declaration + +T23510a.hs:15:30: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘a’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘a’ on the LHS of the type declaration + +T23510a.hs:17:67: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘v’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘v’ on the LHS of the type declaration ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -198,3 +198,4 @@ test('RnUnexpectedStandaloneDeriving', normal, compile_fail, ['']) test('RnStupidThetaInGadt', normal, compile_fail, ['']) test('PackageImportsDisabled', normal, compile_fail, ['']) test('ImportLookupIllegal', normal, compile_fail, ['']) +test('T23510a', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_compile/T13343.hs ===================================== @@ -4,6 +4,7 @@ module Bug where import GHC.Exts -type Bad = (forall (v1 :: RuntimeRep) (a1 :: TYPE v). a1) :: TYPE v +type Bad :: forall v . TYPE v +type Bad @v = (forall (v1 :: RuntimeRep) (a1 :: TYPE v). a1) :: TYPE v --- should be accepted because GHC will generalize over v. Note v /= v1. +-- Note v /= v1. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2b491c3960d5fb03188cef53fab375ca8118d09e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2b491c3960d5fb03188cef53fab375ca8118d09e You're receiving 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 Jun 14 08:41:11 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Wed, 14 Jun 2023 04:41:11 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/dib-instances] Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) Message-ID: <64897d276553b_17653dc56e81768e9@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/dib-instances at Glasgow Haskell Compiler / GHC Commits: 7cd6812b by Andrei Borzenkov at 2023-06-14T12:40:59+04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 15 changed files: - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - docs/users_guide/9.8.1-notes.rst - testsuite/tests/indexed-types/should_compile/T14131.hs - testsuite/tests/indexed-types/should_compile/T15852.hs - testsuite/tests/indexed-types/should_compile/T15852.stderr - testsuite/tests/indexed-types/should_fail/T14230.hs - testsuite/tests/indexed-types/should_fail/T7938.hs - testsuite/tests/indexed-types/should_fail/T7938.stderr - + testsuite/tests/rename/should_compile/T23512b.hs - testsuite/tests/rename/should_compile/all.T - + testsuite/tests/rename/should_fail/T23512a.hs - + testsuite/tests/rename/should_fail/T23512a.stderr - testsuite/tests/rename/should_fail/all.T - testsuite/tests/typecheck/should_fail/T15797.hs Changes: ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -1799,8 +1799,7 @@ one exists: a free variable 'a', which we implicitly quantify over. That is why we can also use it to the left of the double colon: 'Left a -The logic resides in extractHsTyRdrTyVarsKindVars. We use it both for type -synonyms and type family instances. +The logic resides in extractHsTyRdrTyVarsKindVars. This is something of a stopgap solution until we can explicitly bind invisible type/kind variables: ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -634,14 +634,10 @@ rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds rnFamEqn :: HsDocContext -> AssocTyFamInfo - -> FreeKiTyVars - -- ^ Additional kind variables to implicitly bind if there is no - -- explicit forall. (See the comments on @all_imp_vars@ below for a - -- more detailed explanation.) -> FamEqn GhcPs rhs -> (HsDocContext -> rhs -> RnM (rhs', FreeVars)) -> RnM (FamEqn GhcRn rhs', FreeVars) -rnFamEqn doc atfi extra_kvars +rnFamEqn doc atfi (FamEqn { feqn_tycon = tycon , feqn_bndrs = outer_bndrs , feqn_pats = pats @@ -652,19 +648,8 @@ rnFamEqn doc atfi extra_kvars -- all_imp_vars represent the implicitly bound type variables. This is -- empty if we have an explicit `forall` (see -- Note [forall-or-nothing rule] in GHC.Hs.Type), which means - -- ignoring: - -- - -- - pat_kity_vars, the free variables mentioned in the type patterns - -- on the LHS of the equation, and - -- - extra_kvars, which is one of the following: - -- * For type family instances, extra_kvars are the free kind - -- variables mentioned in an outermost kind signature on the RHS - -- of the equation. - -- (See Note [Implicit quantification in type synonyms] in - -- GHC.Rename.HsType.) - -- * For data family instances, extra_kvars are the free kind - -- variables mentioned in the explicit return kind, if one is - -- provided. (e.g., the `k` in `data instance T :: k -> Type`). + -- ignoring pat_kity_vars, the free variables mentioned in the type patterns + -- on the LHS of the equation -- -- Some examples: -- @@ -678,8 +663,6 @@ rnFamEqn doc atfi extra_kvars -- type family G :: Maybe a -- type instance forall a. G = (Nothing :: Maybe a) -- -- all_imp_vars = [] - -- type instance G = (Nothing :: Maybe a) - -- -- all_imp_vars = [a] -- -- data family H :: k -> Type -- data instance forall k. H :: k -> Type where ... @@ -690,7 +673,7 @@ rnFamEqn doc atfi extra_kvars -- -- For associated type family instances, exclude the type variables -- bound by the instance head with filterInScopeM (#19649). - ; all_imp_vars <- filterInScopeM $ pat_kity_vars ++ extra_kvars + ; all_imp_vars <- filterInScopeM $ pat_kity_vars ; bindHsOuterTyVarBndrs doc mb_cls all_imp_vars outer_bndrs $ \rn_outer_bndrs -> do { (pats', pat_fvs) <- rnLHsTypeArgs (FamPatCtx tycon) pats @@ -727,21 +710,12 @@ rnFamEqn doc atfi extra_kvars -- associated family instance but not bound on the LHS, then reject -- that type variable as being out of scope. -- See Note [Renaming associated types]. - -- Per that Note, the LHS type variables consist of: - -- - -- - The variables mentioned in the instance's type patterns - -- (pat_fvs), and - -- - -- - The variables mentioned in an outermost kind signature on the - -- RHS. This is a subset of `rhs_fvs`. To compute it, we look up - -- each RdrName in `extra_kvars` to find its corresponding Name in - -- the LocalRdrEnv. - ; extra_kvar_nms <- mapMaybeM (lookupLocalOccRn_maybe . unLoc) extra_kvars - ; let lhs_bound_vars = pat_fvs `extendNameSetList` extra_kvar_nms - improperly_scoped cls_tkv = + -- Per that Note, the LHS type variables consist of the variables + -- mentioned in the instance's type patterns (pat_fvs) + ; let improperly_scoped cls_tkv = cls_tkv `elemNameSet` rhs_fvs -- Mentioned on the RHS... - && not (cls_tkv `elemNameSet` lhs_bound_vars) + && not (cls_tkv `elemNameSet` pat_fvs) -- ...but not bound on the LHS. bad_tvs = filter improperly_scoped inst_head_tvs ; unless (null bad_tvs) (addErr (TcRnBadAssocRhs bad_tvs)) @@ -786,7 +760,7 @@ rnFamEqn doc atfi extra_kvars -- -- type instance F a b c = Either a b -- ^^^^^ - lhs_loc = case map lhsTypeArgSrcSpan pats ++ map getLocA extra_kvars of + lhs_loc = case map lhsTypeArgSrcSpan pats of [] -> panic "rnFamEqn.lhs_loc" [loc] -> loc (loc:locs) -> loc `combineSrcSpans` last locs @@ -845,10 +819,9 @@ data ClosedTyFamInfo rnTyFamInstEqn :: AssocTyFamInfo -> TyFamInstEqn GhcPs -> RnM (TyFamInstEqn GhcRn, FreeVars) -rnTyFamInstEqn atfi eqn@(FamEqn { feqn_tycon = tycon, feqn_rhs = rhs }) - = rnFamEqn (TySynCtx tycon) atfi extra_kvs eqn rnTySyn - where - extra_kvs = extractHsTyRdrTyVarsKindVars rhs +rnTyFamInstEqn atfi eqn@(FamEqn { feqn_tycon = tycon }) + = rnFamEqn (TySynCtx tycon) atfi eqn rnTySyn + rnTyFamDefltDecl :: Name -> TyFamDefltDecl GhcPs @@ -859,11 +832,9 @@ rnDataFamInstDecl :: AssocTyFamInfo -> DataFamInstDecl GhcPs -> RnM (DataFamInstDecl GhcRn, FreeVars) rnDataFamInstDecl atfi (DataFamInstDecl { dfid_eqn = - eqn@(FamEqn { feqn_tycon = tycon - , feqn_rhs = rhs })}) - = do { let extra_kvs = extractDataDefnKindVars rhs - ; (eqn', fvs) <- - rnFamEqn (TyDataCtx tycon) atfi extra_kvs eqn rnDataDefn + eqn@(FamEqn { feqn_tycon = tycon })}) + = do { (eqn', fvs) <- + rnFamEqn (TyDataCtx tycon) atfi eqn rnDataDefn ; return (DataFamInstDecl { dfid_eqn = eqn' }, fvs) } -- Renaming of the associated types in instances. @@ -949,10 +920,7 @@ a class, we must check that all of the type variables mentioned on the RHS are properly scoped. Specifically, the rule is this: Every variable mentioned on the RHS of a type instance declaration - (whether associated or not) must be either - * Mentioned on the LHS, or - * Mentioned in an outermost kind signature on the RHS - (see Note [Implicit quantification in type synonyms]) + (whether associated or not) must be mentioned on the LHS Here is a simple example of something we should reject: @@ -962,8 +930,7 @@ Here is a simple example of something we should reject: type F Int x = z Here, `z` is mentioned on the RHS of the associated instance without being -mentioned on the LHS, nor is `z` mentioned in an outermost kind signature. The -renamer will reject `z` as being out of scope without much fuss. +mentioned on the LHS. The renamer will reject `z` as being out of scope without much fuss. Things get slightly trickier when the instance header itself binds type variables. Consider this example (adapted from #5515): @@ -1055,10 +1022,8 @@ Some additional wrinkles: Note that the `o` in the `Codomain 'KProxy` instance should be considered improperly scoped. It does not meet the criteria for being explicitly - quantified, as it is not mentioned by name on the LHS, nor does it meet the - criteria for being implicitly quantified, as it is used in a RHS kind - signature that is not outermost (see Note [Implicit quantification in type - synonyms]). However, `o` /is/ bound by the instance header, so if this + quantified, as it is not mentioned by name on the LHS. + However, `o` /is/ bound by the instance header, so if this program is not rejected by the renamer, the typechecker would treat it as though you had written this: @@ -1070,6 +1035,12 @@ Some additional wrinkles: If the user really wants the latter, it is simple enough to communicate their intent by mentioning `o` on the LHS by name. +* Historical note: Previously we had to add type variables from the outermost + kind signature on the RHS to the scope of associated type family instance, + i.e. GHC did implicit quantification over them. But now that we implement + GHC Proposal #425 "Invisible binders in type declarations" + we don't need to do this anymore. + Note [Type family equations and occurrences] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In most data/type family equations, the type family name used in the equation ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -19,6 +19,22 @@ Language This feature is guarded behind :extension:`TypeAbstractions`. +- In accordance with GHC proposal `#425 + `_ + GHC no longer implicitly quantifies over type variables that appear only in the RHS of type and + data family instances. This code will no longer work: :: + + type family F1 a :: k + type instance F1 Int = Any :: j -> j + + Instead you should write:: + + type instance F1 @(j -> j) Int = Any :: j -> j + + Or:: + + type instance forall j . F1 Int = Any :: j -> j + Compiler ~~~~~~~~ ===================================== testsuite/tests/indexed-types/should_compile/T14131.hs ===================================== @@ -9,21 +9,21 @@ import Data.Kind import Data.Proxy data family Nat :: k -> k -> Type -newtype instance Nat :: (k -> Type) -> (k -> Type) -> Type where +newtype instance Nat :: forall k . (k -> Type) -> (k -> Type) -> Type where Nat :: (forall xx. f xx -> g xx) -> Nat f g type family F :: Maybe a -type instance F = (Nothing :: Maybe a) +type instance F @a = (Nothing :: Maybe a) class C k where data CD :: k -> k -> Type type CT :: k instance C (Maybe a) where - data CD :: Maybe a -> Maybe a -> Type where + data CD @(Maybe a) :: Maybe a -> Maybe a -> Type where CD :: forall a (m :: Maybe a) (n :: Maybe a). Proxy m -> Proxy n -> CD m n - type CT = (Nothing :: Maybe a) + type CT @(Maybe a) = (Nothing :: Maybe a) class Z k where type ZT :: Maybe k - type ZT = (Nothing :: Maybe k) + type ZT @k = (Nothing :: Maybe k) ===================================== testsuite/tests/indexed-types/should_compile/T15852.hs ===================================== @@ -7,4 +7,4 @@ import Data.Kind import Data.Proxy data family DF a (b :: k) -data instance DF (Proxy c) :: Proxy j -> Type +data instance DF @(Proxy j) (Proxy c) :: Proxy j -> Type ===================================== testsuite/tests/indexed-types/should_compile/T15852.stderr ===================================== @@ -3,10 +3,10 @@ TYPE CONSTRUCTORS roles nominal nominal nominal COERCION AXIOMS axiom T15852.D:R:DFProxyProxy0 :: - forall k1 k2 (c :: k1) (j :: k2). - DF (Proxy c) = T15852.R:DFProxyProxy k1 k2 c j + forall k1 k2 (j :: k1) (c :: k2). + DF (Proxy c) = T15852.R:DFProxyProxy k1 k2 j c FAMILY INSTANCES - data instance forall {k1} {k2} {c :: k1} {j :: k2}. + data instance forall {k1} {k2} {j :: k1} {c :: k2}. DF (Proxy c) -- Defined at T15852.hs:10:15 Dependent modules: [] -Dependent packages: [base-4.17.0.0] +Dependent packages: [base-4.18.0.0] ===================================== testsuite/tests/indexed-types/should_fail/T14230.hs ===================================== @@ -8,4 +8,4 @@ class C k where data CD :: k -> k -> * instance C (Maybe a) where - data CD :: (k -> *) -> (k -> *) -> * + data forall k . CD :: (k -> *) -> (k -> *) -> * ===================================== testsuite/tests/indexed-types/should_fail/T7938.hs ===================================== @@ -9,4 +9,4 @@ class Foo (a :: k1) (b :: k2) where type Bar a instance Foo (a :: k1) (b :: k2) where - type Bar a = (KP :: KProxy k2) + type forall k2 . Bar a = (KP :: KProxy k2) ===================================== testsuite/tests/indexed-types/should_fail/T7938.stderr ===================================== @@ -1,5 +1,5 @@ -T7938.hs:12:17: error: [GHC-83865] +T7938.hs:12:29: error: [GHC-83865] • Expected a type, but ‘KP :: KProxy k2’ has kind ‘KProxy k2’ • In the type ‘(KP :: KProxy k2)’ In the type instance declaration for ‘Bar’ ===================================== testsuite/tests/rename/should_compile/T23512b.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies, TypeAbstractions #-} +module T23512b where +import GHC.Types + +type family F2 a :: k +type instance F2 @(j -> j) Int = Any :: j -> j + +type family F3 a :: k +type instance forall j. F3 Int = Any :: j -> j ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -212,3 +212,4 @@ test('T22122', [expect_broken(22122), extra_files(['T22122_aux.hs'])], multimod_ test('T23240', [req_th, extra_files(['T23240_aux.hs'])], multimod_compile, ['T23240', '-v0']) test('T23318', normal, compile, ['-Wduplicate-exports']) test('T23434', normal, compile, ['']) +test('T23512b', normal, compile, ['']) ===================================== testsuite/tests/rename/should_fail/T23512a.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies #-} +module T23512a where +import GHC.Types + +type family F1 a :: k +type instance F1 Int = Any :: j -> j + +data family D :: k -> Type +data instance D :: k -> Type ===================================== testsuite/tests/rename/should_fail/T23512a.stderr ===================================== @@ -0,0 +1,6 @@ + +T23512a.hs:6:31: error: [GHC-76037] Not in scope: type variable ‘j’ + +T23512a.hs:6:36: error: [GHC-76037] Not in scope: type variable ‘j’ + +T23512a.hs:9:20: error: [GHC-76037] Not in scope: type variable ‘k’ ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -198,3 +198,4 @@ test('RnUnexpectedStandaloneDeriving', normal, compile_fail, ['']) test('RnStupidThetaInGadt', normal, compile_fail, ['']) test('PackageImportsDisabled', normal, compile_fail, ['']) test('ImportLookupIllegal', normal, compile_fail, ['']) +test('T23512a', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/T15797.hs ===================================== @@ -13,7 +13,7 @@ import Data.Kind class Ríki (obj :: Type) where type Obj :: obj -> Constraint - type Obj = Bæ @k :: k -> Constraint + type forall k . Obj = Bæ @k :: k -> Constraint class Bæ (a :: k) instance Bæ @k (a :: k) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7cd6812b3911d336bf8791ffdb5bc0ea98b2d7b7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7cd6812b3911d336bf8791ffdb5bc0ea98b2d7b7 You're receiving 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 Jun 14 09:19:23 2023 From: gitlab at gitlab.haskell.org (=?UTF-8?B?R2VyZ8WRIMOJcmRpIChAY2FjdHVzKQ==?=) Date: Wed, 14 Jun 2023 05:19:23 -0400 Subject: [Git][ghc/ghc][wip/issue-23516] Add `IfaceWarnings` to represent the `ModIface`-storable parts Message-ID: <6489861b7bc13_17e3c2c5760391f7@gitlab.mail> Gergő Érdi pushed to branch wip/issue-23516 at Glasgow Haskell Compiler / GHC Commits: 8e14d2ab by Gergő Érdi at 2023-06-14T10:19:04+01:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 8 changed files: - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Types/SourceText.hs - compiler/GHC/Unit/Module/ModIface.hs - compiler/GHC/Unit/Module/Warnings.hs Changes: ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -102,7 +102,6 @@ import GHC.Types.PkgQual import GHC.Unit.External import GHC.Unit.Module -import GHC.Unit.Module.Warnings import GHC.Unit.Module.ModIface import GHC.Unit.Module.Deps import GHC.Unit.State @@ -1206,16 +1205,6 @@ pprTrustInfo trust = text "trusted:" <+> ppr trust pprTrustPkg :: Bool -> SDoc pprTrustPkg tpkg = text "require own pkg trusted:" <+> ppr tpkg -instance Outputable (Warnings pass) where - ppr = pprWarns - -pprWarns :: Warnings pass -> SDoc -pprWarns NoWarnings = Outputable.empty -pprWarns (WarnAll txt) = text "Warn all" <+> ppr txt -pprWarns (WarnSome prs) = text "Warnings:" - <+> vcat (map pprWarning prs) - where pprWarning (name, txt) = ppr name <+> ppr txt - pprIfaceAnnotation :: IfaceAnnotation -> SDoc pprIfaceAnnotation (IfaceAnnotation { ifAnnotatedTarget = target, ifAnnotatedValue = serialized }) = ppr target <+> text "annotated by" <+> ppr serialized ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -66,6 +66,8 @@ import GHC.Types.SourceFile import GHC.Types.TyThing import GHC.Types.HpcInfo import GHC.Types.CompleteMatch +import GHC.Types.SourceText +import GHC.Types.SrcLoc ( unLoc ) import GHC.Utils.Outputable import GHC.Utils.Panic @@ -291,7 +293,7 @@ mkIface_ hsc_env -- The order of fixities returned from nonDetNameEnvElts is not -- deterministic, so we sort by OccName to canonicalize it. -- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM for more details. - warns = src_warns + warns = toIfaceWarnings src_warns iface_rules = map coreRuleToIfaceRule rules iface_insts = map instanceToIfaceInst $ fixSafeInstances safe_mode (instEnvElts insts) iface_fam_insts = map famInstToIfaceFamInst fam_insts @@ -393,6 +395,21 @@ ifaceRoughMatchTcs tcs = map do_rough tcs do_rough (RM_KnownTc n) = Just (toIfaceTyCon_name n) -------------------------- +toIfaceWarnings :: Warnings GhcRn -> IfaceWarnings +toIfaceWarnings NoWarnings = IfNoWarnings +toIfaceWarnings (WarnAll txt) = IfWarnAll (toIfaceWarningTxt txt) +toIfaceWarnings (WarnSome prs) = IfWarnSome [(occ, toIfaceWarningTxt txt) | (occ, txt) <- prs] + +toIfaceWarningTxt :: WarningTxt GhcRn -> IfaceWarningTxt +toIfaceWarningTxt (WarningTxt mb_cat src strs) = IfWarningTxt (unLoc <$> mb_cat) (unLoc src) (map (toIfaceStringLiteralWithNames . unLoc) strs) +toIfaceWarningTxt (DeprecatedTxt src strs) = IfDeprecatedTxt (unLoc src) (map (toIfaceStringLiteralWithNames . unLoc) strs) + +toIfaceStringLiteralWithNames :: WithHsDocIdentifiers StringLiteral GhcRn -> (IfaceStringLiteral, [IfExtName]) +toIfaceStringLiteralWithNames (WithHsDocIdentifiers src names) = (toIfaceStringLiteral src, map unLoc names) + +toIfaceStringLiteral :: StringLiteral -> IfaceStringLiteral +toIfaceStringLiteral (StringLiteral sl fs _) = IfStringLiteral sl fs + coreRuleToIfaceRule :: CoreRule -> IfaceRule -- A plugin that installs a BuiltinRule in a CoreDoPluginPass should -- ensure that there's another CoreDoPluginPass that removes the rule. ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -962,7 +962,7 @@ addFingerprints hsc_env iface0 eps <- hscEPS hsc_env let decls = mi_decls iface0 - warn_fn = mkIfaceWarnCache (mi_warns iface0) + warn_fn = mkIfaceWarnCache (fromIfaceWarnings $ mi_warns iface0) fix_fn = mkIfaceFixCache (mi_fixities iface0) -- The ABI of a declaration represents everything that is made ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -16,6 +16,7 @@ module GHC.Iface.Syntax ( IfaceBindingX(..), IfaceMaybeRhs(..), IfaceConAlt(..), IfaceIdInfo, IfaceIdDetails(..), IfaceUnfolding(..), IfGuidance(..), IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget, + IfaceWarnings(..), IfaceWarningTxt(..), IfaceStringLiteral(..), IfaceClsInst(..), IfaceFamInst(..), IfaceTickish(..), IfaceClassBody(..), IfaceBang(..), @@ -32,6 +33,7 @@ module GHC.Iface.Syntax ( -- Misc ifaceDeclImplicitBndrs, visibleIfConDecls, ifaceDeclFingerprints, + fromIfaceWarnings, -- Free Names freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst, @@ -65,13 +67,17 @@ import GHC.Types.ForeignCall import GHC.Types.Annotations( AnnPayload, AnnTarget ) import GHC.Types.Basic import GHC.Unit.Module +import GHC.Unit.Module.Warnings import GHC.Types.SrcLoc +import GHC.Types.SourceText import GHC.Data.BooleanFormula ( BooleanFormula, pprBooleanFormula, isTrue ) import GHC.Types.Var( VarBndr(..), binderVar, tyVarSpecToBinders, visArgTypeLike ) import GHC.Core.TyCon ( Role (..), Injectivity(..), tyConBndrVisForAllTyFlag ) import GHC.Core.DataCon (SrcStrictness(..), SrcUnpackedness(..)) import GHC.Builtin.Types ( constraintKindTyConName ) import GHC.Stg.InferTags.TagSig +import GHC.Hs.Extension ( GhcRn ) +import GHC.Hs.Doc ( WithHsDocIdentifiers(..) ) import GHC.Utils.Lexeme (isLexSym) import GHC.Utils.Fingerprint @@ -323,6 +329,18 @@ data IfaceRule ifRuleOrph :: IsOrphan -- Just like IfaceClsInst } +data IfaceWarnings + = IfNoWarnings + | IfWarnAll IfaceWarningTxt + | IfWarnSome [(OccName, IfaceWarningTxt)] + +data IfaceWarningTxt + = IfWarningTxt (Maybe WarningCategory) SourceText [(IfaceStringLiteral, [IfExtName])] + | IfDeprecatedTxt SourceText [(IfaceStringLiteral, [IfExtName])] + +data IfaceStringLiteral + = IfStringLiteral SourceText FastString + data IfaceAnnotation = IfaceAnnotation { ifAnnotatedTarget :: IfaceAnnTarget, @@ -549,6 +567,24 @@ ifaceDeclFingerprints hash decl unsafeDupablePerformIO . computeFingerprint (panic "ifaceDeclFingerprints") +fromIfaceWarnings :: IfaceWarnings -> Warnings GhcRn +fromIfaceWarnings = \case + IfNoWarnings -> NoWarnings + IfWarnAll txt -> WarnAll (fromIfaceWarningTxt txt) + IfWarnSome prs -> WarnSome [(occ, fromIfaceWarningTxt txt) | (occ, txt) <- prs] + +fromIfaceWarningTxt :: IfaceWarningTxt -> WarningTxt GhcRn +fromIfaceWarningTxt = \case + IfWarningTxt mb_cat src strs -> WarningTxt (noLoc <$> mb_cat) (noLoc src) (noLoc <$> map fromIfaceStringLiteralWithNames strs) + IfDeprecatedTxt src strs -> DeprecatedTxt (noLoc src) (noLoc <$> map fromIfaceStringLiteralWithNames strs) + +fromIfaceStringLiteralWithNames :: (IfaceStringLiteral, [IfExtName]) -> WithHsDocIdentifiers StringLiteral GhcRn +fromIfaceStringLiteralWithNames (str, names) = WithHsDocIdentifiers (fromIfaceStringLiteral str) (map noLoc names) + +fromIfaceStringLiteral :: IfaceStringLiteral -> StringLiteral +fromIfaceStringLiteral (IfStringLiteral st fs) = StringLiteral st fs Nothing + + {- ************************************************************************ * * @@ -700,6 +736,23 @@ pprAxBranch pp_tc idx (IfaceAxBranch { ifaxbTyVars = tvs text "--" <+> text "incompatible with:" <+> pprWithCommas (\incomp -> text "#" <> ppr incomp) incomps +instance Outputable IfaceWarnings where + ppr = \case + IfNoWarnings -> empty + IfWarnAll txt -> text "Warn all" <+> ppr txt + IfWarnSome prs -> text "Warnings:" <+> vcat [ppr name <+> ppr txt | (name, txt) <- prs] + +instance Outputable IfaceWarningTxt where + ppr = \case + IfWarningTxt _ _ ws -> pp_ws ws + IfDeprecatedTxt _ ds -> pp_ws ds + where + pp_ws [msg] = ppr (fst msg) + pp_ws msgs = brackets $ vcat . punctuate comma . map (ppr . fst) $ msgs + +instance Outputable IfaceStringLiteral where + ppr (IfStringLiteral st fs) = pprWithSourceText st (ftext fs) + instance Outputable IfaceAnnotation where ppr (IfaceAnnotation target value) = ppr target <+> colon <+> ppr value @@ -2236,6 +2289,28 @@ instance Binary IfaceRule where a8 <- get bh return (IfaceRule a1 a2 a3 a4 a5 a6 a7 a8) +instance Binary IfaceWarnings where + put_ bh = \case + IfNoWarnings -> putByte bh 0 + IfWarnAll txt -> putByte bh 1 *> put_ bh txt + IfWarnSome prs -> putByte bh 2 *> put_ bh prs + get bh = getByte bh >>= \case + 0 -> pure IfNoWarnings + 1 -> pure IfWarnAll <*> get bh + _ -> pure IfWarnSome <*> get bh + +instance Binary IfaceWarningTxt where + put_ bh = \case + IfWarningTxt a1 a2 a3 -> putByte bh 0 *> put_ bh a1 *> put_ bh a2 *> put_ bh a3 + IfDeprecatedTxt a1 a2 -> putByte bh 1 *> put_ bh a1 *> put_ bh a2 + get bh = getByte bh >>= \case + 0 -> pure IfWarningTxt <*> get bh <*> get bh <*> get bh + _ -> pure IfDeprecatedTxt <*> get bh <*> get bh + +instance Binary IfaceStringLiteral where + put_ bh (IfStringLiteral a1 a2) = put_ bh a1 *> put_ bh a2 + get bh = IfStringLiteral <$> get bh <*> get bh + instance Binary IfaceAnnotation where put_ bh (IfaceAnnotation a1 a2) = do put_ bh a1 @@ -2786,5 +2861,19 @@ instance NFData IfaceClsInst where rnf (IfaceClsInst f1 f2 f3 f4 f5) = f1 `seq` rnf f2 `seq` rnf f3 `seq` f4 `seq` f5 `seq` () +instance NFData IfaceWarnings where + rnf = \case + IfNoWarnings -> () + IfWarnAll txt -> rnf txt + IfWarnSome txts -> rnf txts + +instance NFData IfaceWarningTxt where + rnf = \case + IfWarningTxt f1 f2 f3 -> rnf f1 `seq` rnf f2 `seq` rnf f3 + IfDeprecatedTxt f1 f2 -> rnf f1 `seq` rnf f2 + +instance NFData IfaceStringLiteral where + rnf (IfStringLiteral f1 f2) = rnf f1 `seq` rnf f2 + instance NFData IfaceAnnotation where rnf (IfaceAnnotation f1 f2) = f1 `seq` f2 `seq` () ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -47,6 +47,7 @@ import GHC.Tc.Zonk.TcType ( tcInitTidyEnv ) import GHC.Hs import GHC.Iface.Load ( loadSrcInterface ) +import GHC.Iface.Syntax ( fromIfaceWarnings ) import GHC.Builtin.Names import GHC.Parser.PostProcess ( setRdrNameSpace ) import GHC.Core.Type @@ -422,7 +423,7 @@ rnImportDecl this_mod imports = calculateAvails home_unit other_home_units iface mod_safe' want_boot (ImportedByUser imv) -- Complain if we import a deprecated module - case mi_warns iface of + case fromIfaceWarnings (mi_warns iface) of WarnAll txt -> addDiagnostic (TcRnDeprecatedModule imp_mod_name txt) _ -> return () ===================================== compiler/GHC/Types/SourceText.hs ===================================== @@ -1,5 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RecordWildCards #-} -- | Source text -- @@ -39,6 +41,7 @@ import Data.Function (on) import Data.Data import GHC.Real ( Ratio(..) ) import GHC.Types.SrcLoc +import Control.DeepSeq {- Note [Pragma source text] @@ -107,6 +110,11 @@ instance Outputable SourceText where ppr (SourceText s) = text "SourceText" <+> ftext s ppr NoSourceText = text "NoSourceText" +instance NFData SourceText where + rnf = \case + SourceText s -> rnf s + NoSourceText -> () + instance Binary SourceText where put_ bh NoSourceText = putByte bh 0 put_ bh (SourceText s) = do @@ -315,12 +323,3 @@ instance Eq StringLiteral where instance Outputable StringLiteral where ppr sl = pprWithSourceText (sl_st sl) (ftext $ sl_fs sl) - -instance Binary StringLiteral where - put_ bh (StringLiteral st fs _) = do - put_ bh st - put_ bh fs - get bh = do - st <- get bh - fs <- get bh - return (StringLiteral st fs Nothing) ===================================== compiler/GHC/Unit/Module/ModIface.hs ===================================== @@ -185,7 +185,7 @@ data ModIface_ (phase :: ModIfacePhase) -- ^ Fixities -- NOT STRICT! we read this field lazily from the interface file - mi_warns :: (Warnings GhcRn), + mi_warns :: IfaceWarnings, -- ^ Warnings -- NOT STRICT! we read this field lazily from the interface file @@ -479,7 +479,7 @@ instance Binary ModIface where mi_finsts = hasFamInsts, mi_exp_hash = exp_hash, mi_orphan_hash = orphan_hash, - mi_warn_fn = mkIfaceWarnCache warns, + mi_warn_fn = mkIfaceWarnCache $ fromIfaceWarnings warns, mi_fix_fn = mkIfaceFixCache fixities, mi_hash_fn = mkIfaceHashCache decls }}) @@ -498,7 +498,7 @@ emptyPartialModIface mod mi_exports = [], mi_used_th = False, mi_fixities = [], - mi_warns = NoWarnings, + mi_warns = IfNoWarnings, mi_anns = [], mi_insts = [], mi_fam_insts = [], @@ -567,7 +567,7 @@ instance ( NFData (IfaceBackendExts (phase :: ModIfacePhase)) `seq` mi_exports `seq` rnf mi_used_th `seq` mi_fixities - `seq` mi_warns + `seq` rnf mi_warns `seq` rnf mi_anns `seq` rnf mi_decls `seq` rnf mi_extra_decls ===================================== compiler/GHC/Unit/Module/Warnings.hs ===================================== @@ -5,6 +5,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE LambdaCase #-} -- | Warnings for a module module GHC.Unit.Module.Warnings @@ -40,7 +41,6 @@ import GHC.Types.SrcLoc import GHC.Types.Unique import GHC.Types.Unique.Set import GHC.Hs.Doc -import GHC.Hs.Extension import GHC.Utils.Outputable import GHC.Utils.Binary @@ -51,6 +51,7 @@ import Language.Haskell.Syntax.Extension import Data.Data import Data.List (isPrefixOf) import GHC.Generics ( Generic ) +import Control.DeepSeq {- @@ -103,7 +104,7 @@ the possibility of them being infinite. -- See Note [Warning categories] newtype WarningCategory = WarningCategory FastString - deriving (Binary, Data, Eq, Outputable, Show, Uniquable) + deriving (Binary, Data, Eq, Outputable, Show, Uniquable, NFData) mkWarningCategory :: FastString -> WarningCategory mkWarningCategory = WarningCategory @@ -203,29 +204,6 @@ instance Outputable (WarningTxt pass) where NoSourceText -> pp_ws ds SourceText src -> ftext src <+> pp_ws ds <+> text "#-}" -instance Binary (WarningTxt GhcRn) where - put_ bh (WarningTxt c s w) = do - putByte bh 0 - put_ bh $ unLoc <$> c - put_ bh $ unLoc s - put_ bh $ unLoc <$> w - put_ bh (DeprecatedTxt s d) = do - putByte bh 1 - put_ bh $ unLoc s - put_ bh $ unLoc <$> d - - get bh = do - h <- getByte bh - case h of - 0 -> do c <- fmap noLoc <$> get bh - s <- noLoc <$> get bh - w <- fmap noLoc <$> get bh - return (WarningTxt c s w) - _ -> do s <- noLoc <$> get bh - d <- fmap noLoc <$> get bh - return (DeprecatedTxt s d) - - pp_ws :: [Located (WithHsDocIdentifiers StringLiteral pass)] -> SDoc pp_ws [l] = ppr $ unLoc l pp_ws ws @@ -271,24 +249,6 @@ data Warnings pass deriving instance Eq (IdP pass) => Eq (Warnings pass) -instance Binary (Warnings GhcRn) where - put_ bh NoWarnings = putByte bh 0 - put_ bh (WarnAll t) = do - putByte bh 1 - put_ bh t - put_ bh (WarnSome ts) = do - putByte bh 2 - put_ bh ts - - get bh = do - h <- getByte bh - case h of - 0 -> return NoWarnings - 1 -> do aa <- get bh - return (WarnAll aa) - _ -> do aa <- get bh - return (WarnSome aa) - -- | Constructs the cache for the 'mi_warn_fn' field of a 'ModIface' mkIfaceWarnCache :: Warnings p -> OccName -> Maybe (WarningTxt p) mkIfaceWarnCache NoWarnings = \_ -> Nothing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8e14d2ab9cfae9eb5029f6b8c62ee604e738dfe8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8e14d2ab9cfae9eb5029f6b8c62ee604e738dfe8 You're receiving 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 Jun 14 09:26:52 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 14 Jun 2023 05:26:52 -0400 Subject: [Git][ghc/ghc][wip/T23109] 144 commits: Make Warn = Located DriverMessage Message-ID: <648987dcc341a_17e3c2c56e841330@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23109 at Glasgow Haskell Compiler / GHC Commits: 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - eadc9afe by Simon Peyton Jones at 2023-06-14T10:02:05+01:00 Make newtype instances opaque I think this will help with #23109 - - - - - 66dc8e86 by Simon Peyton Jones at 2023-06-14T10:02:05+01:00 Wibbles - - - - - b33c6802 by Simon Peyton Jones at 2023-06-14T10:03:13+01:00 Allow SelCo for newtype classes Experimental change - - - - - 28b3205c by Simon Peyton Jones at 2023-06-14T10:03:13+01:00 Wibble - - - - - c74f4fe7 by Simon Peyton Jones at 2023-06-14T10:26:29+01:00 Furher wibbles - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - HACKING.md - compiler/GHC.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types/Prim.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6ed9ec4cf48e6089caf0fd94496ed509078a5645...c74f4fe7c166ea20971000876d7cfc7e444f443f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6ed9ec4cf48e6089caf0fd94496ed509078a5645...c74f4fe7c166ea20971000876d7cfc7e444f443f You're receiving 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 Jun 14 11:01:43 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 14 Jun 2023 07:01:43 -0400 Subject: [Git][ghc/ghc][master] Add -Wmissing-poly-kind-signatures Message-ID: <64899e176842c_17e3c2c571085221@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - 11 changed files: - compiler/GHC/Core/Type.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Utils/Monad.hs - docs/users_guide/using-warnings.rst - + testsuite/tests/warnings/should_compile/T22826.hs - + testsuite/tests/warnings/should_compile/T22826.stderr - testsuite/tests/warnings/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -111,6 +111,7 @@ module GHC.Core.Type ( isTyVarTy, isFunTy, isCoercionTy, isCoercionTy_maybe, isForAllTy, isForAllTy_ty, isForAllTy_co, + isForAllTy_invis_ty, isPiTy, isTauTy, isFamFreeTy, isCoVarType, isAtomicTy, @@ -1891,6 +1892,15 @@ isForAllTy_ty ty | otherwise = False +-- | Like `isForAllTy`, but returns True only if it is an inferred tyvar binder +isForAllTy_invis_ty :: Type -> Bool +isForAllTy_invis_ty ty + | ForAllTy (Bndr tv (Invisible InferredSpec)) _ <- coreFullView ty + , isTyVar tv + = True + + | otherwise = False + -- | Like `isForAllTy`, but returns True only if it is a covar binder isForAllTy_co :: Type -> Bool isForAllTy_co ty ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -631,6 +631,7 @@ data WarningFlag = | Opt_WarnAmbiguousFields -- Since 9.2 | Opt_WarnImplicitLift -- Since 9.2 | Opt_WarnMissingKindSignatures -- Since 9.2 + | Opt_WarnMissingPolyKindSignatures -- Since 9.8 | Opt_WarnMissingExportedPatternSynonymSignatures -- since 9.2 | Opt_WarnRedundantStrictnessFlags -- Since 9.4 | Opt_WarnForallIdentifier -- Since 9.4 @@ -685,6 +686,7 @@ warnFlagNames wflag = case wflag of Opt_WarnSemigroup -> "semigroup" :| [] Opt_WarnMissingSignatures -> "missing-signatures" :| [] Opt_WarnMissingKindSignatures -> "missing-kind-signatures" :| [] + Opt_WarnMissingPolyKindSignatures -> "missing-poly-kind-signatures" :| [] Opt_WarnMissingExportedSignatures -> "missing-exported-signatures" :| [] Opt_WarnMonomorphism -> "monomorphism-restriction" :| [] Opt_WarnNameShadowing -> "name-shadowing" :| [] ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2192,6 +2192,7 @@ wWarningFlagsDeps = mconcat [ warnSpec Opt_WarnSemigroup, warnSpec Opt_WarnMissingSignatures, warnSpec Opt_WarnMissingKindSignatures, + warnSpec Opt_WarnMissingPolyKindSignatures, subWarnSpec "missing-exported-sigs" Opt_WarnMissingExportedSignatures "it is replaced by -Wmissing-exported-signatures", ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -1689,12 +1689,13 @@ warnMissingKindSignatures gbl_env tcs = tcg_tcs gbl_env ksig_ns = tcg_ksigs gbl_env exports = availsToNameSet (tcg_exports gbl_env) - not_ghc_generated :: Name -> Bool - not_ghc_generated name = name `elemNameSet` ksig_ns + + has_kind_signature :: Name -> Bool + has_kind_signature name = name `elemNameSet` ksig_ns add_ty_warn :: Bool -> TyCon -> RnM () add_ty_warn cusks_enabled tyCon = - when (not_ghc_generated name) $ + when (has_kind_signature name) $ addDiagnosticAt (getSrcSpan name) diag where name = tyConName tyCon ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -3321,8 +3321,8 @@ missingSignatureWarningFlags (MissingTopLevelBindingSig {}) exported missingSignatureWarningFlags (MissingPatSynSig {}) exported = Opt_WarnMissingPatternSynonymSignatures :| [ Opt_WarnMissingExportedPatternSynonymSignatures | IsExported == exported ] -missingSignatureWarningFlags (MissingTyConKindSig {}) _ - = Opt_WarnMissingKindSignatures :| [] +missingSignatureWarningFlags (MissingTyConKindSig ty_con _) _ + = Opt_WarnMissingKindSignatures :| [Opt_WarnMissingPolyKindSignatures | isForAllTy_invis_ty (tyConKind ty_con) ] useDerivingStrategies :: GhcHint useDerivingStrategies = ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -936,6 +936,7 @@ data TcRnMessage where -Wmissing-pattern-synonym-signatures -Wmissing-exported-pattern-synonym-signatures -Wmissing-kind-signatures + -Wmissing-poly-kind-signatures Test cases: T11077 (top-level bindings) ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -1543,6 +1543,17 @@ tryTcDiscardingErrs recover thing_inside tidy up the message; we then use it to tidy the context messages -} +{- + +Note [Reporting warning diagnostics] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We use functions below to report warnings. For the most part, +we do /not/ need to check any warning flags before doing so. +See https://gitlab.haskell.org/ghc/ghc/-/wikis/Errors-as-(structured)-values +for the design. + +-} + addErrTc :: TcRnMessage -> TcM () addErrTc err_msg = do { env0 <- liftZonkM tcInitTidyEnv ; addErrTcM (env0, err_msg) } ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -1324,6 +1324,31 @@ of ``-W(no-)*``. the parent class a standalone kind signature or CUSK is sufficient to fix the warning for the class's associated type families as well. +.. ghc-flag:: -Wmissing-poly-kind-signatures + :shortdesc: warn when inferred polykinded type or class declaration don't have kind signatures nor CUSKs + :type: dynamic + :reverse: -Wno-missing-poly-kind-signatures + :category: + + :since: 9.8 + :default: off + + .. index:: + single: kind signatures, missing + + This is a restricted version of :ghc-flag:`-Wmissing-kind-signatures`. + + It warns when a declaration defines a type constructor that lacks a :ref:`standalone kind signature ` + and whose inferred kind is polymorphic (which happens with `-PolyKinds`. For example :: + + data T a = MkT (a -> Int) -- T :: Type -> Type + -- Not polymorphic, hence no warning + data W f a = MkW (f a) -- W :: forall k. (k->Type) -> k -> Type + -- Polymorphic, hence warning! + + It is useful to catch accidentally polykinded types, or to make that polymorphism explicit, + without requiring a kind signature for every type. + .. ghc-flag:: -Wmissing-exported-pattern-synonym-signatures :shortdesc: warn about pattern synonyms without signatures, only if they are exported ===================================== testsuite/tests/warnings/should_compile/T22826.hs ===================================== @@ -0,0 +1,53 @@ +{-# OPTIONS_GHC -Wmissing-poly-kind-signatures #-} +{-# LANGUAGE GADTs, PolyKinds, TypeFamilies #-} +-- without standalone kind signatures or cusks: warnings +module T22826 where + +import Data.Kind (Type) + +-- type family +type family Id x where + Id Int = Int + +-- class definition +class Functor f => Alt f where + () :: f a -> f a -> f a + +-- polykinded class +class EqP f where + eqp :: f a -> f b -> Bool + +-- type alias +type Arr a b = a -> b +type B = Bool + +-- Haskell98 data +data YesNo = Yes | No +data V2 a = V2 a a + +-- GADT +data Free f a where + Pure :: a -> Free f a + Ap :: f b -> Free f (b -> a) -> Free f a + +-- data family +data family D1 a + +-- polykinded data +data Proxy a = Proxy + +-- associated type family +class C a where + type AT a b + +-- polykinded type with partial kind spec +-- not warned: PolyKinds don't add variables here +data D (k :: Type) a (b :: k) where + D :: [a] -> D k a b + +-- polykinded type without kind signature, which is polymorphic, +-- but PolyKinds won't change it. +data E a k b = MkE a (VProxy k b) + +type VProxy :: forall k -> k -> Type +data VProxy k a = MkVP ===================================== testsuite/tests/warnings/should_compile/T22826.stderr ===================================== @@ -0,0 +1,12 @@ + +T22826.hs:17:1: warning: [GHC-38417] [-Wmissing-poly-kind-signatures] + Top-level type constructor with no standalone kind signature: + type EqP :: forall {k}. (k -> *) -> Constraint + +T22826.hs:37:1: warning: [GHC-38417] [-Wmissing-poly-kind-signatures] + Top-level type constructor with no standalone kind signature: + type Proxy :: forall {k}. k -> * + +T22826.hs:40:1: warning: [GHC-38417] [-Wmissing-poly-kind-signatures] + Top-level type constructor with no standalone kind signature: + type C :: forall {k}. k -> Constraint ===================================== testsuite/tests/warnings/should_compile/all.T ===================================== @@ -64,3 +64,4 @@ test('DodgyImports', normal, compile, ['-Wdodgy-imports']) test('DodgyImports_hiding', normal, compile, ['-Wdodgy-imports']) test('T22702a', normal, compile, ['']) test('T22702b', normal, compile, ['']) +test('T22826', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e4b33a1ded2a3934f4b1bf61c348f06241eb49c5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e4b33a1ded2a3934f4b1bf61c348f06241eb49c5 You're receiving 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 Jun 14 11:02:21 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 14 Jun 2023 07:02:21 -0400 Subject: [Git][ghc/ghc][master] ci: special case in req_host_target_ghc for JS Message-ID: <64899e3dd3d5e_17e3c2c56fc8836f@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - 1 changed file: - testsuite/driver/testlib.py Changes: ===================================== testsuite/driver/testlib.py ===================================== @@ -327,12 +327,13 @@ def req_process( name, opts ): def req_host_target_ghc( name, opts ): """ - When testing a cross GHC, some test cases require a host GHC as - well (e.g. for compiling custom Setup.hs). This is not supported - yet (#23236), so for the time being we skip them when testing - cross GHCs. + When testing a cross GHC, some test cases require a host GHC as well (e.g. + for compiling custom Setup.hs). This is not supported yet (#23236), so for + the time being we skip them when testing cross GHCs. However, this is not + the case for the JS backend. The JS backend is a cross-compiler that + produces code that the host can run. """ - if isCross(): + if isCross() and not js_arch(): opts.skip = True def ignore_stdout(name, opts): View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f8395b94ad23bbf50248e3acdcfdd393005dba1e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f8395b94ad23bbf50248e3acdcfdd393005dba1e You're receiving 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 Jun 14 11:03:05 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 14 Jun 2023 07:03:05 -0400 Subject: [Git][ghc/ghc][master] When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Message-ID: <64899e69849a9_17e3c2c59cc9345e@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - 4 changed files: - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs Changes: ===================================== compiler/GHC/Data/BooleanFormula.hs ===================================== @@ -24,8 +24,7 @@ import Data.Data import GHC.Utils.Monad import GHC.Utils.Outputable -import GHC.Utils.Binary -import GHC.Parser.Annotation ( LocatedL, noLocA ) +import GHC.Parser.Annotation ( LocatedL ) import GHC.Types.SrcLoc import GHC.Types.Unique import GHC.Types.Unique.Set @@ -243,22 +242,3 @@ pprBooleanFormulaNormal = go go (Or []) = keyword $ text "FALSE" go (Or xs) = fsep $ intersperse vbar (map (go . unLoc) xs) go (Parens x) = parens (go $ unLoc x) - - ----------------------------------------------------------------------- --- Binary ----------------------------------------------------------------------- - -instance Binary a => Binary (BooleanFormula a) where - put_ bh (Var x) = putByte bh 0 >> put_ bh x - put_ bh (And xs) = putByte bh 1 >> put_ bh (unLoc <$> xs) - put_ bh (Or xs) = putByte bh 2 >> put_ bh (unLoc <$> xs) - put_ bh (Parens x) = putByte bh 3 >> put_ bh (unLoc x) - - get bh = do - h <- getByte bh - case h of - 0 -> Var <$> get bh - 1 -> And . fmap noLocA <$> get bh - 2 -> Or . fmap noLocA <$> get bh - _ -> Parens . noLocA <$> get bh ===================================== compiler/GHC/Iface/Decl.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE NondecreasingIndentation #-} +{-# LANGUAGE LambdaCase #-} {- (c) The University of Glasgow 2006-2008 @@ -12,6 +13,7 @@ module GHC.Iface.Decl ( coAxiomToIfaceDecl , tyThingToIfaceDecl -- Converting things to their Iface equivalents + , toIfaceBooleanFormula ) where @@ -38,12 +40,14 @@ import GHC.Types.Var import GHC.Types.Name import GHC.Types.Basic import GHC.Types.TyThing +import GHC.Types.SrcLoc import GHC.Utils.Panic.Plain import GHC.Utils.Misc import GHC.Data.FastString import GHC.Data.Maybe +import GHC.Data.BooleanFormula import Data.List ( findIndex, mapAccumL ) @@ -284,7 +288,7 @@ classToIfaceDecl env clas ifClassCtxt = tidyToIfaceContext env1 sc_theta, ifATs = map toIfaceAT clas_ats, ifSigs = map toIfaceClassOp op_stuff, - ifMinDef = fmap getOccFS (classMinimalDef clas) + ifMinDef = toIfaceBooleanFormula $ fmap getOccFS (classMinimalDef clas) } (env1, tc_binders) = tidyTyConBinders env (tyConBinders tycon) @@ -332,3 +336,10 @@ tidyTyConBinders = mapAccumL tidyTyConBinder tidyTyVar :: TidyEnv -> TyVar -> FastString tidyTyVar (_, subst) tv = toIfaceTyVar (lookupVarEnv subst tv `orElse` tv) + +toIfaceBooleanFormula :: BooleanFormula IfLclName -> IfaceBooleanFormula +toIfaceBooleanFormula = \case + Var nm -> IfVar nm + And bfs -> IfAnd (map (toIfaceBooleanFormula . unLoc) bfs) + Or bfs -> IfOr (map (toIfaceBooleanFormula . unLoc) bfs) + Parens bf -> IfParens (toIfaceBooleanFormula . unLoc $ bf) ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -17,7 +17,7 @@ module GHC.Iface.Syntax ( IfaceIdInfo, IfaceIdDetails(..), IfaceUnfolding(..), IfGuidance(..), IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget, IfaceClsInst(..), IfaceFamInst(..), IfaceTickish(..), - IfaceClassBody(..), + IfaceClassBody(..), IfaceBooleanFormula(..), IfaceBang(..), IfaceSrcBang(..), SrcUnpackedness(..), SrcStrictness(..), IfaceAxBranch(..), @@ -32,6 +32,7 @@ module GHC.Iface.Syntax ( -- Misc ifaceDeclImplicitBndrs, visibleIfConDecls, ifaceDeclFingerprints, + fromIfaceBooleanFormula, -- Free Names freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst, @@ -66,12 +67,13 @@ import GHC.Types.Annotations( AnnPayload, AnnTarget ) import GHC.Types.Basic import GHC.Unit.Module import GHC.Types.SrcLoc -import GHC.Data.BooleanFormula ( BooleanFormula, pprBooleanFormula, isTrue ) +import GHC.Data.BooleanFormula ( BooleanFormula(..), pprBooleanFormula, isTrue ) import GHC.Types.Var( VarBndr(..), binderVar, tyVarSpecToBinders, visArgTypeLike ) import GHC.Core.TyCon ( Role (..), Injectivity(..), tyConBndrVisForAllTyFlag ) import GHC.Core.DataCon (SrcStrictness(..), SrcUnpackedness(..)) import GHC.Builtin.Types ( constraintKindTyConName ) import GHC.Stg.InferTags.TagSig +import GHC.Parser.Annotation (noLocA) import GHC.Utils.Lexeme (isLexSym) import GHC.Utils.Fingerprint @@ -191,9 +193,22 @@ data IfaceClassBody ifClassCtxt :: IfaceContext, -- Super classes ifATs :: [IfaceAT], -- Associated type families ifSigs :: [IfaceClassOp], -- Method signatures - ifMinDef :: BooleanFormula IfLclName -- Minimal complete definition + ifMinDef :: IfaceBooleanFormula -- Minimal complete definition } +data IfaceBooleanFormula + = IfVar IfLclName + | IfAnd [IfaceBooleanFormula] + | IfOr [IfaceBooleanFormula] + | IfParens IfaceBooleanFormula + +fromIfaceBooleanFormula :: IfaceBooleanFormula -> BooleanFormula IfLclName +fromIfaceBooleanFormula = \case + IfVar nm -> Var nm + IfAnd ibfs -> And (map (noLocA . fromIfaceBooleanFormula) ibfs) + IfOr ibfs -> Or (map (noLocA . fromIfaceBooleanFormula) ibfs) + IfParens ibf -> Parens (noLocA . fromIfaceBooleanFormula $ ibf) + data IfaceTyConParent = IfNoParent | IfDataInstance @@ -930,7 +945,7 @@ pprIfaceDecl ss (IfaceClass { ifName = clas , pprClassStandaloneKindSig ss clas (mkIfaceTyConKind binders constraintIfaceKind) , text "class" <+> pprIfaceDeclHead suppress_bndr_sig context ss clas binders <+> pprFundeps fds <+> pp_where , nest 2 (vcat [ vcat asocs, vcat dsigs - , ppShowAllSubs ss (pprMinDef minDef)])] + , ppShowAllSubs ss (pprMinDef $ fromIfaceBooleanFormula minDef)])] where pp_where = ppShowRhs ss $ ppUnless (null sigs && null ats) (text "where") @@ -2038,6 +2053,20 @@ instance Binary IfaceDecl where ifBody = IfAbstractClass }) _ -> panic (unwords ["Unknown IfaceDecl tag:", show h]) +instance Binary IfaceBooleanFormula where + put_ bh = \case + IfVar a1 -> putByte bh 0 >> put_ bh a1 + IfAnd a1 -> putByte bh 1 >> put_ bh a1 + IfOr a1 -> putByte bh 2 >> put_ bh a1 + IfParens a1 -> putByte bh 3 >> put_ bh a1 + + get bh = do + getByte bh >>= \case + 0 -> IfVar <$> get bh + 1 -> IfAnd <$> get bh + 2 -> IfOr <$> get bh + _ -> IfParens <$> get bh + {- Note [Lazy deserialization of IfaceId] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The use of lazyPut and lazyGet in the IfaceId Binary instance is @@ -2650,7 +2679,14 @@ instance NFData IfaceAxBranch where instance NFData IfaceClassBody where rnf = \case IfAbstractClass -> () - IfConcreteClass f1 f2 f3 f4 -> rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` f4 `seq` () + IfConcreteClass f1 f2 f3 f4 -> rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` () + +instance NFData IfaceBooleanFormula where + rnf = \case + IfVar f1 -> rnf f1 + IfAnd f1 -> rnf f1 + IfOr f1 -> rnf f1 + IfParens f1 -> rnf f1 instance NFData IfaceAT where rnf (IfaceAT f1 f2) = rnf f1 `seq` rnf f2 ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -44,6 +44,7 @@ import GHC.Driver.Config.Core.Lint ( initLintConfig ) import GHC.Builtin.Types.Literals(typeNatCoAxiomRules) import GHC.Builtin.Types +import GHC.Iface.Decl (toIfaceBooleanFormula) import GHC.Iface.Syntax import GHC.Iface.Load import GHC.Iface.Env @@ -290,7 +291,7 @@ mergeIfaceDecl d1 d2 (mkNameEnv [ (n, op) | op@(IfaceClassOp n _ _) <- ops2 ]) in d1 { ifBody = (ifBody d1) { ifSigs = ops, - ifMinDef = BF.mkOr [noLocA bf1, noLocA bf2] + ifMinDef = toIfaceBooleanFormula . BF.mkOr . map (noLocA . fromIfaceBooleanFormula) $ [bf1, bf2] } } `withRolesFrom` d2 -- It doesn't matter; we'll check for consistency later when @@ -773,7 +774,7 @@ tc_iface_decl _parent ignore_prags ifBody = IfConcreteClass { ifClassCtxt = rdr_ctxt, ifATs = rdr_ats, ifSigs = rdr_sigs, - ifMinDef = mindef_occ + ifMinDef = if_mindef }}) = bindIfaceTyConBinders binders $ \ binders' -> do { traceIf (text "tc-iface-class1" <+> ppr tc_name) @@ -782,6 +783,7 @@ tc_iface_decl _parent ignore_prags ; sigs <- mapM tc_sig rdr_sigs ; fds <- mapM tc_fd rdr_fds ; traceIf (text "tc-iface-class3" <+> ppr tc_name) + ; let mindef_occ = fromIfaceBooleanFormula if_mindef ; mindef <- traverse (lookupIfaceTop . mkVarOccFS) mindef_occ ; cls <- fixM $ \ cls -> do { ats <- mapM (tc_at cls) rdr_ats View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b852a5b662aaad6d651734ffd16852beedf7e99a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b852a5b662aaad6d651734ffd16852beedf7e99a You're receiving 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 Jun 14 11:03:38 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 14 Jun 2023 07:03:38 -0400 Subject: [Git][ghc/ghc][master] Add a testcase for #20076 Message-ID: <64899e8a3666a_17e3c21b5779097117@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - 3 changed files: - compiler/GHC/Tc/Types/Origin.hs - testsuite/tests/typecheck/should_fail/T23427.hs - testsuite/tests/typecheck/should_fail/T23427.stderr Changes: ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -830,7 +830,7 @@ pprCtOrigin (InstProvidedOrigin mod cls_inst) pprCtOrigin (ImpedanceMatching x) = vcat [ text "arising when matching required constraints" - , text "in a recursive group involving" <+> quotes (ppr x)] + , text "in a group involving" <+> quotes (ppr x)] pprCtOrigin (CycleBreakerOrigin orig) = pprCtOrigin orig ===================================== testsuite/tests/typecheck/should_fail/T23427.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} module T23427 where class C a where @@ -8,3 +9,7 @@ indent n = doText n where doText x = const (f x) doTail doTail _ = const n doText + +-- Test case from #20076 +x :: Num a => a +(x, y) = (1.2, 3.4) ===================================== testsuite/tests/typecheck/should_fail/T23427.stderr ===================================== @@ -1,12 +1,12 @@ -T23427.hs:9:7: error: [GHC-39999] +T23427.hs:10:7: error: [GHC-39999] • Could not deduce ‘C a0’ arising when matching required constraints - in a recursive group involving ‘doTail’ + in a group involving ‘doTail’ from the context: C a bound by the type signature for: indent :: forall a. C a => a -> a - at T23427.hs:6:1-23 + at T23427.hs:7:1-23 The type variable ‘a0’ is ambiguous • In an equation for ‘indent’: indent n @@ -14,3 +14,12 @@ T23427.hs:9:7: error: [GHC-39999] where doText x = const (f x) doTail doTail _ = const n doText + +T23427.hs:15:1: error: [GHC-39999] + Could not deduce ‘Fractional a’ + arising when matching required constraints + in a group involving ‘x’ + from the context: Num a + bound by the inferred type for ‘x’: + forall a. Num a => a + at T23427.hs:15:1-19 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c29b45eefc27cacb0ea014d856500396e178da25 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c29b45eefc27cacb0ea014d856500396e178da25 You're receiving 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 Jun 14 11:04:18 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 14 Jun 2023 07:04:18 -0400 Subject: [Git][ghc/ghc][master] Use tcInferFRR to prevent bad generalisation Message-ID: <64899eb222123_17e3c2c56e81022c3@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - 5 changed files: - compiler/GHC/Tc/Gen/Bind.hs - testsuite/tests/polykinds/T22743.stderr - + testsuite/tests/rep-poly/T23176.hs - + testsuite/tests/rep-poly/T23176.stderr - testsuite/tests/rep-poly/all.T Changes: ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -1210,20 +1210,10 @@ This check, mkInferredPolyId, is really in the wrong place: `inferred_poly_ty` doesn't obey the PKTI and it would be better not to generalise it in the first place; see #20686. But for now it works. -How else could we avoid generalising over escaping type variables? I -considered: - -* Adjust the generalisation in GHC.Tc.Solver to directly check for - escaping kind variables; instead, promote or default them. But that - gets into the defaulting swamp and is a non-trivial and unforced - change, so I have left it alone for now. - -* When inferring the type of a binding, in `tcMonoBinds`, we create - an ExpSigmaType with `tcInfer`. If we simply gave it an ir_frr field - that said "must have fixed runtime rep", then the kind would be made - Concrete; and we never generalise over Concrete variables. A bit - more indirect, but we need the "don't generalise over Concrete variables" - stuff anyway. +I considered adjusting the generalisation in GHC.Tc.Solver to directly check for +escaping kind variables; instead, promoting or defaulting them. But that +gets into the defaulting swamp and is a non-trivial and unforced +change, so I have left it alone for now. Note [Impedance matching] ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1312,7 +1302,9 @@ tcMonoBinds is_rec sig_fn no_gen , Nothing <- sig_fn name -- ...with no type signature = setSrcSpanA b_loc $ do { ((co_fn, matches'), rhs_ty') - <- tcInfer $ \ exp_ty -> + <- tcInferFRR (FRRBinder name) $ \ exp_ty -> + -- tcInferFRR: the type of a let-binder must have + -- a fixed runtime rep. See #23176 tcExtendBinderStack [TcIdBndr_ExpType name exp_ty NotTopLevel] $ -- We extend the error context even for a non-recursive -- function so that in type error messages we show the @@ -1334,7 +1326,9 @@ tcMonoBinds is_rec sig_fn no_gen | NonRecursive <- is_rec -- ...binder isn't mentioned in RHS , all (isNothing . sig_fn) bndrs = addErrCtxt (patMonoBindsCtxt pat grhss) $ - do { (grhss', pat_ty) <- tcInfer $ \ exp_ty -> + do { (grhss', pat_ty) <- tcInferFRR FRRPatBind $ \ exp_ty -> + -- tcInferFRR: the type of each let-binder must have + -- a fixed runtime rep. See #23176 tcGRHSsPat grhss exp_ty ; let exp_pat_ty :: Scaled ExpSigmaTypeFRR ===================================== testsuite/tests/polykinds/T22743.stderr ===================================== @@ -1,7 +1,10 @@ -T22743.hs:10:1: error: [GHC-31147] - • Quantified type's kind mentions quantified type variable - type: ‘forall {f :: * -> RuntimeRep} {g} {a :: TYPE (f g)}. a’ - where the body of the forall has this kind: ‘TYPE (f g)’ - • When checking the inferred type - x :: forall {f :: * -> RuntimeRep} {g} {a :: TYPE (f g)}. a +T22743.hs:10:1: error: [GHC-52083] + The binder ‘x’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T22743.hs:10:1: error: [GHC-52083] + The binder ‘x’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. ===================================== testsuite/tests/rep-poly/T23176.hs ===================================== @@ -0,0 +1,6 @@ +module T23176 where + +import GHC.Exts + +f = outOfScope :: (_ :: TYPE (r s)) +(g :: _) = outOfScope :: (_ :: TYPE (r s)) ===================================== testsuite/tests/rep-poly/T23176.stderr ===================================== @@ -0,0 +1,30 @@ + +T23176.hs:5:1: error: [GHC-52083] + The binder ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23176.hs:5:1: error: [GHC-52083] + The binder ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23176.hs:5:1: error: [GHC-52083] + The binder ‘f’ + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23176.hs:6:1: error: [GHC-52083] + The pattern binding + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23176.hs:6:1: error: [GHC-52083] + The pattern binding + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. + +T23176.hs:6:1: error: [GHC-52083] + The pattern binding + cannot be assigned a fixed runtime representation, not even by defaulting. + Suggested fix: Add a type signature. ===================================== testsuite/tests/rep-poly/all.T ===================================== @@ -118,3 +118,4 @@ test('T21650_b', normal, compile_fail, ['-Wno-deprecated-flags']) ## test('T23051', normal, compile_fail, ['']) test('T23153', normal, compile_fail, ['']) test('T23154', normal, compile_fail, ['']) +test('T23176', normal, compile_fail, ['-XPartialTypeSignatures -fdefer-out-of-scope-variables']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b80ef202d24a3d529d4409d7a6815a9644ea32a9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b80ef202d24a3d529d4409d7a6815a9644ea32a9 You're receiving 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 Jun 14 11:04:52 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 14 Jun 2023 07:04:52 -0400 Subject: [Git][ghc/ghc][master] ci: Add dependenices on necessary aarch64 jobs for head.hackage ci Message-ID: <64899ed4a9ffd_17e3c2306f38010709a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -718,6 +718,12 @@ hackage-lint: - job: nightly-x86_64-linux-deb10-numa-slow-validate optional: true artifacts: false + - job: nightly-aarch64-linux-deb10-validate + optional: true + artifacts: false + - job: aarch64-linux-deb10-validate + optional: true + artifacts: false extends: .hackage variables: SLOW_VALIDATE: 1 @@ -733,6 +739,9 @@ hackage-label-lint: - job: x86_64-linux-deb10-numa-slow-validate optional: true artifacts: false + - job: aarch64-linux-deb10-validate + optional: true + artifacts: false extends: .hackage variables: SLOW_VALIDATE: 1 @@ -747,6 +756,9 @@ nightly-hackage-lint: - job: nightly-x86_64-linux-deb10-numa-slow-validate optional: true artifacts: false + - job: nightly-aarch64-linux-deb10-validate + optional: true + artifacts: false rules: - if: $NIGHTLY variables: @@ -761,6 +773,9 @@ nightly-hackage-perf: - job: nightly-x86_64-linux-fedora33-release optional: true artifacts: false + - job: nightly-aarch64-linux-deb10-validate + optional: true + artifacts: false rules: - if: $NIGHTLY variables: @@ -777,6 +792,9 @@ release-hackage-lint: - job: release-x86_64-linux-fedora33-release optional: true artifacts: false + - job: release-aarch64-linux-deb10-release+no_split_sections + optional: true + artifacts: false rules: - if: '$RELEASE_JOB == "yes"' extends: .hackage View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bd8ef37d3a494579f3b29a14af74ab91de07c6a2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bd8ef37d3a494579f3b29a14af74ab91de07c6a2 You're receiving 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 Jun 14 11:05:37 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 14 Jun 2023 07:05:37 -0400 Subject: [Git][ghc/ghc][master] Add standalone kind signatures for Code and TExp Message-ID: <64899f012c246_17e3c2341481411078e@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - 1 changed file: - libraries/template-haskell/Language/Haskell/TH/Syntax.hs Changes: ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -8,6 +8,7 @@ {-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-} {-# LANGUAGE TemplateHaskellQuotes #-} +{-# LANGUAGE StandaloneKindSignatures #-} ----------------------------------------------------------------------------- -- | @@ -57,6 +58,7 @@ import GHC.CString ( unpackCString# ) import GHC.Generics ( Generic ) import GHC.Types ( Int(..), Word(..), Char(..), Double(..), Float(..), TYPE, RuntimeRep(..), Multiplicity (..) ) +import qualified Data.Kind as Kind (Type) import GHC.Prim ( Int#, Word#, Char#, Double#, Float#, Addr# ) import GHC.Ptr ( Ptr, plusPtr ) import GHC.Lexeme ( startsVarSym, startsVarId ) @@ -332,8 +334,9 @@ instance Quote Q where -- ----------------------------------------------------- +type TExp :: TYPE r -> Kind.Type type role TExp nominal -- See Note [Role of TExp] -newtype TExp (a :: TYPE (r :: RuntimeRep)) = TExp +newtype TExp a = TExp { unType :: Exp -- ^ Underlying untyped Template Haskell expression } -- ^ Typed wrapper around an 'Exp'. @@ -376,8 +379,9 @@ The splice will evaluate to (MkAge 3) and you can't add that to -- Code constructor +type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type type role Code representational nominal -- See Note [Role of TExp] -newtype Code m (a :: TYPE (r :: RuntimeRep)) = Code +newtype Code m a = Code { examineCode :: m (TExp a) -- ^ Underlying monadic value } -- ^ Represents an expression which has type @a@, built in monadic context @m at . Built on top of 'TExp', typed View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a0c27cee239462bb9346c8fdbe7f6fd1e6f265a5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a0c27cee239462bb9346c8fdbe7f6fd1e6f265a5 You're receiving 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 Jun 14 11:06:09 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 14 Jun 2023 07:06:09 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Warn that GHC.TypeLits.Internal should not be used Message-ID: <64899f214cc49_17e3c2c57101144a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 2 changed files: - libraries/base/GHC/TypeLits/Internal.hs - libraries/base/GHC/TypeNats/Internal.hs Changes: ===================================== libraries/base/GHC/TypeLits/Internal.hs ===================================== @@ -5,9 +5,14 @@ {-# OPTIONS_HADDOCK not-home #-} {-| -This module exports the Type Literal kinds as well as the comparison type -families for those kinds. It is needed to prevent module cycles while still -allowing these identifiers to be imported in 'Data.Type.Ord'. +DO NOT USE THIS MODULE. Use "GHC.TypeLits" instead. + +This module is internal-only and was exposed by accident. It may be +removed without warning in a future version. + +(The technical reason for this module's existence is that it is needed +to prevent module cycles while still allowing these identifiers to be +imported in 'Data.Type.Ord'.) @since 4.16.0.0 -} ===================================== libraries/base/GHC/TypeNats/Internal.hs ===================================== @@ -5,9 +5,14 @@ {-# OPTIONS_HADDOCK not-home #-} {-| -This module exports the Type Nat kind as well as the comparison type -family for that kinds. It is needed to prevent module cycles while still -allowing these identifiers to be imported in 'Data.Type.Ord'. +DO NOT USE THIS MODULE. Use "GHC.TypeNats" instead. + +This module is internal-only and was exposed by accident. It may be +removed without warning in a future version. + +(The technical reason for this module's existence is that it is needed +to prevent module cycles while still allowing these identifiers to be +imported in 'Data.Type.Ord'.) @since 4.16.0.0 -} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a0c27cee239462bb9346c8fdbe7f6fd1e6f265a5...100650e35d6d17965e293160785360933c9e0a25 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a0c27cee239462bb9346c8fdbe7f6fd1e6f265a5...100650e35d6d17965e293160785360933c9e0a25 You're receiving 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 Jun 14 11:38:16 2023 From: gitlab at gitlab.haskell.org (=?UTF-8?B?R2VyZ8WRIMOJcmRpIChAY2FjdHVzKQ==?=) Date: Wed, 14 Jun 2023 07:38:16 -0400 Subject: [Git][ghc/ghc][wip/issue-23516] 20 commits: Change WarningWithFlag to plural WarningWithFlags Message-ID: <6489a6a8e607e_17e3c242e16a81370c1@gitlab.mail> Gergő Érdi pushed to branch wip/issue-23516 at Glasgow Haskell Compiler / GHC Commits: a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 5e4ff3b0 by Gergő Érdi at 2023-06-14T19:27:49+08:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Core/Type.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Types/SourceText.hs - compiler/GHC/Unit/Module/ModIface.hs - compiler/GHC/Unit/Module/Warnings.hs - compiler/GHC/Utils/Error.hs - configure.ac - distrib/configure.ac.in - docs/users_guide/9.8.1-notes.rst - docs/users_guide/ghci.rst - docs/users_guide/using-warnings.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8e14d2ab9cfae9eb5029f6b8c62ee604e738dfe8...5e4ff3b031059d64b05d1ccc5d744e84e1e19d24 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8e14d2ab9cfae9eb5029f6b8c62ee604e738dfe8...5e4ff3b031059d64b05d1ccc5d744e84e1e19d24 You're receiving 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 Jun 14 11:38:52 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Wed, 14 Jun 2023 07:38:52 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/sand-witch/DIB-INSTANCES Message-ID: <6489a6cc50670_17e3c244975ec137443@gitlab.mail> Andrei Borzenkov pushed new branch wip/sand-witch/DIB-INSTANCES at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sand-witch/DIB-INSTANCES You're receiving 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 Jun 14 11:39:53 2023 From: gitlab at gitlab.haskell.org (=?UTF-8?B?R2VyZ8WRIMOJcmRpIChAY2FjdHVzKQ==?=) Date: Wed, 14 Jun 2023 07:39:53 -0400 Subject: [Git][ghc/ghc][wip/issue-23516] Add `IfaceWarnings` to represent the `ModIface`-storable parts Message-ID: <6489a709cfb61_17e3c2445d50413764b@gitlab.mail> Gergő Érdi pushed to branch wip/issue-23516 at Glasgow Haskell Compiler / GHC Commits: a5504526 by Gergő Érdi at 2023-06-14T19:39:25+08:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 8 changed files: - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Types/SourceText.hs - compiler/GHC/Unit/Module/ModIface.hs - compiler/GHC/Unit/Module/Warnings.hs Changes: ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -102,7 +102,6 @@ import GHC.Types.PkgQual import GHC.Unit.External import GHC.Unit.Module -import GHC.Unit.Module.Warnings import GHC.Unit.Module.ModIface import GHC.Unit.Module.Deps import GHC.Unit.State @@ -1206,16 +1205,6 @@ pprTrustInfo trust = text "trusted:" <+> ppr trust pprTrustPkg :: Bool -> SDoc pprTrustPkg tpkg = text "require own pkg trusted:" <+> ppr tpkg -instance Outputable (Warnings pass) where - ppr = pprWarns - -pprWarns :: Warnings pass -> SDoc -pprWarns NoWarnings = Outputable.empty -pprWarns (WarnAll txt) = text "Warn all" <+> ppr txt -pprWarns (WarnSome prs) = text "Warnings:" - <+> vcat (map pprWarning prs) - where pprWarning (name, txt) = ppr name <+> ppr txt - pprIfaceAnnotation :: IfaceAnnotation -> SDoc pprIfaceAnnotation (IfaceAnnotation { ifAnnotatedTarget = target, ifAnnotatedValue = serialized }) = ppr target <+> text "annotated by" <+> ppr serialized ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -66,6 +66,8 @@ import GHC.Types.SourceFile import GHC.Types.TyThing import GHC.Types.HpcInfo import GHC.Types.CompleteMatch +import GHC.Types.SourceText +import GHC.Types.SrcLoc ( unLoc ) import GHC.Utils.Outputable import GHC.Utils.Panic @@ -291,7 +293,7 @@ mkIface_ hsc_env -- The order of fixities returned from nonDetNameEnvElts is not -- deterministic, so we sort by OccName to canonicalize it. -- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM for more details. - warns = src_warns + warns = toIfaceWarnings src_warns iface_rules = map coreRuleToIfaceRule rules iface_insts = map instanceToIfaceInst $ fixSafeInstances safe_mode (instEnvElts insts) iface_fam_insts = map famInstToIfaceFamInst fam_insts @@ -393,6 +395,21 @@ ifaceRoughMatchTcs tcs = map do_rough tcs do_rough (RM_KnownTc n) = Just (toIfaceTyCon_name n) -------------------------- +toIfaceWarnings :: Warnings GhcRn -> IfaceWarnings +toIfaceWarnings NoWarnings = IfNoWarnings +toIfaceWarnings (WarnAll txt) = IfWarnAll (toIfaceWarningTxt txt) +toIfaceWarnings (WarnSome prs) = IfWarnSome [(occ, toIfaceWarningTxt txt) | (occ, txt) <- prs] + +toIfaceWarningTxt :: WarningTxt GhcRn -> IfaceWarningTxt +toIfaceWarningTxt (WarningTxt mb_cat src strs) = IfWarningTxt (unLoc <$> mb_cat) (unLoc src) (map (toIfaceStringLiteralWithNames . unLoc) strs) +toIfaceWarningTxt (DeprecatedTxt src strs) = IfDeprecatedTxt (unLoc src) (map (toIfaceStringLiteralWithNames . unLoc) strs) + +toIfaceStringLiteralWithNames :: WithHsDocIdentifiers StringLiteral GhcRn -> (IfaceStringLiteral, [IfExtName]) +toIfaceStringLiteralWithNames (WithHsDocIdentifiers src names) = (toIfaceStringLiteral src, map unLoc names) + +toIfaceStringLiteral :: StringLiteral -> IfaceStringLiteral +toIfaceStringLiteral (StringLiteral sl fs _) = IfStringLiteral sl fs + coreRuleToIfaceRule :: CoreRule -> IfaceRule -- A plugin that installs a BuiltinRule in a CoreDoPluginPass should -- ensure that there's another CoreDoPluginPass that removes the rule. ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -962,7 +962,7 @@ addFingerprints hsc_env iface0 eps <- hscEPS hsc_env let decls = mi_decls iface0 - warn_fn = mkIfaceWarnCache (mi_warns iface0) + warn_fn = mkIfaceWarnCache (fromIfaceWarnings $ mi_warns iface0) fix_fn = mkIfaceFixCache (mi_fixities iface0) -- The ABI of a declaration represents everything that is made ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -16,6 +16,7 @@ module GHC.Iface.Syntax ( IfaceBindingX(..), IfaceMaybeRhs(..), IfaceConAlt(..), IfaceIdInfo, IfaceIdDetails(..), IfaceUnfolding(..), IfGuidance(..), IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget, + IfaceWarnings(..), IfaceWarningTxt(..), IfaceStringLiteral(..), IfaceClsInst(..), IfaceFamInst(..), IfaceTickish(..), IfaceClassBody(..), IfaceBooleanFormula(..), IfaceBang(..), @@ -33,6 +34,7 @@ module GHC.Iface.Syntax ( ifaceDeclImplicitBndrs, visibleIfConDecls, ifaceDeclFingerprints, fromIfaceBooleanFormula, + fromIfaceWarnings, -- Free Names freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst, @@ -66,7 +68,9 @@ import GHC.Types.ForeignCall import GHC.Types.Annotations( AnnPayload, AnnTarget ) import GHC.Types.Basic import GHC.Unit.Module +import GHC.Unit.Module.Warnings import GHC.Types.SrcLoc +import GHC.Types.SourceText import GHC.Data.BooleanFormula ( BooleanFormula(..), pprBooleanFormula, isTrue ) import GHC.Types.Var( VarBndr(..), binderVar, tyVarSpecToBinders, visArgTypeLike ) import GHC.Core.TyCon ( Role (..), Injectivity(..), tyConBndrVisForAllTyFlag ) @@ -74,6 +78,8 @@ import GHC.Core.DataCon (SrcStrictness(..), SrcUnpackedness(..)) import GHC.Builtin.Types ( constraintKindTyConName ) import GHC.Stg.InferTags.TagSig import GHC.Parser.Annotation (noLocA) +import GHC.Hs.Extension ( GhcRn ) +import GHC.Hs.Doc ( WithHsDocIdentifiers(..) ) import GHC.Utils.Lexeme (isLexSym) import GHC.Utils.Fingerprint @@ -338,6 +344,18 @@ data IfaceRule ifRuleOrph :: IsOrphan -- Just like IfaceClsInst } +data IfaceWarnings + = IfNoWarnings + | IfWarnAll IfaceWarningTxt + | IfWarnSome [(OccName, IfaceWarningTxt)] + +data IfaceWarningTxt + = IfWarningTxt (Maybe WarningCategory) SourceText [(IfaceStringLiteral, [IfExtName])] + | IfDeprecatedTxt SourceText [(IfaceStringLiteral, [IfExtName])] + +data IfaceStringLiteral + = IfStringLiteral SourceText FastString + data IfaceAnnotation = IfaceAnnotation { ifAnnotatedTarget :: IfaceAnnTarget, @@ -564,6 +582,24 @@ ifaceDeclFingerprints hash decl unsafeDupablePerformIO . computeFingerprint (panic "ifaceDeclFingerprints") +fromIfaceWarnings :: IfaceWarnings -> Warnings GhcRn +fromIfaceWarnings = \case + IfNoWarnings -> NoWarnings + IfWarnAll txt -> WarnAll (fromIfaceWarningTxt txt) + IfWarnSome prs -> WarnSome [(occ, fromIfaceWarningTxt txt) | (occ, txt) <- prs] + +fromIfaceWarningTxt :: IfaceWarningTxt -> WarningTxt GhcRn +fromIfaceWarningTxt = \case + IfWarningTxt mb_cat src strs -> WarningTxt (noLoc <$> mb_cat) (noLoc src) (noLoc <$> map fromIfaceStringLiteralWithNames strs) + IfDeprecatedTxt src strs -> DeprecatedTxt (noLoc src) (noLoc <$> map fromIfaceStringLiteralWithNames strs) + +fromIfaceStringLiteralWithNames :: (IfaceStringLiteral, [IfExtName]) -> WithHsDocIdentifiers StringLiteral GhcRn +fromIfaceStringLiteralWithNames (str, names) = WithHsDocIdentifiers (fromIfaceStringLiteral str) (map noLoc names) + +fromIfaceStringLiteral :: IfaceStringLiteral -> StringLiteral +fromIfaceStringLiteral (IfStringLiteral st fs) = StringLiteral st fs Nothing + + {- ************************************************************************ * * @@ -715,6 +751,23 @@ pprAxBranch pp_tc idx (IfaceAxBranch { ifaxbTyVars = tvs text "--" <+> text "incompatible with:" <+> pprWithCommas (\incomp -> text "#" <> ppr incomp) incomps +instance Outputable IfaceWarnings where + ppr = \case + IfNoWarnings -> empty + IfWarnAll txt -> text "Warn all" <+> ppr txt + IfWarnSome prs -> text "Warnings:" <+> vcat [ppr name <+> ppr txt | (name, txt) <- prs] + +instance Outputable IfaceWarningTxt where + ppr = \case + IfWarningTxt _ _ ws -> pp_ws ws + IfDeprecatedTxt _ ds -> pp_ws ds + where + pp_ws [msg] = ppr (snd msg) + pp_ws msgs = brackets $ vcat . punctuate comma . map (ppr . snd) $ msgs + +instance Outputable IfaceStringLiteral where + ppr (IfStringLiteral st fs) = pprWithSourceText st (ftext fs) + instance Outputable IfaceAnnotation where ppr (IfaceAnnotation target value) = ppr target <+> colon <+> ppr value @@ -2265,6 +2318,28 @@ instance Binary IfaceRule where a8 <- get bh return (IfaceRule a1 a2 a3 a4 a5 a6 a7 a8) +instance Binary IfaceWarnings where + put_ bh = \case + IfNoWarnings -> putByte bh 0 + IfWarnAll txt -> putByte bh 1 *> put_ bh txt + IfWarnSome prs -> putByte bh 2 *> put_ bh prs + get bh = getByte bh >>= \case + 0 -> pure IfNoWarnings + 1 -> pure IfWarnAll <*> get bh + _ -> pure IfWarnSome <*> get bh + +instance Binary IfaceWarningTxt where + put_ bh = \case + IfWarningTxt a1 a2 a3 -> putByte bh 0 *> put_ bh a1 *> put_ bh a2 *> put_ bh a3 + IfDeprecatedTxt a1 a2 -> putByte bh 1 *> put_ bh a1 *> put_ bh a2 + get bh = getByte bh >>= \case + 0 -> pure IfWarningTxt <*> get bh <*> get bh <*> get bh + _ -> pure IfDeprecatedTxt <*> get bh <*> get bh + +instance Binary IfaceStringLiteral where + put_ bh (IfStringLiteral a1 a2) = put_ bh a1 *> put_ bh a2 + get bh = IfStringLiteral <$> get bh <*> get bh + instance Binary IfaceAnnotation where put_ bh (IfaceAnnotation a1 a2) = do put_ bh a1 @@ -2822,5 +2897,19 @@ instance NFData IfaceClsInst where rnf (IfaceClsInst f1 f2 f3 f4 f5) = f1 `seq` rnf f2 `seq` rnf f3 `seq` f4 `seq` f5 `seq` () +instance NFData IfaceWarnings where + rnf = \case + IfNoWarnings -> () + IfWarnAll txt -> rnf txt + IfWarnSome txts -> rnf txts + +instance NFData IfaceWarningTxt where + rnf = \case + IfWarningTxt f1 f2 f3 -> rnf f1 `seq` rnf f2 `seq` rnf f3 + IfDeprecatedTxt f1 f2 -> rnf f1 `seq` rnf f2 + +instance NFData IfaceStringLiteral where + rnf (IfStringLiteral f1 f2) = rnf f1 `seq` rnf f2 + instance NFData IfaceAnnotation where rnf (IfaceAnnotation f1 f2) = f1 `seq` f2 `seq` () ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -47,6 +47,7 @@ import GHC.Tc.Zonk.TcType ( tcInitTidyEnv ) import GHC.Hs import GHC.Iface.Load ( loadSrcInterface ) +import GHC.Iface.Syntax ( fromIfaceWarnings ) import GHC.Builtin.Names import GHC.Parser.PostProcess ( setRdrNameSpace ) import GHC.Core.Type @@ -422,7 +423,7 @@ rnImportDecl this_mod imports = calculateAvails home_unit other_home_units iface mod_safe' want_boot (ImportedByUser imv) -- Complain if we import a deprecated module - case mi_warns iface of + case fromIfaceWarnings (mi_warns iface) of WarnAll txt -> addDiagnostic (TcRnDeprecatedModule imp_mod_name txt) _ -> return () ===================================== compiler/GHC/Types/SourceText.hs ===================================== @@ -1,5 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RecordWildCards #-} -- | Source text -- @@ -39,6 +41,7 @@ import Data.Function (on) import Data.Data import GHC.Real ( Ratio(..) ) import GHC.Types.SrcLoc +import Control.DeepSeq {- Note [Pragma source text] @@ -107,6 +110,11 @@ instance Outputable SourceText where ppr (SourceText s) = text "SourceText" <+> ftext s ppr NoSourceText = text "NoSourceText" +instance NFData SourceText where + rnf = \case + SourceText s -> rnf s + NoSourceText -> () + instance Binary SourceText where put_ bh NoSourceText = putByte bh 0 put_ bh (SourceText s) = do @@ -315,12 +323,3 @@ instance Eq StringLiteral where instance Outputable StringLiteral where ppr sl = pprWithSourceText (sl_st sl) (ftext $ sl_fs sl) - -instance Binary StringLiteral where - put_ bh (StringLiteral st fs _) = do - put_ bh st - put_ bh fs - get bh = do - st <- get bh - fs <- get bh - return (StringLiteral st fs Nothing) ===================================== compiler/GHC/Unit/Module/ModIface.hs ===================================== @@ -185,7 +185,7 @@ data ModIface_ (phase :: ModIfacePhase) -- ^ Fixities -- NOT STRICT! we read this field lazily from the interface file - mi_warns :: (Warnings GhcRn), + mi_warns :: IfaceWarnings, -- ^ Warnings -- NOT STRICT! we read this field lazily from the interface file @@ -479,7 +479,7 @@ instance Binary ModIface where mi_finsts = hasFamInsts, mi_exp_hash = exp_hash, mi_orphan_hash = orphan_hash, - mi_warn_fn = mkIfaceWarnCache warns, + mi_warn_fn = mkIfaceWarnCache $ fromIfaceWarnings warns, mi_fix_fn = mkIfaceFixCache fixities, mi_hash_fn = mkIfaceHashCache decls }}) @@ -498,7 +498,7 @@ emptyPartialModIface mod mi_exports = [], mi_used_th = False, mi_fixities = [], - mi_warns = NoWarnings, + mi_warns = IfNoWarnings, mi_anns = [], mi_insts = [], mi_fam_insts = [], @@ -567,7 +567,7 @@ instance ( NFData (IfaceBackendExts (phase :: ModIfacePhase)) `seq` mi_exports `seq` rnf mi_used_th `seq` mi_fixities - `seq` mi_warns + `seq` rnf mi_warns `seq` rnf mi_anns `seq` rnf mi_decls `seq` rnf mi_extra_decls ===================================== compiler/GHC/Unit/Module/Warnings.hs ===================================== @@ -5,6 +5,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE LambdaCase #-} -- | Warnings for a module module GHC.Unit.Module.Warnings @@ -40,7 +41,6 @@ import GHC.Types.SrcLoc import GHC.Types.Unique import GHC.Types.Unique.Set import GHC.Hs.Doc -import GHC.Hs.Extension import GHC.Utils.Outputable import GHC.Utils.Binary @@ -51,6 +51,7 @@ import Language.Haskell.Syntax.Extension import Data.Data import Data.List (isPrefixOf) import GHC.Generics ( Generic ) +import Control.DeepSeq {- @@ -103,7 +104,7 @@ the possibility of them being infinite. -- See Note [Warning categories] newtype WarningCategory = WarningCategory FastString - deriving (Binary, Data, Eq, Outputable, Show, Uniquable) + deriving (Binary, Data, Eq, Outputable, Show, Uniquable, NFData) mkWarningCategory :: FastString -> WarningCategory mkWarningCategory = WarningCategory @@ -203,29 +204,6 @@ instance Outputable (WarningTxt pass) where NoSourceText -> pp_ws ds SourceText src -> ftext src <+> pp_ws ds <+> text "#-}" -instance Binary (WarningTxt GhcRn) where - put_ bh (WarningTxt c s w) = do - putByte bh 0 - put_ bh $ unLoc <$> c - put_ bh $ unLoc s - put_ bh $ unLoc <$> w - put_ bh (DeprecatedTxt s d) = do - putByte bh 1 - put_ bh $ unLoc s - put_ bh $ unLoc <$> d - - get bh = do - h <- getByte bh - case h of - 0 -> do c <- fmap noLoc <$> get bh - s <- noLoc <$> get bh - w <- fmap noLoc <$> get bh - return (WarningTxt c s w) - _ -> do s <- noLoc <$> get bh - d <- fmap noLoc <$> get bh - return (DeprecatedTxt s d) - - pp_ws :: [Located (WithHsDocIdentifiers StringLiteral pass)] -> SDoc pp_ws [l] = ppr $ unLoc l pp_ws ws @@ -271,24 +249,6 @@ data Warnings pass deriving instance Eq (IdP pass) => Eq (Warnings pass) -instance Binary (Warnings GhcRn) where - put_ bh NoWarnings = putByte bh 0 - put_ bh (WarnAll t) = do - putByte bh 1 - put_ bh t - put_ bh (WarnSome ts) = do - putByte bh 2 - put_ bh ts - - get bh = do - h <- getByte bh - case h of - 0 -> return NoWarnings - 1 -> do aa <- get bh - return (WarnAll aa) - _ -> do aa <- get bh - return (WarnSome aa) - -- | Constructs the cache for the 'mi_warn_fn' field of a 'ModIface' mkIfaceWarnCache :: Warnings p -> OccName -> Maybe (WarningTxt p) mkIfaceWarnCache NoWarnings = \_ -> Nothing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a55045269ceddb4e7fa304fe344ec61cb6371f5f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a55045269ceddb4e7fa304fe344ec61cb6371f5f You're receiving 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 Jun 14 11:42:25 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 14 Jun 2023 07:42:25 -0400 Subject: [Git][ghc/ghc][wip/forall-vis-coercions] Refactoring Message-ID: <6489a7a18fd4f_17e3c2445d50413989d@gitlab.mail> Simon Peyton Jones pushed to branch wip/forall-vis-coercions at Glasgow Haskell Compiler / GHC Commits: 148e83df by Simon Peyton Jones at 2023-06-14T12:40:58+01:00 Refactoring I have just added to Matthew's patch * Record type for ForAllCo * Refactor can_eq_nc_forall to use uType * Deall with mis-matched foralls in can_eq_nc_forall - - - - - 17 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/FamInstEnv.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Types/Var.hs Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -41,7 +41,7 @@ module GHC.Core.Coercion ( mkInstCo, mkAppCo, mkAppCos, mkTyConAppCo, mkFunCo, mkFunCo2, mkFunCoNoFTF, mkFunResCo, mkNakedFunCo, - mkForAllCo, mkForAllCos, mkHomoForAllCos, + mkForAllCo, mkHomoForAllCos, mkPhantomCo, mkHoleCo, mkUnivCo, mkSubCo, mkAxiomInstCo, mkProofIrrelCo, @@ -557,19 +557,25 @@ splitFunCo_maybe (FunCo { fco_arg = arg, fco_res = res }) = Just (arg, res) splitFunCo_maybe _ = Nothing splitForAllCo_maybe :: Coercion -> Maybe (TyCoVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion) -splitForAllCo_maybe (ForAllCo tv vL vR k_co co) = Just (tv, vL, vR, k_co, co) +splitForAllCo_maybe (ForAllCo { fco_tcv = tv, fco_visL = vL, fco_visR = vR + , fco_kind = k_co, fco_body = co }) + = Just (tv, vL, vR, k_co, co) splitForAllCo_maybe _ = Nothing -- | Like 'splitForAllCo_maybe', but only returns Just for tyvar binder splitForAllCo_ty_maybe :: Coercion -> Maybe (TyVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion) -splitForAllCo_ty_maybe (ForAllCo tv vL vR k_co co) - | isTyVar tv = Just (tv, vL, vR, k_co, co) +splitForAllCo_ty_maybe co + | Just stuff@(tv, _, _, _, _) <- splitForAllCo_maybe co + , isTyVar tv + = Just stuff splitForAllCo_ty_maybe _ = Nothing -- | Like 'splitForAllCo_maybe', but only returns Just for covar binder splitForAllCo_co_maybe :: Coercion -> Maybe (CoVar, ForAllTyFlag, ForAllTyFlag, Coercion, Coercion) -splitForAllCo_co_maybe (ForAllCo cv vL vR k_co co) - | isCoVar cv = Just (cv, vL, vR, k_co, co) +splitForAllCo_co_maybe co + | Just stuff@(cv, _, _, _, _) <- splitForAllCo_maybe co + , isCoVar cv + = Just stuff splitForAllCo_co_maybe _ = Nothing @@ -972,7 +978,8 @@ mkForAllCo v visL visR kind_co co , visL `eqForAllVis` visR = mkReflCo r (mkTyCoForAllTy v visL ty) | otherwise - = ForAllCo v visL visR kind_co co + = ForAllCo { fco_tcv = v, fco_visL = visL, fco_visR = visR + , fco_kind = kind_co, fco_body = co } -- | Like 'mkForAllCo', but the inner coercion shouldn't be an obvious -- reflexive coercion. For example, it is guaranteed in 'mkForAllCos'. @@ -987,21 +994,8 @@ mkForAllCo_NoRefl v visL visR kind_co co = mkFunCoNoFTF (coercionRole co) (multToCo ManyTy) kind_co co -- Functions from coercions are always unrestricted | otherwise - = ForAllCo v visL visR kind_co co - --- | Make nested ForAllCos, with 'Specified' visibility -mkForAllCos :: [(TyCoVar, CoercionN)] -> Coercion -> Coercion --- We don't seem to use this for anything as of Apr 2023 -mkForAllCos bndrs co - | Just (ty, r ) <- isReflCo_maybe co - = let (refls_rev'd, non_refls_rev'd) = span (isReflCo . snd) (reverse bndrs) in - foldl' (flip step) - (mkReflCo r (mkTyCoInvForAllTys (reverse (map fst refls_rev'd)) ty)) - non_refls_rev'd - | otherwise - = foldr step co bndrs - where step (tcv, kind_co) inner_co - = mkForAllCo_NoRefl tcv Specified Specified kind_co inner_co + = ForAllCo { fco_tcv = v, fco_visL = visL, fco_visR = visR + , fco_kind = kind_co, fco_body = co } -- | Make a Coercion quantified over a type/coercion variable; -- the variable has the same kind and visibility in both sides of the coercion @@ -1171,7 +1165,7 @@ mkSelCo_maybe cs co | Just (ty, r) <- isReflCo_maybe co = Just (mkReflCo r (getNthFromType cs ty)) - go SelForAll (ForAllCo _ _ _ kind_co _) + go SelForAll (ForAllCo { fco_kind = kind_co }) = Just kind_co -- If co :: (forall a1:k1. t1) ~ (forall a2:k2. t2) -- then (nth SelForAll co :: k1 ~N k2) @@ -1239,7 +1233,7 @@ mkLRCo lr co -- | Instantiates a 'Coercion'. mkInstCo :: Coercion -> CoercionN -> Coercion -mkInstCo (ForAllCo tcv _visL _visR _kind_co body_co) co +mkInstCo (ForAllCo { fco_tcv = tcv, fco_body = body_co }) co | Just (arg, _) <- isReflCo_maybe co -- works for both tyvar and covar = substCoUnchecked (zipTCvSubst [tcv] [arg]) body_co @@ -1391,9 +1385,10 @@ setNominalRole_maybe r co = TransCo <$> setNominalRole_maybe_helper co1 <*> setNominalRole_maybe_helper co2 setNominalRole_maybe_helper (AppCo co1 co2) = AppCo <$> setNominalRole_maybe_helper co1 <*> pure co2 - setNominalRole_maybe_helper (ForAllCo tv visL visR kind_co co) + setNominalRole_maybe_helper co@(ForAllCo { fco_visL = visL, fco_visR = visR, fco_body = body_co }) | visL `eqForAllVis` visR - = ForAllCo tv visL visR kind_co <$> setNominalRole_maybe_helper co + = do { body_co' <- setNominalRole_maybe_helper body_co + ; return (co { fco_body = body_co' }) } setNominalRole_maybe_helper (SelCo cs co) = -- NB, this case recurses via setNominalRole_maybe, not -- setNominalRole_maybe_helper! @@ -1513,7 +1508,7 @@ promoteCoercion co = case co of | otherwise -> mkKindCo co - ForAllCo tv _ _ _ g + ForAllCo { fco_tcv = tv, fco_body = g } | isTyVar tv -> promoteCoercion g @@ -1671,7 +1666,7 @@ mkPiCos r vs co = foldr (mkPiCo r) co vs -- | Make a forall 'Coercion', where both types related by the coercion -- are quantified over the same variable. mkPiCo :: Role -> Var -> Coercion -> Coercion -mkPiCo r v co | isTyVar v = mkHomoForAllCos [Bndr v Specified] co +mkPiCo r v co | isTyVar v = mkHomoForAllCos [Bndr v coreTyLamForAllTyFlag] co | isCoVar v = assert (not (v `elemVarSet` tyCoVarsOfCo co)) $ -- We didn't call mkForAllCo here because if v does not appear -- in co, the argument coercion will be nominal. But here we @@ -2410,7 +2405,8 @@ coercionLKind co go (GRefl _ ty _) = ty go (TyConAppCo _ tc cos) = mkTyConApp tc (map go cos) go (AppCo co1 co2) = mkAppTy (go co1) (go co2) - go (ForAllCo tv1 visL _ _ co1) = mkTyCoForAllTy tv1 visL (go co1) + go (ForAllCo { fco_tcv = tv1, fco_visL = visL, fco_body = co1 }) + = mkTyCoForAllTy tv1 visL (go co1) go (FunCo { fco_afl = af, fco_mult = mult, fco_arg = arg, fco_res = res}) {- See Note [FunCo] -} = FunTy { ft_af = af, ft_mult = go mult , ft_arg = go arg, ft_res = go res } @@ -2489,7 +2485,8 @@ coercionRKind co go (AxiomRuleCo ax cos) = pSnd $ expectJust "coercionKind" $ coaxrProves ax $ map coercionKind cos - go co@(ForAllCo tv1 _visL visR k_co co1) -- works for both tyvar and covar + go co@(ForAllCo { fco_tcv = tv1, fco_visR = visR + , fco_kind = k_co, fco_body = co1 }) -- works for both tyvar and covar | isGReflCo k_co = mkTyCoForAllTy tv1 visR (go co1) -- kind_co always has kind @Type@, thus @isGReflCo@ | otherwise = go_forall empty_subst co @@ -2513,7 +2510,8 @@ coercionRKind co go_app (InstCo co arg) args = go_app co (go arg:args) go_app co args = piResultTys (go co) args - go_forall subst (ForAllCo tv1 _visL visR k_co co) + go_forall subst (ForAllCo { fco_tcv = tv1, fco_visR = visR + , fco_kind = k_co, fco_body = co }) -- See Note [Nested ForAllCos] | isTyVar tv1 = mkForAllTy (Bndr tv2 visR) (go_forall subst' co) @@ -2525,7 +2523,8 @@ coercionRKind co | otherwise = extendTvSubst (extendSubstInScope subst tv2) tv1 $ TyVarTy tv2 `mkCastTy` mkSymCo k_co - go_forall subst (ForAllCo cv1 _visL visR k_co co) + go_forall subst (ForAllCo { fco_tcv = cv1, fco_visR = visR + , fco_kind = k_co, fco_body = co }) | isCoVar cv1 = mkTyCoForAllTy cv2 visR (go_forall subst' co) where @@ -2575,26 +2574,26 @@ change reduces /total/ compile time by a factor of more than ten. coercionRole :: Coercion -> Role coercionRole = go where - go (Refl _) = Nominal - go (GRefl r _ _) = r - go (TyConAppCo r _ _) = r - go (AppCo co1 _) = go co1 - go (ForAllCo _tcv _visL _visR _kco co) = go co - go (FunCo { fco_role = r }) = r - go (CoVarCo cv) = coVarRole cv - go (HoleCo h) = coVarRole (coHoleCoVar h) - go (AxiomInstCo ax _ _) = coAxiomRole ax - go (UnivCo _ r _ _) = r - go (SymCo co) = go co - go (TransCo co1 _co2) = go co1 - go (SelCo SelForAll _co) = Nominal - go (SelCo (SelTyCon _ r) _co) = r - go (SelCo (SelFun fs) co) = funRole (coercionRole co) fs - go (LRCo {}) = Nominal - go (InstCo co _) = go co - go (KindCo {}) = Nominal - go (SubCo _) = Representational - go (AxiomRuleCo ax _) = coaxrRole ax + go (Refl _) = Nominal + go (GRefl r _ _) = r + go (TyConAppCo r _ _) = r + go (AppCo co1 _) = go co1 + go (ForAllCo { fco_body = co }) = go co + go (FunCo { fco_role = r }) = r + go (CoVarCo cv) = coVarRole cv + go (HoleCo h) = coVarRole (coHoleCoVar h) + go (AxiomInstCo ax _ _) = coAxiomRole ax + go (UnivCo _ r _ _) = r + go (SymCo co) = go co + go (TransCo co1 _co2) = go co1 + go (SelCo SelForAll _co) = Nominal + go (SelCo (SelTyCon _ r) _co) = r + go (SelCo (SelFun fs) co) = funRole (coercionRole co) fs + go (LRCo {}) = Nominal + go (InstCo co _) = go co + go (KindCo {}) = Nominal + go (SubCo _) = Representational + go (AxiomRuleCo ax _) = coaxrRole ax {- Note [Nested InstCos] ===================================== compiler/GHC/Core/Coercion/Opt.hs ===================================== @@ -376,7 +376,7 @@ opt_co4 env sym rep r (SelCo (SelTyCon n r1) (TyConAppCo _ _ cos)) opt_co4 env sym rep r (SelCo (SelFun fs) (FunCo _r2 _afl _afr w co1 co2)) = opt_co4_wrap env sym rep r (getNthFun fs w co1 co2) -opt_co4 env sym rep _ (SelCo SelForAll (ForAllCo _ _ _ eta _)) +opt_co4 env sym rep _ (SelCo SelForAll (ForAllCo { fco_kind = eta })) -- works for both tyvar and covar = opt_co4_wrap env sym rep Nominal eta @@ -384,7 +384,7 @@ opt_co4 env sym rep r (SelCo n co) | Just nth_co <- case (co', n) of (TyConAppCo _ _ cos, SelTyCon n _) -> Just (cos `getNth` n) (FunCo _ _ _ w co1 co2, SelFun fs) -> Just (getNthFun fs w co1 co2) - (ForAllCo _ _ _ eta _, SelForAll) -> Just eta + (ForAllCo { fco_kind = eta }, SelForAll) -> Just eta _ -> Nothing = if rep && (r == Nominal) -- keep propagating the SubCo ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -386,8 +386,9 @@ orphNamesOfCo (Refl ty) = orphNamesOfType ty orphNamesOfCo (GRefl _ ty mco) = orphNamesOfType ty `unionNameSet` orphNamesOfMCo mco orphNamesOfCo (TyConAppCo _ tc cos) = unitNameSet (getName tc) `unionNameSet` orphNamesOfCos cos orphNamesOfCo (AppCo co1 co2) = orphNamesOfCo co1 `unionNameSet` orphNamesOfCo co2 -orphNamesOfCo (ForAllCo _tcv _vL _vR kind_co co) = orphNamesOfCo kind_co - `unionNameSet` orphNamesOfCo co +orphNamesOfCo (ForAllCo { fco_kind = kind_co, fco_body = co }) + = orphNamesOfCo kind_co + `unionNameSet` orphNamesOfCo co orphNamesOfCo (FunCo { fco_mult = co_mult, fco_arg = co1, fco_res = co2 }) = orphNamesOfCo co_mult `unionNameSet` orphNamesOfCo co1 ===================================== compiler/GHC/Core/FamInstEnv.hs ===================================== @@ -1488,7 +1488,7 @@ normalise_type ty go (ForAllTy (Bndr tcvar vis) ty) = do { (lc', tv', k_redn) <- normalise_var_bndr tcvar ; redn <- withLC lc' $ normalise_type ty - ; return $ mkForAllRedn vis vis tv' k_redn redn } + ; return $ mkForAllRedn vis tv' k_redn redn } go (TyVarTy tv) = normalise_tyvar tv go (CastTy ty co) = do { redn <- go ty ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -2230,7 +2230,8 @@ lintCoercion co@(AppCo co1 co2) ; return (AppCo co1' co2') } ---------- -lintCoercion co@(ForAllCo tcv visL visR kind_co body_co) +lintCoercion co@(ForAllCo { fco_tcv = tcv, fco_visL = visL, fco_visR = visR + , fco_kind = kind_co, fco_body = body_co }) | not (isTyCoVar tcv) = failWithL (text "Non tyco binder in ForAllCo:" <+> ppr co) | otherwise @@ -2261,7 +2262,7 @@ lintCoercion co@(ForAllCo tcv visL visR kind_co body_co) lintL (visL `eqForAllVis` visR) $ text "Nominal ForAllCo has mismatched visibilities: " <+> ppr co - ; return (ForAllCo tcv' visL visR kind_co' body_co') } } + ; return (co { fco_tcv = tcv', fco_kind = kind_co', fco_body = body_co' }) } } lintCoercion co@(FunCo { fco_role = r, fco_afl = afl, fco_afr = afr , fco_mult = cow, fco_arg = co1, fco_res = co2 }) ===================================== compiler/GHC/Core/Reduction.hs ===================================== @@ -370,15 +370,14 @@ mkFunRedn r af -- -- Combines 'mkForAllCo' and 'mkForAllTy'. mkForAllRedn :: ForAllTyFlag - -> ForAllTyFlag -> TyVar -> ReductionN -- ^ kind reduction -> Reduction -- ^ body reduction -> Reduction -mkForAllRedn vis1 vis2 tv1 (Reduction h ki') (Reduction co ty) +mkForAllRedn vis tv1 (Reduction h ki') (Reduction co ty) = mkReduction - (mkForAllCo tv1 vis1 vis2 h co) - (mkForAllTy (Bndr tv2 vis2) ty) + (mkForAllCo tv1 vis vis h co) + (mkForAllTy (Bndr tv2 vis) ty) where tv2 = setTyVarKind tv1 ki' {-# INLINE mkForAllRedn #-} ===================================== compiler/GHC/Core/TyCo/FVs.hs ===================================== @@ -631,7 +631,7 @@ tyCoFVsOfCo (GRefl _ ty mco) fv_cand in_scope acc tyCoFVsOfCo (TyConAppCo _ _ cos) fv_cand in_scope acc = tyCoFVsOfCos cos fv_cand in_scope acc tyCoFVsOfCo (AppCo co arg) fv_cand in_scope acc = (tyCoFVsOfCo co `unionFV` tyCoFVsOfCo arg) fv_cand in_scope acc -tyCoFVsOfCo (ForAllCo tv _visL _visR kind_co co) fv_cand in_scope acc +tyCoFVsOfCo (ForAllCo { fco_tcv = tv, fco_kind = kind_co, fco_body = co }) fv_cand in_scope acc = (tyCoFVsVarBndr tv (tyCoFVsOfCo co) `unionFV` tyCoFVsOfCo kind_co) fv_cand in_scope acc tyCoFVsOfCo (FunCo { fco_mult = w, fco_arg = co1, fco_res = co2 }) fv_cand in_scope acc = (tyCoFVsOfCo co1 `unionFV` tyCoFVsOfCo co2 `unionFV` tyCoFVsOfCo w) fv_cand in_scope acc @@ -686,7 +686,7 @@ almost_devoid_co_var_of_co (TyConAppCo _ _ cos) cv almost_devoid_co_var_of_co (AppCo co arg) cv = almost_devoid_co_var_of_co co cv && almost_devoid_co_var_of_co arg cv -almost_devoid_co_var_of_co (ForAllCo v _visL _visR kind_co co) cv +almost_devoid_co_var_of_co (ForAllCo { fco_tcv = v, fco_kind = kind_co, fco_body = co }) cv = almost_devoid_co_var_of_co kind_co cv && (v == cv || almost_devoid_co_var_of_co co cv) almost_devoid_co_var_of_co (FunCo { fco_mult = w, fco_arg = co1, fco_res = co2 }) cv @@ -1109,7 +1109,8 @@ tyConsOfType ty go_co (GRefl _ ty mco) = go ty `unionUniqSets` go_mco mco go_co (TyConAppCo _ tc args) = go_tc tc `unionUniqSets` go_cos args go_co (AppCo co arg) = go_co co `unionUniqSets` go_co arg - go_co (ForAllCo _ _ _ kind_co co) = go_co kind_co `unionUniqSets` go_co co + go_co (ForAllCo { fco_kind = kind_co, fco_body = co }) + = go_co kind_co `unionUniqSets` go_co co go_co (FunCo { fco_mult = m, fco_arg = a, fco_res = r }) = go_co m `unionUniqSets` go_co a `unionUniqSets` go_co r go_co (AxiomInstCo ax _ args) = go_ax ax `unionUniqSets` go_cos args @@ -1293,14 +1294,14 @@ occCheckExpand vs_to_avoid ty go_co cxt (AppCo co arg) = do { co' <- go_co cxt co ; arg' <- go_co cxt arg ; return (AppCo co' arg') } - go_co cxt@(as, env) (ForAllCo tv visL visR kind_co body_co) + go_co cxt@(as, env) co@(ForAllCo { fco_tcv = tv, fco_kind = kind_co, fco_body = body_co }) = do { kind_co' <- go_co cxt kind_co ; let tv' = setVarType tv $ coercionLKind kind_co' env' = extendVarEnv env tv tv' as' = as `delVarSet` tv ; body' <- go_co (as', env') body_co - ; return (ForAllCo tv' visL visR kind_co' body') } + ; return (co { fco_tcv = tv', fco_kind = kind_co', fco_body = body' }) } go_co cxt co@(FunCo { fco_mult = w, fco_arg = co1 ,fco_res = co2 }) = do { co1' <- go_co cxt co1 ; co2' <- go_co cxt co2 ===================================== compiler/GHC/Core/TyCo/Rep.hs ===================================== @@ -488,9 +488,9 @@ This is done in mkCastTy. In sum, in order to uphold (EQ), we need the following invariants: - (EQ1) No decomposable CastTy to the left of an AppTy, where a decomposable - cast is one that relates either a FunTy to a FunTy or a - ForAllTy to a ForAllTy. + (EQ1) No decomposable CastTy to the left of an AppTy, + where a "decomposable cast" is one that relates + either a FunTy to a FunTy, or a ForAllTy to a ForAllTy. (EQ2) No reflexive casts in CastTy. (EQ3) No nested CastTys. (EQ4) No CastTy over (ForAllTy (Bndr tyvar vis) body). @@ -851,11 +851,11 @@ data Coercion -- See Note [Forall coercions] | ForAllCo - TyCoVar - !ForAllTyFlag -- visibility of coercionLKind - !ForAllTyFlag -- visibility of coercionRKind - KindCoercion - Coercion + { fco_tcv :: TyCoVar + , fco_visL :: !ForAllTyFlag -- visibility of coercionLKind + , fco_visR :: !ForAllTyFlag -- visibility of coercionRKind + , fco_kind :: KindCoercion + , fco_body :: Coercion } -- ForAllCo :: _ -> N -> e -> e | FunCo -- FunCo :: "e" -> N/P -> e -> e -> e @@ -1167,41 +1167,53 @@ of the chosen branch. Note [Forall coercions] ~~~~~~~~~~~~~~~~~~~~~~~ Constructing coercions between forall-types can be a bit tricky, -because the kinds of the bound tyvars can be different. +because the kinds of the bound otyvars can be different. The typing rule is: - - kind_co : k1 ~ k2 - tv1:k1 |- co : t1 ~ t2 - ------------------------------------------------------------------- - ForAllCo tv1 vis1 vis2 kind_co co - : all tv1:k1 . t1 ~ - all tv1:k2 . (t2[tv1 |-> tv1 |> sym kind_co]) - -First, the TyCoVar stored in a ForAllCo is really an optimisation: this field -should be a Name, as its kind is redundant. Thinking of the field as a Name -is helpful in understanding what a ForAllCo means. -The kind of TyCoVar always matches the left-hand kind of the coercion. - -The idea is that kind_co gives the two kinds of the tyvar. See how, in the -conclusion, tv1 is assigned kind k1 on the left but kind k2 on the right. - -Of course, a type variable can't have different kinds at the same time. So, -we arbitrarily prefer the first kind when using tv1 in the inner coercion -co, which shows that t1 equals t2. - -The last wrinkle is that we need to fix the kinds in the conclusion. In -t2, tv1 is assumed to have kind k1, but it has kind k2 in the conclusion of -the rule. So we do a kind-fixing substitution, replacing (tv1:k1) with -(tv1:k2) |> sym kind_co. This substitution is slightly bizarre, because it -mentions the same name with different kinds, but it *is* well-kinded, noting -that `(tv1:k2) |> sym kind_co` has kind k1. - -This all really would work storing just a Name in the ForAllCo. But we can't -add Names to, e.g., VarSets, and there generally is just an impedance mismatch -in a bunch of places. So we use tv1. When we need tv2, we can use -setTyVarKind. + kind_co : k1 ~N k2 + tv1:k1 |- co : t1 ~r t2 + if r=N, then vis1=vis2 + ------------------------------------ + ForAllCo (tv1:k1) vis1 vis2 kind_co co + : forall (tv1:k1) . t1 + ~r + forall (tv1:k2) . (t2[tv1 |-> (tv1:k2) |> sym kind_co]) + +Several things to note here + +(FC1) First, the TyCoVar stored in a ForAllCo is really an optimisation: this + field should be a Name, as its kind is redundant. Thinking of the field as a + Name is helpful in understanding what a ForAllCo means. The kind of TyCoVar + always matches the left-hand kind of the coercion. + + * The idea is that kind_co gives the two kinds of the tyvar. See how, in the + conclusion, tv1 is assigned kind k1 on the left but kind k2 on the right. + + * Of course, a type variable can't have different kinds at the same time. + So, in `co` itself we use (tv1 : k1); hence the premise + tv1:k1 |- co : t1 ~r t2 + + * The last wrinkle is that we need to fix the kinds in the conclusion. In + t2, tv1 is assumed to have kind k1, but it has kind k2 in the conclusion of + the rule. So we do a kind-fixing substitution, replacing (tv1:k1) with + (tv1:k2) |> sym kind_co. This substitution is slightly bizarre, because it + mentions the same name with different kinds, but it *is* well-kinded, noting + that `(tv1:k2) |> sym kind_co` has kind k1. + + We could instead store just a Name in the ForAllCo. But we can't add Names + to, e.g., VarSets, and there generally is just an impedance mismatch in a + bunch of places. So we use tv1. When we need tv2, we can use setTyVarKind. + +(FC2) Note that the kind coercion must be Nominal; and that the role `r` of + the final coercion is the same as that of the body coercion. + +(FC3) A ForAllCo allows to cast between visibilities. For example: + ForAllCo a Required Specified (SubCo (Refl ty)) + : (forall a -> ty) ~R (forall a. ty) + But only at Representational role. The two types are Representationally + equal but not Nominally equal. Hence the premise + if r=N, then vis1=vis2 Note [Predicate coercions] ~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1821,7 +1833,8 @@ coercionSize (GRefl _ ty MRefl) = typeSize ty coercionSize (GRefl _ ty (MCo co)) = 1 + typeSize ty + coercionSize co coercionSize (TyConAppCo _ _ args) = 1 + sum (map coercionSize args) coercionSize (AppCo co arg) = coercionSize co + coercionSize arg -coercionSize (ForAllCo _ _ _ h co) = 1 + coercionSize co + coercionSize h +coercionSize (ForAllCo { fco_kind = h, fco_body = co }) + = 1 + coercionSize co + coercionSize h coercionSize (FunCo _ _ _ w c1 c2) = 1 + coercionSize c1 + coercionSize c2 + coercionSize w coercionSize (CoVarCo _) = 1 ===================================== compiler/GHC/Core/TyCo/Subst.hs ===================================== @@ -535,7 +535,8 @@ Note [Sym and ForAllCo] In OptCoercion, we try to push "sym" out to the leaves of a coercion. But, how do we push sym into a ForAllCo? It's a little ugly. -Ignoring visibility, here is the typing rule: +Ignoring visibility, here is the typing rule +(see Note [Forall coercions] in GHC.Core.TyCo.Rep). h : k1 ~# k2 (tv : k1) |- g : ty1 ~# ty2 ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -548,7 +548,8 @@ expandTypeSynonyms ty = mkTyConAppCo r tc (map (go_co subst) args) go_co subst (AppCo co arg) = mkAppCo (go_co subst co) (go_co subst arg) - go_co subst (ForAllCo tv visL visR kind_co co) + go_co subst (ForAllCo { fco_tcv = tv, fco_visL = visL, fco_visR = visR + , fco_kind = kind_co, fco_body = co }) = let (subst', tv', kind_co') = go_cobndr subst tv kind_co in mkForAllCo tv' visL visR kind_co' (go_co subst' co) go_co subst (FunCo r afl afr w co1 co2) @@ -990,7 +991,8 @@ mapTyCoX (TyCoMapper { tcm_tyvar = tyvar | otherwise = mkTyConAppCo r tc <$> go_cos env cos - go_co !env (ForAllCo tv visL visR kind_co co) + go_co !env (ForAllCo { fco_tcv = tv, fco_visL = visL, fco_visR = visR + , fco_kind = kind_co, fco_body = co }) = do { kind_co' <- go_co env kind_co ; tycobinder env tv visL $ \env' tv' -> do ; co' <- go_co env' co @@ -1050,8 +1052,6 @@ invariant: use it. Note [Decomposing fat arrow c=>t] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -This note needs updating since the Type/Constraint separation in Core... - Can we unify (a b) with (Eq a => ty)? If we do so, we end up with a partial application like ((=>) (Eq a)) which doesn't make sense in source Haskell. In contrast, we *can* unify (a b) with (t1 -> t2). @@ -1064,14 +1064,13 @@ The type (Proxy (Eq Int => Int)) is only accepted with -XImpredicativeTypes, but suppose we want that. But then in the call to 'i', we end up decomposing (Eq Int => Int), and we definitely don't want that. -This really only applies to the type checker; in Core, '=>' and '->' -are the same, as are 'Constraint' and '*'. But for now I've put -the test in splitAppTyNoView_maybe, which applies throughout, because -the other calls to splitAppTy are in GHC.Core.Unify, which is also used by -the type checker (e.g. when matching type-function equations). - We are willing to split (t1 -=> t2) because the argument is still of kind Type, not Constraint. So the criterion is isVisibleFunArg. + +In Core there is no real reason to avoid such decomposition. But for now I've +put the test in splitAppTyNoView_maybe, which applies throughout, because the +other calls to splitAppTy are in GHC.Core.Unify, which is also used by the +type checker (e.g. when matching type-function equations). -} -- | Applies a type to another, as in e.g. @k a@ @@ -1938,22 +1937,20 @@ dropForAlls ty = go ty go ty | Just ty' <- coreView ty = go ty' go res = res --- | Attempts to take a forall type apart, but only if it's a proper forall, --- with a named binder +-- | Attempts to take a ForAllTy apart, returning the full ForAllTyBinder splitForAllForAllTyBinder_maybe :: Type -> Maybe (ForAllTyBinder, Type) splitForAllForAllTyBinder_maybe ty | ForAllTy bndr inner_ty <- coreFullView ty = Just (bndr, inner_ty) | otherwise = Nothing --- | Attempts to take a forall type apart, but only if it's a proper forall, --- with a named binder +-- | Attempts to take a ForAllTy apart, returning the Var splitForAllTyCoVar_maybe :: Type -> Maybe (TyCoVar, Type) splitForAllTyCoVar_maybe ty | ForAllTy (Bndr tv _) inner_ty <- coreFullView ty = Just (tv, inner_ty) | otherwise = Nothing --- | Like 'splitForAllTyCoVar_maybe', but only returns Just if it is a tyvar binder. +-- | Attempts to take a ForAllTy apart, but only if the binder is a TyVar splitForAllTyVar_maybe :: Type -> Maybe (TyVar, Type) splitForAllTyVar_maybe ty | ForAllTy (Bndr tv _) inner_ty <- coreFullView ty ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -1780,7 +1780,9 @@ pushRefl co = Just (TyConApp tc tys, r) -> Just (TyConAppCo r tc (zipWith mkReflCo (tyConRoleListX r tc) tys)) Just (ForAllTy (Bndr tv vis) ty, r) - -> Just (ForAllCo tv vis vis (mkNomReflCo (varType tv)) (mkReflCo r ty)) + -> Just (ForAllCo { fco_tcv = tv, fco_visL = vis, fco_visR = vis + , fco_kind = mkNomReflCo (varType tv) + , fco_body = mkReflCo r ty }) -- NB: NoRefl variant. Otherwise, we get a loop! _ -> Nothing ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -21,7 +21,8 @@ module GHC.Core.Utils ( scaleAltsBy, -- * Properties of expressions - exprType, coreAltType, coreAltsType, mkLamType, mkLamTypes, + exprType, coreAltType, coreAltsType, + mkLamType, mkLamTypes, mkFunctionType, exprIsDupable, exprIsTrivial, getIdFromTrivialExpr, getIdFromTrivialExpr_maybe, @@ -166,7 +167,7 @@ mkLamTypes :: [Var] -> Type -> Type mkLamType v body_ty | isTyVar v - = mkForAllTy (Bndr v Specified) body_ty + = mkForAllTy (Bndr v coreTyLamForAllTyFlag) body_ty | isCoVar v , v `elemVarSet` tyCoVarsOfType body_ty ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -21,6 +21,7 @@ import GHC.Tc.Utils.Unify import GHC.Tc.Utils.TcType import GHC.Tc.Instance.Family ( tcTopNormaliseNewTypeTF_maybe ) import GHC.Tc.Instance.FunDeps( FunDepEqn(..) ) +import qualified GHC.Tc.Utils.Monad as TcM import GHC.Core.Type import GHC.Core.Predicate @@ -477,27 +478,19 @@ can_eq_nc_forall :: CtEvidence -> EqRel -- so we must proceed one binder at a time (#13879) can_eq_nc_forall ev eq_rel s1 s2 - | CtWanted { ctev_loc = loc, ctev_dest = orig_dest, ctev_rewriters = rewriters } <- ev - = do { let free_tvs = tyCoVarsOfTypes [s1,s2] - (bndrs1, phi1) = tcSplitForAllTyVarBinders s1 - (bndrs2, phi2) = tcSplitForAllTyVarBinders s2 + | CtWanted { ctev_dest = orig_dest } <- ev + = do { let free_tvs = tyCoVarsOfTypes [s1,s2] + (bndrs1, phi1, bndrs2, phi2) = split_foralls s1 s2 + hard_fail why = do { traceTcS ("Forall failure: " ++ why) $ - vcat [ ppr s1, ppr s2, ppr bndrs1, ppr bndrs2 - , ppr (binderFlags bndrs1) - , ppr (binderFlags bndrs2) ] - ; canEqHardFailure ev s1 s2 } + vcat [ ppr s1, ppr s2, ppr bndrs1, ppr bndrs2 + , ppr (binderFlags bndrs1) + , ppr (binderFlags bndrs2) ] + ; canEqHardFailure ev s1 s2 } ; if | eq_rel == NomEq - , not (and $ zipWith (eqForAllVis `on` binderFlag) bndrs1 bndrs2) + , not (all2 (eqForAllVis `on` binderFlag) bndrs1 bndrs2) -> hard_fail "visibility mismatch" - | not (equalLength bndrs1 bndrs2) - -- I believe this relies on the (generally wrong) assumption - -- that type families never return a forall-type. - -- But newtypes can certainly wrap forall-types! - -- So we definitely shouldn't just reject for ReprEq. - -- See also #22537. - -> hard_fail "unequal foralls-nesting-depth" - | otherwise -> do { ; traceTcS "Creating implication for polytype equality" $ ppr ev ; let empty_subst1 = mkEmptySubst $ mkInScopeSet free_tvs @@ -508,33 +501,36 @@ can_eq_nc_forall ev eq_rel s1 s2 ; let phi1' = substTy subst1 phi1 -- Unify the kinds, extend the substitution - go :: [TcTyVar] -> Subst -> [TyVarBinder] -> [TyVarBinder] - -> TcS (TcCoercion, Cts) - go (skol_tv:skol_tvs) subst (bndr1:bndrs1) (bndr2:bndrs2) - = do { let tv2 = binderVar bndr2 + go :: UnifyEnv -> [TcTyVar] -> Subst + -> [TyVarBinder] -> [TyVarBinder] -> TcM.TcM TcCoercion + go uenv (skol_tv:skol_tvs) subst (bndr1:bndrs1) (bndr2:bndrs2) + = do { let tv2 = binderVar bndr2 vis1 = binderFlag bndr1 vis2 = binderFlag bndr2 - ; (kind_co, wanteds1) <- unify loc rewriters Nominal (tyVarKind skol_tv) - (substTy subst (tyVarKind tv2)) + + ; kind_co <- uType (uenv `setUEnvRole` Nominal) + (tyVarKind skol_tv) + (substTy subst (tyVarKind tv2)) + ; let subst' = extendTvSubstAndInScope subst tv2 (mkCastTy (mkTyVarTy skol_tv) kind_co) -- skol_tv is already in the in-scope set, but the -- free vars of kind_co are not; hence "...AndInScope" - ; (co, wanteds2) <- go skol_tvs subst' bndrs1 bndrs2 - ; return ( mkForAllCo skol_tv vis1 vis2 kind_co co - , wanteds1 `unionBags` wanteds2 ) } + ; co <- go uenv skol_tvs subst' bndrs1 bndrs2 + ; return (mkForAllCo skol_tv vis1 vis2 kind_co co)} -- Done: unify phi1 ~ phi2 - go [] subst bndrs1 bndrs2 + go uenv [] subst bndrs1 bndrs2 = assert (null bndrs1 && null bndrs2) $ - unify loc rewriters (eqRelRole eq_rel) phi1' (substTyUnchecked subst phi2) + uType uenv phi1' (substTyUnchecked subst phi2) - go _ _ _ _ = panic "cna_eq_nc_forall" -- case (s:ss) [] + go _ _ _ _ _ = panic "can_eq_nc_forall" -- case (s:ss) [] empty_subst2 = mkEmptySubst (getSubstInScope subst1) - ; (lvl, (all_co, wanteds)) <- pushLevelNoWorkList (ppr skol_info) $ - go skol_tvs empty_subst2 bndrs1 bndrs2 + ; (lvl, (all_co, wanteds)) <- pushLevelNoWorkList (ppr skol_info) $ + unifyForAllBody ev (eqRelRole eq_rel) $ \uenv -> + go uenv skol_tvs empty_subst2 bndrs1 bndrs2 ; emitTvImplicationTcS lvl (getSkolemInfo skol_info) skol_tvs wanteds ; setWantedEq orig_dest all_co @@ -546,16 +542,24 @@ can_eq_nc_forall ev eq_rel s1 s2 ; stopWith ev "Discard given polytype equality" } where - unify :: CtLoc -> RewriterSet -> Role -> TcType -> TcType -> TcS (TcCoercion, Cts) - -- This version returns the wanted constraint rather - -- than putting it in the work list - unify loc rewriters role ty1 ty2 - | ty1 `tcEqType` ty2 - = return (mkReflCo role ty1, emptyBag) - | otherwise - = do { (wanted, co) <- newWantedEq loc rewriters role ty1 ty2 - ; return (co, unitBag (mkNonCanonical wanted)) } - + split_foralls :: TcType -> TcType + -> ([ForAllTyBinder], TcType, [ForAllTyBinder], TcType) + -- Split matching foralls; stop when the foralls don't match + -- See #22537. ToDo: amplify this note + split_foralls s1 s2 + | n_bndrs1 == n_bndrs2 = ( bndrs1, phi1 + , bndrs2, phi2) + | n_bndrs1 < n_bndrs2 = ( bndrs1, phi1 + , take n_bndrs1 bndrs2 + , mkForAllTys (drop n_bndrs1 bndrs2) phi2 ) + | otherwise = ( take n_bndrs2 bndrs1 + , mkForAllTys (drop n_bndrs2 bndrs1) phi1 + , bndrs2, phi2 ) + where + (bndrs1, phi1) = tcSplitForAllTyVarBinders s1 + (bndrs2, phi2) = tcSplitForAllTyVarBinders s2 + n_bndrs1 = length bndrs1 + n_bndrs2 = length bndrs2 {- Note [Unwrap newtypes first] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -97,7 +97,7 @@ module GHC.Tc.Solver.Monad ( instDFunType, -- Unification - wrapUnifierTcS, unifyFunDeps, uPairsTcM, + wrapUnifierTcS, unifyFunDeps, uPairsTcM, unifyForAllBody, -- MetaTyVars newFlexiTcSTy, instFlexiX, @@ -1997,6 +1997,16 @@ unifyFunDeps ev role do_unifications where fvs = tyCoVarsOfType (ctEvPred ev) +unifyForAllBody :: CtEvidence -> Role -> (UnifyEnv -> TcM a) + -> TcS (a, Cts) +unifyForAllBody ev role unify_body + = do { (res, cts, unified, _rewriters) <- wrapUnifierX ev role unify_body + + -- Kick out any inert constraint that we have unified + ; _ <- kickOutAfterUnification unified + + ; return (res, cts) } + wrapUnifierTcS :: CtEvidence -> Role -> (UnifyEnv -> TcM a) -- Some calls to uType -> TcS (a, Bag Ct, [TcTyVar]) @@ -2010,21 +2020,7 @@ wrapUnifierTcS :: CtEvidence -> Role -- unified the process; the (Bag Ct) are the deferred constraints. wrapUnifierTcS ev role do_unifications - = do { (cos, unified, rewriters, cts) <- wrapTcS $ - do { defer_ref <- TcM.newTcRef emptyBag - ; unified_ref <- TcM.newTcRef [] - ; rewriters <- TcM.zonkRewriterSet (ctEvRewriters ev) - ; let env = UE { u_role = role - , u_rewriters = rewriters - , u_loc = ctEvLoc ev - , u_defer = defer_ref - , u_unified = Just unified_ref} - - ; cos <- do_unifications env - - ; cts <- TcM.readTcRef defer_ref - ; unified <- TcM.readTcRef unified_ref - ; return (cos, unified, rewriters, cts) } + = do { (res, cts, unified, rewriters) <- wrapUnifierX ev role do_unifications -- Emit the deferred constraints -- See Note [Work-list ordering] in GHC.Tc.Solved.Equality @@ -2034,7 +2030,27 @@ wrapUnifierTcS ev role do_unifications -- And kick out any inert constraint that we have unified ; _ <- kickOutAfterUnification unified - ; return (cos, cts, unified) } + ; return (res, cts, unified) } + +wrapUnifierX :: CtEvidence -> Role + -> (UnifyEnv -> TcM a) -- Some calls to uType + -> TcS (a, Bag Ct, [TcTyVar], RewriterSet) +wrapUnifierX ev role do_unifications + = wrapTcS $ + do { defer_ref <- TcM.newTcRef emptyBag + ; unified_ref <- TcM.newTcRef [] + ; rewriters <- TcM.zonkRewriterSet (ctEvRewriters ev) + ; let env = UE { u_role = role + , u_rewriters = rewriters + , u_loc = ctEvLoc ev + , u_defer = defer_ref + , u_unified = Just unified_ref} + + ; res <- do_unifications env + + ; cts <- TcM.readTcRef defer_ref + ; unified <- TcM.readTcRef unified_ref + ; return (res, cts, unified, rewriters) } {- ===================================== compiler/GHC/Tc/TyCl/Utils.hs ===================================== @@ -137,7 +137,8 @@ synonymTyConsOfType ty go_co (GRefl _ ty mco) = go ty `plusNameEnv` go_mco mco go_co (TyConAppCo _ tc cs) = go_tc tc `plusNameEnv` go_co_s cs go_co (AppCo co co') = go_co co `plusNameEnv` go_co co' - go_co (ForAllCo _ _ _ co co') = go_co co `plusNameEnv` go_co co' + go_co (ForAllCo { fco_kind = kind_co, fco_body = body_co }) + = go_co kind_co `plusNameEnv` go_co body_co go_co (FunCo { fco_mult = m, fco_arg = a, fco_res = r }) = go_co m `plusNameEnv` go_co a `plusNameEnv` go_co r go_co (CoVarCo _) = emptyNameEnv ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -1447,7 +1447,7 @@ collect_cand_qtvs_co orig_ty cur_lvl bound = go_co go_co dv (CoVarCo cv) = go_cv dv cv - go_co dv (ForAllCo tcv _visL _visR kind_co co) + go_co dv (ForAllCo { fco_tcv = tcv, fco_kind = kind_co, fco_body = co }) = do { dv1 <- go_co dv kind_co ; collect_cand_qtvs_co orig_ty cur_lvl (bound `extendVarSet` tcv) dv1 co } ===================================== compiler/GHC/Types/Var.hs ===================================== @@ -69,6 +69,7 @@ module GHC.Types.Var ( ForAllTyFlag(Invisible,Required,Specified,Inferred), Specificity(..), isVisibleForAllTyFlag, isInvisibleForAllTyFlag, isInferredForAllTyFlag, + coreTyLamForAllTyFlag, -- * FunTyFlag FunTyFlag(..), isVisibleFunArg, isInvisibleFunArg, isFUNArg, @@ -488,6 +489,12 @@ isInferredForAllTyFlag :: ForAllTyFlag -> Bool isInferredForAllTyFlag (Invisible InferredSpec) = True isInferredForAllTyFlag _ = False +coreTyLamForAllTyFlag :: ForAllTyFlag +-- ^ The ForAllTyFlag on a (Lam a e) term, where `a` is a type variable. +-- If you want other ForAllTyFlag, use a cast. +-- See Note [Forall coercions] in GHC.Core.TyCo.Rep +coreTyLamForAllTyFlag = Specified + instance Outputable ForAllTyFlag where ppr Required = text "[req]" ppr Specified = text "[spec]" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/148e83dff016be02f155ec116b52acb1ce8bb9f9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/148e83dff016be02f155ec116b52acb1ce8bb9f9 You're receiving 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 Jun 14 11:42:31 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Wed, 14 Jun 2023 07:42:31 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/DIB-instances] Implement the -Wimplicit-rhs-quantification warning (#23510) Message-ID: <6489a7a733726_17e3c23e8e81c140045@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/DIB-instances at Glasgow Haskell Compiler / GHC Commits: 17b2cd17 by Andrei Borzenkov at 2023-06-14T15:42:00+04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 19 changed files: - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - docs/users_guide/using-warnings.rst - testsuite/tests/dependent/should_compile/T16391a.hs - testsuite/tests/ghci/scripts/ghci024.stdout - testsuite/tests/ghci/scripts/ghci024.stdout-mingw32 - + testsuite/tests/rename/should_compile/T23510b.hs - testsuite/tests/rename/should_compile/all.T - + testsuite/tests/rename/should_fail/T23510a.hs - + testsuite/tests/rename/should_fail/T23510a.stderr - testsuite/tests/rename/should_fail/all.T - testsuite/tests/typecheck/should_compile/T13343.hs Changes: ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -641,6 +641,7 @@ data WarningFlag = | Opt_WarnLoopySuperclassSolve -- Since 9.6 | Opt_WarnTermVariableCapture -- Since 9.8 | Opt_WarnMissingRoleAnnotations -- Since 9.8 + | Opt_WarnImplicitRhsQuantification -- Since 9.8 deriving (Eq, Ord, Show, Enum) -- | Return the names of a WarningFlag @@ -748,6 +749,7 @@ warnFlagNames wflag = case wflag of Opt_WarnLoopySuperclassSolve -> "loopy-superclass-solve" :| [] Opt_WarnTypeEqualityRequiresOperators -> "type-equality-requires-operators" :| [] Opt_WarnMissingRoleAnnotations -> "missing-role-annotations" :| [] + Opt_WarnImplicitRhsQuantification -> "implicit-rhs-quantification" :| [] -- ----------------------------------------------------------------------------- -- Standard sets of warning options @@ -939,6 +941,7 @@ minusWcompatOpts , Opt_WarnNonCanonicalMonadInstances , Opt_WarnCompatUnqualifiedImports , Opt_WarnTypeEqualityOutOfScope + , Opt_WarnImplicitRhsQuantification ] -- | Things you get with -Wunused-binds ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2259,7 +2259,8 @@ wWarningFlagsDeps = mconcat [ warnSpec Opt_WarnTypeEqualityOutOfScope, warnSpec Opt_WarnTypeEqualityRequiresOperators, warnSpec Opt_WarnTermVariableCapture, - warnSpec Opt_WarnMissingRoleAnnotations + warnSpec Opt_WarnMissingRoleAnnotations, + warnSpec Opt_WarnImplicitRhsQuantification ] warningGroupsDeps :: [(Deprecation, FlagSpec WarningGroup)] ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -918,8 +918,8 @@ bindHsQTyVars :: forall a b. -> Maybe a -- Just _ => an associated type decl -> FreeKiTyVars -- Kind variables from scope -> LHsQTyVars GhcPs - -> (LHsQTyVars GhcRn -> Bool -> RnM (b, FreeVars)) - -- The Bool is True <=> all kind variables used in the + -> (LHsQTyVars GhcRn -> FreeKiTyVars -> RnM (b, FreeVars)) + -- The FreeKiTyVars is null <=> all kind variables used in the -- kind signature are bound on the left. Reason: -- the last clause of Note [CUSKs: complete user-supplied kind signatures] -- in GHC.Hs.Decls @@ -942,7 +942,6 @@ bindHsQTyVars doc mb_assoc body_kv_occs hsq_bndrs thing_inside bndr_kv_occs ++ body_kv_occs body_remaining = filterFreeVarsToBind bndr_kv_occs $ filterFreeVarsToBind bndrs body_kv_occs - all_bound_on_lhs = null body_remaining ; traceRn "checkMixedVars3" $ vcat [ text "bndrs" <+> ppr hs_tv_bndrs @@ -969,7 +968,7 @@ bindHsQTyVars doc mb_assoc body_kv_occs hsq_bndrs thing_inside ; traceRn "bindHsQTyVars" (ppr hsq_bndrs $$ ppr implicit_kv_nms $$ ppr rn_bndrs) ; thing_inside (HsQTvs { hsq_ext = implicit_kv_nms , hsq_explicit = rn_bndrs }) - all_bound_on_lhs } } + body_remaining } } where hs_tv_bndrs = hsQTvExplicit hsq_bndrs @@ -1802,12 +1801,15 @@ one exists: The logic resides in extractHsTyRdrTyVarsKindVars. We use it both for type synonyms and type family instances. -This is something of a stopgap solution until we can explicitly bind invisible +This was a stopgap solution until we could explicitly bind invisible type/kind variables: type TySyn3 :: forall a. Maybe a type TySyn3 @a = 'Just ('Nothing :: Maybe a) +Now that the new syntax was proposed in #425 and implemented in 9.8, we issue a warning +-Wimplicit-rhs-quantification for TySyn2 and TySyn4 and will eventually disallow them. + Note [Implicit quantification in type synonyms: non-taken alternatives] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -1709,11 +1709,16 @@ rnTyClDecl (SynDecl { tcdLName = tycon, tcdTyVars = tyvars, ; let kvs = extractHsTyRdrTyVarsKindVars rhs doc = TySynCtx tycon ; traceRn "rntycl-ty" (ppr tycon <+> ppr kvs) - ; bindHsQTyVars doc Nothing kvs tyvars $ \ tyvars' _ -> - do { (rhs', fvs) <- rnTySyn doc rhs + ; bindHsQTyVars doc Nothing kvs tyvars $ \ tyvars' free_rhs_kvs -> + do { mapM_ warn_implicit_kvs (nubL free_rhs_kvs) + ; (rhs', fvs) <- rnTySyn doc rhs ; return (SynDecl { tcdLName = tycon', tcdTyVars = tyvars' , tcdFixity = fixity , tcdRhs = rhs', tcdSExt = fvs }, fvs) } } + where + warn_implicit_kvs :: LocatedN RdrName -> RnM () + warn_implicit_kvs kv = + addDiagnosticAt (getLocA kv) (TcRnImplicitRhsQuantification kv) -- "data", "newtype" declarations rnTyClDecl (DataDecl @@ -1725,12 +1730,12 @@ rnTyClDecl (DataDecl doc = TyDataCtx tycon new_or_data = dataDefnConsNewOrData cons ; traceRn "rntycl-data" (ppr tycon <+> ppr kvs) - ; bindHsQTyVars doc Nothing kvs tyvars $ \ tyvars' no_rhs_kvs -> + ; bindHsQTyVars doc Nothing kvs tyvars $ \ tyvars' free_rhs_kvs -> do { (defn', fvs) <- rnDataDefn doc defn - ; cusk <- data_decl_has_cusk tyvars' new_or_data no_rhs_kvs kind_sig + ; cusk <- data_decl_has_cusk tyvars' new_or_data (null free_rhs_kvs) kind_sig ; let rn_info = DataDeclRn { tcdDataCusk = cusk , tcdFVs = fvs } - ; traceRn "rndata" (ppr tycon <+> ppr cusk <+> ppr no_rhs_kvs) + ; traceRn "rndata" (ppr tycon <+> ppr cusk <+> ppr free_rhs_kvs) ; return (DataDecl { tcdLName = tycon' , tcdTyVars = tyvars' , tcdFixity = fixity ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1851,6 +1851,11 @@ instance Diagnostic TcRnMessage where , text "or a complete user-supplied kind (CUSK, legacy feature)" , text "is required to use invisible binders." ] + TcRnImplicitRhsQuantification kv -> mkSimpleDecorated $ + vcat [ text "The variable" <+> quotes (ppr kv) <+> text "occurs free on the RHS of the type declaration" + , text "In the future GHC will no longer implicitly quantify over such variables" + ] + diagnosticReason = \case TcRnUnknownMessage m -> diagnosticReason m @@ -2467,6 +2472,8 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnInvisBndrWithoutSig{} -> ErrorWithoutFlag + TcRnImplicitRhsQuantification{} + -> WarningWithFlag Opt_WarnImplicitRhsQuantification diagnosticHints = \case TcRnUnknownMessage m @@ -3130,6 +3137,8 @@ instance Diagnostic TcRnMessage where -> noHints TcRnInvisBndrWithoutSig name _ -> [SuggestAddStandaloneKindSignature name] + TcRnImplicitRhsQuantification kv + -> [SuggestBindTyVarOnLhs (unLoc kv)] diagnosticCode :: TcRnMessage -> Maybe DiagnosticCode diagnosticCode = constructorCode ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -4094,6 +4094,23 @@ data TcRnMessage where -} TcRnMissingRoleAnnotation :: Name -> [Role] -> TcRnMessage + {-| TcRnImplicitRhsQuantification is a warning that occurs when GHC implicitly + quantifies over a type variable that occurs free on the RHS of the type declaration + that is not mentioned on the LHS + + Example: + + type T = 'Nothing :: Maybe a + + Controlled by flags: + - Wimplicit-rhs-quantification + + Test cases: + T23510a + T23510b + -} + TcRnImplicitRhsQuantification :: LocatedN RdrName -> TcRnMessage + deriving Generic ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -591,6 +591,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnArityMismatch" = 27346 GhcDiagnosticCode "TcRnSimplifiableConstraint" = 62412 GhcDiagnosticCode "TcRnIllegalQuasiQuotes" = 77343 + GhcDiagnosticCode "TcRnImplicitRhsQuantification" = 16382 -- TcRnTypeApplicationsDisabled GhcDiagnosticCode "TypeApplication" = 23482 ===================================== compiler/GHC/Types/Hint.hs ===================================== @@ -465,6 +465,9 @@ data GhcHint {-| Suggest eta-reducing a type synonym used in the implementation of abstract data. -} | SuggestEtaReduceAbsDataTySyn TyCon + {-| Suggest binding the type variable on the LHS of the type declaration + -} + | SuggestBindTyVarOnLhs RdrName -- | An 'InstantiationSuggestion' for a '.hsig' file. This is generated -- by GHC in case of a 'DriverUnexpectedSignature' and suggests a way ===================================== compiler/GHC/Types/Hint/Ppr.hs ===================================== @@ -251,6 +251,8 @@ instance Outputable GhcHint where SuggestEtaReduceAbsDataTySyn tc -> text "If possible, eta-reduce the type synonym" <+> ppr_tc <+> text "so that it is nullary." where ppr_tc = quotes (ppr $ tyConName tc) + SuggestBindTyVarOnLhs tv + -> text "Bind" <+> quotes (ppr tv) <+> text "on the LHS of the type declaration" perhapsAsPat :: SDoc perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace" ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -166,6 +166,7 @@ as ``-Wno-...`` for every individual warning in the group. * :ghc-flag:`-Wnoncanonical-monad-instances` * :ghc-flag:`-Wcompat-unqualified-imports` * :ghc-flag:`-Wtype-equality-out-of-scope` + * :ghc-flag:`-Wimplicit-rhs-quantification` .. ghc-flag:: -w :shortdesc: disable all warnings @@ -2415,6 +2416,28 @@ of ``-W(no-)*``. In other words the type-class role cannot be accidentally left representational or phantom, which could affected the code correctness. +.. ghc-flag:: -Wimplicit-rhs-quantification + :shortdesc: warn when type variables on the RHS of a type synonym are implicitly quantified + :type: dynamic + :reverse: -Wno-implicit-rhs-quantification + :category: + + :since: 9.8 + :default: off + + In accordance with `GHC Proposal #425 + `__, + GHC will stop implicitly quantifying over type variables that occur free on the + right-hand side of a type synonym but are not mentioned on the left-hand side. + Type synonym declarations that rely on this form of quantification should be rewritten with invisible binders. + + For example: :: + + type T1 :: forall a . Maybe a + type T1 = 'Nothing :: Maybe a -- old + type T1 @a = 'Nothing :: Maybe a -- new + + This warning detects code that will be affected by this breaking change. If you're feeling really paranoid, the :ghc-flag:`-dcore-lint` option is a good choice. It turns on heavyweight intra-pass sanity-checking within GHC. (It checks GHC's ===================================== testsuite/tests/dependent/should_compile/T16391a.hs ===================================== @@ -9,7 +9,8 @@ import Data.Kind type Const (a :: Type) (b :: Type) = a type family F :: Const Type a where F = Int -type TS = (Int :: Const Type a) +type TS :: forall a . Const Type a +type TS @a = (Int :: Const Type a) data T1 :: Const Type a where MkT1 :: T1 data T2 :: Const Type a -> Type where ===================================== testsuite/tests/ghci/scripts/ghci024.stdout ===================================== @@ -18,6 +18,7 @@ warning settings: -Wsemigroup -Wcompat-unqualified-imports -Wtype-equality-out-of-scope + -Wimplicit-rhs-quantification ~~~~~~~~~~ Testing :set -a options currently set: none. base language is: GHC2021 ===================================== testsuite/tests/ghci/scripts/ghci024.stdout-mingw32 ===================================== @@ -17,6 +17,7 @@ warning settings: -Wsemigroup -Wcompat-unqualified-imports -Wtype-equality-out-of-scope + -Wimplicit-rhs-quantification ~~~~~~~~~~ Testing :set -a options currently set: none. base language is: GHC2021 ===================================== testsuite/tests/rename/should_compile/T23510b.hs ===================================== @@ -0,0 +1,14 @@ +{-# OPTIONS -Wimplicit-rhs-quantification #-} +{-# LANGUAGE DataKinds, TypeAbstractions #-} +module T23510b where + +import Data.Proxy + +type T1 :: forall k . Maybe k +type T1 @a = 'Nothing :: Maybe a + +type T2 :: forall k j . k -> Either k j +type T2 @a @b = 'Left :: a -> Either a b + +type T3 :: forall {k} (d :: k) . Proxy k +type T3 @(a :: k) = 'Proxy :: Proxy k ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -212,3 +212,4 @@ test('T22122', [expect_broken(22122), extra_files(['T22122_aux.hs'])], multimod_ test('T23240', [req_th, extra_files(['T23240_aux.hs'])], multimod_compile, ['T23240', '-v0']) test('T23318', normal, compile, ['-Wduplicate-exports']) test('T23434', normal, compile, ['']) +test('T23510b', normal, compile, ['']) ===================================== testsuite/tests/rename/should_fail/T23510a.hs ===================================== @@ -0,0 +1,17 @@ +{-# OPTIONS -Wimplicit-rhs-quantification #-} +{-# LANGUAGE DataKinds #-} +module T23510a where + +import Data.Proxy +import GHC.Types + +type T1 = 'Nothing :: Maybe a + +type T2 = 'Left :: a -> Either a b + +type T3 = 'Proxy :: Proxy k + +type Const (a :: Type) (b :: Type) = a +type TS = (Int :: Const Type a) + +type Bad = (forall (v1 :: RuntimeRep) (a1 :: TYPE v). a1) :: TYPE v ===================================== testsuite/tests/rename/should_fail/T23510a.stderr ===================================== @@ -0,0 +1,30 @@ + +T23510a.hs:8:29: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘a’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘a’ on the LHS of the type declaration + +T23510a.hs:10:20: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘a’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘a’ on the LHS of the type declaration + +T23510a.hs:10:34: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘b’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘b’ on the LHS of the type declaration + +T23510a.hs:12:27: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘k’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘k’ on the LHS of the type declaration + +T23510a.hs:15:30: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘a’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘a’ on the LHS of the type declaration + +T23510a.hs:17:67: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘v’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘v’ on the LHS of the type declaration ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -198,3 +198,4 @@ test('RnUnexpectedStandaloneDeriving', normal, compile_fail, ['']) test('RnStupidThetaInGadt', normal, compile_fail, ['']) test('PackageImportsDisabled', normal, compile_fail, ['']) test('ImportLookupIllegal', normal, compile_fail, ['']) +test('T23510a', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_compile/T13343.hs ===================================== @@ -4,6 +4,7 @@ module Bug where import GHC.Exts -type Bad = (forall (v1 :: RuntimeRep) (a1 :: TYPE v). a1) :: TYPE v +type Bad :: forall v . TYPE v +type Bad @v = (forall (v1 :: RuntimeRep) (a1 :: TYPE v). a1) :: TYPE v --- should be accepted because GHC will generalize over v. Note v /= v1. +-- Note v /= v1. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/17b2cd17089f1822d2d487af45d48c6cfc96349e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/17b2cd17089f1822d2d487af45d48c6cfc96349e You're receiving 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 Jun 14 12:37:40 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 14 Jun 2023 08:37:40 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 12 commits: Add -Wmissing-poly-kind-signatures Message-ID: <6489b49494751_17e3c23e8e81c1677a6@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - d0dbe81f by Jacco Krijnen at 2023-06-14T08:37:34-04:00 Add more flags for dumping core passes (#23491) - - - - - 9053a544 by Jacco Krijnen at 2023-06-14T08:37:34-04:00 Add tests for dumping flags (#23491) - - - - - 9a60412d by Sebastian Graf at 2023-06-14T08:37:35-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Type.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Demand.hs - docs/users_guide/debugging.rst - docs/users_guide/using-warnings.rst - libraries/base/GHC/TypeLits/Internal.hs - libraries/base/GHC/TypeNats/Internal.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - testsuite/driver/testlib.py - testsuite/tests/polykinds/T22743.stderr - + testsuite/tests/rep-poly/T23176.hs - + testsuite/tests/rep-poly/T23176.stderr - testsuite/tests/rep-poly/all.T - + testsuite/tests/simplCore/should_compile/T23491.hs - + testsuite/tests/simplCore/should_compile/T23491a.stderr - + testsuite/tests/simplCore/should_compile/T23491b.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/79870853c232867acbfbd180fe33a93893e0384a...9a60412d29330abcfb9ef1ed2df59dca8eea6573 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/79870853c232867acbfbd180fe33a93893e0384a...9a60412d29330abcfb9ef1ed2df59dca8eea6573 You're receiving 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 Jun 14 12:48:49 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Wed, 14 Jun 2023 08:48:49 -0400 Subject: [Git][ghc/ghc][wip/T22010] Quick fixes for tests Message-ID: <6489b731d0cc4_17e3c240e32ac1770d4@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: fa21833a by Jaro Reinders at 2023-06-14T14:48:36+02:00 Quick fixes for tests - - - - - 3 changed files: - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout - testsuite/tests/perf/should_run/UniqLoop.hs Changes: ===================================== testsuite/tests/count-deps/CountDepsAst.stdout ===================================== @@ -100,6 +100,13 @@ GHC.Data.Strict GHC.Data.StringBuffer GHC.Data.TrieMap GHC.Data.Unboxed +GHC.Data.Word64Map +GHC.Data.Word64Map.Internal +GHC.Data.Word64Map.Lazy +GHC.Data.Word64Map.Strict +GHC.Data.Word64Map.Strict.Internal +GHC.Data.Word64Set +GHC.Data.Word64Set.Internal GHC.Driver.Backend GHC.Driver.Backend.Internal GHC.Driver.Config.Core.Lint @@ -286,6 +293,9 @@ GHC.Utils.Binary.Typeable GHC.Utils.BufHandle GHC.Utils.CliOption GHC.Utils.Constants +GHC.Utils.Containers.Internal.BitUtil +GHC.Utils.Containers.Internal.Prelude +GHC.Utils.Containers.Internal.StrictPair GHC.Utils.Error GHC.Utils.Exception GHC.Utils.FV ===================================== testsuite/tests/count-deps/CountDepsParser.stdout ===================================== @@ -100,6 +100,13 @@ GHC.Data.Strict GHC.Data.StringBuffer GHC.Data.TrieMap GHC.Data.Unboxed +GHC.Data.Word64Map +GHC.Data.Word64Map.Internal +GHC.Data.Word64Map.Lazy +GHC.Data.Word64Map.Strict +GHC.Data.Word64Map.Strict.Internal +GHC.Data.Word64Set +GHC.Data.Word64Set.Internal GHC.Driver.Backend GHC.Driver.Backend.Internal GHC.Driver.Backpack.Syntax @@ -293,6 +300,9 @@ GHC.Utils.Binary.Typeable GHC.Utils.BufHandle GHC.Utils.CliOption GHC.Utils.Constants +GHC.Utils.Containers.Internal.BitUtil +GHC.Utils.Containers.Internal.Prelude +GHC.Utils.Containers.Internal.StrictPair GHC.Utils.Error GHC.Utils.Exception GHC.Utils.FV ===================================== testsuite/tests/perf/should_run/UniqLoop.hs ===================================== @@ -4,13 +4,14 @@ module Main where import GHC.Types.Unique.Supply import GHC.Types.Unique +import Data.Word -- Generate a lot of uniques main = do us <- mkSplitUniqSupply 'v' seq (churn us 10000000) (return ()) -churn :: UniqSupply -> Int -> Int +churn :: UniqSupply -> Word64 -> Word64 churn !us 0 = getKey $ uniqFromSupply us churn us n = let (!x,!us') = takeUniqFromSupply us View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fa21833aa157a32c7e5dcb7f750daf6982a5c013 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fa21833aa157a32c7e5dcb7f750daf6982a5c013 You're receiving 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 Jun 14 12:49:20 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Wed, 14 Jun 2023 08:49:20 -0400 Subject: [Git][ghc/ghc][wip/T22010] Fix atomic_inc64 declaration Message-ID: <6489b7505a5fa_17e3c244975ec177497@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: be12acc6 by Jaro Reinders at 2023-06-14T14:49:15+02:00 Fix atomic_inc64 declaration - - - - - 1 changed file: - rts/include/stg/SMP.h Changes: ===================================== rts/include/stg/SMP.h ===================================== @@ -94,7 +94,7 @@ EXTERN_INLINE StgWord atomic_inc(StgVolatilePtr p, StgWord n); * return ((*p) += n); * } */ -EXTERN_INLINE StgWord64 atomic_inc64(StgVolatilePtr p, StgWord64 n); +EXTERN_INLINE StgWord64 atomic_inc64(StgWord64 volatile* p, StgWord64 n); /* * Atomic decrement @@ -440,7 +440,7 @@ atomic_inc(StgVolatilePtr p, StgWord incr) } EXTERN_INLINE StgWord64 -atomic_inc64(StgVolatilePtr p, StgWord64 incr) +atomic_inc64(StgWord64 volatile* p, StgWord64 incr) { #if defined(HAVE_C11_ATOMICS) return __atomic_add_fetch(p, incr, __ATOMIC_SEQ_CST); @@ -678,9 +678,9 @@ atomic_inc(StgVolatilePtr p, StgWord incr) } -EXTERN_INLINE StgWord64 atomic_inc64(StgVolatilePtr p, StgWord64 incr); +EXTERN_INLINE StgWord64 atomic_inc64(StgWord64 volatile* p, StgWord64 incr); EXTERN_INLINE StgWord64 -atomic_inc64(StgVolatilePtr p, StgWord64 incr) +atomic_inc64(StgWord64 volatile* p, StgWord64 incr) { return ((*p) += incr); } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/be12acc6f7c3812ed4641d59505dae8fd6079540 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/be12acc6f7c3812ed4641d59505dae8fd6079540 You're receiving 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 Jun 14 12:49:59 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Wed, 14 Jun 2023 08:49:59 -0400 Subject: [Git][ghc/ghc][wip/T22010] Refactor mkUnique Message-ID: <6489b7778ae11_17e3c240e32ac1778f@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: f0c7bfd1 by Jaro Reinders at 2023-06-14T14:49:51+02:00 Refactor mkUnique - - - - - 3 changed files: - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Types/Unique.hs - compiler/GHC/Types/Unique/Supply.hs Changes: ===================================== compiler/GHC/Builtin/Uniques.hs ===================================== @@ -117,14 +117,14 @@ mkSumTyConUnique arity = assertPpr (arity <= 0x3f) (ppr arity) $ -- 0x3f since we only have 6 bits to encode the -- alternative - mkUnique 'z' (arity `shiftL` 8 .|. 0xfc) + mkUniqueInt 'z' (arity `shiftL` 8 .|. 0xfc) mkSumDataConUnique :: ConTagZ -> Arity -> Unique mkSumDataConUnique alt arity | alt >= arity = panic ("mkSumDataConUnique: " ++ show alt ++ " >= " ++ show arity) | otherwise - = mkUnique 'z' (arity `shiftL` 8 + alt `shiftL` 2) {- skip the tycon -} + = mkUniqueInt 'z' (arity `shiftL` 8 + alt `shiftL` 2) {- skip the tycon -} getUnboxedSumName :: Int -> Name getUnboxedSumName n @@ -211,17 +211,17 @@ selector Uniques takes inspiration from the encoding for unboxed sum Uniques. -} mkCTupleTyConUnique :: Arity -> Unique -mkCTupleTyConUnique a = mkUnique 'k' (2*a) +mkCTupleTyConUnique a = mkUniqueInt 'k' (2*a) mkCTupleDataConUnique :: Arity -> Unique -mkCTupleDataConUnique a = mkUnique 'm' (3*a) +mkCTupleDataConUnique a = mkUniqueInt 'm' (3*a) mkCTupleSelIdUnique :: ConTagZ -> Arity -> Unique mkCTupleSelIdUnique sc_pos arity | sc_pos >= arity = panic ("mkCTupleSelIdUnique: " ++ show sc_pos ++ " >= " ++ show arity) | otherwise - = mkUnique 'j' (arity `shiftL` cTupleSelIdArityBits + sc_pos) + = mkUniqueInt 'j' (arity `shiftL` cTupleSelIdArityBits + sc_pos) getCTupleTyConName :: Int -> Name getCTupleTyConName n = @@ -264,12 +264,12 @@ cTupleSelIdPosBitmask = 0xff -- Normal tuples mkTupleDataConUnique :: Boxity -> Arity -> Unique -mkTupleDataConUnique Boxed a = mkUnique '7' (3*a) -- may be used in C labels -mkTupleDataConUnique Unboxed a = mkUnique '8' (3*a) +mkTupleDataConUnique Boxed a = mkUniqueInt '7' (3*a) -- may be used in C labels +mkTupleDataConUnique Unboxed a = mkUniqueInt '8' (3*a) mkTupleTyConUnique :: Boxity -> Arity -> Unique -mkTupleTyConUnique Boxed a = mkUnique '4' (2*a) -mkTupleTyConUnique Unboxed a = mkUnique '5' (2*a) +mkTupleTyConUnique Boxed a = mkUniqueInt '4' (2*a) +mkTupleTyConUnique Unboxed a = mkUniqueInt '5' (2*a) -- | This function is an inverse of `mkTupleTyConUnique` isTupleTyConUnique :: Unique -> Maybe (Boxity, Arity) @@ -361,27 +361,27 @@ mkPrimOpIdUnique :: Int -> Unique mkPrimOpWrapperUnique :: Int -> Unique mkPreludeMiscIdUnique :: Int -> Unique -mkAlphaTyVarUnique i = mkUnique '1' i -mkPreludeClassUnique i = mkUnique '2' i +mkAlphaTyVarUnique i = mkUniqueInt '1' i +mkPreludeClassUnique i = mkUniqueInt '2' i -------------------------------------------------- -mkPrimOpIdUnique op = mkUnique '9' (2*op) -mkPrimOpWrapperUnique op = mkUnique '9' (2*op+1) -mkPreludeMiscIdUnique i = mkUnique '0' i +mkPrimOpIdUnique op = mkUniqueInt '9' (2*op) +mkPrimOpWrapperUnique op = mkUniqueInt '9' (2*op+1) +mkPreludeMiscIdUnique i = mkUniqueInt '0' i mkPseudoUniqueE, mkBuiltinUnique :: Int -> Unique -mkBuiltinUnique i = mkUnique 'B' i -mkPseudoUniqueE i = mkUnique 'E' i -- used in NCG spiller to create spill VirtualRegs +mkBuiltinUnique i = mkUniqueInt 'B' i +mkPseudoUniqueE i = mkUniqueInt 'E' i -- used in NCG spiller to create spill VirtualRegs mkRegSingleUnique, mkRegPairUnique, mkRegSubUnique, mkRegClassUnique :: Int -> Unique -mkRegSingleUnique = mkUnique 'R' -mkRegSubUnique = mkUnique 'S' -mkRegPairUnique = mkUnique 'P' -mkRegClassUnique = mkUnique 'L' +mkRegSingleUnique = mkUniqueInt 'R' +mkRegSubUnique = mkUniqueInt 'S' +mkRegPairUnique = mkUniqueInt 'P' +mkRegClassUnique = mkUniqueInt 'L' mkCostCentreUnique :: Int -> Unique -mkCostCentreUnique = mkUnique 'C' +mkCostCentreUnique = mkUniqueInt 'C' varNSUnique, dataNSUnique, tvNSUnique, tcNSUnique :: Unique varNSUnique = mkUnique 'i' 0 @@ -390,7 +390,7 @@ tvNSUnique = mkUnique 'v' 0 tcNSUnique = mkUnique 'c' 0 mkFldNSUnique :: FastString -> Unique -mkFldNSUnique fs = mkUnique 'f' (uniqueOfFS fs) +mkFldNSUnique fs = mkUniqueInt 'f' (uniqueOfFS fs) isFldNSUnique :: Unique -> Bool isFldNSUnique uniq = case unpkUnique uniq of @@ -404,7 +404,7 @@ initExitJoinUnique = mkUnique 's' 0 -- See Note [Related uniques for wired-in things] mkPreludeTyConUnique :: Int -> Unique -mkPreludeTyConUnique i = mkUnique '3' (2*i) +mkPreludeTyConUnique i = mkUniqueInt '3' (2*i) tyConRepNameUnique :: Unique -> Unique tyConRepNameUnique u = incrUnique u @@ -414,7 +414,7 @@ tyConRepNameUnique u = incrUnique u -- See Note [Related uniques for wired-in things] mkPreludeDataConUnique :: Int -> Unique -mkPreludeDataConUnique i = mkUnique '6' (3*i) -- Must be alphabetic +mkPreludeDataConUnique i = mkUniqueInt '6' (3*i) -- Must be alphabetic dataConTyRepNameUnique, dataConWorkerUnique :: Unique -> Unique dataConWorkerUnique u = incrUnique u @@ -440,7 +440,7 @@ dataConTyRepNameUnique u = stepUnique u 2 -- A little delicate! mkBoxingTyConUnique :: Int -> Unique -mkBoxingTyConUnique i = mkUnique 'b' (5*i) +mkBoxingTyConUnique i = mkUniqueInt 'b' (5*i) boxingDataConUnique :: Unique -> Unique boxingDataConUnique u = stepUnique u 2 ===================================== compiler/GHC/Types/Unique.hs ===================================== @@ -32,7 +32,8 @@ module GHC.Types.Unique ( mkUniqueGrimily, getKey, - mkUnique, mkUnique64, unpkUnique, + mkUnique, unpkUnique, + mkUniqueInt, eqUnique, ltUnique, incrUnique, stepUnique, @@ -121,7 +122,7 @@ incrUnique (MkUnique i) = MkUnique (i + 1) stepUnique (MkUnique i) n = MkUnique (i + n) mkLocalUnique :: Word64 -> Unique -mkLocalUnique i = mkUnique64 'X' i +mkLocalUnique i = mkUnique 'X' i minLocalUnique :: Unique minLocalUnique = mkLocalUnique 0 @@ -130,7 +131,7 @@ maxLocalUnique :: Unique maxLocalUnique = mkLocalUnique uniqueMask -- newTagUnique changes the "domain" of a unique to a different char -newTagUnique u c = mkUnique64 c i where (_,i) = unpkUnique u +newTagUnique u c = mkUnique c i where (_,i) = unpkUnique u -- | How many bits are devoted to the unique index (as opposed to the class -- character). @@ -143,7 +144,7 @@ uniqueMask = (1 `shiftL` uNIQUE_BITS) - 1 -- and as long as the Char fits in 8 bits, which we assume anyway! -mkUnique :: Char -> Int -> Unique -- Builds a unique from pieces +mkUnique :: Char -> Word64 -> Unique -- Builds a unique from pieces -- EXPORTED and used only in GHC.Builtin.Uniques mkUnique c i = MkUnique (tag .|. bits) @@ -151,12 +152,8 @@ mkUnique c i tag = fromIntegral (ord c) `shiftL` uNIQUE_BITS bits = fromIntegral i .&. uniqueMask -mkUnique64 :: Char -> Word64 -> Unique -mkUnique64 c i - = MkUnique (tag .|. bits) - where - tag = fromIntegral (ord c) `shiftL` uNIQUE_BITS - bits = i .&. uniqueMask +mkUniqueInt :: Char -> Int -> Unique +mkUniqueInt c i = mkUnique c (fromIntegral i) unpkUnique (MkUnique u) = let ===================================== compiler/GHC/Types/Unique/Supply.hs ===================================== @@ -265,7 +265,7 @@ initUniqSupply counter inc = do uniqFromMask :: Char -> IO Unique uniqFromMask !mask = do { uqNum <- genSym - ; return $! mkUnique64 mask uqNum } + ; return $! mkUnique mask uqNum } {-# NOINLINE uniqFromMask #-} -- We'll unbox everything, but we don't want to inline it splitUniqSupply :: UniqSupply -> (UniqSupply, UniqSupply) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f0c7bfd16f5d98c69c0ae9628260557671147e46 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f0c7bfd16f5d98c69c0ae9628260557671147e46 You're receiving 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 Jun 14 13:53:08 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Wed, 14 Jun 2023 09:53:08 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/DIB-INSTANCES] Remove arity inference in type declarations (#23514) Message-ID: <6489c6445091f_c7397c5774703a5@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/DIB-INSTANCES at Glasgow Haskell Compiler / GHC Commits: 4eaa6859 by Andrei Borzenkov at 2023-06-14T17:50:40+04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 18 changed files: - compiler/GHC/Core/Type.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Splice.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - + testsuite/tests/rename/should_compile/T23514b.hs - testsuite/tests/rename/should_compile/all.T - + testsuite/tests/rename/should_fail/T23514a.hs - + testsuite/tests/rename/should_fail/T23514a.stderr - testsuite/tests/rename/should_fail/all.T - testsuite/tests/saks/should_compile/T16724.stdout - testsuite/tests/saks/should_compile/saks020.hs - testsuite/tests/saks/should_compile/saks030.hs - testsuite/tests/saks/should_compile/saks032.hs - testsuite/tests/typecheck/should_fail/T18640a.hs - testsuite/tests/typecheck/should_fail/T18640a.stderr - testsuite/tests/typecheck/should_fail/T18640c.hs - testsuite/tests/typecheck/should_fail/T18640c.stderr Changes: ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -60,7 +60,7 @@ module GHC.Core.Type ( mkTyConBindersPreferAnon, mkPiTy, mkPiTys, piResultTy, piResultTys, - applyTysX, dropForAlls, + applyTysX, dropForAlls, dropInvisForAlls, mkFamilyTyConApp, buildSynTyCon, @@ -1937,6 +1937,14 @@ dropForAlls ty = go ty go ty | Just ty' <- coreView ty = go ty' go res = res +-- | Drops all invisible ForAllTys +dropInvisForAlls :: Type -> Type +dropInvisForAlls ty = go ty + where + go (ForAllTy (Bndr _ Invisible{}) res) = go res + go ty | Just ty' <- coreView ty = go ty' + go res = res + -- | Attempts to take a forall type apart, but only if it's a proper forall, -- with a named binder splitForAllTyCoVar_maybe :: Type -> Maybe (TyCoVar, Type) ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -863,12 +863,7 @@ pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype, cons = visibleIfConDecls condecls pp_where = ppWhen (gadt && not (null cons)) $ text "where" pp_cons = ppr_trim (map show_con cons) :: [SDoc] - pp_kind = ppUnless (if ki_sig_printable - then isIfaceRhoType kind - -- Even in the presence of a standalone kind signature, a non-tau - -- result kind annotation cannot be discarded as it determines the arity. - -- See Note [Arity inference in kcCheckDeclHeader_sig] in GHC.Tc.Gen.HsType - else isIfaceLiftedTypeKind kind) + pp_kind = ppUnless (ki_sig_printable || isIfaceLiftedTypeKind kind) (dcolon <+> ppr kind) pp_lhs = case parent of ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -2557,35 +2557,25 @@ kcCheckDeclHeader_sig sig_kind name flav -- extended with both 'implicit_tcv_prs' and 'explicit_tv_prs'. ; ctx_k <- kc_res_ki - -- Work out extra_arity, the number of extra invisible binders from - -- the kind signature that should be part of the TyCon's arity. - -- See Note [Arity inference in kcCheckDeclHeader_sig] - ; let n_invis_tcbs = countWhile isInvisibleTyConBinder excess_sig_tcbs - invis_arity = case ctx_k of - AnyKind -> n_invis_tcbs -- No kind signature, so make all the invisible binders - -- the signature into part of the arity of the TyCon - OpenKind -> n_invis_tcbs -- Result kind is (TYPE rr), so again make all the - -- invisible binders part of the arity of the TyCon - TheKind ki -> 0 `max` (n_invis_tcbs - invisibleTyBndrCount ki) - - ; let (invis_tcbs, resid_tcbs) = splitAt invis_arity excess_sig_tcbs - ; let sig_res_kind' = mkTyConKind resid_tcbs sig_res_kind - - ; traceTc "kcCheckDeclHeader_sig 2" $ vcat [ ppr excess_sig_tcbs - , ppr invis_arity, ppr invis_tcbs - , ppr n_invis_tcbs ] + ; let sig_res_kind' = mkTyConKind excess_sig_tcbs sig_res_kind + + ; traceTc "kcCheckDeclHeader_sig 2" (ppr excess_sig_tcbs) -- Unify res_ki (from the type declaration) with the residual kind from -- the kind signature. Don't forget to apply the skolemising 'subst' first. ; case ctx_k of AnyKind -> return () -- No signature - _ -> do { res_ki <- newExpectedKind ctx_k - ; discardResult (unifyKind Nothing sig_res_kind' res_ki) } + OpenKind -> + do { res_ki <- newExpectedKind ctx_k + ; discardResult (unifyKind Nothing (dropInvisForAlls sig_res_kind') res_ki) } + TheKind _ -> + do { res_ki <- newExpectedKind ctx_k + ; discardResult (unifyKind Nothing sig_res_kind' res_ki) } -- Add more binders for data/newtype, so the result kind has no arrows -- See Note [Datatype return kinds] - ; if null resid_tcbs || not (needsEtaExpansion flav) - then return (invis_tcbs, sig_res_kind') + ; if null excess_sig_tcbs || not (needsEtaExpansion flav) + then return ([], sig_res_kind') else return (excess_sig_tcbs, sig_res_kind) } @@ -2780,86 +2770,6 @@ Basic plan is this: part of the signature (k -> Type) with the kind signature of the decl, (j -> Type). This unification, done in kcCheckDeclHeader, needs TcTyVars. - * The tricky extra_arity part is described in - Note [Arity inference in kcCheckDeclHeader_sig] - -Note [Arity inference in kcCheckDeclHeader_sig] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider these declarations: - type family S1 :: forall k2. k1 -> k2 -> Type - type family S2 (a :: k1) (b :: k2) :: Type - -Both S1 and S2 can be given the same standalone kind signature: - type S1 :: forall k1 k2. k1 -> k2 -> Type - type S2 :: forall k1 k2. k1 -> k2 -> Type - -And, indeed, tyConKind S1 == tyConKind S2. However, -tyConBinders and tyConResKind for S1 and S2 are different: - - tyConBinders S1 == [spec k1] - tyConResKind S1 == forall k2. k1 -> k2 -> Type - tyConKind S1 == forall k1 k2. k1 -> k2 -> Type - - tyConBinders S2 == [spec k1, spec k2, anon-vis (a :: k1), anon-vis (b :: k2)] - tyConResKind S2 == Type - tyConKind S1 == forall k1 k2. k1 -> k2 -> Type - -This difference determines the /arity/: - tyConArity tc == length (tyConBinders tc) -That is, the arity of S1 is 1, while the arity of S2 is 4. - -'kcCheckDeclHeader_sig' needs to infer the desired arity, to split the -standalone kind signature into binders and the result kind. It does so -in two rounds: - -1. matchUpSigWithDecl matches up - - the [TyConBinder] from (applying splitTyConKind to) the kind signature - - with the [LHsTyVarBndr] from the type declaration. - That may leave some excess TyConBinder: in the case of S2 there are - no excess TyConBinders, but in the case of S1 there are two (since - there are no LHsTYVarBndrs. - -2. Split off further TyConBinders (in the case of S1, one more) to - make it possible to unify the residual return kind with the - signature in the type declaration. More precisely, split off such - enough invisible that the remainder of the standalone kind - signature and the user-written result kind signature have the same - number of invisible quantifiers. - -As another example consider the following declarations: - - type F :: Type -> forall j. j -> forall k1 k2. (k1, k2) -> Type - type family F a b - - type G :: Type -> forall j. j -> forall k1 k2. (k1, k2) -> Type - type family G a b :: forall r2. (r1, r2) -> Type - -For both F and G, the signature (after splitTyConKind) has - sig_tcbs :: [TyConBinder] - = [ anon-vis (@a_aBq), spec (@j_auA), anon-vis (@(b_aBr :: j_auA)) - , spec (@k1_auB), spec (@k2_auC) - , anon-vis (@(c_aBs :: (k1_auB, k2_auC)))] - -matchUpSigWithDecl will consume the first three of these, passing on - excess_sig_tcbs - = [ spec (@k1_auB), spec (@k2_auC) - , anon-vis (@(c_aBs :: (k1_auB, k2_auC)))] - -For F, there is no result kind signature in the declaration for F, so -we absorb all invisible binders into F's arity. The resulting arity of -F is 3+2=5. - -Now, in the case of G, we have a result kind sig 'forall r2. (r2,r2)->Type'. -This has one invisible binder, so we split of enough extra binders from -our excess_sig_tcbs to leave just one to match 'r2'. - - res_ki = forall r2. (r1, r2) -> Type - kisig = forall k1 k2. (k1, k2) -> Type - ^^^ - split off this one. - -The resulting arity of G is 3+1=4. - Note [discardResult in kcCheckDeclHeader_sig] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We use 'unifyKind' to check inline kind annotations in declaration headers ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -796,7 +796,7 @@ tcTExpTy m_ty exp_ty TcRnTHError $ TypedTHError $ TypedTHWithPolyType exp_ty ; codeCon <- tcLookupTyCon codeTyConName ; let rep = getRuntimeRep exp_ty - ; return (mkTyConApp codeCon [rep, m_ty, exp_ty]) } + ; return (mkTyConApp codeCon [m_ty, rep, exp_ty]) } quotationCtxtDoc :: LHsExpr GhcRn -> SDoc quotationCtxtDoc br_body ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -378,8 +378,11 @@ The splice will evaluate to (MkAge 3) and you can't add that to 4::Int. So you can't coerce a (Code Q Age) to a (Code Q Int). -} -- Code constructor - +#if __GLASGOW_HASKELL__ >= 907 +type Code :: (Kind.Type -> Kind.Type) -> forall r. TYPE r -> Kind.Type +#else type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type +#endif type role Code representational nominal -- See Note [Role of TExp] newtype Code m a = Code { examineCode :: m (TExp a) -- ^ Underlying monadic value ===================================== testsuite/tests/rename/should_compile/T23514b.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies, DataKinds #-} +module T23514b where + +import GHC.Types + +type F :: Type -> forall k. Maybe k +type family F x @k where + F Int @Type = Just Bool + F Int = Just Either ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -212,3 +212,4 @@ test('T22122', [expect_broken(22122), extra_files(['T22122_aux.hs'])], multimod_ test('T23240', [req_th, extra_files(['T23240_aux.hs'])], multimod_compile, ['T23240', '-v0']) test('T23318', normal, compile, ['-Wduplicate-exports']) test('T23434', normal, compile, ['']) +test('T23514b', normal, compile, ['']) ===================================== testsuite/tests/rename/should_fail/T23514a.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies, DataKinds #-} +module T23514a where + +import GHC.Types + +type F :: Type -> forall k. Maybe k +type family F x where + F Int @Type = Just Bool + F Int = Just Either ===================================== testsuite/tests/rename/should_fail/T23514a.stderr ===================================== @@ -0,0 +1,6 @@ + +T23514a.hs:9:17: error: [GHC-83865] + • Expected kind ‘forall k. Maybe k’, + but ‘Just Either’ has kind ‘Maybe (* -> * -> *)’ + • In the type ‘Just Either’ + In the type family declaration for ‘F’ ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -199,3 +199,4 @@ test('RnUnexpectedStandaloneDeriving', normal, compile_fail, ['']) test('RnStupidThetaInGadt', normal, compile_fail, ['']) test('PackageImportsDisabled', normal, compile_fail, ['']) test('ImportLookupIllegal', normal, compile_fail, ['']) +test('T23514a', normal, compile_fail, ['']) ===================================== testsuite/tests/saks/should_compile/T16724.stdout ===================================== @@ -1,6 +1,6 @@ type T1 :: forall k (a :: k). Type -type family T1 @k @a +type family T1 -- Defined at T16724.hs:11:1 type T2 :: forall {k} (a :: k). Type -type family T2 @{k} @a +type family T2 -- Defined at T16724.hs:15:1 ===================================== testsuite/tests/saks/should_compile/saks020.hs ===================================== @@ -6,4 +6,4 @@ module SAKS_020 where import Data.Kind (Type) type T :: forall k. k -> forall j. j -> Type -data T (x :: hk) :: hj -> Type +data T (x :: hk) @hj :: hj -> Type ===================================== testsuite/tests/saks/should_compile/saks030.hs ===================================== @@ -10,7 +10,7 @@ import Data.Type.Equality type T1 :: forall k (a :: k). Bool type T2 :: k -> Bool -type family T1 where +type family T1 @k @a where T1 @Bool @True = False T1 @Bool @False = True ===================================== testsuite/tests/saks/should_compile/saks032.hs ===================================== @@ -18,4 +18,4 @@ type F1 :: Type -> forall j. j -> forall k1 k2. (k1, k2) -> Type type family F1 a b type F2 :: Type -> forall j. j -> forall k1 k2. (k1, k2) -> Type -type family F2 a b :: forall r2. (r1, r2) -> Type +type family F2 a b @r1 :: forall r2. (r1, r2) -> Type ===================================== testsuite/tests/typecheck/should_fail/T18640a.hs ===================================== @@ -8,4 +8,4 @@ module T18640a where import Data.Kind type F2 :: forall a b. Type -> a -type family F2 :: forall b. Type -> Type where +type family F2 @a :: forall b. Type -> Type where ===================================== testsuite/tests/typecheck/should_fail/T18640a.stderr ===================================== @@ -5,5 +5,5 @@ T18640a.hs:11:1: error: [GHC-25897] Actual: forall (b :: k). * -> a ‘a’ is a rigid type variable bound by the type family declaration for ‘F2’ - at T18640a.hs:10:19 + at T18640a.hs:11:17 • In the type family declaration for ‘F2’ ===================================== testsuite/tests/typecheck/should_fail/T18640c.hs ===================================== @@ -11,4 +11,4 @@ type F1 :: forall k -> Type type family F1 k :: Type type F2 :: forall x. forall k -> x -type F2 = F1 +type F2 k = F1 k ===================================== testsuite/tests/typecheck/should_fail/T18640c.stderr ===================================== @@ -1,10 +1,8 @@ -T18640c.hs:14:11: error: [GHC-25897] - • Couldn't match kind ‘x’ with ‘*’ - Expected kind ‘forall (k1 :: k) -> x’, - but ‘F1’ has kind ‘forall (k1 :: k) -> *’ +T18640c.hs:14:13: error: [GHC-25897] + • Expected kind ‘x’, but ‘F1 k’ has kind ‘*’ ‘x’ is a rigid type variable bound by the type synonym declaration for ‘F2’ at T18640c.hs:13:19 - • In the type ‘F1’ + • In the type ‘F1 k’ In the type declaration for ‘F2’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4eaa68595592067eadbcae9c37ff2597bf3fa29b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4eaa68595592067eadbcae9c37ff2597bf3fa29b You're receiving 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 Jun 14 14:00:56 2023 From: gitlab at gitlab.haskell.org (Sylvain Henry (@hsyl20)) Date: Wed, 14 Jun 2023 10:00:56 -0400 Subject: [Git][ghc/ghc][wip/js-th] 6 commits: JS: implement TH support Message-ID: <6489c818c8aa6_c7397c578872842@gitlab.mail> Sylvain Henry pushed to branch wip/js-th at Glasgow Haskell Compiler / GHC Commits: 8b24618c by Sylvain Henry at 2023-06-14T16:06:20+02: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> - - - - - 9c7dacaa by Sylvain Henry at 2023-06-14T16:06:20+02:00 Don't use getKey - - - - - 3a92443d by Sylvain Henry at 2023-06-14T16:06:20+02:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - f7558e4b by Sylvain Henry at 2023-06-14T16:06:20+02:00 Fix some recompilation avoidance tests - - - - - d5fa0666 by Sylvain Henry at 2023-06-14T16:06:20+02:00 TH_import_loop is now broken as expected - - - - - ffe3e5c1 by Sylvain Henry at 2023-06-14T16:06:20+02:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Runtime/Context.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/Stg/FVs.hs - compiler/GHC/Stg/Pipeline.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/Types.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Utils/Misc.hs - compiler/ghc.cabal.in - + ghc-interp.js - hadrian/src/Base.hs - hadrian/src/Rules/Generate.hs - libraries/ghci/GHCi/Run.hs - libraries/ghci/ghci.cabal.in - libraries/template-haskell/tests/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/525a94473c4b0e6e572ecbe8a178972fa1b127e0...ffe3e5c1e3868bb23bc1ce24dd671729d387f723 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/525a94473c4b0e6e572ecbe8a178972fa1b127e0...ffe3e5c1e3868bb23bc1ce24dd671729d387f723 You're receiving 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 Jun 14 14:34:35 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Wed, 14 Jun 2023 10:34:35 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/DIB-INSTANCES] Remove arity inference in type declarations (#23514) Message-ID: <6489cffb18fcf_c7397fac08845db@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/DIB-INSTANCES at Glasgow Haskell Compiler / GHC Commits: 17fb8813 by Andrei Borzenkov at 2023-06-14T18:12:33+04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 20 changed files: - compiler/GHC/Core/Type.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Splice.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - + testsuite/tests/rename/should_compile/T23514b.hs - testsuite/tests/rename/should_compile/all.T - + testsuite/tests/rename/should_fail/T23514a.hs - + testsuite/tests/rename/should_fail/T23514a.stderr - testsuite/tests/rename/should_fail/all.T - testsuite/tests/saks/should_compile/T16724.stdout - testsuite/tests/saks/should_compile/saks020.hs - testsuite/tests/saks/should_compile/saks030.hs - testsuite/tests/saks/should_compile/saks032.hs - + testsuite/tests/th/CodeQ_HKD.hs - testsuite/tests/th/all.T - testsuite/tests/typecheck/should_fail/T18640a.hs - testsuite/tests/typecheck/should_fail/T18640a.stderr - testsuite/tests/typecheck/should_fail/T18640c.hs - testsuite/tests/typecheck/should_fail/T18640c.stderr Changes: ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -60,7 +60,7 @@ module GHC.Core.Type ( mkTyConBindersPreferAnon, mkPiTy, mkPiTys, piResultTy, piResultTys, - applyTysX, dropForAlls, + applyTysX, dropForAlls, dropInvisForAlls, mkFamilyTyConApp, buildSynTyCon, @@ -1937,6 +1937,14 @@ dropForAlls ty = go ty go ty | Just ty' <- coreView ty = go ty' go res = res +-- | Drops all invisible ForAllTys +dropInvisForAlls :: Type -> Type +dropInvisForAlls ty = go ty + where + go (ForAllTy (Bndr _ Invisible{}) res) = go res + go ty | Just ty' <- coreView ty = go ty' + go res = res + -- | Attempts to take a forall type apart, but only if it's a proper forall, -- with a named binder splitForAllTyCoVar_maybe :: Type -> Maybe (TyCoVar, Type) ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -863,12 +863,7 @@ pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype, cons = visibleIfConDecls condecls pp_where = ppWhen (gadt && not (null cons)) $ text "where" pp_cons = ppr_trim (map show_con cons) :: [SDoc] - pp_kind = ppUnless (if ki_sig_printable - then isIfaceRhoType kind - -- Even in the presence of a standalone kind signature, a non-tau - -- result kind annotation cannot be discarded as it determines the arity. - -- See Note [Arity inference in kcCheckDeclHeader_sig] in GHC.Tc.Gen.HsType - else isIfaceLiftedTypeKind kind) + pp_kind = ppUnless (ki_sig_printable || isIfaceLiftedTypeKind kind) (dcolon <+> ppr kind) pp_lhs = case parent of ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -2557,35 +2557,25 @@ kcCheckDeclHeader_sig sig_kind name flav -- extended with both 'implicit_tcv_prs' and 'explicit_tv_prs'. ; ctx_k <- kc_res_ki - -- Work out extra_arity, the number of extra invisible binders from - -- the kind signature that should be part of the TyCon's arity. - -- See Note [Arity inference in kcCheckDeclHeader_sig] - ; let n_invis_tcbs = countWhile isInvisibleTyConBinder excess_sig_tcbs - invis_arity = case ctx_k of - AnyKind -> n_invis_tcbs -- No kind signature, so make all the invisible binders - -- the signature into part of the arity of the TyCon - OpenKind -> n_invis_tcbs -- Result kind is (TYPE rr), so again make all the - -- invisible binders part of the arity of the TyCon - TheKind ki -> 0 `max` (n_invis_tcbs - invisibleTyBndrCount ki) - - ; let (invis_tcbs, resid_tcbs) = splitAt invis_arity excess_sig_tcbs - ; let sig_res_kind' = mkTyConKind resid_tcbs sig_res_kind - - ; traceTc "kcCheckDeclHeader_sig 2" $ vcat [ ppr excess_sig_tcbs - , ppr invis_arity, ppr invis_tcbs - , ppr n_invis_tcbs ] + ; let sig_res_kind' = mkTyConKind excess_sig_tcbs sig_res_kind + + ; traceTc "kcCheckDeclHeader_sig 2" (ppr excess_sig_tcbs) -- Unify res_ki (from the type declaration) with the residual kind from -- the kind signature. Don't forget to apply the skolemising 'subst' first. ; case ctx_k of AnyKind -> return () -- No signature - _ -> do { res_ki <- newExpectedKind ctx_k - ; discardResult (unifyKind Nothing sig_res_kind' res_ki) } + OpenKind -> + do { res_ki <- newExpectedKind ctx_k + ; discardResult (unifyKind Nothing (dropInvisForAlls sig_res_kind') res_ki) } + TheKind _ -> + do { res_ki <- newExpectedKind ctx_k + ; discardResult (unifyKind Nothing sig_res_kind' res_ki) } -- Add more binders for data/newtype, so the result kind has no arrows -- See Note [Datatype return kinds] - ; if null resid_tcbs || not (needsEtaExpansion flav) - then return (invis_tcbs, sig_res_kind') + ; if null excess_sig_tcbs || not (needsEtaExpansion flav) + then return ([], sig_res_kind') else return (excess_sig_tcbs, sig_res_kind) } @@ -2780,86 +2770,6 @@ Basic plan is this: part of the signature (k -> Type) with the kind signature of the decl, (j -> Type). This unification, done in kcCheckDeclHeader, needs TcTyVars. - * The tricky extra_arity part is described in - Note [Arity inference in kcCheckDeclHeader_sig] - -Note [Arity inference in kcCheckDeclHeader_sig] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider these declarations: - type family S1 :: forall k2. k1 -> k2 -> Type - type family S2 (a :: k1) (b :: k2) :: Type - -Both S1 and S2 can be given the same standalone kind signature: - type S1 :: forall k1 k2. k1 -> k2 -> Type - type S2 :: forall k1 k2. k1 -> k2 -> Type - -And, indeed, tyConKind S1 == tyConKind S2. However, -tyConBinders and tyConResKind for S1 and S2 are different: - - tyConBinders S1 == [spec k1] - tyConResKind S1 == forall k2. k1 -> k2 -> Type - tyConKind S1 == forall k1 k2. k1 -> k2 -> Type - - tyConBinders S2 == [spec k1, spec k2, anon-vis (a :: k1), anon-vis (b :: k2)] - tyConResKind S2 == Type - tyConKind S1 == forall k1 k2. k1 -> k2 -> Type - -This difference determines the /arity/: - tyConArity tc == length (tyConBinders tc) -That is, the arity of S1 is 1, while the arity of S2 is 4. - -'kcCheckDeclHeader_sig' needs to infer the desired arity, to split the -standalone kind signature into binders and the result kind. It does so -in two rounds: - -1. matchUpSigWithDecl matches up - - the [TyConBinder] from (applying splitTyConKind to) the kind signature - - with the [LHsTyVarBndr] from the type declaration. - That may leave some excess TyConBinder: in the case of S2 there are - no excess TyConBinders, but in the case of S1 there are two (since - there are no LHsTYVarBndrs. - -2. Split off further TyConBinders (in the case of S1, one more) to - make it possible to unify the residual return kind with the - signature in the type declaration. More precisely, split off such - enough invisible that the remainder of the standalone kind - signature and the user-written result kind signature have the same - number of invisible quantifiers. - -As another example consider the following declarations: - - type F :: Type -> forall j. j -> forall k1 k2. (k1, k2) -> Type - type family F a b - - type G :: Type -> forall j. j -> forall k1 k2. (k1, k2) -> Type - type family G a b :: forall r2. (r1, r2) -> Type - -For both F and G, the signature (after splitTyConKind) has - sig_tcbs :: [TyConBinder] - = [ anon-vis (@a_aBq), spec (@j_auA), anon-vis (@(b_aBr :: j_auA)) - , spec (@k1_auB), spec (@k2_auC) - , anon-vis (@(c_aBs :: (k1_auB, k2_auC)))] - -matchUpSigWithDecl will consume the first three of these, passing on - excess_sig_tcbs - = [ spec (@k1_auB), spec (@k2_auC) - , anon-vis (@(c_aBs :: (k1_auB, k2_auC)))] - -For F, there is no result kind signature in the declaration for F, so -we absorb all invisible binders into F's arity. The resulting arity of -F is 3+2=5. - -Now, in the case of G, we have a result kind sig 'forall r2. (r2,r2)->Type'. -This has one invisible binder, so we split of enough extra binders from -our excess_sig_tcbs to leave just one to match 'r2'. - - res_ki = forall r2. (r1, r2) -> Type - kisig = forall k1 k2. (k1, k2) -> Type - ^^^ - split off this one. - -The resulting arity of G is 3+1=4. - Note [discardResult in kcCheckDeclHeader_sig] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We use 'unifyKind' to check inline kind annotations in declaration headers ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -796,7 +796,7 @@ tcTExpTy m_ty exp_ty TcRnTHError $ TypedTHError $ TypedTHWithPolyType exp_ty ; codeCon <- tcLookupTyCon codeTyConName ; let rep = getRuntimeRep exp_ty - ; return (mkTyConApp codeCon [rep, m_ty, exp_ty]) } + ; return (mkTyConApp codeCon [m_ty, rep, exp_ty]) } quotationCtxtDoc :: LHsExpr GhcRn -> SDoc quotationCtxtDoc br_body ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -378,8 +378,11 @@ The splice will evaluate to (MkAge 3) and you can't add that to 4::Int. So you can't coerce a (Code Q Age) to a (Code Q Int). -} -- Code constructor - +#if __GLASGOW_HASKELL__ >= 907 +type Code :: (Kind.Type -> Kind.Type) -> forall r. TYPE r -> Kind.Type +#else type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type +#endif type role Code representational nominal -- See Note [Role of TExp] newtype Code m a = Code { examineCode :: m (TExp a) -- ^ Underlying monadic value ===================================== testsuite/tests/rename/should_compile/T23514b.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies, DataKinds #-} +module T23514b where + +import GHC.Types + +type F :: Type -> forall k. Maybe k +type family F x @k where + F Int @Type = Just Bool + F Int = Just Either ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -212,3 +212,4 @@ test('T22122', [expect_broken(22122), extra_files(['T22122_aux.hs'])], multimod_ test('T23240', [req_th, extra_files(['T23240_aux.hs'])], multimod_compile, ['T23240', '-v0']) test('T23318', normal, compile, ['-Wduplicate-exports']) test('T23434', normal, compile, ['']) +test('T23514b', normal, compile, ['']) ===================================== testsuite/tests/rename/should_fail/T23514a.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies, DataKinds #-} +module T23514a where + +import GHC.Types + +type F :: Type -> forall k. Maybe k +type family F x where + F Int @Type = Just Bool + F Int = Just Either ===================================== testsuite/tests/rename/should_fail/T23514a.stderr ===================================== @@ -0,0 +1,6 @@ + +T23514a.hs:9:17: error: [GHC-83865] + • Expected kind ‘forall k. Maybe k’, + but ‘Just Either’ has kind ‘Maybe (* -> * -> *)’ + • In the type ‘Just Either’ + In the type family declaration for ‘F’ ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -199,3 +199,4 @@ test('RnUnexpectedStandaloneDeriving', normal, compile_fail, ['']) test('RnStupidThetaInGadt', normal, compile_fail, ['']) test('PackageImportsDisabled', normal, compile_fail, ['']) test('ImportLookupIllegal', normal, compile_fail, ['']) +test('T23514a', normal, compile_fail, ['']) ===================================== testsuite/tests/saks/should_compile/T16724.stdout ===================================== @@ -1,6 +1,6 @@ type T1 :: forall k (a :: k). Type -type family T1 @k @a +type family T1 -- Defined at T16724.hs:11:1 type T2 :: forall {k} (a :: k). Type -type family T2 @{k} @a +type family T2 -- Defined at T16724.hs:15:1 ===================================== testsuite/tests/saks/should_compile/saks020.hs ===================================== @@ -6,4 +6,4 @@ module SAKS_020 where import Data.Kind (Type) type T :: forall k. k -> forall j. j -> Type -data T (x :: hk) :: hj -> Type +data T (x :: hk) @hj :: hj -> Type ===================================== testsuite/tests/saks/should_compile/saks030.hs ===================================== @@ -10,7 +10,7 @@ import Data.Type.Equality type T1 :: forall k (a :: k). Bool type T2 :: k -> Bool -type family T1 where +type family T1 @k @a where T1 @Bool @True = False T1 @Bool @False = True ===================================== testsuite/tests/saks/should_compile/saks032.hs ===================================== @@ -18,4 +18,4 @@ type F1 :: Type -> forall j. j -> forall k1 k2. (k1, k2) -> Type type family F1 a b type F2 :: Type -> forall j. j -> forall k1 k2. (k1, k2) -> Type -type family F2 a b :: forall r2. (r1, r2) -> Type +type family F2 a b @r1 :: forall r2. (r1, r2) -> Type ===================================== testsuite/tests/th/CodeQ_HKD.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE TemplateHaskell #-} + +module CodeQ_HKD where +import GHC.Exts +import Data.Kind +import Language.Haskell.TH hiding (Type) + +data T (f :: forall r . (TYPE r) -> Type) = MkT (f Int) (f Int#) + + +tcodeq :: T CodeQ +tcodeq = MkT [||5||] [||5#||] ===================================== testsuite/tests/th/all.T ===================================== @@ -576,3 +576,4 @@ test('T21050', normal, compile_fail, ['']) test('T22559a', normal, compile_fail, ['']) test('T22559b', normal, compile_fail, ['']) test('T22559c', normal, compile_fail, ['']) +test('CodeQ_HKD', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/T18640a.hs ===================================== @@ -8,4 +8,4 @@ module T18640a where import Data.Kind type F2 :: forall a b. Type -> a -type family F2 :: forall b. Type -> Type where +type family F2 @a :: forall b. Type -> Type where ===================================== testsuite/tests/typecheck/should_fail/T18640a.stderr ===================================== @@ -5,5 +5,5 @@ T18640a.hs:11:1: error: [GHC-25897] Actual: forall (b :: k). * -> a ‘a’ is a rigid type variable bound by the type family declaration for ‘F2’ - at T18640a.hs:10:19 + at T18640a.hs:11:17 • In the type family declaration for ‘F2’ ===================================== testsuite/tests/typecheck/should_fail/T18640c.hs ===================================== @@ -11,4 +11,4 @@ type F1 :: forall k -> Type type family F1 k :: Type type F2 :: forall x. forall k -> x -type F2 = F1 +type F2 k = F1 k ===================================== testsuite/tests/typecheck/should_fail/T18640c.stderr ===================================== @@ -1,10 +1,8 @@ -T18640c.hs:14:11: error: [GHC-25897] - • Couldn't match kind ‘x’ with ‘*’ - Expected kind ‘forall (k1 :: k) -> x’, - but ‘F1’ has kind ‘forall (k1 :: k) -> *’ +T18640c.hs:14:13: error: [GHC-25897] + • Expected kind ‘x’, but ‘F1 k’ has kind ‘*’ ‘x’ is a rigid type variable bound by the type synonym declaration for ‘F2’ at T18640c.hs:13:19 - • In the type ‘F1’ + • In the type ‘F1 k’ In the type declaration for ‘F2’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/17fb8813f5fc7431b00fca3607691dc9737fed8b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/17fb8813f5fc7431b00fca3607691dc9737fed8b You're receiving 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 Jun 14 16:11:09 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 14 Jun 2023 12:11:09 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] 3 commits: IWP Message-ID: <6489e69d2288b_c73971d8551c13174c@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: c545c607 by Rodrigo Mesquita at 2023-06-13T19:19:47+01:00 IWP - - - - - f3bbd6c0 by Rodrigo Mesquita at 2023-06-14T00:56:52+01:00 WIP - - - - - 6dec19d1 by Rodrigo Mesquita at 2023-06-14T17:10:56+01:00 WIP - - - - - 6 changed files: - + compiler/GHC/Core/Functor.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/ghc.cabal.in - libraries/hegg Changes: ===================================== compiler/GHC/Core/Functor.hs ===================================== @@ -0,0 +1,118 @@ +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +module GHC.Core.Functor where + +import GHC.Generics +import GHC.Prelude + +import Data.Bool +import Data.Eq +import Data.Ord +import Data.Functor +import Data.Functor.Classes +import Data.Foldable +import Data.Traversable + +import GHC.Core +import GHC.Core.TyCo.Rep +import GHC.Core.Map.Type +import GHC.Core.Map.Expr +import GHC.Types.Var +import GHC.Types.Literal +import GHC.Types.Tickish +import Unsafe.Coerce (unsafeCoerce) + +import Data.Equality.Utils (Fix(..)) + +-- Important to note the binders are also represented by $a$ +-- This is because in the e-graph we will represent binders with the +-- equivalence class id of things equivalent to it. +-- +-- Unfortunately type binders are still not correctly accounted for. +-- Perhaps it'd really be better to make DeBruijn work over these types + +-- ROMES:TODO: Rename module to specify this is for egraphs + +data AltF b a + = AltF AltCon [b] a + deriving (Functor, Foldable, Traversable) + +data BindF b a + = NonRecF b a + | RecF [(b, a)] + deriving (Functor, Foldable, Traversable) + +data ExprF b a + = VarF Id + | LitF Literal + | AppF a a + | LamF b a + | LetF (BindF b a) a + | CaseF a b Type [AltF b a] + + | CastF a CoercionR + | TickF CoreTickish a + | TypeF Type + | CoercionF Coercion + deriving (Functor, Foldable, Traversable) + +type CoreExprF + = ExprF CoreBndr + +-- instance (Eq a, Eq b) => Eq (AltF b a) where +-- (==) (AltF c as a) (AltF c' as' a') = c == c' && as == as' && a == a' + +-- instance Eq b => Eq1 (AltF b) where +-- liftEq eq (AltF c as a) (AltF c' as' a') = c == c' && as == as' && eq a a' + +-- instance (Eq a, Eq b) => Eq (BindF b a) where +-- (==) (RecF as) (RecF as') = as == as' +-- (==) (NonRecF a b) (NonRecF a' b') = a == a' && b == b' +-- (==) _ _ = False + +-- instance Eq b => Eq1 (BindF b) where +-- liftEq eq (RecF as) (RecF as') = liftEq (\(x,y) (x',y') -> x == x' && eq y y') as as' +-- liftEq eq (NonRecF a b) (NonRecF a' b') = a == a' && eq b b' +-- liftEq _ _ _ = False + +-- instance (Eq a, Eq b) => Eq (ExprF b a) where +-- (==) (VarF a) (VarF b) = a == b +-- (==) (LitF a) (LitF b) = a == b +-- (==) (AppF a a') (AppF b b') = a == b && a' == b' +-- (==) (LamF a a') (LamF b b') = a == b && a' == b' +-- (==) (LetF a a') (LetF b b') = a == b && a' == b' + -- (==) (CaseF a a' t as) (CaseF b b' v bs) = a == b && a' == b' + -- && eqDeBruijnType t v + -- && as == bs + -- (==) (CastF a c) (CastF b c') = a == b && eqDeBruijnType (coercionType c) (coercionType c') + -- ROMES:TODO: THE REST OF IT!! + -- (==) _ _ = False + +instance Eq a => Eq (DeBruijnF CoreExprF a) where + (==) _ _ = error "TODO" + +instance Eq1 (DeBruijnF CoreExprF) where + liftEq eq = error "TODO" + +instance Ord a => Ord (DeBruijnF CoreExprF a) where + compare _ _ = error "TODO" + +instance Ord1 (DeBruijnF CoreExprF) where + liftCompare cmp _ _ = error "TODO" + +instance Functor (DeBruijnF CoreExprF) +instance Foldable (DeBruijnF CoreExprF) +instance Traversable (DeBruijnF CoreExprF) + + +-- | 'unsafeCoerce' mostly because I'm too lazy to write the boilerplate. +fromCoreExpr :: CoreExpr -> Fix CoreExprF +fromCoreExpr = unsafeCoerce + +fromDBCoreExpr :: DeBruijn CoreExpr -> Fix (DeBruijnF CoreExprF) +fromDBCoreExpr = unsafeCoerce + +toCoreExpr :: CoreExpr -> Fix CoreExprF +toCoreExpr = unsafeCoerce + ===================================== compiler/GHC/Core/Map/Type.hs ===================================== @@ -6,6 +6,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DeriveTraversable #-} module GHC.Core.Map.Type ( -- * Re-export generic interface @@ -21,7 +22,7 @@ module GHC.Core.Map.Type ( -- * Utilities for use by friends only TypeMapG, CoercionMapG, - DeBruijn(..), deBruijnize, eqDeBruijnType, eqDeBruijnVar, + DeBruijn(..), DeBruijnF(..), deBruijnize, deBruijnizeF, eqDeBruijnType, eqDeBruijnVar, BndrMap, xtBndr, lkBndr, VarMap, xtVar, lkVar, lkDFreeVar, xtDFreeVar, @@ -34,6 +35,7 @@ module GHC.Core.Map.Type ( -- between GHC.Core.Unify (which depends on this module) and GHC.Core import GHC.Prelude +import Data.Functor.Classes import GHC.Core.Type import GHC.Core.Coercion @@ -513,12 +515,18 @@ lookupCME (CME { cme_env = env }) v = lookupVarEnv env v -- needing it. data DeBruijn a = D CmEnv a +newtype DeBruijnF f a = DeBruijnF (DeBruijn (f a)) + -- | Synthesizes a @DeBruijn a@ from an @a@, by assuming that there are no -- bound binders (an empty 'CmEnv'). This is usually what you want if there -- isn't already a 'CmEnv' in scope. deBruijnize :: a -> DeBruijn a deBruijnize = D emptyCME +-- | Like 'deBruijnize' but synthesizes a @DeBruijnF f a@ from an @f a@ +deBruijnizeF :: f a -> DeBruijnF f a +deBruijnizeF = DeBruijnF . deBruijnize + instance Eq (DeBruijn a) => Eq (DeBruijn [a]) where D _ [] == D _ [] = True D env (x:xs) == D env' (x':xs') = D env x == D env' x' && ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -59,7 +59,8 @@ import GHC.Types.Unique.Supply import GHC.Core import GHC.Core.FVs (exprFreeVars) import GHC.Core.TyCo.Compare( eqType ) -import GHC.Core.Map.Expr +import GHC.Core.Map.Type +import GHC.Core.Functor import GHC.Core.Predicate (typeDeterminesValue) import GHC.Core.SimpleOpt (simpleOptExpr, exprIsConApp_maybe) import GHC.Core.Utils (exprType) @@ -99,9 +100,13 @@ import qualified Data.List.NonEmpty as NE import Data.Ord (comparing) import Data.Functor.Const -import Data.Equality.Graph (EGraph) +import Data.Equality.Graph (EGraph, ClassId) import Data.Equality.Utils (Fix(..)) +import Data.Equality.Graph.Lens import qualified Data.Equality.Graph as EG +import Data.Bifunctor (second) +import Data.Function ((&)) +import qualified Data.IntSet as IS -- -- * Main exports @@ -689,38 +694,47 @@ filterUnliftedFields con args = -- ⊥. addBotCt :: Nabla -> Id -> MaybeT DsM Nabla addBotCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x = do - let (xid, env') = EG.represent (Fix $ Const x) env - env'' <- EG.adjustF go xid env' +-- ROMES:TODO: bit of a hack to represent binders with `Var`, which is likely wrong (lambda bound vars might get equivalent to global ones?). Will need to justify this well +-- Perhaps I can get a new e-class everytime I have a new binder, and use the e-class Id as the true identifier. +-- (would just require adding a primitive to create empty e-classes. easy.) + let (xid, env') = representId x env + env'' <- updateVarInfo xid go env' pure nabla{nabla_tm_st = ts{ts_facts = env''}} where - go :: VarInfo -> MaybeT DsM VarInfo - go vi at VI { vi_bot = bot } + go :: Maybe VarInfo -> MaybeT DsM (Maybe VarInfo) + go Nothing = pure (Just (emptyVarInfo x){vi_bot = IsBot}) + go (Just vi at VI { vi_bot = bot }) = case bot of IsNotBot -> mzero -- There was x ≁ ⊥. Contradiction! - IsBot -> pure vi -- There already is x ~ ⊥. Nothing left to do + IsBot -> pure (Just vi) -- There already is x ~ ⊥. Nothing left to do MaybeBot -- We add x ~ ⊥ | definitelyUnliftedType (idType x) -- Case (3) in Note [Strict fields and variables of unlifted type] -> mzero -- unlifted vars can never be ⊥ | otherwise -> do - pure vi{ vi_bot = IsBot } + pure (Just vi{ vi_bot = IsBot }) -- | Adds the constraint @x ~/ ⊥@ to 'Nabla'. Quite similar to 'addNotConCt', -- but only cares for the ⊥ "constructor". addNotBotCt :: Nabla -> Id -> MaybeT DsM Nabla addNotBotCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts=env} } x = do - let (xid, env') = EG.represent (Fix $ Const x) env - -- ROMES:TODO: This could be all be a function passed to adjust - let (y, vi at VI { vi_bot = bot }, TmSt{ts_facts=env''}) = lookupVarInfoNT (ts{ts_facts=env'}) x -- ROMES:TODO: this will represent x again (quite cheap still), but whatever for now - case bot of - IsBot -> mzero -- There was x ~ ⊥. Contradiction! - IsNotBot -> pure nabla -- There already is x ≁ ⊥. Nothing left to do (ROMES:TODO missing env') - MaybeBot -> do -- We add x ≁ ⊥ and test if x is still inhabited - -- Mark dirty for a delayed inhabitation test - let vi' = vi{ vi_bot = IsNotBot} - pure $ markDirty y - $ nabla{ nabla_tm_st = ts{ ts_facts = EG.adjust (const vi') xid env''} } + let (xid, env') = representId x env + (y, mvi) = lookupVarInfoNT (ts{ts_facts=env'}) x + (yid, env'') = representId x env' + case mvi of + Just vi at VI { vi_bot = bot } -> + case bot of + IsBot -> mzero -- There was x ~ ⊥. Contradiction! + IsNotBot -> pure nabla -- There already is x ≁ ⊥. Nothing left to do + MaybeBot -> do -- We add x ≁ ⊥ and test if x is still inhabited + -- Mark dirty for a delayed inhabitation test + let vi' = vi{ vi_bot = IsNotBot} + pure $ markDirty yid + $ nabla{nabla_tm_st = ts{ ts_facts = env'' & _class xid . _data .~ Just vi'}} + Nothing -> + pure $ markDirty yid -- as above + $ nabla{nabla_tm_st = ts{ ts_facts = env'' & _class xid . _data .~ Just ((emptyVarInfo x){vi_bot = IsNotBot})}} -- | Record a @x ~/ K@ constraint, e.g. that a particular 'Id' @x@ can't -- take the shape of a 'PmAltCon' @K@ in the 'Nabla' and return @Nothing@ if @@ -729,17 +743,19 @@ addNotBotCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts=env} } x = do addNotConCt :: Nabla -> Id -> PmAltCon -> MaybeT DsM Nabla addNotConCt _ _ (PmAltConLike (RealDataCon dc)) | isNewDataCon dc = mzero -- (3) in Note [Coverage checking Newtype matches] -addNotConCt nabla x nalt = do - (mb_mark_dirty, nabla') <- trvVarInfo go nabla x +addNotConCt nabla at MkNabla{nabla_tm_st=ts at TmSt{ts_facts=env}} x nalt = do + let (xid, env') = representId x env + (mb_mark_dirty, nabla') <- trvVarInfo go nabla{nabla_tm_st=ts{ts_facts=env'}} xid pure $ case mb_mark_dirty of - Just x -> markDirty x nabla' - Nothing -> nabla' + True -> markDirty xid nabla' + False -> nabla' where -- Update `x`'s 'VarInfo' entry. Fail ('MaybeT') if contradiction, -- otherwise return updated entry and `Just x'` if `x` should be marked dirty, -- where `x'` is the representative of `x`. - go :: VarInfo -> MaybeT DsM (Maybe Id, VarInfo) - go vi@(VI x' pos neg _ rcm) = do + go :: Maybe VarInfo -> MaybeT DsM (Bool, Maybe VarInfo) + go Nothing = pure (False, Just (emptyVarInfo x){vi_bot = IsNotBot, vi_neg = emptyPmAltConSet `extendPmAltConSet` nalt}) -- romes:TODO: Do I need to mark dirty the new thing? + go (Just vi@(VI x' pos neg _ rcm)) = do -- 1. Bail out quickly when nalt contradicts a solution let contradicts nalt sol = eqPmAltCon (paca_con sol) nalt == Equal guard (not (any (contradicts nalt) pos)) @@ -758,12 +774,12 @@ addNotConCt nabla x nalt = do pure $ case mb_rcm' of -- If nalt could be removed from a COMPLETE set, we'll get back Just and -- have to mark x dirty, by returning Just x'. - Just rcm' -> (Just x', vi'{ vi_rcm = rcm' }) + Just rcm' -> (True, Just vi'{ vi_rcm = rcm' }) -- Otherwise, nalt didn't occur in any residual COMPLETE set and we -- don't have to mark it dirty. So we return Nothing, which in the case -- above would have compromised precision. -- See Note [Shortcutting the inhabitation test], grep for T17836. - Nothing -> (Nothing, vi') + Nothing -> (False, Just vi') hasRequiredTheta :: PmAltCon -> Bool hasRequiredTheta (PmAltConLike cl) = notNull req_theta @@ -779,10 +795,9 @@ hasRequiredTheta _ = False -- See Note [TmState invariants]. addConCt :: Nabla -> Id -> PmAltCon -> [TyVar] -> [Id] -> MaybeT DsM Nabla addConCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x alt tvs args = do - let (xid, env') = EG.represent (Fix $ Const x) env - -- ROMES:TODO: Omssions of updates on ts_facts on nabla are fine, but not perfect. Get it consistent + let (xid, env') = representId x env -- ROMES:TODO: Also looks like a function on varinfo (adjust) - let (vi@(VI _ pos neg bot _), TmSt{ts_facts=env''}) = lookupVarInfo (ts{ts_facts=env'}) x + let vi@(VI _ pos neg bot _) = fromMaybe (emptyVarInfo x) $ lookupVarInfo (ts{ts_facts=env'}) x -- First try to refute with a negative fact guard (not (elemPmAltConSet alt neg)) -- Then see if any of the other solutions (remember: each of them is an @@ -801,7 +816,7 @@ addConCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x alt tvs args = Nothing -> do let pos' = PACA alt tvs args : pos let nabla_with bot' = - nabla{ nabla_tm_st = ts{ts_facts = EG.adjust (const (vi{vi_pos = pos', vi_bot = bot'})) xid env''} } + nabla{nabla_tm_st = ts{ts_facts = env' & _class xid ._data .~ (Just vi{vi_pos = pos', vi_bot = bot'})}} -- Do (2) in Note [Coverage checking Newtype matches] case (alt, args) of (PmAltConLike (RealDataCon dc), [y]) | isNewDataCon dc -> @@ -835,8 +850,9 @@ addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = -- ROMES:TODO: equate auxiliary var that finds both vars, and lookups up the domain associated. However, I think we no longer should have Just/Nothing but rather always store emptyVarInfo for new e-nodes -- equate should also update e-graph, basically re-implement "equateUSDFM" in terms of the e-graph, or inline it or so case equate env x y of + (Nothing, env') -> pure $ nabla{nabla_tm_st=ts{ts_facts=env'}} -- We keep the VarInfo as Nothing -- Add the constraints we had for x to y - (vi_x, env') -> do + (Just vi_x, env') -> do let nabla_equated = nabla{ nabla_tm_st = ts{ts_facts = env'} } -- and then gradually merge every positive fact we have on x into y let add_pos nabla (PACA cl tvs args) = addConCt nabla y cl tvs args @@ -855,12 +871,12 @@ addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = -- >>> equate [({u1,u3}, Just ele1)] u3 u4 == (Nothing, [({u1,u3,u4}, Just ele1)]) -- >>> equate [({u1,u3}, Just ele1)] u4 u3 == (Nothing, [({u1,u3,u4}, Just ele1)]) -- >>> equate [({u1,u3}, Just ele1), ({u2}, Just ele2)] u3 u2 == (Just ele1, [({u2,u1,u3}, Just ele2)]) - equate :: EGraph VarInfo (Const Id) -> Id -> Id -> (VarInfo, EGraph VarInfo (Const Id)) + equate :: TmEGraph -> Id -> Id -> (Maybe VarInfo, TmEGraph) equate eg x y = do - let (xid, eg') = EG.represent (Fix $ Const x) eg - (yid, eg'') = EG.represent (Fix $ Const y) eg' + let (xid, eg') = representId x eg + (yid, eg'') = representId y eg' (_, eg''') = EG.merge xid yid eg'' - in (EG.lookup xid eg', eg''') + in (eg' ^. _class xid ._data, eg''') -- Note: lookup in eg', because it's before the merge. @@ -929,10 +945,12 @@ addCoreCt nabla x e = do -- semantically equivalent to @e@, in which case we may add the constraint -- @x ~ y at . equate_with_similar_expr :: Id -> CoreExpr -> StateT Nabla (MaybeT DsM) () - equate_with_similar_expr x e = do - rep <- StateT $ \nabla -> lift (representCoreExpr nabla e) + equate_with_similar_expr _x e = do + _ <- StateT $ \nabla -> pure (representCoreExpr nabla e) + pure () -- Note that @rep == x@ if we encountered @e@ for the first time. - modifyT (\nabla -> addVarCt nabla x rep) + -- ROMES:TODO: I don't think we need to do this anymore + -- modifyT (\nabla -> addVarCt nabla x rep) bind_expr :: CoreExpr -> StateT Nabla (MaybeT DsM) Id bind_expr e = do @@ -987,25 +1005,18 @@ modifyT f = StateT $ fmap ((,) ()) . f -- Which is the @x@ of a @let x = e'@ constraint (with @e@ semantically -- equivalent to @e'@) we encountered earlier, or a fresh identifier if -- there weren't any such constraints. -representCoreExpr :: Nabla -> CoreExpr -> DsM (Id, Nabla) -representCoreExpr nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_reps = reps } } e --- ROMES:TODO: Represent - | Just rep <- lookupCoreMap reps key = pure (rep, nabla) - | otherwise = do - rep <- mkPmId (exprType e) - let reps' = extendCoreMap reps key rep - let nabla' = nabla{ nabla_tm_st = ts{ ts_reps = reps' } } - pure (rep, nabla') - where - key = makeDictsCoherent e - -- Use a key in which dictionaries for the same type become equal. - -- See Note [Unique dictionaries in the TmOracle CoreMap] +representCoreExpr :: Nabla -> CoreExpr -> (ClassId, Nabla) +representCoreExpr nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = egraph } } e = + second (\g -> nabla{nabla_tm_st = ts{ts_facts = g}}) $ EG.represent (fromDBCoreExpr (deBruijnize (makeDictsCoherent e))) egraph + -- Use a key in which dictionaries for the same type become equal. + -- See Note [Unique dictionaries in the TmOracle CoreMap] -- | Change out 'Id's which are uniquely determined by their type to a -- common value, so that different names for dictionaries of the same type -- are considered equal when building a 'CoreMap'. -- -- See Note [Unique dictionaries in the TmOracle CoreMap] +-- ROMES:TODO: I suppose this should be taken into account by the Eq instance of DeBruijnF CoreExprF -- if we do that there then we're sure that EG.represent takes that into account. makeDictsCoherent :: CoreExpr -> CoreExpr makeDictsCoherent var@(Var v) | let ty = idType v @@ -1094,6 +1105,7 @@ In the end, replacing dictionaries with an error value in the pattern-match checker was the most self-contained, although we might want to revisit once we implement a more robust approach to computing equality in the pattern-match checker (see #19272). +ROMES:TODO: I don't think e-graphs avoid this situation, because the names of the binders will still differ (although the Eq instance could take this into account?) -} {- Note [The Pos/Neg invariant] @@ -1306,24 +1318,24 @@ tyStateRefined :: TyState -> TyState -> Bool -- refinement of b or vice versa! tyStateRefined a b = ty_st_n a /= ty_st_n b -markDirty :: Id -> Nabla -> Nabla +markDirty :: ClassId -> Nabla -> Nabla markDirty x nabla at MkNabla{nabla_tm_st = ts at TmSt{ts_dirty = dirty} } = - nabla{ nabla_tm_st = ts{ ts_dirty = extendDVarSet dirty x } } + nabla{nabla_tm_st = ts{ ts_dirty = IS.insert x dirty }} -traverseDirty :: Monad m => (VarInfo -> m VarInfo) -> TmState -> m TmState +traverseDirty :: Monad m => (ClassId -> Maybe VarInfo -> m (Maybe VarInfo)) -> TmState -> m TmState traverseDirty f ts at TmSt{ts_facts = env, ts_dirty = dirty} = - go (uniqDSetToList dirty) env + + go (IS.elems dirty) env where go [] env = pure ts{ts_facts=env} go (x:xs) !_env = do - let (vi, TmSt{ts_facts=env'}) = lookupVarInfo ts x - vi' <- f vi -- todo: lookupvar should really return the xid - let (xid,env'') = EG.represent (Fix $ Const x) env' -- ROMES:TODO: really, a helper functoin for representing Ids - go xs (EG.adjust (const vi') xid env'') + let vi = env ^._class x._data + vi' <- f x vi + go xs (env & _class x._data .~ vi') -- Use 'over' or so instead? -traverseAll :: Monad m => (VarInfo -> m VarInfo) -> TmState -> m TmState +traverseAll :: Monad m => (ClassId -> Maybe VarInfo -> m (Maybe VarInfo)) -> TmState -> m TmState traverseAll f ts at TmSt{ts_facts = env} = do - env' <- EG.traverseAnalysisData f env + env' <- (_iclasses.(\fab (i,cl) -> let mvi = fab (i,cl^._data) in (cl &) . (_data .~) <$> mvi)) (uncurry f) env pure ts{ts_facts = env'} -- | Makes sure the given 'Nabla' is still inhabited, by trying to instantiate @@ -1345,18 +1357,19 @@ inhabitationTest fuel old_ty_st nabla at MkNabla{ nabla_tm_st = ts } = {-# SCC "in ts' <- if tyStateRefined old_ty_st (nabla_ty_st nabla) then traverseAll test_one ts else traverseDirty test_one ts - pure nabla{ nabla_tm_st = ts'{ts_dirty=emptyDVarSet}} + pure nabla{ nabla_tm_st = ts'{ts_dirty=IS.empty}} where - nabla_not_dirty = nabla{ nabla_tm_st = ts{ts_dirty=emptyDVarSet} } - test_one :: VarInfo -> MaybeT DsM VarInfo - test_one vi = - lift (varNeedsTesting old_ty_st nabla vi) >>= \case + nabla_not_dirty = nabla{ nabla_tm_st = ts{ts_dirty=IS.empty} } + test_one :: ClassId -> Maybe VarInfo -> MaybeT DsM (Maybe VarInfo) + test_one cid Nothing = pure Nothing + test_one cid (Just vi) = + lift (varNeedsTesting old_ty_st nabla cid vi) >>= \case True -> do -- lift $ tracePm "test_one" (ppr vi) -- No solution yet and needs testing -- We have to test with a Nabla where all dirty bits are cleared - instantiate (fuel-1) nabla_not_dirty vi - _ -> pure vi + Just <$> instantiate (fuel-1) nabla_not_dirty vi + _ -> pure (Just vi) -- ROMES:TODO: The dirty shortcutting bit seems like the bookeeping on nodes to -- upward merge, perhaps we can rid of it too @@ -1364,15 +1377,15 @@ inhabitationTest fuel old_ty_st nabla at MkNabla{ nabla_tm_st = ts } = {-# SCC "in -- | Checks whether the given 'VarInfo' needs to be tested for inhabitants. -- Returns `False` when we can skip the inhabitation test, presuming it would -- say "yes" anyway. See Note [Shortcutting the inhabitation test]. -varNeedsTesting :: TyState -> Nabla -> VarInfo -> DsM Bool -varNeedsTesting _ MkNabla{nabla_tm_st=tm_st} vi - | elemDVarSet (vi_id vi) (ts_dirty tm_st) = pure True -varNeedsTesting _ _ vi +varNeedsTesting :: TyState -> Nabla -> ClassId -> VarInfo -> DsM Bool +varNeedsTesting _ MkNabla{nabla_tm_st=tm_st} cid _ + | IS.member cid (ts_dirty tm_st) = pure True +varNeedsTesting _ _ _ vi | notNull (vi_pos vi) = pure False -varNeedsTesting old_ty_st MkNabla{nabla_ty_st=new_ty_st} _ +varNeedsTesting old_ty_st MkNabla{nabla_ty_st=new_ty_st} _ _ -- Same type state => still inhabited | not (tyStateRefined old_ty_st new_ty_st) = pure False -varNeedsTesting old_ty_st MkNabla{nabla_ty_st=new_ty_st} vi = do +varNeedsTesting old_ty_st MkNabla{nabla_ty_st=new_ty_st} _ vi = do -- These normalisations are relatively expensive, but still better than having -- to perform a full inhabitation test (_, _, old_norm_ty) <- tntrGuts <$> pmTopNormaliseType old_ty_st (idType $ vi_id vi) @@ -1400,19 +1413,20 @@ instBot _fuel nabla vi = {-# SCC "instBot" #-} do pure vi addNormalisedTypeMatches :: Nabla -> Id -> DsM (ResidualCompleteMatches, Nabla) -addNormalisedTypeMatches nabla at MkNabla{ nabla_ty_st = ty_st } x - = trvVarInfo add_matches nabla x +addNormalisedTypeMatches nabla at MkNabla{ nabla_ty_st = ty_st, nabla_tm_st = ts at TmSt{ts_facts=env} } x + | (xid,env') <- representId x env + = trvVarInfo (add_matches . fromMaybe (emptyVarInfo x)) nabla{nabla_tm_st=ts{ts_facts=env'}} xid where add_matches vi at VI{ vi_rcm = rcm } -- important common case, shaving down allocations of PmSeriesG by -5% - | isRcmInitialised rcm = pure (rcm, vi) + | isRcmInitialised rcm = pure (rcm, Just vi) add_matches vi at VI{ vi_rcm = rcm } = do norm_res_ty <- normaliseSourceTypeWHNF ty_st (idType x) env <- dsGetFamInstEnvs rcm' <- case splitReprTyConApp_maybe env norm_res_ty of Just (rep_tc, _args, _co) -> addTyConMatches rep_tc rcm Nothing -> addCompleteMatches rcm - pure (rcm', vi{ vi_rcm = rcm' }) + pure (rcm', Just vi{ vi_rcm = rcm' }) -- | Does a 'splitTyConApp_maybe' and then tries to look through a data family -- application to find the representation TyCon, to which the data constructors @@ -1433,7 +1447,7 @@ instCompleteSets fuel nabla vi = {-# SCC "instCompleteSets" #-} do let x = vi_id vi (rcm, nabla) <- lift (addNormalisedTypeMatches nabla x) nabla <- foldM (\nabla cls -> instCompleteSet fuel nabla x cls) nabla (getRcm rcm) - pure (fst $ lookupVarInfo (nabla_tm_st nabla) x) + pure (fromMaybe (emptyVarInfo x) (lookupVarInfo (nabla_tm_st nabla) x)) anyConLikeSolution :: (ConLike -> Bool) -> [PmAltConApp] -> Bool anyConLikeSolution p = any (go . paca_con) @@ -1462,7 +1476,7 @@ instCompleteSet fuel nabla x cs | otherwise = {-# SCC "instCompleteSet" #-} go nabla (sorted_candidates cs) where - (vi, _env') = lookupVarInfo (nabla_tm_st nabla) x + vi = fromMaybe (emptyVarInfo x) $ lookupVarInfo (nabla_tm_st nabla) x sorted_candidates :: CompleteMatch -> [ConLike] sorted_candidates cm @@ -1949,9 +1963,9 @@ generateInhabitingPatterns :: GenerateInhabitingPatternsMode -> [Id] -> Int -> N -- See Note [Why inhabitationTest doesn't call generateInhabitingPatterns] generateInhabitingPatterns _ _ 0 _ = pure [] generateInhabitingPatterns _ [] _ nabla = pure [nabla] -generateInhabitingPatterns mode (x:xs) n nabla = do +generateInhabitingPatterns mode (x:xs) n nabla at MkNabla{nabla_tm_st=ts} = do tracePm "generateInhabitingPatterns" (ppr mode <+> ppr n <+> ppr (x:xs) $$ ppr nabla) - let (VI _ pos neg _ _, _env') = lookupVarInfo (nabla_tm_st nabla) x + let (VI _ pos neg _ _) = fromMaybe (emptyVarInfo x) $ lookupVarInfo ts x case pos of _:_ -> do -- Example for multiple solutions (must involve a PatSyn): @@ -1988,8 +2002,8 @@ generateInhabitingPatterns mode (x:xs) n nabla = do mb_stuff <- runMaybeT $ instantiate_newtype_chain x nabla dcs case mb_stuff of Nothing -> pure [] - Just (y, newty_nabla) -> do - let (vi, _env) = lookupVarInfo (nabla_tm_st newty_nabla) y + Just (y, newty_nabla at MkNabla{nabla_tm_st=ts}) -> do + let vi = fromMaybe (emptyVarInfo y) $ lookupVarInfo ts y env <- dsGetFamInstEnvs rcm <- case splitReprTyConApp_maybe env rep_ty of Just (tc, _, _) -> addTyConMatches tc (vi_rcm vi) @@ -2122,3 +2136,10 @@ Note that for -XEmptyCase, we don't want to emit a minimal cover. We arrange that by passing 'CaseSplitTopLevel' to 'generateInhabitingPatterns'. We detect the -XEmptyCase case in 'reportWarnings' by looking for 'ReportEmptyCase'. -} + +-- | Update the value of the analysis data of some e-class by its id. +updateVarInfo :: Functor f => ClassId -> (a -> f a) -> EGraph a l -> f (EGraph a l) +-- Update the data at class @xid@ using lenses and the monadic action @go@ +updateVarInfo xid = _class xid . _data + +-- ROMES:TODO: When exactly to rebuild? \ No newline at end of file ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -1,5 +1,6 @@ -{-# OPTIONS_GHC -Wno-orphans #-} -- Oh god, ROMES:TODO {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -13,12 +14,12 @@ module GHC.HsToCore.Pmc.Solver.Types ( -- * Normalised refinement types - BotInfo(..), PmAltConApp(..), VarInfo(..), TmState(..), TyState(..), + BotInfo(..), PmAltConApp(..), VarInfo(..), TmState(..), TmEGraph, TyState(..), Nabla(..), Nablas(..), initNablas, lookupRefuts, lookupSolution, -- ** Looking up 'VarInfo' - lookupVarInfo, lookupVarInfoNT, trvVarInfo, + lookupVarInfo, lookupVarInfoNT, trvVarInfo, emptyVarInfo, representId, -- ** Caching residual COMPLETE sets CompleteMatch, ResidualCompleteMatches(..), getRcm, isRcmInitialised, @@ -48,6 +49,7 @@ import GHC.Types.Id import GHC.Types.Var.Set import GHC.Types.Unique.DSet import GHC.Types.Name +import GHC.Core.Functor import GHC.Core.DataCon import GHC.Core.ConLike import GHC.Utils.Outputable @@ -61,6 +63,7 @@ import GHC.Types.Literal import GHC.Core import GHC.Core.TyCo.Compare( eqType ) import GHC.Core.Map.Expr +import GHC.Core.Map.Type import GHC.Core.Utils (exprType) import GHC.Builtin.Names import GHC.Builtin.Types @@ -78,10 +81,16 @@ import GHC.Real (Ratio(..)) import qualified Data.Semigroup as Semi import Data.Functor.Const +import Data.Functor.Compose +import Data.Function ((&)) import Data.Equality.Analysis (Analysis(..)) -import Data.Equality.Graph (EGraph) +import Data.Equality.Graph (EGraph, ClassId) import Data.Equality.Utils (Fix(..)) +import Data.Equality.Graph.Lens import qualified Data.Equality.Graph as EG +import Data.IntSet (IntSet) +import qualified Data.IntSet as IS (empty) +import Data.Bifunctor (second) -- import GHC.Driver.Ppr @@ -139,29 +148,24 @@ instance Outputable TyState where initTyState :: TyState initTyState = TySt 0 emptyInert --- | The term oracle state. Stores 'VarInfo' for encountered 'Id's. These --- entries are possibly shared when we figure out that two variables must be --- equal, thus represent the same set of values. +-- | The term oracle state. Stores 'VarInfo' for encountered 'Id's and +-- 'CoreExpr's. These entries are possibly shared when we figure out that two +-- variables must be equal, thus represent the same set of values. -- -- See Note [TmState invariants] in "GHC.HsToCore.Pmc.Solver". data TmState = TmSt - { ts_facts :: !(EGraph VarInfo (Const Id)) -- ROMES:TODO: The Id here is because we don't merge yet ts_reps into the e-graph; so we simply have Ids as E-nodes - -- ^ Facts about term variables. Deterministic env, so that we generate - -- deterministic error messages. --- ROMES:TODO: ts_reps perhaps too as well... but a first iteration should map CoreMap to ClassId, and replace just ts_facts. - , ts_reps :: !(CoreMap Id) - -- ^ An environment for looking up whether we already encountered semantically - -- equivalent expressions that we want to represent by the same 'Id' - -- representative. --- ROMES:TODO: ts_dirty looks a bit to me like the bookeeping needed to know --- which nodes to upward merge, perhaps we can get rid of it too. - , ts_dirty :: !DIdSet + { ts_facts :: !TmEGraph + -- ^ Facts about terms. + + -- ROMES:TODO: ts_dirty looks a bit to me like the bookeeping needed to know + -- which nodes to upward merge, perhaps we can get rid of it too. + , ts_dirty :: !IntSet -- ^ Which 'VarInfo' needs to be checked for inhabitants because of new -- negative constraints (e.g. @x ≁ ⊥@ or @x ≁ K@). } -instance EG.Language (Const Id) +type TmEGraph = EGraph (Maybe VarInfo) (DeBruijnF CoreExprF) -- | Information about an 'Id'. Stores positive ('vi_pos') facts, like @x ~ Just 42@, -- and negative ('vi_neg') facts, like "x is not (:)". @@ -174,6 +178,8 @@ data VarInfo { vi_id :: !Id -- ^ The 'Id' in question. Important for adding new constraints relative to -- this 'VarInfo' when we don't easily have the 'Id' available. + -- ROMES:TODO: What is the Id in question when we might have multiple Ids in the same equivalence class? + -- It seems currenlty this is the representative of the e-class, so we could probably drop it, in favour of Type or so (since sometimes we need to know the type, and that's also reasonable data for the e-class to have) , vi_pos :: ![PmAltConApp] -- ^ Positive info: 'PmAltCon' apps it is (i.e. @x ~ [Just y, PatSyn z]@), all @@ -181,7 +187,7 @@ data VarInfo -- pattern matches involving pattern synonym -- case x of { Just y -> case x of PatSyn z -> ... } -- However, no more than one RealDataCon in the list, otherwise contradiction - -- because of generativity. + -- because of generativity (which would violate Invariant 1 from the paper). , vi_neg :: !PmAltConSet -- ^ Negative info: A list of 'PmAltCon's that it cannot match. @@ -219,10 +225,10 @@ data VarInfo -- There ought to be a better way. instance Eq VarInfo where (==) _ _ = False -instance Analysis VarInfo (Const Id) where +instance Analysis (Maybe VarInfo) (DeBruijnF CoreExprF) where {-# INLINE makeA #-} {-# INLINE joinA #-} - makeA (Const id) = emptyVarInfo id + makeA _ = Nothing -- romes: so currently, variables are joined in 'addVarCt' manually by getting the old value of $x$ and assuming the value of $y$ was chosen. -- That's obviously bad now, it'd be much more clearer to do it here. It's just the nabla threading that's more trouble joinA _a b = b @@ -252,7 +258,7 @@ instance Outputable BotInfo where -- | Not user-facing. instance Outputable TmState where - ppr (TmSt _state reps dirty) = text "" $$ ppr reps $$ ppr dirty + ppr (TmSt _ dirty) = text "" $$ ppr dirty -- | Not user-facing. instance Outputable VarInfo where @@ -273,7 +279,7 @@ instance Outputable VarInfo where -- | Initial state of the term oracle. initTmState :: TmState -initTmState = TmSt EG.emptyEGraph emptyCoreMap emptyDVarSet +initTmState = TmSt EG.emptyEGraph IS.empty -- | A data type that caches for the 'VarInfo' of @x@ the results of querying -- 'dsGetCompleteMatches' and then striking out all occurrences of @K@ for @@ -326,16 +332,12 @@ emptyVarInfo x } -- | @lookupVarInfo tms x@ tells what we know about 'x' ---- romes: TODO: lookupVarInfo should also return the ClassId the Id was represented in..., that'd make things better -lookupVarInfo :: TmState -> Id -> (VarInfo, TmState) -lookupVarInfo tm@(TmSt env _ _) x - -- = fromMaybe (emptyVarInfo x) (lookupUSDFM env x) - -- ROMES:TODO Kind of an issue here, we could have a lookup operation on e-graphs but it'd be good to make it faster - -- We will want to assume every Id is mapped to VarInfo, with emptyVarInfo as the default rather than Maybe - -- I'm just unsure if the Id always exists or not. - -- Then again this shouldn't be Id, but rather ClassId§ - = let (i,env') = EG.represent (Fix $ Const x) env - in (EG.lookup i env', tm{ts_facts=env'}) +--- romes:TODO: This will have a different type. I don't know what yet. +-- romes:TODO I don't think this is what we want any longer, more like represent Id and see if it was previously represented by some data or not? +-- romes:TodO should return VarInfo rather than Maybe VarInfo +lookupVarInfo :: TmState -> Id -> Maybe VarInfo +lookupVarInfo (TmSt eg _) x + = let (xid, eg') = representId x eg in eg' ^._class xid._data -- | Like @lookupVarInfo ts x@, but @lookupVarInfo ts x = (y, vi)@ also looks -- through newtype constructors. We have @x ~ N1 (... (Nk y))@ such that the @@ -347,38 +349,35 @@ lookupVarInfo tm@(TmSt env _ _) x -- modulo type normalisation! -- -- See also Note [Coverage checking Newtype matches] in GHC.HsToCore.Pmc.Solver. -lookupVarInfoNT :: TmState -> Id -> (Id, VarInfo, TmState) +lookupVarInfoNT :: TmState -> Id -> (Id, Maybe VarInfo) lookupVarInfoNT ts x = case lookupVarInfo ts x of - (VI{ vi_pos = as_newtype -> Just y },ts') - -> lookupVarInfoNT ts' y - (res,ts') - -> (x, res, ts') + Just VI{ vi_pos = as_newtype -> Just y } -> lookupVarInfoNT ts y + res -> (x, res) where as_newtype = listToMaybe . mapMaybe go go PACA{paca_con = PmAltConLike (RealDataCon dc), paca_ids = [y]} | isNewDataCon dc = Just y go _ = Nothing --- ROMES:TODO: What does this do, how to update? -trvVarInfo :: Functor f => (VarInfo -> f (a, VarInfo)) -> Nabla -> Id -> f (a, Nabla) -trvVarInfo f nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts = _env} } x - -- ROMES:TODO: adjust on the EG, instead of fetching? the (a,) bit is not trivial - = let (vi, ts'@TmSt{ts_facts = env'}) = lookupVarInfo ts x - set_vi (a, vi') = - (a, nabla{ nabla_tm_st = ts'{ ts_facts = let (i,env'') = EG.represent (Fix $ Const $ vi_id vi') env' in EG.adjust (const vi') i env'' } }) - in set_vi <$> f vi - where +-- romes: We could probably inline this +trvVarInfo :: forall f a. Functor f => (Maybe VarInfo -> f (a,Maybe VarInfo)) -> Nabla -> ClassId -> f (a,Nabla) +trvVarInfo f nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts = env} } x + = second (\g -> nabla{nabla_tm_st = ts{ts_facts=g}}) <$> updateAccum (_class x._data) f env + where + updateAccum :: forall f a s c. Functor f => Lens' s a -> (a -> f (c,a)) -> s -> f (c,s) + updateAccum lens g = getCompose . lens @(Compose f ((,) c)) (Compose . g) ------------------------------------------------ -- * Exported utility functions querying 'Nabla' +-- ROMES:TODO: Document +-- | Lookup the refutable patterns, i.e. the pattern alt cons that certainly can't happen?? +-- ROMES:TODO: ClassId? lookupRefuts :: Nabla -> Id -> [PmAltCon] -- Unfortunately we need the extra bit of polymorphism and the unfortunate -- duplication of lookupVarInfo here. lookupRefuts MkNabla{ nabla_tm_st = ts } x = - -- bimap (pmAltConSetElems . vi_neg) (\ts' -> nabla{nabla_tm_st=ts'}) $ lookupVarInfo ts x - -- ROMES:TODO: It's a bit unfortunate we forget the representation of $x$, but OK - pmAltConSetElems $ vi_neg $ fst $ lookupVarInfo ts x + maybe [] (pmAltConSetElems . vi_neg) $ lookupVarInfo ts x isDataConSolution :: PmAltConApp -> Bool isDataConSolution PACA{paca_con = PmAltConLike (RealDataCon _)} = True @@ -387,8 +386,9 @@ isDataConSolution _ = False -- @lookupSolution nabla x@ picks a single solution ('vi_pos') of @x@ from -- possibly many, preferring 'RealDataCon' solutions whenever possible. lookupSolution :: Nabla -> Id -> Maybe PmAltConApp -lookupSolution nabla x = case vi_pos $ fst $ lookupVarInfo (nabla_tm_st nabla) x of - -- ROMES:TODO: It's a bit unfortunate we forget the representation of $x$, but OK +lookupSolution nabla x = do + varinfo <- lookupVarInfo (nabla_tm_st nabla) x + case vi_pos varinfo of [] -> Nothing pos@(x:_) | Just sol <- find isDataConSolution pos -> Just sol @@ -506,6 +506,7 @@ extendPmAltConSet (PACS cls lits) (PmAltConLike cl) extendPmAltConSet (PACS cls lits) (PmAltLit lit) = PACS cls (unionLists lits [lit]) +-- | The elements of a 'PmAltConSet' pmAltConSetElems :: PmAltConSet -> [PmAltCon] pmAltConSetElems (PACS cls lits) = map PmAltConLike (uniqDSetToList cls) ++ map PmAltLit lits @@ -838,3 +839,8 @@ instance Outputable PmAltCon where instance Outputable PmEquality where ppr = text . show + + +representId :: Id -> TmEGraph -> (ClassId, TmEGraph) +-- ROMES:TODO: bit of a hack to represent binders with `Var`, which is likely wrong (lambda bound vars might get equivalent to global ones?). Will need to justify this well +representId x = EG.add (EG.Node (deBruijnizeF (VarF x))) -- debruijn things are compared correctly wrt binders, but we can still have a debruijn var w name with no prob ===================================== compiler/ghc.cabal.in ===================================== @@ -300,6 +300,7 @@ Library GHC.Core.ConLike GHC.Core.DataCon GHC.Core.FamInstEnv + GHC.Core.Functor GHC.Core.FVs GHC.Core.InstEnv GHC.Core.Lint ===================================== libraries/hegg ===================================== @@ -1 +1 @@ -Subproject commit 67453e7735fdfc9e6212c607ba3ed855d525d349 +Subproject commit 94339b984e48bd6ce009b4e70c9374e8ac4981cd View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d0575935ff754d76fd358ba6229e7fc6c798801b...6dec19d1bcfc25d4c3d79c795d5fba865c1b2876 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d0575935ff754d76fd358ba6229e7fc6c798801b...6dec19d1bcfc25d4c3d79c795d5fba865c1b2876 You're receiving 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 Jun 14 17:06:03 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Wed, 14 Jun 2023 13:06:03 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/sized-literals-deriving Message-ID: <6489f37bf375_c7397c57381431f4@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/sized-literals-deriving at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sized-literals-deriving You're receiving 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 Jun 14 17:50:24 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Wed, 14 Jun 2023 13:50:24 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/#16635-improve-errors] Capture scoped kind variables at type-checking phase (#16635) Message-ID: <6489fde0c7748_c7397c56e815038b@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/#16635-improve-errors at Glasgow Haskell Compiler / GHC Commits: be43743d by Andrei Borzenkov at 2023-06-14T21:50:09+04:00 Capture scoped kind variables at type-checking phase (#16635) Like descibed in new Note [Type variable scoping errors during type check] in GHC.Tc.Types, I made ScopedTypeVariables work on type level like in term level. For now that only means, that the error about kind variables scoped into type are rejected at the elaboration time, because we can't generalize the type by adding type-level lambda - we simply have no one. - - - - - 30 changed files: - compiler/GHC/Hs/Type.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Errors/Types/PromotionErr.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Types/BasicTypes.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Types/Error/Codes.hs - testsuite/tests/dependent/should_fail/PromotedClass.stderr - testsuite/tests/dependent/should_fail/SelfDep.stderr - testsuite/tests/dependent/should_fail/T13780a.stderr - testsuite/tests/dependent/should_fail/T13780c.stderr - testsuite/tests/dependent/should_fail/T14845_compile.stderr - testsuite/tests/dependent/should_fail/T14845_fail1.stderr - testsuite/tests/dependent/should_fail/T14845_fail2.stderr - testsuite/tests/dependent/should_fail/T15215.stderr - testsuite/tests/dependent/should_fail/T15245.stderr - testsuite/tests/patsyn/should_fail/T11265.stderr - testsuite/tests/patsyn/should_fail/T9161-1.stderr - testsuite/tests/patsyn/should_fail/T9161-2.stderr - testsuite/tests/polykinds/PolyKinds06.stderr - testsuite/tests/polykinds/PolyKinds07.stderr - testsuite/tests/polykinds/T13625.stderr - testsuite/tests/polykinds/T15116.stderr - testsuite/tests/polykinds/T15116a.stderr - testsuite/tests/polykinds/T5716.stderr - testsuite/tests/polykinds/T5716a.stderr - testsuite/tests/polykinds/T6129.stderr - testsuite/tests/polykinds/T7433.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/be43743dc054dde320ffca2c3faf6dc018e2edaa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/be43743dc054dde320ffca2c3faf6dc018e2edaa You're receiving 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 Jun 14 18:54:59 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Wed, 14 Jun 2023 14:54:59 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/#16635-improve-errors] 34 commits: Don't report redundant Givens from quantified constraints Message-ID: <648a0d034da3c_c7397c574c169616@gitlab.mail> Vladislav Zavialov pushed to branch wip/sand-witch/#16635-improve-errors at Glasgow Haskell Compiler / GHC Commits: 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 8e308425 by Andrei Borzenkov at 2023-06-14T20:54:45+02:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 30 changed files: - .gitlab-ci.yml - HACKING.md - compiler/GHC/Core/Type.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Errors/Types/PromotionErr.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Solve.hs - compiler/GHC/Tc/Types/BasicTypes.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Tc/Utils/Monad.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/be43743dc054dde320ffca2c3faf6dc018e2edaa...8e3084256cd8a84da5a105afd550c90d9e799e52 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/be43743dc054dde320ffca2c3faf6dc018e2edaa...8e3084256cd8a84da5a105afd550c90d9e799e52 You're receiving 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 Jun 14 20:30:23 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Wed, 14 Jun 2023 16:30:23 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23509 Message-ID: <648a235f6a0ff_c7397c573818665a@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/T23509 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23509 You're receiving 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 Jun 14 20:36:04 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Wed, 14 Jun 2023 16:36:04 -0400 Subject: [Git][ghc/ghc][wip/T23509] Fix test T18522-deb-ppr Message-ID: <648a24b4c3878_c7397c56e81901a7@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/T23509 at Glasgow Haskell Compiler / GHC Commits: 5d3ab48b by Krzysztof Gogolewski at 2023-06-14T22:35:52+02:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 2 changed files: - testsuite/tests/ghc-api/T18522-dbg-ppr.hs - testsuite/tests/ghc-api/all.T Changes: ===================================== testsuite/tests/ghc-api/T18522-dbg-ppr.hs ===================================== @@ -10,7 +10,7 @@ import GHC.Driver.Session import GHC.Core.TyCo.Ppr import GHC.Utils.Outputable import GHC.Tc.Module -import GHC.Tc.Utils.Zonk +import GHC.Tc.Zonk.Env import GHC.Utils.Error import GHC.Driver.Ppr import GHC.Driver.Env ===================================== testsuite/tests/ghc-api/all.T ===================================== @@ -26,7 +26,7 @@ test('T18181', compile_and_run, ['-package ghc']) test('T18522-dbg-ppr', - [extra_run_opts('"' + config.libdir + '"'), fragile(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/5d3ab48b60b3d3909670a7f2a1c45ec309cafa45 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5d3ab48b60b3d3909670a7f2a1c45ec309cafa45 You're receiving 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 Jun 14 21:18:12 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 14 Jun 2023 17:18:12 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Add more flags for dumping core passes (#23491) Message-ID: <648a2e948c15f_c7397c56e820112@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 10 changed files: - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - docs/users_guide/debugging.rst - + testsuite/tests/simplCore/should_compile/T23491.hs - + testsuite/tests/simplCore/should_compile/T23491a.stderr - + testsuite/tests/simplCore/should_compile/T23491b.stderr - + testsuite/tests/simplCore/should_compile/T23491c.stderr - + testsuite/tests/simplCore/should_compile/T23491d.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Driver/Config/Core/Lint.hs ===================================== @@ -77,10 +77,10 @@ initEndPassConfig dflags extra_vars name_ppr_ctx pass = EndPassConfig coreDumpFlag :: CoreToDo -> Maybe DumpFlag coreDumpFlag (CoreDoSimplify {}) = Just Opt_D_verbose_core2core coreDumpFlag (CoreDoPluginPass {}) = Just Opt_D_verbose_core2core -coreDumpFlag CoreDoFloatInwards = Just Opt_D_verbose_core2core -coreDumpFlag (CoreDoFloatOutwards {}) = Just Opt_D_verbose_core2core -coreDumpFlag CoreLiberateCase = Just Opt_D_verbose_core2core -coreDumpFlag CoreDoStaticArgs = Just Opt_D_verbose_core2core +coreDumpFlag CoreDoFloatInwards = Just Opt_D_dump_float_in +coreDumpFlag (CoreDoFloatOutwards {}) = Just Opt_D_dump_float_out +coreDumpFlag CoreLiberateCase = Just Opt_D_dump_liberate_case +coreDumpFlag CoreDoStaticArgs = Just Opt_D_dump_static_argument_transformation coreDumpFlag CoreDoCallArity = Just Opt_D_dump_call_arity coreDumpFlag CoreDoExitify = Just Opt_D_dump_exitify coreDumpFlag (CoreDoDemand {}) = Just Opt_D_dump_stranal ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -127,6 +127,10 @@ data DumpFlag | Opt_D_dump_types | Opt_D_dump_rules | Opt_D_dump_cse + | Opt_D_dump_float_out + | Opt_D_dump_float_in + | Opt_D_dump_liberate_case + | Opt_D_dump_static_argument_transformation | Opt_D_dump_worker_wrapper | Opt_D_dump_rn_trace | Opt_D_dump_rn_stats ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -1468,6 +1468,16 @@ dynamic_flags_deps = [ (setDumpFlag Opt_D_dump_rules) , make_ord_flag defGhcFlag "ddump-cse" (setDumpFlag Opt_D_dump_cse) + , make_ord_flag defGhcFlag "ddump-float-out" + (setDumpFlag Opt_D_dump_float_out) + , make_ord_flag defGhcFlag "ddump-full-laziness" + (setDumpFlag Opt_D_dump_float_out) + , make_ord_flag defGhcFlag "ddump-float-in" + (setDumpFlag Opt_D_dump_float_in) + , make_ord_flag defGhcFlag "ddump-liberate-case" + (setDumpFlag Opt_D_dump_liberate_case) + , make_ord_flag defGhcFlag "ddump-static-argument-transformation" + (setDumpFlag Opt_D_dump_static_argument_transformation) , make_ord_flag defGhcFlag "ddump-worker-wrapper" (setDumpFlag Opt_D_dump_worker_wrapper) , make_ord_flag defGhcFlag "ddump-rn-trace" ===================================== docs/users_guide/debugging.rst ===================================== @@ -436,6 +436,31 @@ subexpression elimination pass. Dump common subexpression elimination (CSE) pass output +.. ghc-flag:: -ddump-full-laziness + -ddump-float-out + :shortdesc: Dump full laziness pass output + :type: dynamic + + Dump full laziness pass (also known as float-out) output (see :ghc-flag:`-ffull-laziness`) + +.. ghc-flag:: -ddump-float-in + :shortdesc: Dump float in output + :type: dynamic + + Dump float-in pass output (see :ghc-flag:`-ffloat-in`) + +.. ghc-flag:: -ddump-liberate-case + :shortdesc: Dump liberate case output + :type: dynamic + + Dump liberate case pass output (see :ghc-flag:`-fliberate-case`) + +.. ghc-flag:: -ddump-static-argument-transformation + :shortdesc: Dump static argument transformation output + :type: dynamic + + Dump static argument transformation pass output (see :ghc-flag:`-fstatic-argument-transformation`) + .. ghc-flag:: -ddump-worker-wrapper :shortdesc: Dump worker-wrapper output :type: dynamic ===================================== testsuite/tests/simplCore/should_compile/T23491.hs ===================================== @@ -0,0 +1 @@ +main = putStrLn "Hello world" ===================================== testsuite/tests/simplCore/should_compile/T23491a.stderr ===================================== @@ -0,0 +1,4 @@ +==================== Float out(FOS {Lam = Just 0, Consts = True, OverSatApps = False}) ==================== +Result size of Float out(FOS {Lam = Just 0, Consts = True, OverSatApps = False}) +==================== Float out(FOS {Lam = Just 0, Consts = True, OverSatApps = True}) ==================== +Result size of Float out(FOS {Lam = Just 0, Consts = True, OverSatApps = True}) ===================================== testsuite/tests/simplCore/should_compile/T23491b.stderr ===================================== @@ -0,0 +1,4 @@ +==================== Float inwards ==================== +Result size of Float inwards +==================== Float inwards ==================== +Result size of Float inwards ===================================== testsuite/tests/simplCore/should_compile/T23491c.stderr ===================================== @@ -0,0 +1,2 @@ +==================== Liberate case ==================== +Result size of Liberate case ===================================== testsuite/tests/simplCore/should_compile/T23491d.stderr ===================================== @@ -0,0 +1,2 @@ +==================== Static argument ==================== +Result size of Static argument ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -484,3 +484,8 @@ test('T23307a', normal, compile, ['-O -ddump-simpl -dno-typeable-binds -dsuppres test('T23307b', normal, compile, ['-O']) test('T23307c', normal, compile, ['-O']) test('T23426', normal, compile, ['-O']) + +test('T23491a', [extra_files(['T23491.hs']), grep_errmsg(r'Float out')], multimod_compile, ['T23491', '-ffull-laziness -ddump-full-laziness']) +test('T23491b', [extra_files(['T23491.hs']), grep_errmsg(r'Float inwards')], multimod_compile, ['T23491', '-ffloat-in -ddump-float-in']) +test('T23491c', [extra_files(['T23491.hs']), grep_errmsg(r'Liberate case')], multimod_compile, ['T23491', '-fliberate-case -ddump-liberate-case']) +test('T23491d', [extra_files(['T23491.hs']), grep_errmsg(r'Static argument')], multimod_compile, ['T23491', '-fstatic-argument-transformation -ddump-static-argument-transformation']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/100650e35d6d17965e293160785360933c9e0a25...1b7604af7dd8c787043ab46d4ad4f84bf131cd3c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/100650e35d6d17965e293160785360933c9e0a25...1b7604af7dd8c787043ab46d4ad4f84bf131cd3c You're receiving 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 Jun 14 21:18:49 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 14 Jun 2023 17:18:49 -0400 Subject: [Git][ghc/ghc][master] Provide a demand signature for atomicModifyMutVar.# (#23047) Message-ID: <648a2eb9aab51_c7397c56d4206247@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 2 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Types/Demand.hs Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -2489,6 +2489,7 @@ primop AtomicModifyMutVar2Op "atomicModifyMutVar2#" GenPrimOp out_of_line = True has_side_effects = True can_fail = True + strictness = { \ _arity -> mkClosedDmdSig [ topDmd, lazyApply1Dmd, topDmd ] topDiv } primop AtomicModifyMutVar_Op "atomicModifyMutVar_#" GenPrimOp MutVar# s a -> (a -> a) -> State# s -> (# State# s, a, a #) @@ -2499,6 +2500,7 @@ primop AtomicModifyMutVar_Op "atomicModifyMutVar_#" GenPrimOp out_of_line = True has_side_effects = True can_fail = True + strictness = { \ _arity -> mkClosedDmdSig [ topDmd, lazyApply1Dmd, topDmd ] topDiv } primop CasMutVarOp "casMutVar#" GenPrimOp MutVar# s v -> v -> v -> State# s -> (# State# s, Int#, v #) ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -963,15 +963,15 @@ strictOnceApply1Dmd = C_11 :* mkCall C_11 topSubDmd strictManyApply1Dmd :: Demand strictManyApply1Dmd = C_1N :* mkCall C_1N topSubDmd --- | First argument of catch#: @MC(M,L)@. +-- | First argument of catch#: @MC(1,L)@. -- Evaluates its arg lazily, but then applies it exactly once to one argument. lazyApply1Dmd :: Demand -lazyApply1Dmd = C_01 :* mkCall C_01 topSubDmd +lazyApply1Dmd = C_01 :* mkCall C_11 topSubDmd --- | Second argument of catch#: @MC(M,C(1,L))@. --- Calls its arg lazily, but then applies it exactly once to an additional argument. +-- | Second argument of catch#: @MC(1,C(1,L))@. +-- Evaluates its arg lazily, but then applies it exactly once to two arguments. lazyApply2Dmd :: Demand -lazyApply2Dmd = C_01 :* mkCall C_01 (mkCall C_11 topSubDmd) +lazyApply2Dmd = C_01 :* mkCall C_11 (mkCall C_11 topSubDmd) -- | Make a 'Demand' evaluated at-most-once. oneifyDmd :: Demand -> Demand View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/420000000e2d3d1a07ff3aa2a24cc88bd3d48e75 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/420000000e2d3d1a07ff3aa2a24cc88bd3d48e75 You're receiving 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 Jun 14 21:50:17 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 14 Jun 2023 17:50:17 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 11 commits: Add more flags for dumping core passes (#23491) Message-ID: <648a3619cfee3_c7397ae8ab34214175@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 54c30252 by Ben Gamari at 2023-06-14T17:49:45-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - eeb7d503 by Andrei Borzenkov at 2023-06-14T17:49:45-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 542fe8bc by Sven Tennie at 2023-06-14T17:49:46-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - cd0c34a0 by doyougnu at 2023-06-14T17:50:04-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 5ebf253e by Vladislav Zavialov at 2023-06-14T17:50:04-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - dd174a15 by Luite Stegeman at 2023-06-14T17:50:09-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - de860f74 by Luite Stegeman at 2023-06-14T17:50:09-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - d9dee102 by Luite Stegeman at 2023-06-14T17:50:09-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 30 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/JS/Make.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Arg.hs - compiler/GHC/StgToJS/Closure.hs - compiler/GHC/StgToJS/CodeGen.hs - − compiler/GHC/StgToJS/CoreUtils.hs - compiler/GHC/StgToJS/DataCon.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Ids.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/StgToJS/Sinker.hs - − compiler/GHC/StgToJS/StgUtils.hs - compiler/GHC/StgToJS/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/ghc.cabal.in - docs/users_guide/debugging.rst The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9a60412d29330abcfb9ef1ed2df59dca8eea6573...d9dee1024e02f11a54cd1f6b93d09c873e448c29 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9a60412d29330abcfb9ef1ed2df59dca8eea6573...d9dee1024e02f11a54cd1f6b93d09c873e448c29 You're receiving 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 Jun 14 22:16:56 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 14 Jun 2023 18:16:56 -0400 Subject: [Git][ghc/ghc][wip/rts-warnings] 425 commits: Optimized Foldable methods for Data.Functor.Compose Message-ID: <648a3c584869d_c7397a33d4702306bd@gitlab.mail> Ben Gamari pushed to branch wip/rts-warnings at Glasgow Haskell Compiler / GHC Commits: 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 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: ...lots of lines omitted... 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. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04: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. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04: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> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+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. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 88346abb by Ben Gamari at 2023-06-14T17:21:15-04:00 rts/ipe: Fix unused lock warning - - - - - 2188fbcc by Ben Gamari at 2023-06-14T17:21:15-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 9582d598 by Ben Gamari at 2023-06-14T17:21:15-04:00 rts: Various warnings fixes - - - - - f89de23b by Ben Gamari at 2023-06-14T17:21:15-04:00 rts: Fix printf format mismatch - - - - - e97589ec by Ben Gamari at 2023-06-14T17:21:15-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - b9461e86 by Ben Gamari at 2023-06-14T17:21:15-04:00 nonmoving: Fix unused definition warrnings - - - - - dde09b4c by Ben Gamari at 2023-06-14T17:21:15-04:00 Disable futimens on Darwin. See #22938 - - - - - 6f80c7db by Ben Gamari at 2023-06-14T17:21:15-04:00 rts: Fix incorrect CPP guard - - - - - 2d7d0910 by Ben Gamari at 2023-06-14T17:28:17-04: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: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/generate_job_metadata - .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - .gitlab/rel_eng/upload_ghc_libs.py - .gitmodules - CODEOWNERS - HACKING.md - cabal.project-reinstall - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b9e7a8e0a248ab433633b9751fcbaef9ce51c159...2d7d091004618a46f236cdb5f2039ffc55ce2fb1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b9e7a8e0a248ab433633b9751fcbaef9ce51c159...2d7d091004618a46f236cdb5f2039ffc55ce2fb1 You're receiving 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 Jun 14 22:57:19 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Wed, 14 Jun 2023 18:57:19 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/int-index/vis-flag-tests Message-ID: <648a45cfd9538_c7397c574c2358ac@gitlab.mail> Vladislav Zavialov pushed new branch wip/int-index/vis-flag-tests at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/int-index/vis-flag-tests You're receiving 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 Jun 14 23:02:02 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Wed, 14 Jun 2023 19:02:02 -0400 Subject: [Git][ghc/ghc][wip/int-index/vis-flag-tests] 37 commits: Don't report redundant Givens from quantified constraints Message-ID: <648a46ea905ca_c7397b0bc90c244029@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/vis-flag-tests at Glasgow Haskell Compiler / GHC Commits: 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 84d31c6e by Vladislav Zavialov at 2023-06-15T01:01:55+02:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - 30 changed files: - .gitlab-ci.yml - HACKING.md - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Type.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Solve.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Demand.hs - compiler/GHC/Types/Error.hs - compiler/GHC/Utils/Error.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/89dfe2afedf52fdbc59cf19cbff0caf8fe3f6530...84d31c6e27480b97f9cf0e57147abdbf5a46f7a6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/89dfe2afedf52fdbc59cf19cbff0caf8fe3f6530...84d31c6e27480b97f9cf0e57147abdbf5a46f7a6 You're receiving 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 Jun 15 03:27:10 2023 From: gitlab at gitlab.haskell.org (=?UTF-8?B?R2VyZ8WRIMOJcmRpIChAY2FjdHVzKQ==?=) Date: Wed, 14 Jun 2023 23:27:10 -0400 Subject: [Git][ghc/ghc][wip/issue-23516] Add `IfaceWarnings` to represent the `ModIface`-storable parts Message-ID: <648a850e363a3_c7397acb36bc258467@gitlab.mail> Gergő Érdi pushed to branch wip/issue-23516 at Glasgow Haskell Compiler / GHC Commits: 8e14d2ab by Gergő Érdi at 2023-06-14T10:19:04+01:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 8 changed files: - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Types/SourceText.hs - compiler/GHC/Unit/Module/ModIface.hs - compiler/GHC/Unit/Module/Warnings.hs Changes: ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -102,7 +102,6 @@ import GHC.Types.PkgQual import GHC.Unit.External import GHC.Unit.Module -import GHC.Unit.Module.Warnings import GHC.Unit.Module.ModIface import GHC.Unit.Module.Deps import GHC.Unit.State @@ -1206,16 +1205,6 @@ pprTrustInfo trust = text "trusted:" <+> ppr trust pprTrustPkg :: Bool -> SDoc pprTrustPkg tpkg = text "require own pkg trusted:" <+> ppr tpkg -instance Outputable (Warnings pass) where - ppr = pprWarns - -pprWarns :: Warnings pass -> SDoc -pprWarns NoWarnings = Outputable.empty -pprWarns (WarnAll txt) = text "Warn all" <+> ppr txt -pprWarns (WarnSome prs) = text "Warnings:" - <+> vcat (map pprWarning prs) - where pprWarning (name, txt) = ppr name <+> ppr txt - pprIfaceAnnotation :: IfaceAnnotation -> SDoc pprIfaceAnnotation (IfaceAnnotation { ifAnnotatedTarget = target, ifAnnotatedValue = serialized }) = ppr target <+> text "annotated by" <+> ppr serialized ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -66,6 +66,8 @@ import GHC.Types.SourceFile import GHC.Types.TyThing import GHC.Types.HpcInfo import GHC.Types.CompleteMatch +import GHC.Types.SourceText +import GHC.Types.SrcLoc ( unLoc ) import GHC.Utils.Outputable import GHC.Utils.Panic @@ -291,7 +293,7 @@ mkIface_ hsc_env -- The order of fixities returned from nonDetNameEnvElts is not -- deterministic, so we sort by OccName to canonicalize it. -- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM for more details. - warns = src_warns + warns = toIfaceWarnings src_warns iface_rules = map coreRuleToIfaceRule rules iface_insts = map instanceToIfaceInst $ fixSafeInstances safe_mode (instEnvElts insts) iface_fam_insts = map famInstToIfaceFamInst fam_insts @@ -393,6 +395,21 @@ ifaceRoughMatchTcs tcs = map do_rough tcs do_rough (RM_KnownTc n) = Just (toIfaceTyCon_name n) -------------------------- +toIfaceWarnings :: Warnings GhcRn -> IfaceWarnings +toIfaceWarnings NoWarnings = IfNoWarnings +toIfaceWarnings (WarnAll txt) = IfWarnAll (toIfaceWarningTxt txt) +toIfaceWarnings (WarnSome prs) = IfWarnSome [(occ, toIfaceWarningTxt txt) | (occ, txt) <- prs] + +toIfaceWarningTxt :: WarningTxt GhcRn -> IfaceWarningTxt +toIfaceWarningTxt (WarningTxt mb_cat src strs) = IfWarningTxt (unLoc <$> mb_cat) (unLoc src) (map (toIfaceStringLiteralWithNames . unLoc) strs) +toIfaceWarningTxt (DeprecatedTxt src strs) = IfDeprecatedTxt (unLoc src) (map (toIfaceStringLiteralWithNames . unLoc) strs) + +toIfaceStringLiteralWithNames :: WithHsDocIdentifiers StringLiteral GhcRn -> (IfaceStringLiteral, [IfExtName]) +toIfaceStringLiteralWithNames (WithHsDocIdentifiers src names) = (toIfaceStringLiteral src, map unLoc names) + +toIfaceStringLiteral :: StringLiteral -> IfaceStringLiteral +toIfaceStringLiteral (StringLiteral sl fs _) = IfStringLiteral sl fs + coreRuleToIfaceRule :: CoreRule -> IfaceRule -- A plugin that installs a BuiltinRule in a CoreDoPluginPass should -- ensure that there's another CoreDoPluginPass that removes the rule. ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -962,7 +962,7 @@ addFingerprints hsc_env iface0 eps <- hscEPS hsc_env let decls = mi_decls iface0 - warn_fn = mkIfaceWarnCache (mi_warns iface0) + warn_fn = mkIfaceWarnCache (fromIfaceWarnings $ mi_warns iface0) fix_fn = mkIfaceFixCache (mi_fixities iface0) -- The ABI of a declaration represents everything that is made ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -16,6 +16,7 @@ module GHC.Iface.Syntax ( IfaceBindingX(..), IfaceMaybeRhs(..), IfaceConAlt(..), IfaceIdInfo, IfaceIdDetails(..), IfaceUnfolding(..), IfGuidance(..), IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget, + IfaceWarnings(..), IfaceWarningTxt(..), IfaceStringLiteral(..), IfaceClsInst(..), IfaceFamInst(..), IfaceTickish(..), IfaceClassBody(..), IfaceBang(..), @@ -32,6 +33,7 @@ module GHC.Iface.Syntax ( -- Misc ifaceDeclImplicitBndrs, visibleIfConDecls, ifaceDeclFingerprints, + fromIfaceWarnings, -- Free Names freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst, @@ -65,13 +67,17 @@ import GHC.Types.ForeignCall import GHC.Types.Annotations( AnnPayload, AnnTarget ) import GHC.Types.Basic import GHC.Unit.Module +import GHC.Unit.Module.Warnings import GHC.Types.SrcLoc +import GHC.Types.SourceText import GHC.Data.BooleanFormula ( BooleanFormula, pprBooleanFormula, isTrue ) import GHC.Types.Var( VarBndr(..), binderVar, tyVarSpecToBinders, visArgTypeLike ) import GHC.Core.TyCon ( Role (..), Injectivity(..), tyConBndrVisForAllTyFlag ) import GHC.Core.DataCon (SrcStrictness(..), SrcUnpackedness(..)) import GHC.Builtin.Types ( constraintKindTyConName ) import GHC.Stg.InferTags.TagSig +import GHC.Hs.Extension ( GhcRn ) +import GHC.Hs.Doc ( WithHsDocIdentifiers(..) ) import GHC.Utils.Lexeme (isLexSym) import GHC.Utils.Fingerprint @@ -323,6 +329,18 @@ data IfaceRule ifRuleOrph :: IsOrphan -- Just like IfaceClsInst } +data IfaceWarnings + = IfNoWarnings + | IfWarnAll IfaceWarningTxt + | IfWarnSome [(OccName, IfaceWarningTxt)] + +data IfaceWarningTxt + = IfWarningTxt (Maybe WarningCategory) SourceText [(IfaceStringLiteral, [IfExtName])] + | IfDeprecatedTxt SourceText [(IfaceStringLiteral, [IfExtName])] + +data IfaceStringLiteral + = IfStringLiteral SourceText FastString + data IfaceAnnotation = IfaceAnnotation { ifAnnotatedTarget :: IfaceAnnTarget, @@ -549,6 +567,24 @@ ifaceDeclFingerprints hash decl unsafeDupablePerformIO . computeFingerprint (panic "ifaceDeclFingerprints") +fromIfaceWarnings :: IfaceWarnings -> Warnings GhcRn +fromIfaceWarnings = \case + IfNoWarnings -> NoWarnings + IfWarnAll txt -> WarnAll (fromIfaceWarningTxt txt) + IfWarnSome prs -> WarnSome [(occ, fromIfaceWarningTxt txt) | (occ, txt) <- prs] + +fromIfaceWarningTxt :: IfaceWarningTxt -> WarningTxt GhcRn +fromIfaceWarningTxt = \case + IfWarningTxt mb_cat src strs -> WarningTxt (noLoc <$> mb_cat) (noLoc src) (noLoc <$> map fromIfaceStringLiteralWithNames strs) + IfDeprecatedTxt src strs -> DeprecatedTxt (noLoc src) (noLoc <$> map fromIfaceStringLiteralWithNames strs) + +fromIfaceStringLiteralWithNames :: (IfaceStringLiteral, [IfExtName]) -> WithHsDocIdentifiers StringLiteral GhcRn +fromIfaceStringLiteralWithNames (str, names) = WithHsDocIdentifiers (fromIfaceStringLiteral str) (map noLoc names) + +fromIfaceStringLiteral :: IfaceStringLiteral -> StringLiteral +fromIfaceStringLiteral (IfStringLiteral st fs) = StringLiteral st fs Nothing + + {- ************************************************************************ * * @@ -700,6 +736,23 @@ pprAxBranch pp_tc idx (IfaceAxBranch { ifaxbTyVars = tvs text "--" <+> text "incompatible with:" <+> pprWithCommas (\incomp -> text "#" <> ppr incomp) incomps +instance Outputable IfaceWarnings where + ppr = \case + IfNoWarnings -> empty + IfWarnAll txt -> text "Warn all" <+> ppr txt + IfWarnSome prs -> text "Warnings:" <+> vcat [ppr name <+> ppr txt | (name, txt) <- prs] + +instance Outputable IfaceWarningTxt where + ppr = \case + IfWarningTxt _ _ ws -> pp_ws ws + IfDeprecatedTxt _ ds -> pp_ws ds + where + pp_ws [msg] = ppr (fst msg) + pp_ws msgs = brackets $ vcat . punctuate comma . map (ppr . fst) $ msgs + +instance Outputable IfaceStringLiteral where + ppr (IfStringLiteral st fs) = pprWithSourceText st (ftext fs) + instance Outputable IfaceAnnotation where ppr (IfaceAnnotation target value) = ppr target <+> colon <+> ppr value @@ -2236,6 +2289,28 @@ instance Binary IfaceRule where a8 <- get bh return (IfaceRule a1 a2 a3 a4 a5 a6 a7 a8) +instance Binary IfaceWarnings where + put_ bh = \case + IfNoWarnings -> putByte bh 0 + IfWarnAll txt -> putByte bh 1 *> put_ bh txt + IfWarnSome prs -> putByte bh 2 *> put_ bh prs + get bh = getByte bh >>= \case + 0 -> pure IfNoWarnings + 1 -> pure IfWarnAll <*> get bh + _ -> pure IfWarnSome <*> get bh + +instance Binary IfaceWarningTxt where + put_ bh = \case + IfWarningTxt a1 a2 a3 -> putByte bh 0 *> put_ bh a1 *> put_ bh a2 *> put_ bh a3 + IfDeprecatedTxt a1 a2 -> putByte bh 1 *> put_ bh a1 *> put_ bh a2 + get bh = getByte bh >>= \case + 0 -> pure IfWarningTxt <*> get bh <*> get bh <*> get bh + _ -> pure IfDeprecatedTxt <*> get bh <*> get bh + +instance Binary IfaceStringLiteral where + put_ bh (IfStringLiteral a1 a2) = put_ bh a1 *> put_ bh a2 + get bh = IfStringLiteral <$> get bh <*> get bh + instance Binary IfaceAnnotation where put_ bh (IfaceAnnotation a1 a2) = do put_ bh a1 @@ -2786,5 +2861,19 @@ instance NFData IfaceClsInst where rnf (IfaceClsInst f1 f2 f3 f4 f5) = f1 `seq` rnf f2 `seq` rnf f3 `seq` f4 `seq` f5 `seq` () +instance NFData IfaceWarnings where + rnf = \case + IfNoWarnings -> () + IfWarnAll txt -> rnf txt + IfWarnSome txts -> rnf txts + +instance NFData IfaceWarningTxt where + rnf = \case + IfWarningTxt f1 f2 f3 -> rnf f1 `seq` rnf f2 `seq` rnf f3 + IfDeprecatedTxt f1 f2 -> rnf f1 `seq` rnf f2 + +instance NFData IfaceStringLiteral where + rnf (IfStringLiteral f1 f2) = rnf f1 `seq` rnf f2 + instance NFData IfaceAnnotation where rnf (IfaceAnnotation f1 f2) = f1 `seq` f2 `seq` () ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -47,6 +47,7 @@ import GHC.Tc.Zonk.TcType ( tcInitTidyEnv ) import GHC.Hs import GHC.Iface.Load ( loadSrcInterface ) +import GHC.Iface.Syntax ( fromIfaceWarnings ) import GHC.Builtin.Names import GHC.Parser.PostProcess ( setRdrNameSpace ) import GHC.Core.Type @@ -422,7 +423,7 @@ rnImportDecl this_mod imports = calculateAvails home_unit other_home_units iface mod_safe' want_boot (ImportedByUser imv) -- Complain if we import a deprecated module - case mi_warns iface of + case fromIfaceWarnings (mi_warns iface) of WarnAll txt -> addDiagnostic (TcRnDeprecatedModule imp_mod_name txt) _ -> return () ===================================== compiler/GHC/Types/SourceText.hs ===================================== @@ -1,5 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RecordWildCards #-} -- | Source text -- @@ -39,6 +41,7 @@ import Data.Function (on) import Data.Data import GHC.Real ( Ratio(..) ) import GHC.Types.SrcLoc +import Control.DeepSeq {- Note [Pragma source text] @@ -107,6 +110,11 @@ instance Outputable SourceText where ppr (SourceText s) = text "SourceText" <+> ftext s ppr NoSourceText = text "NoSourceText" +instance NFData SourceText where + rnf = \case + SourceText s -> rnf s + NoSourceText -> () + instance Binary SourceText where put_ bh NoSourceText = putByte bh 0 put_ bh (SourceText s) = do @@ -315,12 +323,3 @@ instance Eq StringLiteral where instance Outputable StringLiteral where ppr sl = pprWithSourceText (sl_st sl) (ftext $ sl_fs sl) - -instance Binary StringLiteral where - put_ bh (StringLiteral st fs _) = do - put_ bh st - put_ bh fs - get bh = do - st <- get bh - fs <- get bh - return (StringLiteral st fs Nothing) ===================================== compiler/GHC/Unit/Module/ModIface.hs ===================================== @@ -185,7 +185,7 @@ data ModIface_ (phase :: ModIfacePhase) -- ^ Fixities -- NOT STRICT! we read this field lazily from the interface file - mi_warns :: (Warnings GhcRn), + mi_warns :: IfaceWarnings, -- ^ Warnings -- NOT STRICT! we read this field lazily from the interface file @@ -479,7 +479,7 @@ instance Binary ModIface where mi_finsts = hasFamInsts, mi_exp_hash = exp_hash, mi_orphan_hash = orphan_hash, - mi_warn_fn = mkIfaceWarnCache warns, + mi_warn_fn = mkIfaceWarnCache $ fromIfaceWarnings warns, mi_fix_fn = mkIfaceFixCache fixities, mi_hash_fn = mkIfaceHashCache decls }}) @@ -498,7 +498,7 @@ emptyPartialModIface mod mi_exports = [], mi_used_th = False, mi_fixities = [], - mi_warns = NoWarnings, + mi_warns = IfNoWarnings, mi_anns = [], mi_insts = [], mi_fam_insts = [], @@ -567,7 +567,7 @@ instance ( NFData (IfaceBackendExts (phase :: ModIfacePhase)) `seq` mi_exports `seq` rnf mi_used_th `seq` mi_fixities - `seq` mi_warns + `seq` rnf mi_warns `seq` rnf mi_anns `seq` rnf mi_decls `seq` rnf mi_extra_decls ===================================== compiler/GHC/Unit/Module/Warnings.hs ===================================== @@ -5,6 +5,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE LambdaCase #-} -- | Warnings for a module module GHC.Unit.Module.Warnings @@ -40,7 +41,6 @@ import GHC.Types.SrcLoc import GHC.Types.Unique import GHC.Types.Unique.Set import GHC.Hs.Doc -import GHC.Hs.Extension import GHC.Utils.Outputable import GHC.Utils.Binary @@ -51,6 +51,7 @@ import Language.Haskell.Syntax.Extension import Data.Data import Data.List (isPrefixOf) import GHC.Generics ( Generic ) +import Control.DeepSeq {- @@ -103,7 +104,7 @@ the possibility of them being infinite. -- See Note [Warning categories] newtype WarningCategory = WarningCategory FastString - deriving (Binary, Data, Eq, Outputable, Show, Uniquable) + deriving (Binary, Data, Eq, Outputable, Show, Uniquable, NFData) mkWarningCategory :: FastString -> WarningCategory mkWarningCategory = WarningCategory @@ -203,29 +204,6 @@ instance Outputable (WarningTxt pass) where NoSourceText -> pp_ws ds SourceText src -> ftext src <+> pp_ws ds <+> text "#-}" -instance Binary (WarningTxt GhcRn) where - put_ bh (WarningTxt c s w) = do - putByte bh 0 - put_ bh $ unLoc <$> c - put_ bh $ unLoc s - put_ bh $ unLoc <$> w - put_ bh (DeprecatedTxt s d) = do - putByte bh 1 - put_ bh $ unLoc s - put_ bh $ unLoc <$> d - - get bh = do - h <- getByte bh - case h of - 0 -> do c <- fmap noLoc <$> get bh - s <- noLoc <$> get bh - w <- fmap noLoc <$> get bh - return (WarningTxt c s w) - _ -> do s <- noLoc <$> get bh - d <- fmap noLoc <$> get bh - return (DeprecatedTxt s d) - - pp_ws :: [Located (WithHsDocIdentifiers StringLiteral pass)] -> SDoc pp_ws [l] = ppr $ unLoc l pp_ws ws @@ -271,24 +249,6 @@ data Warnings pass deriving instance Eq (IdP pass) => Eq (Warnings pass) -instance Binary (Warnings GhcRn) where - put_ bh NoWarnings = putByte bh 0 - put_ bh (WarnAll t) = do - putByte bh 1 - put_ bh t - put_ bh (WarnSome ts) = do - putByte bh 2 - put_ bh ts - - get bh = do - h <- getByte bh - case h of - 0 -> return NoWarnings - 1 -> do aa <- get bh - return (WarnAll aa) - _ -> do aa <- get bh - return (WarnSome aa) - -- | Constructs the cache for the 'mi_warn_fn' field of a 'ModIface' mkIfaceWarnCache :: Warnings p -> OccName -> Maybe (WarningTxt p) mkIfaceWarnCache NoWarnings = \_ -> Nothing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8e14d2ab9cfae9eb5029f6b8c62ee604e738dfe8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8e14d2ab9cfae9eb5029f6b8c62ee604e738dfe8 You're receiving 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 Jun 15 07:10:42 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 15 Jun 2023 03:10:42 -0400 Subject: [Git][ghc/ghc][master] compiler: Cross-reference Note [StgToJS design] Message-ID: <648ab9722b41f_c7397ae8ab34283578@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - 2 changed files: - compiler/GHC/StgToJS/Prim.hs - rts/js/arith.js Changes: ===================================== compiler/GHC/StgToJS/Prim.hs ===================================== @@ -56,6 +56,9 @@ genPrim prof bound ty op = case op of ------------------------------ Int ---------------------------------------------- +-- N.B. See Note [StgToJS design] in GHC.StgToJS for details on +-- number representation. + IntAddOp -> \[r] [x,y] -> PrimInline $ r |= toI32 (Add x y) IntSubOp -> \[r] [x,y] -> PrimInline $ r |= toI32 (Sub x y) IntMulOp -> \[r] [x,y] -> PrimInline $ r |= app "Math.imul" [x, y] ===================================== rts/js/arith.js ===================================== @@ -21,6 +21,12 @@ function h$logArith() { h$log.apply(h$log,arguments); } #define RETURN_W64(x) RETURN_UBX_TUP2(W64h(x), W64l(x)) #define RETURN_W32(x) return Number(x) + +// N.B. 64-bit numbers are represented by two JS numbers, +// each of which can represent a 32-bit integer precisely. +// See Note [StgToJS design] in GHC.StgToJS for details on +// number representation. + function h$hs_quotWord64(h1,l1,h2,l2) { var a = W64(h1,l1); var b = W64(h2,l2); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8f27023b1f465e44ea02e1b6ac7b7b04c632cc5e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8f27023b1f465e44ea02e1b6ac7b7b04c632cc5e You're receiving 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 Jun 15 07:11:24 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 15 Jun 2023 03:11:24 -0400 Subject: [Git][ghc/ghc][master] Implement the -Wimplicit-rhs-quantification warning (#23510) Message-ID: <648ab99c31b64_c7397acb36bc287418@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 19 changed files: - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - docs/users_guide/using-warnings.rst - testsuite/tests/dependent/should_compile/T16391a.hs - testsuite/tests/ghci/scripts/ghci024.stdout - testsuite/tests/ghci/scripts/ghci024.stdout-mingw32 - + testsuite/tests/rename/should_compile/T23510b.hs - testsuite/tests/rename/should_compile/all.T - + testsuite/tests/rename/should_fail/T23510a.hs - + testsuite/tests/rename/should_fail/T23510a.stderr - testsuite/tests/rename/should_fail/all.T - testsuite/tests/typecheck/should_compile/T13343.hs Changes: ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -646,6 +646,7 @@ data WarningFlag = | Opt_WarnLoopySuperclassSolve -- Since 9.6 | Opt_WarnTermVariableCapture -- Since 9.8 | Opt_WarnMissingRoleAnnotations -- Since 9.8 + | Opt_WarnImplicitRhsQuantification -- Since 9.8 deriving (Eq, Ord, Show, Enum) -- | Return the names of a WarningFlag @@ -754,6 +755,7 @@ warnFlagNames wflag = case wflag of Opt_WarnLoopySuperclassSolve -> "loopy-superclass-solve" :| [] Opt_WarnTypeEqualityRequiresOperators -> "type-equality-requires-operators" :| [] Opt_WarnMissingRoleAnnotations -> "missing-role-annotations" :| [] + Opt_WarnImplicitRhsQuantification -> "implicit-rhs-quantification" :| [] -- ----------------------------------------------------------------------------- -- Standard sets of warning options @@ -945,6 +947,7 @@ minusWcompatOpts , Opt_WarnNonCanonicalMonadInstances , Opt_WarnCompatUnqualifiedImports , Opt_WarnTypeEqualityOutOfScope + , Opt_WarnImplicitRhsQuantification ] -- | Things you get with -Wunused-binds ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2270,7 +2270,8 @@ wWarningFlagsDeps = mconcat [ warnSpec Opt_WarnTypeEqualityOutOfScope, warnSpec Opt_WarnTypeEqualityRequiresOperators, warnSpec Opt_WarnTermVariableCapture, - warnSpec Opt_WarnMissingRoleAnnotations + warnSpec Opt_WarnMissingRoleAnnotations, + warnSpec Opt_WarnImplicitRhsQuantification ] warningGroupsDeps :: [(Deprecation, FlagSpec WarningGroup)] ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -918,8 +918,8 @@ bindHsQTyVars :: forall a b. -> Maybe a -- Just _ => an associated type decl -> FreeKiTyVars -- Kind variables from scope -> LHsQTyVars GhcPs - -> (LHsQTyVars GhcRn -> Bool -> RnM (b, FreeVars)) - -- The Bool is True <=> all kind variables used in the + -> (LHsQTyVars GhcRn -> FreeKiTyVars -> RnM (b, FreeVars)) + -- The FreeKiTyVars is null <=> all kind variables used in the -- kind signature are bound on the left. Reason: -- the last clause of Note [CUSKs: complete user-supplied kind signatures] -- in GHC.Hs.Decls @@ -942,7 +942,6 @@ bindHsQTyVars doc mb_assoc body_kv_occs hsq_bndrs thing_inside bndr_kv_occs ++ body_kv_occs body_remaining = filterFreeVarsToBind bndr_kv_occs $ filterFreeVarsToBind bndrs body_kv_occs - all_bound_on_lhs = null body_remaining ; traceRn "checkMixedVars3" $ vcat [ text "bndrs" <+> ppr hs_tv_bndrs @@ -969,7 +968,7 @@ bindHsQTyVars doc mb_assoc body_kv_occs hsq_bndrs thing_inside ; traceRn "bindHsQTyVars" (ppr hsq_bndrs $$ ppr implicit_kv_nms $$ ppr rn_bndrs) ; thing_inside (HsQTvs { hsq_ext = implicit_kv_nms , hsq_explicit = rn_bndrs }) - all_bound_on_lhs } } + body_remaining } } where hs_tv_bndrs = hsQTvExplicit hsq_bndrs @@ -1802,12 +1801,15 @@ one exists: The logic resides in extractHsTyRdrTyVarsKindVars. We use it both for type synonyms and type family instances. -This is something of a stopgap solution until we can explicitly bind invisible +This was a stopgap solution until we could explicitly bind invisible type/kind variables: type TySyn3 :: forall a. Maybe a type TySyn3 @a = 'Just ('Nothing :: Maybe a) +Now that the new syntax was proposed in #425 and implemented in 9.8, we issue a warning +-Wimplicit-rhs-quantification for TySyn2 and TySyn4 and will eventually disallow them. + Note [Implicit quantification in type synonyms: non-taken alternatives] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -1709,11 +1709,16 @@ rnTyClDecl (SynDecl { tcdLName = tycon, tcdTyVars = tyvars, ; let kvs = extractHsTyRdrTyVarsKindVars rhs doc = TySynCtx tycon ; traceRn "rntycl-ty" (ppr tycon <+> ppr kvs) - ; bindHsQTyVars doc Nothing kvs tyvars $ \ tyvars' _ -> - do { (rhs', fvs) <- rnTySyn doc rhs + ; bindHsQTyVars doc Nothing kvs tyvars $ \ tyvars' free_rhs_kvs -> + do { mapM_ warn_implicit_kvs (nubL free_rhs_kvs) + ; (rhs', fvs) <- rnTySyn doc rhs ; return (SynDecl { tcdLName = tycon', tcdTyVars = tyvars' , tcdFixity = fixity , tcdRhs = rhs', tcdSExt = fvs }, fvs) } } + where + warn_implicit_kvs :: LocatedN RdrName -> RnM () + warn_implicit_kvs kv = + addDiagnosticAt (getLocA kv) (TcRnImplicitRhsQuantification kv) -- "data", "newtype" declarations rnTyClDecl (DataDecl @@ -1725,12 +1730,12 @@ rnTyClDecl (DataDecl doc = TyDataCtx tycon new_or_data = dataDefnConsNewOrData cons ; traceRn "rntycl-data" (ppr tycon <+> ppr kvs) - ; bindHsQTyVars doc Nothing kvs tyvars $ \ tyvars' no_rhs_kvs -> + ; bindHsQTyVars doc Nothing kvs tyvars $ \ tyvars' free_rhs_kvs -> do { (defn', fvs) <- rnDataDefn doc defn - ; cusk <- data_decl_has_cusk tyvars' new_or_data no_rhs_kvs kind_sig + ; cusk <- data_decl_has_cusk tyvars' new_or_data (null free_rhs_kvs) kind_sig ; let rn_info = DataDeclRn { tcdDataCusk = cusk , tcdFVs = fvs } - ; traceRn "rndata" (ppr tycon <+> ppr cusk <+> ppr no_rhs_kvs) + ; traceRn "rndata" (ppr tycon <+> ppr cusk <+> ppr free_rhs_kvs) ; return (DataDecl { tcdLName = tycon' , tcdTyVars = tyvars' , tcdFixity = fixity ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -1851,6 +1851,11 @@ instance Diagnostic TcRnMessage where , text "or a complete user-supplied kind (CUSK, legacy feature)" , text "is required to use invisible binders." ] + TcRnImplicitRhsQuantification kv -> mkSimpleDecorated $ + vcat [ text "The variable" <+> quotes (ppr kv) <+> text "occurs free on the RHS of the type declaration" + , text "In the future GHC will no longer implicitly quantify over such variables" + ] + diagnosticReason = \case TcRnUnknownMessage m -> diagnosticReason m @@ -2467,6 +2472,8 @@ instance Diagnostic TcRnMessage where -> ErrorWithoutFlag TcRnInvisBndrWithoutSig{} -> ErrorWithoutFlag + TcRnImplicitRhsQuantification{} + -> WarningWithFlag Opt_WarnImplicitRhsQuantification diagnosticHints = \case TcRnUnknownMessage m @@ -3130,6 +3137,8 @@ instance Diagnostic TcRnMessage where -> noHints TcRnInvisBndrWithoutSig name _ -> [SuggestAddStandaloneKindSignature name] + TcRnImplicitRhsQuantification kv + -> [SuggestBindTyVarOnLhs (unLoc kv)] diagnosticCode :: TcRnMessage -> Maybe DiagnosticCode diagnosticCode = constructorCode ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -4096,6 +4096,23 @@ data TcRnMessage where -} TcRnMissingRoleAnnotation :: Name -> [Role] -> TcRnMessage + {-| TcRnImplicitRhsQuantification is a warning that occurs when GHC implicitly + quantifies over a type variable that occurs free on the RHS of the type declaration + that is not mentioned on the LHS + + Example: + + type T = 'Nothing :: Maybe a + + Controlled by flags: + - Wimplicit-rhs-quantification + + Test cases: + T23510a + T23510b + -} + TcRnImplicitRhsQuantification :: LocatedN RdrName -> TcRnMessage + deriving Generic ===================================== compiler/GHC/Types/Error/Codes.hs ===================================== @@ -591,6 +591,7 @@ type family GhcDiagnosticCode c = n | n -> c where GhcDiagnosticCode "TcRnArityMismatch" = 27346 GhcDiagnosticCode "TcRnSimplifiableConstraint" = 62412 GhcDiagnosticCode "TcRnIllegalQuasiQuotes" = 77343 + GhcDiagnosticCode "TcRnImplicitRhsQuantification" = 16382 -- TcRnTypeApplicationsDisabled GhcDiagnosticCode "TypeApplication" = 23482 ===================================== compiler/GHC/Types/Hint.hs ===================================== @@ -465,6 +465,9 @@ data GhcHint {-| Suggest eta-reducing a type synonym used in the implementation of abstract data. -} | SuggestEtaReduceAbsDataTySyn TyCon + {-| Suggest binding the type variable on the LHS of the type declaration + -} + | SuggestBindTyVarOnLhs RdrName -- | An 'InstantiationSuggestion' for a '.hsig' file. This is generated -- by GHC in case of a 'DriverUnexpectedSignature' and suggests a way ===================================== compiler/GHC/Types/Hint/Ppr.hs ===================================== @@ -251,6 +251,8 @@ instance Outputable GhcHint where SuggestEtaReduceAbsDataTySyn tc -> text "If possible, eta-reduce the type synonym" <+> ppr_tc <+> text "so that it is nullary." where ppr_tc = quotes (ppr $ tyConName tc) + SuggestBindTyVarOnLhs tv + -> text "Bind" <+> quotes (ppr tv) <+> text "on the LHS of the type declaration" perhapsAsPat :: SDoc perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace" ===================================== docs/users_guide/using-warnings.rst ===================================== @@ -166,6 +166,7 @@ as ``-Wno-...`` for every individual warning in the group. * :ghc-flag:`-Wnoncanonical-monad-instances` * :ghc-flag:`-Wcompat-unqualified-imports` * :ghc-flag:`-Wtype-equality-out-of-scope` + * :ghc-flag:`-Wimplicit-rhs-quantification` .. ghc-flag:: -w :shortdesc: disable all warnings @@ -2440,6 +2441,28 @@ of ``-W(no-)*``. In other words the type-class role cannot be accidentally left representational or phantom, which could affected the code correctness. +.. ghc-flag:: -Wimplicit-rhs-quantification + :shortdesc: warn when type variables on the RHS of a type synonym are implicitly quantified + :type: dynamic + :reverse: -Wno-implicit-rhs-quantification + :category: + + :since: 9.8 + :default: off + + In accordance with `GHC Proposal #425 + `__, + GHC will stop implicitly quantifying over type variables that occur free on the + right-hand side of a type synonym but are not mentioned on the left-hand side. + Type synonym declarations that rely on this form of quantification should be rewritten with invisible binders. + + For example: :: + + type T1 :: forall a . Maybe a + type T1 = 'Nothing :: Maybe a -- old + type T1 @a = 'Nothing :: Maybe a -- new + + This warning detects code that will be affected by this breaking change. If you're feeling really paranoid, the :ghc-flag:`-dcore-lint` option is a good choice. It turns on heavyweight intra-pass sanity-checking within GHC. (It checks GHC's ===================================== testsuite/tests/dependent/should_compile/T16391a.hs ===================================== @@ -9,7 +9,8 @@ import Data.Kind type Const (a :: Type) (b :: Type) = a type family F :: Const Type a where F = Int -type TS = (Int :: Const Type a) +type TS :: forall a . Const Type a +type TS @a = (Int :: Const Type a) data T1 :: Const Type a where MkT1 :: T1 data T2 :: Const Type a -> Type where ===================================== testsuite/tests/ghci/scripts/ghci024.stdout ===================================== @@ -18,6 +18,7 @@ warning settings: -Wsemigroup -Wcompat-unqualified-imports -Wtype-equality-out-of-scope + -Wimplicit-rhs-quantification ~~~~~~~~~~ Testing :set -a options currently set: none. base language is: GHC2021 ===================================== testsuite/tests/ghci/scripts/ghci024.stdout-mingw32 ===================================== @@ -17,6 +17,7 @@ warning settings: -Wsemigroup -Wcompat-unqualified-imports -Wtype-equality-out-of-scope + -Wimplicit-rhs-quantification ~~~~~~~~~~ Testing :set -a options currently set: none. base language is: GHC2021 ===================================== testsuite/tests/rename/should_compile/T23510b.hs ===================================== @@ -0,0 +1,14 @@ +{-# OPTIONS -Wimplicit-rhs-quantification #-} +{-# LANGUAGE DataKinds, TypeAbstractions #-} +module T23510b where + +import Data.Proxy + +type T1 :: forall k . Maybe k +type T1 @a = 'Nothing :: Maybe a + +type T2 :: forall k j . k -> Either k j +type T2 @a @b = 'Left :: a -> Either a b + +type T3 :: forall {k} (d :: k) . Proxy k +type T3 @(a :: k) = 'Proxy :: Proxy k ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -212,3 +212,4 @@ test('T22122', [expect_broken(22122), extra_files(['T22122_aux.hs'])], multimod_ test('T23240', [req_th, extra_files(['T23240_aux.hs'])], multimod_compile, ['T23240', '-v0']) test('T23318', normal, compile, ['-Wduplicate-exports']) test('T23434', normal, compile, ['']) +test('T23510b', normal, compile, ['']) ===================================== testsuite/tests/rename/should_fail/T23510a.hs ===================================== @@ -0,0 +1,17 @@ +{-# OPTIONS -Wimplicit-rhs-quantification #-} +{-# LANGUAGE DataKinds #-} +module T23510a where + +import Data.Proxy +import GHC.Types + +type T1 = 'Nothing :: Maybe a + +type T2 = 'Left :: a -> Either a b + +type T3 = 'Proxy :: Proxy k + +type Const (a :: Type) (b :: Type) = a +type TS = (Int :: Const Type a) + +type Bad = (forall (v1 :: RuntimeRep) (a1 :: TYPE v). a1) :: TYPE v ===================================== testsuite/tests/rename/should_fail/T23510a.stderr ===================================== @@ -0,0 +1,30 @@ + +T23510a.hs:8:29: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘a’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘a’ on the LHS of the type declaration + +T23510a.hs:10:20: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘a’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘a’ on the LHS of the type declaration + +T23510a.hs:10:34: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘b’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘b’ on the LHS of the type declaration + +T23510a.hs:12:27: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘k’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘k’ on the LHS of the type declaration + +T23510a.hs:15:30: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘a’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘a’ on the LHS of the type declaration + +T23510a.hs:17:67: error: [GHC-16382] [-Wimplicit-rhs-quantification (in -Wcompat), Werror=implicit-rhs-quantification] + The variable ‘v’ occurs free on the RHS of the type declaration + In the future GHC will no longer implicitly quantify over such variables + Suggested fix: Bind ‘v’ on the LHS of the type declaration ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -199,3 +199,4 @@ test('RnUnexpectedStandaloneDeriving', normal, compile_fail, ['']) test('RnStupidThetaInGadt', normal, compile_fail, ['']) test('PackageImportsDisabled', normal, compile_fail, ['']) test('ImportLookupIllegal', normal, compile_fail, ['']) +test('T23510a', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_compile/T13343.hs ===================================== @@ -4,6 +4,7 @@ module Bug where import GHC.Exts -type Bad = (forall (v1 :: RuntimeRep) (a1 :: TYPE v). a1) :: TYPE v +type Bad :: forall v . TYPE v +type Bad @v = (forall (v1 :: RuntimeRep) (a1 :: TYPE v). a1) :: TYPE v --- should be accepted because GHC will generalize over v. Note v /= v1. +-- Note v /= v1. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a71b60e923806fa696d734aa82d465682188b6d4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a71b60e923806fa696d734aa82d465682188b6d4 You're receiving 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 Jun 15 07:11:55 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 15 Jun 2023 03:11:55 -0400 Subject: [Git][ghc/ghc][master] Minor refactorings to mkSpillInstr and mkLoadInstr Message-ID: <648ab9bbb1b27_c73971657018c2912de@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1 changed file: - compiler/GHC/CmmToAsm/AArch64/Instr.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -369,13 +369,13 @@ mkSpillInstr -> [Instr] mkSpillInstr config reg delta slot = - case (spillSlotToOffset config slot) - delta of + case off - delta of imm | -256 <= imm && imm <= 255 -> [ mkStrSp imm ] imm | imm > 0 && imm .&. 0x7 == 0x0 && imm <= 0xfff -> [ mkStrSp imm ] imm | imm > 0xfff && imm <= 0xffffff && imm .&. 0x7 == 0x0 -> [ mkIp0SpillAddr (imm .&~. 0xfff) , mkStrIp0 (imm .&. 0xfff) ] - imm -> pprPanic "mkSpillInstr" (text "Unable to spill into" <+> int imm) + imm -> pprPanic "mkSpillInstr" (text "Unable to spill register into" <+> int imm) where a .&~. b = a .&. (complement b) @@ -396,13 +396,13 @@ mkLoadInstr -> [Instr] mkLoadInstr config reg delta slot = - case (spillSlotToOffset config slot) - delta of + case off - delta of imm | -256 <= imm && imm <= 255 -> [ mkLdrSp imm ] imm | imm > 0 && imm .&. 0x7 == 0x0 && imm <= 0xfff -> [ mkLdrSp imm ] imm | imm > 0xfff && imm <= 0xffffff && imm .&. 0x7 == 0x0 -> [ mkIp0SpillAddr (imm .&~. 0xfff) , mkLdrIp0 (imm .&. 0xfff) ] - imm -> pprPanic "mkSpillInstr" (text "Unable to spill into" <+> int imm) + imm -> pprPanic "mkLoadInstr" (text "Unable to load spilled register at" <+> int imm) where a .&~. b = a .&. (complement b) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0078dd007535c8c81384a771e79f59efb4d5b382 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0078dd007535c8c81384a771e79f59efb4d5b382 You're receiving 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 Jun 15 07:12:47 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 15 Jun 2023 03:12:47 -0400 Subject: [Git][ghc/ghc][master] JS: merge util modules Message-ID: <648ab9efb8ee1_c7397166dedac2960c9@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 14 changed files: - compiler/GHC/JS/Make.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Arg.hs - compiler/GHC/StgToJS/Closure.hs - compiler/GHC/StgToJS/CodeGen.hs - − compiler/GHC/StgToJS/CoreUtils.hs - compiler/GHC/StgToJS/DataCon.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Ids.hs - compiler/GHC/StgToJS/Sinker.hs - − compiler/GHC/StgToJS/StgUtils.hs - compiler/GHC/StgToJS/Utils.hs - compiler/ghc.cabal.in Changes: ===================================== compiler/GHC/JS/Make.hs ===================================== @@ -36,7 +36,7 @@ -- construct new terms in the EDSL. Crucially, missing from this module are -- corresponding /elimination/ or /destructing/ functions which would -- project information from the EDSL back to Haskell. See --- 'GHC.StgToJS.UnitUtils' and 'GHC.StgToJS.CoreUtils' for such functions. +-- 'GHC.StgToJS.Utils' for such functions. -- -- * /Introduction/ functions -- ===================================== compiler/GHC/StgToJS/Apply.hs ===================================== @@ -39,7 +39,6 @@ import GHC.StgToJS.Monad import GHC.StgToJS.Types import GHC.StgToJS.Profiling import GHC.StgToJS.Regs -import GHC.StgToJS.CoreUtils import GHC.StgToJS.Utils import GHC.StgToJS.Rts.Types import GHC.StgToJS.Stack @@ -205,7 +204,7 @@ genApp ctx i args -- no args and Id can't be a function: just enter it | [] <- args , idFunRepArity i == 0 - , not (might_be_a_function (idType i)) + , not (mightBeAFunction (idType i)) = do enter_id <- genIdArg i >>= \case ===================================== compiler/GHC/StgToJS/Arg.hs ===================================== @@ -37,7 +37,7 @@ import GHC.StgToJS.DataCon import GHC.StgToJS.Types import GHC.StgToJS.Monad import GHC.StgToJS.Literal -import GHC.StgToJS.CoreUtils +import GHC.StgToJS.Utils import GHC.StgToJS.Profiling import GHC.StgToJS.Ids ===================================== compiler/GHC/StgToJS/Closure.hs ===================================== @@ -27,7 +27,7 @@ import GHC.Data.FastString import GHC.StgToJS.Heap import GHC.StgToJS.Types -import GHC.StgToJS.CoreUtils +import GHC.StgToJS.Utils import GHC.StgToJS.Regs (stack,sp) import GHC.JS.Make ===================================== compiler/GHC/StgToJS/CodeGen.hs ===================================== @@ -22,8 +22,7 @@ import GHC.StgToJS.Arg import GHC.StgToJS.Sinker import GHC.StgToJS.Types import qualified GHC.StgToJS.Object as Object -import GHC.StgToJS.StgUtils -import GHC.StgToJS.CoreUtils +import GHC.StgToJS.Utils import GHC.StgToJS.Deps import GHC.StgToJS.Expr import GHC.StgToJS.ExprCtx ===================================== compiler/GHC/StgToJS/CoreUtils.hs deleted ===================================== @@ -1,283 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} - --- | Core utils -module GHC.StgToJS.CoreUtils where - -import GHC.Prelude - -import GHC.JS.Unsat.Syntax -import GHC.JS.Transform - -import GHC.StgToJS.Types - -import GHC.Stg.Syntax - -import GHC.Tc.Utils.TcType - -import GHC.Builtin.Types -import GHC.Builtin.Types.Prim - -import GHC.Core.DataCon -import GHC.Core.TyCo.Rep -import GHC.Core.TyCon -import GHC.Core.Type - -import GHC.Types.RepType -import GHC.Types.Var -import GHC.Types.Id - -import GHC.Utils.Misc -import GHC.Utils.Outputable -import GHC.Utils.Panic - -import qualified Data.Bits as Bits - --- | can we unbox C x to x, only if x is represented as a Number -isUnboxableCon :: DataCon -> Bool -isUnboxableCon dc - | [t] <- dataConRepArgTys dc - , [t1] <- typeVt (scaledThing t) - = isUnboxable t1 && - dataConTag dc == 1 && - length (tyConDataCons $ dataConTyCon dc) == 1 - | otherwise = False - --- | one-constructor types with one primitive field represented as a JS Number --- can be unboxed -isUnboxable :: VarType -> Bool -isUnboxable DoubleV = True -isUnboxable IntV = True -- includes Char# -isUnboxable _ = False - --- | Number of slots occupied by a PrimRep -data SlotCount - = NoSlot - | OneSlot - | TwoSlots - deriving (Show,Eq,Ord) - -instance Outputable SlotCount where - ppr = text . show - --- | Return SlotCount as an Int -slotCount :: SlotCount -> Int -slotCount = \case - NoSlot -> 0 - OneSlot -> 1 - TwoSlots -> 2 - - --- | Number of slots occupied by a value with the given VarType -varSize :: VarType -> Int -varSize = slotCount . varSlotCount - -varSlotCount :: VarType -> SlotCount -varSlotCount VoidV = NoSlot -varSlotCount LongV = TwoSlots -- hi, low -varSlotCount AddrV = TwoSlots -- obj/array, offset -varSlotCount _ = OneSlot - -typeSize :: Type -> Int -typeSize t = sum . map varSize . typeVt $ t - -isVoid :: VarType -> Bool -isVoid VoidV = True -isVoid _ = False - -isPtr :: VarType -> Bool -isPtr PtrV = True -isPtr _ = False - -isSingleVar :: VarType -> Bool -isSingleVar v = varSlotCount v == OneSlot - -isMultiVar :: VarType -> Bool -isMultiVar v = case varSlotCount v of - NoSlot -> False - OneSlot -> False - TwoSlots -> True - --- | can we pattern match on these values in a case? -isMatchable :: [VarType] -> Bool -isMatchable [DoubleV] = True -isMatchable [IntV] = True -isMatchable _ = False - -tyConVt :: HasDebugCallStack => TyCon -> [VarType] -tyConVt = typeVt . mkTyConTy - -idVt :: HasDebugCallStack => Id -> [VarType] -idVt = typeVt . idType - -typeVt :: HasDebugCallStack => Type -> [VarType] -typeVt t | isRuntimeRepKindedTy t = [] -typeVt t = map primRepVt (typePrimRep t)-- map uTypeVt (repTypeArgs t) - --- only use if you know it's not an unboxed tuple -uTypeVt :: HasDebugCallStack => UnaryType -> VarType -uTypeVt ut - | isRuntimeRepKindedTy ut = VoidV --- | isRuntimeRepTy ut = VoidV - -- GHC panics on this otherwise - | Just (tc, ty_args) <- splitTyConApp_maybe ut - , length ty_args /= tyConArity tc = PtrV - | isPrimitiveType ut = (primTypeVt ut) - | otherwise = - case typePrimRep' ut of - [] -> VoidV - [pt] -> primRepVt pt - _ -> pprPanic "uTypeVt: not unary" (ppr ut) - -primRepVt :: HasDebugCallStack => PrimRep -> VarType -primRepVt VoidRep = VoidV -primRepVt LiftedRep = PtrV -- fixme does ByteArray# ever map to this? -primRepVt UnliftedRep = RtsObjV -primRepVt IntRep = IntV -primRepVt Int8Rep = IntV -primRepVt Int16Rep = IntV -primRepVt Int32Rep = IntV -primRepVt WordRep = IntV -primRepVt Word8Rep = IntV -primRepVt Word16Rep = IntV -primRepVt Word32Rep = IntV -primRepVt Int64Rep = LongV -primRepVt Word64Rep = LongV -primRepVt AddrRep = AddrV -primRepVt FloatRep = DoubleV -primRepVt DoubleRep = DoubleV -primRepVt (VecRep{}) = error "uTypeVt: vector types are unsupported" - -typePrimRep' :: HasDebugCallStack => UnaryType -> [PrimRep] -typePrimRep' ty = kindPrimRep' empty (typeKind ty) - --- | Find the primitive representation of a 'TyCon'. Defined here to --- avoid module loops. Call this only on unlifted tycons. -tyConPrimRep' :: HasDebugCallStack => TyCon -> [PrimRep] -tyConPrimRep' tc = kindPrimRep' empty res_kind - where - res_kind = tyConResKind tc - --- | Take a kind (of shape @TYPE rr@) and produce the 'PrimRep's --- of values of types of this kind. -kindPrimRep' :: HasDebugCallStack => SDoc -> Kind -> [PrimRep] -kindPrimRep' doc ki - | Just ki' <- coreView ki - = kindPrimRep' doc ki' -kindPrimRep' doc (TyConApp _typ [runtime_rep]) - = -- ASSERT( typ `hasKey` tYPETyConKey ) - runtimeRepPrimRep doc runtime_rep -kindPrimRep' doc ki - = pprPanic "kindPrimRep'" (ppr ki $$ doc) - -primTypeVt :: HasDebugCallStack => Type -> VarType -primTypeVt t = case tyConAppTyCon_maybe (unwrapType t) of - Nothing -> error "primTypeVt: not a TyCon" - Just tc - | tc == charPrimTyCon -> IntV - | tc == intPrimTyCon -> IntV - | tc == wordPrimTyCon -> IntV - | tc == floatPrimTyCon -> DoubleV - | tc == doublePrimTyCon -> DoubleV - | tc == int8PrimTyCon -> IntV - | tc == word8PrimTyCon -> IntV - | tc == int16PrimTyCon -> IntV - | tc == word16PrimTyCon -> IntV - | tc == int32PrimTyCon -> IntV - | tc == word32PrimTyCon -> IntV - | tc == int64PrimTyCon -> LongV - | tc == word64PrimTyCon -> LongV - | tc == addrPrimTyCon -> AddrV - | tc == stablePtrPrimTyCon -> AddrV - | tc == stableNamePrimTyCon -> RtsObjV - | tc == statePrimTyCon -> VoidV - | tc == proxyPrimTyCon -> VoidV - | tc == realWorldTyCon -> VoidV - | tc == threadIdPrimTyCon -> RtsObjV - | tc == weakPrimTyCon -> RtsObjV - | tc == arrayPrimTyCon -> ArrV - | tc == smallArrayPrimTyCon -> ArrV - | tc == byteArrayPrimTyCon -> ObjV -- can contain any JS reference, used for JSVal - | tc == mutableArrayPrimTyCon -> ArrV - | tc == smallMutableArrayPrimTyCon -> ArrV - | tc == mutableByteArrayPrimTyCon -> ObjV -- can contain any JS reference, used for JSVal - | tc == mutVarPrimTyCon -> RtsObjV - | tc == mVarPrimTyCon -> RtsObjV - | tc == tVarPrimTyCon -> RtsObjV - | tc == bcoPrimTyCon -> RtsObjV -- unsupported? - | tc == stackSnapshotPrimTyCon -> RtsObjV - | tc == ioPortPrimTyCon -> RtsObjV -- unsupported? - | tc == anyTyCon -> PtrV - | tc == compactPrimTyCon -> ObjV -- unsupported? - | tc == eqPrimTyCon -> VoidV -- coercion token? - | tc == eqReprPrimTyCon -> VoidV -- role - | tc == unboxedUnitTyCon -> VoidV -- Void# - | otherwise -> PtrV -- anything else must be some boxed thing - -argVt :: StgArg -> VarType -argVt a = uTypeVt . stgArgType $ a - -dataConType :: DataCon -> Type -dataConType dc = idType (dataConWrapId dc) - -isBoolDataCon :: DataCon -> Bool -isBoolDataCon dc = isBoolTy (dataConType dc) - --- standard fixed layout: payload types --- payload starts at .d1 for heap objects, entry closest to Sp for stack frames -fixedLayout :: [VarType] -> CILayout -fixedLayout vts = CILayoutFixed (sum (map varSize vts)) vts - --- 2-var values might have been moved around separately, use DoubleV as substitute --- ObjV is 1 var, so this is no problem for implicit metadata -stackSlotType :: Id -> VarType -stackSlotType i - | OneSlot <- varSlotCount otype = otype - | otherwise = DoubleV - where otype = uTypeVt (idType i) - -idPrimReps :: Id -> [PrimRep] -idPrimReps = typePrimReps . idType - -typePrimReps :: Type -> [PrimRep] -typePrimReps = typePrimRep . unwrapType - -primRepSize :: PrimRep -> SlotCount -primRepSize p = varSlotCount (primRepVt p) - --- | Associate the given values to each RrimRep in the given order, taking into --- account the number of slots per PrimRep -assocPrimReps :: [PrimRep] -> [JExpr] -> [(PrimRep, [JExpr])] -assocPrimReps [] _ = [] -assocPrimReps (r:rs) vs = case (primRepSize r,vs) of - (NoSlot, xs) -> (r,[]) : assocPrimReps rs xs - (OneSlot, x:xs) -> (r,[x]) : assocPrimReps rs xs - (TwoSlots, x:y:xs) -> (r,[x,y]) : assocPrimReps rs xs - err -> pprPanic "assocPrimReps" (ppr $ map (satJExpr Nothing) <$> err) - --- | Associate the given values to the Id's PrimReps, taking into account the --- number of slots per PrimRep -assocIdPrimReps :: Id -> [JExpr] -> [(PrimRep, [JExpr])] -assocIdPrimReps i = assocPrimReps (idPrimReps i) - --- | Associate the given JExpr to the Id's PrimReps, taking into account the --- number of slots per PrimRep -assocIdExprs :: Id -> [JExpr] -> [TypedExpr] -assocIdExprs i es = fmap (uncurry TypedExpr) (assocIdPrimReps i es) - --- | Return False only if we are *sure* it's a data type --- Look through newtypes etc as much as possible -might_be_a_function :: HasDebugCallStack => Type -> Bool -might_be_a_function ty - | [LiftedRep] <- typePrimRep ty - , Just tc <- tyConAppTyCon_maybe (unwrapType ty) - , isDataTyCon tc - = False - | otherwise - = True - -mkArityTag :: Int -> Int -> Int -mkArityTag arity registers = arity Bits..|. (registers `Bits.shiftL` 8) - -toTypeList :: [VarType] -> [Int] -toTypeList = concatMap (\x -> replicate (varSize x) (fromEnum x)) ===================================== compiler/GHC/StgToJS/DataCon.hs ===================================== @@ -35,7 +35,6 @@ import GHC.StgToJS.Closure import GHC.StgToJS.ExprCtx import GHC.StgToJS.Types import GHC.StgToJS.Monad -import GHC.StgToJS.CoreUtils import GHC.StgToJS.Profiling import GHC.StgToJS.Utils import GHC.StgToJS.Ids ===================================== compiler/GHC/StgToJS/Expr.hs ===================================== @@ -47,8 +47,6 @@ import GHC.StgToJS.Literal import GHC.StgToJS.Prim import GHC.StgToJS.Profiling import GHC.StgToJS.Regs -import GHC.StgToJS.StgUtils -import GHC.StgToJS.CoreUtils import GHC.StgToJS.Utils import GHC.StgToJS.Stack import GHC.StgToJS.Ids ===================================== compiler/GHC/StgToJS/FFI.hs ===================================== @@ -22,7 +22,7 @@ import GHC.StgToJS.Monad import GHC.StgToJS.Types import GHC.StgToJS.Literal import GHC.StgToJS.Regs -import GHC.StgToJS.CoreUtils +import GHC.StgToJS.Utils import GHC.StgToJS.Ids import GHC.Types.RepType ===================================== compiler/GHC/StgToJS/Ids.hs ===================================== @@ -40,7 +40,7 @@ import GHC.Prelude import GHC.StgToJS.Types import GHC.StgToJS.Monad -import GHC.StgToJS.CoreUtils +import GHC.StgToJS.Utils import GHC.StgToJS.Symbols import GHC.JS.Unsat.Syntax ===================================== compiler/GHC/StgToJS/Sinker.hs ===================================== @@ -15,7 +15,7 @@ import GHC.Unit.Module import GHC.Types.Literal import GHC.Data.Graph.Directed -import GHC.StgToJS.CoreUtils +import GHC.StgToJS.Utils import Data.Char import Data.Either ===================================== compiler/GHC/StgToJS/StgUtils.hs deleted ===================================== @@ -1,266 +0,0 @@ -{-# LANGUAGE LambdaCase #-} - -module GHC.StgToJS.StgUtils - ( bindingRefs - , hasExport - , collectTopIds - , collectIds - , removeTick - , isUpdatableRhs - , isInlineExpr - , exprRefs - -- * Live vars - , LiveVars - , liveVars - , liveStatic - , stgRhsLive - , stgExprLive - , stgTopBindLive - , stgLetNoEscapeLive - , stgLneLiveExpr - , stgLneLive - , stgLneLive' - ) -where - -import GHC.Prelude - -import GHC.Stg.Syntax -import GHC.Core.DataCon -import GHC.Core.Type -import GHC.Core.TyCon - -import GHC.Types.Unique.FM -import GHC.Types.Unique.Set -import GHC.Types.Unique -import GHC.Types.Id -import GHC.Types.Id.Info -import GHC.Types.ForeignCall -import GHC.Types.TyThing -import GHC.Types.Name -import GHC.Types.Var.Set - -import GHC.Builtin.Names -import GHC.Builtin.PrimOps (PrimOp(SeqOp), primOpIsReallyInline) -import GHC.Utils.Misc (seqList) -import GHC.Utils.Panic - -import qualified Data.Foldable as F -import qualified Data.Set as S -import qualified Data.List as L -import Data.Set (Set) -import Data.Monoid - -s :: a -> Set a -s = S.singleton - -l :: (a -> Set Id) -> [a] -> Set Id -l = F.foldMap - --- | collect Ids that this binding refers to --- (does not include the bindees themselves) --- first argument is Id -> StgExpr map for unfloated arguments -bindingRefs :: UniqFM Id CgStgExpr -> CgStgBinding -> Set Id -bindingRefs u = \case - StgNonRec _ rhs -> rhsRefs u rhs - StgRec bs -> l (rhsRefs u . snd) bs - -rhsRefs :: UniqFM Id CgStgExpr -> CgStgRhs -> Set Id -rhsRefs u = \case - StgRhsClosure _ _ _ _ body _ -> exprRefs u body - StgRhsCon _ccs d _mu _ticks args _ -> l s [ i | AnId i <- dataConImplicitTyThings d] <> l (argRefs u) args - -exprRefs :: UniqFM Id CgStgExpr -> CgStgExpr -> Set Id -exprRefs u = \case - StgApp f args -> s f <> l (argRefs u) args - StgConApp d _n args _ -> l s [ i | AnId i <- dataConImplicitTyThings d] <> l (argRefs u) args - StgOpApp _ args _ -> l (argRefs u) args - StgLit {} -> mempty - StgCase expr _ _ alts -> exprRefs u expr <> mconcat (fmap (altRefs u) alts) - StgLet _ bnd expr -> bindingRefs u bnd <> exprRefs u expr - StgLetNoEscape _ bnd expr -> bindingRefs u bnd <> exprRefs u expr - StgTick _ expr -> exprRefs u expr - -altRefs :: UniqFM Id CgStgExpr -> CgStgAlt -> Set Id -altRefs u alt = exprRefs u (alt_rhs alt) - -argRefs :: UniqFM Id CgStgExpr -> StgArg -> Set Id -argRefs u = \case - StgVarArg id - | Just e <- lookupUFM u id -> exprRefs u e - | otherwise -> s id - _ -> mempty - -hasExport :: CgStgBinding -> Bool -hasExport bnd = - case bnd of - StgNonRec b e -> isExportedBind b e - StgRec bs -> any (uncurry isExportedBind) bs - where - isExportedBind _i (StgRhsCon _cc con _ _ _ _) = - getUnique con == staticPtrDataConKey - isExportedBind _ _ = False - -collectTopIds :: CgStgBinding -> [Id] -collectTopIds (StgNonRec b _) = [b] -collectTopIds (StgRec bs) = let xs = map (zapFragileIdInfo . fst) bs - in seqList xs `seq` xs - -collectIds :: UniqFM Id CgStgExpr -> CgStgBinding -> [Id] -collectIds unfloated b = - let xs = map zapFragileIdInfo . - filter acceptId $ S.toList (bindingRefs unfloated b) - in seqList xs `seq` xs - where - acceptId i = all ($ i) [not . isForbidden] -- fixme test this: [isExported[isGlobalId, not.isForbidden] - -- the GHC.Prim module has no js source file - isForbidden i - | Just m <- nameModule_maybe (getName i) = m == gHC_PRIM - | otherwise = False - -removeTick :: CgStgExpr -> CgStgExpr -removeTick (StgTick _ e) = e -removeTick e = e - ------------------------------------------------------ --- Live vars --- --- TODO: should probably be moved into GHC.Stg.LiveVars - -type LiveVars = DVarSet - -liveStatic :: LiveVars -> LiveVars -liveStatic = filterDVarSet isGlobalId - -liveVars :: LiveVars -> LiveVars -liveVars = filterDVarSet (not . isGlobalId) - -stgTopBindLive :: CgStgTopBinding -> [(Id, LiveVars)] -stgTopBindLive = \case - StgTopLifted b -> stgBindLive b - StgTopStringLit {} -> [] - -stgBindLive :: CgStgBinding -> [(Id, LiveVars)] -stgBindLive = \case - StgNonRec b rhs -> [(b, stgRhsLive rhs)] - StgRec bs -> map (\(b,rhs) -> (b, stgRhsLive rhs)) bs - -stgBindRhsLive :: CgStgBinding -> LiveVars -stgBindRhsLive b = - let (bs, ls) = unzip (stgBindLive b) - in delDVarSetList (unionDVarSets ls) bs - -stgRhsLive :: CgStgRhs -> LiveVars -stgRhsLive = \case - StgRhsClosure _ _ _ args e _ -> delDVarSetList (stgExprLive True e) args - StgRhsCon _ _ _ _ args _ -> unionDVarSets (map stgArgLive args) - -stgArgLive :: StgArg -> LiveVars -stgArgLive = \case - StgVarArg occ -> unitDVarSet occ - StgLitArg {} -> emptyDVarSet - -stgExprLive :: Bool -> CgStgExpr -> LiveVars -stgExprLive includeLHS = \case - StgApp occ args -> unionDVarSets (unitDVarSet occ : map stgArgLive args) - StgLit {} -> emptyDVarSet - StgConApp _dc _n args _tys -> unionDVarSets (map stgArgLive args) - StgOpApp _op args _ty -> unionDVarSets (map stgArgLive args) - StgCase e b _at alts - | includeLHS -> el `unionDVarSet` delDVarSet al b - | otherwise -> delDVarSet al b - where - al = unionDVarSets (map stgAltLive alts) - el = stgExprLive True e - StgLet _ b e -> delDVarSetList (stgBindRhsLive b `unionDVarSet` stgExprLive True e) (bindees b) - StgLetNoEscape _ b e -> delDVarSetList (stgBindRhsLive b `unionDVarSet` stgExprLive True e) (bindees b) - StgTick _ti e -> stgExprLive True e - -stgAltLive :: CgStgAlt -> LiveVars -stgAltLive alt = - delDVarSetList (stgExprLive True (alt_rhs alt)) (alt_bndrs alt) - -stgLetNoEscapeLive :: Bool -> StgBinding -> StgExpr -> LiveVars -stgLetNoEscapeLive _someBool _b _e = panic "stgLetNoEscapeLive" - -bindees :: CgStgBinding -> [Id] -bindees = \case - StgNonRec b _e -> [b] - StgRec bs -> map fst bs - -isUpdatableRhs :: CgStgRhs -> Bool -isUpdatableRhs (StgRhsClosure _ _ u _ _ _) = isUpdatable u -isUpdatableRhs _ = False - -stgLneLive' :: CgStgBinding -> [Id] -stgLneLive' b = filter (`notElem` bindees b) (stgLneLive b) - -stgLneLive :: CgStgBinding -> [Id] -stgLneLive (StgNonRec _b e) = stgLneLiveExpr e -stgLneLive (StgRec bs) = L.nub $ concatMap (stgLneLiveExpr . snd) bs - -stgLneLiveExpr :: CgStgRhs -> [Id] -stgLneLiveExpr rhs = dVarSetElems (liveVars $ stgRhsLive rhs) --- stgLneLiveExpr (StgRhsClosure _ _ _ _ e) = dVarSetElems (liveVars (stgExprLive e)) --- stgLneLiveExpr StgRhsCon {} = [] - --- | returns True if the expression is definitely inline -isInlineExpr :: UniqSet Id -> CgStgExpr -> (UniqSet Id, Bool) -isInlineExpr v = \case - StgApp i args - -> (emptyUniqSet, isInlineApp v i args) - StgLit{} - -> (emptyUniqSet, True) - StgConApp{} - -> (emptyUniqSet, True) - StgOpApp (StgFCallOp f _) _ _ - -> (emptyUniqSet, isInlineForeignCall f) - StgOpApp (StgPrimOp SeqOp) [StgVarArg e] t - -> (emptyUniqSet, e `elementOfUniqSet` v || isStrictType t) - StgOpApp (StgPrimOp op) _ _ - -> (emptyUniqSet, primOpIsReallyInline op) - StgOpApp (StgPrimCallOp _c) _ _ - -> (emptyUniqSet, True) - StgCase e b _ alts - ->let (_ve, ie) = isInlineExpr v e - v' = addOneToUniqSet v b - (vas, ias) = unzip $ map (isInlineExpr v') (fmap alt_rhs alts) - vr = L.foldl1' intersectUniqSets vas - in (vr, (ie || b `elementOfUniqSet` v) && and ias) - StgLet _ b e - -> isInlineExpr (inspectInlineBinding v b) e - StgLetNoEscape _ _b e - -> isInlineExpr v e - StgTick _ e - -> isInlineExpr v e - -inspectInlineBinding :: UniqSet Id -> CgStgBinding -> UniqSet Id -inspectInlineBinding v = \case - StgNonRec i r -> inspectInlineRhs v i r - StgRec bs -> foldl' (\v' (i,r) -> inspectInlineRhs v' i r) v bs - -inspectInlineRhs :: UniqSet Id -> Id -> CgStgRhs -> UniqSet Id -inspectInlineRhs v i = \case - StgRhsCon{} -> addOneToUniqSet v i - StgRhsClosure _ _ ReEntrant _ _ _ -> addOneToUniqSet v i - _ -> v - -isInlineForeignCall :: ForeignCall -> Bool -isInlineForeignCall (CCall (CCallSpec _ cconv safety)) = - not (playInterruptible safety) && - not (cconv /= JavaScriptCallConv && playSafe safety) - -isInlineApp :: UniqSet Id -> Id -> [StgArg] -> Bool -isInlineApp v i = \case - _ | isJoinId i -> False - [] -> isUnboxedTupleType (idType i) || - isStrictType (idType i) || - i `elementOfUniqSet` v - - [StgVarArg a] - | DataConWrapId dc <- idDetails i - , isNewTyCon (dataConTyCon dc) - , isStrictType (idType a) || a `elementOfUniqSet` v || isStrictId a - -> True - _ -> False - ===================================== compiler/GHC/StgToJS/Utils.hs ===================================== @@ -1,11 +1,78 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE LambdaCase #-} module GHC.StgToJS.Utils ( assignToTypedExprs , assignCoerce1 , assignToExprCtx - ) -where + -- * Core Utils + , isUnboxableCon + , isUnboxable + , SlotCount(..) + , slotCount + , varSize + , varSlotCount + , typeSize + , isVoid + , isPtr + , isSingleVar + , isMultiVar + , isMatchable + , tyConVt + , idVt + , typeVt + , uTypeVt + , primRepVt + , typePrimRep' + , tyConPrimRep' + , kindPrimRep' + , primTypeVt + , argVt + , dataConType + , isBoolDataCon + , fixedLayout + , stackSlotType + , idPrimReps + , typePrimReps + , primRepSize + , assocPrimReps + , assocIdPrimReps + , assocIdExprs + , mightBeAFunction + , mkArityTag + , toTypeList + -- * Stg Utils + , bindingRefs + , rhsRefs + , exprRefs + , altRefs + , argRefs + , hasExport + , collectTopIds + , collectIds + , removeTick + , LiveVars + , liveStatic + , liveVars + , stgTopBindLive + , stgBindLive + , stgBindRhsLive + , stgRhsLive + , stgArgLive + , stgExprLive + , stgAltLive + , stgLetNoEscapeLive + , bindees + , isUpdatableRhs + , stgLneLive + , stgLneLive' + , stgLneLiveExpr + , isInlineExpr + , inspectInlineBinding + , inspectInlineRhs + , isInlineForeignCall + , isInlineApp + ) where import GHC.Prelude @@ -14,11 +81,44 @@ import GHC.StgToJS.ExprCtx import GHC.JS.Unsat.Syntax import GHC.JS.Make +import GHC.JS.Transform +import GHC.Core.DataCon +import GHC.Core.TyCo.Rep hiding (typeSize) import GHC.Core.TyCon +import GHC.Core.Type hiding (typeSize) +import GHC.Stg.Syntax + +import GHC.Tc.Utils.TcType + +import GHC.Builtin.Types +import GHC.Builtin.Types.Prim +import GHC.Builtin.Names +import GHC.Builtin.PrimOps (PrimOp(SeqOp), primOpIsReallyInline) + +import GHC.Types.RepType +import GHC.Types.Var +import GHC.Types.Var.Set +import GHC.Types.Id +import GHC.Types.Id.Info +import GHC.Types.Unique.FM +import GHC.Types.Unique.Set +import GHC.Types.ForeignCall +import GHC.Types.TyThing +import GHC.Types.Name + +import GHC.Utils.Misc +import GHC.Utils.Outputable hiding ((<>)) import GHC.Utils.Panic -import GHC.Utils.Outputable + +import qualified Data.Bits as Bits +import qualified Data.Foldable as F +import qualified Data.Set as S +import qualified Data.List as L +import Data.Set (Set) +import Data.Monoid + assignToTypedExprs :: [TypedExpr] -> [JExpr] -> JStat assignToTypedExprs tes es = @@ -55,3 +155,473 @@ assignCoerce (TypedExpr UnliftedRep [sptr]) (TypedExpr AddrRep [_a_val, a_off]) sptr |= a_off assignCoerce p1 p2 = assignTypedExprs [p1] [p2] + +-------------------------------------------------------------------------------- +-- Core Utils +-------------------------------------------------------------------------------- + +-- | can we unbox C x to x, only if x is represented as a Number +isUnboxableCon :: DataCon -> Bool +isUnboxableCon dc + | [t] <- dataConRepArgTys dc + , [t1] <- typeVt (scaledThing t) + = isUnboxable t1 && + dataConTag dc == 1 && + length (tyConDataCons $ dataConTyCon dc) == 1 + | otherwise = False + +-- | one-constructor types with one primitive field represented as a JS Number +-- can be unboxed +isUnboxable :: VarType -> Bool +isUnboxable DoubleV = True +isUnboxable IntV = True -- includes Char# +isUnboxable _ = False + +-- | Number of slots occupied by a PrimRep +data SlotCount + = NoSlot + | OneSlot + | TwoSlots + deriving (Show,Eq,Ord) + +instance Outputable SlotCount where + ppr = text . show + +-- | Return SlotCount as an Int +slotCount :: SlotCount -> Int +slotCount = \case + NoSlot -> 0 + OneSlot -> 1 + TwoSlots -> 2 + + +-- | Number of slots occupied by a value with the given VarType +varSize :: VarType -> Int +varSize = slotCount . varSlotCount + +varSlotCount :: VarType -> SlotCount +varSlotCount VoidV = NoSlot +varSlotCount LongV = TwoSlots -- hi, low +varSlotCount AddrV = TwoSlots -- obj/array, offset +varSlotCount _ = OneSlot + +typeSize :: Type -> Int +typeSize t = sum . map varSize . typeVt $ t + +isVoid :: VarType -> Bool +isVoid VoidV = True +isVoid _ = False + +isPtr :: VarType -> Bool +isPtr PtrV = True +isPtr _ = False + +isSingleVar :: VarType -> Bool +isSingleVar v = varSlotCount v == OneSlot + +isMultiVar :: VarType -> Bool +isMultiVar v = case varSlotCount v of + NoSlot -> False + OneSlot -> False + TwoSlots -> True + +-- | can we pattern match on these values in a case? +isMatchable :: [VarType] -> Bool +isMatchable [DoubleV] = True +isMatchable [IntV] = True +isMatchable _ = False + +tyConVt :: HasDebugCallStack => TyCon -> [VarType] +tyConVt = typeVt . mkTyConTy + +idVt :: HasDebugCallStack => Id -> [VarType] +idVt = typeVt . idType + +typeVt :: HasDebugCallStack => Type -> [VarType] +typeVt t | isRuntimeRepKindedTy t = [] +typeVt t = map primRepVt (typePrimRep t)-- map uTypeVt (repTypeArgs t) + +-- only use if you know it's not an unboxed tuple +uTypeVt :: HasDebugCallStack => UnaryType -> VarType +uTypeVt ut + | isRuntimeRepKindedTy ut = VoidV +-- | isRuntimeRepTy ut = VoidV + -- GHC panics on this otherwise + | Just (tc, ty_args) <- splitTyConApp_maybe ut + , length ty_args /= tyConArity tc = PtrV + | isPrimitiveType ut = (primTypeVt ut) + | otherwise = + case typePrimRep' ut of + [] -> VoidV + [pt] -> primRepVt pt + _ -> pprPanic "uTypeVt: not unary" (ppr ut) + +primRepVt :: HasDebugCallStack => PrimRep -> VarType +primRepVt VoidRep = VoidV +primRepVt LiftedRep = PtrV -- fixme does ByteArray# ever map to this? +primRepVt UnliftedRep = RtsObjV +primRepVt IntRep = IntV +primRepVt Int8Rep = IntV +primRepVt Int16Rep = IntV +primRepVt Int32Rep = IntV +primRepVt WordRep = IntV +primRepVt Word8Rep = IntV +primRepVt Word16Rep = IntV +primRepVt Word32Rep = IntV +primRepVt Int64Rep = LongV +primRepVt Word64Rep = LongV +primRepVt AddrRep = AddrV +primRepVt FloatRep = DoubleV +primRepVt DoubleRep = DoubleV +primRepVt (VecRep{}) = error "uTypeVt: vector types are unsupported" + +typePrimRep' :: HasDebugCallStack => UnaryType -> [PrimRep] +typePrimRep' ty = kindPrimRep' empty (typeKind ty) + +-- | Find the primitive representation of a 'TyCon'. Defined here to +-- avoid module loops. Call this only on unlifted tycons. +tyConPrimRep' :: HasDebugCallStack => TyCon -> [PrimRep] +tyConPrimRep' tc = kindPrimRep' empty res_kind + where + res_kind = tyConResKind tc + +-- | Take a kind (of shape @TYPE rr@) and produce the 'PrimRep's +-- of values of types of this kind. +kindPrimRep' :: HasDebugCallStack => SDoc -> Kind -> [PrimRep] +kindPrimRep' doc ki + | Just ki' <- coreView ki + = kindPrimRep' doc ki' +kindPrimRep' doc (TyConApp _typ [runtime_rep]) + = -- ASSERT( typ `hasKey` tYPETyConKey ) + runtimeRepPrimRep doc runtime_rep +kindPrimRep' doc ki + = pprPanic "kindPrimRep'" (ppr ki $$ doc) + +primTypeVt :: HasDebugCallStack => Type -> VarType +primTypeVt t = case tyConAppTyCon_maybe (unwrapType t) of + Nothing -> error "primTypeVt: not a TyCon" + Just tc + | tc == charPrimTyCon -> IntV + | tc == intPrimTyCon -> IntV + | tc == wordPrimTyCon -> IntV + | tc == floatPrimTyCon -> DoubleV + | tc == doublePrimTyCon -> DoubleV + | tc == int8PrimTyCon -> IntV + | tc == word8PrimTyCon -> IntV + | tc == int16PrimTyCon -> IntV + | tc == word16PrimTyCon -> IntV + | tc == int32PrimTyCon -> IntV + | tc == word32PrimTyCon -> IntV + | tc == int64PrimTyCon -> LongV + | tc == word64PrimTyCon -> LongV + | tc == addrPrimTyCon -> AddrV + | tc == stablePtrPrimTyCon -> AddrV + | tc == stableNamePrimTyCon -> RtsObjV + | tc == statePrimTyCon -> VoidV + | tc == proxyPrimTyCon -> VoidV + | tc == realWorldTyCon -> VoidV + | tc == threadIdPrimTyCon -> RtsObjV + | tc == weakPrimTyCon -> RtsObjV + | tc == arrayPrimTyCon -> ArrV + | tc == smallArrayPrimTyCon -> ArrV + | tc == byteArrayPrimTyCon -> ObjV -- can contain any JS reference, used for JSVal + | tc == mutableArrayPrimTyCon -> ArrV + | tc == smallMutableArrayPrimTyCon -> ArrV + | tc == mutableByteArrayPrimTyCon -> ObjV -- can contain any JS reference, used for JSVal + | tc == mutVarPrimTyCon -> RtsObjV + | tc == mVarPrimTyCon -> RtsObjV + | tc == tVarPrimTyCon -> RtsObjV + | tc == bcoPrimTyCon -> RtsObjV -- unsupported? + | tc == stackSnapshotPrimTyCon -> RtsObjV + | tc == ioPortPrimTyCon -> RtsObjV -- unsupported? + | tc == anyTyCon -> PtrV + | tc == compactPrimTyCon -> ObjV -- unsupported? + | tc == eqPrimTyCon -> VoidV -- coercion token? + | tc == eqReprPrimTyCon -> VoidV -- role + | tc == unboxedUnitTyCon -> VoidV -- Void# + | otherwise -> PtrV -- anything else must be some boxed thing + +argVt :: StgArg -> VarType +argVt a = uTypeVt . stgArgType $ a + +dataConType :: DataCon -> Type +dataConType dc = idType (dataConWrapId dc) + +isBoolDataCon :: DataCon -> Bool +isBoolDataCon dc = isBoolTy (dataConType dc) + +-- standard fixed layout: payload types +-- payload starts at .d1 for heap objects, entry closest to Sp for stack frames +fixedLayout :: [VarType] -> CILayout +fixedLayout vts = CILayoutFixed (sum (map varSize vts)) vts + +-- 2-var values might have been moved around separately, use DoubleV as substitute +-- ObjV is 1 var, so this is no problem for implicit metadata +stackSlotType :: Id -> VarType +stackSlotType i + | OneSlot <- varSlotCount otype = otype + | otherwise = DoubleV + where otype = uTypeVt (idType i) + +idPrimReps :: Id -> [PrimRep] +idPrimReps = typePrimReps . idType + +typePrimReps :: Type -> [PrimRep] +typePrimReps = typePrimRep . unwrapType + +primRepSize :: PrimRep -> SlotCount +primRepSize p = varSlotCount (primRepVt p) + +-- | Associate the given values to each RrimRep in the given order, taking into +-- account the number of slots per PrimRep +assocPrimReps :: [PrimRep] -> [JExpr] -> [(PrimRep, [JExpr])] +assocPrimReps [] _ = [] +assocPrimReps (r:rs) vs = case (primRepSize r,vs) of + (NoSlot, xs) -> (r,[]) : assocPrimReps rs xs + (OneSlot, x:xs) -> (r,[x]) : assocPrimReps rs xs + (TwoSlots, x:y:xs) -> (r,[x,y]) : assocPrimReps rs xs + err -> pprPanic "assocPrimReps" (ppr $ map (satJExpr Nothing) <$> err) + +-- | Associate the given values to the Id's PrimReps, taking into account the +-- number of slots per PrimRep +assocIdPrimReps :: Id -> [JExpr] -> [(PrimRep, [JExpr])] +assocIdPrimReps i = assocPrimReps (idPrimReps i) + +-- | Associate the given JExpr to the Id's PrimReps, taking into account the +-- number of slots per PrimRep +assocIdExprs :: Id -> [JExpr] -> [TypedExpr] +assocIdExprs i es = fmap (uncurry TypedExpr) (assocIdPrimReps i es) + +-- | Return False only if we are *sure* it's a data type +-- Look through newtypes etc as much as possible +mightBeAFunction :: HasDebugCallStack => Type -> Bool +mightBeAFunction ty + | [LiftedRep] <- typePrimRep ty + , Just tc <- tyConAppTyCon_maybe (unwrapType ty) + , isDataTyCon tc + = False + | otherwise + = True + +mkArityTag :: Int -> Int -> Int +mkArityTag arity registers = arity Bits..|. (registers `Bits.shiftL` 8) + +toTypeList :: [VarType] -> [Int] +toTypeList = concatMap (\x -> replicate (varSize x) (fromEnum x)) + +-------------------------------------------------------------------------------- +-- Stg Utils +-------------------------------------------------------------------------------- + +s :: a -> Set a +s = S.singleton + +l :: (a -> Set Id) -> [a] -> Set Id +l = F.foldMap + +-- | collect Ids that this binding refers to +-- (does not include the bindees themselves) +-- first argument is Id -> StgExpr map for unfloated arguments +bindingRefs :: UniqFM Id CgStgExpr -> CgStgBinding -> Set Id +bindingRefs u = \case + StgNonRec _ rhs -> rhsRefs u rhs + StgRec bs -> l (rhsRefs u . snd) bs + +rhsRefs :: UniqFM Id CgStgExpr -> CgStgRhs -> Set Id +rhsRefs u = \case + StgRhsClosure _ _ _ _ body _ -> exprRefs u body + StgRhsCon _ccs d _mu _ticks args _ -> l s [ i | AnId i <- dataConImplicitTyThings d] <> l (argRefs u) args + +exprRefs :: UniqFM Id CgStgExpr -> CgStgExpr -> Set Id +exprRefs u = \case + StgApp f args -> s f <> l (argRefs u) args + StgConApp d _n args _ -> l s [ i | AnId i <- dataConImplicitTyThings d] <> l (argRefs u) args + StgOpApp _ args _ -> l (argRefs u) args + StgLit {} -> mempty + StgCase expr _ _ alts -> exprRefs u expr <> mconcat (fmap (altRefs u) alts) + StgLet _ bnd expr -> bindingRefs u bnd <> exprRefs u expr + StgLetNoEscape _ bnd expr -> bindingRefs u bnd <> exprRefs u expr + StgTick _ expr -> exprRefs u expr + +altRefs :: UniqFM Id CgStgExpr -> CgStgAlt -> Set Id +altRefs u alt = exprRefs u (alt_rhs alt) + +argRefs :: UniqFM Id CgStgExpr -> StgArg -> Set Id +argRefs u = \case + StgVarArg id + | Just e <- lookupUFM u id -> exprRefs u e + | otherwise -> s id + _ -> mempty + +hasExport :: CgStgBinding -> Bool +hasExport bnd = + case bnd of + StgNonRec b e -> isExportedBind b e + StgRec bs -> any (uncurry isExportedBind) bs + where + isExportedBind _i (StgRhsCon _cc con _ _ _ _) = + getUnique con == staticPtrDataConKey + isExportedBind _ _ = False + +collectTopIds :: CgStgBinding -> [Id] +collectTopIds (StgNonRec b _) = [b] +collectTopIds (StgRec bs) = let xs = map (zapFragileIdInfo . fst) bs + in seqList xs `seq` xs + +collectIds :: UniqFM Id CgStgExpr -> CgStgBinding -> [Id] +collectIds unfloated b = + let xs = map zapFragileIdInfo . + filter acceptId $ S.toList (bindingRefs unfloated b) + in seqList xs `seq` xs + where + acceptId i = all ($ i) [not . isForbidden] -- fixme test this: [isExported[isGlobalId, not.isForbidden] + -- the GHC.Prim module has no js source file + isForbidden i + | Just m <- nameModule_maybe (getName i) = m == gHC_PRIM + | otherwise = False + +removeTick :: CgStgExpr -> CgStgExpr +removeTick (StgTick _ e) = e +removeTick e = e + +----------------------------------------------------- +-- Live vars +-- +-- TODO: should probably be moved into GHC.Stg.LiveVars + +type LiveVars = DVarSet + +liveStatic :: LiveVars -> LiveVars +liveStatic = filterDVarSet isGlobalId + +liveVars :: LiveVars -> LiveVars +liveVars = filterDVarSet (not . isGlobalId) + +stgTopBindLive :: CgStgTopBinding -> [(Id, LiveVars)] +stgTopBindLive = \case + StgTopLifted b -> stgBindLive b + StgTopStringLit {} -> [] + +stgBindLive :: CgStgBinding -> [(Id, LiveVars)] +stgBindLive = \case + StgNonRec b rhs -> [(b, stgRhsLive rhs)] + StgRec bs -> map (\(b,rhs) -> (b, stgRhsLive rhs)) bs + +stgBindRhsLive :: CgStgBinding -> LiveVars +stgBindRhsLive b = + let (bs, ls) = unzip (stgBindLive b) + in delDVarSetList (unionDVarSets ls) bs + +stgRhsLive :: CgStgRhs -> LiveVars +stgRhsLive = \case + StgRhsClosure _ _ _ args e _ -> delDVarSetList (stgExprLive True e) args + StgRhsCon _ _ _ _ args _ -> unionDVarSets (map stgArgLive args) + +stgArgLive :: StgArg -> LiveVars +stgArgLive = \case + StgVarArg occ -> unitDVarSet occ + StgLitArg {} -> emptyDVarSet + +stgExprLive :: Bool -> CgStgExpr -> LiveVars +stgExprLive includeLHS = \case + StgApp occ args -> unionDVarSets (unitDVarSet occ : map stgArgLive args) + StgLit {} -> emptyDVarSet + StgConApp _dc _n args _tys -> unionDVarSets (map stgArgLive args) + StgOpApp _op args _ty -> unionDVarSets (map stgArgLive args) + StgCase e b _at alts + | includeLHS -> el `unionDVarSet` delDVarSet al b + | otherwise -> delDVarSet al b + where + al = unionDVarSets (map stgAltLive alts) + el = stgExprLive True e + StgLet _ b e -> delDVarSetList (stgBindRhsLive b `unionDVarSet` stgExprLive True e) (bindees b) + StgLetNoEscape _ b e -> delDVarSetList (stgBindRhsLive b `unionDVarSet` stgExprLive True e) (bindees b) + StgTick _ti e -> stgExprLive True e + +stgAltLive :: CgStgAlt -> LiveVars +stgAltLive alt = + delDVarSetList (stgExprLive True (alt_rhs alt)) (alt_bndrs alt) + +stgLetNoEscapeLive :: Bool -> StgBinding -> StgExpr -> LiveVars +stgLetNoEscapeLive _someBool _b _e = panic "stgLetNoEscapeLive" + +bindees :: CgStgBinding -> [Id] +bindees = \case + StgNonRec b _e -> [b] + StgRec bs -> map fst bs + +isUpdatableRhs :: CgStgRhs -> Bool +isUpdatableRhs (StgRhsClosure _ _ u _ _ _) = isUpdatable u +isUpdatableRhs _ = False + +stgLneLive' :: CgStgBinding -> [Id] +stgLneLive' b = filter (`notElem` bindees b) (stgLneLive b) + +stgLneLive :: CgStgBinding -> [Id] +stgLneLive (StgNonRec _b e) = stgLneLiveExpr e +stgLneLive (StgRec bs) = L.nub $ concatMap (stgLneLiveExpr . snd) bs + +stgLneLiveExpr :: CgStgRhs -> [Id] +stgLneLiveExpr rhs = dVarSetElems (liveVars $ stgRhsLive rhs) +-- stgLneLiveExpr (StgRhsClosure _ _ _ _ e) = dVarSetElems (liveVars (stgExprLive e)) +-- stgLneLiveExpr StgRhsCon {} = [] + +-- | returns True if the expression is definitely inline +isInlineExpr :: UniqSet Id -> CgStgExpr -> (UniqSet Id, Bool) +isInlineExpr v = \case + StgApp i args + -> (emptyUniqSet, isInlineApp v i args) + StgLit{} + -> (emptyUniqSet, True) + StgConApp{} + -> (emptyUniqSet, True) + StgOpApp (StgFCallOp f _) _ _ + -> (emptyUniqSet, isInlineForeignCall f) + StgOpApp (StgPrimOp SeqOp) [StgVarArg e] t + -> (emptyUniqSet, e `elementOfUniqSet` v || isStrictType t) + StgOpApp (StgPrimOp op) _ _ + -> (emptyUniqSet, primOpIsReallyInline op) + StgOpApp (StgPrimCallOp _c) _ _ + -> (emptyUniqSet, True) + StgCase e b _ alts + ->let (_ve, ie) = isInlineExpr v e + v' = addOneToUniqSet v b + (vas, ias) = unzip $ map (isInlineExpr v') (fmap alt_rhs alts) + vr = L.foldl1' intersectUniqSets vas + in (vr, (ie || b `elementOfUniqSet` v) && and ias) + StgLet _ b e + -> isInlineExpr (inspectInlineBinding v b) e + StgLetNoEscape _ _b e + -> isInlineExpr v e + StgTick _ e + -> isInlineExpr v e + +inspectInlineBinding :: UniqSet Id -> CgStgBinding -> UniqSet Id +inspectInlineBinding v = \case + StgNonRec i r -> inspectInlineRhs v i r + StgRec bs -> foldl' (\v' (i,r) -> inspectInlineRhs v' i r) v bs + +inspectInlineRhs :: UniqSet Id -> Id -> CgStgRhs -> UniqSet Id +inspectInlineRhs v i = \case + StgRhsCon{} -> addOneToUniqSet v i + StgRhsClosure _ _ ReEntrant _ _ _ -> addOneToUniqSet v i + _ -> v + +isInlineForeignCall :: ForeignCall -> Bool +isInlineForeignCall (CCall (CCallSpec _ cconv safety)) = + not (playInterruptible safety) && + not (cconv /= JavaScriptCallConv && playSafe safety) + +isInlineApp :: UniqSet Id -> Id -> [StgArg] -> Bool +isInlineApp v i = \case + _ | isJoinId i -> False + [] -> isUnboxedTupleType (idType i) || + isStrictType (idType i) || + i `elementOfUniqSet` v + + [StgVarArg a] + | DataConWrapId dc <- idDetails i + , isNewTyCon (dataConTyCon dc) + , isStrictType (idType a) || a `elementOfUniqSet` v || isStrictId a + -> True + _ -> False ===================================== compiler/ghc.cabal.in ===================================== @@ -663,7 +663,6 @@ Library GHC.StgToJS.Arg GHC.StgToJS.Closure GHC.StgToJS.CodeGen - GHC.StgToJS.CoreUtils GHC.StgToJS.DataCon GHC.StgToJS.Deps GHC.StgToJS.Expr @@ -682,7 +681,6 @@ Library GHC.StgToJS.Sinker GHC.StgToJS.Stack GHC.StgToJS.StaticPtr - GHC.StgToJS.StgUtils GHC.StgToJS.Symbols GHC.StgToJS.Types GHC.StgToJS.Utils View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1792b57a717e0b3b338b93d641d9f55f12cf7173 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1792b57a717e0b3b338b93d641d9f55f12cf7173 You're receiving 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 Jun 15 07:13:16 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 15 Jun 2023 03:13:16 -0400 Subject: [Git][ghc/ghc][master] Check visibility of nested foralls in can_eq_nc (#18863) Message-ID: <648aba0c8194_c7397ae8ab34299767@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 6 changed files: - compiler/GHC/Tc/Solver/Equality.hs - + testsuite/tests/saks/should_fail/T18863c.hs - + testsuite/tests/saks/should_fail/T18863c.stderr - + testsuite/tests/saks/should_fail/T18863d.hs - + testsuite/tests/saks/should_fail/T18863d.stderr - testsuite/tests/saks/should_fail/all.T Changes: ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -388,9 +388,8 @@ can_eq_nc rewritten _rdr_env _envs ev eq_rel ty1 _ ty2 _ = canTyConApp ev eq_rel both_generative 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 at ForAllTy{} _ + s2 at ForAllTy{} _ = can_eq_nc_forall ev eq_rel s1 s2 -- See Note [Canonicalising type applications] about why we require rewritten types @@ -481,11 +480,12 @@ can_eq_nc_forall ev eq_rel s1 s2 = do { let free_tvs = tyCoVarsOfTypes [s1,s2] (bndrs1, phi1) = tcSplitForAllTyVarBinders s1 (bndrs2, phi2) = tcSplitForAllTyVarBinders s2 - ; if not (equalLength bndrs1 bndrs2) + flags1 = binderFlags bndrs1 + flags2 = binderFlags bndrs2 + ; if not (all2 eqForAllVis flags1 flags2) -- Note [ForAllTy and type equality] then do { traceTcS "Forall failure" $ vcat [ ppr s1, ppr s2, ppr bndrs1, ppr bndrs2 - , ppr (binderFlags bndrs1) - , ppr (binderFlags bndrs2) ] + , ppr flags1, ppr flags2 ] ; canEqHardFailure ev s1 s2 } else do { traceTcS "Creating implication for polytype equality" $ ppr ev ===================================== testsuite/tests/saks/should_fail/T18863c.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE StandaloneKindSignatures #-} + +module T18863c where + +import Data.Kind + +type D :: forall j -> forall i -> (i -> j) -> Type +data D :: forall j -> forall i. (i -> j) -> Type ===================================== testsuite/tests/saks/should_fail/T18863c.stderr ===================================== @@ -0,0 +1,5 @@ + +T18863c.hs:10:1: error: [GHC-83865] + • Couldn't match expected kind: forall j -> forall i. (i -> j) -> * + with actual kind: forall j i -> (i -> j) -> * + • In the data type declaration for ‘D’ ===================================== testsuite/tests/saks/should_fail/T18863d.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE StandaloneKindSignatures #-} + +module T18863d where + +import Data.Kind + +type D :: forall j -> forall i. (i -> j) -> Type +data D :: forall j -> forall i -> (i -> j) -> Type ===================================== testsuite/tests/saks/should_fail/T18863d.stderr ===================================== @@ -0,0 +1,5 @@ + +T18863d.hs:10:1: error: [GHC-83865] + • Couldn't match expected kind: forall j i -> (i -> j) -> * + with actual kind: forall j -> forall i. (i -> j) -> * + • In the data type declaration for ‘D’ ===================================== testsuite/tests/saks/should_fail/all.T ===================================== @@ -33,4 +33,6 @@ test('T16826', normal, compile_fail, ['']) test('T16756b', normal, compile_fail, ['']) test('T18863a', normal, compile_fail, ['']) test('T18863b', normal, compile_fail, ['']) +test('T18863c', normal, compile_fail, ['']) +test('T18863d', normal, compile_fail, ['']) test('T20916', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/469ff08b4c56491f42236a5d59fe3e85ee901657 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/469ff08b4c56491f42236a5d59fe3e85ee901657 You're receiving 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 Jun 15 07:13:55 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 15 Jun 2023 03:13:55 -0400 Subject: [Git][ghc/ghc][master] 3 commits: JS: use regular mask for blocking IO Message-ID: <648aba33597fb_c73971699d408303027@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 2 changed files: - libraries/base/GHC/IO/FD.hs - libraries/base/jsbits/base.js Changes: ===================================== libraries/base/GHC/IO/FD.hs ===================================== @@ -571,7 +571,7 @@ indicates that there's no data, we call threadWaitRead. readRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO Int readRawBufferPtr loc !fd !buf !off !len #if defined(javascript_HOST_ARCH) - = fmap fromIntegral . uninterruptibleMask_ $ + = fmap fromIntegral . mask_ $ throwErrnoIfMinus1 loc (c_read (fdFD fd) (buf `plusPtr` off) len) #else | isNonBlocking fd = unsafe_read -- unsafe is ok, it can't block @@ -593,7 +593,7 @@ readRawBufferPtr loc !fd !buf !off !len readRawBufferPtrNoBlock :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO Int readRawBufferPtrNoBlock loc !fd !buf !off !len #if defined(javascript_HOST_ARCH) - = uninterruptibleMask_ $ do + = mask_ $ do r <- throwErrnoIfMinus1 loc (c_read (fdFD fd) (buf `plusPtr` off) len) case r of (-1) -> return 0 @@ -618,7 +618,7 @@ readRawBufferPtrNoBlock loc !fd !buf !off !len writeRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt writeRawBufferPtr loc !fd !buf !off !len #if defined(javascript_HOST_ARCH) - = fmap fromIntegral . uninterruptibleMask_ $ + = fmap fromIntegral . mask_ $ throwErrnoIfMinus1 loc (c_write (fdFD fd) (buf `plusPtr` off) len) #else | isNonBlocking fd = unsafe_write -- unsafe is ok, it can't block @@ -638,7 +638,7 @@ writeRawBufferPtr loc !fd !buf !off !len writeRawBufferPtrNoBlock :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt writeRawBufferPtrNoBlock loc !fd !buf !off !len #if defined(javascript_HOST_ARCH) - = uninterruptibleMask_ $ do + = mask_ $ do r <- throwErrnoIfMinus1 loc (c_write (fdFD fd) (buf `plusPtr` off) len) case r of (-1) -> return 0 ===================================== libraries/base/jsbits/base.js ===================================== @@ -664,8 +664,14 @@ if(h$isNode()) { }); } + var h$base_stdinHandlerInstalled = false; + h$base_readStdin = function(fd, fdo, buf, buf_offset, n, c) { TRACE_IO("read stdin") + if(!h$base_stdinHandlerInstalled) { + process.stdin.on('readable', h$base_process_stdin); + h$base_stdinHandlerInstalled = true; + } h$base_stdin_waiting.enqueue({buf: buf, off: buf_offset, n: n, c: c}); h$base_process_stdin(); } @@ -720,7 +726,6 @@ if(h$isNode()) { c(0); } - process.stdin.on('readable', h$base_process_stdin); process.stdin.on('end', function() { h$base_stdin_eof = true; h$base_process_stdin(); }); h$base_isattyStdin = function() { return process.stdin.isTTY; }; @@ -803,7 +808,7 @@ var h$base_stderr_fd = , refs: 1 }; -var h$base_fdN = -2; // negative file descriptors are 'virtual', -1 is already used to indicated error +var h$base_fdN = -3; // negative file descriptors are 'virtual', -1 and -2 are reserved var h$base_fds = [h$base_stdin_fd, h$base_stdout_fd, h$base_stderr_fd]; function h$shutdownHaskellAndExit(code, fast) { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/469ff08b4c56491f42236a5d59fe3e85ee901657...a54b40a99018a32a3251b2ff5e36c0816b39999f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/469ff08b4c56491f42236a5d59fe3e85ee901657...a54b40a99018a32a3251b2ff5e36c0816b39999f You're receiving 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 Jun 15 07:16:19 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Thu, 15 Jun 2023 03:16:19 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/#16635-improve-errors] 12 commits: Add more flags for dumping core passes (#23491) Message-ID: <648abac3bd410_c739716c56d20303245@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/#16635-improve-errors at Glasgow Haskell Compiler / GHC Commits: 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 30 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/JS/Make.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Arg.hs - compiler/GHC/StgToJS/Closure.hs - compiler/GHC/StgToJS/CodeGen.hs - − compiler/GHC/StgToJS/CoreUtils.hs - compiler/GHC/StgToJS/DataCon.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Ids.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/StgToJS/Sinker.hs - − compiler/GHC/StgToJS/StgUtils.hs - compiler/GHC/StgToJS/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Errors/Types/PromotionErr.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Types/BasicTypes.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Types/Demand.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8e3084256cd8a84da5a105afd550c90d9e799e52...78cd11329ce2ed00cbba8a459fe688ccc8f83d13 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8e3084256cd8a84da5a105afd550c90d9e799e52...78cd11329ce2ed00cbba8a459fe688ccc8f83d13 You're receiving 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 Jun 15 07:17:23 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Thu, 15 Jun 2023 03:17:23 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/dib-instances] 31 commits: Change WarningWithFlag to plural WarningWithFlags Message-ID: <648abb034f790_c73971656fdf4304011@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/dib-instances at Glasgow Haskell Compiler / GHC Commits: a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - b932b26b by Andrei Borzenkov at 2023-06-15T11:17:06+04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/JS/Make.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Arg.hs - compiler/GHC/StgToJS/Closure.hs - compiler/GHC/StgToJS/CodeGen.hs - − compiler/GHC/StgToJS/CoreUtils.hs - compiler/GHC/StgToJS/DataCon.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Ids.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/StgToJS/Sinker.hs - − compiler/GHC/StgToJS/StgUtils.hs - compiler/GHC/StgToJS/Utils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7cd6812b3911d336bf8791ffdb5bc0ea98b2d7b7...b932b26bfbeb15dd6ab2211fbf4a50f150a12dbe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7cd6812b3911d336bf8791ffdb5bc0ea98b2d7b7...b932b26bfbeb15dd6ab2211fbf4a50f150a12dbe You're receiving 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 Jun 15 07:57:33 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 15 Jun 2023 03:57:33 -0400 Subject: [Git][ghc/ghc][wip/T22010] Remove unused import Message-ID: <648ac46d669cc_c73971783c2e830909@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 560ecb0c by Jaro Reinders at 2023-06-15T09:57:15+02:00 Remove unused import - - - - - 1 changed file: - compiler/GHC/Data/Word64Set/Internal.hs Changes: ===================================== compiler/GHC/Data/Word64Set/Internal.hs ===================================== @@ -219,9 +219,6 @@ import Text.Read #if __GLASGOW_HASKELL__ import qualified GHC.Exts -# if !(WORD_SIZE_IN_BITS==64) -import qualified GHC.Int -# endif import Language.Haskell.TH.Syntax (Lift) -- See Note [ Template Haskell Dependencies ] import Language.Haskell.TH () View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/560ecb0cd38878182735ad92afcad97b293ccc27 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/560ecb0cd38878182735ad92afcad97b293ccc27 You're receiving 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 Jun 15 08:46:49 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Thu, 15 Jun 2023 04:46:49 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] WIP Message-ID: <648acff91528d_c739717499dc03166af@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: 55c41884 by Rodrigo Mesquita at 2023-06-15T09:46:42+01:00 WIP - - - - - 3 changed files: - compiler/GHC/Core/Functor.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Map/Type.hs Changes: ===================================== compiler/GHC/Core/Functor.hs ===================================== @@ -1,19 +1,11 @@ {-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE StandaloneDeriving #-} + module GHC.Core.Functor where -import GHC.Generics import GHC.Prelude -import Data.Bool -import Data.Eq -import Data.Ord -import Data.Functor -import Data.Functor.Classes -import Data.Foldable -import Data.Traversable - import GHC.Core import GHC.Core.TyCo.Rep import GHC.Core.Map.Type @@ -25,6 +17,9 @@ import Unsafe.Coerce (unsafeCoerce) import Data.Equality.Utils (Fix(..)) +import GHC.Utils.Misc (all2, equalLength) +import Data.Functor.Identity (Identity(..)) + -- Important to note the binders are also represented by $a$ -- This is because in the e-graph we will represent binders with the -- equivalence class id of things equivalent to it. @@ -36,12 +31,12 @@ import Data.Equality.Utils (Fix(..)) data AltF b a = AltF AltCon [b] a - deriving (Functor, Foldable, Traversable) + deriving (Functor, Foldable, Traversable, Eq, Ord) data BindF b a = NonRecF b a | RecF [(b, a)] - deriving (Functor, Foldable, Traversable) + deriving (Functor, Foldable, Traversable, Eq, Ord) data ExprF b a = VarF Id @@ -60,51 +55,66 @@ data ExprF b a type CoreExprF = ExprF CoreBndr --- instance (Eq a, Eq b) => Eq (AltF b a) where --- (==) (AltF c as a) (AltF c' as' a') = c == c' && as == as' && a == a' - --- instance Eq b => Eq1 (AltF b) where --- liftEq eq (AltF c as a) (AltF c' as' a') = c == c' && as == as' && eq a a' - --- instance (Eq a, Eq b) => Eq (BindF b a) where --- (==) (RecF as) (RecF as') = as == as' --- (==) (NonRecF a b) (NonRecF a' b') = a == a' && b == b' --- (==) _ _ = False - --- instance Eq b => Eq1 (BindF b) where --- liftEq eq (RecF as) (RecF as') = liftEq (\(x,y) (x',y') -> x == x' && eq y y') as as' --- liftEq eq (NonRecF a b) (NonRecF a' b') = a == a' && eq b b' --- liftEq _ _ _ = False - --- instance (Eq a, Eq b) => Eq (ExprF b a) where --- (==) (VarF a) (VarF b) = a == b --- (==) (LitF a) (LitF b) = a == b --- (==) (AppF a a') (AppF b b') = a == b && a' == b' --- (==) (LamF a a') (LamF b b') = a == b && a' == b' --- (==) (LetF a a') (LetF b b') = a == b && a' == b' - -- (==) (CaseF a a' t as) (CaseF b b' v bs) = a == b && a' == b' - -- && eqDeBruijnType t v - -- && as == bs - -- (==) (CastF a c) (CastF b c') = a == b && eqDeBruijnType (coercionType c) (coercionType c') - -- ROMES:TODO: THE REST OF IT!! - -- (==) _ _ = False - instance Eq a => Eq (DeBruijnF CoreExprF a) where - (==) _ _ = error "TODO" - -instance Eq1 (DeBruijnF CoreExprF) where - liftEq eq = error "TODO" + (==) = eqDeBruijnExprF + +-- ROMES:TODO: This instance is plain wrong. This DeBruijn scheme won't +-- particularly work for our situation, we'll likely have to have ints instead +-- of Id binders. Now, ignoring DeBruijn indices, we'll simply get this compile +-- to get a rougher estimate of performance? +eqDeBruijnExprF :: forall a. Eq a => DeBruijnF CoreExprF a -> DeBruijnF CoreExprF a -> Bool +eqDeBruijnExprF (DeBruijnF (D env1 e1)) (DeBruijnF (D env2 e2)) = go e1 e2 where + go :: CoreExprF a -> CoreExprF a -> Bool + go (VarF v1) (VarF v2) = eqDeBruijnVar (D env1 v1) (D env2 v2) + go (LitF lit1) (LitF lit2) = lit1 == lit2 + go (TypeF t1) (TypeF t2) = eqDeBruijnType (D env1 t1) (D env2 t2) + -- See Note [Alpha-equality for Coercion arguments] + go (CoercionF {}) (CoercionF {}) = True + go (CastF e1 co1) (CastF e2 co2) = D env1 co1 == D env2 co2 && e1 == e2 + go (AppF f1 a1) (AppF f2 a2) = f1 == f2 && a1 == a2 + go (TickF n1 e1) (TickF n2 e2) + = eqDeBruijnTickish (D env1 n1) (D env2 n2) + && e1 == e2 + + go (LamF b1 e1) (LamF b2 e2) + = eqDeBruijnType (D env1 (varType b1)) (D env2 (varType b2)) + && D env1 (varMultMaybe b1) == D env2 (varMultMaybe b2) + && e1 == e2 + + go (LetF (NonRecF v1 r1) e1) (LetF (NonRecF v2 r2) e2) + = r1 == r2 -- See Note [Alpha-equality for let-bindings] + && e1 == e2 + + go (LetF (RecF ps1) e1) (LetF (RecF ps2) e2) + = equalLength ps1 ps2 + -- See Note [Alpha-equality for let-bindings] + && all2 (\b1 b2 -> eqDeBruijnType (D env1 (varType b1)) + (D env2 (varType b2))) + bs1 bs2 + && rs1 == rs2 + && e1 == e2 + where + (bs1,rs1) = unzip ps1 + (bs2,rs2) = unzip ps2 + env1' = extendCMEs env1 bs1 + env2' = extendCMEs env2 bs2 + + go (CaseF e1 b1 t1 a1) (CaseF e2 b2 t2 a2) + | null a1 -- See Note [Empty case alternatives] + = null a2 && e1 == e2 && D env1 t1 == D env2 t2 + | otherwise + = e1 == e2 && a1 == a2 + + go _ _ = False + +-- With Ints as binders we can have almost trivial eq instances instance Ord a => Ord (DeBruijnF CoreExprF a) where - compare _ _ = error "TODO" - -instance Ord1 (DeBruijnF CoreExprF) where - liftCompare cmp _ _ = error "TODO" - -instance Functor (DeBruijnF CoreExprF) -instance Foldable (DeBruijnF CoreExprF) -instance Traversable (DeBruijnF CoreExprF) + compare a b = if a == b then EQ else LT +deriving instance Functor (DeBruijnF CoreExprF) +deriving instance Foldable (DeBruijnF CoreExprF) +deriving instance Traversable (DeBruijnF CoreExprF) -- | 'unsafeCoerce' mostly because I'm too lazy to write the boilerplate. fromCoreExpr :: CoreExpr -> Fix CoreExprF ===================================== compiler/GHC/Core/Map/Expr.hs ===================================== @@ -18,6 +18,8 @@ module GHC.Core.Map.Expr ( CoreMap, emptyCoreMap, extendCoreMap, lookupCoreMap, foldCoreMap, -- * Alpha equality eqDeBruijnExpr, eqCoreExpr, + -- ** Exports for CoreExprF instances + eqDeBruijnTickish, eqDeBruijnVar, -- * 'TrieMap' class reexports TrieMap(..), insertTM, deleteTM, lkDFreeVar, xtDFreeVar, ===================================== compiler/GHC/Core/Map/Type.hs ===================================== @@ -35,7 +35,6 @@ module GHC.Core.Map.Type ( -- between GHC.Core.Unify (which depends on this module) and GHC.Core import GHC.Prelude -import Data.Functor.Classes import GHC.Core.Type import GHC.Core.Coercion @@ -514,6 +513,7 @@ lookupCME (CME { cme_env = env }) v = lookupVarEnv env v -- export the constructor. Make a helper function if you find yourself -- needing it. data DeBruijn a = D CmEnv a + deriving (Functor,Foldable,Traversable) -- romes:TODO: For internal use only! newtype DeBruijnF f a = DeBruijnF (DeBruijn (f a)) @@ -524,7 +524,7 @@ deBruijnize :: a -> DeBruijn a deBruijnize = D emptyCME -- | Like 'deBruijnize' but synthesizes a @DeBruijnF f a@ from an @f a@ -deBruijnizeF :: f a -> DeBruijnF f a +deBruijnizeF :: Functor f => f a -> DeBruijnF f a deBruijnizeF = DeBruijnF . deBruijnize instance Eq (DeBruijn a) => Eq (DeBruijn [a]) where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/55c41884c1701b787b8d77a84812388259f1e604 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/55c41884c1701b787b8d77a84812388259f1e604 You're receiving 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 Jun 15 09:15:37 2023 From: gitlab at gitlab.haskell.org (Berk Ozkutuk (@ozkutuk)) Date: Thu, 15 Jun 2023 05:15:37 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ozkutuk/sprint-fun Message-ID: <648ad6b9ccae8_c7397181b124c326888@gitlab.mail> Berk Ozkutuk pushed new branch wip/ozkutuk/sprint-fun at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ozkutuk/sprint-fun You're receiving 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 Jun 15 09:23:35 2023 From: gitlab at gitlab.haskell.org (Berk Ozkutuk (@ozkutuk)) Date: Thu, 15 Jun 2023 05:23:35 -0400 Subject: [Git][ghc/ghc][wip/ozkutuk/sprint-fun] Disambiguate closures' printing from thunks (#23507) Message-ID: <648ad8979964a_c739717499dc032876d@gitlab.mail> Berk Ozkutuk pushed to branch wip/ozkutuk/sprint-fun at Glasgow Haskell Compiler / GHC Commits: d3a173ba by Berk Ozkutuk at 2023-06-15T11:22:57+02:00 Disambiguate closures' printing from thunks (#23507) - - - - - 7 changed files: - compiler/GHC/Runtime/Heap/Inspect.hs - testsuite/tests/ghci/scripts/T14828.stdout - + testsuite/tests/ghci/scripts/T23507.script - + testsuite/tests/ghci/scripts/T23507.stdout - testsuite/tests/ghci/scripts/all.T - testsuite/tests/ghci/scripts/ghci055.stdout - testsuite/tests/ghci/scripts/shadow-bindings.stdout Changes: ===================================== compiler/GHC/Runtime/Heap/Inspect.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns, ScopedTypeVariables, MagicHash #-} +{-# LANGUAGE ViewPatterns #-} ----------------------------------------------------------------------------- -- @@ -37,6 +38,7 @@ import GHC.Types.RepType import GHC.Core.Multiplicity import qualified GHC.Core.Unify as U import GHC.Core.TyCon +import GHC.Core.TyCo.Rep (Type(..)) import GHC.Tc.Utils.Monad import GHC.Tc.Utils.TcType @@ -331,6 +333,7 @@ cPprTermBase y = , ifTerm' (isTyCon doubleTyCon . ty) ppr_double , ifTerm' (isTyCon integerTyCon . ty) ppr_integer , ifTerm' (isTyCon naturalTyCon . ty) ppr_natural + , ifSuspension (isFunTy . ty) ppr_fun ] where ifTerm :: (Term -> Bool) @@ -345,6 +348,18 @@ cPprTermBase y = | pred t = f prec t ifTerm' _ _ _ _ = return Nothing + ifSuspension :: (Term -> Bool) + -> (Precedence -> Term -> m (Maybe SDoc)) + -> Precedence -> Term -> m (Maybe SDoc) + ifSuspension pred f prec t at Suspension{} + | pred t = f prec t + ifSuspension _ _ _ _ = return Nothing + + isFunTy :: Type -> Bool + isFunTy (FunTy {}) = True + isFunTy (ForAllTy {}) = True + isFunTy _ = False + isTupleTy ty = fromMaybe False $ do (tc,_) <- tcSplitTyConApp_maybe ty return (isBoxedTupleTyCon tc) @@ -459,6 +474,10 @@ cPprTermBase y = getListTerms t = pprPanic "getListTerms" (ppr t) ppr_list _ _ = panic "doList" + ppr_fun :: Precedence -> Term -> m (Maybe SDoc) + ppr_fun _ (ty -> fun_ty) = return $ Just $ + angleBrackets (underscore <+> dcolon <+> pprType fun_ty) + repPrim :: TyCon -> [Word] -> SDoc repPrim t = rep where ===================================== testsuite/tests/ghci/scripts/T14828.stdout ===================================== @@ -1,12 +1,18 @@ foldl :: Foldable t => (b -> a -> b) -> b -> t a -> b -foldl = (_t1::Foldable t => (b -> a -> b) -> b -> t a -> b) +foldl = <_ :: forall (t :: * -> *) b a. + Foldable t => + (b -> a -> b) -> b -> t a -> b> fmap :: Functor f => (a -> b) -> f a -> f b -fmap = (_t2::Functor f => (a -> b) -> f a -> f b) +fmap = <_ :: forall (f :: * -> *) a b. + Functor f => + (a -> b) -> f a -> f b> return :: Monad m => a -> m a -return = (_t3::Monad m => a -> m a) +return = <_ :: forall (m :: * -> *) a. Monad m => a -> m a> pure :: Applicative f => a -> f a -pure = (_t4::Applicative f => a -> f a) -mempty = (_t5::Monoid a => a) -mappend = (_t6::Monoid a => a -> a -> a) -foldl' = (_t7::Foldable t => (b -> a -> b) -> b -> t a -> b) -f = (_t8::(forall a. a -> a) -> b -> b) +pure = <_ :: forall (f :: * -> *) a. Applicative f => a -> f a> +mempty = <_ :: forall a. Monoid a => a> +mappend = <_ :: forall a. Monoid a => a -> a -> a> +foldl' = <_ :: forall (t :: * -> *) b a. + Foldable t => + (b -> a -> b) -> b -> t a -> b> +f = <_ :: forall b. (forall a. a -> a) -> b -> b> ===================================== testsuite/tests/ghci/scripts/T23507.script ===================================== @@ -0,0 +1,4 @@ +let f () = () +:sprint f +let x = 3 +:sprint x ===================================== testsuite/tests/ghci/scripts/T23507.stdout ===================================== @@ -0,0 +1,2 @@ +f = <_ :: () -> ()> +x = <_ :: forall {a}. Num a => a> ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -375,3 +375,4 @@ test('T22695', normal, ghci_script, ['T22695.script']) test('T22817', normal, ghci_script, ['T22817.script']) test('T22908', normal, ghci_script, ['T22908.script']) test('T23062', normal, ghci_script, ['T23062.script']) +test('T23507', normal, ghci_script, ['T23507.script']) ===================================== testsuite/tests/ghci/scripts/ghci055.stdout ===================================== @@ -1,5 +1,5 @@ *** Exception: Prelude.undefined CallStack (from HasCallStack): undefined, called at :1:7 in interactive:Ghci1 -x :: a = _ +x :: a = <_ :: forall {a}. a> y :: Int = 3 ===================================== testsuite/tests/ghci/scripts/shadow-bindings.stdout ===================================== @@ -27,7 +27,7 @@ it :: () = () Expecting T and foo with function type type T :: * data T = ... -foo :: T -> Bool = _ +foo :: T -> Bool = <_ :: T -> Bool> it :: () = () Expecting T and foo :: Bool type T :: * View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d3a173baa56ccb439cce673214cbf1a84d1fa163 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d3a173baa56ccb439cce673214cbf1a84d1fa163 You're receiving 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 Jun 15 09:28:56 2023 From: gitlab at gitlab.haskell.org (Berk Ozkutuk (@ozkutuk)) Date: Thu, 15 Jun 2023 05:28:56 -0400 Subject: [Git][ghc/ghc][wip/ozkutuk/sprint-fun] Disambiguate closures' printing from thunks (#23507) Message-ID: <648ad9d857542_c7397179ece6c3289dd@gitlab.mail> Berk Ozkutuk pushed to branch wip/ozkutuk/sprint-fun at Glasgow Haskell Compiler / GHC Commits: 4d3f1d67 by Berk Ozkutuk at 2023-06-15T11:28:26+02:00 Disambiguate closures' printing from thunks (#23507) - - - - - 7 changed files: - compiler/GHC/Runtime/Heap/Inspect.hs - testsuite/tests/ghci/scripts/T14828.stdout - + testsuite/tests/ghci/scripts/T23507.script - + testsuite/tests/ghci/scripts/T23507.stdout - testsuite/tests/ghci/scripts/all.T - testsuite/tests/ghci/scripts/ghci055.stdout - testsuite/tests/ghci/scripts/shadow-bindings.stdout Changes: ===================================== compiler/GHC/Runtime/Heap/Inspect.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns, ScopedTypeVariables, MagicHash #-} +{-# LANGUAGE ViewPatterns #-} ----------------------------------------------------------------------------- -- @@ -37,6 +38,7 @@ import GHC.Types.RepType import GHC.Core.Multiplicity import qualified GHC.Core.Unify as U import GHC.Core.TyCon +import GHC.Core.TyCo.Rep (Type(..)) import GHC.Tc.Utils.Monad import GHC.Tc.Utils.TcType @@ -331,6 +333,7 @@ cPprTermBase y = , ifTerm' (isTyCon doubleTyCon . ty) ppr_double , ifTerm' (isTyCon integerTyCon . ty) ppr_integer , ifTerm' (isTyCon naturalTyCon . ty) ppr_natural + , ifSuspension (isFunTy . ty) ppr_fun ] where ifTerm :: (Term -> Bool) @@ -345,6 +348,18 @@ cPprTermBase y = | pred t = f prec t ifTerm' _ _ _ _ = return Nothing + ifSuspension :: (Term -> Bool) + -> (Precedence -> Term -> m (Maybe SDoc)) + -> Precedence -> Term -> m (Maybe SDoc) + ifSuspension pred f prec t at Suspension{} + | pred t = f prec t + ifSuspension _ _ _ _ = return Nothing + + isFunTy :: Type -> Bool + isFunTy (FunTy {}) = True -- Functions e.g. let f = () -> () + isFunTy (ForAllTy {}) = True -- "Overloaded values" e.g. Implicitly let x = 3 + isFunTy _ = False + isTupleTy ty = fromMaybe False $ do (tc,_) <- tcSplitTyConApp_maybe ty return (isBoxedTupleTyCon tc) @@ -459,6 +474,10 @@ cPprTermBase y = getListTerms t = pprPanic "getListTerms" (ppr t) ppr_list _ _ = panic "doList" + ppr_fun :: Precedence -> Term -> m (Maybe SDoc) + ppr_fun _ (ty -> fun_ty) = return $ Just $ + angleBrackets (underscore <+> dcolon <+> pprType fun_ty) + repPrim :: TyCon -> [Word] -> SDoc repPrim t = rep where ===================================== testsuite/tests/ghci/scripts/T14828.stdout ===================================== @@ -1,12 +1,18 @@ foldl :: Foldable t => (b -> a -> b) -> b -> t a -> b -foldl = (_t1::Foldable t => (b -> a -> b) -> b -> t a -> b) +foldl = <_ :: forall (t :: * -> *) b a. + Foldable t => + (b -> a -> b) -> b -> t a -> b> fmap :: Functor f => (a -> b) -> f a -> f b -fmap = (_t2::Functor f => (a -> b) -> f a -> f b) +fmap = <_ :: forall (f :: * -> *) a b. + Functor f => + (a -> b) -> f a -> f b> return :: Monad m => a -> m a -return = (_t3::Monad m => a -> m a) +return = <_ :: forall (m :: * -> *) a. Monad m => a -> m a> pure :: Applicative f => a -> f a -pure = (_t4::Applicative f => a -> f a) -mempty = (_t5::Monoid a => a) -mappend = (_t6::Monoid a => a -> a -> a) -foldl' = (_t7::Foldable t => (b -> a -> b) -> b -> t a -> b) -f = (_t8::(forall a. a -> a) -> b -> b) +pure = <_ :: forall (f :: * -> *) a. Applicative f => a -> f a> +mempty = <_ :: forall a. Monoid a => a> +mappend = <_ :: forall a. Monoid a => a -> a -> a> +foldl' = <_ :: forall (t :: * -> *) b a. + Foldable t => + (b -> a -> b) -> b -> t a -> b> +f = <_ :: forall b. (forall a. a -> a) -> b -> b> ===================================== testsuite/tests/ghci/scripts/T23507.script ===================================== @@ -0,0 +1,4 @@ +let f () = () +:sprint f +let x = 3 +:sprint x ===================================== testsuite/tests/ghci/scripts/T23507.stdout ===================================== @@ -0,0 +1,2 @@ +f = <_ :: () -> ()> +x = <_ :: forall {a}. Num a => a> ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -375,3 +375,4 @@ test('T22695', normal, ghci_script, ['T22695.script']) test('T22817', normal, ghci_script, ['T22817.script']) test('T22908', normal, ghci_script, ['T22908.script']) test('T23062', normal, ghci_script, ['T23062.script']) +test('T23507', normal, ghci_script, ['T23507.script']) ===================================== testsuite/tests/ghci/scripts/ghci055.stdout ===================================== @@ -1,5 +1,5 @@ *** Exception: Prelude.undefined CallStack (from HasCallStack): undefined, called at :1:7 in interactive:Ghci1 -x :: a = _ +x :: a = <_ :: forall {a}. a> y :: Int = 3 ===================================== testsuite/tests/ghci/scripts/shadow-bindings.stdout ===================================== @@ -27,7 +27,7 @@ it :: () = () Expecting T and foo with function type type T :: * data T = ... -foo :: T -> Bool = _ +foo :: T -> Bool = <_ :: T -> Bool> it :: () = () Expecting T and foo :: Bool type T :: * View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4d3f1d67fdfd157826715eea83e163581d4449da -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4d3f1d67fdfd157826715eea83e163581d4449da You're receiving 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 Jun 15 09:37:05 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Thu, 15 Jun 2023 05:37:05 -0400 Subject: [Git][ghc/ghc][wip/int-index/vis-flag-tests] 9 commits: compiler: Cross-reference Note [StgToJS design] Message-ID: <648adbc19e1e4_c739717499dc03365fe@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/vis-flag-tests at Glasgow Haskell Compiler / GHC Commits: 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - e51ebc8d by Vladislav Zavialov at 2023-06-15T11:36:58+02:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - 30 changed files: - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/JS/Make.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Arg.hs - compiler/GHC/StgToJS/Closure.hs - compiler/GHC/StgToJS/CodeGen.hs - − compiler/GHC/StgToJS/CoreUtils.hs - compiler/GHC/StgToJS/DataCon.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Ids.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/StgToJS/Sinker.hs - − compiler/GHC/StgToJS/StgUtils.hs - compiler/GHC/StgToJS/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/ghc.cabal.in - docs/users_guide/using-warnings.rst - libraries/base/GHC/IO/FD.hs - libraries/base/jsbits/base.js - rts/js/arith.js The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/84d31c6e27480b97f9cf0e57147abdbf5a46f7a6...e51ebc8d63a9c983481b2ddf995b0e8b64e29261 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/84d31c6e27480b97f9cf0e57147abdbf5a46f7a6...e51ebc8d63a9c983481b2ddf995b0e8b64e29261 You're receiving 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 Jun 15 09:55:56 2023 From: gitlab at gitlab.haskell.org (Ben Price (@brprice)) Date: Thu, 15 Jun 2023 05:55:56 -0400 Subject: [Git][ghc/ghc][wip/global-local-mismatch-info] Lint: more details on "Occurrence is GlobalId, but binding is LocalId" Message-ID: <648ae02c732ea_c73971783c4b435623e@gitlab.mail> Ben Price pushed to branch wip/global-local-mismatch-info at Glasgow Haskell Compiler / GHC Commits: 636b3e10 by Ben Price at 2023-06-12T21:25:24+01:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - 1 changed file: - compiler/GHC/Core/Lint.hs Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -3243,7 +3243,7 @@ lookupIdInScope id_occ = do { in_scope_ids <- getInScopeIds ; case lookupVarEnv in_scope_ids id_occ of Just (id_bndr, linted_ty) - -> do { checkL (not (bad_global id_bndr)) global_in_scope + -> do { checkL (not (bad_global id_bndr)) $ global_in_scope id_bndr ; return (id_bndr, linted_ty) } Nothing -> do { checkL (not is_local) local_out_of_scope ; return (id_occ, idType id_occ) } } @@ -3252,8 +3252,10 @@ lookupIdInScope id_occ where is_local = mustHaveLocalBinding id_occ local_out_of_scope = text "Out of scope:" <+> pprBndr LetBind id_occ - global_in_scope = hang (text "Occurrence is GlobalId, but binding is LocalId") - 2 (pprBndr LetBind id_occ) + global_in_scope id_bndr = hang (text "Occurrence is GlobalId, but binding is LocalId") + 2 $ vcat [hang (text "occurrence:") 2 $ pprBndr LetBind id_occ + ,hang (text "binder :") 2 $ pprBndr LetBind id_bndr + ] bad_global id_bnd = isGlobalId id_occ && isLocalId id_bnd && not (isWiredIn id_occ) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/636b3e10b541a25631d43a1031346d4fb222dd25 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/636b3e10b541a25631d43a1031346d4fb222dd25 You're receiving 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 Jun 15 10:08:06 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Thu, 15 Jun 2023 06:08:06 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 150 commits: Migrate errors in GHC.Tc.Validity Message-ID: <648ae3065bd2_c7397179ece58358529@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - eb9065c2 by Rodrigo Mesquita at 2023-06-15T11:06:21+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 39ac7670 by Ben Gamari at 2023-06-15T11:06:23+01:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - a75a307c by Ben Gamari at 2023-06-15T11:06:23+01:00 ghc-toolchain: Initial commit - - - - - 679f08be by Ben Gamari at 2023-06-15T11:07:48+01:00 Rip out runtime linker/compiler checks - - - - - 301018ea by Ben Gamari at 2023-06-15T11:07:49+01:00 configure: Rip out toolchain selection logic - - - - - 7738378b by Rodrigo Mesquita at 2023-06-15T11:07:49+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b480f4ab1514ac0a4fc957db199d1a0279. Revert get_arm_isa deletion from 74f03f243d08aa910d39cdd9dadb976e9386283a As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X - - - - - f5318ded by Rodrigo Mesquita at 2023-06-15T11:07:49+01:00 configure: Revert ripping out of toolchain selection logic - - - - - 8d7e5fbc by Rodrigo Mesquita at 2023-06-15T11:07:49+01:00 Stop configuring into settings unused Ld command - - - - - 27108bed by Rodrigo Mesquita at 2023-06-15T11:07:49+01:00 configure: Create and validate toolchain target file - - - - - a762583c by Rodrigo Mesquita at 2023-06-15T11:07:50+01:00 Fixes for ghc-toolchain to match configure output - - - - - 1f210e46 by Rodrigo Mesquita at 2023-06-15T11:07:50+01:00 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now - - - - - 90058e6b by Rodrigo Mesquita at 2023-06-15T11:07:50+01:00 Tweak to prep_target_file - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - HACKING.md - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types/Prim.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/CoreToStg/Prep.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e398306c264d98fa02eed082f275ced96da074a1...90058e6b49370c1613909c2b0012d44168dd25c2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e398306c264d98fa02eed082f275ced96da074a1...90058e6b49370c1613909c2b0012d44168dd25c2 You're receiving 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 Jun 15 10:20:24 2023 From: gitlab at gitlab.haskell.org (Ben Price (@brprice)) Date: Thu, 15 Jun 2023 06:20:24 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/lint-occ-bndr-name-mismatch Message-ID: <648ae5e81c0bc_c7397181b124c369030@gitlab.mail> Ben Price pushed new branch wip/lint-occ-bndr-name-mismatch at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/lint-occ-bndr-name-mismatch You're receiving 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 Jun 15 10:32:22 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Thu, 15 Jun 2023 06:32:22 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 12 commits: Configure CPP into settings Message-ID: <648ae8b68a02c_c7397179ece6c3736fd@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: a5da5bd5 by Rodrigo Mesquita at 2023-06-15T11:30:54+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - ab13551c by Ben Gamari at 2023-06-15T11:31:13+01:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 7d106802 by Ben Gamari at 2023-06-15T11:31:46+01:00 ghc-toolchain: Initial commit - - - - - 2ddfe05a by Ben Gamari at 2023-06-15T11:31:46+01:00 Rip out runtime linker/compiler checks - - - - - 6a754b2d by Ben Gamari at 2023-06-15T11:31:46+01:00 configure: Rip out toolchain selection logic - - - - - 0125a9fc by Rodrigo Mesquita at 2023-06-15T11:31:46+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b480f4ab1514ac0a4fc957db199d1a0279. Revert get_arm_isa deletion from 74f03f243d08aa910d39cdd9dadb976e9386283a As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X - - - - - bc1fa2b9 by Rodrigo Mesquita at 2023-06-15T11:31:46+01:00 configure: Revert ripping out of toolchain selection logic - - - - - 69ab81e2 by Rodrigo Mesquita at 2023-06-15T11:31:46+01:00 Stop configuring into settings unused Ld command - - - - - 24d0ae28 by Rodrigo Mesquita at 2023-06-15T11:31:47+01:00 configure: Create and validate toolchain target file - - - - - 42df34dd by Rodrigo Mesquita at 2023-06-15T11:31:47+01:00 Fixes for ghc-toolchain to match configure output - - - - - 78f949e8 by Rodrigo Mesquita at 2023-06-15T11:31:47+01:00 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now - - - - - 1dc9a134 by Rodrigo Mesquita at 2023-06-15T11:31:47+01:00 Tweak to prep_target_file - - - - - 30 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - + default.target.in - distrib/configure.ac.in - ghc/Main.hs - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - 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/90058e6b49370c1613909c2b0012d44168dd25c2...1dc9a1341a859b5feca6134a1a440fb33bd2c0f3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/90058e6b49370c1613909c2b0012d44168dd25c2...1dc9a1341a859b5feca6134a1a440fb33bd2c0f3 You're receiving 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 Jun 15 10:37:45 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Thu, 15 Jun 2023 06:37:45 -0400 Subject: [Git][ghc/ghc][wip/rip-solaris-configuration] 140 commits: Migrate errors in GHC.Tc.Validity Message-ID: <648ae9f9a4bc_c7397194f278437436a@gitlab.mail> Rodrigo Mesquita pushed to branch wip/rip-solaris-configuration at Glasgow Haskell Compiler / GHC Commits: 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - a5da5bd5 by Rodrigo Mesquita at 2023-06-15T11:30:54+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - ab13551c by Ben Gamari at 2023-06-15T11:31:13+01:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - HACKING.md - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types/Prim.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/UsageEnv.hs - compiler/GHC/CoreToStg/Prep.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5033fdbe0dc625875d87d4bf637db13b642f2fb8...ab13551c6dd538ed122e12b3b0ab1b9a48589959 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5033fdbe0dc625875d87d4bf637db13b642f2fb8...ab13551c6dd538ed122e12b3b0ab1b9a48589959 You're receiving 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 Jun 15 10:45:01 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 15 Jun 2023 06:45:01 -0400 Subject: [Git][ghc/ghc][wip/forall-vis-coercions] Wibble Message-ID: <648aebad72302_c7397179ece583745a1@gitlab.mail> Simon Peyton Jones pushed to branch wip/forall-vis-coercions at Glasgow Haskell Compiler / GHC Commits: 0d88a768 by Simon Peyton Jones at 2023-06-15T11:44:51+01:00 Wibble - - - - - 3 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Tc/Solver/Equality.hs Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -41,7 +41,7 @@ module GHC.Core.Coercion ( mkInstCo, mkAppCo, mkAppCos, mkTyConAppCo, mkFunCo, mkFunCo2, mkFunCoNoFTF, mkFunResCo, mkNakedFunCo, - mkForAllCo, mkHomoForAllCos, + mkNakedForAllCo, mkForAllCo, mkHomoForAllCos, mkPhantomCo, mkHoleCo, mkUnivCo, mkSubCo, mkAxiomInstCo, mkProofIrrelCo, @@ -969,11 +969,21 @@ once ~# is made to be homogeneous. -- | Make a Coercion from a tycovar, a kind coercion, and a body coercion. -- The kind of the tycovar should be the left-hand kind of the kind coercion. -- See Note [Unused coercion variable in ForAllCo] -mkForAllCo :: TyCoVar -> ForAllTyFlag -> ForAllTyFlag -> CoercionN -> Coercion -> Coercion +mkForAllCo :: HasDebugCallStack => TyCoVar -> ForAllTyFlag -> ForAllTyFlag -> CoercionN -> Coercion -> Coercion mkForAllCo v visL visR kind_co co - | assert (varType v `eqType` (coercionLKind kind_co)) True - , assert (isTyVar v || almostDevoidCoVarOfCo v co) True - , Just (ty, r) <- isReflCo_maybe co + = assertPpr (varType v `eqType` (coercionLKind kind_co)) + (vcat [ ppr v <+> dcolon <+> ppr (varType v) + , text "kind_co:" <+> ppr kind_co + , text "lkind:" <+> ppr (coercionLKind kind_co) ]) $ + assert (isTyVar v || almostDevoidCoVarOfCo v co) $ + mkNakedForAllCo v visL visR kind_co co + +mkNakedForAllCo :: TyCoVar -> ForAllTyFlag -> ForAllTyFlag -> CoercionN -> Coercion -> Coercion +-- This version lacks the assertion checks. +-- Used during type checking when the arguments may (legitimately) not be zonked +-- and so the assertions might (bogusly) fail +mkNakedForAllCo v visL visR kind_co co + | Just (ty, r) <- isReflCo_maybe co , isGReflCo kind_co , visL `eqForAllVis` visR = mkReflCo r (mkTyCoForAllTy v visL ty) ===================================== compiler/GHC/Core/Coercion.hs-boot ===================================== @@ -16,7 +16,7 @@ import GHC.Utils.Misc mkReflCo :: Role -> Type -> Coercion mkTyConAppCo :: HasDebugCallStack => Role -> TyCon -> [Coercion] -> Coercion mkAppCo :: Coercion -> Coercion -> Coercion -mkForAllCo :: TyCoVar -> ForAllTyFlag -> ForAllTyFlag -> Coercion -> Coercion -> Coercion +mkForAllCo :: HasDebugCallStack => TyCoVar -> ForAllTyFlag -> ForAllTyFlag -> Coercion -> Coercion -> Coercion mkFunCo :: Role -> FunTyFlag -> CoercionN -> Coercion -> Coercion -> Coercion mkNakedFunCo :: Role -> FunTyFlag -> CoercionN -> Coercion -> Coercion -> Coercion mkFunCo2 :: Role -> FunTyFlag -> FunTyFlag -> CoercionN -> Coercion -> Coercion -> Coercion ===================================== compiler/GHC/Tc/Solver/Equality.hs ===================================== @@ -517,7 +517,7 @@ can_eq_nc_forall ev eq_rel s1 s2 -- skol_tv is already in the in-scope set, but the -- free vars of kind_co are not; hence "...AndInScope" ; co <- go uenv skol_tvs subst' bndrs1 bndrs2 - ; return (mkForAllCo skol_tv vis1 vis2 kind_co co)} + ; return (mkNakedForAllCo skol_tv vis1 vis2 kind_co co)} -- Done: unify phi1 ~ phi2 go uenv [] subst bndrs1 bndrs2 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0d88a768e89c6d89e2312ade3d348e8881325be2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0d88a768e89c6d89e2312ade3d348e8881325be2 You're receiving 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 Jun 15 12:20:19 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 15 Jun 2023 08:20:19 -0400 Subject: [Git][ghc/ghc][wip/T22010] Finally fix atomic_inc64 Message-ID: <648b0203caf46_c7397a33d470408873@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: f96bfd74 by Jaro Reinders at 2023-06-15T14:20:08+02:00 Finally fix atomic_inc64 - - - - - 1 changed file: - compiler/cbits/genSym.c Changes: ===================================== compiler/cbits/genSym.c ===================================== @@ -14,6 +14,20 @@ HsWord64 ghc_unique_counter = 0; HsInt ghc_unique_inc = 1; #endif +// This function has been added to the RTS. Here we pessimistically assume +// that a threaded RTS is used. This function is only used for bootstrapping. +#if !MIN_VERSION_GLASGOW_HASKELL(9,7,0,0) +EXTERN_INLINE StgWord64 +atomic_inc64(StgWord64 volatile* p, StgWord64 incr) +{ +#if defined(HAVE_C11_ATOMICS) + return __atomic_add_fetch(p, incr, __ATOMIC_SEQ_CST); +#else + return __sync_add_and_fetch(p, incr); +#endif +} +#endif + #define UNIQUE_BITS (sizeof (HsWord64) * 8 - UNIQUE_TAG_BITS) #define UNIQUE_MASK ((1ULL << UNIQUE_BITS) - 1) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f96bfd74d6a743181434e36319fa4caff4abb853 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f96bfd74d6a743181434e36319fa4caff4abb853 You're receiving 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 Jun 15 12:26:19 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Thu, 15 Jun 2023 08:26:19 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] 2 commits: Fix immediate operand related guards Message-ID: <648b036bec9cf_c73971783d224411557@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: eef804e8 by Sven Tennie at 2023-06-15T10:03:02+00:00 Fix immediate operand related guards For most operations, the immediate's boundaries are those of a 12bit integer. - - - - - b4e9fc74 by Sven Tennie at 2023-06-15T12:21:13+00:00 Assign x31 to be IP register And, use it for register spilling. - - - - - 3 changed files: - compiler/CodeGen.Platform.h - compiler/GHC/CmmToAsm/RV64/CodeGen.hs - compiler/GHC/CmmToAsm/RV64/Instr.hs Changes: ===================================== compiler/CodeGen.Platform.h ===================================== @@ -1101,6 +1101,9 @@ freeReg 3 = False freeReg 4 = False -- frame pointer freeReg 8 = False +-- made-up inter-procedural (ip) register +-- See Note [The made-up RISCV64 IP register] +freeReg 31 = False # if defined(REG_Base) freeReg REG_Base = False ===================================== compiler/GHC/CmmToAsm/RV64/CodeGen.hs ===================================== @@ -689,12 +689,12 @@ getRegister' config plat expr -- 1. Compute Reg +/- n directly. -- For Add/Sub we can directly encode 12bits, or 12bits lsl #12. CmmMachOp (MO_Add w) [(CmmReg reg), CmmLit (CmmInt n _)] - | n > 0 && n < 4096 -> return $ Any (intFormat w) (\d -> unitOL $ annExpr expr (ADD (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n)))) + | fitsIn12bitImm n -> return $ Any (intFormat w) (\d -> unitOL $ annExpr expr (ADD (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n)))) -- TODO: 12bits lsl #12; e.g. lower 12 bits of n are 0; shift n >> 12, and set lsl to #12. where w' = formatToWidth (cmmTypeFormat (cmmRegType plat reg)) r' = getRegisterReg plat reg CmmMachOp (MO_Sub w) [(CmmReg reg), CmmLit (CmmInt n _)] - | n > 0 && n < 4096 -> return $ Any (intFormat w) (\d -> unitOL $ annExpr expr (SUB (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n)))) + | fitsIn12bitImm n -> return $ Any (intFormat w) (\d -> unitOL $ annExpr expr (SUB (OpReg w d) (OpReg w' r') (OpImm (ImmInteger n)))) -- TODO: 12bits lsl #12; e.g. lower 12 bits of n are 0; shift n >> 12, and set lsl to #12. where w' = formatToWidth (cmmTypeFormat (cmmRegType plat reg)) r' = getRegisterReg plat reg ===================================== compiler/GHC/CmmToAsm/RV64/Instr.hs ===================================== @@ -341,7 +341,7 @@ patchJumpInstr instr patchF -- is essentially [-256,255], or [0, 0xFFF]*8 = [0, 32760] for 64bits. -- -- The @RESERVED_C_STACK_BYTES@ is 16k, so we can't address any location in a --- single instruction. The idea is to use the Inter Procedure 0 (ip0) register +-- single instruction. The idea is to use the Inter Procedure 0 (ip) register -- to perform the computations for larger offsets. -- -- Using sp to compute the offset will violate assumptions about the stack pointer @@ -361,18 +361,18 @@ mkSpillInstr config reg delta slot = case off - delta of imm | fitsIn12bitImm imm -> [mkStrSpImm imm] imm -> - [ movImmToIp0 imm, - addSpToIp0, - mkStrIp0 + [ movImmToIp imm, + addSpToIp, + mkStrIp ] where fmt = case reg of RegReal (RealRegSingle n) | n < 32 -> II64 _ -> FF64 mkStrSpImm imm = ANN (text "Spill@" <> int (off - delta)) $ STR fmt (OpReg W64 reg) (OpAddr (AddrRegImm sp_reg (ImmInt imm))) - movImmToIp0 imm = ANN (text "Spill: IP0 <- " <> int imm) $ MOV ip0 (OpImm (ImmInt imm)) - addSpToIp0 = ANN (text "Spill: IP0 <- SP + IP0 ") $ ADD ip0 ip0 sp - mkStrIp0 = ANN (text "Spill@" <> int (off - delta)) $ STR fmt (OpReg W64 reg) (OpAddr (AddrReg ip0_reg)) + movImmToIp imm = ANN (text "Spill: IP <- " <> int imm) $ MOV ip (OpImm (ImmInt imm)) + addSpToIp = ANN (text "Spill: IP <- SP + IP ") $ ADD ip ip sp + mkStrIp = ANN (text "Spill@" <> int (off - delta)) $ STR fmt (OpReg W64 reg) (OpAddr (AddrReg ip_reg)) off = spillSlotToOffset config slot @@ -387,18 +387,18 @@ mkLoadInstr config reg delta slot = case off - delta of imm | fitsIn12bitImm imm -> [mkLdrSpImm imm] imm -> - [ movImmToIp0 imm, - addSpToIp0, - mkLdrIp0 + [ movImmToIp imm, + addSpToIp, + mkLdrIp ] where fmt = case reg of RegReal (RealRegSingle n) | n < 32 -> II64 _ -> FF64 mkLdrSpImm imm = ANN (text "Reload@" <> int (off - delta)) $ LDR fmt (OpReg W64 reg) (OpAddr (AddrRegImm sp_reg (ImmInt imm))) - movImmToIp0 imm = ANN (text "Reload: IP0 <- " <> int imm) $ MOV ip0 (OpImm (ImmInt imm)) - addSpToIp0 = ANN (text "Reload: IP0 <- SP + IP0 ") $ ADD ip0 ip0 sp - mkLdrIp0 = ANN (text "Reload@" <> int (off - delta)) $ LDR fmt (OpReg W64 reg) (OpAddr (AddrReg ip0_reg)) + movImmToIp imm = ANN (text "Reload: IP <- " <> int imm) $ MOV ip (OpImm (ImmInt imm)) + addSpToIp = ANN (text "Reload: IP <- SP + IP ") $ ADD ip ip sp + mkLdrIp = ANN (text "Reload@" <> int (off - delta)) $ LDR fmt (OpReg W64 reg) (OpAddr (AddrReg ip_reg)) off = spillSlotToOffset config slot @@ -442,15 +442,17 @@ mkJumpInstr id = [B (TBlock id)] mkStackAllocInstr :: Platform -> Int -> [Instr] mkStackAllocInstr platform n | n == 0 = [] - | n > 0 && n < 4096 = [ ANN (text "Alloc More Stack") $ SUB sp sp (OpImm (ImmInt n)) ] - | n > 0 = ANN (text "Alloc More Stack") (SUB sp sp (OpImm (ImmInt 4095))) : mkStackAllocInstr platform (n - 4095) + | n > 0 && fitsIn12bitImm n = [ ANN (text "Alloc More Stack") $ SUB sp sp (OpImm (ImmInt n)) ] + -- TODO: This case may be optimized with the IP register for large n-s + | n > 0 = ANN (text "Alloc More Stack") (SUB sp sp (OpImm (ImmInt intMax12bit))) : mkStackAllocInstr platform (n - intMax12bit) mkStackAllocInstr _platform n = pprPanic "mkStackAllocInstr" (int n) mkStackDeallocInstr :: Platform -> Int -> [Instr] mkStackDeallocInstr platform n | n == 0 = [] - | n > 0 && n < 4096 = [ ANN (text "Dealloc More Stack") $ ADD sp sp (OpImm (ImmInt n)) ] - | n > 0 = ANN (text "Dealloc More Stack") (ADD sp sp (OpImm (ImmInt 4095))) : mkStackDeallocInstr platform (n - 4095) + | n > 0 && fitsIn12bitImm n = [ ANN (text "Dealloc More Stack") $ ADD sp sp (OpImm (ImmInt n)) ] + -- TODO: This case may be optimized with the IP register for large n-s + | n > 0 = ANN (text "Dealloc More Stack") (ADD sp sp (OpImm (ImmInt intMax12bit))) : mkStackDeallocInstr platform (n - intMax12bit) mkStackDeallocInstr _platform n = pprPanic "mkStackDeallocInstr" (int n) -- @@ -762,21 +764,38 @@ data Operand opReg :: Width -> Reg -> Operand opReg = OpReg -ra_reg, sp_reg :: Reg +-- Note [The made-up RISCV64 IP register] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- RISCV64 has no inter-procedural register in its ABI. However, we need one to +-- make register spills/loads to/from high number slots. I.e. slot numbers that +-- do not fit in a 12bit integer which is used as immediate in the arithmetic +-- operations. Thus, we're marking one additional register (x31) as permanently +-- non-free and call it IP. +-- +-- IP can be used as temporary register in all operations. Just be aware that it +-- may be clobbered as soon as you loose direct control over it (i.e. using IP +-- by-passes the register allocation/spilling mechanisms.) It should be fine to +-- use it as temporary register in a MachOp translation as long as you don't +-- rely on its value beyond this limited scope. +-- +-- X31 is a caller-saved register. I.e. there are no guarantees about what the +-- callee does with it. That's exactly what we want here. + +zero_reg, ra_reg, sp_reg, ip_reg :: Reg zero_reg = RegReal (RealRegSingle 0) ra_reg = RegReal (RealRegSingle 1) sp_reg = RegReal (RealRegSingle 2) -ip0_reg = RegReal (RealRegSingle 16) +ip_reg = RegReal (RealRegSingle 31) -zero, sp, ip0 :: Operand +zero, ra, sp, gp, tp, fp, ip :: Operand zero = OpReg W64 zero_reg ra = OpReg W64 ra_reg sp = OpReg W64 sp_reg gp = OpReg W64 (RegReal (RealRegSingle 3)) tp = OpReg W64 (RegReal (RealRegSingle 4)) fp = OpReg W64 (RegReal (RealRegSingle 8)) - -ip0 = OpReg W64 ip0_reg +ip = OpReg W64 ip_reg _x :: Int -> Operand _x i = OpReg W64 (RegReal (RealRegSingle i)) @@ -865,9 +884,12 @@ opRegSExt w _r = pprPanic "opRegSExt" (ppr w) fitsIn12bitImm :: (Num a, Ord a) => a -> Bool fitsIn12bitImm off = off >= intMin12bit && off <= intMax12bit - where - intMin12bit = -2048 - intMax12bit = 2047 + +intMin12bit :: Num a => a +intMin12bit = -2048 + +intMax12bit :: Num a => a +intMax12bit = 2047 fitsIn32bits :: (Num a, Ord a, Bits a) => a -> Bool fitsIn32bits i = (-1 `shiftL` 31) <= i && i <= (1 `shiftL` 31 -1) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/deff328fd8c52d8a98e1f87f5db37afeef7735fa...b4e9fc740dc2c9d29a9ee285d6dea539d453dde0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/deff328fd8c52d8a98e1f87f5db37afeef7735fa...b4e9fc740dc2c9d29a9ee285d6dea539d453dde0 You're receiving 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 Jun 15 12:46:34 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Thu, 15 Jun 2023 08:46:34 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/DIB-INSTANCES] 12 commits: Add more flags for dumping core passes (#23491) Message-ID: <648b082aa872b_c73971783c2e842915a@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/DIB-INSTANCES at Glasgow Haskell Compiler / GHC Commits: 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - b65bca83 by Andrei Borzenkov at 2023-06-15T16:46:24+04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 30 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/JS/Make.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Arg.hs - compiler/GHC/StgToJS/Closure.hs - compiler/GHC/StgToJS/CodeGen.hs - − compiler/GHC/StgToJS/CoreUtils.hs - compiler/GHC/StgToJS/DataCon.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Ids.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/StgToJS/Sinker.hs - − compiler/GHC/StgToJS/StgUtils.hs - compiler/GHC/StgToJS/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Types/Demand.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/17fb8813f5fc7431b00fca3607691dc9737fed8b...b65bca8301a0c4c447c9691f6152b289d37647d7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/17fb8813f5fc7431b00fca3607691dc9737fed8b...b65bca8301a0c4c447c9691f6152b289d37647d7 You're receiving 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 Jun 15 12:48:15 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 15 Jun 2023 08:48:15 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 13 commits: compiler: Cross-reference Note [StgToJS design] Message-ID: <648b088fd579a_c73971783c2e84295ab@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - df824e85 by Sylvain Henry at 2023-06-15T08:48:10-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 6097f32d by Sylvain Henry at 2023-06-15T08:48:10-04:00 JS: testsuite: update ticket numbers - - - - - d658edd0 by Sylvain Henry at 2023-06-15T08:48:10-04:00 JS: more triage - - - - - 5050fc51 by Krzysztof Gogolewski at 2023-06-15T08:48:11-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 30 changed files: - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/JS/Make.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Arg.hs - compiler/GHC/StgToJS/Closure.hs - compiler/GHC/StgToJS/CodeGen.hs - − compiler/GHC/StgToJS/CoreUtils.hs - compiler/GHC/StgToJS/DataCon.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/FFI.hs - compiler/GHC/StgToJS/Ids.hs - compiler/GHC/StgToJS/Prim.hs - compiler/GHC/StgToJS/Sinker.hs - − compiler/GHC/StgToJS/StgUtils.hs - compiler/GHC/StgToJS/Utils.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Errors/Types/PromotionErr.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Types/BasicTypes.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Types/Error/Codes.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/d9dee1024e02f11a54cd1f6b93d09c873e448c29...5050fc5122c702932976f65f44aa898c6ce55f69 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d9dee1024e02f11a54cd1f6b93d09c873e448c29...5050fc5122c702932976f65f44aa898c6ce55f69 You're receiving 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 Jun 15 12:55:51 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 15 Jun 2023 08:55:51 -0400 Subject: [Git][ghc/ghc][wip/T22010] Fix unique_counter in the rts Message-ID: <648b0a57cb9a7_c7397179ece6c438495@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: f0d4031d by Jaro Reinders at 2023-06-15T14:55:39+02:00 Fix unique_counter in the rts - - - - - 5 changed files: - compiler/cbits/genSym.c - rts/Globals.c - rts/RtsSymbols.c - rts/include/rts/Globals.h - rts/js/globals.js Changes: ===================================== compiler/cbits/genSym.c ===================================== @@ -9,8 +9,10 @@ // // The CPP is thus about the RTS version GHC is linked against, and not the // version of the GHC being built. -#if !MIN_VERSION_GLASGOW_HASKELL(9,3,0,0) +#if !MIN_VERSION_GLASGOW_HASKELL(9,7,0,0) HsWord64 ghc_unique_counter = 0; +#endif +#if !MIN_VERSION_GLASGOW_HASKELL(9,3,0,0) HsInt ghc_unique_inc = 1; #endif ===================================== rts/Globals.c ===================================== @@ -108,5 +108,5 @@ mkStoreAccessor(LibHSghcGlobalHasPprDebug) mkStoreAccessor(LibHSghcGlobalHasNoDebugOutput) mkStoreAccessor(LibHSghcGlobalHasNoStateHack) -HsInt ghc_unique_counter = 0; +HsWord64 ghc_unique_counter = 0; HsInt ghc_unique_inc = 1; ===================================== rts/RtsSymbols.c ===================================== @@ -902,7 +902,7 @@ extern char **environ; SymI_HasProto(stopHeapProfTimer) \ SymI_HasProto(requestHeapCensus) \ SymI_HasProto(atomic_inc) \ - SymI_HasProto(atomic_inc64) \ + SymI_HasProto(atomic_inc64) \ SymI_HasProto(atomic_dec) \ SymI_HasProto(hs_spt_lookup) \ SymI_HasProto(hs_spt_insert) \ ===================================== rts/include/rts/Globals.h ===================================== @@ -32,5 +32,5 @@ mkStoreAccessorPrototype(LibHSghcFastStringTable) mkStoreAccessorPrototype(LibHSghcGlobalHasPprDebug) mkStoreAccessorPrototype(LibHSghcGlobalHasNoDebugOutput) mkStoreAccessorPrototype(LibHSghcGlobalHasNoStateHack) -extern HsInt ghc_unique_counter; +extern HsWord64 ghc_unique_counter; extern HsInt ghc_unique_inc; ===================================== rts/js/globals.js ===================================== @@ -20,5 +20,6 @@ GVAR(h$getOrSetLibHSghcFastStringTable, faststring_table) var h$ghc_unique_inc = h$newByteArray(4); h$ghc_unique_inc.i3[0] = 1; -var h$ghc_unique_counter = h$newByteArray(4); +var h$ghc_unique_counter = h$newByteArray(8); h$ghc_unique_counter.i3[0] = 0; +h$ghc_unique_counter.i3[1] = 0; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f0d4031d667ad78c7ce79e65091241809bdfa0c9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f0d4031d667ad78c7ce79e65091241809bdfa0c9 You're receiving 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 Jun 15 13:16:33 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 15 Jun 2023 09:16:33 -0400 Subject: [Git][ghc/ghc][wip/T22010] Rename unique counter to avoid clash with old rts Message-ID: <648b0f31d2a18_c73971783c4b44497d@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 51c4ee9e by Jaro Reinders at 2023-06-15T15:16:27+02:00 Rename unique counter to avoid clash with old rts - - - - - 6 changed files: - compiler/GHC/Types/Unique/Supply.hs - compiler/cbits/genSym.c - rts/Globals.c - rts/RtsSymbols.c - rts/include/rts/Globals.h - rts/js/globals.js Changes: ===================================== compiler/GHC/Types/Unique/Supply.hs ===================================== @@ -235,7 +235,7 @@ foreign import ccall unsafe "genSym" genSym :: IO Word64 genSym :: IO Word64 genSym = do let !mask = (1 `unsafeShiftL` uNIQUE_BITS) - 1 - let !(Ptr counter) = ghc_unique_counter + let !(Ptr counter) = ghc_unique_counter64 let !(Ptr inc_ptr) = ghc_unique_inc u <- IO $ \s0 -> case readWordOffAddr# inc_ptr 0# s0 of (# s1, inc #) -> case fetchAddWordAddr# counter inc s1 of @@ -254,13 +254,13 @@ genSym = do return u #endif -foreign import ccall unsafe "&ghc_unique_counter" ghc_unique_counter :: Ptr Word64 -foreign import ccall unsafe "&ghc_unique_inc" ghc_unique_inc :: Ptr Int +foreign import ccall unsafe "&ghc_unique_counter64" ghc_unique_counter64 :: Ptr Word64 +foreign import ccall unsafe "&ghc_unique_inc" ghc_unique_inc :: Ptr Int initUniqSupply :: Word64 -> Int -> IO () initUniqSupply counter inc = do - poke ghc_unique_counter counter - poke ghc_unique_inc inc + poke ghc_unique_counter64 counter + poke ghc_unique_inc inc uniqFromMask :: Char -> IO Unique uniqFromMask !mask ===================================== compiler/cbits/genSym.c ===================================== @@ -10,7 +10,7 @@ // The CPP is thus about the RTS version GHC is linked against, and not the // version of the GHC being built. #if !MIN_VERSION_GLASGOW_HASKELL(9,7,0,0) -HsWord64 ghc_unique_counter = 0; +HsWord64 ghc_unique_counter64 = 0; #endif #if !MIN_VERSION_GLASGOW_HASKELL(9,3,0,0) HsInt ghc_unique_inc = 1; @@ -34,7 +34,7 @@ atomic_inc64(StgWord64 volatile* p, StgWord64 incr) #define UNIQUE_MASK ((1ULL << UNIQUE_BITS) - 1) HsWord64 genSym(void) { - HsWord64 u = atomic_inc64((StgWord64 *)&ghc_unique_counter, ghc_unique_inc) & UNIQUE_MASK; + HsWord64 u = atomic_inc64((StgWord64 *)&ghc_unique_counter64, ghc_unique_inc) & UNIQUE_MASK; // Uh oh! We will overflow next time a unique is requested. ASSERT(u != UNIQUE_MASK); return u; ===================================== rts/Globals.c ===================================== @@ -108,5 +108,5 @@ mkStoreAccessor(LibHSghcGlobalHasPprDebug) mkStoreAccessor(LibHSghcGlobalHasNoDebugOutput) mkStoreAccessor(LibHSghcGlobalHasNoStateHack) -HsWord64 ghc_unique_counter = 0; +HsWord64 ghc_unique_counter64 = 0; HsInt ghc_unique_inc = 1; ===================================== rts/RtsSymbols.c ===================================== @@ -551,7 +551,7 @@ extern char **environ; SymI_HasProto(getOrSetLibHSghcGlobalHasPprDebug) \ SymI_HasProto(getOrSetLibHSghcGlobalHasNoDebugOutput) \ SymI_HasProto(getOrSetLibHSghcGlobalHasNoStateHack) \ - SymI_HasProto(ghc_unique_counter) \ + SymI_HasProto(ghc_unique_counter64) \ SymI_HasProto(ghc_unique_inc) \ SymI_HasProto(genericRaise) \ SymI_HasProto(getProgArgv) \ ===================================== rts/include/rts/Globals.h ===================================== @@ -32,5 +32,5 @@ mkStoreAccessorPrototype(LibHSghcFastStringTable) mkStoreAccessorPrototype(LibHSghcGlobalHasPprDebug) mkStoreAccessorPrototype(LibHSghcGlobalHasNoDebugOutput) mkStoreAccessorPrototype(LibHSghcGlobalHasNoStateHack) -extern HsWord64 ghc_unique_counter; +extern HsWord64 ghc_unique_counter64; extern HsInt ghc_unique_inc; ===================================== rts/js/globals.js ===================================== @@ -20,6 +20,6 @@ GVAR(h$getOrSetLibHSghcFastStringTable, faststring_table) var h$ghc_unique_inc = h$newByteArray(4); h$ghc_unique_inc.i3[0] = 1; -var h$ghc_unique_counter = h$newByteArray(8); -h$ghc_unique_counter.i3[0] = 0; -h$ghc_unique_counter.i3[1] = 0; +var h$ghc_unique_counter64 = h$newByteArray(8); +h$ghc_unique_counter64.i3[0] = 0; +h$ghc_unique_counter64.i3[1] = 0; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/51c4ee9e13db3107b93c40a90fbbae3405cf5a3d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/51c4ee9e13db3107b93c40a90fbbae3405cf5a3d You're receiving 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 Jun 15 13:20:11 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 15 Jun 2023 09:20:11 -0400 Subject: [Git][ghc/ghc][wip/T22010] Fix imports Message-ID: <648b100ba06d_c73971783c4b4463767@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 588b703b by Jaro Reinders at 2023-06-15T15:20:02+02:00 Fix imports - - - - - 1 changed file: - compiler/GHC/Types/Unique/Supply.hs Changes: ===================================== compiler/GHC/Types/Unique/Supply.hs ===================================== @@ -46,10 +46,10 @@ import Foreign.Storable #include "MachDeps.h" -#if MIN_VERSION_GLASGOW_HASKELL(9,1,0,0) +#if MIN_VERSION_GLASGOW_HASKELL(9,1,0,0) && WORD_SIZE_IN_BITS == 64 import GHC.Word( Word64(..) ) import GHC.Exts( fetchAddWordAddr#, plusWord#, readWordOffAddr# ) -#if MIN_VERSION_GLASGOW_HASKELL(9,4,0,0) && WORD_SIZE_IN_BITS == 64 +#if MIN_VERSION_GLASGOW_HASKELL(9,3,0,0) import GHC.Exts( wordToWord64# ) #endif #endif View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/588b703b73634756458efd846fae0fc68de4d20a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/588b703b73634756458efd846fae0fc68de4d20a You're receiving 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 Jun 15 13:46:15 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Thu, 15 Jun 2023 09:46:15 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/DIB-INSTANCES] Remove arity inference in type declarations (#23514) Message-ID: <648b162733124_c7397194f278449588c@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/DIB-INSTANCES at Glasgow Haskell Compiler / GHC Commits: 29e2c8a4 by Andrei Borzenkov at 2023-06-15T17:45:56+04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 22 changed files: - compiler/GHC/Core/Type.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Splice.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - testsuite/tests/perf/compiler/CoOpt_Singletons.hs - + testsuite/tests/rename/should_compile/T23514b.hs - testsuite/tests/rename/should_compile/all.T - + testsuite/tests/rename/should_fail/T23514a.hs - + testsuite/tests/rename/should_fail/T23514a.stderr - testsuite/tests/rename/should_fail/all.T - testsuite/tests/saks/should_compile/T16724.stdout - testsuite/tests/saks/should_compile/saks020.hs - testsuite/tests/saks/should_compile/saks030.hs - testsuite/tests/saks/should_compile/saks032.hs - testsuite/tests/saks/should_fail/T18863b.stderr - + testsuite/tests/th/CodeQ_HKD.hs - testsuite/tests/th/all.T - testsuite/tests/typecheck/should_fail/T18640a.hs - testsuite/tests/typecheck/should_fail/T18640a.stderr - testsuite/tests/typecheck/should_fail/T18640c.hs - testsuite/tests/typecheck/should_fail/T18640c.stderr Changes: ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -60,7 +60,7 @@ module GHC.Core.Type ( mkTyConBindersPreferAnon, mkPiTy, mkPiTys, piResultTy, piResultTys, - applyTysX, dropForAlls, + applyTysX, dropForAlls, dropInvisForAlls, mkFamilyTyConApp, buildSynTyCon, @@ -1937,6 +1937,14 @@ dropForAlls ty = go ty go ty | Just ty' <- coreView ty = go ty' go res = res +-- | Drops all invisible ForAllTys +dropInvisForAlls :: Type -> Type +dropInvisForAlls ty = go ty + where + go (ForAllTy (Bndr _ Invisible{}) res) = go res + go ty | Just ty' <- coreView ty = go ty' + go res = res + -- | Attempts to take a forall type apart, but only if it's a proper forall, -- with a named binder splitForAllTyCoVar_maybe :: Type -> Maybe (TyCoVar, Type) ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -863,12 +863,7 @@ pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype, cons = visibleIfConDecls condecls pp_where = ppWhen (gadt && not (null cons)) $ text "where" pp_cons = ppr_trim (map show_con cons) :: [SDoc] - pp_kind = ppUnless (if ki_sig_printable - then isIfaceRhoType kind - -- Even in the presence of a standalone kind signature, a non-tau - -- result kind annotation cannot be discarded as it determines the arity. - -- See Note [Arity inference in kcCheckDeclHeader_sig] in GHC.Tc.Gen.HsType - else isIfaceLiftedTypeKind kind) + pp_kind = ppUnless (ki_sig_printable || isIfaceLiftedTypeKind kind) (dcolon <+> ppr kind) pp_lhs = case parent of ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -2555,37 +2555,29 @@ kcCheckDeclHeader_sig sig_kind name flav -- ^^^^^^^^^ -- We do it here because at this point the environment has been -- extended with both 'implicit_tcv_prs' and 'explicit_tv_prs'. + -- + -- Also see Note [Arity of type families and type synonyms] ; ctx_k <- kc_res_ki - -- Work out extra_arity, the number of extra invisible binders from - -- the kind signature that should be part of the TyCon's arity. - -- See Note [Arity inference in kcCheckDeclHeader_sig] - ; let n_invis_tcbs = countWhile isInvisibleTyConBinder excess_sig_tcbs - invis_arity = case ctx_k of - AnyKind -> n_invis_tcbs -- No kind signature, so make all the invisible binders - -- the signature into part of the arity of the TyCon - OpenKind -> n_invis_tcbs -- Result kind is (TYPE rr), so again make all the - -- invisible binders part of the arity of the TyCon - TheKind ki -> 0 `max` (n_invis_tcbs - invisibleTyBndrCount ki) + ; let sig_res_kind' = mkTyConKind excess_sig_tcbs sig_res_kind - ; let (invis_tcbs, resid_tcbs) = splitAt invis_arity excess_sig_tcbs - ; let sig_res_kind' = mkTyConKind resid_tcbs sig_res_kind - - ; traceTc "kcCheckDeclHeader_sig 2" $ vcat [ ppr excess_sig_tcbs - , ppr invis_arity, ppr invis_tcbs - , ppr n_invis_tcbs ] + ; traceTc "kcCheckDeclHeader_sig 2" (ppr excess_sig_tcbs) -- Unify res_ki (from the type declaration) with the residual kind from -- the kind signature. Don't forget to apply the skolemising 'subst' first. ; case ctx_k of AnyKind -> return () -- No signature - _ -> do { res_ki <- newExpectedKind ctx_k - ; discardResult (unifyKind Nothing sig_res_kind' res_ki) } + OpenKind -> + do { res_ki <- newExpectedKind ctx_k + ; discardResult (unifyKind Nothing (dropInvisForAlls sig_res_kind') res_ki) } + TheKind _ -> + do { res_ki <- newExpectedKind ctx_k + ; discardResult (unifyKind Nothing sig_res_kind' res_ki) } -- Add more binders for data/newtype, so the result kind has no arrows -- See Note [Datatype return kinds] - ; if null resid_tcbs || not (needsEtaExpansion flav) - then return (invis_tcbs, sig_res_kind') + ; if null excess_sig_tcbs || not (needsEtaExpansion flav) + then return ([], sig_res_kind') else return (excess_sig_tcbs, sig_res_kind) } @@ -2738,8 +2730,8 @@ swizzleTcb swizzle_env subst (Bndr tv vis) -- See Note [Source locations for implicitly bound type variables] -- in GHC.Tc.Rename.HsType -{- See Note [kcCheckDeclHeader_sig] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [kcCheckDeclHeader_sig] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Given a kind signature 'sig_kind' and a declaration header, kcCheckDeclHeader_sig verifies that the declaration conforms to the signature. The end result is a PolyTcTyCon 'tc' such that: @@ -2780,85 +2772,39 @@ Basic plan is this: part of the signature (k -> Type) with the kind signature of the decl, (j -> Type). This unification, done in kcCheckDeclHeader, needs TcTyVars. - * The tricky extra_arity part is described in - Note [Arity inference in kcCheckDeclHeader_sig] - -Note [Arity inference in kcCheckDeclHeader_sig] +Note [Arity of type families and type synonyms] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider these declarations: - type family S1 :: forall k2. k1 -> k2 -> Type - type family S2 (a :: k1) (b :: k2) :: Type - -Both S1 and S2 can be given the same standalone kind signature: - type S1 :: forall k1 k2. k1 -> k2 -> Type - type S2 :: forall k1 k2. k1 -> k2 -> Type - -And, indeed, tyConKind S1 == tyConKind S2. However, -tyConBinders and tyConResKind for S1 and S2 are different: - - tyConBinders S1 == [spec k1] - tyConResKind S1 == forall k2. k1 -> k2 -> Type - tyConKind S1 == forall k1 k2. k1 -> k2 -> Type - - tyConBinders S2 == [spec k1, spec k2, anon-vis (a :: k1), anon-vis (b :: k2)] - tyConResKind S2 == Type - tyConKind S1 == forall k1 k2. k1 -> k2 -> Type - -This difference determines the /arity/: - tyConArity tc == length (tyConBinders tc) -That is, the arity of S1 is 1, while the arity of S2 is 4. - -'kcCheckDeclHeader_sig' needs to infer the desired arity, to split the -standalone kind signature into binders and the result kind. It does so -in two rounds: - -1. matchUpSigWithDecl matches up - - the [TyConBinder] from (applying splitTyConKind to) the kind signature - - with the [LHsTyVarBndr] from the type declaration. - That may leave some excess TyConBinder: in the case of S2 there are - no excess TyConBinders, but in the case of S1 there are two (since - there are no LHsTYVarBndrs. - -2. Split off further TyConBinders (in the case of S1, one more) to - make it possible to unify the residual return kind with the - signature in the type declaration. More precisely, split off such - enough invisible that the remainder of the standalone kind - signature and the user-written result kind signature have the same - number of invisible quantifiers. - -As another example consider the following declarations: - - type F :: Type -> forall j. j -> forall k1 k2. (k1, k2) -> Type - type family F a b - - type G :: Type -> forall j. j -> forall k1 k2. (k1, k2) -> Type - type family G a b :: forall r2. (r1, r2) -> Type - -For both F and G, the signature (after splitTyConKind) has - sig_tcbs :: [TyConBinder] - = [ anon-vis (@a_aBq), spec (@j_auA), anon-vis (@(b_aBr :: j_auA)) - , spec (@k1_auB), spec (@k2_auC) - , anon-vis (@(c_aBs :: (k1_auB, k2_auC)))] - -matchUpSigWithDecl will consume the first three of these, passing on - excess_sig_tcbs - = [ spec (@k1_auB), spec (@k2_auC) - , anon-vis (@(c_aBs :: (k1_auB, k2_auC)))] - -For F, there is no result kind signature in the declaration for F, so -we absorb all invisible binders into F's arity. The resulting arity of -F is 3+2=5. - -Now, in the case of G, we have a result kind sig 'forall r2. (r2,r2)->Type'. -This has one invisible binder, so we split of enough extra binders from -our excess_sig_tcbs to leave just one to match 'r2'. - - res_ki = forall r2. (r1, r2) -> Type - kisig = forall k1 k2. (k1, k2) -> Type - ^^^ - split off this one. - -The resulting arity of G is 3+1=4. +Consider + + type F1 :: forall k. k -> k -> Type + type family F1 @k + + type F2a :: forall k. k -> k -> Type + type family F2a @k a + + type F2b :: forall k. k -> k -> Type + type family F2b a + + type F3 :: forall k. k -> k -> Type + type family F3 a b + +All four have the same /kind/, but what /arity/ do they have? +For a type family, the arity is critical: +* A type family must always appear saturated (up to its arity) +* A type family can match only on `arity` arguments, not further ones +* The arity is recorded by `tyConArity`, and is equal to the number of + `TyConBinders` in the `TyCon`. +* In this context "arity" includes both kind and type arguments. + +The arity is not determined by the kind signature (all four have the same signature). +Rather, it is determined by the declaration of the family: +* `F1` has arity 1. +* `F2a` has arity 2. +* `F2b` also has arity 2: the kind argument is invisible. +* `F3` has arity 3; again the kind argument is invisible. + +The matching-up of kind signature with the declaration itself is done by +`matchUpWithSigDecl`. Note [discardResult in kcCheckDeclHeader_sig] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -796,7 +796,7 @@ tcTExpTy m_ty exp_ty TcRnTHError $ TypedTHError $ TypedTHWithPolyType exp_ty ; codeCon <- tcLookupTyCon codeTyConName ; let rep = getRuntimeRep exp_ty - ; return (mkTyConApp codeCon [rep, m_ty, exp_ty]) } + ; return (mkTyConApp codeCon [m_ty, rep, exp_ty]) } quotationCtxtDoc :: LHsExpr GhcRn -> SDoc quotationCtxtDoc br_body ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -378,8 +378,11 @@ The splice will evaluate to (MkAge 3) and you can't add that to 4::Int. So you can't coerce a (Code Q Age) to a (Code Q Int). -} -- Code constructor - +#if __GLASGOW_HASKELL__ >= 907 +type Code :: (Kind.Type -> Kind.Type) -> forall r. TYPE r -> Kind.Type +#else type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type +#endif type role Code representational nominal -- See Note [Role of TExp] newtype Code m a = Code { examineCode :: m (TExp a) -- ^ Underlying monadic value ===================================== testsuite/tests/perf/compiler/CoOpt_Singletons.hs ===================================== @@ -52,7 +52,7 @@ type SameKind :: k -> k -> Constraint type SameKind (a :: k) (b :: k) = (() :: Constraint) type Sing :: k -> Type -type family Sing :: k -> Type +type family Sing @k :: k -> Type type SLambda :: (k1 ~> k2) -> Type newtype SLambda (f :: k1 ~> k2) = @@ -159,7 +159,7 @@ type instance Apply (Lambda_6989586621679038878Sym3 f6989586621679038875 g698958 type family Lambda_6989586621679038878Sym4 f6989586621679038875 g6989586621679038876 a_69895866216790388666989586621679038877 x6989586621679038880 where Lambda_6989586621679038878Sym4 f6989586621679038875 g6989586621679038876 a_69895866216790388666989586621679038877 x6989586621679038880 = Lambda_6989586621679038878_a7z9 f6989586621679038875 g6989586621679038876 a_69895866216790388666989586621679038877 x6989586621679038880 type ($!@#@$) :: (~>) ((~>) a_a7yq b_a7yr) ((~>) a_a7yq b_a7yr) -data ($!@#@$) :: (~>) ((~>) a_a7yq b_a7yr) ((~>) a_a7yq b_a7yr) +data ($!@#@$) @a_a7yq @b_a7yr :: (~>) ((~>) a_a7yq b_a7yr) ((~>) a_a7yq b_a7yr) where (:$!@#@$###) :: SameKind (Apply ($!@#@$) arg_a7yP) (($!@#@$$) arg_a7yP) => ($!@#@$) a6989586621679038860 @@ -177,7 +177,7 @@ type family ($!@#@$$$) (a6989586621679038860 :: (~>) a_a7yq b_a7yr) (a6989586621 ($!@#@$$$) a6989586621679038860 a6989586621679038861 = ($!) a6989586621679038860 a6989586621679038861 infixr 0 $!@#@$$$ type (.@#@$) :: (~>) ((~>) b_a7ys c_a7yt) ((~>) ((~>) a_a7yu b_a7ys) ((~>) a_a7yu c_a7yt)) -data (.@#@$) :: (~>) ((~>) b_a7ys c_a7yt) ((~>) ((~>) a_a7yu b_a7ys) ((~>) a_a7yu c_a7yt)) +data (.@#@$) @b_a7ys @c_a7yt @a_a7yu :: (~>) ((~>) b_a7ys c_a7yt) ((~>) ((~>) a_a7yu b_a7ys) ((~>) a_a7yu c_a7yt)) where (:.@#@$###) :: SameKind (Apply (.@#@$) arg_a7z1) ((.@#@$$) arg_a7z1) => (.@#@$) a6989586621679038872 @@ -205,7 +205,7 @@ type family (.@#@$$$$) (a6989586621679038872 :: (~>) b_a7ys c_a7yt) (a6989586621 (.@#@$$$$) a6989586621679038872 a6989586621679038873 a6989586621679038874 = (.) a6989586621679038872 a6989586621679038873 a6989586621679038874 infixr 9 .@#@$$$$ type FlipSym0 :: (~>) ((~>) a_a7yv ((~>) b_a7yw c_a7yx)) ((~>) b_a7yw ((~>) a_a7yv c_a7yx)) -data FlipSym0 :: (~>) ((~>) a_a7yv ((~>) b_a7yw c_a7yx)) ((~>) b_a7yw ((~>) a_a7yv c_a7yx)) +data FlipSym0 @a_a7yv @b_a7yw @c_a7yx :: (~>) ((~>) a_a7yv ((~>) b_a7yw c_a7yx)) ((~>) b_a7yw ((~>) a_a7yv c_a7yx)) where FlipSym0KindInference :: SameKind (Apply FlipSym0 arg_a7zf) (FlipSym1 arg_a7zf) => FlipSym0 a6989586621679038886 @@ -229,7 +229,7 @@ type FlipSym3 :: (~>) a_a7yv ((~>) b_a7yw c_a7yx) type family FlipSym3 (a6989586621679038886 :: (~>) a_a7yv ((~>) b_a7yw c_a7yx)) (a6989586621679038887 :: b_a7yw) (a6989586621679038888 :: a_a7yv) :: c_a7yx where FlipSym3 a6989586621679038886 a6989586621679038887 a6989586621679038888 = Flip a6989586621679038886 a6989586621679038887 a6989586621679038888 type IdSym0 :: (~>) a_a7yy a_a7yy -data IdSym0 :: (~>) a_a7yy a_a7yy +data IdSym0 @a_a7yy :: (~>) a_a7yy a_a7yy where IdSym0KindInference :: SameKind (Apply IdSym0 arg_a7zn) (IdSym1 arg_a7zn) => IdSym0 a6989586621679038894 @@ -314,7 +314,7 @@ $(genSingletons [''Dual]) -} type DualSym0 :: forall (a_a5fi :: Type). (~>) a_a5fi (Dual (a_a5fi :: Type)) -data DualSym0 :: (~>) a_a5fi (Dual (a_a5fi :: Type)) +data DualSym0 @a_a5fi :: (~>) a_a5fi (Dual (a_a5fi :: Type)) where DualSym0KindInference :: SameKind (Apply DualSym0 arg_a9sh) (DualSym1 arg_a9sh) => DualSym0 a6989586621679046142 @@ -324,7 +324,7 @@ type DualSym1 :: forall (a_a5fi :: Type). a_a5fi type family DualSym1 (a6989586621679046142 :: a_a5fi) :: Dual (a_a5fi :: Type) where DualSym1 a6989586621679046142 = 'Dual a6989586621679046142 type GetDualSym0 :: forall (a_a5fi :: Type). (~>) (Dual (a_a5fi :: Type)) a_a5fi -data GetDualSym0 :: (~>) (Dual (a_a5fi :: Type)) a_a5fi +data GetDualSym0 @a_a5fi :: (~>) (Dual (a_a5fi :: Type)) a_a5fi where GetDualSym0KindInference :: SameKind (Apply GetDualSym0 arg_a9sk) (GetDualSym1 arg_a9sk) => GetDualSym0 a6989586621679046145 @@ -369,7 +369,7 @@ $(singletonsOnly [d| -} type (<>@#@$) :: forall a_a9GJ. (~>) a_a9GJ ((~>) a_a9GJ a_a9GJ) -data (<>@#@$) :: (~>) a_a9GJ ((~>) a_a9GJ a_a9GJ) +data (<>@#@$) @a_a9GJ :: (~>) a_a9GJ ((~>) a_a9GJ a_a9GJ) where (:<>@#@$###) :: SameKind (Apply (<>@#@$) arg_a9GZ) ((<>@#@$$) arg_a9GZ) => (<>@#@$) a6989586621679047054 @@ -386,10 +386,10 @@ type family (<>@#@$$$) (a6989586621679047054 :: a_a9GJ) (a6989586621679047055 :: class PSemigroup a_a9GJ where type family (<>) (arg_a9GX :: a_a9GJ) (arg_a9GY :: a_a9GJ) :: a_a9GJ type MemptySym0 :: forall a_a9GK. a_a9GK -type family MemptySym0 :: a_a9GK where +type family MemptySym0 @a_a9GK :: a_a9GK where MemptySym0 = Mempty type MappendSym0 :: forall a_a9GK. (~>) a_a9GK ((~>) a_a9GK a_a9GK) -data MappendSym0 :: (~>) a_a9GK ((~>) a_a9GK a_a9GK) +data MappendSym0 @a_a9GK :: (~>) a_a9GK ((~>) a_a9GK a_a9GK) where MappendSym0KindInference :: SameKind (Apply MappendSym0 arg_a9H5) (MappendSym1 arg_a9H5) => MappendSym0 a6989586621679047060 @@ -407,7 +407,7 @@ type Mappend_6989586621679047064 :: a_a9GK -> a_a9GK -> a_a9GK type family Mappend_6989586621679047064 (a_a9Hg :: a_a9GK) (a_a9Hh :: a_a9GK) :: a_a9GK where Mappend_6989586621679047064 a_6989586621679047066_a9Hl a_6989586621679047068_a9Hm = Apply (Apply (<>@#@$) a_6989586621679047066_a9Hl) a_6989586621679047068_a9Hm type Mappend_6989586621679047064Sym0 :: (~>) a_a9GK ((~>) a_a9GK a_a9GK) -data Mappend_6989586621679047064Sym0 :: (~>) a_a9GK ((~>) a_a9GK a_a9GK) +data Mappend_6989586621679047064Sym0 @a_a9GK :: (~>) a_a9GK ((~>) a_a9GK a_a9GK) where Mappend_6989586621679047064Sym0KindInference :: SameKind (Apply Mappend_6989586621679047064Sym0 arg_a9Hi) (Mappend_6989586621679047064Sym1 arg_a9Hi) => Mappend_6989586621679047064Sym0 a6989586621679047073 @@ -431,7 +431,7 @@ type TFHelper_6989586621679047079 :: Dual a_a9GL type family TFHelper_6989586621679047079 (a_a9Hr :: Dual a_a9GL) (a_a9Hs :: Dual a_a9GL) :: Dual a_a9GL where TFHelper_6989586621679047079 ('Dual a_a9Hw) ('Dual b_a9Hx) = Apply DualSym0 (Apply (Apply (<>@#@$) b_a9Hx) a_a9Hw) type TFHelper_6989586621679047079Sym0 :: (~>) (Dual a_a9GL) ((~>) (Dual a_a9GL) (Dual a_a9GL)) -data TFHelper_6989586621679047079Sym0 :: (~>) (Dual a_a9GL) ((~>) (Dual a_a9GL) (Dual a_a9GL)) +data TFHelper_6989586621679047079Sym0 @a_a9GL :: (~>) (Dual a_a9GL) ((~>) (Dual a_a9GL) (Dual a_a9GL)) where TFHelper_6989586621679047079Sym0KindInference :: SameKind (Apply TFHelper_6989586621679047079Sym0 arg_a9Ht) (TFHelper_6989586621679047079Sym1 arg_a9Ht) => TFHelper_6989586621679047079Sym0 a6989586621679047084 @@ -450,10 +450,10 @@ type family TFHelper_6989586621679047079Sym2 (a6989586621679047084 :: Dual a_a9G instance PSemigroup (Dual a_a9GL) where type (<>) a_a9Hn a_a9Ho = Apply (Apply TFHelper_6989586621679047079Sym0 a_a9Hn) a_a9Ho type Mempty_6989586621679047088 :: Dual a_a9GO -type family Mempty_6989586621679047088 :: Dual a_a9GO where +type family Mempty_6989586621679047088 @a_a9GO :: Dual a_a9GO where Mempty_6989586621679047088 = Apply DualSym0 MemptySym0 type Mempty_6989586621679047088Sym0 :: Dual a_a9GO -type family Mempty_6989586621679047088Sym0 :: Dual a_a9GO where +type family Mempty_6989586621679047088Sym0 @a_a9GO :: Dual a_a9GO where Mempty_6989586621679047088Sym0 = Mempty_6989586621679047088 instance PMonoid (Dual a_a9GO) where type Mempty = Mempty_6989586621679047088Sym0 @@ -508,7 +508,7 @@ $(singletonsOnly [d| -} type AppEndoSym0 :: (~>) (Endo a_agCh) ((~>) a_agCh a_agCh) -data AppEndoSym0 :: (~>) (Endo a_agCh) ((~>) a_agCh a_agCh) +data AppEndoSym0 @a_agCh :: (~>) (Endo a_agCh) ((~>) a_agCh a_agCh) where AppEndoSym0KindInference :: SameKind (Apply AppEndoSym0 arg_agUE) (AppEndoSym1 arg_agUE) => AppEndoSym0 a6989586621679074809 @@ -530,7 +530,7 @@ type TFHelper_6989586621679075091 :: Endo a_agCk type family TFHelper_6989586621679075091 (a_agZf :: Endo a_agCk) (a_agZg :: Endo a_agCk) :: Endo a_agCk where TFHelper_6989586621679075091 ('Endo x_agZk) ('Endo y_agZl) = Apply EndoSym0 (Apply (Apply (.@#@$) x_agZk) y_agZl) type TFHelper_6989586621679075091Sym0 :: (~>) (Endo a_agCk) ((~>) (Endo a_agCk) (Endo a_agCk)) -data TFHelper_6989586621679075091Sym0 :: (~>) (Endo a_agCk) ((~>) (Endo a_agCk) (Endo a_agCk)) +data TFHelper_6989586621679075091Sym0 @a_agCk :: (~>) (Endo a_agCk) ((~>) (Endo a_agCk) (Endo a_agCk)) where TFHelper_6989586621679075091Sym0KindInference :: SameKind (Apply TFHelper_6989586621679075091Sym0 arg_agZh) (TFHelper_6989586621679075091Sym1 arg_agZh) => TFHelper_6989586621679075091Sym0 a6989586621679075096 @@ -549,10 +549,10 @@ type family TFHelper_6989586621679075091Sym2 (a6989586621679075096 :: Endo a_agC instance PSemigroup (Endo a_agCk) where type (<>) a_agZb a_agZc = Apply (Apply TFHelper_6989586621679075091Sym0 a_agZb) a_agZc type Mempty_6989586621679075313 :: Endo a_agCn -type family Mempty_6989586621679075313 :: Endo a_agCn where +type family Mempty_6989586621679075313 @a_agCn :: Endo a_agCn where Mempty_6989586621679075313 = Apply EndoSym0 IdSym0 type Mempty_6989586621679075313Sym0 :: Endo a_agCn -type family Mempty_6989586621679075313Sym0 :: Endo a_agCn where +type family Mempty_6989586621679075313Sym0 @a_agCn :: Endo a_agCn where Mempty_6989586621679075313Sym0 = Mempty_6989586621679075313 instance PMonoid (Endo a_agCn) where type Mempty = Mempty_6989586621679075313Sym0 @@ -602,7 +602,7 @@ $(singletonsOnly [d| type FoldMapSym0 :: forall a_ahBz m_ahBy t_ahBx. (~>) ((~>) a_ahBz m_ahBy) ((~>) (t_ahBx a_ahBz) m_ahBy) -data FoldMapSym0 :: (~>) ((~>) a_ahBz m_ahBy) ((~>) (t_ahBx a_ahBz) m_ahBy) +data FoldMapSym0 @a_ahBz @m_ahBy @t_ahBx :: (~>) ((~>) a_ahBz m_ahBy) ((~>) (t_ahBx a_ahBz) m_ahBy) where FoldMapSym0KindInference :: SameKind (Apply FoldMapSym0 arg_ahBS) (FoldMapSym1 arg_ahBS) => FoldMapSym0 a6989586621679077489 @@ -621,7 +621,7 @@ type family FoldMapSym2 (a6989586621679077489 :: (~>) a_ahBz m_ahBy) (a698958662 type FoldrSym0 :: forall a_ahBA b_ahBB t_ahBx. (~>) ((~>) a_ahBA ((~>) b_ahBB b_ahBB)) ((~>) b_ahBB ((~>) (t_ahBx a_ahBA) b_ahBB)) -data FoldrSym0 :: (~>) ((~>) a_ahBA ((~>) b_ahBB b_ahBB)) ((~>) b_ahBB ((~>) (t_ahBx a_ahBA) b_ahBB)) +data FoldrSym0 @a_ahBA @b_ahBB @t_ahBx :: (~>) ((~>) a_ahBA ((~>) b_ahBB b_ahBB)) ((~>) b_ahBB ((~>) (t_ahBx a_ahBA) b_ahBB)) where FoldrSym0KindInference :: SameKind (Apply FoldrSym0 arg_ahBY) (FoldrSym1 arg_ahBY) => FoldrSym0 a6989586621679077495 @@ -653,7 +653,7 @@ type family FoldrSym3 (a6989586621679077495 :: (~>) a_ahBA ((~>) b_ahBB b_ahBB)) type Foldr'Sym0 :: forall a_ahBC b_ahBD t_ahBx. (~>) ((~>) a_ahBC ((~>) b_ahBD b_ahBD)) ((~>) b_ahBD ((~>) (t_ahBx a_ahBC) b_ahBD)) -data Foldr'Sym0 :: (~>) ((~>) a_ahBC ((~>) b_ahBD b_ahBD)) ((~>) b_ahBD ((~>) (t_ahBx a_ahBC) b_ahBD)) +data Foldr'Sym0 @a_ahBC @b_ahBD @t_ahBx :: (~>) ((~>) a_ahBC ((~>) b_ahBD b_ahBD)) ((~>) b_ahBD ((~>) (t_ahBx a_ahBC) b_ahBD)) where Foldr'Sym0KindInference :: SameKind (Apply Foldr'Sym0 arg_ahC5) (Foldr'Sym1 arg_ahC5) => Foldr'Sym0 a6989586621679077502 @@ -685,7 +685,7 @@ type family Foldr'Sym3 (a6989586621679077502 :: (~>) a_ahBC ((~>) b_ahBD b_ahBD) type FoldlSym0 :: forall b_ahBE a_ahBF t_ahBx. (~>) ((~>) b_ahBE ((~>) a_ahBF b_ahBE)) ((~>) b_ahBE ((~>) (t_ahBx a_ahBF) b_ahBE)) -data FoldlSym0 :: (~>) ((~>) b_ahBE ((~>) a_ahBF b_ahBE)) ((~>) b_ahBE ((~>) (t_ahBx a_ahBF) b_ahBE)) +data FoldlSym0 @b_ahBE @a_ahBF @t_ahBx :: (~>) ((~>) b_ahBE ((~>) a_ahBF b_ahBE)) ((~>) b_ahBE ((~>) (t_ahBx a_ahBF) b_ahBE)) where FoldlSym0KindInference :: SameKind (Apply FoldlSym0 arg_ahCc) (FoldlSym1 arg_ahCc) => FoldlSym0 a6989586621679077509 @@ -753,7 +753,7 @@ type Foldr'_6989586621679077515 :: (~>) a_ahBC ((~>) b_ahBD b_ahBD) type family Foldr'_6989586621679077515 (a_ahCl :: (~>) a_ahBC ((~>) b_ahBD b_ahBD)) (a_ahCm :: b_ahBD) (a_ahCn :: t_ahBx a_ahBC) :: b_ahBD where Foldr'_6989586621679077515 f_ahCs z0_ahCt xs_ahCu = Apply (Apply (Apply (Apply FoldlSym0 (Let6989586621679077527F'Sym3 f_ahCs z0_ahCt xs_ahCu)) IdSym0) xs_ahCu) z0_ahCt type Foldr'_6989586621679077515Sym0 :: (~>) ((~>) a_ahBC ((~>) b_ahBD b_ahBD)) ((~>) b_ahBD ((~>) (t_ahBx a_ahBC) b_ahBD)) -data Foldr'_6989586621679077515Sym0 :: (~>) ((~>) a_ahBC ((~>) b_ahBD b_ahBD)) ((~>) b_ahBD ((~>) (t_ahBx a_ahBC) b_ahBD)) +data Foldr'_6989586621679077515Sym0 @a_ahBC @b_ahBD @t_ahBx :: (~>) ((~>) a_ahBC ((~>) b_ahBD b_ahBD)) ((~>) b_ahBD ((~>) (t_ahBx a_ahBC) b_ahBD)) where Foldr'_6989586621679077515Sym0KindInference :: SameKind (Apply Foldr'_6989586621679077515Sym0 arg_ahCo) (Foldr'_6989586621679077515Sym1 arg_ahCo) => Foldr'_6989586621679077515Sym0 a6989586621679077521 @@ -781,7 +781,7 @@ type Foldl_6989586621679077538 :: (~>) b_ahBE ((~>) a_ahBF b_ahBE) type family Foldl_6989586621679077538 (a_ahCI :: (~>) b_ahBE ((~>) a_ahBF b_ahBE)) (a_ahCJ :: b_ahBE) (a_ahCK :: t_ahBx a_ahBF) :: b_ahBE where Foldl_6989586621679077538 f_ahCP z_ahCQ t_ahCR = Apply (Apply AppEndoSym0 (Apply GetDualSym0 (Apply (Apply FoldMapSym0 (Apply (Apply (.@#@$) DualSym0) (Apply (Apply (.@#@$) EndoSym0) (Apply FlipSym0 f_ahCP)))) t_ahCR))) z_ahCQ type Foldl_6989586621679077538Sym0 :: (~>) ((~>) b_ahBE ((~>) a_ahBF b_ahBE)) ((~>) b_ahBE ((~>) (t_ahBx a_ahBF) b_ahBE)) -data Foldl_6989586621679077538Sym0 :: (~>) ((~>) b_ahBE ((~>) a_ahBF b_ahBE)) ((~>) b_ahBE ((~>) (t_ahBx a_ahBF) b_ahBE)) +data Foldl_6989586621679077538Sym0 @b_ahBE @a_ahBF @t_ahBx :: (~>) ((~>) b_ahBE ((~>) a_ahBF b_ahBE)) ((~>) b_ahBE ((~>) (t_ahBx a_ahBF) b_ahBE)) where Foldl_6989586621679077538Sym0KindInference :: SameKind (Apply Foldl_6989586621679077538Sym0 arg_ahCL) (Foldl_6989586621679077538Sym1 arg_ahCL) => Foldl_6989586621679077538Sym0 a6989586621679077544 @@ -946,7 +946,7 @@ type FoldMap_6989586621679081137 :: (~>) a_ahBz_acmX m_ahBy_acmY type family FoldMap_6989586621679081137 (a_aiyL :: (~>) a_ahBz_acmX m_ahBy_acmY) (a_aiyM :: Tuple2 a_aikY a_ahBz_acmX) :: m_ahBy_acmY where FoldMap_6989586621679081137 _f_6989586621679081117_aiyQ ('Tuple2 a_6989586621679081123_aiyR a_6989586621679081125_aiyS) = Apply (Apply MappendSym0 (Apply (Apply (Apply (Apply Lambda_6989586621679081147Sym0 _f_6989586621679081117_aiyQ) a_6989586621679081123_aiyR) a_6989586621679081125_aiyS) a_6989586621679081123_aiyR)) (Apply _f_6989586621679081117_aiyQ a_6989586621679081125_aiyS) type FoldMap_6989586621679081137Sym0 :: (~>) ((~>) a_ahBz_acmX m_ahBy_acmY) ((~>) (Tuple2 a_aikY a_ahBz_acmX) m_ahBy_acmY) -data FoldMap_6989586621679081137Sym0 :: (~>) ((~>) a_ahBz_acmX m_ahBy_acmY) ((~>) (Tuple2 a_aikY a_ahBz_acmX) m_ahBy_acmY) +data FoldMap_6989586621679081137Sym0 @a_ahBz_acmX @m_ahBy_acmY @a_aikY :: (~>) ((~>) a_ahBz_acmX m_ahBy_acmY) ((~>) (Tuple2 a_aikY a_ahBz_acmX) m_ahBy_acmY) where FoldMap_6989586621679081137Sym0KindInference :: SameKind (Apply FoldMap_6989586621679081137Sym0 arg_aiyN) (FoldMap_6989586621679081137Sym1 arg_aiyN) => FoldMap_6989586621679081137Sym0 a6989586621679081142 @@ -1001,7 +1001,7 @@ type Foldr_6989586621679081154 :: (~>) a_ahBA_acn1 ((~>) b_ahBB_acn2 b_ahBB_acn2 type family Foldr_6989586621679081154 (a_aiz2 :: (~>) a_ahBA_acn1 ((~>) b_ahBB_acn2 b_ahBB_acn2)) (a_aiz3 :: b_ahBB_acn2) (a_aiz4 :: Tuple2 a_aikY a_ahBA_acn1) :: b_ahBB_acn2 where Foldr_6989586621679081154 _f_6989586621679081117_aiz9 _z_6989586621679081119_aiza ('Tuple2 a_6989586621679081131_aizb a_6989586621679081133_aizc) = Apply (Apply (Apply (Apply (Apply (Apply Lambda_6989586621679081167Sym0 _f_6989586621679081117_aiz9) _z_6989586621679081119_aiza) a_6989586621679081131_aizb) a_6989586621679081133_aizc) a_6989586621679081131_aizb) (Apply (Apply _f_6989586621679081117_aiz9 a_6989586621679081133_aizc) _z_6989586621679081119_aiza) type Foldr_6989586621679081154Sym0 :: (~>) ((~>) a_ahBA_acn1 ((~>) b_ahBB_acn2 b_ahBB_acn2)) ((~>) b_ahBB_acn2 ((~>) (Tuple2 a_aikY a_ahBA_acn1) b_ahBB_acn2)) -data Foldr_6989586621679081154Sym0 :: (~>) ((~>) a_ahBA_acn1 ((~>) b_ahBB_acn2 b_ahBB_acn2)) ((~>) b_ahBB_acn2 ((~>) (Tuple2 a_aikY a_ahBA_acn1) b_ahBB_acn2)) +data Foldr_6989586621679081154Sym0 @a_ahBA_acn1 @b_ahBB_acn2 @a_aikY :: (~>) ((~>) a_ahBA_acn1 ((~>) b_ahBB_acn2 b_ahBB_acn2)) ((~>) b_ahBB_acn2 ((~>) (Tuple2 a_aikY a_ahBA_acn1) b_ahBB_acn2)) where Foldr_6989586621679081154Sym0KindInference :: SameKind (Apply Foldr_6989586621679081154Sym0 arg_aiz5) (Foldr_6989586621679081154Sym1 arg_aiz5) => Foldr_6989586621679081154Sym0 a6989586621679081160 ===================================== testsuite/tests/rename/should_compile/T23514b.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies, DataKinds #-} +module T23514b where + +import GHC.Types + +type F :: Type -> forall k. Maybe k +type family F x @k where + F Int @Type = Just Bool + F Int = Just Either ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -213,3 +213,4 @@ test('T23240', [req_th, extra_files(['T23240_aux.hs'])], multimod_compile, ['T23 test('T23318', normal, compile, ['-Wduplicate-exports']) test('T23434', normal, compile, ['']) test('T23510b', normal, compile, ['']) +test('T23514b', normal, compile, ['']) ===================================== testsuite/tests/rename/should_fail/T23514a.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies, DataKinds #-} +module T23514a where + +import GHC.Types + +type F :: Type -> forall k. Maybe k +type family F x where + F Int @Type = Just Bool + F Int = Just Either ===================================== testsuite/tests/rename/should_fail/T23514a.stderr ===================================== @@ -0,0 +1,6 @@ + +T23514a.hs:9:17: error: [GHC-83865] + • Expected kind ‘forall k. Maybe k’, + but ‘Just Either’ has kind ‘Maybe (* -> * -> *)’ + • In the type ‘Just Either’ + In the type family declaration for ‘F’ ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -200,3 +200,4 @@ test('RnStupidThetaInGadt', normal, compile_fail, ['']) test('PackageImportsDisabled', normal, compile_fail, ['']) test('ImportLookupIllegal', normal, compile_fail, ['']) test('T23510a', normal, compile_fail, ['']) +test('T23514a', normal, compile_fail, ['']) ===================================== testsuite/tests/saks/should_compile/T16724.stdout ===================================== @@ -1,6 +1,6 @@ type T1 :: forall k (a :: k). Type -type family T1 @k @a +type family T1 -- Defined at T16724.hs:11:1 type T2 :: forall {k} (a :: k). Type -type family T2 @{k} @a +type family T2 -- Defined at T16724.hs:15:1 ===================================== testsuite/tests/saks/should_compile/saks020.hs ===================================== @@ -6,4 +6,4 @@ module SAKS_020 where import Data.Kind (Type) type T :: forall k. k -> forall j. j -> Type -data T (x :: hk) :: hj -> Type +data T (x :: hk) @hj :: hj -> Type ===================================== testsuite/tests/saks/should_compile/saks030.hs ===================================== @@ -10,7 +10,7 @@ import Data.Type.Equality type T1 :: forall k (a :: k). Bool type T2 :: k -> Bool -type family T1 where +type family T1 @k @a where T1 @Bool @True = False T1 @Bool @False = True ===================================== testsuite/tests/saks/should_compile/saks032.hs ===================================== @@ -18,4 +18,4 @@ type F1 :: Type -> forall j. j -> forall k1 k2. (k1, k2) -> Type type family F1 a b type F2 :: Type -> forall j. j -> forall k1 k2. (k1, k2) -> Type -type family F2 a b :: forall r2. (r1, r2) -> Type +type family F2 a b @r1 :: forall r2. (r1, r2) -> Type ===================================== testsuite/tests/saks/should_fail/T18863b.stderr ===================================== @@ -1,5 +1,5 @@ T18863b.hs:9:1: error: [GHC-83865] • Couldn't match expected kind: forall i -> i -> * - with actual kind: i -> * + with actual kind: forall i. i -> * • In the data type declaration for ‘IDb’ ===================================== testsuite/tests/th/CodeQ_HKD.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE TemplateHaskell #-} + +module CodeQ_HKD where +import GHC.Exts +import Data.Kind +import Language.Haskell.TH hiding (Type) + +data T (f :: forall r . (TYPE r) -> Type) = MkT (f Int) (f Int#) + + +tcodeq :: T CodeQ +tcodeq = MkT [||5||] [||5#||] ===================================== testsuite/tests/th/all.T ===================================== @@ -576,3 +576,4 @@ test('T21050', normal, compile_fail, ['']) test('T22559a', normal, compile_fail, ['']) test('T22559b', normal, compile_fail, ['']) test('T22559c', normal, compile_fail, ['']) +test('CodeQ_HKD', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/T18640a.hs ===================================== @@ -8,4 +8,4 @@ module T18640a where import Data.Kind type F2 :: forall a b. Type -> a -type family F2 :: forall b. Type -> Type where +type family F2 @a :: forall b. Type -> Type where ===================================== testsuite/tests/typecheck/should_fail/T18640a.stderr ===================================== @@ -5,5 +5,5 @@ T18640a.hs:11:1: error: [GHC-25897] Actual: forall (b :: k). * -> a ‘a’ is a rigid type variable bound by the type family declaration for ‘F2’ - at T18640a.hs:10:19 + at T18640a.hs:11:17 • In the type family declaration for ‘F2’ ===================================== testsuite/tests/typecheck/should_fail/T18640c.hs ===================================== @@ -11,4 +11,4 @@ type F1 :: forall k -> Type type family F1 k :: Type type F2 :: forall x. forall k -> x -type F2 = F1 +type F2 k = F1 k ===================================== testsuite/tests/typecheck/should_fail/T18640c.stderr ===================================== @@ -1,10 +1,8 @@ -T18640c.hs:14:11: error: [GHC-25897] - • Couldn't match kind ‘x’ with ‘*’ - Expected kind ‘forall (k1 :: k) -> x’, - but ‘F1’ has kind ‘forall (k1 :: k) -> *’ +T18640c.hs:14:13: error: [GHC-25897] + • Expected kind ‘x’, but ‘F1 k’ has kind ‘*’ ‘x’ is a rigid type variable bound by the type synonym declaration for ‘F2’ at T18640c.hs:13:19 - • In the type ‘F1’ + • In the type ‘F1 k’ In the type declaration for ‘F2’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/29e2c8a4c4ec582a367096ec48cf4d36f8e1507d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/29e2c8a4c4ec582a367096ec48cf4d36f8e1507d You're receiving 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 Jun 15 15:16:40 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 15 Jun 2023 11:16:40 -0400 Subject: [Git][ghc/ghc][wip/T22010] Bump GHC version in CI Message-ID: <648b2b5855aee_c7397181b124c55275f@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 4a8de23e by Jaro Reinders at 2023-06-15T17:16:27+02:00 Bump GHC version in CI - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -84,7 +84,7 @@ workflow: matrix: - GHC_VERSION: 9.2.5 DOCKER_IMAGE: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10-ghc9_2:$DOCKER_REV" - - GHC_VERSION: 9.4.3 + - GHC_VERSION: 9.4.4 DOCKER_IMAGE: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV" - GHC_VERSION: 9.6.1 DOCKER_IMAGE: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10-ghc9_6:$DOCKER_REV" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4a8de23e71819c7f53ebbefc904f5858b14eb098 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4a8de23e71819c7f53ebbefc904f5858b14eb098 You're receiving 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 Jun 15 15:27:51 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Thu, 15 Jun 2023 11:27:51 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/sand-witch/dib-INSTANCES Message-ID: <648b2df777d47_c73971783c2e85547b1@gitlab.mail> Andrei Borzenkov pushed new branch wip/sand-witch/dib-INSTANCES at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sand-witch/dib-INSTANCES You're receiving 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 Jun 15 20:40:57 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Thu, 15 Jun 2023 16:40:57 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T21973 Message-ID: <648b77599ca5e_32a24ec5fa830448@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/T21973 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T21973 You're receiving 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 Jun 15 22:08:47 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 15 Jun 2023 18:08:47 -0400 Subject: [Git][ghc/ghc][master] Report scoped kind variables at the type-checking phase (#16635) Message-ID: <648b8bef5fc75_32a24ec5f94414fd@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 30 changed files: - compiler/GHC/Hs/Type.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Errors/Types/PromotionErr.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Types/BasicTypes.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Types/Error/Codes.hs - testsuite/tests/dependent/should_fail/PromotedClass.stderr - testsuite/tests/dependent/should_fail/SelfDep.stderr - testsuite/tests/dependent/should_fail/T13780a.stderr - testsuite/tests/dependent/should_fail/T13780c.stderr - testsuite/tests/dependent/should_fail/T14845_compile.stderr - testsuite/tests/dependent/should_fail/T14845_fail1.stderr - testsuite/tests/dependent/should_fail/T14845_fail2.stderr - testsuite/tests/dependent/should_fail/T15215.stderr - testsuite/tests/dependent/should_fail/T15245.stderr - testsuite/tests/patsyn/should_fail/T11265.stderr - testsuite/tests/patsyn/should_fail/T9161-1.stderr - testsuite/tests/patsyn/should_fail/T9161-2.stderr - testsuite/tests/polykinds/PolyKinds06.stderr - testsuite/tests/polykinds/PolyKinds07.stderr - testsuite/tests/polykinds/T13625.stderr - testsuite/tests/polykinds/T15116.stderr - testsuite/tests/polykinds/T15116a.stderr - testsuite/tests/polykinds/T5716.stderr - testsuite/tests/polykinds/T5716a.stderr - testsuite/tests/polykinds/T6129.stderr - testsuite/tests/polykinds/T7433.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/78cd11329ce2ed00cbba8a459fe688ccc8f83d13 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/78cd11329ce2ed00cbba8a459fe688ccc8f83d13 You're receiving 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 Jun 15 22:09:31 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 15 Jun 2023 18:09:31 -0400 Subject: [Git][ghc/ghc][master] 3 commits: JS: testsuite: use correct ticket number Message-ID: <648b8c1b9b01d_32a24ec5f08446d9@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - 30 changed files: - libraries/base/jsbits/errno.js - rts/js/profiling.js - testsuite/tests/backpack/cabal/T15594/all.T - testsuite/tests/backpack/cabal/T16219/all.T - testsuite/tests/backpack/cabal/T20509/all.T - testsuite/tests/backpack/cabal/bkpcabal01/all.T - testsuite/tests/backpack/cabal/bkpcabal02/all.T - testsuite/tests/backpack/cabal/bkpcabal03/all.T - testsuite/tests/backpack/cabal/bkpcabal04/all.T - testsuite/tests/backpack/cabal/bkpcabal05/all.T - testsuite/tests/backpack/cabal/bkpcabal06/all.T - testsuite/tests/backpack/cabal/bkpcabal07/all.T - testsuite/tests/cabal/T12733/all.T - testsuite/tests/cabal/cabal01/all.T - testsuite/tests/cabal/cabal03/all.T - testsuite/tests/cabal/cabal04/all.T - testsuite/tests/cabal/cabal05/all.T - testsuite/tests/cabal/cabal06/all.T - testsuite/tests/cabal/cabal08/all.T - testsuite/tests/cabal/cabal09/all.T - testsuite/tests/cabal/cabal10/all.T - testsuite/tests/cabal/t18567/all.T - testsuite/tests/cabal/t19518/all.T - testsuite/tests/cabal/t20242/all.T - testsuite/tests/driver/T1372/all.T - testsuite/tests/driver/T3007/all.T - testsuite/tests/driver/multipleHomeUnits/different-db/all.T - testsuite/tests/driver/multipleHomeUnits/mhu-closure/all.T - testsuite/tests/driver/package-imports-t20779/all.T - testsuite/tests/driver/recomp007/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/78cd11329ce2ed00cbba8a459fe688ccc8f83d13...08d8e9efa245e87e9c67da73e0987846865671d6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/78cd11329ce2ed00cbba8a459fe688ccc8f83d13...08d8e9efa245e87e9c67da73e0987846865671d6 You're receiving 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 Jun 15 22:10:13 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 15 Jun 2023 18:10:13 -0400 Subject: [Git][ghc/ghc][master] Fix test T18522-deb-ppr Message-ID: <648b8c45d9f01_32a24ec5f6c498e@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 2 changed files: - testsuite/tests/ghc-api/T18522-dbg-ppr.hs - testsuite/tests/ghc-api/all.T Changes: ===================================== testsuite/tests/ghc-api/T18522-dbg-ppr.hs ===================================== @@ -10,7 +10,7 @@ import GHC.Driver.Session import GHC.Core.TyCo.Ppr import GHC.Utils.Outputable import GHC.Tc.Module -import GHC.Tc.Utils.Zonk +import GHC.Tc.Zonk.Env import GHC.Utils.Error import GHC.Driver.Ppr import GHC.Driver.Env ===================================== testsuite/tests/ghc-api/all.T ===================================== @@ -26,7 +26,7 @@ test('T18181', compile_and_run, ['-package ghc']) test('T18522-dbg-ppr', - [extra_run_opts('"' + config.libdir + '"'), fragile(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/e8752e125f8b43adffac3b99e02455218828abed -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e8752e125f8b43adffac3b99e02455218828abed You're receiving 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 Jun 15 22:41:29 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 15 Jun 2023 18:41:29 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: JS: testsuite: use correct ticket number Message-ID: <648b93995eb06_32a24e339d04864121@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 6e3a2c3c by Ben Price at 2023-06-15T18:41:21-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - 3b97b5ff by Ryan Hendrickson at 2023-06-15T18:41:24-04:00 Clean a stray bit of text in user guide - - - - - efe7b16e by Vladislav Zavialov at 2023-06-15T18:41:24-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - 30 changed files: - compiler/GHC/Core/Lint.hs - docs/users_guide/exts/infix_tycons.rst - libraries/base/jsbits/errno.js - rts/js/profiling.js - testsuite/tests/backpack/cabal/T15594/all.T - testsuite/tests/backpack/cabal/T16219/all.T - testsuite/tests/backpack/cabal/T20509/all.T - testsuite/tests/backpack/cabal/bkpcabal01/all.T - testsuite/tests/backpack/cabal/bkpcabal02/all.T - testsuite/tests/backpack/cabal/bkpcabal03/all.T - testsuite/tests/backpack/cabal/bkpcabal04/all.T - testsuite/tests/backpack/cabal/bkpcabal05/all.T - testsuite/tests/backpack/cabal/bkpcabal06/all.T - testsuite/tests/backpack/cabal/bkpcabal07/all.T - testsuite/tests/cabal/T12733/all.T - testsuite/tests/cabal/cabal01/all.T - testsuite/tests/cabal/cabal03/all.T - testsuite/tests/cabal/cabal04/all.T - testsuite/tests/cabal/cabal05/all.T - testsuite/tests/cabal/cabal06/all.T - testsuite/tests/cabal/cabal08/all.T - testsuite/tests/cabal/cabal09/all.T - testsuite/tests/cabal/cabal10/all.T - testsuite/tests/cabal/t18567/all.T - testsuite/tests/cabal/t19518/all.T - testsuite/tests/cabal/t20242/all.T - testsuite/tests/driver/T1372/all.T - testsuite/tests/driver/T3007/all.T - testsuite/tests/driver/multipleHomeUnits/different-db/all.T - testsuite/tests/driver/multipleHomeUnits/mhu-closure/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5050fc5122c702932976f65f44aa898c6ce55f69...efe7b16e80b9dca099809e34a508bad920dfea84 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5050fc5122c702932976f65f44aa898c6ce55f69...efe7b16e80b9dca099809e34a508bad920dfea84 You're receiving 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 Jun 15 22:50:56 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 15 Jun 2023 18:50:56 -0400 Subject: [Git][ghc/ghc][wip/T23109] Further improvments Message-ID: <648b95d06de3_32a24e2e1155c71381@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23109 at Glasgow Haskell Compiler / GHC Commits: 3a586101 by Simon Peyton Jones at 2023-06-15T23:50:39+01:00 Further improvments - - - - - 2 changed files: - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Tc/Instance/Class.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -1405,6 +1405,7 @@ preInlineUnconditionally env top_lvl bndr rhs rhs_env | isExitJoinId bndr = Nothing -- Note [Do not inline exit join points] -- in module Exitify | not (one_occ (idOccInfo bndr)) = Nothing + | isDFunId bndr = Nothing | not (isStableUnfolding unf) = Just $! (extend_subst_with rhs) -- See Note [Stable unfoldings and preInlineUnconditionally] ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -30,12 +30,15 @@ import GHC.Builtin.Types.Prim import GHC.Builtin.Names import GHC.Types.FieldLabel -import GHC.Types.Name.Reader import GHC.Types.SafeHaskell -import GHC.Types.Name ( Name ) +import GHC.Types.Name ( Name, getOccName ) +import GHC.Types.Name.Reader +import GHC.Types.Name.Occurrence( occNameString, mkVarOcc ) import GHC.Types.Var.Env ( VarEnv ) import GHC.Types.Id +import GHC.Types.Id.Info import GHC.Types.Var +import GHC.Types.Basic( dfunInlinePragma ) import GHC.Core.Predicate import GHC.Core.Coercion @@ -45,8 +48,9 @@ import GHC.Core.Make ( mkCharExpr, mkNaturalExpr, mkStringExprFS, mkCoreLams ) import GHC.Core.DataCon import GHC.Core.TyCon import GHC.Core.Class +import GHC.Core.Unfold.Make( mkDFunUnfolding ) -import GHC.Core ( Expr(Var, App, Cast) ) +import GHC.Core ( Expr(..), Bind(..), mkConApp ) import GHC.Utils.Outputable import GHC.Utils.Panic @@ -387,26 +391,42 @@ makeLitDict :: Class -> Type -> EvExpr -> TcM ClsInstResult -- The process is mirrored for Symbols: -- String -> SSymbol n -- SSymbol n -> KnownSymbol n -makeLitDict clas ty et - | Just (_, co_dict) <- tcInstNewTyCon_maybe (classTyCon clas) [ty] - -- co_dict :: KnownNat n ~ SNat n - , [ meth ] <- classMethods clas - , Just tcRep <- tyConAppTyCon_maybe (classMethodTy meth) - -- If the method type is forall n. KnownNat n => SNat n - -- then tcRep is SNat - , Just (_, co_rep) <- tcInstNewTyCon_maybe tcRep [ty] - -- SNat n ~ Integer - , let ev_tm = mkEvCast et (mkSymCo (mkTransCo co_dict co_rep)) - = return $ OneInst { cir_new_theta = [] - , cir_mk_ev = \_ -> ev_tm - , cir_coherence = IsCoherent - , cir_what = BuiltinInstance } +makeLitDict clas lit_ty lit_expr + | [meth] <- classMethods clas + , Just rep_tc <- tyConAppTyCon_maybe (classMethodTy meth) + -- If the method type is forall n. KnownNat n => SNat n + -- then rep_tc :: TyCon is SNat + , [dict_con] <- tyConDataCons (classTyCon clas) + , [rep_con] <- tyConDataCons rep_tc + , let pred_ty = mkClassPred clas [lit_ty] + dict_args = [ Type lit_ty, mkConApp rep_con [Type lit_ty, lit_expr] ] + dfun_rhs = mkConApp dict_con dict_args + dfun_info = vanillaIdInfo `setUnfoldingInfo` mkDFunUnfolding [] dict_con dict_args + `setInlinePragInfo` dfunInlinePragma + dfun_occ_str :: String + = "$f" ++ occNameString (getOccName clas) ++ + occNameString (getDFunTyKey lit_ty) + + = do { df_name <- newName (mkVarOcc dfun_occ_str) + ; let dfun_id = mkLocalVar (DFunId True) df_name ManyTy pred_ty dfun_info + ev_tm = EvExpr (Let (NonRec dfun_id dfun_rhs) (Var dfun_id)) + ; return $ OneInst { cir_new_theta = [] + , cir_mk_ev = \_ -> ev_tm + , cir_coherence = IsCoherent + , cir_what = BuiltinInstance } } | otherwise = pprPanic "makeLitDict" $ text "Unexpected evidence for" <+> ppr (className clas) $$ vcat (map (ppr . idType) (classMethods clas)) +{- Here is what we are making + let $dfKnownNat17 :: KnownNat 17 + [Unfolding = DFun :DKnownNat @17 (UnsafeSNat @17 17)] + $dfKnownNat17 = :DKnownNat @17 (UnsafeSNat @17 17) + in $dfKnownNat17 +-} + {- ******************************************************************** * * Class lookup for WithDict View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3a586101f411228e35fe9840e988146a8b2a10d0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3a586101f411228e35fe9840e988146a8b2a10d0 You're receiving 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 Jun 16 07:22:38 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 16 Jun 2023 03:22:38 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Lint: more details on "Occurrence is GlobalId, but binding is LocalId" Message-ID: <648c0dbe56232_32a24e274dc7011901f@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: c24c0e7d by Ben Price at 2023-06-16T03:22:28-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - f7e3ca7a by Ryan Hendrickson at 2023-06-16T03:22:31-04:00 Clean a stray bit of text in user guide - - - - - 047b8d26 by Vladislav Zavialov at 2023-06-16T03:22:32-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - 15 changed files: - compiler/GHC/Core/Lint.hs - docs/users_guide/exts/infix_tycons.rst - + 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/VisFlag4.hs - + testsuite/tests/typecheck/should_fail/VisFlag4.stderr - + testsuite/tests/typecheck/should_fail/VisFlag5.hs - + testsuite/tests/typecheck/should_fail/VisFlag5.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -3243,7 +3243,7 @@ lookupIdInScope id_occ = do { in_scope_ids <- getInScopeIds ; case lookupVarEnv in_scope_ids id_occ of Just (id_bndr, linted_ty) - -> do { checkL (not (bad_global id_bndr)) global_in_scope + -> do { checkL (not (bad_global id_bndr)) $ global_in_scope id_bndr ; return (id_bndr, linted_ty) } Nothing -> do { checkL (not is_local) local_out_of_scope ; return (id_occ, idType id_occ) } } @@ -3252,8 +3252,10 @@ lookupIdInScope id_occ where is_local = mustHaveLocalBinding id_occ local_out_of_scope = text "Out of scope:" <+> pprBndr LetBind id_occ - global_in_scope = hang (text "Occurrence is GlobalId, but binding is LocalId") - 2 (pprBndr LetBind id_occ) + global_in_scope id_bndr = hang (text "Occurrence is GlobalId, but binding is LocalId") + 2 $ vcat [hang (text "occurrence:") 2 $ pprBndr LetBind id_occ + ,hang (text "binder :") 2 $ pprBndr LetBind id_bndr + ] bad_global id_bnd = isGlobalId id_occ && isLocalId id_bnd && not (isWiredIn id_occ) ===================================== docs/users_guide/exts/infix_tycons.rst ===================================== @@ -41,7 +41,7 @@ specifically: infixl 7 T, :*: sets the fixity for both type constructor ``T`` and data constructor - ``T``, and similarly for ``:*:``. ``Int `a` Bool``. + ``T``, and similarly for ``:*:``. - The function arrow ``->`` is ``infixr`` with fixity -1. ===================================== 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,27 @@ + +VisFlag1.hs:12:16: error: [GHC-83865] + • Expecting one more argument to ‘V’ + Expected kind ‘forall j. j -> *’, + but ‘V’ has kind ‘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-18872] + • Couldn't match kind: forall k -> k -> * + with: forall j. j -> * + When matching types + hk0 :: forall j. j -> * + V :: forall k -> k -> * + 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/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-83865] + • Expecting one more argument to ‘V’ + Expected kind ‘forall j. j -> *’, + but ‘V’ has kind ‘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-83865] + • Expecting one more argument to ‘V’ + Expected kind ‘forall j. j -> *’, + but ‘V’ has kind ‘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,15 @@ + +VisFlag2.hs:13:21: error: [GHC-83865] + • Couldn't match kind: forall a. a + with: forall a -> a + Expected kind ‘* -> forall a -> a’, + but ‘Invis’ has kind ‘* -> forall a. a’ + • In the type ‘Invis’ + In the type instance declaration for ‘Vis’ + +VisFlag2.hs:14:23: error: [GHC-83865] + • Expecting one more argument to ‘Vis’ + Expected kind ‘* -> forall a. a’, + but ‘Vis’ has kind ‘* -> 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-83865] + • Expecting one more argument to ‘hk’ + Expected kind ‘forall k. k -> k’, + but ‘hk’ has kind ‘forall k -> k -> k’ + • In the associated type family declaration for ‘F’ ===================================== testsuite/tests/typecheck/should_fail/VisFlag4.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE StandaloneKindSignatures #-} + +module VisFlag4 where + +import Data.Kind + +type C :: (forall k -> k -> k) -> Constraint +class C (hk :: forall k. k -> k) where ===================================== testsuite/tests/typecheck/should_fail/VisFlag4.stderr ===================================== @@ -0,0 +1,5 @@ + +VisFlag4.hs:8:1: error: [GHC-83865] + • Expected kind ‘forall k -> k -> k’, + but ‘hk’ has kind ‘forall k. k -> k’ + • In the class declaration for ‘C’ ===================================== testsuite/tests/typecheck/should_fail/VisFlag5.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeFamilies #-} + +module VisFlag5 where + +import Data.Kind + +data family D a :: (forall i -> i -> i) -> Type +data instance D Int :: (forall i. i -> i) -> Type ===================================== testsuite/tests/typecheck/should_fail/VisFlag5.stderr ===================================== @@ -0,0 +1,7 @@ + +VisFlag5.hs:8:1: error: [GHC-83865] + • Couldn't match kind: forall i -> i -> i + with: forall i. i -> i + Expected kind ‘(forall i. i -> i) -> *’, + but ‘D Int’ has kind ‘(forall i -> i -> i) -> *’ + • In the data instance declaration for ‘D’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -690,3 +690,9 @@ test('T22560_fail_b', normal, compile_fail, ['']) test('T22560_fail_c', normal, compile_fail, ['']) test('T22560_fail_d', normal, compile_fail, ['']) test('T22560_fail_ext', normal, compile_fail, ['']) +test('VisFlag1', normal, compile_fail, ['']) +test('VisFlag1_ql', normal, compile_fail, ['']) +test('VisFlag2', normal, compile_fail, ['']) +test('VisFlag3', normal, compile_fail, ['']) +test('VisFlag4', normal, compile_fail, ['']) +test('VisFlag5', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/efe7b16e80b9dca099809e34a508bad920dfea84...047b8d26e5b9039042ecc8fb0a21ea828a9cedc1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/efe7b16e80b9dca099809e34a508bad920dfea84...047b8d26e5b9039042ecc8fb0a21ea828a9cedc1 You're receiving 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 Jun 16 08:02:58 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Fri, 16 Jun 2023 04:02:58 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/DIB-INSTANCES] Remove arity inference in type declarations (#23514) Message-ID: <648c17326d955_32a24e339d04813675d@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/DIB-INSTANCES at Glasgow Haskell Compiler / GHC Commits: 1dcf8ecf by Andrei Borzenkov at 2023-06-16T12:02:40+04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 22 changed files: - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Splice.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - testsuite/tests/perf/compiler/CoOpt_Singletons.hs - + testsuite/tests/rename/should_compile/T23514b.hs - testsuite/tests/rename/should_compile/all.T - + testsuite/tests/rename/should_fail/T23514a.hs - + testsuite/tests/rename/should_fail/T23514a.stderr - testsuite/tests/rename/should_fail/all.T - testsuite/tests/saks/should_compile/T16724.stdout - testsuite/tests/saks/should_compile/saks020.hs - testsuite/tests/saks/should_compile/saks030.hs - testsuite/tests/saks/should_compile/saks032.hs - + testsuite/tests/th/CodeQ_HKD.hs - testsuite/tests/th/all.T - + testsuite/tests/typecheck/should_compile/T23514c.hs - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_fail/T18640a.hs - testsuite/tests/typecheck/should_fail/T18640a.stderr - testsuite/tests/typecheck/should_fail/T18640c.hs - testsuite/tests/typecheck/should_fail/T18640c.stderr Changes: ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -863,12 +863,7 @@ pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype, cons = visibleIfConDecls condecls pp_where = ppWhen (gadt && not (null cons)) $ text "where" pp_cons = ppr_trim (map show_con cons) :: [SDoc] - pp_kind = ppUnless (if ki_sig_printable - then isIfaceRhoType kind - -- Even in the presence of a standalone kind signature, a non-tau - -- result kind annotation cannot be discarded as it determines the arity. - -- See Note [Arity inference in kcCheckDeclHeader_sig] in GHC.Tc.Gen.HsType - else isIfaceLiftedTypeKind kind) + pp_kind = ppUnless (ki_sig_printable || isIfaceLiftedTypeKind kind) (dcolon <+> ppr kind) pp_lhs = case parent of ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -2555,37 +2555,30 @@ kcCheckDeclHeader_sig sig_kind name flav -- ^^^^^^^^^ -- We do it here because at this point the environment has been -- extended with both 'implicit_tcv_prs' and 'explicit_tv_prs'. + -- + -- Also see Note [Arity of type families and type synonyms] ; ctx_k <- kc_res_ki - -- Work out extra_arity, the number of extra invisible binders from - -- the kind signature that should be part of the TyCon's arity. - -- See Note [Arity inference in kcCheckDeclHeader_sig] - ; let n_invis_tcbs = countWhile isInvisibleTyConBinder excess_sig_tcbs - invis_arity = case ctx_k of - AnyKind -> n_invis_tcbs -- No kind signature, so make all the invisible binders - -- the signature into part of the arity of the TyCon - OpenKind -> n_invis_tcbs -- Result kind is (TYPE rr), so again make all the - -- invisible binders part of the arity of the TyCon - TheKind ki -> 0 `max` (n_invis_tcbs - invisibleTyBndrCount ki) + ; let sig_res_kind' = mkTyConKind excess_sig_tcbs sig_res_kind - ; let (invis_tcbs, resid_tcbs) = splitAt invis_arity excess_sig_tcbs - ; let sig_res_kind' = mkTyConKind resid_tcbs sig_res_kind - - ; traceTc "kcCheckDeclHeader_sig 2" $ vcat [ ppr excess_sig_tcbs - , ppr invis_arity, ppr invis_tcbs - , ppr n_invis_tcbs ] + ; traceTc "kcCheckDeclHeader_sig 2" $ + vcat [ text "excess_sig_tcbs" <+> ppr excess_sig_tcbs + , text "ctx_k" <+> ppr ctx_k + , text "sig_res_kind'" <+> ppr sig_res_kind' + ] -- Unify res_ki (from the type declaration) with the residual kind from -- the kind signature. Don't forget to apply the skolemising 'subst' first. ; case ctx_k of AnyKind -> return () -- No signature - _ -> do { res_ki <- newExpectedKind ctx_k - ; discardResult (unifyKind Nothing sig_res_kind' res_ki) } + _ -> do + res_ki <- newExpectedKind ctx_k + check_exp_res_ki sig_res_kind' res_ki -- Add more binders for data/newtype, so the result kind has no arrows -- See Note [Datatype return kinds] - ; if null resid_tcbs || not (needsEtaExpansion flav) - then return (invis_tcbs, sig_res_kind') + ; if null excess_sig_tcbs || not (needsEtaExpansion flav) + then return ([], sig_res_kind') else return (excess_sig_tcbs, sig_res_kind) } @@ -2641,6 +2634,22 @@ kcCheckDeclHeader_sig sig_kind name flav ] ; return tc } +-- | This instantiates invisible arguments for the type being checked if it must +-- be saturated and is not yet saturated. +check_exp_res_ki :: TcKind -- ^ the known kind of that type + -> TcKind -- ^ the expected kind + -> TcM () +-- Just a convenience wrapper to save calls to 'ppr' +check_exp_res_ki act_kind exp_kind + = discardResult $ unifyKind Nothing act_kind' exp_kind + where + (_, act_kind') = splitInvisPiTysN n_to_inst act_kind + + -- by analogy with checkExpectedKind + n_exp_invis_bndrs = invisibleTyBndrCount exp_kind + n_act_invis_bndrs = invisibleTyBndrCount act_kind + n_to_inst = n_act_invis_bndrs - n_exp_invis_bndrs + matchUpSigWithDecl :: Name -- Name of the type constructor for error messages -> [TcTyConBinder] -- TcTyConBinders (with skolem TcTyVars) from the separate kind signature @@ -2738,8 +2747,8 @@ swizzleTcb swizzle_env subst (Bndr tv vis) -- See Note [Source locations for implicitly bound type variables] -- in GHC.Tc.Rename.HsType -{- See Note [kcCheckDeclHeader_sig] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [kcCheckDeclHeader_sig] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Given a kind signature 'sig_kind' and a declaration header, kcCheckDeclHeader_sig verifies that the declaration conforms to the signature. The end result is a PolyTcTyCon 'tc' such that: @@ -2780,85 +2789,39 @@ Basic plan is this: part of the signature (k -> Type) with the kind signature of the decl, (j -> Type). This unification, done in kcCheckDeclHeader, needs TcTyVars. - * The tricky extra_arity part is described in - Note [Arity inference in kcCheckDeclHeader_sig] - -Note [Arity inference in kcCheckDeclHeader_sig] +Note [Arity of type families and type synonyms] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider these declarations: - type family S1 :: forall k2. k1 -> k2 -> Type - type family S2 (a :: k1) (b :: k2) :: Type - -Both S1 and S2 can be given the same standalone kind signature: - type S1 :: forall k1 k2. k1 -> k2 -> Type - type S2 :: forall k1 k2. k1 -> k2 -> Type - -And, indeed, tyConKind S1 == tyConKind S2. However, -tyConBinders and tyConResKind for S1 and S2 are different: - - tyConBinders S1 == [spec k1] - tyConResKind S1 == forall k2. k1 -> k2 -> Type - tyConKind S1 == forall k1 k2. k1 -> k2 -> Type - - tyConBinders S2 == [spec k1, spec k2, anon-vis (a :: k1), anon-vis (b :: k2)] - tyConResKind S2 == Type - tyConKind S1 == forall k1 k2. k1 -> k2 -> Type - -This difference determines the /arity/: - tyConArity tc == length (tyConBinders tc) -That is, the arity of S1 is 1, while the arity of S2 is 4. - -'kcCheckDeclHeader_sig' needs to infer the desired arity, to split the -standalone kind signature into binders and the result kind. It does so -in two rounds: - -1. matchUpSigWithDecl matches up - - the [TyConBinder] from (applying splitTyConKind to) the kind signature - - with the [LHsTyVarBndr] from the type declaration. - That may leave some excess TyConBinder: in the case of S2 there are - no excess TyConBinders, but in the case of S1 there are two (since - there are no LHsTYVarBndrs. - -2. Split off further TyConBinders (in the case of S1, one more) to - make it possible to unify the residual return kind with the - signature in the type declaration. More precisely, split off such - enough invisible that the remainder of the standalone kind - signature and the user-written result kind signature have the same - number of invisible quantifiers. - -As another example consider the following declarations: - - type F :: Type -> forall j. j -> forall k1 k2. (k1, k2) -> Type - type family F a b +Consider - type G :: Type -> forall j. j -> forall k1 k2. (k1, k2) -> Type - type family G a b :: forall r2. (r1, r2) -> Type + type F1 :: forall k. k -> k -> Type + type family F1 @k -For both F and G, the signature (after splitTyConKind) has - sig_tcbs :: [TyConBinder] - = [ anon-vis (@a_aBq), spec (@j_auA), anon-vis (@(b_aBr :: j_auA)) - , spec (@k1_auB), spec (@k2_auC) - , anon-vis (@(c_aBs :: (k1_auB, k2_auC)))] + type F2a :: forall k. k -> k -> Type + type family F2a @k a -matchUpSigWithDecl will consume the first three of these, passing on - excess_sig_tcbs - = [ spec (@k1_auB), spec (@k2_auC) - , anon-vis (@(c_aBs :: (k1_auB, k2_auC)))] + type F2b :: forall k. k -> k -> Type + type family F2b a -For F, there is no result kind signature in the declaration for F, so -we absorb all invisible binders into F's arity. The resulting arity of -F is 3+2=5. + type F3 :: forall k. k -> k -> Type + type family F3 a b -Now, in the case of G, we have a result kind sig 'forall r2. (r2,r2)->Type'. -This has one invisible binder, so we split of enough extra binders from -our excess_sig_tcbs to leave just one to match 'r2'. +All four have the same /kind/, but what /arity/ do they have? +For a type family, the arity is critical: +* A type family must always appear saturated (up to its arity) +* A type family can match only on `arity` arguments, not further ones +* The arity is recorded by `tyConArity`, and is equal to the number of + `TyConBinders` in the `TyCon`. +* In this context "arity" includes both kind and type arguments. - res_ki = forall r2. (r1, r2) -> Type - kisig = forall k1 k2. (k1, k2) -> Type - ^^^ - split off this one. +The arity is not determined by the kind signature (all four have the same signature). +Rather, it is determined by the declaration of the family: +* `F1` has arity 1. +* `F2a` has arity 2. +* `F2b` also has arity 2: the kind argument is invisible. +* `F3` has arity 3; again the kind argument is invisible. -The resulting arity of G is 3+1=4. +The matching-up of kind signature with the declaration itself is done by +`matchUpWithSigDecl`. Note [discardResult in kcCheckDeclHeader_sig] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2949,6 +2912,12 @@ data ContextKind = TheKind TcKind -- ^ a specific kind | AnyKind -- ^ any kind will do | OpenKind -- ^ something of the form @TYPE _@ +-- debug only +instance Outputable ContextKind where + ppr AnyKind = text "AnyKind" + ppr OpenKind = text "OpenKind" + ppr (TheKind k) = text "TheKind" <+> ppr k + ----------------------- newExpectedKind :: ContextKind -> TcM TcKind newExpectedKind (TheKind k) = return k ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -796,7 +796,7 @@ tcTExpTy m_ty exp_ty TcRnTHError $ TypedTHError $ TypedTHWithPolyType exp_ty ; codeCon <- tcLookupTyCon codeTyConName ; let rep = getRuntimeRep exp_ty - ; return (mkTyConApp codeCon [rep, m_ty, exp_ty]) } + ; return (mkTyConApp codeCon [m_ty, rep, exp_ty]) } quotationCtxtDoc :: LHsExpr GhcRn -> SDoc quotationCtxtDoc br_body ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -378,8 +378,11 @@ The splice will evaluate to (MkAge 3) and you can't add that to 4::Int. So you can't coerce a (Code Q Age) to a (Code Q Int). -} -- Code constructor - +#if __GLASGOW_HASKELL__ >= 907 +type Code :: (Kind.Type -> Kind.Type) -> forall r. TYPE r -> Kind.Type +#else type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type +#endif type role Code representational nominal -- See Note [Role of TExp] newtype Code m a = Code { examineCode :: m (TExp a) -- ^ Underlying monadic value ===================================== testsuite/tests/perf/compiler/CoOpt_Singletons.hs ===================================== @@ -52,7 +52,7 @@ type SameKind :: k -> k -> Constraint type SameKind (a :: k) (b :: k) = (() :: Constraint) type Sing :: k -> Type -type family Sing :: k -> Type +type family Sing @k :: k -> Type type SLambda :: (k1 ~> k2) -> Type newtype SLambda (f :: k1 ~> k2) = @@ -386,7 +386,7 @@ type family (<>@#@$$$) (a6989586621679047054 :: a_a9GJ) (a6989586621679047055 :: class PSemigroup a_a9GJ where type family (<>) (arg_a9GX :: a_a9GJ) (arg_a9GY :: a_a9GJ) :: a_a9GJ type MemptySym0 :: forall a_a9GK. a_a9GK -type family MemptySym0 :: a_a9GK where +type family MemptySym0 @a_a9GK :: a_a9GK where MemptySym0 = Mempty type MappendSym0 :: forall a_a9GK. (~>) a_a9GK ((~>) a_a9GK a_a9GK) data MappendSym0 :: (~>) a_a9GK ((~>) a_a9GK a_a9GK) @@ -450,10 +450,10 @@ type family TFHelper_6989586621679047079Sym2 (a6989586621679047084 :: Dual a_a9G instance PSemigroup (Dual a_a9GL) where type (<>) a_a9Hn a_a9Ho = Apply (Apply TFHelper_6989586621679047079Sym0 a_a9Hn) a_a9Ho type Mempty_6989586621679047088 :: Dual a_a9GO -type family Mempty_6989586621679047088 :: Dual a_a9GO where +type family Mempty_6989586621679047088 @a_a9GO :: Dual a_a9GO where Mempty_6989586621679047088 = Apply DualSym0 MemptySym0 type Mempty_6989586621679047088Sym0 :: Dual a_a9GO -type family Mempty_6989586621679047088Sym0 :: Dual a_a9GO where +type family Mempty_6989586621679047088Sym0 @a_a9GO :: Dual a_a9GO where Mempty_6989586621679047088Sym0 = Mempty_6989586621679047088 instance PMonoid (Dual a_a9GO) where type Mempty = Mempty_6989586621679047088Sym0 @@ -549,10 +549,10 @@ type family TFHelper_6989586621679075091Sym2 (a6989586621679075096 :: Endo a_agC instance PSemigroup (Endo a_agCk) where type (<>) a_agZb a_agZc = Apply (Apply TFHelper_6989586621679075091Sym0 a_agZb) a_agZc type Mempty_6989586621679075313 :: Endo a_agCn -type family Mempty_6989586621679075313 :: Endo a_agCn where +type family Mempty_6989586621679075313 @a_agCn :: Endo a_agCn where Mempty_6989586621679075313 = Apply EndoSym0 IdSym0 type Mempty_6989586621679075313Sym0 :: Endo a_agCn -type family Mempty_6989586621679075313Sym0 :: Endo a_agCn where +type family Mempty_6989586621679075313Sym0 @a_agCn :: Endo a_agCn where Mempty_6989586621679075313Sym0 = Mempty_6989586621679075313 instance PMonoid (Endo a_agCn) where type Mempty = Mempty_6989586621679075313Sym0 ===================================== testsuite/tests/rename/should_compile/T23514b.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies, DataKinds #-} +module T23514b where + +import GHC.Types + +type F :: Type -> forall k. Maybe k +type family F x @k where + F Int @Type = Just Bool + F Int = Just Either ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -213,3 +213,4 @@ test('T23240', [req_th, extra_files(['T23240_aux.hs'])], multimod_compile, ['T23 test('T23318', normal, compile, ['-Wduplicate-exports']) test('T23434', normal, compile, ['']) test('T23510b', normal, compile, ['']) +test('T23514b', normal, compile, ['']) ===================================== testsuite/tests/rename/should_fail/T23514a.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies, DataKinds #-} +module T23514a where + +import GHC.Types + +type F :: Type -> forall k. Maybe k +type family F x where + F Int @Type = Just Bool + F Int = Just Either ===================================== testsuite/tests/rename/should_fail/T23514a.stderr ===================================== @@ -0,0 +1,6 @@ + +T23514a.hs:9:17: error: [GHC-83865] + • Expected kind ‘forall k. Maybe k’, + but ‘Just Either’ has kind ‘Maybe (* -> * -> *)’ + • In the type ‘Just Either’ + In the type family declaration for ‘F’ ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -200,3 +200,4 @@ test('RnStupidThetaInGadt', normal, compile_fail, ['']) test('PackageImportsDisabled', normal, compile_fail, ['']) test('ImportLookupIllegal', normal, compile_fail, ['']) test('T23510a', normal, compile_fail, ['']) +test('T23514a', normal, compile_fail, ['']) ===================================== testsuite/tests/saks/should_compile/T16724.stdout ===================================== @@ -1,6 +1,6 @@ type T1 :: forall k (a :: k). Type -type family T1 @k @a +type family T1 -- Defined at T16724.hs:11:1 type T2 :: forall {k} (a :: k). Type -type family T2 @{k} @a +type family T2 -- Defined at T16724.hs:15:1 ===================================== testsuite/tests/saks/should_compile/saks020.hs ===================================== @@ -6,4 +6,4 @@ module SAKS_020 where import Data.Kind (Type) type T :: forall k. k -> forall j. j -> Type -data T (x :: hk) :: hj -> Type +data T (x :: hk) @hj :: hj -> Type ===================================== testsuite/tests/saks/should_compile/saks030.hs ===================================== @@ -10,7 +10,7 @@ import Data.Type.Equality type T1 :: forall k (a :: k). Bool type T2 :: k -> Bool -type family T1 where +type family T1 @k @a where T1 @Bool @True = False T1 @Bool @False = True ===================================== testsuite/tests/saks/should_compile/saks032.hs ===================================== @@ -18,4 +18,4 @@ type F1 :: Type -> forall j. j -> forall k1 k2. (k1, k2) -> Type type family F1 a b type F2 :: Type -> forall j. j -> forall k1 k2. (k1, k2) -> Type -type family F2 a b :: forall r2. (r1, r2) -> Type +type family F2 a b @r1 :: forall r2. (r1, r2) -> Type ===================================== testsuite/tests/th/CodeQ_HKD.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE TemplateHaskell #-} + +module CodeQ_HKD where +import GHC.Exts +import Data.Kind +import Language.Haskell.TH hiding (Type) + +data T (f :: forall r . (TYPE r) -> Type) = MkT (f Int) (f Int#) + + +tcodeq :: T CodeQ +tcodeq = MkT [||5||] [||5#||] ===================================== testsuite/tests/th/all.T ===================================== @@ -576,3 +576,4 @@ test('T21050', normal, compile_fail, ['']) test('T22559a', normal, compile_fail, ['']) test('T22559b', normal, compile_fail, ['']) test('T22559c', normal, compile_fail, ['']) +test('CodeQ_HKD', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_compile/T23514c.hs ===================================== @@ -0,0 +1,21 @@ +module T23514c where +import Data.Kind + + +type P1 :: forall k (a :: k) . k -> Type +data P1 :: k -> Type + +type P2 :: forall k (a :: k) . k -> Type +data P2 @k :: k -> Type + +type P3 :: forall k (a :: k) . k -> Type +data P3 @k @a :: k -> Type + +type P4 :: forall k (a :: k) . k -> Type +data P4 :: forall k (a :: k) . k -> Type + +type P5 :: forall k (a :: k) . k -> Type +data P5 :: forall a . k -> Type + +type P6 :: forall k (a :: k) . k -> Type +data P6 @k :: forall a . k -> Type ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -880,3 +880,4 @@ test('T22560b', normal, compile, ['']) test('T22560c', normal, compile, ['']) test('T22560d', extra_files(['T22560d.hs']), ghci_script, ['T22560d.script']) test('T22560e', normal, compile, ['']) +test('T23514c', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/T18640a.hs ===================================== @@ -8,4 +8,4 @@ module T18640a where import Data.Kind type F2 :: forall a b. Type -> a -type family F2 :: forall b. Type -> Type where +type family F2 @a :: forall b. Type -> Type where ===================================== testsuite/tests/typecheck/should_fail/T18640a.stderr ===================================== @@ -5,5 +5,5 @@ T18640a.hs:11:1: error: [GHC-25897] Actual: forall (b :: k). * -> a ‘a’ is a rigid type variable bound by the type family declaration for ‘F2’ - at T18640a.hs:10:19 + at T18640a.hs:11:17 • In the type family declaration for ‘F2’ ===================================== testsuite/tests/typecheck/should_fail/T18640c.hs ===================================== @@ -11,4 +11,4 @@ type F1 :: forall k -> Type type family F1 k :: Type type F2 :: forall x. forall k -> x -type F2 = F1 +type F2 k = F1 k ===================================== testsuite/tests/typecheck/should_fail/T18640c.stderr ===================================== @@ -1,10 +1,8 @@ -T18640c.hs:14:11: error: [GHC-25897] - • Couldn't match kind ‘x’ with ‘*’ - Expected kind ‘forall (k1 :: k) -> x’, - but ‘F1’ has kind ‘forall (k1 :: k) -> *’ +T18640c.hs:14:13: error: [GHC-25897] + • Expected kind ‘x’, but ‘F1 k’ has kind ‘*’ ‘x’ is a rigid type variable bound by the type synonym declaration for ‘F2’ at T18640c.hs:13:19 - • In the type ‘F1’ + • In the type ‘F1 k’ In the type declaration for ‘F2’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1dcf8ecf3d8ddc97d879d6cef25ad545e85704cb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1dcf8ecf3d8ddc97d879d6cef25ad545e85704cb You're receiving 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 Jun 16 08:04:37 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Fri, 16 Jun 2023 04:04:37 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/dib-instances] 6 commits: Report scoped kind variables at the type-checking phase (#16635) Message-ID: <648c17955f411_32a24e2e1155c1408f3@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/dib-instances at Glasgow Haskell Compiler / GHC Commits: 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 63d2c679 by Andrei Borzenkov at 2023-06-16T12:04:18+04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 30 changed files: - compiler/GHC/Hs/Type.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Errors/Types/PromotionErr.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Types/BasicTypes.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Types/Error/Codes.hs - docs/users_guide/9.8.1-notes.rst - libraries/base/jsbits/errno.js - rts/js/profiling.js - testsuite/tests/backpack/cabal/T15594/all.T - testsuite/tests/backpack/cabal/T16219/all.T - testsuite/tests/backpack/cabal/T20509/all.T - testsuite/tests/backpack/cabal/bkpcabal01/all.T - testsuite/tests/backpack/cabal/bkpcabal02/all.T - testsuite/tests/backpack/cabal/bkpcabal03/all.T - testsuite/tests/backpack/cabal/bkpcabal04/all.T - testsuite/tests/backpack/cabal/bkpcabal05/all.T - testsuite/tests/backpack/cabal/bkpcabal06/all.T - testsuite/tests/backpack/cabal/bkpcabal07/all.T - testsuite/tests/cabal/T12733/all.T - testsuite/tests/cabal/cabal01/all.T - testsuite/tests/cabal/cabal03/all.T - testsuite/tests/cabal/cabal04/all.T - testsuite/tests/cabal/cabal05/all.T - testsuite/tests/cabal/cabal06/all.T - testsuite/tests/cabal/cabal08/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b932b26bfbeb15dd6ab2211fbf4a50f150a12dbe...63d2c67932ed70bc19fd62dcad4763d11af24303 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b932b26bfbeb15dd6ab2211fbf4a50f150a12dbe...63d2c67932ed70bc19fd62dcad4763d11af24303 You're receiving 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 Jun 16 08:31:31 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 16 Jun 2023 04:31:31 -0400 Subject: [Git][ghc/ghc][wip/haddock-mem-fixes] Bump haddock submodule Message-ID: <648c1de3b7fc0_32a24e30292a41478cb@gitlab.mail> Matthew Pickering pushed to branch wip/haddock-mem-fixes at Glasgow Haskell Compiler / GHC Commits: ba607766 by Finley McIlwaine at 2023-06-16T09:31:07+01:00 Bump haddock submodule - - - - - 1 changed file: - utils/haddock Changes: ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 30cf825972c53d97d6add9aa0e61bcb32ccc3ad1 +Subproject commit 2ec4f67265b709dda79fabd5ccdd9a1fb16bee56 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ba60776611f07d64a17e3aede50c9dd76c40667e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ba60776611f07d64a17e3aede50c9dd76c40667e You're receiving 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 Jun 16 08:39:20 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Fri, 16 Jun 2023 04:39:20 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/DIB-INSTANCES] Remove arity inference in type declarations (#23514) Message-ID: <648c1fb82cedb_32a24e339cfd0155573@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/DIB-INSTANCES at Glasgow Haskell Compiler / GHC Commits: 7cfbb301 by Andrei Borzenkov at 2023-06-16T12:39:05+04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 22 changed files: - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Splice.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - libraries/template-haskell/changelog.md - testsuite/tests/perf/compiler/CoOpt_Singletons.hs - testsuite/tests/saks/should_compile/T16724.stdout - testsuite/tests/saks/should_compile/saks020.hs - testsuite/tests/saks/should_compile/saks030.hs - testsuite/tests/saks/should_compile/saks032.hs - + testsuite/tests/th/CodeQ_HKD.hs - testsuite/tests/th/all.T - + testsuite/tests/typecheck/should_compile/T23514b.hs - + testsuite/tests/typecheck/should_compile/T23514c.hs - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_fail/T18640a.hs - testsuite/tests/typecheck/should_fail/T18640a.stderr - testsuite/tests/typecheck/should_fail/T18640c.hs - testsuite/tests/typecheck/should_fail/T18640c.stderr - + testsuite/tests/typecheck/should_fail/T23514a.hs - + testsuite/tests/typecheck/should_fail/T23514a.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -863,12 +863,7 @@ pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype, cons = visibleIfConDecls condecls pp_where = ppWhen (gadt && not (null cons)) $ text "where" pp_cons = ppr_trim (map show_con cons) :: [SDoc] - pp_kind = ppUnless (if ki_sig_printable - then isIfaceRhoType kind - -- Even in the presence of a standalone kind signature, a non-tau - -- result kind annotation cannot be discarded as it determines the arity. - -- See Note [Arity inference in kcCheckDeclHeader_sig] in GHC.Tc.Gen.HsType - else isIfaceLiftedTypeKind kind) + pp_kind = ppUnless (ki_sig_printable || isIfaceLiftedTypeKind kind) (dcolon <+> ppr kind) pp_lhs = case parent of ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -2555,37 +2555,30 @@ kcCheckDeclHeader_sig sig_kind name flav -- ^^^^^^^^^ -- We do it here because at this point the environment has been -- extended with both 'implicit_tcv_prs' and 'explicit_tv_prs'. + -- + -- Also see Note [Arity of type families and type synonyms] ; ctx_k <- kc_res_ki - -- Work out extra_arity, the number of extra invisible binders from - -- the kind signature that should be part of the TyCon's arity. - -- See Note [Arity inference in kcCheckDeclHeader_sig] - ; let n_invis_tcbs = countWhile isInvisibleTyConBinder excess_sig_tcbs - invis_arity = case ctx_k of - AnyKind -> n_invis_tcbs -- No kind signature, so make all the invisible binders - -- the signature into part of the arity of the TyCon - OpenKind -> n_invis_tcbs -- Result kind is (TYPE rr), so again make all the - -- invisible binders part of the arity of the TyCon - TheKind ki -> 0 `max` (n_invis_tcbs - invisibleTyBndrCount ki) + ; let sig_res_kind' = mkTyConKind excess_sig_tcbs sig_res_kind - ; let (invis_tcbs, resid_tcbs) = splitAt invis_arity excess_sig_tcbs - ; let sig_res_kind' = mkTyConKind resid_tcbs sig_res_kind - - ; traceTc "kcCheckDeclHeader_sig 2" $ vcat [ ppr excess_sig_tcbs - , ppr invis_arity, ppr invis_tcbs - , ppr n_invis_tcbs ] + ; traceTc "kcCheckDeclHeader_sig 2" $ + vcat [ text "excess_sig_tcbs" <+> ppr excess_sig_tcbs + , text "ctx_k" <+> ppr ctx_k + , text "sig_res_kind'" <+> ppr sig_res_kind' + ] -- Unify res_ki (from the type declaration) with the residual kind from -- the kind signature. Don't forget to apply the skolemising 'subst' first. ; case ctx_k of AnyKind -> return () -- No signature - _ -> do { res_ki <- newExpectedKind ctx_k - ; discardResult (unifyKind Nothing sig_res_kind' res_ki) } + _ -> do + res_ki <- newExpectedKind ctx_k + check_exp_res_ki sig_res_kind' res_ki -- Add more binders for data/newtype, so the result kind has no arrows -- See Note [Datatype return kinds] - ; if null resid_tcbs || not (needsEtaExpansion flav) - then return (invis_tcbs, sig_res_kind') + ; if null excess_sig_tcbs || not (needsEtaExpansion flav) + then return ([], sig_res_kind') else return (excess_sig_tcbs, sig_res_kind) } @@ -2641,6 +2634,22 @@ kcCheckDeclHeader_sig sig_kind name flav ] ; return tc } +-- | Check the result kind annotation on a type constructor against +-- the corresponding section of the standalone kind signature. +-- Drops invisible binders that interfere with unification. +check_exp_res_ki :: TcKind -- ^ the actual kind + -> TcKind -- ^ the expected kind + -> TcM () +check_exp_res_ki act_kind exp_kind + = discardResult $ unifyKind Nothing act_kind' exp_kind + where + (_, act_kind') = splitInvisPiTysN n_to_inst act_kind + + -- by analogy with checkExpectedKind + n_exp_invis_bndrs = invisibleTyBndrCount exp_kind + n_act_invis_bndrs = invisibleTyBndrCount act_kind + n_to_inst = n_act_invis_bndrs - n_exp_invis_bndrs + matchUpSigWithDecl :: Name -- Name of the type constructor for error messages -> [TcTyConBinder] -- TcTyConBinders (with skolem TcTyVars) from the separate kind signature @@ -2738,8 +2747,8 @@ swizzleTcb swizzle_env subst (Bndr tv vis) -- See Note [Source locations for implicitly bound type variables] -- in GHC.Tc.Rename.HsType -{- See Note [kcCheckDeclHeader_sig] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [kcCheckDeclHeader_sig] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Given a kind signature 'sig_kind' and a declaration header, kcCheckDeclHeader_sig verifies that the declaration conforms to the signature. The end result is a PolyTcTyCon 'tc' such that: @@ -2780,85 +2789,43 @@ Basic plan is this: part of the signature (k -> Type) with the kind signature of the decl, (j -> Type). This unification, done in kcCheckDeclHeader, needs TcTyVars. - * The tricky extra_arity part is described in - Note [Arity inference in kcCheckDeclHeader_sig] - -Note [Arity inference in kcCheckDeclHeader_sig] +Note [Arity of type families and type synonyms] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider these declarations: - type family S1 :: forall k2. k1 -> k2 -> Type - type family S2 (a :: k1) (b :: k2) :: Type - -Both S1 and S2 can be given the same standalone kind signature: - type S1 :: forall k1 k2. k1 -> k2 -> Type - type S2 :: forall k1 k2. k1 -> k2 -> Type - -And, indeed, tyConKind S1 == tyConKind S2. However, -tyConBinders and tyConResKind for S1 and S2 are different: - - tyConBinders S1 == [spec k1] - tyConResKind S1 == forall k2. k1 -> k2 -> Type - tyConKind S1 == forall k1 k2. k1 -> k2 -> Type - - tyConBinders S2 == [spec k1, spec k2, anon-vis (a :: k1), anon-vis (b :: k2)] - tyConResKind S2 == Type - tyConKind S1 == forall k1 k2. k1 -> k2 -> Type - -This difference determines the /arity/: - tyConArity tc == length (tyConBinders tc) -That is, the arity of S1 is 1, while the arity of S2 is 4. - -'kcCheckDeclHeader_sig' needs to infer the desired arity, to split the -standalone kind signature into binders and the result kind. It does so -in two rounds: - -1. matchUpSigWithDecl matches up - - the [TyConBinder] from (applying splitTyConKind to) the kind signature - - with the [LHsTyVarBndr] from the type declaration. - That may leave some excess TyConBinder: in the case of S2 there are - no excess TyConBinders, but in the case of S1 there are two (since - there are no LHsTYVarBndrs. - -2. Split off further TyConBinders (in the case of S1, one more) to - make it possible to unify the residual return kind with the - signature in the type declaration. More precisely, split off such - enough invisible that the remainder of the standalone kind - signature and the user-written result kind signature have the same - number of invisible quantifiers. - -As another example consider the following declarations: +Consider - type F :: Type -> forall j. j -> forall k1 k2. (k1, k2) -> Type - type family F a b + type F0 :: forall k. k -> k -> Type + type family F0 - type G :: Type -> forall j. j -> forall k1 k2. (k1, k2) -> Type - type family G a b :: forall r2. (r1, r2) -> Type + type F1 :: forall k. k -> k -> Type + type family F1 @k -For both F and G, the signature (after splitTyConKind) has - sig_tcbs :: [TyConBinder] - = [ anon-vis (@a_aBq), spec (@j_auA), anon-vis (@(b_aBr :: j_auA)) - , spec (@k1_auB), spec (@k2_auC) - , anon-vis (@(c_aBs :: (k1_auB, k2_auC)))] + type F2a :: forall k. k -> k -> Type + type family F2a @k a -matchUpSigWithDecl will consume the first three of these, passing on - excess_sig_tcbs - = [ spec (@k1_auB), spec (@k2_auC) - , anon-vis (@(c_aBs :: (k1_auB, k2_auC)))] + type F2b :: forall k. k -> k -> Type + type family F2b a -For F, there is no result kind signature in the declaration for F, so -we absorb all invisible binders into F's arity. The resulting arity of -F is 3+2=5. + type F3 :: forall k. k -> k -> Type + type family F3 a b -Now, in the case of G, we have a result kind sig 'forall r2. (r2,r2)->Type'. -This has one invisible binder, so we split of enough extra binders from -our excess_sig_tcbs to leave just one to match 'r2'. +All five have the same /kind/, but what /arity/ do they have? +For a type family, the arity is critical: +* A type family must always appear saturated (up to its arity) +* A type family can match only on `arity` arguments, not further ones +* The arity is recorded by `tyConArity`, and is equal to the number of + `TyConBinders` in the `TyCon`. +* In this context "arity" includes both kind and type arguments. - res_ki = forall r2. (r1, r2) -> Type - kisig = forall k1 k2. (k1, k2) -> Type - ^^^ - split off this one. +The arity is not determined by the kind signature (all five have the same signature). +Rather, it is determined by the declaration of the family: +* `F0` has arity 0. +* `F1` has arity 1. +* `F2a` has arity 2. +* `F2b` also has arity 2: the kind argument is invisible. +* `F3` has arity 3; again the kind argument is invisible. -The resulting arity of G is 3+1=4. +The matching-up of kind signature with the declaration itself is done by +`matchUpWithSigDecl`. Note [discardResult in kcCheckDeclHeader_sig] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2949,6 +2916,12 @@ data ContextKind = TheKind TcKind -- ^ a specific kind | AnyKind -- ^ any kind will do | OpenKind -- ^ something of the form @TYPE _@ +-- debug only +instance Outputable ContextKind where + ppr AnyKind = text "AnyKind" + ppr OpenKind = text "OpenKind" + ppr (TheKind k) = text "TheKind" <+> ppr k + ----------------------- newExpectedKind :: ContextKind -> TcM TcKind newExpectedKind (TheKind k) = return k ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -796,7 +796,7 @@ tcTExpTy m_ty exp_ty TcRnTHError $ TypedTHError $ TypedTHWithPolyType exp_ty ; codeCon <- tcLookupTyCon codeTyConName ; let rep = getRuntimeRep exp_ty - ; return (mkTyConApp codeCon [rep, m_ty, exp_ty]) } + ; return (mkTyConApp codeCon [m_ty, rep, exp_ty]) } quotationCtxtDoc :: LHsExpr GhcRn -> SDoc quotationCtxtDoc br_body ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -378,8 +378,13 @@ The splice will evaluate to (MkAge 3) and you can't add that to 4::Int. So you can't coerce a (Code Q Age) to a (Code Q Int). -} -- Code constructor - +#if __GLASGOW_HASKELL__ >= 907 +type Code :: (Kind.Type -> Kind.Type) -> forall r. TYPE r -> Kind.Type + -- The nested `forall` makes it possible to assign the arity of 0 to + -- type CodeQ = Code Q +#else type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type +#endif type role Code representational nominal -- See Note [Role of TExp] newtype Code m a = Code { examineCode :: m (TExp a) -- ^ Underlying monadic value ===================================== libraries/template-haskell/changelog.md ===================================== @@ -1,10 +1,15 @@ # Changelog for [`template-haskell` package](http://hackage.haskell.org/package/template-haskell) +## 2.22.0.0 + + * The kind of `Code` was changed from `forall r. (Type -> Type) -> TYPE r -> Type` + to `(Type -> Type) -> forall r. TYPE r -> Type`. This enables higher-kinded usage. + ## 2.21.0.0 * Record fields now belong to separate `NameSpace`s, keyed by the parent of the record field. This is the name of the first constructor of the parent type, - even if this constructor does not have the field in question. + even if this constructor does not have the field in question. This change enables TemplateHaskell support for `DuplicateRecordFields`. @@ -21,7 +26,7 @@ ## 2.20.0.0 - * The `Ppr.pprInfixT` function has gained a `Precedence` argument. + * The `Ppr.pprInfixT` function has gained a `Precedence` argument. * The values of named precedence levels like `Ppr.appPrec` have changed. * Add `TypeDataD` constructor to the `Dec` type for `type data` ===================================== testsuite/tests/perf/compiler/CoOpt_Singletons.hs ===================================== @@ -52,7 +52,7 @@ type SameKind :: k -> k -> Constraint type SameKind (a :: k) (b :: k) = (() :: Constraint) type Sing :: k -> Type -type family Sing :: k -> Type +type family Sing @k :: k -> Type type SLambda :: (k1 ~> k2) -> Type newtype SLambda (f :: k1 ~> k2) = @@ -386,7 +386,7 @@ type family (<>@#@$$$) (a6989586621679047054 :: a_a9GJ) (a6989586621679047055 :: class PSemigroup a_a9GJ where type family (<>) (arg_a9GX :: a_a9GJ) (arg_a9GY :: a_a9GJ) :: a_a9GJ type MemptySym0 :: forall a_a9GK. a_a9GK -type family MemptySym0 :: a_a9GK where +type family MemptySym0 @a_a9GK :: a_a9GK where MemptySym0 = Mempty type MappendSym0 :: forall a_a9GK. (~>) a_a9GK ((~>) a_a9GK a_a9GK) data MappendSym0 :: (~>) a_a9GK ((~>) a_a9GK a_a9GK) @@ -450,10 +450,10 @@ type family TFHelper_6989586621679047079Sym2 (a6989586621679047084 :: Dual a_a9G instance PSemigroup (Dual a_a9GL) where type (<>) a_a9Hn a_a9Ho = Apply (Apply TFHelper_6989586621679047079Sym0 a_a9Hn) a_a9Ho type Mempty_6989586621679047088 :: Dual a_a9GO -type family Mempty_6989586621679047088 :: Dual a_a9GO where +type family Mempty_6989586621679047088 @a_a9GO :: Dual a_a9GO where Mempty_6989586621679047088 = Apply DualSym0 MemptySym0 type Mempty_6989586621679047088Sym0 :: Dual a_a9GO -type family Mempty_6989586621679047088Sym0 :: Dual a_a9GO where +type family Mempty_6989586621679047088Sym0 @a_a9GO :: Dual a_a9GO where Mempty_6989586621679047088Sym0 = Mempty_6989586621679047088 instance PMonoid (Dual a_a9GO) where type Mempty = Mempty_6989586621679047088Sym0 @@ -549,10 +549,10 @@ type family TFHelper_6989586621679075091Sym2 (a6989586621679075096 :: Endo a_agC instance PSemigroup (Endo a_agCk) where type (<>) a_agZb a_agZc = Apply (Apply TFHelper_6989586621679075091Sym0 a_agZb) a_agZc type Mempty_6989586621679075313 :: Endo a_agCn -type family Mempty_6989586621679075313 :: Endo a_agCn where +type family Mempty_6989586621679075313 @a_agCn :: Endo a_agCn where Mempty_6989586621679075313 = Apply EndoSym0 IdSym0 type Mempty_6989586621679075313Sym0 :: Endo a_agCn -type family Mempty_6989586621679075313Sym0 :: Endo a_agCn where +type family Mempty_6989586621679075313Sym0 @a_agCn :: Endo a_agCn where Mempty_6989586621679075313Sym0 = Mempty_6989586621679075313 instance PMonoid (Endo a_agCn) where type Mempty = Mempty_6989586621679075313Sym0 ===================================== testsuite/tests/saks/should_compile/T16724.stdout ===================================== @@ -1,6 +1,6 @@ type T1 :: forall k (a :: k). Type -type family T1 @k @a +type family T1 -- Defined at T16724.hs:11:1 type T2 :: forall {k} (a :: k). Type -type family T2 @{k} @a +type family T2 -- Defined at T16724.hs:15:1 ===================================== testsuite/tests/saks/should_compile/saks020.hs ===================================== @@ -6,4 +6,4 @@ module SAKS_020 where import Data.Kind (Type) type T :: forall k. k -> forall j. j -> Type -data T (x :: hk) :: hj -> Type +data T (x :: hk) @hj :: hj -> Type ===================================== testsuite/tests/saks/should_compile/saks030.hs ===================================== @@ -10,7 +10,7 @@ import Data.Type.Equality type T1 :: forall k (a :: k). Bool type T2 :: k -> Bool -type family T1 where +type family T1 @k @a where T1 @Bool @True = False T1 @Bool @False = True ===================================== testsuite/tests/saks/should_compile/saks032.hs ===================================== @@ -18,4 +18,4 @@ type F1 :: Type -> forall j. j -> forall k1 k2. (k1, k2) -> Type type family F1 a b type F2 :: Type -> forall j. j -> forall k1 k2. (k1, k2) -> Type -type family F2 a b :: forall r2. (r1, r2) -> Type +type family F2 a b @r1 :: forall r2. (r1, r2) -> Type ===================================== testsuite/tests/th/CodeQ_HKD.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE TemplateHaskell #-} + +module CodeQ_HKD where +import GHC.Exts +import Data.Kind +import Language.Haskell.TH hiding (Type) + +data T (f :: forall r . (TYPE r) -> Type) = MkT (f Int) (f Int#) + + +tcodeq :: T CodeQ +tcodeq = MkT [||5||] [||5#||] ===================================== testsuite/tests/th/all.T ===================================== @@ -576,3 +576,4 @@ test('T21050', normal, compile_fail, ['']) test('T22559a', normal, compile_fail, ['']) test('T22559b', normal, compile_fail, ['']) test('T22559c', normal, compile_fail, ['']) +test('CodeQ_HKD', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_compile/T23514b.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies, DataKinds #-} +module T23514b where + +import GHC.Types + +type F :: Type -> forall k. Maybe k +type family F x @k where + F Int @Type = Just Bool + F Int = Just Either ===================================== testsuite/tests/typecheck/should_compile/T23514c.hs ===================================== @@ -0,0 +1,21 @@ +module T23514c where +import Data.Kind + + +type P1 :: forall k (a :: k) . k -> Type +data P1 :: k -> Type + +type P2 :: forall k (a :: k) . k -> Type +data P2 @k :: k -> Type + +type P3 :: forall k (a :: k) . k -> Type +data P3 @k @a :: k -> Type + +type P4 :: forall k (a :: k) . k -> Type +data P4 :: forall k (a :: k) . k -> Type + +type P5 :: forall k (a :: k) . k -> Type +data P5 :: forall a . k -> Type + +type P6 :: forall k (a :: k) . k -> Type +data P6 @k :: forall a . k -> Type ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -880,3 +880,5 @@ test('T22560b', normal, compile, ['']) test('T22560c', normal, compile, ['']) test('T22560d', extra_files(['T22560d.hs']), ghci_script, ['T22560d.script']) test('T22560e', normal, compile, ['']) +test('T23514b', normal, compile, ['']) +test('T23514c', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/T18640a.hs ===================================== @@ -8,4 +8,4 @@ module T18640a where import Data.Kind type F2 :: forall a b. Type -> a -type family F2 :: forall b. Type -> Type where +type family F2 @a :: forall b. Type -> Type where ===================================== testsuite/tests/typecheck/should_fail/T18640a.stderr ===================================== @@ -5,5 +5,5 @@ T18640a.hs:11:1: error: [GHC-25897] Actual: forall (b :: k). * -> a ‘a’ is a rigid type variable bound by the type family declaration for ‘F2’ - at T18640a.hs:10:19 + at T18640a.hs:11:17 • In the type family declaration for ‘F2’ ===================================== testsuite/tests/typecheck/should_fail/T18640c.hs ===================================== @@ -11,4 +11,4 @@ type F1 :: forall k -> Type type family F1 k :: Type type F2 :: forall x. forall k -> x -type F2 = F1 +type F2 k = F1 k ===================================== testsuite/tests/typecheck/should_fail/T18640c.stderr ===================================== @@ -1,10 +1,8 @@ -T18640c.hs:14:11: error: [GHC-25897] - • Couldn't match kind ‘x’ with ‘*’ - Expected kind ‘forall (k1 :: k) -> x’, - but ‘F1’ has kind ‘forall (k1 :: k) -> *’ +T18640c.hs:14:13: error: [GHC-25897] + • Expected kind ‘x’, but ‘F1 k’ has kind ‘*’ ‘x’ is a rigid type variable bound by the type synonym declaration for ‘F2’ at T18640c.hs:13:19 - • In the type ‘F1’ + • In the type ‘F1 k’ In the type declaration for ‘F2’ ===================================== testsuite/tests/typecheck/should_fail/T23514a.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies, DataKinds #-} +module T23514a where + +import GHC.Types + +type F :: Type -> forall k. Maybe k +type family F x where + F Int @Type = Just Bool + F Int = Just Either ===================================== testsuite/tests/typecheck/should_fail/T23514a.stderr ===================================== @@ -0,0 +1,6 @@ + +T23514a.hs:9:17: error: [GHC-83865] + • Expected kind ‘forall k. Maybe k’, + but ‘Just Either’ has kind ‘Maybe (* -> * -> *)’ + • In the type ‘Just Either’ + In the type family declaration for ‘F’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -690,3 +690,4 @@ test('T22560_fail_b', normal, compile_fail, ['']) test('T22560_fail_c', normal, compile_fail, ['']) test('T22560_fail_d', normal, compile_fail, ['']) test('T22560_fail_ext', normal, compile_fail, ['']) +test('T23514a', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7cfbb301a3d8cd2af5e5cc801ae5933ccd198bf4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7cfbb301a3d8cd2af5e5cc801ae5933ccd198bf4 You're receiving 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 Jun 16 09:52:22 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 16 Jun 2023 05:52:22 -0400 Subject: [Git][ghc/ghc][wip/forall-vis-coercions] 50 commits: Don't report redundant Givens from quantified constraints Message-ID: <648c30d661cfd_32a24e274dc701693e4@gitlab.mail> Simon Peyton Jones pushed to branch wip/forall-vis-coercions at Glasgow Haskell Compiler / GHC Commits: 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - f6d79ca6 by Matthew Craven at 2023-06-16T10:51:56+01:00 Equality of forall-types is visiblity aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [Forall coercions] in GHC.Core.TyCo.Rep - - - - - 30 changed files: - .gitlab-ci.yml - HACKING.md - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Rename.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0d88a768e89c6d89e2312ade3d348e8881325be2...f6d79ca63d6d465cc34dce03021b862a672c31fa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0d88a768e89c6d89e2312ade3d348e8881325be2...f6d79ca63d6d465cc34dce03021b862a672c31fa You're receiving 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 Jun 16 09:52:57 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 16 Jun 2023 05:52:57 -0400 Subject: [Git][ghc/ghc][master] Lint: more details on "Occurrence is GlobalId, but binding is LocalId" Message-ID: <648c30f9dadd_32a24e31c63c817348d@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - 1 changed file: - compiler/GHC/Core/Lint.hs Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -3243,7 +3243,7 @@ lookupIdInScope id_occ = do { in_scope_ids <- getInScopeIds ; case lookupVarEnv in_scope_ids id_occ of Just (id_bndr, linted_ty) - -> do { checkL (not (bad_global id_bndr)) global_in_scope + -> do { checkL (not (bad_global id_bndr)) $ global_in_scope id_bndr ; return (id_bndr, linted_ty) } Nothing -> do { checkL (not is_local) local_out_of_scope ; return (id_occ, idType id_occ) } } @@ -3252,8 +3252,10 @@ lookupIdInScope id_occ where is_local = mustHaveLocalBinding id_occ local_out_of_scope = text "Out of scope:" <+> pprBndr LetBind id_occ - global_in_scope = hang (text "Occurrence is GlobalId, but binding is LocalId") - 2 (pprBndr LetBind id_occ) + global_in_scope id_bndr = hang (text "Occurrence is GlobalId, but binding is LocalId") + 2 $ vcat [hang (text "occurrence:") 2 $ pprBndr LetBind id_occ + ,hang (text "binder :") 2 $ pprBndr LetBind id_bndr + ] bad_global id_bnd = isGlobalId id_occ && isLocalId id_bnd && not (isWiredIn id_occ) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/62c5641679b38ecf1978da890e084ef435255903 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/62c5641679b38ecf1978da890e084ef435255903 You're receiving 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 Jun 16 09:53:42 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 16 Jun 2023 05:53:42 -0400 Subject: [Git][ghc/ghc][master] Clean a stray bit of text in user guide Message-ID: <648c3126ec4be_32a24e274dc701786db@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 1 changed file: - docs/users_guide/exts/infix_tycons.rst Changes: ===================================== docs/users_guide/exts/infix_tycons.rst ===================================== @@ -41,7 +41,7 @@ specifically: infixl 7 T, :*: sets the fixity for both type constructor ``T`` and data constructor - ``T``, and similarly for ``:*:``. ``Int `a` Bool``. + ``T``, and similarly for ``:*:``. - The function arrow ``->`` is ``infixr`` with fixity -1. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d4c102387ee23c805fa07bb394df12dd0206fc94 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d4c102387ee23c805fa07bb394df12dd0206fc94 You're receiving 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 Jun 16 09:54:25 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 16 Jun 2023 05:54:25 -0400 Subject: [Git][ghc/ghc][master] testsuite: Add forall visibility test cases Message-ID: <648c3151dc6fb_32a24e10a30218182415@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - 13 changed files: - + 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/VisFlag4.hs - + testsuite/tests/typecheck/should_fail/VisFlag4.stderr - + testsuite/tests/typecheck/should_fail/VisFlag5.hs - + testsuite/tests/typecheck/should_fail/VisFlag5.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== 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,27 @@ + +VisFlag1.hs:12:16: error: [GHC-83865] + • Expecting one more argument to ‘V’ + Expected kind ‘forall j. j -> *’, + but ‘V’ has kind ‘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-18872] + • Couldn't match kind: forall k -> k -> * + with: forall j. j -> * + When matching types + hk0 :: forall j. j -> * + V :: forall k -> k -> * + 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/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-83865] + • Expecting one more argument to ‘V’ + Expected kind ‘forall j. j -> *’, + but ‘V’ has kind ‘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-83865] + • Expecting one more argument to ‘V’ + Expected kind ‘forall j. j -> *’, + but ‘V’ has kind ‘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,15 @@ + +VisFlag2.hs:13:21: error: [GHC-83865] + • Couldn't match kind: forall a. a + with: forall a -> a + Expected kind ‘* -> forall a -> a’, + but ‘Invis’ has kind ‘* -> forall a. a’ + • In the type ‘Invis’ + In the type instance declaration for ‘Vis’ + +VisFlag2.hs:14:23: error: [GHC-83865] + • Expecting one more argument to ‘Vis’ + Expected kind ‘* -> forall a. a’, + but ‘Vis’ has kind ‘* -> 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-83865] + • Expecting one more argument to ‘hk’ + Expected kind ‘forall k. k -> k’, + but ‘hk’ has kind ‘forall k -> k -> k’ + • In the associated type family declaration for ‘F’ ===================================== testsuite/tests/typecheck/should_fail/VisFlag4.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE StandaloneKindSignatures #-} + +module VisFlag4 where + +import Data.Kind + +type C :: (forall k -> k -> k) -> Constraint +class C (hk :: forall k. k -> k) where ===================================== testsuite/tests/typecheck/should_fail/VisFlag4.stderr ===================================== @@ -0,0 +1,5 @@ + +VisFlag4.hs:8:1: error: [GHC-83865] + • Expected kind ‘forall k -> k -> k’, + but ‘hk’ has kind ‘forall k. k -> k’ + • In the class declaration for ‘C’ ===================================== testsuite/tests/typecheck/should_fail/VisFlag5.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeFamilies #-} + +module VisFlag5 where + +import Data.Kind + +data family D a :: (forall i -> i -> i) -> Type +data instance D Int :: (forall i. i -> i) -> Type ===================================== testsuite/tests/typecheck/should_fail/VisFlag5.stderr ===================================== @@ -0,0 +1,7 @@ + +VisFlag5.hs:8:1: error: [GHC-83865] + • Couldn't match kind: forall i -> i -> i + with: forall i. i -> i + Expected kind ‘(forall i. i -> i) -> *’, + but ‘D Int’ has kind ‘(forall i -> i -> i) -> *’ + • In the data instance declaration for ‘D’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -690,3 +690,9 @@ test('T22560_fail_b', normal, compile_fail, ['']) test('T22560_fail_c', normal, compile_fail, ['']) test('T22560_fail_d', normal, compile_fail, ['']) test('T22560_fail_ext', normal, compile_fail, ['']) +test('VisFlag1', normal, compile_fail, ['']) +test('VisFlag1_ql', normal, compile_fail, ['']) +test('VisFlag2', normal, compile_fail, ['']) +test('VisFlag3', normal, compile_fail, ['']) +test('VisFlag4', normal, compile_fail, ['']) +test('VisFlag5', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/93647b5cdc94532bd436c0076de64412f305011a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/93647b5cdc94532bd436c0076de64412f305011a You're receiving 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 Jun 16 10:01:33 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 16 Jun 2023 06:01:33 -0400 Subject: [Git][ghc/ghc][wip/forall-vis-coercions] Equality of forall-types is visiblity aware Message-ID: <648c32fd3daf7_32a24e113a59ec18271@gitlab.mail> Simon Peyton Jones pushed to branch wip/forall-vis-coercions at Glasgow Haskell Compiler / GHC Commits: 407f6a8a by Matthew Craven at 2023-06-16T11:01:24+01:00 Equality of forall-types is visiblity aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [Forall coercions] in GHC.Core.TyCo.Rep - - - - - 30 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Iface/Rename.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Types/Var.hs - testsuite/tests/cpranal/should_compile/T18174.stderr - testsuite/tests/cpranal/should_compile/T18401.stderr - testsuite/tests/pmcheck/should_compile/T11195.hs - testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr - testsuite/tests/simplCore/should_compile/T8331.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/407f6a8af51741b4f4ab6de1d08e1fbefe39a94e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/407f6a8af51741b4f4ab6de1d08e1fbefe39a94e You're receiving 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 Jun 16 10:25:28 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 16 Jun 2023 06:25:28 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Lint: more details on "Occurrence is GlobalId, but binding is LocalId" Message-ID: <648c389859f8b_32a24e31c28541930d4@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - 7bdbfb92 by Sylvain Henry at 2023-06-16T06:25:17-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 1a55d908 by Krzysztof Gogolewski at 2023-06-16T06:25:17-04:00 Add tests for #21973 - - - - - 26 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/JS/Syntax.hs - compiler/GHC/JS/Unsat/Syntax.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/StgToJS/Types.hs - + compiler/GHC/Types/SaneDouble.hs - compiler/ghc.cabal.in - docs/users_guide/exts/infix_tycons.rst - + 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/VisFlag4.hs - + testsuite/tests/typecheck/should_fail/VisFlag4.stderr - + testsuite/tests/typecheck/should_fail/VisFlag5.hs - + testsuite/tests/typecheck/should_fail/VisFlag5.stderr - testsuite/tests/typecheck/should_fail/all.T - + testsuite/tests/typecheck/should_run/T21973a.hs - + testsuite/tests/typecheck/should_run/T21973a.stderr - + testsuite/tests/typecheck/should_run/T21973b.hs - + testsuite/tests/typecheck/should_run/T21973b.stdout - testsuite/tests/typecheck/should_run/all.T Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -3243,7 +3243,7 @@ lookupIdInScope id_occ = do { in_scope_ids <- getInScopeIds ; case lookupVarEnv in_scope_ids id_occ of Just (id_bndr, linted_ty) - -> do { checkL (not (bad_global id_bndr)) global_in_scope + -> do { checkL (not (bad_global id_bndr)) $ global_in_scope id_bndr ; return (id_bndr, linted_ty) } Nothing -> do { checkL (not is_local) local_out_of_scope ; return (id_occ, idType id_occ) } } @@ -3252,8 +3252,10 @@ lookupIdInScope id_occ where is_local = mustHaveLocalBinding id_occ local_out_of_scope = text "Out of scope:" <+> pprBndr LetBind id_occ - global_in_scope = hang (text "Occurrence is GlobalId, but binding is LocalId") - 2 (pprBndr LetBind id_occ) + global_in_scope id_bndr = hang (text "Occurrence is GlobalId, but binding is LocalId") + 2 $ vcat [hang (text "occurrence:") 2 $ pprBndr LetBind id_occ + ,hang (text "binder :") 2 $ pprBndr LetBind id_bndr + ] bad_global id_bnd = isGlobalId id_occ && isLocalId id_bnd && not (isWiredIn id_occ) ===================================== compiler/GHC/JS/Syntax.hs ===================================== @@ -94,6 +94,7 @@ import GHC.Prelude import GHC.JS.Unsat.Syntax (Ident(..)) import GHC.Data.FastString import GHC.Types.Unique.Map +import GHC.Types.SaneDouble import GHC.Utils.Misc import Control.DeepSeq @@ -333,25 +334,6 @@ data AOp instance NFData AOp --- | A newtype wrapper around 'Double' to ensure we never generate a 'Double' --- that becomes a 'NaN', see 'Eq SaneDouble', 'Ord SaneDouble' for details on --- Sane-ness -newtype SaneDouble = SaneDouble - { unSaneDouble :: Double - } - deriving (Data, Typeable, Fractional, Num, Generic, NFData) - -instance Eq SaneDouble where - (SaneDouble x) == (SaneDouble y) = x == y || (isNaN x && isNaN y) - -instance Ord SaneDouble where - compare (SaneDouble x) (SaneDouble y) = compare (fromNaN x) (fromNaN y) - where fromNaN z | isNaN z = Nothing - | otherwise = Just z - -instance Show SaneDouble where - show (SaneDouble x) = show x - -------------------------------------------------------------------------------- -- Helper Functions -------------------------------------------------------------------------------- ===================================== compiler/GHC/JS/Unsat/Syntax.hs ===================================== @@ -103,6 +103,7 @@ import GHC.Data.FastString import GHC.Utils.Monad.State.Strict import GHC.Types.Unique import GHC.Types.Unique.Map +import GHC.Types.SaneDouble -- | A supply of identifiers, possibly empty newtype IdentSupply a @@ -359,26 +360,6 @@ data JUOp instance NFData JUOp --- | A newtype wrapper around 'Double' to ensure we never generate a 'Double' --- that becomes a 'NaN', see 'Eq SaneDouble', 'Ord SaneDouble' for details on --- Sane-ness -newtype SaneDouble = SaneDouble - { unSaneDouble :: Double - } - deriving (Data, Typeable, Fractional, Num, Generic, NFData) - -instance Eq SaneDouble where - (SaneDouble x) == (SaneDouble y) = x == y || (isNaN x && isNaN y) - -instance Ord SaneDouble where - compare (SaneDouble x) (SaneDouble y) = compare (fromNaN x) (fromNaN y) - where fromNaN z | isNaN z = Nothing - | otherwise = Just z - -instance Show SaneDouble where - show (SaneDouble x) = show x - - -------------------------------------------------------------------------------- -- Identifiers -------------------------------------------------------------------------------- ===================================== compiler/GHC/StgToJS/Object.hs ===================================== @@ -86,7 +86,6 @@ import GHC.Unit.Module import GHC.Data.FastString import GHC.Types.Unique.Map -import GHC.Float (castDoubleToWord64, castWord64ToDouble) import GHC.Utils.Binary hiding (SymbolTable) import GHC.Utils.Outputable (ppr, Outputable, hcat, vcat, text, hsep) @@ -483,39 +482,6 @@ instance Binary Ident where put_ bh (TxtI xs) = put_ bh xs get bh = TxtI <$> get bh --- we need to preserve NaN and infinities, unfortunately the Binary instance for Double does not do this -instance Binary Sat.SaneDouble where - put_ bh (Sat.SaneDouble d) - | isNaN d = putByte bh 1 - | isInfinite d && d > 0 = putByte bh 2 - | isInfinite d && d < 0 = putByte bh 3 - | isNegativeZero d = putByte bh 4 - | otherwise = putByte bh 5 >> put_ bh (castDoubleToWord64 d) - get bh = getByte bh >>= \case - 1 -> pure $ Sat.SaneDouble (0 / 0) - 2 -> pure $ Sat.SaneDouble (1 / 0) - 3 -> pure $ Sat.SaneDouble ((-1) / 0) - 4 -> pure $ Sat.SaneDouble (-0) - 5 -> Sat.SaneDouble . castWord64ToDouble <$> get bh - n -> error ("Binary get bh SaneDouble: invalid tag: " ++ show n) - --- FIXME: remove after Unsat replaces JStat --- we need to preserve NaN and infinities, unfortunately the Binary instance for Double does not do this -instance Binary SaneDouble where - put_ bh (SaneDouble d) - | isNaN d = putByte bh 1 - | isInfinite d && d > 0 = putByte bh 2 - | isInfinite d && d < 0 = putByte bh 3 - | isNegativeZero d = putByte bh 4 - | otherwise = putByte bh 5 >> put_ bh (castDoubleToWord64 d) - get bh = getByte bh >>= \case - 1 -> pure $ SaneDouble (0 / 0) - 2 -> pure $ SaneDouble (1 / 0) - 3 -> pure $ SaneDouble ((-1) / 0) - 4 -> pure $ SaneDouble (-0) - 5 -> SaneDouble . castWord64ToDouble <$> get bh - n -> error ("Binary get bh SaneDouble: invalid tag: " ++ show n) - instance Binary ClosureInfo where put_ bh (ClosureInfo v regs name layo typ static) = do put_ bh v >> put_ bh regs >> put_ bh name >> put_ bh layo >> put_ bh typ >> put_ bh static ===================================== compiler/GHC/StgToJS/Types.hs ===================================== @@ -1,4 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} @@ -48,9 +47,6 @@ import qualified Data.Map as M import Data.Set (Set) import qualified Data.ByteString as BS import Data.Monoid -import Data.Typeable (Typeable) -import GHC.Generics (Generic) -import Control.DeepSeq -- | A State monad over IO holding the generator state. type G = StateT GenState IO @@ -107,7 +103,7 @@ data ClosureInfo = ClosureInfo , ciType :: CIType -- ^ type of the object, with extra info where required , ciStatic :: CIStatic -- ^ static references of this object } - deriving stock (Eq, Show, Generic) + deriving stock (Eq, Show) -- | Closure information, 'ClosureInfo', registers data CIRegs @@ -115,9 +111,7 @@ data CIRegs | CIRegs { ciRegsSkip :: Int -- ^ unused registers before actual args start , ciRegsTypes :: [VarType] -- ^ args } - deriving stock (Eq, Ord, Show, Generic) - -instance NFData CIRegs + deriving stock (Eq, Ord, Show) -- | Closure Information, 'ClosureInfo', layout data CILayout @@ -129,9 +123,7 @@ data CILayout { layoutSize :: !Int -- ^ closure size in array positions, including entry , layout :: [VarType] -- ^ The set of sized Types to layout } - deriving stock (Eq, Ord, Show, Generic) - -instance NFData CILayout + deriving stock (Eq, Ord, Show) -- | The type of 'ClosureInfo' data CIType @@ -143,13 +135,11 @@ data CIType | CIPap -- ^ The closure is a Partial Application | CIBlackhole -- ^ The closure is a black hole | CIStackFrame -- ^ The closure is a stack frame - deriving stock (Eq, Ord, Show, Generic) - -instance NFData CIType + deriving stock (Eq, Ord, Show) -- | Static references that must be kept alive newtype CIStatic = CIStaticRefs { staticRefs :: [FastString] } - deriving stock (Eq, Generic) + deriving stock (Eq) deriving newtype (Semigroup, Monoid, Show) -- | static refs: array = references, null = nothing to report @@ -169,9 +159,7 @@ data VarType | RtsObjV -- ^ some RTS object from GHCJS (for example TVar#, MVar#, MutVar#, Weak#) | ObjV -- ^ some JS object, user supplied, be careful around these, can be anything | ArrV -- ^ boxed array - deriving stock (Eq, Ord, Enum, Bounded, Show, Generic) - -instance NFData VarType + deriving stock (Eq, Ord, Enum, Bounded, Show) instance ToJExpr VarType where toJExpr = toJExpr . fromEnum @@ -231,7 +219,7 @@ data StaticInfo = StaticInfo { siVar :: !FastString -- ^ global object , siVal :: !StaticVal -- ^ static initialization , siCC :: !(Maybe Ident) -- ^ optional CCS name - } deriving stock (Eq, Show, Typeable, Generic) + } deriving stock (Eq, Show) data StaticVal = StaticFun !FastString [StaticArg] @@ -245,7 +233,7 @@ data StaticVal -- ^ regular datacon app | StaticList [StaticArg] (Maybe FastString) -- ^ list initializer (with optional tail) - deriving stock (Eq, Show, Generic) + deriving stock (Eq, Show) data StaticUnboxed = StaticUnboxedBool !Bool @@ -253,9 +241,7 @@ data StaticUnboxed | StaticUnboxedDouble !SaneDouble | StaticUnboxedString !BS.ByteString | StaticUnboxedStringOffset !BS.ByteString - deriving stock (Eq, Ord, Show, Generic) - -instance NFData StaticUnboxed + deriving stock (Eq, Ord, Show) -- | Static Arguments. Static Arguments are things that are statically -- allocated, i.e., they exist at program startup. These are static heap objects @@ -264,7 +250,7 @@ data StaticArg = StaticObjArg !FastString -- ^ reference to a heap object | StaticLitArg !StaticLit -- ^ literal | StaticConArg !FastString [StaticArg] -- ^ unfloated constructor - deriving stock (Eq, Show, Generic) + deriving stock (Eq, Show) instance Outputable StaticArg where ppr x = text (show x) @@ -278,7 +264,7 @@ data StaticLit | StringLit !FastString | BinLit !BS.ByteString | LabelLit !Bool !FastString -- ^ is function pointer, label (also used for string / binary init) - deriving (Eq, Show, Generic) + deriving (Eq, Show) instance Outputable StaticLit where ppr x = text (show x) @@ -300,7 +286,7 @@ data ForeignJSRef = ForeignJSRef , foreignRefCConv :: !CCallConv , foreignRefArgs :: ![FastString] , foreignRefResult :: !FastString - } deriving stock (Generic) + } -- | data used to generate one ObjUnit in our object file data LinkableUnit = LinkableUnit ===================================== compiler/GHC/Types/SaneDouble.hs ===================================== @@ -0,0 +1,48 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} + +-- | Double datatype with saner instances +module GHC.Types.SaneDouble + ( SaneDouble (..) + ) +where + +import GHC.Prelude +import GHC.Utils.Binary +import GHC.Float (castDoubleToWord64, castWord64ToDouble) + +-- | A newtype wrapper around 'Double' to ensure we never generate a 'Double' +-- that becomes a 'NaN', see instances for details on sanity. +newtype SaneDouble = SaneDouble + { unSaneDouble :: Double + } + deriving (Fractional, Num) + +instance Eq SaneDouble where + (SaneDouble x) == (SaneDouble y) = x == y || (isNaN x && isNaN y) + +instance Ord SaneDouble where + compare (SaneDouble x) (SaneDouble y) = compare (fromNaN x) (fromNaN y) + where fromNaN z | isNaN z = Nothing + | otherwise = Just z + +instance Show SaneDouble where + show (SaneDouble x) = show x + +-- we need to preserve NaN and infinities, unfortunately the Binary instance for +-- Double does not do this +instance Binary SaneDouble where + put_ bh (SaneDouble d) + | isNaN d = putByte bh 1 + | isInfinite d && d > 0 = putByte bh 2 + | isInfinite d && d < 0 = putByte bh 3 + | isNegativeZero d = putByte bh 4 + | otherwise = putByte bh 5 >> put_ bh (castDoubleToWord64 d) + get bh = getByte bh >>= \case + 1 -> pure $ SaneDouble (0 / 0) + 2 -> pure $ SaneDouble (1 / 0) + 3 -> pure $ SaneDouble ((-1) / 0) + 4 -> pure $ SaneDouble (-0) + 5 -> SaneDouble . castWord64ToDouble <$> get bh + n -> error ("Binary get bh SaneDouble: invalid tag: " ++ show n) + ===================================== compiler/ghc.cabal.in ===================================== @@ -811,6 +811,7 @@ Library GHC.Types.ProfAuto GHC.Types.RepType GHC.Types.SafeHaskell + GHC.Types.SaneDouble GHC.Types.SourceError GHC.Types.SourceFile GHC.Types.SourceText ===================================== docs/users_guide/exts/infix_tycons.rst ===================================== @@ -41,7 +41,7 @@ specifically: infixl 7 T, :*: sets the fixity for both type constructor ``T`` and data constructor - ``T``, and similarly for ``:*:``. ``Int `a` Bool``. + ``T``, and similarly for ``:*:``. - The function arrow ``->`` is ``infixr`` with fixity -1. ===================================== 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,27 @@ + +VisFlag1.hs:12:16: error: [GHC-83865] + • Expecting one more argument to ‘V’ + Expected kind ‘forall j. j -> *’, + but ‘V’ has kind ‘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-18872] + • Couldn't match kind: forall k -> k -> * + with: forall j. j -> * + When matching types + hk0 :: forall j. j -> * + V :: forall k -> k -> * + 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/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-83865] + • Expecting one more argument to ‘V’ + Expected kind ‘forall j. j -> *’, + but ‘V’ has kind ‘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-83865] + • Expecting one more argument to ‘V’ + Expected kind ‘forall j. j -> *’, + but ‘V’ has kind ‘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,15 @@ + +VisFlag2.hs:13:21: error: [GHC-83865] + • Couldn't match kind: forall a. a + with: forall a -> a + Expected kind ‘* -> forall a -> a’, + but ‘Invis’ has kind ‘* -> forall a. a’ + • In the type ‘Invis’ + In the type instance declaration for ‘Vis’ + +VisFlag2.hs:14:23: error: [GHC-83865] + • Expecting one more argument to ‘Vis’ + Expected kind ‘* -> forall a. a’, + but ‘Vis’ has kind ‘* -> 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-83865] + • Expecting one more argument to ‘hk’ + Expected kind ‘forall k. k -> k’, + but ‘hk’ has kind ‘forall k -> k -> k’ + • In the associated type family declaration for ‘F’ ===================================== testsuite/tests/typecheck/should_fail/VisFlag4.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE StandaloneKindSignatures #-} + +module VisFlag4 where + +import Data.Kind + +type C :: (forall k -> k -> k) -> Constraint +class C (hk :: forall k. k -> k) where ===================================== testsuite/tests/typecheck/should_fail/VisFlag4.stderr ===================================== @@ -0,0 +1,5 @@ + +VisFlag4.hs:8:1: error: [GHC-83865] + • Expected kind ‘forall k -> k -> k’, + but ‘hk’ has kind ‘forall k. k -> k’ + • In the class declaration for ‘C’ ===================================== testsuite/tests/typecheck/should_fail/VisFlag5.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeFamilies #-} + +module VisFlag5 where + +import Data.Kind + +data family D a :: (forall i -> i -> i) -> Type +data instance D Int :: (forall i. i -> i) -> Type ===================================== testsuite/tests/typecheck/should_fail/VisFlag5.stderr ===================================== @@ -0,0 +1,7 @@ + +VisFlag5.hs:8:1: error: [GHC-83865] + • Couldn't match kind: forall i -> i -> i + with: forall i. i -> i + Expected kind ‘(forall i. i -> i) -> *’, + but ‘D Int’ has kind ‘(forall i -> i -> i) -> *’ + • In the data instance declaration for ‘D’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -690,3 +690,9 @@ test('T22560_fail_b', normal, compile_fail, ['']) test('T22560_fail_c', normal, compile_fail, ['']) test('T22560_fail_d', normal, compile_fail, ['']) test('T22560_fail_ext', normal, compile_fail, ['']) +test('VisFlag1', normal, compile_fail, ['']) +test('VisFlag1_ql', normal, compile_fail, ['']) +test('VisFlag2', normal, compile_fail, ['']) +test('VisFlag3', normal, compile_fail, ['']) +test('VisFlag4', normal, compile_fail, ['']) +test('VisFlag5', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_run/T21973a.hs ===================================== @@ -0,0 +1,45 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE InstanceSigs #-} + +module Main (main) where + +import Data.Kind +import GHC.Exts + +class (Monoid (Share a), Eq (Share a)) => ClassDecode a where + type Share a :: Type + decoderWithShare :: Share a -> Decoder a + +class (Eq (Currency e), ClassDecode (Tx e)) => ClassLedger e where + type Currency e :: Type + type Tx e :: Type + +newtype Decoder a = Decoder (String -> a) + +{-# NOINLINE decode #-} +decode :: ClassDecode a => String -> a +decode str = + case decoderWithShare mempty of + Decoder f -> f str + +data MyLedger c + +newtype MyTx c = MyTx + { currency :: c + } deriving (Show, Read) + +instance (Eq c) => ClassLedger (MyLedger c) where + type Currency (MyLedger c) = c + type Tx (MyLedger c) = MyTx c + +instance (Eq [c], ClassLedger (MyLedger c)) => ClassDecode (MyTx c) where + type Share (MyTx c) = [c] + {-# NOINLINE decoderWithShare #-} + decoderWithShare :: [c] -> Decoder (MyTx c) + decoderWithShare (s :: [c]) = + Decoder $ \str -> error $ show (s == s) + +main :: IO () +main = print (noinline decode (noinline show (currency (MyTx "USD"))) :: MyTx String) ===================================== testsuite/tests/typecheck/should_run/T21973a.stderr ===================================== @@ -0,0 +1,3 @@ +T21973a: True +CallStack (from HasCallStack): + error, called at T21973a.hs:42:23 in main:Main ===================================== testsuite/tests/typecheck/should_run/T21973b.hs ===================================== @@ -0,0 +1,40 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE InstanceSigs #-} + +module Main (main) where + +import Data.Kind +import GHC.Exts + + +data D a = MkD + deriving Eq + +class Def a where + def :: a +instance Def (D a) where + def = MkD + +type family Share a where + Share Char = Char + + +class ( Share a ~ a, Def a ) => ClassDecode a where +instance ClassLedger c => ClassDecode (D c) where + +class (Eq e, ClassDecode (D e)) => ClassLedger e where +instance Eq c => ClassLedger c where + + +decoderWithShare2 :: ClassLedger a => a -> Bool +decoderWithShare2 d = d == d + + +decode :: forall a. (ClassLedger a, ClassDecode a) => Bool +decode = decoderWithShare2 @a (def @(Share a)) + +main :: IO () +main = print (decode @(D Char)) ===================================== testsuite/tests/typecheck/should_run/T21973b.stdout ===================================== @@ -0,0 +1 @@ +True ===================================== testsuite/tests/typecheck/should_run/all.T ===================================== @@ -167,3 +167,5 @@ test('T19397M4', extra_files(['T19397S.hs']), compile_and_run, ['-main-is foo']) test('T19667', normal, compile_and_run, ['-fhpc']) test('T20768', normal, compile_and_run, ['']) test('T22510', normal, compile_and_run, ['']) +test('T21973a', [exit_code(1)], compile_and_run, ['']) +test('T21973b', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/047b8d26e5b9039042ecc8fb0a21ea828a9cedc1...1a55d9087b8ca790f3da6f7be19b7023792377ed -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/047b8d26e5b9039042ecc8fb0a21ea828a9cedc1...1a55d9087b8ca790f3da6f7be19b7023792377ed You're receiving 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 Jun 16 11:28:35 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 16 Jun 2023 07:28:35 -0400 Subject: [Git][ghc/ghc][wip/forall-vis-coercions] 4 commits: Lint: more details on "Occurrence is GlobalId, but binding is LocalId" Message-ID: <648c4763aebb4_32a24e11d37794214230@gitlab.mail> Simon Peyton Jones pushed to branch wip/forall-vis-coercions at Glasgow Haskell Compiler / GHC Commits: 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - c6e55187 by Matthew Craven at 2023-06-16T12:28:25+01:00 Equality of forall-types is visiblity aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [Forall coercions] in GHC.Core.TyCo.Rep - - - - - 30 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Iface/Rename.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Types/Var.hs - docs/users_guide/exts/infix_tycons.rst - testsuite/tests/cpranal/should_compile/T18174.stderr - testsuite/tests/cpranal/should_compile/T18401.stderr - testsuite/tests/pmcheck/should_compile/T11195.hs - testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/407f6a8af51741b4f4ab6de1d08e1fbefe39a94e...c6e5518777b529924011e3dc58510b5fea78edc9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/407f6a8af51741b4f4ab6de1d08e1fbefe39a94e...c6e5518777b529924011e3dc58510b5fea78edc9 You're receiving 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 Jun 16 13:11:28 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Fri, 16 Jun 2023 09:11:28 -0400 Subject: [Git][ghc/ghc][wip/supersven/fix_trivColorable_aarch64] Fix number of free double regs Message-ID: <648c5f804f063_32a24e11d377942711f6@gitlab.mail> Sven Tennie pushed to branch wip/supersven/fix_trivColorable_aarch64 at Glasgow Haskell Compiler / GHC Commits: 3ea57b52 by Sven Tennie at 2023-06-16T13:10:58+00:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - 1 changed file: - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs Changes: ===================================== compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs ===================================== @@ -102,7 +102,8 @@ trivColorable -> Triv VirtualReg RegClass RealReg trivColorable platform virtualRegSqueeze realRegSqueeze RcInteger conflicts exclusions - | let cALLOCATABLE_REGS_INTEGER + | -- Allocatable are all regs of this class, where freeReg == True (MachRegs.h) + let cALLOCATABLE_REGS_INTEGER = (case platformArch platform of ArchX86 -> 3 ArchX86_64 -> 5 @@ -110,6 +111,9 @@ trivColorable platform virtualRegSqueeze realRegSqueeze RcInteger conflicts excl ArchPPC_64 _ -> 15 ArchARM _ _ _ -> panic "trivColorable ArchARM" -- N.B. x18 is reserved by the platform on AArch64/Darwin + -- 32 - Base - Sp - Hp - R1..R6 - SpLim - IP0 - SP - LR - FP - X18 + -- -> 32 - 15 = 17 + -- (one stack pointer for Haskell, one for C) ArchAArch64 -> 17 ArchAlpha -> panic "trivColorable ArchAlpha" ArchMipseb -> panic "trivColorable ArchMipseb" @@ -179,7 +183,7 @@ trivColorable platform virtualRegSqueeze realRegSqueeze RcDouble conflicts exclu ArchPPC -> 26 ArchPPC_64 _ -> 20 ArchARM _ _ _ -> panic "trivColorable ArchARM" - ArchAArch64 -> 32 + ArchAArch64 -> 28 -- 32 - D1..D4 ArchAlpha -> panic "trivColorable ArchAlpha" ArchMipseb -> panic "trivColorable ArchMipseb" ArchMipsel -> panic "trivColorable ArchMipsel" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3ea57b526c11b32fdee71525507b754b6a19f5df -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3ea57b526c11b32fdee71525507b754b6a19f5df You're receiving 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 Jun 16 13:16:17 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 16 Jun 2023 09:16:17 -0400 Subject: [Git][ghc/ghc][wip/rts-warnings] 2 commits: rts: Disable `#pragma GCC`s on clang compilers Message-ID: <648c60a13068_32a24e15081a3c2821b@gitlab.mail> Ben Gamari pushed to branch wip/rts-warnings at Glasgow Haskell Compiler / GHC Commits: ef642206 by Ben Gamari at 2023-06-16T09:13:39-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - b64092b9 by Ben Gamari at 2023-06-16T09:14:27-04:00 rts: Add prototypes in ZeroSlop.c These aren't called from C but nevertheless the compiler wants them. - - - - - 2 changed files: - rts/Hash.c - rts/ZeroSlop.c Changes: ===================================== rts/Hash.c ===================================== @@ -18,11 +18,13 @@ since we compile these things these days with cabal we can no longer specify optimization per file. So we have to resort to pragmas. */ #if defined(__GNUC__) || defined(__GNUG__) +#if !defined(__clang__) #if !defined(DEBUG) #pragma GCC push_options #pragma GCC optimize ("O3") #endif #endif +#endif #define XXH_NAMESPACE __rts_ #define XXH_STATIC_LINKING_ONLY /* access advanced declarations */ ===================================== rts/ZeroSlop.c ===================================== @@ -11,16 +11,22 @@ #include "Rts.h" +void stg_overwritingClosure (StgClosure *p); + void stg_overwritingClosure (StgClosure *p) { overwritingClosure(p); } +void stg_overwritingMutableClosureOfs (StgClosure *p, uint32_t offset); + void stg_overwritingMutableClosureOfs (StgClosure *p, uint32_t offset) { overwritingMutableClosureOfs(p, offset); } +void stg_overwritingClosureSize (StgClosure *p, uint32_t size); + void stg_overwritingClosureSize (StgClosure *p, uint32_t size /* in words */) { overwritingClosureSize(p, size); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2d7d091004618a46f236cdb5f2039ffc55ce2fb1...b64092b9318132b6409105d1011d835930a45173 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2d7d091004618a46f236cdb5f2039ffc55ce2fb1...b64092b9318132b6409105d1011d835930a45173 You're receiving 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 Jun 16 13:36:52 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 16 Jun 2023 09:36:52 -0400 Subject: [Git][ghc/ghc] Pushed new branch ghc-9.8 Message-ID: <648c6574773e6_32a24e113a59ec29828f@gitlab.mail> Ben Gamari pushed new branch ghc-9.8 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/ghc-9.8 You're receiving 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 Jun 16 13:39:46 2023 From: gitlab at gitlab.haskell.org (=?UTF-8?B?R2VyZ8WRIMOJcmRpIChAY2FjdHVzKQ==?=) Date: Fri, 16 Jun 2023 09:39:46 -0400 Subject: [Git][ghc/ghc][wip/issue-23516] 39 commits: Change WarningWithFlag to plural WarningWithFlags Message-ID: <648c66227c4c0_32a24e118dcb183017ae@gitlab.mail> Gergő Érdi pushed to branch wip/issue-23516 at Glasgow Haskell Compiler / GHC Commits: a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - 4c442a73 by Gergő Érdi at 2023-06-16T21:38:46+08:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/JS/Make.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Arg.hs - compiler/GHC/StgToJS/Closure.hs - compiler/GHC/StgToJS/CodeGen.hs - − compiler/GHC/StgToJS/CoreUtils.hs - compiler/GHC/StgToJS/DataCon.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/FFI.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8e14d2ab9cfae9eb5029f6b8c62ee604e738dfe8...4c442a73975227855ec9daf60a0371798b59cf29 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8e14d2ab9cfae9eb5029f6b8c62ee604e738dfe8...4c442a73975227855ec9daf60a0371798b59cf29 You're receiving 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 Jun 16 14:30:07 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Fri, 16 Jun 2023 10:30:07 -0400 Subject: [Git][ghc/ghc][wip/haddock-mem-fixes] Bump haddock submodule Message-ID: <648c71efc03cf_32a24e11d3779432343c@gitlab.mail> Finley McIlwaine pushed to branch wip/haddock-mem-fixes at Glasgow Haskell Compiler / GHC Commits: 6d5b5a3b by Finley McIlwaine at 2023-06-16T08:29:46-06:00 Bump haddock submodule - - - - - 1 changed file: - utils/haddock Changes: ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 30cf825972c53d97d6add9aa0e61bcb32ccc3ad1 +Subproject commit d4fc9502a0f176b5cad02ea2880aefde7001fa70 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6d5b5a3bc5fa329978180b9f69bd10afb7df98de -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6d5b5a3bc5fa329978180b9f69bd10afb7df98de You're receiving 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 Jun 16 15:55:53 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 16 Jun 2023 11:55:53 -0400 Subject: [Git][ghc/ghc][wip/forall-vis-coercions] Equality of forall-types is visiblity aware Message-ID: <648c8609313e_271466c5e4032732@gitlab.mail> Simon Peyton Jones pushed to branch wip/forall-vis-coercions at Glasgow Haskell Compiler / GHC Commits: fac25e6e by Matthew Craven at 2023-06-16T16:55:16+01:00 Equality of forall-types is visiblity aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [Forall coercions] in GHC.Core.TyCo.Rep - - - - - 30 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Iface/Rename.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Types/Var.hs - testsuite/tests/cpranal/should_compile/T18174.stderr - testsuite/tests/cpranal/should_compile/T18401.stderr - testsuite/tests/pmcheck/should_compile/T11195.hs - testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr - testsuite/tests/simplCore/should_compile/T8331.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fac25e6e703f02357b2cfa413aba4ab27ec0dfe1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fac25e6e703f02357b2cfa413aba4ab27ec0dfe1 You're receiving 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 Jun 16 16:00:19 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 16 Jun 2023 12:00:19 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ghc-9.8 Message-ID: <648c871314693_271466c5e543923b@gitlab.mail> Ben Gamari pushed new branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ghc-9.8 You're receiving 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 Jun 16 16:00:25 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 16 Jun 2023 12:00:25 -0400 Subject: [Git][ghc/ghc] Deleted branch ghc-9.8 Message-ID: <648c8719b26f6_271466c5e5439465@gitlab.mail> Ben Gamari deleted branch ghc-9.8 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 Fri Jun 16 16:04:28 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 16 Jun 2023 12:04:28 -0400 Subject: [Git][ghc/ghc][wip/haddock-mem-fixes] 54 commits: Don't report redundant Givens from quantified constraints Message-ID: <648c880c2eeec_271466c5df0450a2@gitlab.mail> Ben Gamari pushed to branch wip/haddock-mem-fixes at Glasgow Haskell Compiler / GHC Commits: 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - 68717db3 by Finley McIlwaine at 2023-06-16T11:53:33-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` - - - - - 22e25a96 by Finley McIlwaine at 2023-06-16T11:54:49-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 30 changed files: - .gitlab-ci.yml - HACKING.md - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/JS/Make.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Arg.hs - compiler/GHC/StgToJS/Closure.hs - compiler/GHC/StgToJS/CodeGen.hs - − compiler/GHC/StgToJS/CoreUtils.hs - compiler/GHC/StgToJS/DataCon.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6d5b5a3bc5fa329978180b9f69bd10afb7df98de...22e25a96fb0e4d918644f95ad0e82c9e685b4365 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6d5b5a3bc5fa329978180b9f69bd10afb7df98de...22e25a96fb0e4d918644f95ad0e82c9e685b4365 You're receiving 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 Jun 16 16:26:02 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 16 Jun 2023 12:26:02 -0400 Subject: [Git][ghc/ghc][master] JS: factorize SaneDouble into its own module Message-ID: <648c8d1a10dfb_271466d1c7845601a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 6 changed files: - compiler/GHC/JS/Syntax.hs - compiler/GHC/JS/Unsat/Syntax.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/StgToJS/Types.hs - + compiler/GHC/Types/SaneDouble.hs - compiler/ghc.cabal.in Changes: ===================================== compiler/GHC/JS/Syntax.hs ===================================== @@ -94,6 +94,7 @@ import GHC.Prelude import GHC.JS.Unsat.Syntax (Ident(..)) import GHC.Data.FastString import GHC.Types.Unique.Map +import GHC.Types.SaneDouble import GHC.Utils.Misc import Control.DeepSeq @@ -333,25 +334,6 @@ data AOp instance NFData AOp --- | A newtype wrapper around 'Double' to ensure we never generate a 'Double' --- that becomes a 'NaN', see 'Eq SaneDouble', 'Ord SaneDouble' for details on --- Sane-ness -newtype SaneDouble = SaneDouble - { unSaneDouble :: Double - } - deriving (Data, Typeable, Fractional, Num, Generic, NFData) - -instance Eq SaneDouble where - (SaneDouble x) == (SaneDouble y) = x == y || (isNaN x && isNaN y) - -instance Ord SaneDouble where - compare (SaneDouble x) (SaneDouble y) = compare (fromNaN x) (fromNaN y) - where fromNaN z | isNaN z = Nothing - | otherwise = Just z - -instance Show SaneDouble where - show (SaneDouble x) = show x - -------------------------------------------------------------------------------- -- Helper Functions -------------------------------------------------------------------------------- ===================================== compiler/GHC/JS/Unsat/Syntax.hs ===================================== @@ -103,6 +103,7 @@ import GHC.Data.FastString import GHC.Utils.Monad.State.Strict import GHC.Types.Unique import GHC.Types.Unique.Map +import GHC.Types.SaneDouble -- | A supply of identifiers, possibly empty newtype IdentSupply a @@ -359,26 +360,6 @@ data JUOp instance NFData JUOp --- | A newtype wrapper around 'Double' to ensure we never generate a 'Double' --- that becomes a 'NaN', see 'Eq SaneDouble', 'Ord SaneDouble' for details on --- Sane-ness -newtype SaneDouble = SaneDouble - { unSaneDouble :: Double - } - deriving (Data, Typeable, Fractional, Num, Generic, NFData) - -instance Eq SaneDouble where - (SaneDouble x) == (SaneDouble y) = x == y || (isNaN x && isNaN y) - -instance Ord SaneDouble where - compare (SaneDouble x) (SaneDouble y) = compare (fromNaN x) (fromNaN y) - where fromNaN z | isNaN z = Nothing - | otherwise = Just z - -instance Show SaneDouble where - show (SaneDouble x) = show x - - -------------------------------------------------------------------------------- -- Identifiers -------------------------------------------------------------------------------- ===================================== compiler/GHC/StgToJS/Object.hs ===================================== @@ -86,7 +86,6 @@ import GHC.Unit.Module import GHC.Data.FastString import GHC.Types.Unique.Map -import GHC.Float (castDoubleToWord64, castWord64ToDouble) import GHC.Utils.Binary hiding (SymbolTable) import GHC.Utils.Outputable (ppr, Outputable, hcat, vcat, text, hsep) @@ -483,39 +482,6 @@ instance Binary Ident where put_ bh (TxtI xs) = put_ bh xs get bh = TxtI <$> get bh --- we need to preserve NaN and infinities, unfortunately the Binary instance for Double does not do this -instance Binary Sat.SaneDouble where - put_ bh (Sat.SaneDouble d) - | isNaN d = putByte bh 1 - | isInfinite d && d > 0 = putByte bh 2 - | isInfinite d && d < 0 = putByte bh 3 - | isNegativeZero d = putByte bh 4 - | otherwise = putByte bh 5 >> put_ bh (castDoubleToWord64 d) - get bh = getByte bh >>= \case - 1 -> pure $ Sat.SaneDouble (0 / 0) - 2 -> pure $ Sat.SaneDouble (1 / 0) - 3 -> pure $ Sat.SaneDouble ((-1) / 0) - 4 -> pure $ Sat.SaneDouble (-0) - 5 -> Sat.SaneDouble . castWord64ToDouble <$> get bh - n -> error ("Binary get bh SaneDouble: invalid tag: " ++ show n) - --- FIXME: remove after Unsat replaces JStat --- we need to preserve NaN and infinities, unfortunately the Binary instance for Double does not do this -instance Binary SaneDouble where - put_ bh (SaneDouble d) - | isNaN d = putByte bh 1 - | isInfinite d && d > 0 = putByte bh 2 - | isInfinite d && d < 0 = putByte bh 3 - | isNegativeZero d = putByte bh 4 - | otherwise = putByte bh 5 >> put_ bh (castDoubleToWord64 d) - get bh = getByte bh >>= \case - 1 -> pure $ SaneDouble (0 / 0) - 2 -> pure $ SaneDouble (1 / 0) - 3 -> pure $ SaneDouble ((-1) / 0) - 4 -> pure $ SaneDouble (-0) - 5 -> SaneDouble . castWord64ToDouble <$> get bh - n -> error ("Binary get bh SaneDouble: invalid tag: " ++ show n) - instance Binary ClosureInfo where put_ bh (ClosureInfo v regs name layo typ static) = do put_ bh v >> put_ bh regs >> put_ bh name >> put_ bh layo >> put_ bh typ >> put_ bh static ===================================== compiler/GHC/StgToJS/Types.hs ===================================== @@ -1,4 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} @@ -48,9 +47,6 @@ import qualified Data.Map as M import Data.Set (Set) import qualified Data.ByteString as BS import Data.Monoid -import Data.Typeable (Typeable) -import GHC.Generics (Generic) -import Control.DeepSeq -- | A State monad over IO holding the generator state. type G = StateT GenState IO @@ -107,7 +103,7 @@ data ClosureInfo = ClosureInfo , ciType :: CIType -- ^ type of the object, with extra info where required , ciStatic :: CIStatic -- ^ static references of this object } - deriving stock (Eq, Show, Generic) + deriving stock (Eq, Show) -- | Closure information, 'ClosureInfo', registers data CIRegs @@ -115,9 +111,7 @@ data CIRegs | CIRegs { ciRegsSkip :: Int -- ^ unused registers before actual args start , ciRegsTypes :: [VarType] -- ^ args } - deriving stock (Eq, Ord, Show, Generic) - -instance NFData CIRegs + deriving stock (Eq, Ord, Show) -- | Closure Information, 'ClosureInfo', layout data CILayout @@ -129,9 +123,7 @@ data CILayout { layoutSize :: !Int -- ^ closure size in array positions, including entry , layout :: [VarType] -- ^ The set of sized Types to layout } - deriving stock (Eq, Ord, Show, Generic) - -instance NFData CILayout + deriving stock (Eq, Ord, Show) -- | The type of 'ClosureInfo' data CIType @@ -143,13 +135,11 @@ data CIType | CIPap -- ^ The closure is a Partial Application | CIBlackhole -- ^ The closure is a black hole | CIStackFrame -- ^ The closure is a stack frame - deriving stock (Eq, Ord, Show, Generic) - -instance NFData CIType + deriving stock (Eq, Ord, Show) -- | Static references that must be kept alive newtype CIStatic = CIStaticRefs { staticRefs :: [FastString] } - deriving stock (Eq, Generic) + deriving stock (Eq) deriving newtype (Semigroup, Monoid, Show) -- | static refs: array = references, null = nothing to report @@ -169,9 +159,7 @@ data VarType | RtsObjV -- ^ some RTS object from GHCJS (for example TVar#, MVar#, MutVar#, Weak#) | ObjV -- ^ some JS object, user supplied, be careful around these, can be anything | ArrV -- ^ boxed array - deriving stock (Eq, Ord, Enum, Bounded, Show, Generic) - -instance NFData VarType + deriving stock (Eq, Ord, Enum, Bounded, Show) instance ToJExpr VarType where toJExpr = toJExpr . fromEnum @@ -231,7 +219,7 @@ data StaticInfo = StaticInfo { siVar :: !FastString -- ^ global object , siVal :: !StaticVal -- ^ static initialization , siCC :: !(Maybe Ident) -- ^ optional CCS name - } deriving stock (Eq, Show, Typeable, Generic) + } deriving stock (Eq, Show) data StaticVal = StaticFun !FastString [StaticArg] @@ -245,7 +233,7 @@ data StaticVal -- ^ regular datacon app | StaticList [StaticArg] (Maybe FastString) -- ^ list initializer (with optional tail) - deriving stock (Eq, Show, Generic) + deriving stock (Eq, Show) data StaticUnboxed = StaticUnboxedBool !Bool @@ -253,9 +241,7 @@ data StaticUnboxed | StaticUnboxedDouble !SaneDouble | StaticUnboxedString !BS.ByteString | StaticUnboxedStringOffset !BS.ByteString - deriving stock (Eq, Ord, Show, Generic) - -instance NFData StaticUnboxed + deriving stock (Eq, Ord, Show) -- | Static Arguments. Static Arguments are things that are statically -- allocated, i.e., they exist at program startup. These are static heap objects @@ -264,7 +250,7 @@ data StaticArg = StaticObjArg !FastString -- ^ reference to a heap object | StaticLitArg !StaticLit -- ^ literal | StaticConArg !FastString [StaticArg] -- ^ unfloated constructor - deriving stock (Eq, Show, Generic) + deriving stock (Eq, Show) instance Outputable StaticArg where ppr x = text (show x) @@ -278,7 +264,7 @@ data StaticLit | StringLit !FastString | BinLit !BS.ByteString | LabelLit !Bool !FastString -- ^ is function pointer, label (also used for string / binary init) - deriving (Eq, Show, Generic) + deriving (Eq, Show) instance Outputable StaticLit where ppr x = text (show x) @@ -300,7 +286,7 @@ data ForeignJSRef = ForeignJSRef , foreignRefCConv :: !CCallConv , foreignRefArgs :: ![FastString] , foreignRefResult :: !FastString - } deriving stock (Generic) + } -- | data used to generate one ObjUnit in our object file data LinkableUnit = LinkableUnit ===================================== compiler/GHC/Types/SaneDouble.hs ===================================== @@ -0,0 +1,48 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} + +-- | Double datatype with saner instances +module GHC.Types.SaneDouble + ( SaneDouble (..) + ) +where + +import GHC.Prelude +import GHC.Utils.Binary +import GHC.Float (castDoubleToWord64, castWord64ToDouble) + +-- | A newtype wrapper around 'Double' to ensure we never generate a 'Double' +-- that becomes a 'NaN', see instances for details on sanity. +newtype SaneDouble = SaneDouble + { unSaneDouble :: Double + } + deriving (Fractional, Num) + +instance Eq SaneDouble where + (SaneDouble x) == (SaneDouble y) = x == y || (isNaN x && isNaN y) + +instance Ord SaneDouble where + compare (SaneDouble x) (SaneDouble y) = compare (fromNaN x) (fromNaN y) + where fromNaN z | isNaN z = Nothing + | otherwise = Just z + +instance Show SaneDouble where + show (SaneDouble x) = show x + +-- we need to preserve NaN and infinities, unfortunately the Binary instance for +-- Double does not do this +instance Binary SaneDouble where + put_ bh (SaneDouble d) + | isNaN d = putByte bh 1 + | isInfinite d && d > 0 = putByte bh 2 + | isInfinite d && d < 0 = putByte bh 3 + | isNegativeZero d = putByte bh 4 + | otherwise = putByte bh 5 >> put_ bh (castDoubleToWord64 d) + get bh = getByte bh >>= \case + 1 -> pure $ SaneDouble (0 / 0) + 2 -> pure $ SaneDouble (1 / 0) + 3 -> pure $ SaneDouble ((-1) / 0) + 4 -> pure $ SaneDouble (-0) + 5 -> SaneDouble . castWord64ToDouble <$> get bh + n -> error ("Binary get bh SaneDouble: invalid tag: " ++ show n) + ===================================== compiler/ghc.cabal.in ===================================== @@ -811,6 +811,7 @@ Library GHC.Types.ProfAuto GHC.Types.RepType GHC.Types.SafeHaskell + GHC.Types.SaneDouble GHC.Types.SourceError GHC.Types.SourceFile GHC.Types.SourceText View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a5f0c00ee19186d245bd0a55f1432811701a1bd7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a5f0c00ee19186d245bd0a55f1432811701a1bd7 You're receiving 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 Jun 16 16:26:38 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 16 Jun 2023 12:26:38 -0400 Subject: [Git][ghc/ghc][master] Add tests for #21973 Message-ID: <648c8d3e5b7e5_2714662598f88595e1@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 5 changed files: - + testsuite/tests/typecheck/should_run/T21973a.hs - + testsuite/tests/typecheck/should_run/T21973a.stderr - + testsuite/tests/typecheck/should_run/T21973b.hs - + testsuite/tests/typecheck/should_run/T21973b.stdout - testsuite/tests/typecheck/should_run/all.T Changes: ===================================== testsuite/tests/typecheck/should_run/T21973a.hs ===================================== @@ -0,0 +1,45 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE InstanceSigs #-} + +module Main (main) where + +import Data.Kind +import GHC.Exts + +class (Monoid (Share a), Eq (Share a)) => ClassDecode a where + type Share a :: Type + decoderWithShare :: Share a -> Decoder a + +class (Eq (Currency e), ClassDecode (Tx e)) => ClassLedger e where + type Currency e :: Type + type Tx e :: Type + +newtype Decoder a = Decoder (String -> a) + +{-# NOINLINE decode #-} +decode :: ClassDecode a => String -> a +decode str = + case decoderWithShare mempty of + Decoder f -> f str + +data MyLedger c + +newtype MyTx c = MyTx + { currency :: c + } deriving (Show, Read) + +instance (Eq c) => ClassLedger (MyLedger c) where + type Currency (MyLedger c) = c + type Tx (MyLedger c) = MyTx c + +instance (Eq [c], ClassLedger (MyLedger c)) => ClassDecode (MyTx c) where + type Share (MyTx c) = [c] + {-# NOINLINE decoderWithShare #-} + decoderWithShare :: [c] -> Decoder (MyTx c) + decoderWithShare (s :: [c]) = + Decoder $ \str -> error $ show (s == s) + +main :: IO () +main = print (noinline decode (noinline show (currency (MyTx "USD"))) :: MyTx String) ===================================== testsuite/tests/typecheck/should_run/T21973a.stderr ===================================== @@ -0,0 +1,3 @@ +T21973a: True +CallStack (from HasCallStack): + error, called at T21973a.hs:42:23 in main:Main ===================================== testsuite/tests/typecheck/should_run/T21973b.hs ===================================== @@ -0,0 +1,40 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE InstanceSigs #-} + +module Main (main) where + +import Data.Kind +import GHC.Exts + + +data D a = MkD + deriving Eq + +class Def a where + def :: a +instance Def (D a) where + def = MkD + +type family Share a where + Share Char = Char + + +class ( Share a ~ a, Def a ) => ClassDecode a where +instance ClassLedger c => ClassDecode (D c) where + +class (Eq e, ClassDecode (D e)) => ClassLedger e where +instance Eq c => ClassLedger c where + + +decoderWithShare2 :: ClassLedger a => a -> Bool +decoderWithShare2 d = d == d + + +decode :: forall a. (ClassLedger a, ClassDecode a) => Bool +decode = decoderWithShare2 @a (def @(Share a)) + +main :: IO () +main = print (decode @(D Char)) ===================================== testsuite/tests/typecheck/should_run/T21973b.stdout ===================================== @@ -0,0 +1 @@ +True ===================================== testsuite/tests/typecheck/should_run/all.T ===================================== @@ -167,3 +167,5 @@ test('T19397M4', extra_files(['T19397S.hs']), compile_and_run, ['-main-is foo']) test('T19667', normal, compile_and_run, ['-fhpc']) test('T20768', normal, compile_and_run, ['']) test('T22510', normal, compile_and_run, ['']) +test('T21973a', [exit_code(1)], compile_and_run, ['']) +test('T21973b', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0baf9e7cfa5d0e76998c2a528693736a6317cf4c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0baf9e7cfa5d0e76998c2a528693736a6317cf4c You're receiving 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 Jun 16 16:57:49 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 16 Jun 2023 12:57:49 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: JS: factorize SaneDouble into its own module Message-ID: <648c948db9796_27146634fe0a464342@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 9650e992 by Diego Diverio at 2023-06-16T12:57:36-04:00 Update documentation for `<**>` - - - - - c5a91ad4 by Diego Diverio at 2023-06-16T12:57:36-04:00 Update text - - - - - c7a95700 by Diego Diverio at 2023-06-16T12:57:36-04:00 Update examples - - - - - b14a557b by Diego Diverio at 2023-06-16T12:57:36-04:00 Update documentation to actually display code correctly - - - - - 68bff0a9 by Andrei Borzenkov at 2023-06-16T12:57:37-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 27 changed files: - compiler/GHC/JS/Syntax.hs - compiler/GHC/JS/Unsat/Syntax.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/StgToJS/Types.hs - + compiler/GHC/Types/SaneDouble.hs - compiler/ghc.cabal.in - docs/users_guide/9.8.1-notes.rst - libraries/base/GHC/Base.hs - testsuite/tests/indexed-types/should_compile/T14131.hs - testsuite/tests/indexed-types/should_compile/T15852.hs - testsuite/tests/indexed-types/should_compile/T15852.stderr - testsuite/tests/indexed-types/should_fail/T14230.hs - testsuite/tests/indexed-types/should_fail/T7938.hs - testsuite/tests/indexed-types/should_fail/T7938.stderr - + testsuite/tests/rename/should_compile/T23512b.hs - testsuite/tests/rename/should_compile/all.T - + testsuite/tests/rename/should_fail/T23512a.hs - + testsuite/tests/rename/should_fail/T23512a.stderr - testsuite/tests/rename/should_fail/all.T - testsuite/tests/typecheck/should_fail/T15797.hs - + testsuite/tests/typecheck/should_run/T21973a.hs - + testsuite/tests/typecheck/should_run/T21973a.stderr - + testsuite/tests/typecheck/should_run/T21973b.hs - + testsuite/tests/typecheck/should_run/T21973b.stdout - testsuite/tests/typecheck/should_run/all.T Changes: ===================================== compiler/GHC/JS/Syntax.hs ===================================== @@ -94,6 +94,7 @@ import GHC.Prelude import GHC.JS.Unsat.Syntax (Ident(..)) import GHC.Data.FastString import GHC.Types.Unique.Map +import GHC.Types.SaneDouble import GHC.Utils.Misc import Control.DeepSeq @@ -333,25 +334,6 @@ data AOp instance NFData AOp --- | A newtype wrapper around 'Double' to ensure we never generate a 'Double' --- that becomes a 'NaN', see 'Eq SaneDouble', 'Ord SaneDouble' for details on --- Sane-ness -newtype SaneDouble = SaneDouble - { unSaneDouble :: Double - } - deriving (Data, Typeable, Fractional, Num, Generic, NFData) - -instance Eq SaneDouble where - (SaneDouble x) == (SaneDouble y) = x == y || (isNaN x && isNaN y) - -instance Ord SaneDouble where - compare (SaneDouble x) (SaneDouble y) = compare (fromNaN x) (fromNaN y) - where fromNaN z | isNaN z = Nothing - | otherwise = Just z - -instance Show SaneDouble where - show (SaneDouble x) = show x - -------------------------------------------------------------------------------- -- Helper Functions -------------------------------------------------------------------------------- ===================================== compiler/GHC/JS/Unsat/Syntax.hs ===================================== @@ -103,6 +103,7 @@ import GHC.Data.FastString import GHC.Utils.Monad.State.Strict import GHC.Types.Unique import GHC.Types.Unique.Map +import GHC.Types.SaneDouble -- | A supply of identifiers, possibly empty newtype IdentSupply a @@ -359,26 +360,6 @@ data JUOp instance NFData JUOp --- | A newtype wrapper around 'Double' to ensure we never generate a 'Double' --- that becomes a 'NaN', see 'Eq SaneDouble', 'Ord SaneDouble' for details on --- Sane-ness -newtype SaneDouble = SaneDouble - { unSaneDouble :: Double - } - deriving (Data, Typeable, Fractional, Num, Generic, NFData) - -instance Eq SaneDouble where - (SaneDouble x) == (SaneDouble y) = x == y || (isNaN x && isNaN y) - -instance Ord SaneDouble where - compare (SaneDouble x) (SaneDouble y) = compare (fromNaN x) (fromNaN y) - where fromNaN z | isNaN z = Nothing - | otherwise = Just z - -instance Show SaneDouble where - show (SaneDouble x) = show x - - -------------------------------------------------------------------------------- -- Identifiers -------------------------------------------------------------------------------- ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -1799,8 +1799,7 @@ one exists: a free variable 'a', which we implicitly quantify over. That is why we can also use it to the left of the double colon: 'Left a -The logic resides in extractHsTyRdrTyVarsKindVars. We use it both for type -synonyms and type family instances. +The logic resides in extractHsTyRdrTyVarsKindVars. This was a stopgap solution until we could explicitly bind invisible type/kind variables: ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -634,14 +634,10 @@ rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds rnFamEqn :: HsDocContext -> AssocTyFamInfo - -> FreeKiTyVars - -- ^ Additional kind variables to implicitly bind if there is no - -- explicit forall. (See the comments on @all_imp_vars@ below for a - -- more detailed explanation.) -> FamEqn GhcPs rhs -> (HsDocContext -> rhs -> RnM (rhs', FreeVars)) -> RnM (FamEqn GhcRn rhs', FreeVars) -rnFamEqn doc atfi extra_kvars +rnFamEqn doc atfi (FamEqn { feqn_tycon = tycon , feqn_bndrs = outer_bndrs , feqn_pats = pats @@ -652,19 +648,8 @@ rnFamEqn doc atfi extra_kvars -- all_imp_vars represent the implicitly bound type variables. This is -- empty if we have an explicit `forall` (see -- Note [forall-or-nothing rule] in GHC.Hs.Type), which means - -- ignoring: - -- - -- - pat_kity_vars, the free variables mentioned in the type patterns - -- on the LHS of the equation, and - -- - extra_kvars, which is one of the following: - -- * For type family instances, extra_kvars are the free kind - -- variables mentioned in an outermost kind signature on the RHS - -- of the equation. - -- (See Note [Implicit quantification in type synonyms] in - -- GHC.Rename.HsType.) - -- * For data family instances, extra_kvars are the free kind - -- variables mentioned in the explicit return kind, if one is - -- provided. (e.g., the `k` in `data instance T :: k -> Type`). + -- ignoring pat_kity_vars, the free variables mentioned in the type patterns + -- on the LHS of the equation -- -- Some examples: -- @@ -678,8 +663,6 @@ rnFamEqn doc atfi extra_kvars -- type family G :: Maybe a -- type instance forall a. G = (Nothing :: Maybe a) -- -- all_imp_vars = [] - -- type instance G = (Nothing :: Maybe a) - -- -- all_imp_vars = [a] -- -- data family H :: k -> Type -- data instance forall k. H :: k -> Type where ... @@ -690,7 +673,7 @@ rnFamEqn doc atfi extra_kvars -- -- For associated type family instances, exclude the type variables -- bound by the instance head with filterInScopeM (#19649). - ; all_imp_vars <- filterInScopeM $ pat_kity_vars ++ extra_kvars + ; all_imp_vars <- filterInScopeM $ pat_kity_vars ; bindHsOuterTyVarBndrs doc mb_cls all_imp_vars outer_bndrs $ \rn_outer_bndrs -> do { (pats', pat_fvs) <- rnLHsTypeArgs (FamPatCtx tycon) pats @@ -727,21 +710,12 @@ rnFamEqn doc atfi extra_kvars -- associated family instance but not bound on the LHS, then reject -- that type variable as being out of scope. -- See Note [Renaming associated types]. - -- Per that Note, the LHS type variables consist of: - -- - -- - The variables mentioned in the instance's type patterns - -- (pat_fvs), and - -- - -- - The variables mentioned in an outermost kind signature on the - -- RHS. This is a subset of `rhs_fvs`. To compute it, we look up - -- each RdrName in `extra_kvars` to find its corresponding Name in - -- the LocalRdrEnv. - ; extra_kvar_nms <- mapMaybeM (lookupLocalOccRn_maybe . unLoc) extra_kvars - ; let lhs_bound_vars = pat_fvs `extendNameSetList` extra_kvar_nms - improperly_scoped cls_tkv = + -- Per that Note, the LHS type variables consist of the variables + -- mentioned in the instance's type patterns (pat_fvs) + ; let improperly_scoped cls_tkv = cls_tkv `elemNameSet` rhs_fvs -- Mentioned on the RHS... - && not (cls_tkv `elemNameSet` lhs_bound_vars) + && not (cls_tkv `elemNameSet` pat_fvs) -- ...but not bound on the LHS. bad_tvs = filter improperly_scoped inst_head_tvs ; unless (null bad_tvs) (addErr (TcRnBadAssocRhs bad_tvs)) @@ -786,7 +760,7 @@ rnFamEqn doc atfi extra_kvars -- -- type instance F a b c = Either a b -- ^^^^^ - lhs_loc = case map lhsTypeArgSrcSpan pats ++ map getLocA extra_kvars of + lhs_loc = case map lhsTypeArgSrcSpan pats of [] -> panic "rnFamEqn.lhs_loc" [loc] -> loc (loc:locs) -> loc `combineSrcSpans` last locs @@ -845,10 +819,9 @@ data ClosedTyFamInfo rnTyFamInstEqn :: AssocTyFamInfo -> TyFamInstEqn GhcPs -> RnM (TyFamInstEqn GhcRn, FreeVars) -rnTyFamInstEqn atfi eqn@(FamEqn { feqn_tycon = tycon, feqn_rhs = rhs }) - = rnFamEqn (TySynCtx tycon) atfi extra_kvs eqn rnTySyn - where - extra_kvs = extractHsTyRdrTyVarsKindVars rhs +rnTyFamInstEqn atfi eqn@(FamEqn { feqn_tycon = tycon }) + = rnFamEqn (TySynCtx tycon) atfi eqn rnTySyn + rnTyFamDefltDecl :: Name -> TyFamDefltDecl GhcPs @@ -859,11 +832,9 @@ rnDataFamInstDecl :: AssocTyFamInfo -> DataFamInstDecl GhcPs -> RnM (DataFamInstDecl GhcRn, FreeVars) rnDataFamInstDecl atfi (DataFamInstDecl { dfid_eqn = - eqn@(FamEqn { feqn_tycon = tycon - , feqn_rhs = rhs })}) - = do { let extra_kvs = extractDataDefnKindVars rhs - ; (eqn', fvs) <- - rnFamEqn (TyDataCtx tycon) atfi extra_kvs eqn rnDataDefn + eqn@(FamEqn { feqn_tycon = tycon })}) + = do { (eqn', fvs) <- + rnFamEqn (TyDataCtx tycon) atfi eqn rnDataDefn ; return (DataFamInstDecl { dfid_eqn = eqn' }, fvs) } -- Renaming of the associated types in instances. @@ -949,10 +920,7 @@ a class, we must check that all of the type variables mentioned on the RHS are properly scoped. Specifically, the rule is this: Every variable mentioned on the RHS of a type instance declaration - (whether associated or not) must be either - * Mentioned on the LHS, or - * Mentioned in an outermost kind signature on the RHS - (see Note [Implicit quantification in type synonyms]) + (whether associated or not) must be mentioned on the LHS Here is a simple example of something we should reject: @@ -962,8 +930,7 @@ Here is a simple example of something we should reject: type F Int x = z Here, `z` is mentioned on the RHS of the associated instance without being -mentioned on the LHS, nor is `z` mentioned in an outermost kind signature. The -renamer will reject `z` as being out of scope without much fuss. +mentioned on the LHS. The renamer will reject `z` as being out of scope without much fuss. Things get slightly trickier when the instance header itself binds type variables. Consider this example (adapted from #5515): @@ -1055,10 +1022,8 @@ Some additional wrinkles: Note that the `o` in the `Codomain 'KProxy` instance should be considered improperly scoped. It does not meet the criteria for being explicitly - quantified, as it is not mentioned by name on the LHS, nor does it meet the - criteria for being implicitly quantified, as it is used in a RHS kind - signature that is not outermost (see Note [Implicit quantification in type - synonyms]). However, `o` /is/ bound by the instance header, so if this + quantified, as it is not mentioned by name on the LHS. + However, `o` /is/ bound by the instance header, so if this program is not rejected by the renamer, the typechecker would treat it as though you had written this: @@ -1070,6 +1035,12 @@ Some additional wrinkles: If the user really wants the latter, it is simple enough to communicate their intent by mentioning `o` on the LHS by name. +* Historical note: Previously we had to add type variables from the outermost + kind signature on the RHS to the scope of associated type family instance, + i.e. GHC did implicit quantification over them. But now that we implement + GHC Proposal #425 "Invisible binders in type declarations" + we don't need to do this anymore. + Note [Type family equations and occurrences] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In most data/type family equations, the type family name used in the equation ===================================== compiler/GHC/StgToJS/Object.hs ===================================== @@ -86,7 +86,6 @@ import GHC.Unit.Module import GHC.Data.FastString import GHC.Types.Unique.Map -import GHC.Float (castDoubleToWord64, castWord64ToDouble) import GHC.Utils.Binary hiding (SymbolTable) import GHC.Utils.Outputable (ppr, Outputable, hcat, vcat, text, hsep) @@ -483,39 +482,6 @@ instance Binary Ident where put_ bh (TxtI xs) = put_ bh xs get bh = TxtI <$> get bh --- we need to preserve NaN and infinities, unfortunately the Binary instance for Double does not do this -instance Binary Sat.SaneDouble where - put_ bh (Sat.SaneDouble d) - | isNaN d = putByte bh 1 - | isInfinite d && d > 0 = putByte bh 2 - | isInfinite d && d < 0 = putByte bh 3 - | isNegativeZero d = putByte bh 4 - | otherwise = putByte bh 5 >> put_ bh (castDoubleToWord64 d) - get bh = getByte bh >>= \case - 1 -> pure $ Sat.SaneDouble (0 / 0) - 2 -> pure $ Sat.SaneDouble (1 / 0) - 3 -> pure $ Sat.SaneDouble ((-1) / 0) - 4 -> pure $ Sat.SaneDouble (-0) - 5 -> Sat.SaneDouble . castWord64ToDouble <$> get bh - n -> error ("Binary get bh SaneDouble: invalid tag: " ++ show n) - --- FIXME: remove after Unsat replaces JStat --- we need to preserve NaN and infinities, unfortunately the Binary instance for Double does not do this -instance Binary SaneDouble where - put_ bh (SaneDouble d) - | isNaN d = putByte bh 1 - | isInfinite d && d > 0 = putByte bh 2 - | isInfinite d && d < 0 = putByte bh 3 - | isNegativeZero d = putByte bh 4 - | otherwise = putByte bh 5 >> put_ bh (castDoubleToWord64 d) - get bh = getByte bh >>= \case - 1 -> pure $ SaneDouble (0 / 0) - 2 -> pure $ SaneDouble (1 / 0) - 3 -> pure $ SaneDouble ((-1) / 0) - 4 -> pure $ SaneDouble (-0) - 5 -> SaneDouble . castWord64ToDouble <$> get bh - n -> error ("Binary get bh SaneDouble: invalid tag: " ++ show n) - instance Binary ClosureInfo where put_ bh (ClosureInfo v regs name layo typ static) = do put_ bh v >> put_ bh regs >> put_ bh name >> put_ bh layo >> put_ bh typ >> put_ bh static ===================================== compiler/GHC/StgToJS/Types.hs ===================================== @@ -1,4 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} @@ -48,9 +47,6 @@ import qualified Data.Map as M import Data.Set (Set) import qualified Data.ByteString as BS import Data.Monoid -import Data.Typeable (Typeable) -import GHC.Generics (Generic) -import Control.DeepSeq -- | A State monad over IO holding the generator state. type G = StateT GenState IO @@ -107,7 +103,7 @@ data ClosureInfo = ClosureInfo , ciType :: CIType -- ^ type of the object, with extra info where required , ciStatic :: CIStatic -- ^ static references of this object } - deriving stock (Eq, Show, Generic) + deriving stock (Eq, Show) -- | Closure information, 'ClosureInfo', registers data CIRegs @@ -115,9 +111,7 @@ data CIRegs | CIRegs { ciRegsSkip :: Int -- ^ unused registers before actual args start , ciRegsTypes :: [VarType] -- ^ args } - deriving stock (Eq, Ord, Show, Generic) - -instance NFData CIRegs + deriving stock (Eq, Ord, Show) -- | Closure Information, 'ClosureInfo', layout data CILayout @@ -129,9 +123,7 @@ data CILayout { layoutSize :: !Int -- ^ closure size in array positions, including entry , layout :: [VarType] -- ^ The set of sized Types to layout } - deriving stock (Eq, Ord, Show, Generic) - -instance NFData CILayout + deriving stock (Eq, Ord, Show) -- | The type of 'ClosureInfo' data CIType @@ -143,13 +135,11 @@ data CIType | CIPap -- ^ The closure is a Partial Application | CIBlackhole -- ^ The closure is a black hole | CIStackFrame -- ^ The closure is a stack frame - deriving stock (Eq, Ord, Show, Generic) - -instance NFData CIType + deriving stock (Eq, Ord, Show) -- | Static references that must be kept alive newtype CIStatic = CIStaticRefs { staticRefs :: [FastString] } - deriving stock (Eq, Generic) + deriving stock (Eq) deriving newtype (Semigroup, Monoid, Show) -- | static refs: array = references, null = nothing to report @@ -169,9 +159,7 @@ data VarType | RtsObjV -- ^ some RTS object from GHCJS (for example TVar#, MVar#, MutVar#, Weak#) | ObjV -- ^ some JS object, user supplied, be careful around these, can be anything | ArrV -- ^ boxed array - deriving stock (Eq, Ord, Enum, Bounded, Show, Generic) - -instance NFData VarType + deriving stock (Eq, Ord, Enum, Bounded, Show) instance ToJExpr VarType where toJExpr = toJExpr . fromEnum @@ -231,7 +219,7 @@ data StaticInfo = StaticInfo { siVar :: !FastString -- ^ global object , siVal :: !StaticVal -- ^ static initialization , siCC :: !(Maybe Ident) -- ^ optional CCS name - } deriving stock (Eq, Show, Typeable, Generic) + } deriving stock (Eq, Show) data StaticVal = StaticFun !FastString [StaticArg] @@ -245,7 +233,7 @@ data StaticVal -- ^ regular datacon app | StaticList [StaticArg] (Maybe FastString) -- ^ list initializer (with optional tail) - deriving stock (Eq, Show, Generic) + deriving stock (Eq, Show) data StaticUnboxed = StaticUnboxedBool !Bool @@ -253,9 +241,7 @@ data StaticUnboxed | StaticUnboxedDouble !SaneDouble | StaticUnboxedString !BS.ByteString | StaticUnboxedStringOffset !BS.ByteString - deriving stock (Eq, Ord, Show, Generic) - -instance NFData StaticUnboxed + deriving stock (Eq, Ord, Show) -- | Static Arguments. Static Arguments are things that are statically -- allocated, i.e., they exist at program startup. These are static heap objects @@ -264,7 +250,7 @@ data StaticArg = StaticObjArg !FastString -- ^ reference to a heap object | StaticLitArg !StaticLit -- ^ literal | StaticConArg !FastString [StaticArg] -- ^ unfloated constructor - deriving stock (Eq, Show, Generic) + deriving stock (Eq, Show) instance Outputable StaticArg where ppr x = text (show x) @@ -278,7 +264,7 @@ data StaticLit | StringLit !FastString | BinLit !BS.ByteString | LabelLit !Bool !FastString -- ^ is function pointer, label (also used for string / binary init) - deriving (Eq, Show, Generic) + deriving (Eq, Show) instance Outputable StaticLit where ppr x = text (show x) @@ -300,7 +286,7 @@ data ForeignJSRef = ForeignJSRef , foreignRefCConv :: !CCallConv , foreignRefArgs :: ![FastString] , foreignRefResult :: !FastString - } deriving stock (Generic) + } -- | data used to generate one ObjUnit in our object file data LinkableUnit = LinkableUnit ===================================== compiler/GHC/Types/SaneDouble.hs ===================================== @@ -0,0 +1,48 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} + +-- | Double datatype with saner instances +module GHC.Types.SaneDouble + ( SaneDouble (..) + ) +where + +import GHC.Prelude +import GHC.Utils.Binary +import GHC.Float (castDoubleToWord64, castWord64ToDouble) + +-- | A newtype wrapper around 'Double' to ensure we never generate a 'Double' +-- that becomes a 'NaN', see instances for details on sanity. +newtype SaneDouble = SaneDouble + { unSaneDouble :: Double + } + deriving (Fractional, Num) + +instance Eq SaneDouble where + (SaneDouble x) == (SaneDouble y) = x == y || (isNaN x && isNaN y) + +instance Ord SaneDouble where + compare (SaneDouble x) (SaneDouble y) = compare (fromNaN x) (fromNaN y) + where fromNaN z | isNaN z = Nothing + | otherwise = Just z + +instance Show SaneDouble where + show (SaneDouble x) = show x + +-- we need to preserve NaN and infinities, unfortunately the Binary instance for +-- Double does not do this +instance Binary SaneDouble where + put_ bh (SaneDouble d) + | isNaN d = putByte bh 1 + | isInfinite d && d > 0 = putByte bh 2 + | isInfinite d && d < 0 = putByte bh 3 + | isNegativeZero d = putByte bh 4 + | otherwise = putByte bh 5 >> put_ bh (castDoubleToWord64 d) + get bh = getByte bh >>= \case + 1 -> pure $ SaneDouble (0 / 0) + 2 -> pure $ SaneDouble (1 / 0) + 3 -> pure $ SaneDouble ((-1) / 0) + 4 -> pure $ SaneDouble (-0) + 5 -> SaneDouble . castWord64ToDouble <$> get bh + n -> error ("Binary get bh SaneDouble: invalid tag: " ++ show n) + ===================================== compiler/ghc.cabal.in ===================================== @@ -811,6 +811,7 @@ Library GHC.Types.ProfAuto GHC.Types.RepType GHC.Types.SafeHaskell + GHC.Types.SaneDouble GHC.Types.SourceError GHC.Types.SourceFile GHC.Types.SourceText ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -19,6 +19,22 @@ Language This feature is guarded behind :extension:`TypeAbstractions`. +- In accordance with GHC proposal `#425 + `_ + GHC no longer implicitly quantifies over type variables that appear only in the RHS of type and + data family instances. This code will no longer work: :: + + type family F1 a :: k + type instance F1 Int = Any :: j -> j + + Instead you should write:: + + type instance F1 @(j -> j) Int = Any :: j -> j + + Or:: + + type instance forall j . F1 Int = Any :: j -> j + Compiler ~~~~~~~~ ===================================== libraries/base/GHC/Base.hs ===================================== @@ -806,11 +806,21 @@ class Functor f => Applicative f where (<*) :: f a -> f b -> f a (<*) = liftA2 const --- | A variant of '<*>' with the arguments reversed. +-- | A variant of '<*>' with the types of the arguments reversed. It differs from +-- @`flip` `(<*>)`@ in that the effects are resolved in the order the arguments are +-- presented. -- +-- ==== __Examples__ +-- >>> (<**>) (print 1) (id <$ print 2) +-- 1 +-- 2 +-- +-- >>> flip (<*>) (print 1) (id <$ print 2) +-- 2 +-- 1 + (<**>) :: Applicative f => f a -> f (a -> b) -> f b (<**>) = liftA2 (\a f -> f a) --- Don't use $ here, see the note at the top of the page -- | Lift a function to actions. -- Equivalent to Functor's `fmap` but implemented using only `Applicative`'s methods: ===================================== testsuite/tests/indexed-types/should_compile/T14131.hs ===================================== @@ -9,21 +9,21 @@ import Data.Kind import Data.Proxy data family Nat :: k -> k -> Type -newtype instance Nat :: (k -> Type) -> (k -> Type) -> Type where +newtype instance Nat :: forall k . (k -> Type) -> (k -> Type) -> Type where Nat :: (forall xx. f xx -> g xx) -> Nat f g type family F :: Maybe a -type instance F = (Nothing :: Maybe a) +type instance F @a = (Nothing :: Maybe a) class C k where data CD :: k -> k -> Type type CT :: k instance C (Maybe a) where - data CD :: Maybe a -> Maybe a -> Type where + data CD @(Maybe a) :: Maybe a -> Maybe a -> Type where CD :: forall a (m :: Maybe a) (n :: Maybe a). Proxy m -> Proxy n -> CD m n - type CT = (Nothing :: Maybe a) + type CT @(Maybe a) = (Nothing :: Maybe a) class Z k where type ZT :: Maybe k - type ZT = (Nothing :: Maybe k) + type ZT @k = (Nothing :: Maybe k) ===================================== testsuite/tests/indexed-types/should_compile/T15852.hs ===================================== @@ -7,4 +7,4 @@ import Data.Kind import Data.Proxy data family DF a (b :: k) -data instance DF (Proxy c) :: Proxy j -> Type +data instance DF @(Proxy j) (Proxy c) :: Proxy j -> Type ===================================== testsuite/tests/indexed-types/should_compile/T15852.stderr ===================================== @@ -3,10 +3,10 @@ TYPE CONSTRUCTORS roles nominal nominal nominal COERCION AXIOMS axiom T15852.D:R:DFProxyProxy0 :: - forall k1 k2 (c :: k1) (j :: k2). - DF (Proxy c) = T15852.R:DFProxyProxy k1 k2 c j + forall k1 k2 (j :: k1) (c :: k2). + DF (Proxy c) = T15852.R:DFProxyProxy k1 k2 j c FAMILY INSTANCES - data instance forall {k1} {k2} {c :: k1} {j :: k2}. + data instance forall {k1} {k2} {j :: k1} {c :: k2}. DF (Proxy c) -- Defined at T15852.hs:10:15 Dependent modules: [] -Dependent packages: [base-4.17.0.0] +Dependent packages: [base-4.18.0.0] ===================================== testsuite/tests/indexed-types/should_fail/T14230.hs ===================================== @@ -8,4 +8,4 @@ class C k where data CD :: k -> k -> * instance C (Maybe a) where - data CD :: (k -> *) -> (k -> *) -> * + data forall k . CD :: (k -> *) -> (k -> *) -> * ===================================== testsuite/tests/indexed-types/should_fail/T7938.hs ===================================== @@ -9,4 +9,4 @@ class Foo (a :: k1) (b :: k2) where type Bar a instance Foo (a :: k1) (b :: k2) where - type Bar a = (KP :: KProxy k2) + type forall k2 . Bar a = (KP :: KProxy k2) ===================================== testsuite/tests/indexed-types/should_fail/T7938.stderr ===================================== @@ -1,5 +1,5 @@ -T7938.hs:12:17: error: [GHC-83865] +T7938.hs:12:29: error: [GHC-83865] • Expected a type, but ‘KP :: KProxy k2’ has kind ‘KProxy k2’ • In the type ‘(KP :: KProxy k2)’ In the type instance declaration for ‘Bar’ ===================================== testsuite/tests/rename/should_compile/T23512b.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies, TypeAbstractions #-} +module T23512b where +import GHC.Types + +type family F2 a :: k +type instance F2 @(j -> j) Int = Any :: j -> j + +type family F3 a :: k +type instance forall j. F3 Int = Any :: j -> j ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -213,3 +213,4 @@ test('T23240', [req_th, extra_files(['T23240_aux.hs'])], multimod_compile, ['T23 test('T23318', normal, compile, ['-Wduplicate-exports']) test('T23434', normal, compile, ['']) test('T23510b', normal, compile, ['']) +test('T23512b', normal, compile, ['']) ===================================== testsuite/tests/rename/should_fail/T23512a.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies #-} +module T23512a where +import GHC.Types + +type family F1 a :: k +type instance F1 Int = Any :: j -> j + +data family D :: k -> Type +data instance D :: k -> Type ===================================== testsuite/tests/rename/should_fail/T23512a.stderr ===================================== @@ -0,0 +1,6 @@ + +T23512a.hs:6:31: error: [GHC-76037] Not in scope: type variable ‘j’ + +T23512a.hs:6:36: error: [GHC-76037] Not in scope: type variable ‘j’ + +T23512a.hs:9:20: error: [GHC-76037] Not in scope: type variable ‘k’ ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -203,3 +203,4 @@ test('T23510a', normal, compile_fail, ['']) test('T16635a', normal, compile_fail, ['']) test('T16635b', normal, compile_fail, ['']) test('T16635c', normal, compile_fail, ['']) +test('T23512a', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/T15797.hs ===================================== @@ -13,7 +13,7 @@ import Data.Kind class Ríki (obj :: Type) where type Obj :: obj -> Constraint - type Obj = Bæ @k :: k -> Constraint + type forall k . Obj = Bæ @k :: k -> Constraint class Bæ (a :: k) instance Bæ @k (a :: k) ===================================== testsuite/tests/typecheck/should_run/T21973a.hs ===================================== @@ -0,0 +1,45 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE InstanceSigs #-} + +module Main (main) where + +import Data.Kind +import GHC.Exts + +class (Monoid (Share a), Eq (Share a)) => ClassDecode a where + type Share a :: Type + decoderWithShare :: Share a -> Decoder a + +class (Eq (Currency e), ClassDecode (Tx e)) => ClassLedger e where + type Currency e :: Type + type Tx e :: Type + +newtype Decoder a = Decoder (String -> a) + +{-# NOINLINE decode #-} +decode :: ClassDecode a => String -> a +decode str = + case decoderWithShare mempty of + Decoder f -> f str + +data MyLedger c + +newtype MyTx c = MyTx + { currency :: c + } deriving (Show, Read) + +instance (Eq c) => ClassLedger (MyLedger c) where + type Currency (MyLedger c) = c + type Tx (MyLedger c) = MyTx c + +instance (Eq [c], ClassLedger (MyLedger c)) => ClassDecode (MyTx c) where + type Share (MyTx c) = [c] + {-# NOINLINE decoderWithShare #-} + decoderWithShare :: [c] -> Decoder (MyTx c) + decoderWithShare (s :: [c]) = + Decoder $ \str -> error $ show (s == s) + +main :: IO () +main = print (noinline decode (noinline show (currency (MyTx "USD"))) :: MyTx String) ===================================== testsuite/tests/typecheck/should_run/T21973a.stderr ===================================== @@ -0,0 +1,3 @@ +T21973a: True +CallStack (from HasCallStack): + error, called at T21973a.hs:42:23 in main:Main ===================================== testsuite/tests/typecheck/should_run/T21973b.hs ===================================== @@ -0,0 +1,40 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE InstanceSigs #-} + +module Main (main) where + +import Data.Kind +import GHC.Exts + + +data D a = MkD + deriving Eq + +class Def a where + def :: a +instance Def (D a) where + def = MkD + +type family Share a where + Share Char = Char + + +class ( Share a ~ a, Def a ) => ClassDecode a where +instance ClassLedger c => ClassDecode (D c) where + +class (Eq e, ClassDecode (D e)) => ClassLedger e where +instance Eq c => ClassLedger c where + + +decoderWithShare2 :: ClassLedger a => a -> Bool +decoderWithShare2 d = d == d + + +decode :: forall a. (ClassLedger a, ClassDecode a) => Bool +decode = decoderWithShare2 @a (def @(Share a)) + +main :: IO () +main = print (decode @(D Char)) ===================================== testsuite/tests/typecheck/should_run/T21973b.stdout ===================================== @@ -0,0 +1 @@ +True ===================================== testsuite/tests/typecheck/should_run/all.T ===================================== @@ -167,3 +167,5 @@ test('T19397M4', extra_files(['T19397S.hs']), compile_and_run, ['-main-is foo']) test('T19667', normal, compile_and_run, ['-fhpc']) test('T20768', normal, compile_and_run, ['']) test('T22510', normal, compile_and_run, ['']) +test('T21973a', [exit_code(1)], compile_and_run, ['']) +test('T21973b', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1a55d9087b8ca790f3da6f7be19b7023792377ed...68bff0a947e1133d359c0b7eded5970a75c20113 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1a55d9087b8ca790f3da6f7be19b7023792377ed...68bff0a947e1133d359c0b7eded5970a75c20113 You're receiving 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 Jun 16 17:01:05 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Fri, 16 Jun 2023 13:01:05 -0400 Subject: [Git][ghc/ghc][wip/testsuite-no-cusks] 7234 commits: PmCheck: No ConLike instantiation in pmcheck Message-ID: <648c95514d932_271466330b0f872136@gitlab.mail> Vladislav Zavialov pushed to branch wip/testsuite-no-cusks at Glasgow Haskell Compiler / GHC Commits: c5d888d4 by Sebastian Graf at 2019-09-28T17:11:41-04:00 PmCheck: No ConLike instantiation in pmcheck `pmcheck` used to call `refineToAltCon` which would refine the knowledge we had about a variable by equating it to a `ConLike` application. Since we weren't particularly smart about this in the Check module, we simply freshened the constructors existential and term binders utimately through a call to `mkOneConFull`. But that instantiation is unnecessary for when we match against a concrete pattern! The pattern will already have fresh binders and field types. So we don't call `refineToAltCon` from `Check` anymore. Subsequently, we can simplify a couple of call sites and functions in `PmOracle`. Also implementing `computeCovered` becomes viable and we don't have to live with the hack that was `addVarPatVecCt` anymore. A side-effect of not indirectly calling `mkOneConFull` anymore is that we don't generate the proper strict argument field constraints anymore. Instead we now desugar ConPatOuts as if they had bangs on their strict fields. This implies that `PmVar` now carries a `HsImplBang` that we need to respect by a (somewhat ephemeral) non-void check. We fix #17234 in doing so. - - - - - ce64b397 by Sebastian Graf at 2019-09-28T17:12:26-04:00 `exprOkForSpeculation` for Note [IO hack in the demand analyser] In #14998 I realised that the notion of speculative execution *exactly matches* eager evaluation of expressions in a case alternative where the scrutinee is an IO action. Normally we have to `deferIO` any result from that single case alternative to prevent this speculative execution, so we had a special case in place in the demand analyser that would check if the scrutinee was a prim-op, in which case we assumed that it would be ok to do the eager evaluation. Now we just check if the scrutinee is `exprOkForSpeculation`, corresponding to the notion that we want to push evaluation of the scrutinee *after* eagerly evaluating stuff from the case alternative. This fixes #14988, because it resolves the last open Item 4 there. - - - - - f3cb8c7c by Ömer Sinan Ağacan at 2019-09-30T22:39:53-04:00 Refactor iface file generation: This commit refactors interface file generation to allow information from the later passed (NCG, STG) to be stored in interface files. We achieve this by splitting interface file generation into two parts: * Partial interfaces, built based on the result of the core pipeline * A fully instantiated interface, which also contains the final fingerprints and can optionally contain information produced by the backend. This change is required by !1304 and !1530. -dynamic-too handling is refactored too: previously when generating code we'd branch on -dynamic-too *before* code generation, but now we do it after. (Original code written by @AndreasK in !1530) Performance ~~~~~~~~~~~ Before this patch interface files where created and immediately flushed to disk which made space leaks impossible. With this change we instead use NFData to force all iface related data structures to avoid space leaks. In the process of refactoring it was discovered that the code in the ToIface Module allocated a lot of thunks which were immediately forced when writing/forcing the interface file. So we made this module more strict to avoid creating many of those thunks. Bottom line is that allocations go down by about ~0.1% compared to master. Residency is not meaningfully different after this patch. Runtime was not benchmarked. Co-Authored-By: Andreas Klebinger <klebinger.andreas at gmx.at> Co-Authored-By: Ömer Sinan Ağacan <omer at well-typed.com> - - - - - 6a1700aa by Simon Peyton Jones at 2019-09-30T22:40:30-04:00 Fix arguments for unbound binders in RULE application We were failing to correctly implement Note [Unbound RULE binders] in Rules.hs. In particular, when cooking up a fake Refl, were were failing to apply the substitition. This patch fixes that problem, and simultaneously tidies up the impedence mis-match between RuleSubst and TCvSubst. Thanks to Sebastian! - - - - - 97811ef5 by Takenobu Tani at 2019-09-30T22:41:35-04:00 Add help message for GHCi :instances command This commit updates GHCi's help message for GHC 8.10. - - - - - 6f8550a3 by Sebastian Graf at 2019-09-30T22:42:14-04:00 Move pattern match checker modules to GHC.HsToCore.PmCheck - - - - - b36dd49b by Takenobu Tani at 2019-09-30T22:42:53-04:00 testsuite: Add minimal test for :doc command Currently, there are no testcases for GHCi `:doc` command. Perhaps because it was experimental. And it could be changed in the future. But `:doc` command is already useful, so I add a minimal regression test to keep current behavior. See also 85309a3cda for implementation of `:doc` command. - - - - - bdba6ac2 by Vladislav Zavialov at 2019-09-30T22:43:31-04:00 Do not rely on CUSKs in 'base' Use standalone kind signatures instead of complete user-specified kinds in Data.Type.Equality and Data.Typeable - - - - - dbdf6a3d by Ben Gamari at 2019-09-30T22:44:07-04:00 testsuite: Mark T3389 as broken in hpc way on i386 See #17256. - - - - - 822481d5 by Ben Gamari at 2019-09-30T22:44:44-04:00 Bump process submodule Marks process003 as fragile, as noted in #17245. - - - - - 6548b7b0 by Sebastian Graf at 2019-10-01T09:22:10+00:00 Add a bunch of testcases for the pattern match checker Adds regression tests for tickets #17207, #17208, #17215, #17216, #17218, #17219, #17248 - - - - - 58013220 by Sebastian Graf at 2019-10-01T09:22:18+00:00 Add testcases inspired by Luke Maranget's pattern match series In his paper "Warnings for Pattern Matching", Luke Maranget describes three series in his appendix for which GHC's pattern match checker scaled very badly. We mostly avoid this now with !1752. This commit adds regression tests for each of the series. Fixes #17264. - - - - - 9c002177 by Ryan Scott at 2019-10-01T16:24:12-04:00 Refactor some cruft in TcDeriv * `mk_eqn_stock`, `mk_eqn_anyclass`, and `mk_eqn_no_mechanism` all took a continuation of type `DerivSpecMechanism -> DerivM EarlyDerivSpec` to represent its primary control flow. However, in practice this continuation was always instantiated with the `mk_originative_eqn` function, so there's not much point in making this be a continuation in the first place. This patch removes these continuations in favor of invoking `mk_originative_eqn` directly, which is simpler. * There were several parts of `TcDeriv` that took different code paths if compiling an `.hs-boot` file. But this is silly, because ever since 101a8c770b9d3abd57ff289bffea3d838cf25c80 we simply error eagerly whenever attempting to derive any instances in an `.hs-boot` file. This patch removes all of the unnecessary `.hs-boot` code paths, leaving only one (which errors out). * Remove various error continuation arguments from `mk_eqn_stock` and related functions. - - - - - 9a27a063 by David Eichmann at 2019-10-01T16:55:33-04:00 Hadrian: Libffi rule now `produces` dynamic library files. - - - - - 0956c194 by David Eichmann at 2019-10-01T16:55:33-04:00 Hadrian: do not cache GHC configure rule - - - - - 8924224e by Ömer Sinan Ağacan at 2019-10-01T16:55:37-04:00 Make small INLINE functions behave properly Simon writes: Currently we check for a type arg rather than isTyCoArg. This in turn makes INLINE things look bigger than they should be, and stops them being inlined into boring contexts when they perfectly well could be. E.g. f x = g <refl> x {-# INLINE g #-} ... (map (f x) xs) ... The context is boring, so don't inline unconditionally. But f's RHS is no bigger than its call, provided you realise that the coercion argument is ultimately cost-free. This happens in practice for $WHRefl. It's not a big deal: at most it means we have an extra function call overhead. But it's untidy, and actually worse than what happens without an INLINE pragma. Fixes #17182 This makes 0.0% change in nofib binary sizes. - - - - - 53b0c6e0 by Gabor Greif at 2019-10-03T08:15:50-04:00 Typo in comment [ci skip] - - - - - 60229e9e by Ryan Scott at 2019-10-03T12:17:10-04:00 Merge TcTypeableValidity into TcTypeable, document treatment of casts This patch: * Implements a refactoring (suggested in https://gitlab.haskell.org/ghc/ghc/merge_requests/1199#note_207345) that moves all functions from `TcTypeableValidity` back to `TcTypeable`, as the former module doesn't really need to live on its own. * Adds `Note [Typeable instances for casted types]` to `TcTypeable` explaining why the `Typeable` solver currently does not support types containing casts. Resolves #16835. - - - - - 3b9d4907 by Richard Eisenberg at 2019-10-03T12:17:13-04:00 Note [Don't flatten tuples from HsSyn] in MkCore Previously, we would sometimes flatten 1-tuples and sometimes not. This didn't cause damage because there is no way to generate HsSyn with 1-tuples. But, with the upcoming fix to #16881, there will be. Without this patch, obscure lint errors would have resulted. No test case, as there is not yet a way to tickle this. - - - - - 8a254d6b by Ömer Sinan Ağacan at 2019-10-03T12:17:19-04:00 Fix new compact block allocation in allocateForCompact allocateForCompact() is called when nursery of a compact region is full, to add new blocks to the compact. New blocks added to an existing region needs a StgCompactNFDataBlock header, not a StgCompactNFData. This fixes allocateForCompact() so that it now correctly allocates space for StgCompactNFDataBlock instead of StgCompactNFData as before. Fixes #17044. A regression test T17044 added. - - - - - 3c7b172b by James Brock at 2019-10-03T12:17:24-04:00 docs String, hyperlink to Data.List Add a reference to the documentation for Data.List in the description for String. On the generated Haddock for Data.String, http://hackage.haskell.org/package/base-4.12.0.0/docs/Data-String.html there is curently no hyperlink to Data.List, which is where a reader will find most of the useful functions which can operate on Strings. I imagine this has confused beginners who came to this page looking for String operations. - - - - - 67bf734c by John Ericson at 2019-10-03T12:17:28-04:00 Add `module {-# SOURCE #-} Foo` syntax for hs-boot in bkp This is a good convenience for testing. - - - - - 6655ec73 by Richard Eisenberg at 2019-10-03T12:17:30-04:00 Improve documentation around empty tuples/lists This patch also changes the way we handle empty lists, simplifying them somewhat. See Note [Empty lists]. Previously, we had to special-case empty lists in the type-checker. Now no more! Finally, this patch improves some documentation around the ir_inst field used in the type-checker. This breaks a test case, but I really think the problem is #17251, not really related to this patch. Test case: typecheck/should_compile/T13680 - - - - - 9a4ff210 by John Ericson at 2019-10-03T12:17:31-04:00 Make Haddock submodule remote point to gitlab mirror This makes it match the others - - - - - cb364bc2 by Ben Gamari at 2019-10-03T12:17:32-04:00 testsuite: Mark print037 as fragile, not broken See #16205. - - - - - 259f4dff by Ben Gamari at 2019-10-03T12:17:32-04:00 Exclude rts.cabal from source distributions This modifies both the Hadrian and make build systems to avoid included the rts.cabal generated by autoconf in the source distribution. Fixes #17265. - - - - - e4c93896 by Ben Gamari at 2019-10-03T12:17:32-04:00 DynFlags: Only warn when split-sections is ignored Previously we would throw an error which seems a bit harsh. As reported in #17283. - - - - - ee6324ad by Tobias Guggenmos at 2019-10-03T12:17:33-04:00 Improve documentation for runtime debugging flags - - - - - 47386fe8 by Tobias Guggenmos at 2019-10-03T12:17:33-04:00 Add new debug flag -DZ Zeros heap memory after gc freed it. - - - - - d0924b15 by Stefan Schulze Frielinghaus at 2019-10-03T12:17:34-04:00 Extend argument of createIOThread to word size Function createIOThread expects its second argument to be of size word. The natural size of the second parameter is 32bits. Thus for some 64bit architectures, where a write of the lower half of a register does not clear the upper half, the value must be zero extended. - - - - - 1357d023 by Ben Gamari at 2019-10-03T12:17:34-04:00 rules/haddock: Ensure that RTS stats directory exists It may not exist if the source tarball was extracted yet not the testsuite tarball. - - - - - ec93d2a9 by Fumiaki Kinoshita at 2019-10-04T21:43:49-04:00 Add Monad instances to `(,,) a b` and `(,,,) a b c` - - - - - 05419e55 by John Ericson at 2019-10-04T21:44:29-04:00 Per stage headers, ghc_boot_platform.h -> stage 0 ghcplatform.h The generated headers are now generated per stage, which means we can skip hacks like `ghc_boot_platform.h` and just have that be the stage 0 header as proper. In general, stages are to be embraced: freely generate everything in each stage but then just build what you depend on, and everything is symmetrical and efficient. Trying to avoid stages because bootstrapping is a mind bender just creates tons of bespoke mini-mind-benders that add up to something far crazier. Hadrian was pretty close to this "stage-major" approach already, and so was fairly easy to fix. Make needed more work, however: it did know about stages so at least there was a scaffold, but few packages except for the compiler cared, and the compiler used its own counting system. That said, make and Hadrian now work more similarly, which is good for the transition to Hadrian. The merits of embracing stage aside, the change may be worthy for easing that transition alone. - - - - - 75a5dd8e by John Ericson at 2019-10-04T21:44:29-04:00 Remove {Build,Host}Platform_NAME from header They are only used in a file we construct directly, so just skip CPP. - - - - - b538476b by Daroc Alden at 2019-10-04T21:45:09-04:00 Deprecate -fwarn-hi-shadowing, because it was never implemented and is not used. This fixes #10913. - - - - - dd8f76b2 by John Ericson at 2019-10-04T21:45:48-04:00 Factor out a smaller part of Platform for host fallback - - - - - d15b44d6 by John Ericson at 2019-10-04T21:45:49-04:00 Pull out the settings file parsing code into it's own module. This has two benefits: 1. One less hunk of code dependent on DynFlags 2. Add a little bit of error granularity to distrinugish between missing data and bad data. This could someday be shared with ghc-pkg which aims to work even with a missing file. I also am about to to make --supported-extensions use this too. - - - - - eb892b28 by John Ericson at 2019-10-04T21:45:49-04:00 Add tryFindTopDir to look for the top dir without blowing up if it is not found. - - - - - 0dded5ec by John Ericson at 2019-10-04T21:45:49-04:00 Always enable the external interpreter You can always just not use or even build `iserv`. I don't think the maintenance cost of the CPP is worth...I can't even tell what the benefit is. - - - - - 0d31ccdd by Artem Pyanykh at 2019-10-04T21:46:28-04:00 [linker, macho] Don't map/allocate zero size sections and segments Zero size sections are common even during regular build on MacOS. For instance: ``` $ ar -xv libHSghc-prim-0.6.1.a longlong.o $ otool -l longlong.o longlong.o: Mach header magic cputype cpusubtype caps filetype ncmds sizeofcmds flags 0xfeedfacf 16777223 3 0x00 1 2 176 0x00002000 Load command 0 cmd LC_SEGMENT_64 cmdsize 152 segname vmaddr 0x0000000000000000 vmsize 0x0000000000000000 <-- segment size = 0 fileoff 208 filesize 0 maxprot 0x00000007 initprot 0x00000007 nsects 1 flags 0x0 Section sectname __text segname __TEXT addr 0x0000000000000000 size 0x0000000000000000 <-- section size = 0 offset 208 align 2^0 (1) reloff 0 nreloc 0 flags 0x80000000 reserved1 0 reserved2 0 cmd LC_BUILD_VERSION cmdsize 24 platform macos sdk 10.14 minos 10.14 ntools 0 ``` The issue of `mmap`ing 0 bytes was resolved in !1050, but the problem remained. These 0 size segments and sections were still allocated in object code, which lead to failed `ASSERT(size > 0)` in `addProddableBlock` further down the road. With this change zero size segments **and** sections are not mapped/allocated at all. Test plan: 1. Build statically linked GHC. 2. Run `ghc --interactive`. Observe that REPL loads successfully (which was not the case before). 3. Load several more compiled hs files into repl. No failures. - - - - - 93f02b62 by Roland Senn at 2019-10-04T21:47:07-04:00 New fix for #11647. Avoid side effects like #17171 If a main module doesn't contain a header, we omit the check whether the main module is exported. With this patch GHC, GHCi and runghc use the same code. - - - - - 8039b625 by Matthew Bauer at 2019-10-04T21:47:47-04:00 Add musl systems to llvm-targets This was done in Nixpkgs, but never upstreamed. Musl is pretty much the same as gnu, but with a different libc. I’ve used the same values for everything. - - - - - ee8118ca by John Ericson at 2019-10-05T00:11:58-04:00 Clean up `#include`s in the compiler - Remove unneeded ones - Use <..> for inter-package. Besides general clean up, helps distinguish between the RTS we link against vs the RTS we compile for. - - - - - 241921a0 by Ben Gamari at 2019-10-05T19:18:40-04:00 rts: Fix CNF dirtying logic Previously due to a silly implementation bug CNFs would never have their dirty flag set, resulting in their being added again and again to the `mut_list`. Fix this. Fixes #17297. - - - - - 825c108b by Ryan Scott at 2019-10-07T12:00:59-04:00 Only flatten up to type family arity in coreFlattenTyFamApp (#16995) Among other uses, `coreFlattenTyFamApp` is used by Core Lint as a part of its check to ensure that each type family axiom reduces according to the way it is defined in the source code. Unfortunately, the logic that `coreFlattenTyFamApp` uses to flatten type family applications disagreed with the logic in `TcFlatten`, which caused it to spuriously complain this program: ```hs type family Param :: Type -> Type type family LookupParam (a :: Type) :: Type where LookupParam (f Char) = Bool LookupParam x = Int foo :: LookupParam (Param ()) foo = 42 ``` This is because `coreFlattenTyFamApp` tries to flatten the `Param ()` in `LookupParam (Param ())` to `alpha` (where `alpha` is a flattening skolem), and GHC is unable to conclude that `alpha` is apart from `f Char`. This patch spruces up `coreFlattenTyFamApp` so that it instead flattens `Param ()` to `alpha ()`, which GHC _can_ know for sure is apart from `f Char`. See `Note [Flatten], wrinkle 3` in `FamInstEnv`. - - - - - b2577081 by Ben Gamari at 2019-10-07T12:01:46-04:00 Refactor, document, and optimize LLVM configuration loading As described in the new Note [LLVM Configuration] in SysTools, we now load llvm-targets and llvm-passes lazily to avoid the overhead of doing so when -fllvm isn't used (also known as "the common case"). Noticed in #17003. Metric Decrease: T12234 T12150 - - - - - 93c71ae6 by Ben Gamari at 2019-10-07T12:02:23-04:00 configure: Determine library versions of template-haskell, et al. These are needed by the user guide documentation. Fixes #17260. - - - - - b7890611 by Andrey Mokhov at 2019-10-07T12:03:13-04:00 Hadrian: Stop using in-tree Cabal - - - - - 0ceb98f6 by Andrey Mokhov at 2019-10-07T12:03:13-04:00 Switch to cabal-version=3.0 in ghc-heap.cabal - - - - - e3418e96 by Andrey Mokhov at 2019-10-07T12:03:13-04:00 Switch to cabal-version=3.0 in base.cabal and rts.cabal - - - - - 805653f6 by John Ericson at 2019-10-07T12:04:19-04:00 Get rid of wildcard patterns in prim Cmm emitting code This way, we can be sure we don't miss a case. - - - - - ab945819 by Ryan Scott at 2019-10-07T12:05:09-04:00 Refactor some cruft in TcGenGenerics * `foldBal` contains needless partiality that can easily be avoided. * `mkProd_E` and `mkProd_P` both contain unique supply arguments that are completely unused, which can be removed. - - - - - d0edba3a by John Ericson at 2019-10-07T12:05:47-04:00 Remove CONFIGURE_ARGS from configure.ac It looks like it's been unused since at least 34cc75e1a62638f2833815746ebce0a9114dc26b. - - - - - 9a6bfb0a by John Ericson at 2019-10-07T12:06:26-04:00 Keep OSTYPE local to configure.ac Unused outside it since b6be81b841e34ca45b3549c4c79e886a8761e59a. - - - - - 4df39fd0 by John Ericson at 2019-10-07T12:07:08-04:00 Get rid of GHC_PACKAGE_DB_FLAG We no longer support booting from older GHC since 527bcc41630918977c73584d99125ff164400695. - - - - - 31a29a7a by John Ericson at 2019-10-07T12:07:46-04:00 Remove GhcLibsWithUnix d679ca43e7477284d733b94ff542be5363be3353 meant to remove it but did not finish the job. - - - - - 77ca39e3 by Ben Gamari at 2019-10-08T05:11:03-04:00 gitlab-ci: Add missing TEST_ENV variables This should fix #16985. - - - - - 9a2798e1 by Ben Gamari at 2019-10-08T05:11:03-04:00 hadrian: Add `validate` and `slow validate` flavours - - - - - ab311696 by Ben Gamari at 2019-10-08T05:11:03-04:00 validate: Use Hadrian's validate flavour - - - - - 98179a77 by Ben Gamari at 2019-10-08T05:11:03-04:00 gitlab-ci: Use validate flavour in hadrian builds - - - - - 8af9eba8 by Ben Gamari at 2019-10-08T05:11:40-04:00 base: Document the fact that Typeable is automatically "derived" This fixes #17060. - - - - - 397c6ed5 by Sebastian Graf at 2019-10-08T05:12:15-04:00 PmCheck: Identify some semantically equivalent expressions By introducing a `CoreMap Id` to the term oracle, we can represent syntactically equivalent expressions by the same `Id`. Combine that with `CoreOpt.simpleCoreExpr` and it might even catch non-trivial semantic equalities. Unfortunately due to scoping issues, this will not solve #17208 for view patterns yet. - - - - - 8a2e8408 by Ben Gamari at 2019-10-08T05:12:58-04:00 users-guide: Refer to language extension flags via :extension: Previously several were referred to via :ghc-flag:`-X...`. - - - - - 7cd54538 by Ben Gamari at 2019-10-08T05:12:58-04:00 users-guide: Make reverse flags addressable via :ghc-flag: Previously one could not easily link to the :reverse: flag of a ghc-flag. - - - - - e9813afc by Ben Gamari at 2019-10-08T05:12:58-04:00 users-guide: Document -XHaskell98 and -XHaskell2010 - - - - - eaeb28a1 by Ben Gamari at 2019-10-08T05:12:58-04:00 users-guide: Fix various warnings - - - - - 180cf177 by Ben Gamari at 2019-10-08T05:12:58-04:00 users-guide: Document NondecreasingIndentation - - - - - 0a26f9e8 by Ben Gamari at 2019-10-08T05:12:58-04:00 users-guide: Document -fworker-wrapper - - - - - ca4791db by Ben Gamari at 2019-10-08T05:12:58-04:00 users-guide: Rework pragma key generation Previously we had a hack to handle the case of multi-token SPECIALISE pragmas. Now we use a slightly more general rule of using a prefix of tokens containing only alphabetical characters. - - - - - 98c09422 by Ben Gamari at 2019-10-08T05:12:58-04:00 users-guide: Run sphinx in nit-picky mode This ensure that it blurts an error on missing references. - - - - - a95f7185 by Ben Gamari at 2019-10-08T05:12:58-04:00 doc: Write out documented flag list - - - - - 9402608e by Ben Gamari at 2019-10-08T05:12:58-04:00 gitlab-ci: Check coverage of GHC flags in users guide This ensures that all GHC flags are documented during the documentation build. Fixes #17315. - - - - - 9ac3bcbb by Andrew Martin at 2019-10-08T13:24:52-04:00 Document the UnliftedFFITypes extension. - - - - - 77f3ba23 by Andrew Martin at 2019-10-08T13:24:52-04:00 Rephrase a bunch of things in the unlifted ffi types documentation. Add a section on pinned byte arrays. - - - - - a70db7bf by Andrew Martin at 2019-10-08T13:24:52-04:00 [skip ci] link to foreign cmm call - - - - - 0d413259 by Andrew Martin at 2019-10-08T13:24:52-04:00 [skip ci] make the table better - - - - - 0c7a5bcd by Andrew Martin at 2019-10-08T13:24:52-04:00 [skip ci] can not -> may not - - - - - 6a5c249d by Andrew Martin at 2019-10-08T13:24:52-04:00 [skip ci] clarify what unsound means - - - - - bf02c264 by Ryan Scott at 2019-10-08T13:25:37-04:00 Mark newtype constructors as used in the Coercible solver (#10347) Currently, newtype constructors are not marked as used when they are accessed under the hood by uses of `coerce`, as described in #10347. This fixes #10347 by co-opting the `tcg_keep` field of `TcGblEnv` to track uses of newtype constructors in the `Coercible` solver. See `Note [Tracking unused binding and imports]` in `TcRnTypes`. Since #10347 is fixed, I was able to simplify the code in `TcDeriv` slightly, as the hack described in `Note [Newtype deriving and unused constructors]` is no longer necessary. - - - - - 9612e91c by Richard Eisenberg at 2019-10-08T13:26:20-04:00 Solve constraints from top-level groups sooner Previously, all constraints from all top-level groups (as separated by top-level splices) were lumped together and solved at the end. This could leak metavariables to TH, though, and that's bad. This patch solves each group's constraints before running the next group's splice. Naturally, we now report fewer errors in some cases. One nice benefit is that this also fixes #11680, but in a much simpler way than the original fix for that ticket. Admittedly, the error messages degrade just a bit from the fix from #11680 (previously, we informed users about variables that will be brought into scope below a top-level splice, and now we just report an out-of-scope error), but the amount of complexity required throughout GHC to get that error was just not worth it. This patch thus reverts much of f93c9517a2c6e158e4a5c5bc7a3d3f88cb4ed119. Fixes #16980 Test cases: th/T16980{,a} - - - - - c2d4011c by Vladislav Zavialov at 2019-10-08T13:27:12-04:00 Bump array and haddock submodules - - - - - f691f0c2 by Sebastian Graf at 2019-10-08T13:27:49-04:00 PmCheck: Look up parent data family TyCon when populating `PossibleMatches` The vanilla COMPLETE set is attached to the representation TyCon of a data family instance, whereas the user-defined COMPLETE sets are attached to the parent data family TyCon itself. Previously, we weren't trying particularly hard to get back to the representation TyCon to the parent data family TyCon, resulting in bugs like #17207. Now we should do much better. Fixes the original issue in #17207, but I found another related bug that isn't so easy to fix. - - - - - 0c0a15a8 by Ben Gamari at 2019-10-09T16:21:14-04:00 Rename STAGE macro to GHC_STAGE To avoid polluting the macro namespace - - - - - 63a5371d by Ben Gamari at 2019-10-09T16:21:14-04:00 Relayout generated header body - - - - - 817c1a94 by Ben Gamari at 2019-10-09T16:21:14-04:00 Define GHC_STAGE in headers instead of command-line - - - - - 5f2c49d8 by Ben Gamari at 2019-10-09T16:21:14-04:00 Remove GHC_STAGE guards from MachDeps This allows the stage1 compiler (which needs to run on the build platform and produce code for the host) to depend upon properties of the target. This is wrong. However, it's no more wrong than it was previously and @Erichson2314 is working on fixing this so I'm going to remove the guard so we can finally bootstrap HEAD with ghc-8.8 (see issue #17146). - - - - - 35cc5eff by Ben Gamari at 2019-10-09T16:21:15-04:00 Test - - - - - d584e3f0 by Ryan Scott at 2019-10-09T16:21:50-04:00 Use addUsedDataCons more judiciously in TcDeriv (#17324) If you derive an instance like this: ```hs deriving <...> instance Foo C ``` And the data constructors for `C` aren't in scope, then `doDerivInstErrorChecks1` throws an error. Moreover, it will _only_ throw an error if `<...>` is either `stock` or `newtype`. This is because the code that the `anyclass` or `via` strategies would generate would not require the use of the data constructors for `C`. However, `doDerivInstErrorChecks1` has another purpose. If you write this: ```hs import M (C(MkC1, ..., MkCn)) deriving <...> instance Foo C ``` Then `doDerivInstErrorChecks1` will call `addUsedDataCons` on `MkC1` through `MkCn` to ensure that `-Wunused-imports` does not complain about them. However, `doDerivInstErrorChecks1` was doing this for _every_ deriving strategy, which mean that if `<...>` were `anyclass` or `via`, then the warning about `MkC1` through `MkCn` being unused would be suppressed! The fix is simple enough: only call `addUsedDataCons` when the strategy is `stock` or `newtype`, just like the other code paths in `doDerivInstErrorChecks1`. Fixes #17324. - - - - - 30f5ac07 by Sebastian Graf at 2019-10-11T22:10:12-04:00 Much simpler language for PmCheck Simon realised that the simple language composed of let bindings, bang patterns and flat constructor patterns is enough to capture the semantics of the source pattern language that are important for pattern-match checking. Well, given that the Oracle is smart enough to connect the dots in this less informationally dense form, which it is now. So we transform `translatePat` to return a list of `PmGrd`s relative to an incoming match variable. `pmCheck` then trivially translates each of the `PmGrd`s into constraints that the oracle understands. Since we pass in the match variable, we incidentally fix #15884 (coverage checks for view patterns) through an interaction with !1746. - - - - - 166e1c2a by Stefan Schulze Frielinghaus at 2019-10-11T22:10:51-04:00 Hadrian: Take care of assembler source files Fixes #17286. - - - - - c2290596 by John Ericson at 2019-10-12T06:32:18-04:00 Simplify Configure in a few ways - No need to distinguish between gcc-llvm and clang. First of all, gcc-llvm is quite old and surely unmaintained by now. Second of all, none of the code actually care about that distinction! Now, it does make sense to consider C multiple frontends for LLVMs in the form of clang vs clang-cl (same clang, yes, but tweaked interface). But this is better handled in terms of "gccish vs mvscish" and "is LLVM", yielding 4 combinations. Therefore, I don't think it is useful saving the existing code for that. - Get the remaining CC_LLVM_BACKEND, and also TABLES_NEXT_TO_CODE in mk/config.h the normal way, rather than hacking it post-hoc. No point keeping these special cases around for now reason. - Get rid of hand-rolled `die` function and just use `AC_MSG_ERROR`. - Abstract check + flag override for unregisterised and tables next to code. Oh, and as part of the above I also renamed/combined some variables where it felt appropriate. - GccIsClang -> CcLlvmBackend. This is for `AC_SUBST`, like the other Camal case ones. It was never about gcc-llvm, or Apple's renamed clang, to be clear. - llvm_CC_FLAVOR -> CC_LLVM_BACKEND. This is for `AC_DEFINE`, like the other all-caps snake case ones. llvm_CC_FLAVOR was just silly indirection *and* an odd name to boot. - - - - - f1ce3535 by Vladislav Zavialov at 2019-10-12T06:33:05-04:00 Escape stats file command (#13676) - - - - - cd1a8808 by Vladislav Zavialov at 2019-10-12T06:33:05-04:00 Skip T13767 on Darwin The CI job fails with: +++ rts/T13676.run/T13676.run.stderr.normalised 2019-10-09 12:27:56.000000000 -0700 @@ -0,0 +1,4 @@ +dyld: Library not loaded: @rpath/libHShaskeline-0.7.5.0-ghc8.9.0.20191009.dylib + Referenced from: /Users/builder/builds/ewzE5N2p/0/ghc/ghc/inplace/lib/bin/ghc + Reason: image not found +*** Exception: readCreateProcess: '/Users/builder/builds/ewzE5N2p/0/ghc/ghc/inplace/lib/bin/ghc' '-B/Users/builder/builds/ewzE5N2p/0/ghc/ghc/inplace/lib' '-e' ''/''$'/'' == '/''/x0024'/''' +RTS '-tT13676.t' (exit -6): failed Unable to reproduce locally. - - - - - 0a338264 by Ryan Scott at 2019-10-12T06:33:42-04:00 Use newDFunName for both manual and derived instances (#17339) Issue #17339 was caused by using a slightly different version of `newDFunName` for derived instances that, confusingly enough, did not take all arguments to the class into account when generating the `DFun` name. I cannot think of any good reason for doing this, so this patch uses `newDFunName` uniformly for both derived instances and manually written instances alike. Fixes #17339. - - - - - c50e4c92 by Simon Peyton Jones at 2019-10-12T13:35:24-04:00 Fix validity checking for inferred types GHC is suposed to uphold the principle that an /inferred/ type for a let-binding should obey the rules for that module. E.g. we should only accept an inferred higher rank type if we have RankNTypes on. But we were failing to check this: TcValidity.checkValidType allowed arbitrary rank for inferred types. This patch fixes the bug. It might in principle cause some breakage, but if so that's good: the user should add RankNTypes and/or a manual signature. (And almost every package has explicit user signatures for all top-level things anyway.) Let's see. Fixes #17213. Metric Decrease: T10370 - - - - - 226d86d2 by Simon Peyton Jones at 2019-10-12T13:36:02-04:00 Do not add a 'solved dict' for quantified constraints GHC has a wonderful-but-delicate mechanism for building recursive dictionaries by adding a goal to the "solved dictionaries" before solving the sub-goals. See Note [Solved dictionaries] in TcSMonad Ticket #17267 showed that if you use this mechanism for local /quantified/ constraints you can get a loop -- or even unsafe coerce. This patch fixes the bug. Specifically * Make TcSMonad.addSolvedDict be conditional on using a /top level/ instance, not a quantified one. * Moreover, we /also/ don't want to add a solved dict for equalities (a~b). * Add lots more comments to Note [Solved dictionaries] to explain the above cryptic stuff. * Extend InstanceWhat to identify those strange built-in equality instances. A couple of other things along the way * Delete the unused Type.isIPPred_maybe. * Stop making addSolvedDict conditional on not being an impolicit parameter. This comes from way back. But it's irrelevant now because IP dicts are never solved via an instance. - - - - - 5ab1a28d by nineonine at 2019-10-13T06:31:40-04:00 Template Haskell: make unary tuples legal (#16881) - - - - - c1bd07cd by Andreas Klebinger at 2019-10-13T06:32:19-04:00 Fix #17334 where NCG did not properly update the CFG. Statements can change the basic block in which instructions are placed during instruction selection. We have to keep track of this switch of the current basic block as we need this information in order to properly update the CFG. This commit implements this change and fixes #17334. We do so by having stmtToInstr return the new block id if a statement changed the basic block. - - - - - 1eda9f28 by Takenobu Tani at 2019-10-13T19:06:02-04:00 users-guide: Add GHCi's ::<builtin-command> form This commit explicitly adds description about double colon command of GHCi. [skip ci] - - - - - 27145351 by Takenobu Tani at 2019-10-13T19:06:40-04:00 Add GHCi help message for :def! and :: commands - - - - - 78463fc5 by Ryan Scott at 2019-10-14T08:38:36-04:00 Add docs/users_guide/.log to .gitignore When the users guide fails to build (as in #17346), a `docs/users_guide/.log` file will be generated with contents that look something like this: ``` WARNING: unknown config value 'latex_paper_size' in override, ignoring /home/rgscott/Software/ghc5/docs/users_guide/ghci.rst:3410: WARNING: u'ghc-flag' reference target not found: -pgmo ?option? /home/rgscott/Software/ghc5/docs/users_guide/ghci.rst:3410: WARNING: u'ghc-flag' reference target not found: -pgmo ?port? Encoding error: 'ascii' codec can't encode character u'\u27e8' in position 132: ordinal not in range(128) The full traceback has been saved in /tmp/sphinx-err-rDF2LX.log, if you want to report the issue to the developers. ``` This definitely should not be checked in to version control, so let's add this to `.gitignore`. - - - - - 4aba72d6 by Ryan Scott at 2019-10-14T08:39:12-04:00 Mention changes from #16980, #17213 in 8.10.1 release notes The fixes for these issues both have user-facing consequences, so it would be good to mention them in the release notes for GHC 8.10.1. While I'm in town, also mention `UnboxedSums` in the release notes entry related to `-fobject-code`. - - - - - 0ca044fd by Ben Gamari at 2019-10-14T08:39:48-04:00 gitlab-ci: Move hadrian-ghc-in-ghci job first This is a very cheap job and can catch a number of "easy" failure modes (e.g. missing imports in the compiler). Let's run it first. - - - - - a2d3594c by Ryan Scott at 2019-10-15T01:35:34-04:00 Refactor some cruft in TcDerivInfer.inferConstraints The latest installment in my quest to clean up the code in `TcDeriv*`. This time, my sights are set on `TcDerivInfer.inferConstraints`, which infers the context for derived instances. This function is a wee bit awkward at the moment: * It's not terribly obvious from a quick glance, but `inferConstraints` is only ever invoked when using the `stock` or `anyclass` deriving strategies, as the code for inferring the context for `newtype`- or `via`-derived instances is located separately in `mk_coerce_based_eqn`. But there's no good reason for things to be this way, so I moved this code from `mk_coerce_based_eqn` to `inferConstraints` so that everything related to inferring instance contexts is located in one place. * In this process, I discovered that the Haddocks for the auxiliary function `inferConstraintsDataConArgs` are completely wrong. It claims that it handles both `stock` and `newtype` deriving, but this is completely wrong, as discussed above—it only handles `stock`. To rectify this, I renamed this function to `inferConstraintsStock` to reflect its actual purpose and created a new `inferConstraintsCoerceBased` function to specifically handle `newtype` (and `via`) deriving. Doing this revealed some opportunities for further simplification: * Removing the context-inference–related code from `mk_coerce_based_eqn` made me realize that the overall structure of the function is basically identical to `mk_originative_eqn`. In fact, I was easily able to combine the two functions into a single `mk_eqn_from_mechanism` function. As part of this merger, I now invoke `atf_coerce_based_error_checks` from `doDerivInstErrorChecks1`. * I discovered that GHC defined this function: ```hs typeToTypeKind = liftedTypeKind `mkVisFunTy` liftedTypeKind ``` No fewer than four times in different modules. I consolidated all of these definitions in a single location in `TysWiredIn`. - - - - - 426b0ddc by Ryan Scott at 2019-10-15T01:36:14-04:00 Don't skip validity checks for built-in classes (#17355) Issue #17355 occurred because the control flow for `TcValidity.check_valid_inst_head` was structured in such a way that whenever it checked a special, built-in class (like `Generic` or `HasField`), it would skip the most important check of all: `checkValidTypePats`, which rejects nonsense like this: ```hs instance Generic (forall a. a) ``` This fixes the issue by carving out `checkValidTypePats` from `check_valid_inst_head` so that `checkValidTypePats` is always invoked. `check_valid_inst_head` has also been renamed to `check_special_inst_head` to reflect its new purpose of _only_ checking for instances headed by special classes. Fixes #17355. - - - - - a55b8a65 by Alp Mestanogullari at 2019-10-15T18:41:18-04:00 iface: export a few more functions from BinIface - - - - - 9c11f817 by Ben Gamari at 2019-10-15T18:41:54-04:00 hadrian: Add support for bindist compressors other than Xz Fixes #17351. - - - - - 535a88e1 by klebinger.andreas at gmx.at at 2019-10-16T07:04:21-04:00 Add loop level analysis to the NCG backend. For backends maintaining the CFG during codegen we can now find loops and their nesting level. This is based on the Cmm CFG and dominator analysis. As a result we can estimate edge frequencies a lot better for methods, resulting in far better code layout. Speedup on nofib: ~1.5% Increase in compile times: ~1.9% To make this feasible this commit adds: * Dominator analysis based on the Lengauer-Tarjan Algorithm. * An algorithm estimating global edge frequences from branch probabilities - In CFG.hs A few static branch prediction heuristics: * Expect to take the backedge in loops. * Expect to take the branch NOT exiting a loop. * Expect integer vs constant comparisons to be false. We also treat heap/stack checks special for branch prediction to avoid them being treated as loops. - - - - - cc2bda50 by adithyaov at 2019-10-16T07:05:01-04:00 Compiling with -S and -fno-code no longer panics (fixes #17143) - - - - - 19641957 by Takenobu Tani at 2019-10-16T07:05:41-04:00 testsuite: Add test for #8305 This is a test for the current algorithm of GHCi command name resolution. I add this test in preparation for updating GHCi command name resolution. For the current algorithm, see https://downloads.haskell.org/ghc/latest/docs/html/users_guide/ghci.html#the-ghci-files - - - - - 6ede3554 by Sebastian Graf at 2019-10-16T07:06:20-04:00 Infer rho-types instead of sigma-types in guard BindStmts and TransStmts In #17343 we saw that we didn't handle the pattern guard `!_ <- undefined` correctly: The `undefined` was never evaluated. Indeed, elaboration failed to insert the invisible type aruments to `undefined`. So `undefined` was trivially a normal-form and in turn never entered. The problem is that we used to infer a sigma-type for the RHS of the guard, the leading qualifiers of which will never be useful in a pattern match situation. Hence we infer a rho-type now. Fixes #17343. - - - - - 798037a1 by John Ericson at 2019-10-16T07:06:58-04:00 Delete ghctags cabal file It came back to life in 381c3ae31b68019177f1cd20cb4da2f9d3b7d6c6 by mistake. - - - - - 51fad9e6 by Richard Eisenberg at 2019-10-16T15:58:58-04:00 Break up TcRnTypes, among other modules. This introduces three new modules: - basicTypes/Predicate.hs describes predicates, moving this logic out of Type. Predicates don't really exist in Core, and so don't belong in Type. - typecheck/TcOrigin.hs describes the origin of constraints and types. It was easy to remove from other modules and can often be imported instead of other, scarier modules. - typecheck/Constraint.hs describes constraints as used in the solver. It is taken from TcRnTypes. No work other than module splitting is in this patch. This is the first step toward homogeneous equality, which will rely more strongly on predicates. And homogeneous equality is the next step toward a dependently typed core language. - - - - - 11d4fc50 by Ben Gamari at 2019-10-16T15:59:52-04:00 hadrian: Introduce enableDebugInfo flavour transformer Also refactor things a bit to eliminate repetition. - - - - - deb96399 by Ryan Scott at 2019-10-16T16:00:29-04:00 Make Coverage.TM a newtype - - - - - 42ebc3f6 by Brian Wignall at 2019-10-16T16:01:06-04:00 Add hyperlinks to PDF/HTML documentation; closes #17342 - - - - - b15a7fb8 by Ben Gamari at 2019-10-17T01:03:11-04:00 testsuite: Ensure that makefile tests get run Previously `makefile_test` and `run_command` tests could easily end up in a situation where they wouldn't be run if the user used the `only_ways` modifier. The reason is to build the set of a ways to run the test in we first start with a candidate set determined by the test type (e.g. `makefile_test`, `compile_run`, etc.) and then filter that set with the constraints given by the test's modifiers. `makefile_test` and `run_command` tests' candidate sets were simply `{normal}`, and consequently most uses of `only_ways` would result in the test being never run. To avoid this we rather use all ways as the candidate sets for these test types. This may result in a few more testcases than we would like (given that some `run_command` tests are insensitive to way) but this can be fixed by adding modifiers and we would much rather run too many tests than too few. This fixes #16042 and a number of other tests afflicted by the same issue. However, there were a few cases that required special attention: * `T14028` is currently failing and is therefore marked as broken due to #17300 * `T-signals-child` is fragile in the `threaded1` and `threaded2` ways (tracked in #17307) - - - - - 4efdda90 by Richard Eisenberg at 2019-10-17T01:03:51-04:00 Tiny fixes to comments around flattening. - - - - - c4c9904b by Ben Gamari at 2019-10-17T01:04:26-04:00 testsuite: Assert that testsuite ways are known This ensures that all testsuite way names given to `omit_ways`, `only_ways`, etc. are known ways. - - - - - 697be2b6 by Ömer Sinan Ağacan at 2019-10-18T15:26:53-04:00 rts/GC: Add an obvious assertion during block initialization Namely ensure that block descriptors are initialized with valid generation numbers. Co-Authored-By: Ben Gamari <ben at well-typed.com> - - - - - 61d2ed42 by Ben Gamari at 2019-10-18T15:26:53-04:00 rts: Add Note explaining applicability of selector optimisation depth limit This was slightly non-obvious so a note seems deserved. - - - - - 11395037 by Ben Gamari at 2019-10-18T15:26:53-04:00 rts/Capability: A few documentation comments - - - - - 206f782a by Ben Gamari at 2019-10-18T15:26:53-04:00 rts: Give stack flags proper macros This were previously quite unclear and will change a bit under the non-moving collector so let's clear this up now. - - - - - 81d4675e by Ben Gamari at 2019-10-18T15:26:53-04:00 rts/GC: Refactor gcCAFs - - - - - 4d674c4e by Ben Gamari at 2019-10-18T15:26:53-04:00 rts: Fix macro parenthesisation - - - - - bfcafd39 by Ben Gamari at 2019-10-18T15:27:42-04:00 rts/Schedule: Allow synchronization without holding a capability The concurrent mark-and-sweep will be performed by a GHC task which will not hold a capability. This is necessary to avoid a concurrent mark from interfering with minor generation collections. However, the major collector must synchronize with the mutators at the end of marking to flush their update remembered sets. This patch extends the `requestSync` mechanism used to synchronize garbage collectors to allow synchronization without holding a capability. This change is fairly straightforward as the capability was previously only required for two reasons: 1. to ensure that we don't try to re-acquire a capability that we the sync requestor already holds. 2. to provide a way to suspend and later resume the sync request if there is already a sync pending. When synchronizing without holding a capability we needn't worry about consideration (1) at all. (2) is slightly trickier and may happen, for instance, when a capability requests a minor collection and shortly thereafter the non-moving mark thread requests a post-mark synchronization. In this case we need to ensure that the non-moving mark thread suspends his request until after the minor GC has concluded to avoid dead-locking. For this we introduce a condition variable, `sync_finished_cond`, which a non-capability-bearing requestor will wait on and which is signalled after a synchronization or GC has finished. - - - - - 921e4e36 by Ömer Sinan Ağacan at 2019-10-18T15:27:56-04:00 rts/BlockAlloc: Allow aligned allocation requests This implements support for block group allocations which are aligned to an integral number of blocks. This will be used by the nonmoving garbage collector, which uses the block allocator to allocate the segments which back its heap. These segments are a fixed number of blocks in size, with each segment being aligned to the segment size boundary. This allows us to easily find the segment metadata stored at the beginning of the segment. - - - - - 4b431f33 by Tamar Christina at 2019-10-20T16:21:10+01:00 Windows: Update tarballs to GCC 9.2 and remove MAX_PATH limit. - - - - - 8057ac96 by Ben Gamari at 2019-10-20T21:15:14-04:00 Merge branches 'wip/gc/sync-without-capability' and 'wip/gc/aligned-block-allocation' into wip/gc/preparation - - - - - 32500f64 by Ömer Sinan Ağacan at 2019-10-20T21:15:37-04:00 rts/StableName: Expose FOR_EACH_STABLE_NAME, freeSnEntry, SNT_size These will be needed when we implement sweeping in the nonmoving collector. - - - - - 4be5152a by Ben Gamari at 2019-10-20T21:15:37-04:00 rts: Disable aggregate-return warnings from gcc This warning is a bit of a relic; there is little reason to avoid aggregate return values in 2019. - - - - - 04471c4f by Ömer Sinan Ağacan at 2019-10-20T21:15:37-04:00 rts/Scav: Expose scavenging functions To keep the non-moving collector nicely separated from the moving collector its scavenging phase will live in another file, `NonMovingScav.c`. However, it will need to use these functions so let's expose them. - - - - - 6ff29c06 by Ben Gamari at 2019-10-20T21:15:37-04:00 rts: Introduce flag to enable the nonmoving old generation This flag will enable the use of a non-moving oldest generation. - - - - - b3ef2d1a by Ben Gamari at 2019-10-20T21:15:37-04:00 rts: Introduce debug flag for non-moving GC - - - - - 68e0647f by Ömer Sinan Ağacan at 2019-10-20T21:15:37-04:00 rts: Non-concurrent mark and sweep This implements the core heap structure and a serial mark/sweep collector which can be used to manage the oldest-generation heap. This is the first step towards a concurrent mark-and-sweep collector aimed at low-latency applications. The full design of the collector implemented here is described in detail in a technical note B. Gamari. "A Concurrent Garbage Collector For the Glasgow Haskell Compiler" (2018) The basic heap structure used in this design is heavily inspired by K. Ueno & A. Ohori. "A fully concurrent garbage collector for functional programs on multicore processors." /ACM SIGPLAN Notices/ Vol. 51. No. 9 (presented by ICFP 2016) This design is intended to allow both marking and sweeping concurrent to execution of a multi-core mutator. Unlike the Ueno design, which requires no global synchronization pauses, the collector introduced here requires a stop-the-world pause at the beginning and end of the mark phase. To avoid heap fragmentation, the allocator consists of a number of fixed-size /sub-allocators/. Each of these sub-allocators allocators into its own set of /segments/, themselves allocated from the block allocator. Each segment is broken into a set of fixed-size allocation blocks (which back allocations) in addition to a bitmap (used to track the liveness of blocks) and some additional metadata (used also used to track liveness). This heap structure enables collection via mark-and-sweep, which can be performed concurrently via a snapshot-at-the-beginning scheme (although concurrent collection is not implemented in this patch). The mark queue is a fairly straightforward chunked-array structure. The representation is a bit more verbose than a typical mark queue to accomodate a combination of two features: * a mark FIFO, which improves the locality of marking, reducing one of the major overheads seen in mark/sweep allocators (see [1] for details) * the selector optimization and indirection shortcutting, which requires that we track where we found each reference to an object in case we need to update the reference at a later point (e.g. when we find that it is an indirection). See Note [Origin references in the nonmoving collector] (in `NonMovingMark.h`) for details. Beyond this the mark/sweep is fairly run-of-the-mill. [1] R. Garner, S.M. Blackburn, D. Frampton. "Effective Prefetch for Mark-Sweep Garbage Collection." ISMM 2007. Co-Authored-By: Ben Gamari <ben at well-typed.com> - - - - - c7e73d12 by Ben Gamari at 2019-10-20T21:15:37-04:00 testsuite: Add nonmoving WAY This simply runs the compile_and_run tests with `-xn`, enabling the nonmoving oldest generation. - - - - - f8f77a07 by Ben Gamari at 2019-10-20T21:15:37-04:00 rts: Mark binder as const - - - - - bd8e3ff4 by Ben Gamari at 2019-10-20T21:15:52-04:00 rts: Implement concurrent collection in the nonmoving collector This extends the non-moving collector to allow concurrent collection. The full design of the collector implemented here is described in detail in a technical note B. Gamari. "A Concurrent Garbage Collector For the Glasgow Haskell Compiler" (2018) This extension involves the introduction of a capability-local remembered set, known as the /update remembered set/, which tracks objects which may no longer be visible to the collector due to mutation. To maintain this remembered set we introduce a write barrier on mutations which is enabled while a concurrent mark is underway. The update remembered set representation is similar to that of the nonmoving mark queue, being a chunked array of `MarkEntry`s. Each `Capability` maintains a single accumulator chunk, which it flushed when it (a) is filled, or (b) when the nonmoving collector enters its post-mark synchronization phase. While the write barrier touches a significant amount of code it is conceptually straightforward: the mutator must ensure that the referee of any pointer it overwrites is added to the update remembered set. However, there are a few details: * In the case of objects with a dirty flag (e.g. `MVar`s) we can exploit the fact that only the *first* mutation requires a write barrier. * Weak references, as usual, complicate things. In particular, we must ensure that the referee of a weak object is marked if dereferenced by the mutator. For this we (unfortunately) must introduce a read barrier, as described in Note [Concurrent read barrier on deRefWeak#] (in `NonMovingMark.c`). * Stable names are also a bit tricky as described in Note [Sweeping stable names in the concurrent collector] (`NonMovingSweep.c`). We take quite some pains to ensure that the high thread count often seen in parallel Haskell applications doesn't affect pause times. To this end we allow thread stacks to be marked either by the thread itself (when it is executed or stack-underflows) or the concurrent mark thread (if the thread owning the stack is never scheduled). There is a non-trivial handshake to ensure that this happens without racing which is described in Note [StgStack dirtiness flags and concurrent marking]. Co-Authored-by: Ömer Sinan Ağacan <omer at well-typed.com> - - - - - dd1b4fdd by Ben Gamari at 2019-10-20T21:15:52-04:00 Nonmoving: Disable memory inventory with concurrent collection - - - - - 4a44ab33 by Ben Gamari at 2019-10-20T21:15:52-04:00 rts: Shrink size of STACK's dirty and marking fields - - - - - 10373416 by Ben Gamari at 2019-10-20T21:15:52-04:00 Don't cleanup until we've stopped the collector This requires that we break nonmovingExit into two pieces since we need to first stop the collector to relinquish any capabilities, then we need to shutdown the scheduler, then we need to free the nonmoving allocators. - - - - - 26c3827f by Ben Gamari at 2019-10-21T11:43:54-04:00 Nonmoving: Ensure write barrier vanishes in non-threaded RTS - - - - - 17e5a032 by Ben Gamari at 2019-10-21T11:43:54-04:00 ThreadPaused: Add barrer on updated thunk - - - - - 8ea316da by David Eichmann at 2019-10-22T02:07:48-04:00 CI: Always dump performance metrics. - - - - - aa31ceaf by Matthew Bauer at 2019-10-22T02:39:01-04:00 Replace freebsd-gnueabihf with freebsd FreeBSD does not support GNU libc, so it makes no sense to use this triple. Most likely previous builds were just using the FreeBSD libc instead of gnueabihf. To fix this, we should just use armv6-unknown-freebsd and armv7-unknown-freebsd triples. Note that both of these are actually "soft-float", not "hard-float". FreeBSD has never officially released hard-float arm32: https://wiki.freebsd.org/ARMTier1 - - - - - fd8b666a by Stefan Schulze Frielinghaus at 2019-10-22T02:39:03-04:00 Implement s390x LLVM backend. This patch adds support for the s390x architecture for the LLVM code generator. The patch includes a register mapping of STG registers onto s390x machine registers which enables a registerised build. - - - - - 2d2cc76f by Tilman Blumhagen at 2019-10-22T02:39:04-04:00 Documentation for (&&) and (&&) states that they are lazy in their second argument (fixes #17354) - - - - - 06d51c4e by Ben Gamari at 2019-10-22T12:13:36-04:00 Fix unregisterised build This required some fiddling around with the location of forward declarations since the C sources generated by GHC's C backend only includes Stg.h. - - - - - 912e440e by Ben Gamari at 2019-10-22T12:17:00-04:00 rts: Tracing support for nonmoving collection events This introduces a few events to mark key points in the nonmoving garbage collection cycle. These include: * `EVENT_CONC_MARK_BEGIN`, denoting the beginning of a round of marking. This may happen more than once in a single major collection since we the major collector iterates until it hits a fixed point. * `EVENT_CONC_MARK_END`, denoting the end of a round of marking. * `EVENT_CONC_SYNC_BEGIN`, denoting the beginning of the post-mark synchronization phase * `EVENT_CONC_UPD_REM_SET_FLUSH`, indicating that a capability has flushed its update remembered set. * `EVENT_CONC_SYNC_END`, denoting that all mutators have flushed their update remembered sets. * `EVENT_CONC_SWEEP_BEGIN`, denoting the beginning of the sweep portion of the major collection. * `EVENT_CONC_SWEEP_END`, denoting the end of the sweep portion of the major collection. - - - - - 9f42cd81 by Ben Gamari at 2019-10-22T12:17:00-04:00 rts: Introduce non-moving heap census This introduces a simple census of the non-moving heap (not to be confused with the heap census used by the heap profiler). This collects basic heap usage information (number of allocated and free blocks) which is useful when characterising fragmentation of the nonmoving heap. - - - - - 711837cc by Ben Gamari at 2019-10-22T12:17:00-04:00 rts/Eventlog: More descriptive error message - - - - - 0d31819e by Ben Gamari at 2019-10-22T12:17:00-04:00 Allow census without live word count Otherwise the census is unsafe when mutators are running due to concurrent mutation. - - - - - 6f173181 by Ben Gamari at 2019-10-22T12:17:00-04:00 NonmovingCensus: Emit samples to eventlog - - - - - 13dd78dd by Ben Gamari at 2019-10-22T12:18:33-04:00 Nonmoving: Allow aging and refactor static objects logic This commit does two things: * Allow aging of objects during the preparatory minor GC * Refactor handling of static objects to avoid the use of a hashtable - - - - - 7b79e8b4 by Ben Gamari at 2019-10-22T12:18:33-04:00 Disable aging when doing deadlock detection GC - - - - - 8fffe12b by Ben Gamari at 2019-10-22T12:18:33-04:00 More comments for aging - - - - - 039d2906 by Ben Gamari at 2019-10-22T12:18:39-04:00 NonMoving: Eliminate integer division in nonmovingBlockCount Perf showed that the this single div was capturing up to 10% of samples in nonmovingMark. However, the overwhelming majority of cases is looking at small block sizes. These cases we can easily compute explicitly, allowing the compiler to turn the division into a significantly more efficient division-by-constant. While the increase in source code looks scary, this all optimises down to very nice looking assembler. At this point the only remaining hotspots in nonmovingBlockCount are due to memory access. - - - - - d15ac82d by Ben Gamari at 2019-10-22T12:18:39-04:00 NonMoving: Allocate mark queues in larger block groups - - - - - 26d2d331 by Ben Gamari at 2019-10-22T12:18:39-04:00 NonMovingMark: Optimize representation of mark queue This shortens MarkQueueEntry by 30% (one word) - - - - - e5eda61e by Ben Gamari at 2019-10-22T12:18:39-04:00 NonMoving: Optimize bitmap search during allocation Use memchr instead of a open-coded loop. This is nearly twice as fast in a synthetic benchmark. - - - - - dacf4cae by Ben Gamari at 2019-10-22T12:18:39-04:00 rts: Add prefetch macros - - - - - 786c52d2 by Ben Gamari at 2019-10-22T12:18:39-04:00 NonMoving: Prefetch when clearing bitmaps Ensure that the bitmap of the segmentt that we will clear next is in cache by the time we reach it. - - - - - 0387df5b by Ben Gamari at 2019-10-22T12:18:39-04:00 NonMoving: Inline nonmovingClearAllBitmaps - - - - - e893877e by Ben Gamari at 2019-10-22T12:18:39-04:00 NonMoving: Fuse sweep preparation into mark prep - - - - - e6f6823f by Ben Gamari at 2019-10-22T12:18:39-04:00 NonMoving: Pre-fetch during mark This improved overall runtime on nofib's constraints test by nearly 10%. - - - - - 56c5ebdc by Ben Gamari at 2019-10-22T12:18:39-04:00 NonMoving: Prefetch segment header - - - - - 19bfe460 by Ben Gamari at 2019-10-22T12:18:39-04:00 NonMoving: Optimise allocator cache behavior Previously we would look at the segment header to determine the block size despite the fact that we already had the block size at hand. - - - - - 53a1a27e by Ben Gamari at 2019-10-22T12:18:39-04:00 NonMovingMark: Eliminate redundant check_in_nonmoving_heaps - - - - - b967e470 by Ben Gamari at 2019-10-22T12:18:39-04:00 NonMoving: Don't do major GC if one is already running Previously we would perform a preparatory moving collection, resulting in many things being added to the mark queue. When we finished with this we would realize in nonmovingCollect that there was already a collection running, in which case we would simply not run the nonmoving collector. However, it was very easy to end up in a "treadmilling" situation: all subsequent GC following the first failed major GC would be scheduled as major GCs. Consequently we would continuously feed the concurrent collector with more mark queue entries and it would never finish. This patch aborts the major collection far earlier, meaning that we avoid adding nonmoving objects to the mark queue and allowing the concurrent collector to finish. - - - - - 3bc172a4 by Ben Gamari at 2019-10-22T12:18:39-04:00 NonMoving: Clean mut_list - - - - - 8e79e2a9 by Ben Gamari at 2019-10-22T12:18:39-04:00 Unconditionally flush update remembered set during minor GC Flush the update remembered set. The goal here is to flush periodically to ensure that we don't end up with a thread who marks their stack on their local update remembered set and doesn't flush until the nonmoving sync period as this would result in a large fraction of the heap being marked during the sync pause. - - - - - b281e80b by Ben Gamari at 2019-10-22T12:18:44-04:00 testsuite: Add nonmoving_thr way - - - - - 07987957 by Ben Gamari at 2019-10-22T12:18:44-04:00 testsuite: Add nonmoving_thr_ghc way This uses the nonmoving collector when compiling the testcases. - - - - - 01fd0242 by Ben Gamari at 2019-10-22T12:18:44-04:00 testsuite: Don't run T15892 in nonmoving ways The nonmoving GC doesn't support `+RTS -G1`, which this test insists on. - - - - - 097f4fd0 by Ben Gamari at 2019-10-22T12:18:44-04:00 testsuite: Nonmoving collector doesn't support -G1 - - - - - 4b91dd25 by Ben Gamari at 2019-10-22T12:18:44-04:00 testsuite: Ensure that threaded tests are run in nonmoving_thr - - - - - 78ce35b9 by Ben Gamari at 2019-10-22T12:18:44-04:00 testsuite: bug1010 requires -c, which isn't supported by nonmoving - - - - - 6e97cc47 by Ben Gamari at 2019-10-22T12:18:44-04:00 testsuite: Skip T15892 in nonmoving_thr_ghc - - - - - 5ce853c8 by Ben Gamari at 2019-10-22T12:18:44-04:00 ghc-heap: Skip heap_all test with debugged RTS The debugged RTS initializes the heap with 0xaa, which breaks the (admittedly rather fragile) assumption that uninitialized fields are set to 0x00: ``` Wrong exit code for heap_all(nonmoving)(expected 0 , actual 1 ) Stderr ( heap_all ): heap_all: user error (assertClosuresEq: Closures do not match Expected: FunClosure {info = StgInfoTable {entry = Nothing, ptrs = 0, nptrs = 1, tipe = FUN_0_1, srtlen = 0, code = Nothing}, ptrArgs = [], dataArgs = [0]} Actual: FunClosure {info = StgInfoTable {entry = Nothing, ptrs = 0, nptrs = 1, tipe = FUN_0_1, srtlen = 1032832, code = Nothing}, ptrArgs = [], dataArgs = [12297829382473034410]} CallStack (from HasCallStack): assertClosuresEq, called at heap_all.hs:230:9 in main:Main ) ``` - - - - - 6abefce7 by Ben Gamari at 2019-10-22T12:18:44-04:00 Skip ghc_heap_all test in nonmoving ways - - - - - 99baff8c by Ben Gamari at 2019-10-22T12:18:44-04:00 testsuite: Don't run T9630 in nonmoving ways The nonmoving collector doesn't support -G1 - - - - - 25ae8f7d by Ben Gamari at 2019-10-22T12:18:44-04:00 testsuite: Don't run T7160 in nonmoving_thr ways The nonmoving way finalizes things in a different order. - - - - - 8cab149b by Ben Gamari at 2019-10-22T12:18:44-04:00 testsuite: Mark length001 as failing under nonmoving ways This is consistent with the other unoptimized ways. - - - - - 5b130b3d by Ben Gamari at 2019-10-22T12:18:46-04:00 Merge branches 'wip/gc/optimize' and 'wip/gc/test' into wip/gc/everything - - - - - 246ce2af by Ömer Sinan Ağacan at 2019-10-22T12:20:15-04:00 NonMoving: Implement indirection shortcutting This allows indirection chains residing in the non-moving heap to be shorted-out. - - - - - 875861ef by Ömer Sinan Ağacan at 2019-10-22T12:20:15-04:00 NonMoving: Implement selector optimisation - - - - - c72e84c6 by Ben Gamari at 2019-10-22T12:20:15-04:00 NonMovingMark: Handle INDs left by shortcutting - - - - - 0f8fd3c6 by Ömer Sinan Ağacan at 2019-10-22T12:20:15-04:00 NonMoving: Implement -xns to disable selector optimization - - - - - c936a245 by Ben Gamari at 2019-10-22T12:20:37-04:00 NonMoving: Introduce nonmovingSegmentLogBlockSize acccessor This will allow us to easily move the block size elsewhere. - - - - - 6dcef5ee by Ben Gamari at 2019-10-22T12:20:37-04:00 NonMoving: Move block size to block descriptor - - - - - dd8d1b49 by Ben Gamari at 2019-10-22T12:20:37-04:00 NonMoving: Move next_free_snap to block descriptor - - - - - 116e4646 by Ben Gamari at 2019-10-22T12:20:46-04:00 NonMoving: Add summarizing Note - - - - - 22eee2bc by Ben Gamari at 2019-10-22T12:20:48-04:00 Merge branches 'wip/gc/segment-header-to-bdescr' and 'wip/gc/docs' into wip/gc/everything2 - - - - - 3a862703 by Ömer Sinan Ağacan at 2019-10-22T18:56:32-04:00 rts: COMPACT_NFDATA support for the nonmoving collector This largely follows the model used for large objects, with appropriate adjustments made to account for references in the sharing deduplication hashtable. - - - - - 7c35d39b by Ben Gamari at 2019-10-22T18:56:32-04:00 rts: Mark nonmoving GC paths in moving collector as unlikely The expectation here is that the nonmoving GC is latency-centric, whereas the moving GC emphasizes throughput. Therefore we give the latter the benefit of better static branch prediction. - - - - - 91109404 by Ben Gamari at 2019-10-22T18:57:27-04:00 nonmoving: Trace GC preparation steps - - - - - a69b28f4 by Ben Gamari at 2019-10-22T18:57:27-04:00 nonmoving: Don't do two passes over large and compact object lists Previously we would first move the new objects to their appropriate non-moving GC list, then do another pass over that list to clear their mark bits. This is needlessly expensive. First clear the mark bits of the existing objects, then add the newly evacuated objects and, at the same time, clear their mark bits. This cuts the preparatory GC time in half for the Pusher benchmark with a large queue size. - - - - - 984745b0 by Ben Gamari at 2019-10-22T18:57:27-04:00 nonmoving: Upper-bound time we hold SM_MUTEX for during sweep - - - - - 96c5411a by David Feuer at 2019-10-23T05:58:37-04:00 Use an IORef for QSemN Replace the outer `MVar` in `QSemN` with an `IORef`. This should probably be lighter, and it removes the need for `uninterruptibleMask`. Previously Differential Revision https://phabricator.haskell.org/D4896 - - - - - faa30dcb by Andreas Klebinger at 2019-10-23T05:58:43-04:00 Warn about missing profiled libs when using the Interpreter. When GHC itself, or it's interpreter is profiled we need to load profiled libraries as well. This requirement is not always obvious, especially when TH implicilty uses the interpreter. When the libs were not found we fall back to assuming the are in a DLL. This is usually not the case so now we warn users when we do so. This makes it more obvious what is happening and gives users a way to fix the issue. This fixes #17121. - - - - - 1cd3fa29 by Richard Eisenberg at 2019-10-23T05:58:46-04:00 Implement a coverage checker for injectivity This fixes #16512. There are lots of parts of this patch: * The main payload is in FamInst. See Note [Coverage condition for injective type families] there for the overview. But it doesn't fix the bug. * We now bump the reduction depth every time we discharge a CFunEqCan. See Note [Flatten when discharging CFunEqCan] in TcInteract. * Exploration of this revealed a new, easy to maintain invariant for CTyEqCans. See Note [Almost function-free] in TcRnTypes. * We also realized that type inference for injectivity was a bit incomplete. This means we exchanged lookupFlattenTyVar for rewriteTyVar. See Note [rewriteTyVar] in TcFlatten. The new function is monadic while the previous one was pure, necessitating some faff in TcInteract. Nothing too bad. * zonkCt did not maintain invariants on CTyEqCan. It's not worth the bother doing so, so we just transmute CTyEqCans to CNonCanonicals. * The pure unifier was finding the fixpoint of the returned substitution, even when doing one-way matching (in tcUnifyTysWithTFs). Fixed now. Test cases: typecheck/should_fail/T16512{a,b} - - - - - 900cf195 by Alp Mestanogullari at 2019-10-23T05:58:48-04:00 compiler: introduce DynFlags plugins They have type '[CommandLineOpts] -> Maybe (DynFlags -> IO DynFlags)'. All plugins that supply a non-Nothing 'dynflagsPlugin' will see their updates applied to the current DynFlags right after the plugins are loaded. One use case for this is to superseede !1580 for registering hooks from a plugin. Frontend/parser plugins were considered to achieve this but they respectively conflict with how this plugin is going to be used and don't allow overriding/modifying the DynFlags, which is how hooks have to be registered. This commit comes with a test, 'test-hook-plugin', that registers a "fake" meta hook that replaces TH expressions with the 0 integer literal. - - - - - a19c7d17 by Ryan Scott at 2019-10-23T05:58:49-04:00 Reify oversaturated data family instances correctly (#17296) `TcSplice` was not properly handling oversaturated data family instances, such as the example in #17296, as it dropped arguments due to carelessly zipping data family instance arguments with `tyConTyVars`. For data families, the number of `tyConTyVars` can sometimes be less than the number of arguments it can accept in a data family instance due to the fact that data family instances can be oversaturated. To account for this, `TcSplice.mkIsPolyTvs` has now been renamed to `tyConArgsPolyKinded` and now factors in `tyConResKind` in addition to `tyConTyVars`. I've also added `Note [Reified instances and explicit kind signatures]` which explains the various subtleties in play here. Fixes #17296. - - - - - 9b2a5008 by Ben Gamari at 2019-10-23T05:58:50-04:00 testsuite: Don't run T7653 in ghci and profiled ways Currently this routinely fails in the i386 job. See #7653. - - - - - b521e8b6 by Ömer Sinan Ağacan at 2019-10-23T05:58:57-04:00 Refactor Compact.c: - Remove forward declarations - Introduce UNTAG_PTR and GET_PTR_TAG for dealing with pointer tags without having to cast arguments to StgClosure* - Remove dead code - Use W_ instead of StgWord - Use P_ instead of StgPtr - - - - - 17987a4b by Matthew Pickering at 2019-10-23T05:58:58-04:00 eventlog: Dump cost centre stack on each sample With this change it is possible to reconstruct the timing portion of a `.prof` file after the fact. By logging the stacks at each time point a more precise executation trace of the program can be observed rather than all identical cost centres being identified in the report. There are two new events: 1. `EVENT_PROF_BEGIN` - emitted at the start of profiling to communicate the tick interval 2. `EVENT_PROF_SAMPLE_COST_CENTRE` - emitted on each tick to communicate the current call stack. Fixes #17322 - - - - - 4798f3b9 by Takenobu Tani at 2019-10-23T05:59:00-04:00 Allow command name resolution for GHCi commands with option `!` #17345 This commit allows command name resolution for GHCi commands with option `!` as follows: ghci> :k! Int Int :: * = Int This commit changes implementation as follows: Before: * Prefix match with full string including the option `!` (e.g. `k!`) After (this patch): * Prefix match without option suffix `!` (e.g. `k`) * in addition, suffix match with option `!` See also #8305 and #8113 - - - - - aa778152 by Andreas Klebinger at 2019-10-23T05:59:01-04:00 Fix bug in the x86 backend involving the CFG. This is part two of fixing #17334. There are two parts to this commit: - A bugfix for computing loop levels - A bugfix of basic block invariants in the NCG. ----------------------------------------------------------- In the first bug we ended up with a CFG of the sort: [A -> B -> C] This was represented via maps as fromList [(A,B),(B,C)] and later transformed into a adjacency array. However the transformation did not include block C in the array (since we only looked at the keys of the map). This was still fine until we tried to look up successors for C and tried to read outside of the array bounds when accessing C. In order to prevent this in the future I refactored to code to include all nodes as keys in the map representation. And make this a invariant which is checked in a few places. Overall I expect this to make the code more robust as now any failed lookup will represent an error, versus failed lookups sometimes being expected and sometimes not. In terms of performance this makes some things cheaper (getting a list of all nodes) and others more expensive (adding a new edge). Overall this adds up to no noteable performance difference. ----------------------------------------------------------- Part 2: When the NCG generated a new basic block, it did not always insert a NEWBLOCK meta instruction in the stream which caused a quite subtle bug. During instruction selection a statement `s` in a block B with control of the sort: B -> C will sometimes result in control flow of the sort: ┌ < ┐ v ^ B -> B1 ┴ -> C as is the case for some atomic operations. Now to keep the CFG in sync when introducing B1 we clearly want to insert it between B and C. However there is a catch when we have to deal with self loops. We might start with code and a CFG of these forms: loop: stmt1 ┌ < ┐ .... v ^ stmtX loop ┘ stmtY .... goto loop: Now we introduce B1: ┌ ─ ─ ─ ─ ─┐ loop: │ ┌ < ┐ │ instrs v │ │ ^ .... loop ┴ B1 ┴ ┘ instrsFromX stmtY goto loop: This is simple, all outgoing edges from loop now simply start from B1 instead and the code generator knows which new edges it introduced for the self loop of B1. Disaster strikes if the statement Y follows the same pattern. If we apply the same rule that all outgoing edges change then we end up with: loop ─> B1 ─> B2 ┬─┐ │ │ └─<┤ │ │ └───<───┘ │ └───────<────────┘ This is problematic. The edge B1->B1 is modified as expected. However the modification is wrong! The assembly in this case looked like this: _loop: <instrs> _B1: ... cmpxchgq ... jne _B1 <instrs> <end _B1> _B2: ... cmpxchgq ... jne _B2 <instrs> jmp loop There is no edge _B2 -> _B1 here. It's still a self loop onto _B1. The problem here is that really B1 should be two basic blocks. Otherwise we have control flow in the *middle* of a basic block. A contradiction! So to account for this we add yet another basic block marker: _B: <instrs> _B1: ... cmpxchgq ... jne _B1 jmp _B1' _B1': <instrs> <end _B1> _B2: ... Now when inserting B2 we will only look at the outgoing edges of B1' and everything will work out nicely. You might also wonder why we don't insert jumps at the end of _B1'. There is no way another block ends up jumping to the labels _B1 or _B2 since they are essentially invisible to other blocks. View them as control flow labels local to the basic block if you'd like. Not doing this ultimately caused (part 2 of) #17334. - - - - - 1f40e68a by Ryan Yates at 2019-10-23T05:59:03-04:00 Full abort on validate failure merging `orElse`. Previously partial roll back of a branch of an `orElse` was attempted if validation failure was observed. Validation here, however, does not account for what part of the transaction observed inconsistent state. This commit fixes this by fully aborting and restarting the transaction. - - - - - 9c1f0f7c by Ben Gamari at 2019-10-23T05:59:03-04:00 Bump stm submodule - - - - - 6beea836 by Andreas Klebinger at 2019-10-23T05:59:04-04:00 Make dynflag argument for withTiming pure. 19 times out of 20 we already have dynflags in scope. We could just always use `return dflags`. But this is in fact not free. When looking at some STG code I noticed that we always allocate a closure for this expression in the heap. Clearly a waste in these cases. For the other cases we can either just modify the callsite to get dynflags or use the _D variants of withTiming I added which will use getDynFlags under the hood. - - - - - 8dd480cc by Matthew Pickering at 2019-10-23T05:59:06-04:00 Performance tests: Reduce acceptance threshold for bytes allocated tests The "new" performance testing infrastructure resets the baseline after every test so it's easy to miss gradual performance regressions over time. We should at least make these numbers smaller to catch patches which affect performance earlier. - - - - - 4af20bbc by Ben Gamari at 2019-10-23T05:59:06-04:00 users-guide: Fix :since: for -Wunused-packages Fixes #17382. - - - - - 21663693 by Ben Gamari at 2019-10-23T05:59:07-04:00 Drop duplicate -optl's from GHC invocations Previously the make build system would pass things like `-optl-optl-Wl,-x -optl-optl-Wl,noexecstack` to GHC. This would naturally result in mass confusion as GHC would pass `-optl-Wl,-x` to GCC. GCC would in turn interpret this as `-o ptl-Wl,-x`, setting the output pass of the invocation. The problem that `-optl` was added to the command-line in two places in the build system. Fix this. Fixes #17385. - - - - - bb0dc5a5 by Andreas Klebinger at 2019-10-23T05:59:07-04:00 Hadrian: Invoke ghc0 via bash when running tests to fix #17362. cmd uses RawCommand which uses Windows semantics to find the executable which sometimes seems to fail for unclear reasons. If we invoke ghc via bash then bash will find the ghc executable and the issue goes away. - - - - - 266435a7 by Ömer Sinan Ağacan at 2019-10-23T05:59:09-04:00 Add new flag for unarised STG dumps Previously -ddump-stg would dump pre and post-unarise STGs. Now we have a new flag for post-unarise STG and -ddump-stg only dumps coreToStg output. STG dump flags after this commit: - -ddump-stg: Dumps CoreToStg output - -ddump-stg-unarised: Unarise output - -ddump-stg-final: STG right before code gen (includes CSE and lambda lifting) - - - - - 8abddac8 by Ben Gamari at 2019-10-23T05:59:10-04:00 base: Add @since on GHC.IO.Handle.Lock.hUnlock Unfortunately this was introduced in base-4.11.0 (GHC 8.4.1) whereas the other locking primitives were added in base-4.10.0 (GHC 8.2.1). - - - - - 7f72b540 by Ben Gamari at 2019-10-23T14:56:46-04:00 Merge non-moving garbage collector This introduces a concurrent mark & sweep garbage collector to manage the old generation. The concurrent nature of this collector typically results in significantly reduced maximum and mean pause times in applications with large working sets. Due to the large and intricate nature of the change I have opted to preserve the fully-buildable history, including merge commits, which is described in the "Branch overview" section below. Collector design ================ The full design of the collector implemented here is described in detail in a technical note > B. Gamari. "A Concurrent Garbage Collector For the Glasgow Haskell > Compiler" (2018) This document can be requested from @bgamari. The basic heap structure used in this design is heavily inspired by > K. Ueno & A. Ohori. "A fully concurrent garbage collector for > functional programs on multicore processors." /ACM SIGPLAN Notices/ > Vol. 51. No. 9 (presented at ICFP 2016) This design is intended to allow both marking and sweeping concurrent to execution of a multi-core mutator. Unlike the Ueno design, which requires no global synchronization pauses, the collector introduced here requires a stop-the-world pause at the beginning and end of the mark phase. To avoid heap fragmentation, the allocator consists of a number of fixed-size /sub-allocators/. Each of these sub-allocators allocators into its own set of /segments/, themselves allocated from the block allocator. Each segment is broken into a set of fixed-size allocation blocks (which back allocations) in addition to a bitmap (used to track the liveness of blocks) and some additional metadata (used also used to track liveness). This heap structure enables collection via mark-and-sweep, which can be performed concurrently via a snapshot-at-the-beginning scheme (although concurrent collection is not implemented in this patch). Implementation structure ======================== The majority of the collector is implemented in a handful of files: * `rts/Nonmoving.c` is the heart of the beast. It implements the entry-point to the nonmoving collector (`nonmoving_collect`), as well as the allocator (`nonmoving_allocate`) and a number of utilities for manipulating the heap. * `rts/NonmovingMark.c` implements the mark queue functionality, update remembered set, and mark loop. * `rts/NonmovingSweep.c` implements the sweep loop. * `rts/NonmovingScav.c` implements the logic necessary to scavenge the nonmoving heap. Branch overview =============== ``` * wip/gc/opt-pause: | A variety of small optimisations to further reduce pause times. | * wip/gc/compact-nfdata: | Introduce support for compact regions into the non-moving |\ collector | \ | \ | | * wip/gc/segment-header-to-bdescr: | | | Another optimization that we are considering, pushing | | | some segment metadata into the segment descriptor for | | | the sake of locality during mark | | | | * | wip/gc/shortcutting: | | | Support for indirection shortcutting and the selector optimization | | | in the non-moving heap. | | | * | | wip/gc/docs: | |/ Work on implementation documentation. | / |/ * wip/gc/everything: | A roll-up of everything below. |\ | \ | |\ | | \ | | * wip/gc/optimize: | | | A variety of optimizations, primarily to the mark loop. | | | Some of these are microoptimizations but a few are quite | | | significant. In particular, the prefetch patches have | | | produced a nontrivial improvement in mark performance. | | | | | * wip/gc/aging: | | | Enable support for aging in major collections. | | | | * | wip/gc/test: | | | Fix up the testsuite to more or less pass. | | | * | | wip/gc/instrumentation: | | | A variety of runtime instrumentation including statistics | | / support, the nonmoving census, and eventlog support. | |/ | / |/ * wip/gc/nonmoving-concurrent: | The concurrent write barriers. | * wip/gc/nonmoving-nonconcurrent: | The nonmoving collector without the write barriers necessary | for concurrent collection. | * wip/gc/preparation: | A merge of the various preparatory patches that aren't directly | implementing the GC. | | * GHC HEAD . . . ``` - - - - - 83655b06 by Ben Gamari at 2019-10-24T08:45:41-04:00 hadrian: Warn user if hadrian build fails due to lack of threaded RTS See #16873. - - - - - 6824f29a by Ryan Scott at 2019-10-24T08:46:19-04:00 Parenthesize GADT return types in pprIfaceConDecl (#17384) We were using `pprIfaceAppArgs` instead of `pprParendIfaceAppArgs` in `pprIfaceConDecl`. Oops. Fixes #17384. - - - - - 9de3f8b1 by Ryan Scott at 2019-10-24T18:38:32-04:00 Make isTcLevPoly more conservative with newtypes (#17360) `isTcLevPoly` gives an approximate answer for when a type constructor is levity polymorphic when fully applied, where `True` means "possibly levity polymorphic" and `False` means "definitely not levity polymorphic". `isTcLevPoly` returned `False` for newtypes, which is incorrect in the presence of `UnliftedNewtypes`, leading to #17360. This patch tweaks `isTcLevPoly` to return `True` for newtypes instead. Fixes #17360. - - - - - 243c72eb by Ryan Scott at 2019-10-24T18:39:08-04:00 Mark promoted InfixT names as IsPromoted (#17394) We applied a similar fix for `ConT` in #15572 but forgot to apply the fix to `InfixT` as well. This patch fixes #17394 by doing just that. - - - - - 87175e78 by James Foster at 2019-10-25T09:01:08-04:00 Make Hadrian use -dynamic-too in the basic case This commit makes Hadrian use the `-dynamic-too` flag when the current Flavour's libraryWays contains both vanilla and dynamic, cutting down the amount of repeated work caused by separate compilation of dynamic and static files. It does this for the basic case where '.o' and '.dyn_o' files are built with one command, but does not generalise to cases like '.prof_o' and '.prof_dyn_o'. - - - - - ecd89062 by Alp Mestanogullari at 2019-10-25T09:01:47-04:00 hadrian/ci: run testsuite against a freshly produced and installed bindist - - - - - 2a16b555 by Ben Gamari at 2019-10-25T09:02:26-04:00 testsuite: Mark T13786 as fragile in unreg build Due to #17018. - - - - - 08298926 by Ben Gamari at 2019-10-25T09:02:26-04:00 testsuite: Use fragile modifier in TH_foreignInterruptible It looks like this use of `skip` snuck through my previous refactoring. - - - - - 4c7d45d1 by Brian Wignall at 2019-10-25T09:03:04-04:00 Make documentation for byteSwap16 consistent with byteSwap32 (impl is same, with s/16/32) - - - - - 02822d84 by Ben Gamari at 2019-10-25T09:03:40-04:00 aclocal: A bit of reformatting - - - - - 519f5162 by Ben Gamari at 2019-10-25T09:03:40-04:00 configure: Drop GccLT46 GCC 4.6 was released 7 years ago. I think we can finally assume that it's available. This is a simplification prompted by #15742. - - - - - acedfc8b by Ben Gamari at 2019-10-25T09:04:16-04:00 gitlab-ci: Run check-uniques during lint job - - - - - 8916e64e by Andrew Martin at 2019-10-26T05:19:38-04:00 Implement shrinkSmallMutableArray# and resizeSmallMutableArray#. This is a part of GHC Proposal #25: "Offer more array resizing primitives". Resources related to the proposal: - Discussion: https://github.com/ghc-proposals/ghc-proposals/pull/121 - Proposal: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0025-resize-boxed.rst Only shrinkSmallMutableArray# is implemented as a primop since a library-space implementation of resizeSmallMutableArray# (in GHC.Exts) is no less efficient than a primop would be. This may be replaced by a primop in the future if someone devises a strategy for growing arrays in-place. The library-space implementation always copies the array when growing it. This commit also tweaks the documentation of the deprecated sizeofMutableByteArray#, removing the mention of concurrency. That primop is unsound even in single-threaded applications. Additionally, the non-negativity assertion on the existing shrinkMutableByteArray# primop has been removed since this predicate is trivially always true. - - - - - 1be9c35c by Roland Senn at 2019-10-26T05:20:14-04:00 Fix #14690 - :steplocal panics after break-on-error `:steplocal` enables only breakpoints in the current top-level binding. When a normal breakpoint is hit, then the module name and the break id from the `BRK_FUN` byte code allow us to access the corresponding entry in a ModBreak table. From this entry we then get the SrcSpan (see compiler/main/InteractiveEval.hs:bindLocalsAtBreakpoint). With this source-span we can then determine the current top-level binding, needed for the steplocal command. However, if we break at an exception or at an error, we don't have an BRK_FUN byte-code, so we don't have any source information. The function `bindLocalsAtBreakpoint` creates an `UnhelpfulSpan`, which doesn't allow us to determine the current top-level binding. To avoid a `panic`, we have to check for `UnhelpfulSpan` in the function `ghc/GHCi/UI.hs:stepLocalCmd`. Hence a :steplocal command after a break-on-exception or a break-on-error is not possible. - - - - - 4820af10 by Adam Sandberg Eriksson at 2019-10-26T19:53:01-04:00 hadrian: point link to ghc gitlab [skip ci] - - - - - 609c7ee6 by Ben Gamari at 2019-10-26T19:53:36-04:00 gitlab-ci: Produce ARMv7 binary distributions - - - - - 8ac49411 by Ben Gamari at 2019-10-26T19:53:36-04:00 testsuite: Skip regalloc_unit_tests unless have_ncg This is a unit test for the native code generator's register allocator; naturally. the NCG is required. - - - - - 60575596 by Ben Gamari at 2019-10-26T19:53:36-04:00 Enable PDF documentation - - - - - 417f59d4 by Ben Gamari at 2019-10-26T19:53:36-04:00 rts: Fix ARM linker includes * Prefer #pragma once over guard macros * Drop redundant #includes * Fix order to ensure that necessary macros are defined when we condition on them - - - - - 4054f0e5 by Ömer Sinan Ağacan at 2019-10-26T19:54:16-04:00 Remove redundant -fno-cse options These were probably added with some GLOBAL_VARs, but those GLOBAL_VARs are now gone. - - - - - c62817f2 by Luke Lau at 2019-10-27T11:35:40-04:00 Fix RankNTypes :ghc-flag: in users guide This fixes a hadrian `build docs` failure - - - - - fc3a5205 by Luke Lau at 2019-10-27T11:35:40-04:00 Remove unused import - - - - - d2520bef by Luke Lau at 2019-10-27T11:35:40-04:00 Fix path to ghc-flags in users guide Hadrian rules It should point to the _build directory, not the source - - - - - 896d470a by Luke Lau at 2019-10-27T11:35:40-04:00 Add back documentation for deprecated -Whi-shadowing This was removed in b538476be3706264620c072e6e436debf9e0d3e4, but without it the compare-flags.py script fails. This adds it back and marks it as deprecated, with a notice that it is slated for removal. - - - - - 7d80f8b5 by Luke Lau at 2019-10-27T11:35:40-04:00 Remove documented flags from expected-undocumented-flags.txt - - - - - fa0d4809 by Ryan Scott at 2019-10-27T11:36:17-04:00 Parenthesize nullary constraint tuples using sigPrec (#17403) We were using `appPrec`, not `sigPrec`, as the precedence when determining whether or not to parenthesize `() :: Constraint`, which lead to the parentheses being omitted in function contexts like `(() :: Constraint) => String`. Easily fixed. Fixes #17403. - - - - - 90d06fd0 by Ben Gamari at 2019-10-27T17:27:17-04:00 hadrian: Silence output from Support SMP check Previously we would allow the output from the check of SMP support introduced by 83655b06e6d3e93b2d15bb0fa250fbb113d7fe68 leak to stdout. Silence this. See #16873. - - - - - 6635a3f6 by Josef Svenningsson at 2019-10-28T09:20:34-04:00 Fix #15344: use fail when desugaring applicative-do Applicative-do has a bug where it fails to use the monadic fail method when desugaring patternmatches which can fail. See #15344. This patch fixes that problem. It required more rewiring than I had expected. Applicative-do happens mostly in the renamer; that's where decisions about scheduling are made. This schedule is then carried through the typechecker and into the desugarer which performs the actual translation. Fixing this bug required sending information about the fail method from the renamer, through the type checker and into the desugarer. Previously, the desugarer didn't have enough information to actually desugar pattern matches correctly. As a side effect, we also fix #16628, where GHC wouldn't catch missing MonadFail instances with -XApplicativeDo. - - - - - cd9b9459 by Ryan Scott at 2019-10-28T09:21:13-04:00 Refactor TcDeriv to validity-check less in anyclass/via deriving (#13154) Due to the way `DerivEnv` is currently structured, there is an invariant that every derived instance must consist of a class applied to a non-empty list of argument types, where the last argument *must* be an application of a type constructor to some arguments. This works for many cases, but there are also some design patterns in standalone `anyclass`/`via` deriving that are made impossible due to enforcing this invariant, as documented in #13154. This fixes #13154 by refactoring `TcDeriv` and friends to perform fewer validity checks when using the `anyclass` or `via` strategies. The highlights are as followed: * Five fields of `DerivEnv` have been factored out into a new `DerivInstTys` data type. These fields only make sense for instances that satisfy the invariant mentioned above, so `DerivInstTys` is now only used in `stock` and `newtype` deriving, but not in other deriving strategies. * There is now a `Note [DerivEnv and DerivSpecMechanism]` describing the bullet point above in more detail, as well as explaining the exact requirements that each deriving strategy imposes. * I've refactored `mkEqnHelp`'s call graph to be slightly less complicated. Instead of the previous `mkDataTypeEqn`/`mkNewTypeEqn` dichotomy, there is now a single entrypoint `mk_eqn`. * Various bits of code were tweaked so as not to use fields that are specific to `DerivInstTys` so that they may be used by all deriving strategies, since not all deriving strategies use `DerivInstTys`. - - - - - e0e04856 by Alan Zimmerman at 2019-10-28T09:21:58-04:00 Attach API Annotations for {-# SOURCE #-} import pragma Attach the API annotations for the start and end locations of the {-# SOURCE #-} pragma in an ImportDecl. Closes #17388 - - - - - e951f219 by Sebastian Graf at 2019-10-28T09:22:35-04:00 Use FlexibleInstances for `Outputable (* p)` instead of match-all instances with equality constraints In #17304, Richard and Simon dicovered that using `-XFlexibleInstances` for `Outputable` instances of AST data types means users can provide orphan `Outputable` instances for passes other than `GhcPass`. Type inference doesn't currently to suffer, and Richard gave an example in #17304 that shows how rare a case would be where the slightly worse type inference would matter. So I went ahead with the refactoring, attempting to fix #17304. - - - - - ad1fe274 by Simon Peyton Jones at 2019-10-28T09:23:14-04:00 Better arity for join points A join point was getting too large an arity, leading to #17294. I've tightened up the invariant: see CoreSyn, Note [Invariants on join points], invariant 2b - - - - - fb4f245c by Takenobu Tani at 2019-10-29T03:45:02-04:00 users-guide: Fix :since: for -xn flag [skip ci] - - - - - 35abbfee by Takenobu Tani at 2019-10-29T03:45:41-04:00 users-guide: Add some new features and fix warnings for GHC 8.10 This updates the following: * Add description for ImportQualifiedPost extension * Add description for ghci command name resolution * Fix markdown warnings [skip ci] - - - - - 57dc1565 by Sylvain Henry at 2019-10-29T03:46:22-04:00 Use `not#` primitive to implement Word's complement - - - - - 28e52732 by Ben Gamari at 2019-10-29T03:46:59-04:00 linters: Add mode to lint given set of files This makes testing much easier. - - - - - db43b3b3 by Ben Gamari at 2019-10-29T03:46:59-04:00 linters: Add linter to catch unquoted use of $(TEST_HC) This is a common bug that creeps into Makefiles (e.g. see T12674). - - - - - ebee0d6b by Ben Gamari at 2019-10-29T03:46:59-04:00 testsuite: Fix quoting of $(TEST_HC) in T12674 I have no idea how this went unnoticed until now. - - - - - 3bd3456f by Ömer Sinan Ağacan at 2019-10-29T03:47:44-04:00 Refactor HscRecomp constructors: Make it evident in the constructors that the final interface is only available when HscStatus is not HscRecomp. (When HscStatus == HscRecomp we need to finish the compilation to get the final interface) `Maybe ModIface` return value of hscIncrementalCompile and the partial `expectIface` function are removed. - - - - - bbdd54aa by Ömer Sinan Ağacan at 2019-10-29T03:47:44-04:00 Return ModIface in compilation pipeline, remove IORef hack for generating ModIfaces The compilation phases now optionally return ModIface (for phases that generate an interface, currently only HscOut when (re)compiling a file). The value is then used by compileOne' to return the generated interface with HomeModInfo (which is then used by the batch mode compiler when building rest of the tree). hscIncrementalMode also returns a DynFlags with plugin info, to be used in the rest of the pipeline. Unfortunately this introduces a (perhaps less bad) hack in place of the previous IORef: we now record the DynFlags used to generate the partial infterface in HscRecomp and use the same DynFlags when generating the full interface. I spent almost three days trying to understand what's changing in DynFlags that causes a backpack test to fail, but I couldn't figure it out. There's a FIXME added next to the field so hopefully someone who understands this better than I do will fix it leter. - - - - - a56433a9 by Ömer Sinan Ağacan at 2019-10-29T03:47:44-04:00 Remove unused DynFlags arg of lookupIfaceByModule - - - - - dcd40c71 by Ömer Sinan Ağacan at 2019-10-29T03:47:44-04:00 HscMain: Move a comment closer to the relevant site - - - - - 593f6543 by Ömer Sinan Ağacan at 2019-10-29T03:47:44-04:00 MkIface: Remove redundant parameter and outdated comments from addFingerprints - - - - - f868e1fe by Ben Gamari at 2019-10-29T03:48:20-04:00 gitlab-ci: Use Hadrian for unregisterised job - - - - - 7b2ecbc0 by Ben Gamari at 2019-10-29T03:48:20-04:00 gitlab-ci: Factor out Linux Hadrian validation logic - - - - - 8e5de15d by Ben Gamari at 2019-10-29T03:48:20-04:00 hadrian: Define USE_LIBFFI_FOR_ADJUSTORS when necessary - - - - - 6a090270 by Ben Gamari at 2019-10-29T03:48:20-04:00 hadrian: Define NOSMP when building rts unregisterised It seems that NOSMP was previously only defined when compiling the compiler, not the RTS. Fix this. In addition do some spring-cleaning and make the logic match that of the Make build system. - - - - - b741d19d by Ben Gamari at 2019-10-29T03:48:20-04:00 hadrian: Shuffle around RTS build flags Some of these flags wanted to be passed to .cmm builds as well as C builds. - - - - - d7cedd9d by Ben Gamari at 2019-10-29T03:48:20-04:00 hadrian: Drop -Werror=unused-but-set-variable from GHC flags Previously `hadrian` would pass `-optc-Werror=unused-but-set-variable` to all GHC invocations. This was a difference from the make build system and cause the unregisterised build to fail as the C that GHC produces contains many unused functions. Drop it from the GHC flags. Note, however, that the flag is still present in `Settings.Builders.Common.cWarnings` and therefore will still be applied during compilation of C sources. - - - - - 7d3a15c7 by Ben Gamari at 2019-10-29T03:48:55-04:00 base: Fix open-file locking The OFD locking path introduced in 3b784d440d4b01b4c549df7c9a3ed2058edfc780 due to #13945 appears to have never actually worked but we never noticed due to an oversight in the autoconf check. Fix it. Thanks to Oleg Grenrus for noticing this. - - - - - 78b70e63 by Ben Gamari at 2019-10-29T03:48:55-04:00 base: Split up file locking implementation This makes the CPP significantly easier to follow. - - - - - 63977398 by Ben Gamari at 2019-10-29T03:49:31-04:00 Don't substitute GccVersion variable Not only is it now unused but we generally can't assume that we are compiling with GCC, so it really shouldn't be used. - - - - - 72f7ac9a by Ben Gamari at 2019-10-29T03:50:06-04:00 Revert "Replace freebsd-gnueabihf with freebsd" This reverts commit aa31ceaf7568802590f73a740ffbc8b800096342 as suggested in #17392. - - - - - 3c0372d6 by Ben Gamari at 2019-10-29T20:31:36-04:00 distrib: Fix binary distribution installation This had silently regressed due to 81860281 and the variable renaming performed in b55ee979, as noted in #17374. - - - - - a7f423ee by Ben Gamari at 2019-10-29T20:31:36-04:00 gitlab-ci: Use pxz to compress binary distributions - - - - - db602643 by Ben Gamari at 2019-10-29T20:31:36-04:00 Don't include settings file in binary distribution The configuration in the installation environment (as determined by `autoconf`) may differ from the build environment and therefore we need to be sure to rebuild the settings file. Fixes #17374. - - - - - 260e2379 by Ben Gamari at 2019-10-29T20:31:36-04:00 gitlab-ci: Fix binary distribution testing - - - - - 01ef3e1f by Ömer Sinan Ağacan at 2019-10-29T20:32:18-04:00 Interpreter: initialize arity fields of AP_NOUPDs AP_NOUPD entry code doesn't use the arity field, but not initializing this field confuses printers/debuggers, and also makes testing harder as the field's value changes randomly. - - - - - 93ff9197 by Ben Gamari at 2019-10-30T07:36:49-04:00 rts: More aarch64 header fixes - - - - - 3e7569bc by Vladislav Zavialov at 2019-10-30T07:36:50-04:00 Whitespace forward compatibility for proposal #229 GHC Proposal #229 changes the lexical rules of Haskell, which may require slight whitespace adjustments in certain cases. This patch changes formatting in a few places in GHC and its testsuite in a way that enables it to compile under the proposed rules. - - - - - 4898df1c by Ben Gamari at 2019-10-30T18:15:52-04:00 gitlab-ci: Fix the ARMv7 triple Previously we were configuring the ARMv7 builds with a host/target triple of arm-linux-gnueabihf, which caused us to target ARMv6 and consequently rely on the old CP15 memory barrier implementation. This barrier has to be emulated on ARMv8 machines which is glacially slow. Hopefully this should fix the ARMv7 builds which currently consistently time out. - - - - - 337e9b5a by Ömer Sinan Ağacan at 2019-10-31T19:01:54-04:00 Remove redundant 0s in ghc-heap pointer strings Before: 0x0000004200c86888 After: 0x42000224f8 This is more concise and consistent with the RTS's printer (which uses %p formatter, and at least on Linux gcc prints the short form) and gdb's pointer formatter. - - - - - 97b6f7a3 by Ben Gamari at 2019-10-31T19:02:32-04:00 base: Clamp IO operation size to 2GB on Darwin As reported in #17414, Darwin throws EINVAL in response to large writes. - - - - - a9743eb7 by Ben Gamari at 2019-10-31T19:02:32-04:00 testsuite: Add test for #17414 - - - - - 73d6e508 by Ben Gamari at 2019-10-31T19:03:10-04:00 base: Various haddock fixes Just a few things I found while looking at #17383. - - - - - dc487642 by taylorfausak at 2019-11-01T04:54:47-04:00 Implement `round` for `Ratio` that doesn't explode with `Natural`s - - - - - 3932fb97 by taylorfausak at 2019-11-01T04:54:47-04:00 Fix rounding around 0 - - - - - baf47ff8 by taylorfausak at 2019-11-01T04:54:47-04:00 Add tests for rounding ratios - - - - - 214d8122 by taylorfausak at 2019-11-01T04:54:47-04:00 Fix running of ratio test case - - - - - 70b62c97 by Ben Gamari at 2019-11-01T04:55:24-04:00 mmap: Factor out protection flags - - - - - c6759080 by Ben Gamari at 2019-11-01T04:55:24-04:00 rts: Make m32 allocator per-ObjectCode MacOS Catalina is finally going to force our hand in forbidden writable exeutable mappings. Unfortunately, this is quite incompatible with the current global m32 allocator, which mixes symbols from various objects in a single page. The problem here is that some of these symbols may not yet be resolved (e.g. had relocations performed) as this happens lazily (and therefore we can't yet make the section read-only and therefore executable). The easiest way around this is to simply create one m32 allocator per ObjectCode. This may slightly increase fragmentation for short-running programs but I suspect will actually improve fragmentation for programs doing lots of loading/unloading since we can always free all of the pages allocated to an object when it is unloaded (although this ability will only be implemented in a later patch). - - - - - 35c99e72 by Simon Peyton Jones at 2019-11-01T04:56:02-04:00 Makes Lint less chatty: I found in #17415 that Lint was printing out truly gigantic warnings, unmanageably huge, with repeated copies of the same thing. This patch makes Lint less chatty, especially for warnings: * For **warnings**, I don't print details of the location, unless you add `-dppr-debug`. * For **errors**, I still print all the info. They are fatal and stop exection, whereas warnings appear repeatedly. * I've made much less use of `AnExpr` in `LintLocInfo`; the expression can be gigantic. - - - - - d2471964 by Simon Peyton Jones at 2019-11-01T04:56:38-04:00 Add another test for #17267 This one came in a comment from James Payor - - - - - 1e2e82aa by Simon Peyton Jones at 2019-11-01T04:57:15-04:00 Fix a bad error in tcMatchTy This patch fixes #17395, a very subtle and hard-to-trigger bug in tcMatchTy. It's all explained in Note [Matching in the presence of casts (2)] I have not added a regression test because it is very hard to trigger it, until we have the upcoming mkAppTyM patch, after which lacking this patch means you can't even compile the libraries. - - - - - 51067194 by Ben Gamari at 2019-11-01T15:48:37-04:00 base: Ensure that failIO isn't SOURCE imported failIO has useful information in its demand signature (specifically that it bottoms) which is hidden if it is SOURCE imported, as noted in #16588. Rejigger things such that we don't SOURCE import it. Metric Increase: T13701 - - - - - c751082c by Ben Gamari at 2019-11-01T15:48:37-04:00 testsuite: Make ExplicitForAllRules1 more robust Previously the test relied on `id` not inlining. Fix this. - - - - - dab12c87 by Ben Gamari at 2019-11-01T15:48:37-04:00 Describe optimisation of demand analysis of noinline As described in #16588. - - - - - c9236384 by Adam Sandberg Eriksson at 2019-11-01T15:49:16-04:00 template-haskell: require at least 1 GADT constructor name (#17379) - - - - - a4ce26e0 by Ben Gamari at 2019-11-01T15:49:53-04:00 hadrian: Make runtest invocation consistency with Make Use True/False instead of 0/1. This shouldn't be a functional change but we should be consistent. - - - - - cabafe34 by Ben Gamari at 2019-11-01T15:50:29-04:00 testsuite: Add test for #17423 - - - - - 4a6d3d68 by Simon Peyton Jones at 2019-11-01T23:11:37-04:00 Make CSE delay inlining less CSE delays inlining a little bit, to avoid losing vital specialisations; see Note [Delay inlining after CSE] in CSE. But it was being over-enthusiastic. This patch makes the delay only apply to Ids with specialisation rules, which avoids unnecessary delay (#17409). - - - - - 01006bc7 by Niklas Hambüchen at 2019-11-01T23:12:17-04:00 doc: Fix backticks - - - - - 9980fb58 by Niklas Hambüchen at 2019-11-01T23:12:17-04:00 Add +RTS --disable-delayed-os-memory-return. Fixes #17411. Sets `MiscFlags.disableDelayedOsMemoryReturn`. See the added `Note [MADV_FREE and MADV_DONTNEED]` for details. - - - - - 182b1199 by Sebastian Graf at 2019-11-02T20:16:33-04:00 Separate `LPat` from `Pat` on the type-level Since the Trees That Grow effort started, we had `type LPat = Pat`. This is so that `SrcLoc`s would only be annotated in GHC's AST, which is the reason why all GHC passes use the extension constructor `XPat` to attach source locations. See #15495 for the design discussion behind that. But now suddenly there are `XPat`s everywhere! There are several functions which dont't cope with `XPat`s by either crashing (`hsPatType`) or simply returning incorrect results (`collectEvVarsPat`). This issue was raised in #17330. I also came up with a rather clean and type-safe solution to the problem: We define ```haskell type family XRec p (f :: * -> *) = r | r -> p f type instance XRec (GhcPass p) f = Located (f (GhcPass p)) type instance XRec TH f = f p type LPat p = XRec p Pat ``` This is a rather modular embedding of the old "ping-pong" style, while we only pay for the `Located` wrapper within GHC. No ping-ponging in a potential Template Haskell AST, for example. Yet, we miss no case where we should've handled a `SrcLoc`: `hsPatType` and `collectEvVarsPat` are not callable at an `LPat`. Also, this gets rid of one indirection in `Located` variants: Previously, we'd have to go through `XPat` and `Located` to get from `LPat` to the wrapped `Pat`. Now it's just `Located` again. Thus we fix #17330. - - - - - 3c916162 by Richard Eisenberg at 2019-11-02T20:17:13-04:00 Update Note references -- comments only Follow-on from !2041. - - - - - 3b65655c by Ben Gamari at 2019-11-04T03:40:31-05:00 SysTools: Only apply Windows-specific workaround on Windows Issue #1110 was apparently due to a bug in Vista which prevented GCC from finding its binaries unless we explicitly added it to PATH. However, this workaround was incorrectly applied on non-Windows platforms as well, resulting in ill-formed PATHs (#17266). Fixes #17266. - - - - - 5d4f16ee by Leif Metcalf at 2019-11-04T03:41:09-05:00 Rephrase note on full-laziness - - - - - 120f2e53 by Ben Gamari at 2019-11-04T03:41:44-05:00 rts/linker: Ensure that code isn't writable For many years the linker would simply map all of its memory with PROT_READ|PROT_WRITE|PROT_EXEC. However operating systems have been becoming increasingly reluctant to accept this practice (e.g. #17353 and #12657) and for good reason: writable code is ripe for exploitation. Consequently mmapForLinker now maps its memory with PROT_READ|PROT_WRITE. After the linker has finished filling/relocating the mapping it must then call mmapForLinkerMarkExecutable on the sections of the mapping which contain executable code. Moreover, to make all of this possible it was necessary to redesign the m32 allocator. First, we gave (in an earlier commit) each ObjectCode its own m32_allocator. This was necessary since code loading and symbol resolution/relocation are currently interleaved, meaning that it is not possible to enforce W^X when symbols from different objects reside in the same page. We then redesigned the m32 allocator to take advantage of the fact that all of the pages allocated with the allocator die at the same time (namely, when the owning ObjectCode is unloaded). This makes a number of things simpler (e.g. no more page reference counting; the interface provided by the allocator for freeing is simpler). See Note [M32 Allocator] for details. - - - - - 7c28087a by Takenobu Tani at 2019-11-05T02:45:31-05:00 users-guide: Improve documentaion of CPP extension Currently, the description of CPP extension is given in the section of command-line options. Therefore, it is a little difficult to understand that it is a language extension. This commit explicitly adds a description for it. [skip ci] - - - - - d57059f7 by Ben Gamari at 2019-11-05T02:46:10-05:00 rts: Add missing const in HEAP_ALLOCED_GC This was previously unnoticed as this code-path is hit on very few platforms (e.g. OpenBSD). - - - - - 487ede42 by Peter Trommler at 2019-11-05T02:46:48-05:00 testsuite: skip test requiring RTS linker on PowerPC The RTS linker is not available on 64-bit PowerPC. Instead of marking tests that require the RTS linker as broken on PowerPC 64-bit skip the respective tests on all platforms where the RTS linker or a statically linked external interpreter is not available. Fixes #11259 - - - - - 1593debf by Sebastian Graf at 2019-11-05T11:38:30-05:00 Check EmptyCase by simply adding a non-void constraint We can handle non-void constraints since !1733, so we can now express the strictness of `-XEmptyCase` just by adding a non-void constraint to the initial Uncovered set. For `case x of {}` we thus check that the Uncovered set `{ x | x /~ ⊥ }` is non-empty. This is conceptually simpler than the plan outlined in #17376, because it talks to the oracle directly. In order for this patch to pass the testsuite, I had to fix handling of newtypes in the pattern-match checker (#17248). Since we use a different code path (well, the main code path) for `-XEmptyCase` now, we apparently also handle #13717 correctly. There's also some dead code that we can get rid off now. `provideEvidence` has been updated to provide output more in line with the old logic, which used `inhabitationCandidates` under the hood. A consequence of the shift away from the `UncoveredPatterns` type is that we don't report reduced type families for empty case matches, because the pretty printer is pure and only knows the match variable's type. Fixes #13717, #17248, #17386 - - - - - e6ffe148 by Ömer Sinan Ağacan at 2019-11-05T11:39:13-05:00 TidyPgm: replace an explicit loop with mapAccumL - - - - - b7460492 by Ömer Sinan Ağacan at 2019-11-05T11:39:13-05:00 CoreTidy: hide tidyRule - - - - - f9978f53 by Stefan Schulze Frielinghaus at 2019-11-05T11:39:51-05:00 Hadrian: enable interpreter for s390x - - - - - 3ce18700 by Ben Gamari at 2019-11-06T08:05:57-05:00 rts: Drop redundant flags for libffi These are now handled in the cabal file's include-dirs field. - - - - - ce9e2a1a by Ben Gamari at 2019-11-06T08:05:57-05:00 configure: Add --with-libdw-{includes,libraries} flags Fixing #17255. - - - - - 97f9674b by Takenobu Tani at 2019-11-06T08:06:37-05:00 configure: Add checking python3-sphinx This checks the configuration about python3-sphinx. We need python3-sphinx instead of python2-sphinx to build documentation. The approach is as follows: * Check python3 version with custom `conf.py` invoked from sphinx-build` executable * Place custom `conf.py` into new `utils/check-sphinx` directory If sphinx is for python2 not python3, it's treated as config ERROR instead of WARN. See also #17346 and #17356. - - - - - b4fb2328 by Dan Brooks at 2019-11-06T08:07:15-05:00 Adding examples to Semigroup/monoid - - - - - 708c60aa by Ryan Scott at 2019-11-07T08:39:36-05:00 Clean up TH's treatment of unary tuples (or, #16881 part two) !1906 left some loose ends in regards to Template Haskell's treatment of unary tuples. This patch ends to tie up those loose ends: * In addition to having `TupleT 1` produce unary tuples, `TupE [exp]` and `TupP [pat]` also now produce unary tuples. * I have added various special cases in GHC's pretty-printers to ensure that explicit 1-tuples are printed using the `Unit` type. See `testsuite/tests/th/T17380`. * The GHC 8.10.1 release notes entry has been tidied up a little. Fixes #16881. Fixes #17371. Fixes #17380. - - - - - a424229d by Stefan Schulze Frielinghaus at 2019-11-07T08:40:13-05:00 For s390x issue a warning if LLVM 9 or older is used For s390x the GHC calling convention is only supported since LLVM version 10. Issue a warning in case an older version of LLVM is used. - - - - - 55bc3787 by Ben Gamari at 2019-11-07T08:40:50-05:00 FlagChecker: Add ticky flags to hashed flags These affect output and therefore should be part of the flag hash. - - - - - fa0b1b4b by Stefan Schulze Frielinghaus at 2019-11-07T08:41:33-05:00 Bump libffi-tarballs submodule - - - - - a9566632 by Takenobu Tani at 2019-11-07T08:42:15-05:00 configure: Modify ERROR to WARN for sphinx's python check If sphinx's python version check failed, many people prefer to build without documents instead of stopping on the error. So this commit fixes the following: * Modify AC_MSG_ERROR to AC_MSG_WARN * Add clearing of SPHINXBUILD variable when check fails See also !2016. - - - - - d0ef8312 by Alp Mestanogullari at 2019-11-07T21:24:59-05:00 hadrian: fix support for the recording of perf test results Before this patch, Hadrian didn't care about the TEST_ENV and METRICS_FILE environment variables, that the performance testing infrastructure uses to record perf tests results from CI jobs. It now looks them up right before running the testsuite driver, and passes suitable --test-env/--metrics-file arguments when these environment variables are set. - - - - - 601e554c by Ben Gamari at 2019-11-07T21:25:36-05:00 Bump the process submodule This should fix the #17108 and #17249 with the fix from https://github.com/haskell/process/pull/159. - - - - - 6b7d7e1c by Ben Gamari at 2019-11-07T21:25:36-05:00 Bump hsc2hs submodule - - - - - b1c158c9 by Ben Gamari at 2019-11-07T21:25:36-05:00 rts: Fix m32 allocator build on Windows An inconsistency in the name of m32_allocator_flush caused the build to fail with a missing prototype error. - - - - - ae431cf4 by Ben Gamari at 2019-11-07T21:25:36-05:00 rts: Ensure that Rts.h is always included first In general this is the convention that we use in the RTS. On Windows things actually fail if we break it. For instance, you see things like: includes\stg\Types.h:26:9: error: warning: #warning "Mismatch between __USE_MINGW_ANSI_STDIO definitions. If using Rts.h make sure it is the first header included." [-Wcpp] - - - - - 0d141d28 by Ben Gamari at 2019-11-07T21:25:36-05:00 rts: Remove undesireable inline specifier I have no idea why I marked this as inline originally but clearly it shouldn't be inlined. - - - - - 870376f9 by Ben Gamari at 2019-11-07T21:25:36-05:00 base: Add missing imports in Windows locking implementation - - - - - 23994738 by Ben Gamari at 2019-11-07T21:25:36-05:00 rts/NonMoving: Fix various Windows build issues The Windows build seems to be stricter about not providing threading primitives in the non-threaded RTS. - - - - - a3ce52fd by Ben Gamari at 2019-11-07T21:25:36-05:00 users_guide: Set flags list file encoding Otherwise this fails on Windows. - - - - - 9db2e905 by Stefan Schulze Frielinghaus at 2019-11-08T05:36:54-05:00 Testsuite: Introduce req_rts_linker Some tests depend on the RTS linker. Introduce a modifier to skip such tests, in case the RTS linker is not available. - - - - - a4631335 by Szymon Nowicki-Korgol at 2019-11-08T05:37:34-05:00 Set correct length of DWARF .debug_aranges section (fixes #17428) - - - - - 3db2ab30 by Ben Gamari at 2019-11-08T05:38:11-05:00 hadrian: Add enableTickyGhc helper This took a bit of trial-and-error to get working so it seems worth having in the tree. - - - - - 5c87ebd7 by Ben Gamari at 2019-11-08T12:09:22-05:00 SetLevels: Don't set context level when floating cases When floating a single-alternative case we previously would set the context level to the level where we were floating the case. However, this is wrong as we are only moving the case and its binders. This resulted in #16978, where the disrepancy caused us to unnecessarily abstract over some free variables of the case body, resulting in shadowing and consequently Core Lint failures. (cherry picked from commit a2a0e6f3bb2d02a9347dec4c7c4f6d4480bc2421) - - - - - 43623b09 by Ben Gamari at 2019-11-08T12:10:01-05:00 testsuite: Run tests in nonmoving_thr in speed==slow - - - - - 6e4656cc by Ben Gamari at 2019-11-08T12:10:01-05:00 rts/nonmoving: Catch failure of createOSThread - - - - - 2e4fc04b by Ben Gamari at 2019-11-08T12:10:01-05:00 Bump unix submodule Marks executeFile001 as broken in all concurrent ways. - - - - - 8a10f9fb by Ben Gamari at 2019-11-09T18:03:01-05:00 template-haskell: Document assembler foreign file support See #16180. - - - - - 5ad3cb53 by Ben Gamari at 2019-11-09T18:03:01-05:00 template-haskell: Fix TBAs in changelog - - - - - 4a75a832 by Ben Gamari at 2019-11-09T18:03:01-05:00 base: Fix TBA in changelog - - - - - d7de0d81 by Ryan Scott at 2019-11-09T18:03:02-05:00 template-haskell: Fix italics in changelog [ci-skip] - - - - - 0fb246c3 by Ben Gamari at 2019-11-09T18:03:37-05:00 testsuite: Fix Windows cleanup path This was a regression introduced with the Path refactoring. - - - - - 925fbdbb by Ben Gamari at 2019-11-09T18:03:37-05:00 testsuite: Skip T16916 on Windows The event manager is not supported on Windows. - - - - - 7c2ce0a0 by Ben Gamari at 2019-11-09T18:03:38-05:00 testsuite: Skip T14931 on Windows This test uses -dynamic-too, which is not supported on Windows. - - - - - 7c63edb4 by Ben Gamari at 2019-11-09T18:03:38-05:00 gitlab-ci: Don't allow Windows make job to fail While linking is still slow (#16084) all of the correctness issues which were preventing us from being able to enforce testsuite-green on Windows are now resolved. - - - - - a50ecda6 by Ben Gamari at 2019-11-09T18:03:38-05:00 testsuite: Fix header #include order on Windows <Rts.h> must always come first. - - - - - dcb23ec9 by Ben Gamari at 2019-11-09T18:03:38-05:00 testsuite: Mark T13676 as broken on Darwin and Windows Due to #17447. - - - - - 411ba7ba by Ben Gamari at 2019-11-09T18:03:38-05:00 testsuite: Mark T11627b as fragile It was previously marked as broken due to #12236 however it passes for me locally while failing on CI. - - - - - c1f1f3f9 by Ben Gamari at 2019-11-09T18:03:38-05:00 testsuite: Mark T16219 as unbroken This was previously broken due to #16386 yet it passes for me locally. - - - - - 1f871e70 by Ben Gamari at 2019-11-09T18:03:38-05:00 testsuite: Remove redundant cleaning logic from T16511 The GHCi script for T16511 had some `rm` commands to clean up output from previous runs. This should be harmless since stderr was redirected to /dev/null; however, it seems that this redirection doesn't work on Windows (perhaps because GHCi uses `cmd` to execute the command-line; I'm not sure). I tried to fix it but was unable to find a sensible solution. Regardless, the cleaning logic is quite redundant now that we run each test in a hermetic environment. Let's just remove it. - - - - - 4d523cb1 by Ben Gamari at 2019-11-09T18:03:38-05:00 testsuite: Mark T17414 as fragile on Windows This consistently times out on Windows as described in #17453. I have tried increasing the timeout multiplier to two yet it stills fails. Disabling until we have time to investigate. - - - - - f73fbd2d by Ben Gamari at 2019-11-09T18:03:38-05:00 testsuite: Ignore stderr in PartialDownsweep As described in #17449, PartialDownsweep is currently fragile due to its dependence on the error messages produced by the C preprocessor. To eliminate this dependence we simply ignore stderr output, instead relying on the fact that the test will exit with a non-zero exit code on failure. Fixes #17449. - - - - - a9b14790 by Ben Gamari at 2019-11-09T18:03:38-05:00 testsuite: Fix putStrLn in saks028 Bizarrely, `saks028` previously failed reliably, but only on Windows (#17450). The test would exit with a zero exit code but simply didn't emit the expected text to stderr. I believe this was due to the fact that the test used `putStrLn`, resulting in the output ending up on stdout. This worked on other platforms since (apparently) we redirect stdout to stderr when evaluating splices. However, on Windows it seems that the redirected output wasn't flushed as it was on other platforms. Anyways, it seems like the right thing to do here is to be explicit about our desire for the output to end up on stderr. Closes #17450. - - - - - b62ca659 by Ben Gamari at 2019-11-09T18:03:38-05:00 testsuite: Drop T7995 This test is quite sensitive to the build configuration as it requires that ghc have unfoldings, which isn't true in the quick build flavours. I considered various options to make the test more robust but none of them seemed particularly appealing. Moreover, Simon PJ was a bit skeptical of the value of the test to begin with and I strongly suspect that any regression in #7995 would be accompanied by failures in our other compiler performance tests. Closes #17399. - - - - - 011f3121 by Ben Gamari at 2019-11-09T18:03:38-05:00 testsuite: Mark T16219 as fragile on Windows As noted in #17452, this test produces very long file paths which exceed the Windows MAX_PATH limitation. Mark the test as fragile for not until we can come up with a better solution. - - - - - 1f98e47d by Simon Peyton Jones at 2019-11-09T18:04:14-05:00 Use the right type in :force A missing prime meant that we were considering the wrong type in the GHCi debugger, when doing :force on multiple arguments (issue #17431). The fix is trivial. - - - - - 1f911de4 by Brian Wignall at 2019-11-09T18:04:57-05:00 Add IsList instance for ZipList (closes #17433) - - - - - e3672f40 by Brian Wignall at 2019-11-09T18:04:57-05:00 Incorporate MR review suggestions; add change in changelog - - - - - 3957bdf2 by Brian Wignall at 2019-11-09T18:04:57-05:00 Fix incorrect plurals - - - - - 6f4c1250 by Alina Banerjee at 2019-11-10T01:06:12-05:00 Improve SPECIALIZE pragma error messages (Fixes #12126) - - - - - fa25c8c4 by Richard Eisenberg at 2019-11-10T01:06:48-05:00 Update release notes about #16512 / #17405. - - - - - 55ca1085 by Richard Eisenberg at 2019-11-10T01:06:48-05:00 Fix #17405 by not checking imported equations Previously, we checked all imported type family equations for injectivity. This is very silly. Now, we check only for conflicts. Before I could even imagine doing the fix, I needed to untangle several functions that were (in my opinion) overly complicated. It's still not quite as perfect as I'd like, but it's good enough for now. Test case: typecheck/should_compile/T17405 - - - - - a9467f4f by Ben Gamari at 2019-11-10T21:06:33-05:00 testsuite: Mark tests fragile in threaded2 as fragile in all concurrent ways - - - - - 3e07ea8d by Ben Gamari at 2019-11-10T21:10:30-05:00 testsuite: Use small allocation area when measuring residency As suggested in #17387; this helps reduce the variance in our residency sampling. Metric Increase: T10370 T3586 lazy-bs-alloc Metric Decrease 'compile_time/peak_megabytes_allocated': T1969 Metric Decrease 'runtime/bytes allocated': space_leak_001 Metric Increase 'compile_time/bytes allocated': T1969 Metric Increase 'runtime/peak_megabytes_allocated': space_leak_001 Metric Decrease: T3064 T9675 - - - - - 049d9ae0 by Ben Gamari at 2019-11-10T21:10:30-05:00 testsuite: Don't check_stats at runtime if not requested Previously we would call check_stats to check the runtime metrics even if the test definition hadn't requested it. This would result in an error since the .stats file doesn't exist. - - - - - 64433428 by Alp Mestanogullari at 2019-11-11T08:49:01-05:00 hadrian: export METRICS_FILE to make it accessible to perf notes script This addresses #17456 and also fixes the --metrics-file argument that Hadrian passes to the testsuite driver. - - - - - 06640394 by Ben Gamari at 2019-11-11T08:50:45-05:00 testsuite: Disable T4334 in nonmoving_thr way - - - - - f8ec32d7 by Alp Mestanogullari at 2019-11-11T11:36:44-05:00 ci: push perf test metrics even when the testsuite doesn't pass The corresponding commit might introduce a regression on a perf test, in which case we certainly want to record it. The testsuite might also fail because of a test unrelated to performance, in which case we want to record that the perf test results were good. Either way, we likely want to record them under all circumstances but we don't without this patch. Metric Decrease: T3586 Metric Increase: lazy-bs-alloc - - - - - 643d42fc by Alp Mestanogullari at 2019-11-12T18:40:19-05:00 testsuite: don't collect compiler stats in collect_runtime_residency We instead want to collect the runtime stats (with collect_stats, instead of collect_compiler_stats). This should fix a number of perf tests failures we have been seeing, where we suddenly started measuring metrics we didn't intend to measure, which tend to fall outside of the acceptance window. Metric Decrease: lazy-bs-alloc T3586 Metric Increase: space_leak_001 T4801 T5835 T12791 - - - - - 535d0edc by Ömer Sinan Ağacan at 2019-11-13T07:06:12-05:00 Document CmmTopInfo type [ci skip] - - - - - 2d4f9ad8 by Ben Gamari at 2019-11-13T07:06:49-05:00 Ensure that coreView/tcView are able to inline Previously an import cycle between Type and TyCoRep meant that several functions in TyCoRep ended up SOURCE import coreView. This is quite unfortunate as coreView is intended to be fused into a larger pattern match and not incur an extra call. Fix this with a bit of restructuring: * Move the functions in `TyCoRep` which depend upon things in `Type` into `Type` * Fold contents of `Kind` into `Type` and turn `Kind` into a simple wrapper re-exporting kind-ish things from `Type` * Clean up the redundant imports that popped up as a result Closes #17441. Metric Decrease: T4334 - - - - - b795637f by Alp Mestanogullari at 2019-11-13T07:07:28-05:00 hadrian: fix Windows CI script By only using 'export' from within bash commands. - - - - - 6885e22c by Ben Gamari at 2019-11-13T07:08:03-05:00 testsuite: Add test for #17458 As noted in #17458, QuantifiedConstraints and UndecideableInstances could previously be used to write programs which can loop at runtime. This was fixed in !1870. - - - - - b4b19d89 by Ben Gamari at 2019-11-13T07:08:03-05:00 users guide: Fix broken link - - - - - 9a939a6c by Ryan Scott at 2019-11-13T07:08:40-05:00 Print name prefixly in the Outputable instance for StandaloneKindSig Issue #17461 was occurring because the `Outputable` instance for standalone kind signatures was simply calling `ppr` on the name in the kind signature, which does not add parentheses to infix names. The solution is simple: use `pprPrefixOcc` instead. Fixes #17461. - - - - - a06cfb59 by Ömer Sinan Ağacan at 2019-11-13T07:09:18-05:00 Only pass mod_location with HscRecomp instead of the entire ModSummary HscRecomp users only need the ModLocation of the module being compiled, so only pass that to users instead of the entire ModSummary Metric Decrease: T4801 - - - - - dd49b3f0 by Ben Gamari at 2019-11-13T17:01:21-05:00 Bump Haskeline and add exceptions as boot library Haskeline now depends upon exceptions. See #16752. - - - - - b06b1858 by Ben Gamari at 2019-11-14T11:30:20-05:00 base: Bump version to 4.14.0.0 Metric Increase: T4801 - - - - - 6ab80439 by Ben Gamari at 2019-11-14T23:05:30-05:00 gitlab-ci: Allow Windows to fail again - - - - - 46afc380 by Ben Gamari at 2019-11-15T09:45:36-05:00 gitlab-ci: Install process to global pkgdb before starting build This is an attempt to mitigate #17480 by ensuring that a functional version of the process library is available before attempting the build. - - - - - 8c5cb806 by Ben Gamari at 2019-11-15T10:45:55-05:00 Bump supported LLVM version to 9.0 - - - - - 8e5851f0 by Ben Gamari at 2019-11-15T10:45:55-05:00 llvm-targets: Update with Clang 9 - - - - - f3ffec27 by Ben Gamari at 2019-11-15T11:54:26-05:00 testsuite: Increase acceptance window of T4801 This statistic is rather unstable. Hopefully fixes #17475. - - - - - c2991f16 by Ben Gamari at 2019-11-15T11:56:10-05:00 users-guide: Drop 8.6.1 release notes - - - - - e8da1354 by Ben Gamari at 2019-11-17T06:48:16-05:00 gitlab-ci: Fix submodule linter We ran it against the .git directory despite the fact that the linter wants to be run against the repository. - - - - - 13290f91 by Ben Gamari at 2019-11-17T06:48:16-05:00 Bump version to 8.10.0 Bumps haddock submodule. - - - - - fa98f823 by Ben Gamari at 2019-11-17T06:48:16-05:00 testsuite: Don't collect residency for T4801 I previously increased the size of the acceptance window from 2% to 5% but this still isn't enough. Regardless, measuring bytes allocated should be sufficient to catch any regressions. - - - - - 002b2842 by Ivan Kasatenko at 2019-11-17T06:49:22-05:00 Make test 16916 more stable across runs - - - - - ca89dd3b by Ben Gamari at 2019-11-17T06:58:17-05:00 users-guide: Address #17329 Adopts the language suggested by @JakobBruenker. - - - - - 2f5ed225 by Ben Gamari at 2019-11-17T07:16:32-05:00 exceptions: Bump submodule back to master The previous commit hasn't made it to master yet. - - - - - 34515e7c by nineonine at 2019-11-17T13:33:22-08:00 Fix random typos [skip ci] - - - - - 4a37a29b by Mario Blažević at 2019-11-17T17:26:24-05:00 Fixed issue #17435, missing Data instances - - - - - 97f1bcae by Andreas Klebinger at 2019-11-17T17:26:24-05:00 Turn some comments into GHC.Hs.Utils into haddocks - - - - - cf7f8e5b by Ben Gamari at 2019-11-17T17:26:26-05:00 testsuite: Skip T17414 on Linux It is typical for $TMP to be a small tmpfson Linux. This test will fail in such cases since we must create a file larger than the filesystem. See #17459. - - - - - 88013b78 by nineonine at 2019-11-19T11:53:16-05:00 Optimize MonadUnique instances based on IO (#16843) Metric Decrease: T14683 - - - - - a8adb5b4 by Ben Gamari at 2019-11-19T11:53:55-05:00 desugar: Drop stale Note [Matching seqId] The need for this note vanished in eae703aa60f41fd232be5478e196b661839ec3de. - - - - - 08d595c0 by Ben Gamari at 2019-11-19T11:53:55-05:00 Give seq a more precise type and remove magic `GHC.Prim.seq` previously had the rather plain type: seq :: forall a b. a -> b -> b However, it also had a special typing rule to applications where `b` is not of kind `Type`. Issue #17440 noted that levity polymorphism allows us to rather give it the more precise type: seq :: forall (r :: RuntimeRep) a (b :: TYPE r). a -> b -> b This allows us to remove the special typing rule that we previously required to allow applications on unlifted arguments. T9404 contains a non-Type application of `seq` which should verify that this works as expected. Closes #17440. - - - - - ec8a463d by Viktor Dukhovni at 2019-11-19T11:54:45-05:00 Enable USE_PTHREAD_FOR_ITIMER also on FreeBSD If using a pthread instead of a timer signal is more reliable, and has no known drawbacks, then FreeBSD is also capable of supporting this mode of operation (tested on FreeBSD 12 with GHC 8.8.1, but no reason why it would not also work on FreeBSD 11 or GHC 8.6). Proposed by Kevin Zhang in: https://bugs.freebsd.org/bugzilla/show_bug.cgi?id=241849 - - - - - cd40e12a by Ömer Sinan Ağacan at 2019-11-19T11:55:36-05:00 Packages.hs: use O(n*log(n)) ordNub instead of O(n*n) nub As reported in #8173 in some environments package lists can get quite long, so we use more efficient ordNub instead of nub on package lists. - - - - - 2b27cc16 by Ben Gamari at 2019-11-19T11:56:21-05:00 Properly account for libdw paths in make build system Should finally fix #17255. - - - - - 0418c38d by Ben Gamari at 2019-11-19T11:56:58-05:00 rts: Add missing include of SymbolExtras.h This broke the Windows build. - - - - - c819c0e4 by Ben Gamari at 2019-11-19T11:57:36-05:00 nonmoving: Use correct info table pointer accessor Previously we used INFO_PTR_TO_STRUCT instead of THUNK_INFO_PTR_TO_STRUCT when looking at a thunk. These two happen to be equivalent on 64-bit architectures due to alignment considerations however they are different on 32-bit platforms. This lead to #17487. To fix this we also employ a small optimization: there is only one thunk of type WHITEHOLE (namely stg_WHITEHOLE_info). Consequently, we can just use a plain pointer comparison instead of testing against info->type. - - - - - deed8e31 by Ben Gamari at 2019-11-19T11:57:36-05:00 nonmoving: Fix incorrect masking in mark queue type test We were using TAG_BITS instead of TAG_MASK. This happened to work on 64-bit platforms where TAG_BITS==3 since we only use tag values 0 and 3. However, this broken on 32-bit platforms where TAG_BITS==2. - - - - - 097f8072 by Ben Gamari at 2019-11-19T11:57:36-05:00 nonmoving: Rework mark queue representation The previous representation needlessly limited the array length to 16-bits on 32-bit platforms. - - - - - eb7b233a by Ben Gamari at 2019-11-19T11:57:36-05:00 nonmoving: Fix handling on large object marking on 32-bit Previously we would reset the pointer pointing to the object to be marked to the beginning of the block when marking a large object. This did no harm on 64-bit but on 32-bit it broke, e.g. `arr020`, since we align pinned ByteArray allocations such that the payload is 8 byte-aligned. This means that the object might not begin at the beginning of the block., - - - - - a7571a74 by Ben Gamari at 2019-11-19T11:57:36-05:00 testsuite: Increase width of stack003 test Previously the returned tuple seemed to fit in registers on amd64. This meant that non-moving collector bug would cause the test to fail on i386 yet not amd64. - - - - - 098d5017 by Ben Gamari at 2019-11-19T11:57:36-05:00 nonmoving: Drop redundant write barrier on stack underflow Previously we would push stack-carried return values to the new stack on a stack overflow. While the precise reasoning for this barrier is unfortunately lost to history, in hindsight I suspect it was prompted by a missing barrier elsewhere (that has been since fixed). Moreover, there the redundant barrier is actively harmful: the stack may contain non-pointer values; blindly pushing these to the mark queue will result in a crash. This is precisely what happened in the `stack003` test. However, because of a (now fixed) deficiency in the test this crash did not trigger on amd64. - - - - - e57b7cc6 by Roland Zumkeller at 2019-11-19T20:39:19-05:00 Changing Thread IDs from 32 bits to 64 bits. - - - - - d1f3c637 by Roland Zumkeller at 2019-11-19T20:39:19-05:00 Use pointer equality in Eq/Ord for ThreadId Changes (==) to use only pointer equality. This is safe because two threads are the same iff they have the same id. Changes `compare` to check pointer equality first and fall back on ids only in case of inequality. See discussion in #16761. - - - - - ef8a08e0 by Alexey Kuleshevich at 2019-11-19T20:39:20-05:00 hpc: Fix encoding issues. Add test for and fix #17073 * Make sure files are being read/written in UTF-8. Set encoding while writing HTML output. Also set encoding while writing and reading .tix files although we don't yet have a ticket complaining that this poses problems. * Set encoding in html header to utf8 * Upgrade to new version of 'hpc' library and reuse `readFileUtf8` and `writeFileUtf8` functions * Update git submodule for `hpc` * Bump up `hpc` executable version Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - b79e46d6 by Vladislav Zavialov at 2019-11-19T20:39:20-05:00 Strip parentheses in expressions contexts in error messages This makes error messages a tad less noisy. - - - - - 13bbde77 by Ben Gamari at 2019-11-21T13:56:56-05:00 Bump hsc2hs submodule Including Phyx's backport of the process changes fixing #17480. - - - - - d4d10501 by Ben Gamari at 2019-11-23T09:42:38-05:00 Bump hsc2hs submodule again This fixes the Darwin build. - - - - - 889d475b by nineonine at 2019-11-23T18:53:29-05:00 Fix typo in Note reference [skip ci] - - - - - 8a33abfc by Ryan Scott at 2019-11-23T18:54:05-05:00 Target the IsList instance for ZipList at base-4.14.0.0 (#17489) This moves the changelog entry about the instance from `base-4.15.0.0` to `base-4.14.0.0`. This accomplishes part (1) from #17489. [ci skip] - - - - - e43e6ece by Ben Gamari at 2019-11-23T18:54:41-05:00 rts: Expose interface for configuring EventLogWriters This exposes a set of interfaces from the GHC API for configuring EventLogWriters. These can be used by consumers like [ghc-eventlog-socket](https://github.com/bgamari/ghc-eventlog-socket). - - - - - de6bbdf2 by Matheus Magalhães de Alcantara at 2019-11-23T18:55:23-05:00 Take care to not eta-reduce jumps in CorePrep CorePrep already had a check to prevent it from eta-reducing Ids that respond true to hasNoBinding (foreign calls, constructors for unboxed sums and products, and Ids with compulsory unfoldings). It did not, however, consider join points as ids that 'must be saturated'. Checking whether the Id responds True to 'isJoinId' should prevent CorePrep from turning saturated jumps like the following (from #17429) into undersaturated ones: (\ eta_XP -> join { mapped_s1vo _ = lvl_s1vs } in jump mapped_s1vo eta_XP) - - - - - 4a1e7e47 by Matheus Magalhães de Alcantara at 2019-11-23T18:55:23-05:00 Make CorePrep.tryEtaReducePrep and CoreUtils.tryEtaReduce line up Simon PJ says he prefers this fix to #17429 over banning eta-reduction for jumps entirely. Sure enough, this also works. Test case: simplCore/should_compile/T17429.hs - - - - - 15f1dc33 by Ryan Scott at 2019-11-23T18:56:00-05:00 Prevent -optc arguments from being duplicated in reverse order (#17471) This reverts a part of commit 7bc5d6c6578ab9d60a83b81c7cc14819afef32ba that causes all arguments to `-optc` (and `-optcxx`) to be passed twice to the C/C++ compiler, once in reverse order and then again in the correct order. While passing duplicate arguments is usually harmless it can cause breakage in this pattern, which is employed by Hackage libraries in the wild: ``` ghc Foo.hs foo.c -optc-D -optcFOO ``` As `FOO -D -D FOO` will cause compilers to error. Fixes #17471. - - - - - e85c9b22 by Ben Gamari at 2019-11-23T18:56:36-05:00 Bump ghc version to 8.11 - - - - - 0e6c2045 by Ben Gamari at 2019-11-23T18:57:12-05:00 rts: Consolidate spinlock implementation Previously we had two distinct implementations: one with spinlock profiling and another without. This seems like needless duplication. - - - - - cb11fcb5 by Ben Gamari at 2019-11-23T18:57:49-05:00 Packages: Don't use expectJust Throw a slightly more informative error on failure. Motivated by the errors seen in !2160. - - - - - 5747ebe9 by Sebastian Graf at 2019-11-23T18:58:25-05:00 Stricten functions ins GHC.Natural This brings `Natural` on par with `Integer` and fixes #17499. Also does some manual CSE for 0 and 1 literals. - - - - - c14b723f by Ömer Sinan Ağacan at 2019-11-23T18:59:06-05:00 Bump exceptions submodule Adds a few files generated by GHC's configure script to .gitignore - - - - - 7b4c7b75 by Brian Wignall at 2019-11-23T19:04:52-05:00 Fix typos - - - - - 6008206a by Viktor Dukhovni at 2019-11-24T14:33:18-05:00 On FreeBSD 12 sys/sysctl.h requires sys/types.h Else build fails with: In file included from ExecutablePath.hsc:42: /usr/include/sys/sysctl.h:1062:25: error: unknown type name 'u_int'; did you mean 'int'? int sysctl(const int *, u_int, void *, size_t *, const void *, size_t); ^~~~~ int compiling libraries/base/dist-install/build/System/Environment/ExecutablePath_hsc_make.c failed (exit code 1) Perhaps also also other FreeBSD releases, but additional include will no harm even if not needed. - - - - - b694b566 by Ben Gamari at 2019-11-24T14:33:54-05:00 configure: Fix HAVE_C11_ATOMICS macro Previously we were using AC_DEFINE instead of AC_DEFINE_UNQUOTED, resulted in the variable not being interpolated. Fixes #17505. - - - - - 8b8dc366 by Krzysztof Gogolewski at 2019-11-25T14:37:38+01:00 Remove prefix arrow support for GADTs (#17211) This reverts the change in #9096. The specialcasing done for prefix (->) is brittle and does not support VTA, type families, type synonyms etc. - - - - - 5a08f7d4 by Sebastian Graf at 2019-11-27T00:14:59-05:00 Make warnings for TH splices opt-in In #17270 we have the pattern-match checker emit incorrect warnings. The reason for that behavior is ultimately an inconsistency in whether we treat TH splices as written by the user (`FromSource :: Origin`) or as generated code (`Generated`). This was first reported in #14838. The current solution is to TH splices as `Generated` by default and only treat them as `FromSource` when the user requests so (-fenable-th-splice-warnings). There are multiple reasons for opt-in rather than opt-out: * It's not clear that the user that compiles a splice is the author of the code that produces the warning. Think of the situation where she just splices in code from a third-party library that produces incomplete pattern matches. In this scenario, the user isn't even able to fix that warning. * Gathering information for producing the warnings (pattern-match check warnings in particular) is costly. There's no point in doing so if the user is not interested in those warnings. Fixes #17270, but not #14838, because the proper solution needs a GHC proposal extending the TH AST syntax. - - - - - 8168b42a by Vladislav Zavialov at 2019-11-27T11:32:18+03:00 Whitespace-sensitive bang patterns (#1087, #17162) This patch implements a part of GHC Proposal #229 that covers five operators: * the bang operator (!) * the tilde operator (~) * the at operator (@) * the dollar operator ($) * the double dollar operator ($$) Based on surrounding whitespace, these operators are disambiguated into bang patterns, lazy patterns, strictness annotations, type applications, splices, and typed splices. This patch doesn't cover the (-) operator or the -Woperator-whitespace warning, which are left as future work. - - - - - 9e5477c4 by Ryan Scott at 2019-11-27T20:01:50-05:00 Fix @since annotations for isResourceVanishedError and friends (#17488) - - - - - e122ba33 by Sergei Trofimovich at 2019-11-27T20:02:29-05:00 .gitmodules: tweak 'exception' URL to avoid redirection warnings Avoid initial close warning of form: ``` Cloning into 'exceptions'... warning: redirecting to https://gitlab.haskell.org/ghc/packages/exceptions.git/ ``` Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 5f84b52a by Philipp Krüger at 2019-11-28T02:54:05-05:00 Reduce boolean blindness in OccInfo(OneOcc) #17482 * Transformed the type aliases `InterestingCxt`, `InsideLam` and `OneBranch` into data types. * Added Semigroup and Monoid instances for use in orOccInfo in OccurAnal.hs * Simplified some usage sites by using pattern matching instead of boolean algebra. Metric Increase: T12150 This increase was on a Mac-build of exactly 1%. This commit does *not* re-intruduce the asymptotic memory usage described in T12150. - - - - - 3748ba3a by Brian Wignall at 2019-11-28T02:54:52-05:00 Fix typos, using Wikipedia list of common typos - - - - - 6c59cc71 by Stefan Schulze Frielinghaus at 2019-11-28T02:55:33-05:00 Fix endian handling of LLVM backend Get rid of CPP macro WORDS_BIGENDIAN which is not defined anymore, and replace it by DynFlag. This fixes partially #17337. - - - - - 6985e0fc by Vladislav Zavialov at 2019-11-28T15:47:53+03:00 Factor out HsSCC/HsCoreAnn/HsTickPragma into HsPragE This is a refactoring with no user-visible changes (except for GHC API users). Consider the HsExpr constructors that correspond to user-written pragmas: HsSCC representing {-# SCC ... #-} HsCoreAnn representing {-# CORE ... #-} HsTickPragma representing {-# GENERATED ... #-} We can factor them out into a separate datatype, HsPragE. It makes the code a bit tidier, especially in the parser. Before this patch: hpc_annot :: { Located ( (([AddAnn],SourceText),(StringLiteral,(Int,Int),(Int,Int))), ((SourceText,SourceText),(SourceText,SourceText)) ) } After this patch: prag_hpc :: { Located ([AddAnn], HsPragE GhcPs) } - - - - - 7f695a20 by Ömer Sinan Ağacan at 2019-11-29T08:25:28-05:00 Pass ModDetails with (partial) ModIface in HscStatus (Partial) ModIface and ModDetails are generated at the same time, but they're passed differently: ModIface is passed in HscStatus consturctors while ModDetails is returned in a tuple. This refactors ModDetails passing so that it's passed around with ModIface in HscStatus constructors. This makes the code more consistent and hopefully easier to understand: ModIface and ModDetails are really very closely related. It makes sense to treat them the same way. - - - - - e921c90f by Ömer Sinan Ağacan at 2019-11-29T08:26:07-05:00 Improve few Foreign.Marshal.Utils docs In copyBytes and moveBytes mention which argument is source and which is destination. Also fixes some of the crazy indentation in the module and cleans trailing whitespace. - - - - - 316f2431 by Sebastian Graf at 2019-11-30T02:57:58-05:00 Hadrian docs: Rename the second "validate" entry to "slow-validate" [ci skip] That would be in line with the implementation. - - - - - 5aba5d32 by Vladislav Zavialov at 2019-11-30T02:58:34-05:00 Remove HasSrcSpan (#17494) Metric Decrease: haddock.compiler - - - - - d1de5c22 by Sylvain Henry at 2019-11-30T02:59:13-05:00 Use Hadrian by default in validate script (#17527) - - - - - 3a96a0b6 by Sebastian Graf at 2019-11-30T02:59:55-05:00 Simpler Semigroup instance for InsideLam and InterestingCtxt This mirrors the definition of `(&&)` and `(||)` now, relieving the Simplifier of a marginal amount of pressure. - - - - - f8cfe81a by Roland Senn at 2019-11-30T20:33:49+01:00 Improve tests for #17171 While backporting MR !1806 to 8.8.2 (!1885) I learnt the following: * Tests with `expect_fail` do not compare `*.stderr` output files. So a test using `expect_fail` will not detect future regressions on the `stderr` output. * To compare the `*.stderr` output files, I have to use the `exit_code(n)` function. * When a release is made, tests with `makefile_test` are converted to use `run_command`. * For the test `T17171a` the return code is `1` when running `makefile_test`, however it's `2` when running `run_command`. Therefore I decided: * To improve my tests for #17171 * To change test T17171a from `expect_fail` to `exit_code(2)` * To change both tests from `makefile_test` to `run_command` - - - - - 2b113fc9 by Vladislav Zavialov at 2019-12-01T08:17:05-05:00 Update DisambECP-related comments - - - - - beed7c3e by Ben Gamari at 2019-12-02T03:41:37-05:00 testsuite: Fix location of typing_stubs module This should fix the build on Debian 8. - - - - - 53251413 by Ben Gamari at 2019-12-02T03:42:14-05:00 testsuite: Don't override LD_LIBRARY_PATH, only prepend NixOS development environments often require that LD_LIBRARY_PATH be set in order to find system libraries. T1407 was overriding LD_LIBRARY_PATH, dropping these directories. Now it merely prepends, its directory. - - - - - 65400314 by Krzysztof Gogolewski at 2019-12-02T03:42:57-05:00 Convert warnings into assertions Since the invariants always hold in the testsuite, we can convert them to asserts. - - - - - 18baed64 by Alan Zimmerman at 2019-12-02T03:43:37-05:00 API Annotations: Unicode '->' on HsForallTy The code fragment type family Proxy2' ∷ ∀ k → k → Type where Proxy2' = Proxy' Generates AnnRarrow instead of AnnRarrowU for the first →. Fixes #17519 - - - - - 717f3236 by Brian Wignall at 2019-12-02T03:44:16-05:00 Fix more typos - - - - - bde48f8e by Ben Gamari at 2019-12-02T11:55:34-05:00 More Haddock syntax in GHC.Hs.Utils As suggested by RyanGlScott in !2163. - - - - - 038bedbc by Ben Gamari at 2019-12-02T11:56:18-05:00 Simplify: Fix pretty-printing of strictness A colleague recently hit the panic in Simplify.addEvals and I noticed that the message is quite unreadable due to incorrect pretty-printing. Fix this. - - - - - c500f652 by Ben Gamari at 2019-12-02T11:56:54-05:00 gitlab-ci: Fix changelog linting logic - - - - - 8ead967d by Ben Gamari at 2019-12-02T11:56:54-05:00 win32-init: Drop workaround for #17480 The `process` changes have now been merged into `hsc2hs`. (cherry picked from commit fa029f53132ad59f847ed012d3b835452cf16615) - - - - - d402209a by Ben Gamari at 2019-12-02T11:56:54-05:00 gitlab-ci: Disable Sphinx build on Debian 8 The docutils version available appears to be too old to support the `table` directive's `:widths:` options. (cherry picked from commit 75764487a96a7a026948b5af5022781872d12baa) - - - - - f1f68824 by Ben Gamari at 2019-12-02T11:56:54-05:00 base: Fix <unistd.h> #include Previously we were including <sys/unistd.h> which is available on glibc but not musl. (cherry picked from commit e44b695ca7cb5f3f99eecfba05c9672c6a22205e) - - - - - 37eb94b3 by Ben Gamari at 2019-12-02T11:56:54-05:00 gitlab-ci: Bump Docker images Installs pxz on Centos7 (cherry picked from commit 86960e691f7a600be247c32a7cf795bf9abf7cc4) - - - - - aec98a79 by Ben Gamari at 2019-12-02T11:56:54-05:00 gitlab-ci: pxz is unavailable on CentOS 7 Fall back to xz - - - - - 6708b8e5 by Ben Gamari at 2019-12-02T11:56:54-05:00 gitlab-ci: Set LANG on CentOS 7 It otherwise seems to default to ascii - - - - - 470ef0e7 by Ben Gamari at 2019-12-02T11:56:54-05:00 gitlab-ci: Consolidate release build configuration - - - - - 38338757 by Ben Gamari at 2019-12-02T11:56:54-05:00 gitlab-ci: Add Debian 10 builds - - - - - 012f13b5 by Ben Gamari at 2019-12-02T11:56:54-05:00 gitlab-ci: Fix Windows bindist collection Apparently variable interpolation in the `artifacts.paths` key of `gitlab-ci.yml` doesn't work on Windows as it does on WIndows. (cherry picked from commit 100cc756faa4468ed6950116bae30609c1c3468b) - - - - - a0f09e23 by Ben Gamari at 2019-12-02T11:56:54-05:00 testsuite: Simplify Python <3.5 fallback for TextIO (cherry picked from commit d092d8598694c23bc07cdcc504dff52fa5f33be1) - - - - - 2b2370ec by Ben Gamari at 2019-12-02T11:56:54-05:00 gitlab-ci: Add release-x86_64-linux-deb9 job (cherry picked from commit cbedb3c4a90649f474cb716842ba53afc5a642ca) - - - - - b1c206fd by Ben Gamari at 2019-12-02T11:56:54-05:00 gitlab-ci: Always build source tarball (cherry picked from commit 67b5de88ef923971f1980335137e3c7193213abd) - - - - - 4cbd5b47 by Sergei Trofimovich at 2019-12-02T11:57:33-05:00 configure.ac: make cross-compiler detection stricter Be more precise at detecting cross-compilation case. Before the change configuration $ ./configure --host=x86_64-pc-linux-gnu --target=x86_64-gentoo-linux-musl was not considered a cross-target. Even though libcs are different (`glibc` vs. `musl`). Without this patch build fails as: ``` "inplace/bin/ghc-cabal" check libraries/integer-gmp "inplace/bin/ghc-cabal" configure libraries/integer-gmp dist-install \ --with-ghc="/home/slyfox/dev/git/ghc/inplace/bin/ghc-stage1" \ --with-ghc-pkg="/home/slyfox/dev/git/ghc/inplace/bin/ghc-pkg" \ --disable-library-for-ghci --enable-library-vanilla --enable-library-for-ghci \ --enable-library-profiling --enable-shared --with-hscolour="/usr/bin/HsColour" \ --configure-option=CFLAGS="-Wall \ -Werror=unused-but-set-variable -Wno-error=inline \ -iquote /home/slyfox/dev/git/ghc/libraries/integer-gmp" \ --configure-option=LDFLAGS=" " --configure-option=CPPFLAGS=" \ " --gcc-options="-Wall -Werror=unused-but-set-variable -Wno-error=inline -iquote /home/slyfox/dev/git/ghc/libraries/integer-gmp \ " --with-gcc="x86_64-gentoo-linux-musl-gcc" --with-ld="x86_64-gentoo-linux-musl-ld.gold" --with-ar="x86_64-gentoo-linux-musl-ar" \ --with-alex="/usr/bin/alex" --with-happy="/usr/bin/happy" Configuring integer-gmp-1.0.2.0... configure: WARNING: unrecognized options: --with-compiler checking build system type... x86_64-pc-linux-gnu checking host system type... x86_64-pc-linux-gnu checking target system type... x86_64-pc-linux-gnu checking for gcc... /usr/lib/ccache/bin/x86_64-gentoo-linux-musl-gcc checking whether the C compiler works... yes checking for C compiler default output file name... a.out checking for suffix of executables... checking whether we are cross compiling... configure: error: in `/home/slyfox/dev/git/ghc/libraries/integer-gmp/dist-install/build': configure: error: cannot run C compiled programs. If you meant to cross compile, use `--host'. See `config.log' for more details make[1]: *** [libraries/integer-gmp/ghc.mk:5: libraries/integer-gmp/dist-install/package-data.mk] Error 1 make: *** [Makefile:126: all] Error 2 ``` Note: here `ghc-stage1` is assumed to target `musl` target but is passed `glibc` toolchain. It happens because initial ./configure phase did not detect host/target as different. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 5f7cb423 by Sylvain Henry at 2019-12-02T23:59:29-05:00 Add `timesInt2#` primop - - - - - fbbe18a2 by Sylvain Henry at 2019-12-02T23:59:29-05:00 Use the new timesInt2# primop in integer-gmp (#9431) - - - - - 5a4b8d0c by Athas at 2019-12-03T00:00:09-05:00 Document RTS behaviour upon encountering '--'. - - - - - 705a16df by Ben Gamari at 2019-12-03T07:11:33-05:00 Make BCO# lifted In #17424 Simon PJ noted that there is a potentially unsafe occurrence of unsafeCoerce#, coercing from an unlifted to lifted type. However, nowhere in the compiler do we assume that a BCO# is not a thunk. Moreover, in the case of a CAF the result returned by `createBCO` *will* be a thunk (as noted in [Updatable CAF BCOs]). Consequently it seems better to rather make BCO# a lifted type and rename it to BCO. - - - - - 35afe4f3 by Sylvain Henry at 2019-12-03T07:12:13-05:00 Use Int# primops in `Bits Int{8,16,32,64}` instances - - - - - 7a51b587 by Sylvain Henry at 2019-12-03T07:12:13-05:00 Add constant folding rule (#16402) narrowN (x .&. m) m .&. (2^N-1) = 2^N-1 ==> narrowN x e.g. narrow16 (x .&. 0x12FFFF) ==> narrow16 x - - - - - 10caee7f by Ben Gamari at 2019-12-03T21:04:50-05:00 users-guide: Add 8.12.1 release notes - - - - - 25019d18 by Ben Gamari at 2019-12-03T21:04:50-05:00 Drop Uniquable constraint for AnnTarget This relied on deriveUnique, which was far too subtle to be safely applied. Thankfully the instance doesn't appear to be used so let's just drop it. - - - - - 78b67ad0 by Ben Gamari at 2019-12-03T21:04:50-05:00 Simplify uniqAway This does two things: * Eliminate all uses of Unique.deriveUnique, which was quite easy to mis-use and extremely subtle. * Rename the previous "derived unique" notion to "local unique". This is possible because the only places where `uniqAway` can be safely used are those where local uniqueness (with respect to some InScopeSet) is sufficient. * Rework the implementation of VarEnv.uniqAway, as discussed in #17462. This should make the operation significantly more efficient than its previous iterative implementation.. Metric Decrease: T9872c T12227 T9233 T14683 T5030 T12545 hie002 Metric Increase: T9961 - - - - - f03a41d4 by Ben Gamari at 2019-12-03T21:05:27-05:00 Elf: Fix link info note generation Previously we would use the `.int` assembler directive to generate 32-bit words in the note section. However, `.int` is note guaranteed to produce 4-bytes; in fact, on some platforms (e.g. AArch64) it produces 8-bytes. Use the `.4bytes` directive to avoid this. Moreover, we used the `.align` directive, which is quite platform dependent. On AArch64 it appears to not even be idempotent (despite what the documentation claims). `.balign` is consequentially preferred as it offers consistent behavior across platforms. - - - - - 84585e5e by Vladislav Zavialov at 2019-12-05T16:07:44-05:00 Meaning-preserving SCC annotations (#15730) This patch implements GHC Proposal #176: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0176-scc-parsing.rst Before the change: 1 / 2 / 2 = 0.25 1 / {-# SCC "name" #-} 2 / 2 = 1.0 After the change: 1 / 2 / 2 = 0.25 1 / {-# SCC "name" #-} 2 / 2 = parse error - - - - - e49e5470 by Vladislav Zavialov at 2019-12-05T16:07:44-05:00 Improve error messages for SCC pragmas - - - - - a2b535d9 by Ben Gamari at 2019-12-05T16:07:45-05:00 users guide: Try to silence underfull \hbox warnings We use two tricks, as suggested here [1]: * Use microtype to try to reduce the incidence of underfull boxes * Bump up \hbadness to eliminate the warnings - - - - - 4e47217f by Bodigrim at 2019-12-05T16:07:47-05:00 Make sameNat and sameSymbol proxy-polymorphic - - - - - 8324f0b7 by Bodigrim at 2019-12-05T16:07:47-05:00 Test proxy-polymorphic sameNat and sameSymbol - - - - - 69001f54 by Ben Gamari at 2019-12-05T16:07:48-05:00 nonmoving: Clear segment bitmaps during sweep Previously we would clear the bitmaps of segments which we are going to sweep during the preparatory pause. However, this is unnecessary: the existence of the mark epoch ensures that the sweep will correctly identify non-reachable objects, even if we do not clear the bitmap. We now defer clearing the bitmap to sweep, which happens concurrently with mutation. - - - - - 58a9c429 by Ben Gamari at 2019-12-05T16:07:48-05:00 testsuite: Disable divByZero on non-NCG targets The LLVM backend does not guarantee any particular semantics for division by zero, making this test unreliable across platforms. - - - - - 8280bd8a by Ben Gamari at 2019-12-05T16:07:49-05:00 testsuite: Factor out terminal coloring - - - - - 92a52aaa by Ben Gamari at 2019-12-05T16:07:49-05:00 testsuite: Make performance metric summary more readable Along with some refactoring. - - - - - c4ca29c7 by Ben Gamari at 2019-12-05T16:07:49-05:00 testsuite: Use colors more consistently - - - - - 3354c68e by Vladislav Zavialov at 2019-12-05T16:07:49-05:00 Pretty-printing of the * kind Before this patch, GHC always printed the * kind unparenthesized. This led to two issues: 1. Sometimes GHC printed invalid or incorrect code. For example, GHC would print: type F @* x = x when it meant to print: type F @(*) x = x In the former case, instead of a kind application we were getting a type operator (@*). 2. Sometimes GHC printed kinds that were correct but hard to read. Should Either * Int be read as Either (*) Int or as (*) Either Int ? This depends on whether -XStarIsType is enabled, but it would be easier if we didn't have to check for the flag when reading the code. We can solve both problems by assigning (*) a different precedence. Note that Haskell98 kinds are not affected: ((* -> *) -> *) -> * does NOT become (((*) -> (*)) -> (*)) -> (*) The parentheses are added when (*) is used in a function argument position: F * * * becomes F (*) (*) (*) F A * B becomes F A (*) B Proxy * becomes Proxy (*) a * -> * becomes a (*) -> * - - - - - 70dd0e4b by Vladislav Zavialov at 2019-12-05T16:07:49-05:00 Parenthesize the * kind in TH.Ppr - - - - - a7a4efbf by Ben Gamari at 2019-12-05T16:07:49-05:00 rts/NonMovingSweep: Fix locking of new mutable list allocation Previously we used allocBlockOnNode_sync in nonmovingSweepMutLists despite the fact that we aren't in the GC and therefore the allocation spinlock isn't in use. This meant that sweep would end up spinning until the next minor GC, when the SM lock was moved away from the SM_MUTEX to the spinlock. This isn't a correctness issue but it sure isn't good for performance. Found thanks for Ward. Fixes #17539. - - - - - f171b358 by Matthias Braun at 2019-12-05T16:07:51-05:00 Fix typo in documentation of Base.hs. - - - - - 9897e8c8 by Gabor Greif at 2019-12-06T21:20:38-05:00 Implement pointer tagging for big families (#14373) Formerly we punted on these and evaluated constructors always got a tag of 1. We now cascade switches because we have to check the tag first and when it is MAX_PTR_TAG then get the precise tag from the info table and switch on that. The only technically tricky part is that the default case needs (logical) duplication. To do this we emit an extra label for it and branch to that from the second switch. This avoids duplicated codegen. Here's a simple example of the new code gen: data D = D1 | D2 | D3 | D4 | D5 | D6 | D7 | D8 On a 64-bit system previously all constructors would be tagged 1. With the new code gen D7 and D8 are tagged 7: [Lib.D7_con_entry() { ... {offset c1eu: // global R1 = R1 + 7; call (P64[Sp])(R1) args: 8, res: 0, upd: 8; } }] [Lib.D8_con_entry() { ... {offset c1ez: // global R1 = R1 + 7; call (P64[Sp])(R1) args: 8, res: 0, upd: 8; } }] When switching we now look at the info table only when the tag is 7. For example, if we derive Enum for the type above, the Cmm looks like this: c2Le: _s2Js::P64 = R1; _c2Lq::P64 = _s2Js::P64 & 7; switch [1 .. 7] _c2Lq::P64 { case 1 : goto c2Lk; case 2 : goto c2Ll; case 3 : goto c2Lm; case 4 : goto c2Ln; case 5 : goto c2Lo; case 6 : goto c2Lp; case 7 : goto c2Lj; } // Read info table for tag c2Lj: _c2Lv::I64 = %MO_UU_Conv_W32_W64(I32[I64[_s2Js::P64 & (-8)] - 4]); if (_c2Lv::I64 != 6) goto c2Lu; else goto c2Lt; Generated Cmm sizes do not change too much, but binaries are very slightly larger, due to the fact that the new instructions are longer in encoded form. E.g. previously entry code for D8 above would be 00000000000001c0 <Lib_D8_con_info>: 1c0: 48 ff c3 inc %rbx 1c3: ff 65 00 jmpq *0x0(%rbp) With this patch 00000000000001d0 <Lib_D8_con_info>: 1d0: 48 83 c3 07 add $0x7,%rbx 1d4: ff 65 00 jmpq *0x0(%rbp) This is one byte longer. Secondly, reading info table directly and then switching is shorter _c1co: movq -1(%rbx),%rax movl -4(%rax),%eax // Switch on info table tag jmp *_n1d5(,%rax,8) than doing the same switch, and then for the tag 7 doing another switch: // When tag is 7 _c1ct: andq $-8,%rbx movq (%rbx),%rax movl -4(%rax),%eax // Switch on info table tag ... Some changes of binary sizes in actual programs: - In NoFib the worst case is 0.1% increase in benchmark "parser" (see NoFib results below). All programs get slightly larger. - Stage 2 compiler size does not change. - In "containers" (the library) size of all object files increases 0.0005%. Size of the test program "bitqueue-properties" increases 0.03%. nofib benchmarks kindly provided by Ömer (@osa1): NoFib Results ============= -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- CS +0.0% 0.0% -0.0% -0.0% -0.0% CSD +0.0% 0.0% 0.0% +0.0% +0.0% FS +0.0% 0.0% 0.0% +0.0% 0.0% S +0.0% 0.0% -0.0% 0.0% 0.0% VS +0.0% 0.0% -0.0% +0.0% +0.0% VSD +0.0% 0.0% -0.0% +0.0% -0.0% VSM +0.0% 0.0% 0.0% 0.0% 0.0% anna +0.0% 0.0% +0.1% -0.9% -0.0% ansi +0.0% 0.0% -0.0% +0.0% +0.0% atom +0.0% 0.0% 0.0% 0.0% 0.0% awards +0.0% 0.0% -0.0% +0.0% 0.0% banner +0.0% 0.0% -0.0% +0.0% 0.0% bernouilli +0.0% 0.0% +0.0% +0.0% +0.0% binary-trees +0.0% 0.0% -0.0% -0.0% -0.0% boyer +0.0% 0.0% +0.0% 0.0% -0.0% boyer2 +0.0% 0.0% +0.0% 0.0% -0.0% bspt +0.0% 0.0% +0.0% +0.0% 0.0% cacheprof +0.0% 0.0% +0.1% -0.8% 0.0% calendar +0.0% 0.0% -0.0% +0.0% -0.0% cichelli +0.0% 0.0% +0.0% 0.0% 0.0% circsim +0.0% 0.0% -0.0% -0.1% -0.0% clausify +0.0% 0.0% +0.0% +0.0% 0.0% comp_lab_zift +0.0% 0.0% +0.0% 0.0% -0.0% compress +0.0% 0.0% +0.0% +0.0% 0.0% compress2 +0.0% 0.0% 0.0% 0.0% 0.0% constraints +0.0% 0.0% -0.0% -0.0% -0.0% cryptarithm1 +0.0% 0.0% +0.0% 0.0% 0.0% cryptarithm2 +0.0% 0.0% +0.0% -0.0% 0.0% cse +0.0% 0.0% +0.0% +0.0% 0.0% digits-of-e1 +0.0% 0.0% -0.0% -0.0% -0.0% digits-of-e2 +0.0% 0.0% +0.0% -0.0% -0.0% dom-lt +0.0% 0.0% +0.0% +0.0% 0.0% eliza +0.0% 0.0% -0.0% +0.0% 0.0% event +0.0% 0.0% -0.0% -0.0% -0.0% exact-reals +0.0% 0.0% +0.0% +0.0% +0.0% exp3_8 +0.0% 0.0% -0.0% -0.0% -0.0% expert +0.0% 0.0% +0.0% +0.0% +0.0% fannkuch-redux +0.0% 0.0% +0.0% 0.0% 0.0% fasta +0.0% 0.0% -0.0% -0.0% -0.0% fem +0.0% 0.0% +0.0% +0.0% +0.0% fft +0.0% 0.0% +0.0% -0.0% -0.0% fft2 +0.0% 0.0% +0.0% +0.0% +0.0% fibheaps +0.0% 0.0% +0.0% +0.0% 0.0% fish +0.0% 0.0% +0.0% +0.0% 0.0% fluid +0.0% 0.0% +0.0% +0.0% +0.0% fulsom +0.0% 0.0% +0.0% -0.0% +0.0% gamteb +0.0% 0.0% +0.0% -0.0% -0.0% gcd +0.0% 0.0% +0.0% +0.0% 0.0% gen_regexps +0.0% 0.0% +0.0% -0.0% -0.0% genfft +0.0% 0.0% -0.0% -0.0% -0.0% gg +0.0% 0.0% 0.0% -0.0% 0.0% grep +0.0% 0.0% +0.0% +0.0% +0.0% hidden +0.0% 0.0% +0.0% -0.0% -0.0% hpg +0.0% 0.0% +0.0% -0.1% -0.0% ida +0.0% 0.0% +0.0% -0.0% -0.0% infer +0.0% 0.0% -0.0% -0.0% -0.0% integer +0.0% 0.0% -0.0% -0.0% -0.0% integrate +0.0% 0.0% 0.0% +0.0% 0.0% k-nucleotide +0.0% 0.0% -0.0% -0.0% -0.0% kahan +0.0% 0.0% -0.0% -0.0% -0.0% knights +0.0% 0.0% +0.0% -0.0% -0.0% lambda +0.0% 0.0% +1.2% -6.1% -0.0% last-piece +0.0% 0.0% +0.0% -0.0% -0.0% lcss +0.0% 0.0% +0.0% -0.0% -0.0% life +0.0% 0.0% +0.0% -0.0% -0.0% lift +0.0% 0.0% +0.0% +0.0% 0.0% linear +0.0% 0.0% +0.0% +0.0% +0.0% listcompr +0.0% 0.0% -0.0% -0.0% -0.0% listcopy +0.0% 0.0% -0.0% -0.0% -0.0% maillist +0.0% 0.0% +0.0% -0.0% -0.0% mandel +0.0% 0.0% +0.0% +0.0% +0.0% mandel2 +0.0% 0.0% +0.0% +0.0% -0.0% mate +0.0% 0.0% +0.0% +0.0% +0.0% minimax +0.0% 0.0% -0.0% +0.0% -0.0% mkhprog +0.0% 0.0% +0.0% +0.0% +0.0% multiplier +0.0% 0.0% 0.0% +0.0% -0.0% n-body +0.0% 0.0% +0.0% -0.0% -0.0% nucleic2 +0.0% 0.0% +0.0% +0.0% -0.0% para +0.0% 0.0% +0.0% +0.0% +0.0% paraffins +0.0% 0.0% +0.0% +0.0% +0.0% parser +0.1% 0.0% +0.4% -1.7% -0.0% parstof +0.0% 0.0% -0.0% -0.0% -0.0% pic +0.0% 0.0% +0.0% 0.0% -0.0% pidigits +0.0% 0.0% -0.0% -0.0% -0.0% power +0.0% 0.0% +0.0% -0.0% -0.0% pretty +0.0% 0.0% +0.0% +0.0% +0.0% primes +0.0% 0.0% +0.0% 0.0% 0.0% primetest +0.0% 0.0% +0.0% +0.0% +0.0% prolog +0.0% 0.0% +0.0% +0.0% +0.0% puzzle +0.0% 0.0% +0.0% +0.0% +0.0% queens +0.0% 0.0% 0.0% +0.0% +0.0% reptile +0.0% 0.0% +0.0% +0.0% 0.0% reverse-complem +0.0% 0.0% -0.0% -0.0% -0.0% rewrite +0.0% 0.0% +0.0% 0.0% -0.0% rfib +0.0% 0.0% +0.0% +0.0% +0.0% rsa +0.0% 0.0% +0.0% +0.0% +0.0% scc +0.0% 0.0% +0.0% +0.0% +0.0% sched +0.0% 0.0% +0.0% +0.0% +0.0% scs +0.0% 0.0% +0.0% +0.0% 0.0% simple +0.0% 0.0% +0.0% +0.0% +0.0% solid +0.0% 0.0% +0.0% +0.0% 0.0% sorting +0.0% 0.0% +0.0% -0.0% 0.0% spectral-norm +0.0% 0.0% -0.0% -0.0% -0.0% sphere +0.0% 0.0% +0.0% -1.0% 0.0% symalg +0.0% 0.0% +0.0% +0.0% +0.0% tak +0.0% 0.0% +0.0% +0.0% +0.0% transform +0.0% 0.0% +0.4% -1.3% +0.0% treejoin +0.0% 0.0% +0.0% -0.0% 0.0% typecheck +0.0% 0.0% -0.0% +0.0% 0.0% veritas +0.0% 0.0% +0.0% -0.1% +0.0% wang +0.0% 0.0% +0.0% +0.0% +0.0% wave4main +0.0% 0.0% +0.0% 0.0% -0.0% wheel-sieve1 +0.0% 0.0% +0.0% +0.0% +0.0% wheel-sieve2 +0.0% 0.0% +0.0% +0.0% 0.0% x2n1 +0.0% 0.0% +0.0% +0.0% 0.0% -------------------------------------------------------------------------------- Min +0.0% 0.0% -0.0% -6.1% -0.0% Max +0.1% 0.0% +1.2% +0.0% +0.0% Geometric Mean +0.0% -0.0% +0.0% -0.1% -0.0% NoFib GC Results ================ -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- circsim +0.0% 0.0% -0.0% -0.0% -0.0% constraints +0.0% 0.0% -0.0% 0.0% -0.0% fibheaps +0.0% 0.0% 0.0% -0.0% -0.0% fulsom +0.0% 0.0% 0.0% -0.6% -0.0% gc_bench +0.0% 0.0% 0.0% 0.0% -0.0% hash +0.0% 0.0% -0.0% -0.0% -0.0% lcss +0.0% 0.0% 0.0% -0.0% 0.0% mutstore1 +0.0% 0.0% 0.0% -0.0% -0.0% mutstore2 +0.0% 0.0% +0.0% -0.0% -0.0% power +0.0% 0.0% -0.0% 0.0% -0.0% spellcheck +0.0% 0.0% -0.0% -0.0% -0.0% -------------------------------------------------------------------------------- Min +0.0% 0.0% -0.0% -0.6% -0.0% Max +0.0% 0.0% +0.0% 0.0% 0.0% Geometric Mean +0.0% +0.0% +0.0% -0.1% +0.0% Fixes #14373 These performance regressions appear to be a fluke in CI. See the discussion in !1742 for details. Metric Increase: T6048 T12234 T12425 Naperian T12150 T5837 T13035 - - - - - ee07421f by Simon Peyton Jones at 2019-12-06T21:21:14-05:00 Work in progress on coercionLKind, coercionRKind This is a preliminary patch for #17515 - - - - - 0a4ca9eb by Simon Peyton Jones at 2019-12-06T21:21:14-05:00 Split up coercionKind This patch implements the idea in #17515, splitting `coercionKind` into: * `coercion{Left,Right}Kind`, which computes the left/right side of the pair * `coercionKind`, which computes the pair of coercible types This is reduces allocation since we frequently only need only one side of the pair. Specifically, we see the following improvements on x86-64 Debian 9: | test | new | old | relative chg. | | :------- | ---------: | ------------: | ------------: | | T5030 | 695537752 | 747641152.0 | -6.97% | | T5321Fun | 449315744 | 474009040.0 | -5.21% | | T9872a | 2611071400 | 2645040952.0 | -1.28% | | T9872c | 2957097904 | 2994260264.0 | -1.24% | | T12227 | 773435072 | 812367768.0 | -4.79% | | T12545 | 3142687224 | 3215714752.0 | -2.27% | | T14683 | 9392407664 | 9824775000.0 | -4.40% | Metric Decrease: T12545 T9872a T14683 T5030 T12227 T9872c T5321Fun T9872b - - - - - d46a72e1 by Gabor Greif at 2019-12-09T12:05:15-05:00 Fix comment typos The below is only necessary to fix the CI perf fluke that happened in 9897e8c8ef0b19a9571ef97a1d9bb050c1ee9121: ------------------------- Metric Decrease: T5837 T6048 T9020 T12425 T12234 T13035 T12150 Naperian ------------------------- - - - - - e3bba7e4 by Micha Wiedenmann at 2019-12-10T19:52:44-05:00 users guide: Motivation of DefaultSignatures - - - - - 843ceb38 by Ben Gamari at 2019-12-10T19:53:54-05:00 rts: Add a long form flag to enable the non-moving GC The old flag, `-xn`, was quite cryptic. Here we add `--nonmoving-gc` in addition. - - - - - 921d3238 by Ryan Scott at 2019-12-10T19:54:34-05:00 Ignore unary constraint tuples during typechecking (#17511) We deliberately avoid defining a magical `Unit%` class, for reasons that I have expounded upon in the newly added `Note [Ignore unary constraint tuples]` in `TcHsType`. However, a sneaky user could try to insert `Unit%` into their program by way of Template Haskell, leading to the interface-file error observed in #17511. To avoid this, any time we encounter a unary constraint tuple during typechecking, we drop the surrounding constraint tuple application. This is safe to do since `Unit% a` and `a` would be semantically equivalent (unlike other forms of unary tuples). Fixes #17511. - - - - - 436ec9f3 by Ben Gamari at 2019-12-10T19:55:37-05:00 gitlab-ci: Move changelog linting logic to shell script Allowing it to be easily used locally. - - - - - 2f6b434f by Ben Gamari at 2019-12-10T19:55:37-05:00 gitlab-ci: Move changelog linting logic to shell script Allowing it to be easily used locally. - - - - - 7a5a6e07 by Ben Gamari at 2019-12-10T19:56:25-05:00 base: Fix incorrect @since in GHC.Natural Fixes #17547. - - - - - 2bbfaf8a by Ben Gamari at 2019-12-10T19:57:01-05:00 hadrian: AArch64 supports the GHCi interpreter and SMP I'm not sure how this was omitted from the list of supported architectures. - - - - - 8f1ceb67 by John Ericson at 2019-12-10T19:57:39-05:00 Move Int# section of primops.txt.pp This matches the organization of the fixed-sized ones, and keeps each Int* next to its corresponding Word*. - - - - - 7a823b0f by John Ericson at 2019-12-10T19:57:39-05:00 Move Int64# and Word64# sections of primops.txt.pp This way it is next to the other fixed-sized ones. - - - - - 8dd9929a by Ben Gamari at 2019-12-10T19:58:19-05:00 testsuite: Add (broken) test for #17510 - - - - - 6e47a76a by Ben Gamari at 2019-12-10T19:58:59-05:00 Re-layout validate script This script was previously a whitespace nightmare. - - - - - f80c4a66 by Crazycolorz5 at 2019-12-11T14:12:17-05:00 rts: Specialize hashing at call site rather than in struct. Separate word and string hash tables on the type level, and do not store the hashing function. Thus when a different hash function is desire it is provided upon accessing the table. This is worst case the same as before the change, and in the majority of cases is better. Also mark the functions for aggressive inlining to improve performance. {F1686506} Reviewers: bgamari, erikd, simonmar Subscribers: rwbarton, thomie, carter GHC Trac Issues: #13165 Differential Revision: https://phabricator.haskell.org/D4889 - - - - - 2d1b9619 by Richard Eisenberg at 2019-12-11T14:12:55-05:00 Warn on inferred polymorphic recursion Silly users sometimes try to use visible dependent quantification and polymorphic recursion without a CUSK or SAK. This causes unexpected errors. So we now adjust expectations with a bit of helpful messaging. Closes #17541 and closes #17131. test cases: dependent/should_fail/T{17541{,b},17131} - - - - - 4dde485e by Oleg Grenrus at 2019-12-12T02:24:46-05:00 Add --show-unit-ids flag to ghc-pkg I only added it into --simple-output and ghc-pkg check output; there are probably other places where it can be adopted. - - - - - e6e1ec08 by Ben Gamari at 2019-12-12T02:25:33-05:00 testsuite: Simplify and clarify performance test baseline search The previous implementation was extremely complicated, seemingly to allow the local and CI namespaces to be searched incrementally. However, it's quite unclear why this is needed and moreover the implementation seems to have had quadratic runtime cost in the search depth(!). - - - - - 29c4609c by Ben Gamari at 2019-12-12T02:26:19-05:00 testsuite: Add test for #17549 - - - - - 9f0ee253 by Ben Gamari at 2019-12-12T02:26:56-05:00 gitlab-ci: Move -dwarf and -debug jobs to full-build stage This sacrifices some precision in favor of improving parallelism. - - - - - 7179b968 by Ben Gamari at 2019-12-12T02:27:34-05:00 Revert "rts: Drop redundant flags for libffi" This seems to have regressed builds using `--with-system-libffi` (#17520). This reverts commit 3ce18700f80a12c48a029b49c6201ad2410071bb. - - - - - cc7d5650 by Oleg Grenrus at 2019-12-16T10:20:56+02:00 Having no shake upper bound is irresposible Given that shake is far from "done" API wise, and is central component to the build system. - - - - - 9431f905 by Oleg Grenrus at 2019-12-16T10:55:50+02:00 Add index-state to hadrian/cabal.project Then one is freer to omit upper bounds, as we won't pick any new entries on Hackage while building hadrian itself. - - - - - 3e17a866 by Krzysztof Gogolewski at 2019-12-16T19:31:44-05:00 Remove dataConSig As suggested in #17291 - - - - - 75355fde by Krzysztof Gogolewski at 2019-12-16T19:31:44-05:00 Use "OrCoVar" functions less As described in #17291, we'd like to separate coercions and expressions in a more robust fashion. This is a small step in this direction. - `mkLocalId` now panicks on a covar. Calls where this was not the case were changed to `mkLocalIdOrCoVar`. - Don't use "OrCoVar" functions in places where we know the type is not a coercion. - - - - - f9686e13 by Richard Eisenberg at 2019-12-16T19:32:21-05:00 Do more validity checks for quantified constraints Close #17583. Test case: typecheck/should_fail/T17563 - - - - - af763765 by Ben Gamari at 2019-12-16T19:33:01-05:00 gitlab-ci: Fix Windows artifact collection Variable interpolation in gitlab-ci.yml apparently doesn't work. Sigh. - - - - - e6d4b902 by Ben Gamari at 2019-12-16T19:33:01-05:00 gitlab-ci: Use xz --threads on Debian 10 - - - - - 8ba650e9 by Ben Gamari at 2019-12-16T19:33:01-05:00 gitlab-ci: Allow debian 8 build to fail The python release shipped with deb8 (3.3) is too old for our testsuite driver. - - - - - ac25a3f6 by Ben Gamari at 2019-12-16T19:33:01-05:00 gitlab-ci: Use xz --threads on Alpine - - - - - cc628088 by Ben Gamari at 2019-12-16T19:33:01-05:00 gitlab-ci: Another approach for xz detection - - - - - 37d788ab by Ben Gamari at 2019-12-16T19:33:01-05:00 gitlab-ci: Re-add release-x86_64-deb9 job Also eliminate some redundancy. - - - - - f8279138 by Ben Gamari at 2019-12-16T19:33:01-05:00 gitlab-ci: Drop redundant release-x86_64-linux-deb9 job - - - - - 8148ff06 by Ben Gamari at 2019-12-17T07:24:40-05:00 testsuite: Mark cgrun057 as broken on ARMv7 Due to #17554. It's very surprising that this only occurs on ARMv7 but this is the only place I've seen this failure thusfar. - - - - - 85e5696d by Ben Gamari at 2019-12-17T07:24:40-05:00 testsuite: Mark prog001 as fragile on ARMv7 Due to #17555. - - - - - a5f0aab0 by Ben Gamari at 2019-12-17T07:24:40-05:00 testsuite: Mark T10272 as broken on ARMv7 Due to #17556. - - - - - 1e6827c6 by Ben Gamari at 2019-12-17T07:24:40-05:00 testsuite: Mark T13825-debugger as broken on ARMv7 Due to #17557. - - - - - 7cef0b7d by Ben Gamari at 2019-12-17T07:24:40-05:00 testsuite: Mark T14028 as broken on ARMv7 Due to #17558. - - - - - 6ea4eb4b by Ben Gamari at 2019-12-17T07:24:40-05:00 testsuite: Make ghc_built_by_llvm check more precise Previously it would hackily look at the flavour name to determine whether LLVM was used to build stage2 ghc. However, this didn't work at all with Hadrian and would miss cases like ARM where we use the LLVM backend by default. See #16087 for the motivation for why ghc_built_by_llvm is needed at all. This should catch one of the ARMv7 failures described in #17555. - - - - - c3e82bf7 by Ben Gamari at 2019-12-17T07:24:40-05:00 testsuite: Mark T5435_* tests as broken on ARM `T5435_v_asm_a`, `T5435_v_asm_b`, and `T5435_v_gcc` all fail on ARMv7. See #17559. - - - - - eb2aa851 by Ben Gamari at 2019-12-17T07:24:40-05:00 gitlab-ci: Don't allow armv7 jobs to fail - - - - - efc92216 by Ben Gamari at 2019-12-17T07:24:40-05:00 Revert "testsuite: Mark cgrun057 as broken on ARMv7" This reverts commit 6cfc47ec8a478e1751cb3e7338954da1853c3996. - - - - - 1d2bb9eb by Ben Gamari at 2019-12-17T07:24:40-05:00 testsuite: Mark print002 as fragile on ARM Due to #17557. Also accepting spurious performance change. Metric Decrease: T1969 - - - - - 41f4e4fb by Josh Meredith at 2019-12-17T07:25:17-05:00 Fix ambiguous occurence error when building Hadrian - - - - - 4374983a by Josh Meredith at 2019-12-17T07:25:17-05:00 Rename SphinxMode constructors - - - - - a8f7ecd5 by Josh Meredith at 2019-12-17T07:25:17-05:00 Use *Mode suffix instead of *M - - - - - 58655b9d by Sylvain Henry at 2019-12-18T13:43:37+01:00 Add GHC-API logging hooks * Add 'dumpAction' hook to DynFlags. It allows GHC API users to catch dumped intermediate codes and information. The format of the dump (Core, Stg, raw text, etc.) is now reported allowing easier automatic handling. * Add 'traceAction' hook to DynFlags. Some dumps go through the trace mechanism (for instance unfoldings that have been considered for inlining). This is problematic because: 1) dumps aren't written into files even with -ddump-to-file on 2) dumps are written on stdout even with GHC API 3) in this specific case, dumping depends on unsafe globally stored DynFlags which is bad for GHC API users We introduce 'traceAction' hook which allows GHC API to catch those traces and to avoid using globally stored DynFlags. * Avoid dumping empty logs via dumpAction/traceAction (but still write empty files to keep the existing behavior) - - - - - fad866e0 by Moritz Kiefer at 2019-12-19T11:15:39-05:00 Avoid race condition in hDuplicateTo In our codebase we have some code along the lines of ``` newStdout <- hDuplicate stdout stderr `hDuplicateTo` stdout ``` to avoid stray `putStrLn`s from corrupting a protocol (LSP) that is run over stdout. On CI we have seen a bunch of issues where `dup2` returned `EBUSY` so this fails with `ResourceExhausted` in Haskell. I’ve spent some time looking at the docs for `dup2` and the code in `base` and afaict the following race condition is being triggered here: 1. The user calls `hDuplicateTo stderr stdout`. 2. `hDuplicateTo` calls `hClose_help stdout_`, this closes the file handle for stdout. 3. The file handle for stdout is now free, so another thread allocating a file might get stdout. 4. If `dup2` is called while `stdout` (now pointing to something else) is half-open, it returns EBUSY. I think there might actually be an even worse case where `dup2` is run after FD 1 is fully open again. In that case, you will end up not just redirecting the original stdout to stderr but also the whatever resulted in that file handle being allocated. As far as I can tell, `dup2` takes care of closing the file handle itself so there is no reason to do this in `hDuplicateTo`. So this PR replaces the call to `hClose_help` by the only part of `hClose_help` that we actually care about, namely, `flushWriteBuffer`. I tested this on our codebase fairly extensively and haven’t been able to reproduce the issue with this patch. - - - - - 0c114c65 by Sylvain Henry at 2019-12-19T11:16:17-05:00 Handle large ARR_WORDS in heap census (fix #17572) We can do a heap census with a non-profiling RTS. With a non-profiling RTS we don't zero superfluous bytes of shrunk arrays hence a need to handle the case specifically to avoid a crash. Revert part of a586b33f8e8ad60b5c5ef3501c89e9b71794bbed - - - - - 1a0d1a65 by John Ericson at 2019-12-20T10:50:22-05:00 Deduplicate copied monad failure handler code - - - - - 70e56b27 by Ryan Scott at 2019-12-20T10:50:57-05:00 lookupBindGroupOcc: recommend names in the same namespace (#17593) Previously, `lookupBindGroupOcc`'s error message would recommend all similar names in scope, regardless of whether they were type constructors, data constructors, or functions, leading to the confusion witnessed in #17593. This is easily fixed by only recommending names in the same namespace, using the `nameSpacesRelated` function. Fixes #17593. - - - - - 3c12355e by Stefan Schulze Frielinghaus at 2019-12-24T01:03:44-05:00 Fix endian handling w.r.t. CPP macro WORDS_BIGENDIAN Include header file `ghcautoconf.h` where the CPP macro `WORDS_BIGENDIAN` is defined. This finally fixes #17337 (in conjunction with commit 6c59cc71dc). - - - - - 11f8eef5 by Stefan Schulze Frielinghaus at 2019-12-24T01:03:44-05:00 fixup! Fix endian handling w.r.t. CPP macro WORDS_BIGENDIAN - - - - - 40327b03 by Sylvain Henry at 2019-12-24T01:04:24-05:00 Remove outdated comment - - - - - aeea92ef by Sylvain Henry at 2019-12-25T19:23:54-05:00 Switch to ReadTheDocs theme for the user-guide - - - - - 26493eab by Gabor Greif at 2019-12-25T19:24:32-05:00 Fix copy-paste error in comment - - - - - 776df719 by Gabor Greif at 2019-12-25T19:24:32-05:00 Fix comment about minimal gcc version to be consistent what FP_GCC_VERSION requires - - - - - 3b17114d by Ömer Sinan Ağacan at 2019-12-26T14:09:11-05:00 Minor refactor in ghc.cabal.in: - Remove outdated comments - Move cutils.c from parser to cbits - Remove unused cutils.h - - - - - 334290b6 by Ryan Scott at 2019-12-26T14:09:48-05:00 Replace panic/notHandled with noExtCon in DsMeta There are many spots in `DsMeta` where `panic` or `notHandled` is used after pattern-matching on a TTG extension constructor. This is overkill, however, as using `noExtCon` would work just as well. This patch switches out these panics for `noExtCon`. - - - - - 68252aa3 by Ben Gamari at 2019-12-27T15:11:38-05:00 testsuite: Skip T17499 when built against integer-simple Since it routinely times out in CI. - - - - - 0c51aeeb by Gabor Greif at 2019-12-27T15:12:17-05:00 suppress popup dialog about missing Xcode at configure tested with `bash` and `zsh`. - - - - - 8d76bcc2 by Gabor Greif at 2019-12-27T15:12:17-05:00 while at it rename XCode to the official Xcode - - - - - 47a68205 by Ben Gamari at 2019-12-27T15:12:55-05:00 testsuite: Mark cgrun057 as fragile on ARM As reported in #17554. Only marking on ARM for now although there is evidence to suggest that the issue may occur on other platforms as well. - - - - - d03dec8f by Gabor Greif at 2019-12-27T15:13:32-05:00 use shell variable CcLlvmBackend for test Previously we used `AC_DEFINE`d variable `CC_LLVM_BACKEND` which has an empty shell expansion. - - - - - 2528e684 by Ben Gamari at 2019-12-30T06:51:32-05:00 driver: Include debug level in the recompilation check hash Fixes #17586. - - - - - f14bb50b by Ben Gamari at 2019-12-30T06:52:09-05:00 rts: Ensure that nonmoving gc isn't used with profiling - - - - - b426de37 by Ben Gamari at 2019-12-30T06:52:45-05:00 llvmGen: Ensure that entry labels don't have predecessors The LLVM IR forbids the entry label of a procedure from having any predecessors. In the case of a simple looping function the LLVM code generator broke this invariant, as noted in #17589. Fix this by moving the function prologue to its own basic block, as suggested by @kavon in #11649. Fixes #11649 and #17589. - - - - - 613f7265 by Ben Gamari at 2019-12-30T06:52:45-05:00 llvmGen: Drop old fix for #11649 This was a hack which is no longer necessary now since we introduce a dedicated entry block for each procedure. - - - - - fdeffa5e by Ben Gamari at 2019-12-30T06:53:23-05:00 rts: Error on invalid --numa flags Previously things like `+RTS --numa-debug` would enable NUMA support, despite being an invalid flag. - - - - - 9ce3ba68 by Ben Gamari at 2019-12-30T06:53:23-05:00 rts: Fix --debug-numa mode under Docker As noted in #17606, Docker disallows the get_mempolicy syscall by default. This caused numerous tests to fail under CI in the `debug_numa` way. Avoid this by disabling the NUMA probing logic when --debug-numa is in use, instead setting n_numa_nodes in RtsFlags.c. Fixes #17606. - - - - - 5baa2a43 by Ben Gamari at 2019-12-30T06:54:01-05:00 testsuite: Disable derefnull when built with LLVM LLVM does not guarantee any particular semantics when dereferencing null pointers. Consequently, this test actually passes when built with the LLVM backend. - - - - - bd544d3d by Ben Gamari at 2019-12-30T06:54:38-05:00 hadrian: Track hash of Cabal Setup builder arguments Lest we fail to rebuild when they change. Fixes #17611. - - - - - 6e2c495e by Ben Gamari at 2019-12-30T06:55:19-05:00 TcIface: Fix inverted logic in typechecking of source ticks Previously we would throw away source ticks when the debug level was non-zero. This is precisely the opposite of what was intended. Fixes #17616. Metric Decrease: T13056 T9020 T9961 T12425 - - - - - 7fad387d by Ben Gamari at 2019-12-30T06:55:55-05:00 perf_notes: Add --zero-y argument This makes it easier to see the true magnitude of fluctuations. Also do some house-keeping in the argument parsing department. - - - - - 0d42b287 by Ben Gamari at 2019-12-30T06:55:55-05:00 testsuite: Enlarge acceptance window for T1969 As noted in #17624, it's quite unstable, especially, for some reason, on i386 and armv7 (something about 32-bit platforms perhaps?). Metric Increase: T1969 - - - - - eb608235 by Sylvain Henry at 2019-12-31T14:22:32-05:00 Module hierarchy (#13009): Stg - - - - - d710fd66 by Vladislav Zavialov at 2019-12-31T14:23:10-05:00 Testsuite: update some Haddock tests Fixed tests: * haddockA039: added to all.T * haddockE004: replaced with T17561 (marked as expect_broken) New tests: * haddockA040: deriving clause for a data instance * haddockA041: haddock and CPP #include - - - - - 859ebdd4 by Kevin Buhr at 2019-12-31T23:44:39-05:00 Add "-Iw" RTS flag for minimum wait between idle GCs (#11134) - - - - - dd4b6551 by Kevin Buhr at 2019-12-31T23:44:39-05:00 Add additional Note explaining the -Iw flag - - - - - c4279ff1 by Kevin Buhr at 2019-12-31T23:44:39-05:00 Fix some sloppy indentation - - - - - b84c09d5 by Ömer Sinan Ağacan at 2019-12-31T23:45:19-05:00 Tweak Cmm dumps to avoid generating sections for empty groups When dumping Cmm groups check if the group is empty, to avoid generating empty sections in dump files like ==================== Output Cmm ==================== [] Also fixes a few bad indentation in the code around changes. - - - - - b2e0323f by Gabor Greif at 2020-01-03T21:22:36-05:00 Simplify mrStr - - - - - 3c9dc06b by Brian Wignall at 2020-01-04T15:55:06-05:00 Fix typos, via a Levenshtein-style corrector - - - - - d561c8f6 by Sylvain Henry at 2020-01-04T15:55:46-05:00 Add Cmm related hooks * stgToCmm hook * cmmToRawCmm hook These hooks are used by Asterius and could be useful to other clients of the GHC API. It increases the Parser dependencies (test CountParserDeps) to 184. It's still less than 200 which was the initial request (cf https://mail.haskell.org/pipermail/ghc-devs/2019-September/018122.html) so I think it's ok to merge this. - - - - - ae6b6276 by Oleg Grenrus at 2020-01-04T15:56:22-05:00 Update to Cabal submodule to v3.2.0.0-alpha3 Metric Increase: haddock.Cabal - - - - - 073f7cfd by Vladislav Zavialov at 2020-01-04T15:56:59-05:00 Add lexerDbg to dump the tokens fed to the parser This a small utility function that comes in handy when debugging the lexer and the parser. - - - - - 558d4d4a by Sylvain Henry at 2020-01-04T15:57:38-05:00 Split integerGmpInternals test in several parts This is to prepare for ghc-bignum which implements some but not all of gmp functions. - - - - - 4056b966 by Ben Gamari at 2020-01-04T15:58:15-05:00 testsuite: Mark cgrun057 as fragile on all platforms I have seen this fail both on x86-64/Debian 9 and armv7/Debian 9 See #17554. - - - - - 5ffea0c6 by Tamar Christina at 2020-01-06T18:38:37-05:00 Fix overflow. - - - - - 99a9f51b by Sylvain Henry at 2020-01-06T18:39:22-05:00 Module hierarchy: Iface (cf #13009) - - - - - 7aa4a061 by Ben Gamari at 2020-01-07T13:11:48-05:00 configure: Only check GCC version if CC is GCC Also refactor FP_GCC_EXTRA_FLAGS in a few ways: * We no longer support compilers which lack support for -fno-builtin and -fwrapv so remove the condition on GccVersion * These flags are only necessary when using the via-C backend so make them conditional on Unregisterised. Fixes #15742. - - - - - 0805ed7e by John Ericson at 2020-01-07T13:12:25-05:00 Use non-empty lists to remove partiality in matching code - - - - - 7844f3a8 by Ben Gamari at 2020-01-07T13:13:02-05:00 testsuite: Mark T17073 as broken on Windows Due to #17607. - - - - - acf40cae by Ben Gamari at 2020-01-07T13:13:02-05:00 gitlab-ci: Disallow Windows from failing - - - - - 34bc02c7 by Ben Gamari at 2020-01-07T13:13:02-05:00 configure: Find Python3 for testsuite In addition, we prefer the Mingw64 Python distribution on Windows due to #17483. - - - - - e35fe8d5 by Ben Gamari at 2020-01-07T13:13:02-05:00 testsuite: Fix Windows platform test Previously we used platform.system() and while this worked fine (e.g. returned `Windows`, as expected) locally under both msys and MingW64 Python distributions, it inexplicably returned `MINGW64_NT-10.0` under MingW64 Python on CI. It seems os.name is more reliable so we now use that instead.. - - - - - 48ef6217 by Ben Gamari at 2020-01-07T13:13:39-05:00 gitlab-ci: Rename push-test-metrics.sh to test-metrics.sh Refactoring to follow. - - - - - 2234fa92 by Ben Gamari at 2020-01-07T13:13:39-05:00 gitlab-ci: Pull test metrics before running testsuite Otherwise the testsuite driver may not have an up-to-date baseline. - - - - - 1ca9adbc by Sylvain Henry at 2020-01-07T13:14:18-05:00 Remove `parallel` check from configure.ac `parallel` is no longer a submodule since 3cb063c805ec841ca33b8371ef8aba9329221b6c - - - - - b69a3460 by Ryan Scott at 2020-01-07T13:14:57-05:00 Monomorphize HsModule to GhcPs (#17642) Analyzing the call sites for `HsModule` reveals that it is only ever used with parsed code (i.e., `GhcPs`). This simplifies `HsModule` by concretizing its `pass` parameter to always be `GhcPs`. Fixes #17642. - - - - - d491a679 by Sylvain Henry at 2020-01-08T06:16:31-05:00 Module hierarchy: Renamer (cf #13009) - - - - - d589410f by Ben Gamari at 2020-01-08T06:17:09-05:00 Bump haskeline submodule to 0.8.0.1 (cherry picked from commit feb3b955402d53c3875dd7a9a39f322827e5bd69) - - - - - 923a1272 by Ryan Scott at 2020-01-08T06:17:47-05:00 Print Core type applications with no whitespace after @ (#17643) This brings the pretty-printer for Core in line with how visible type applications are normally printed: namely, with no whitespace after the `@` character (i.e., `f @a` instead of `f @ a`). While I'm in town, I also give the same treatment to type abstractions (i.e., `\(@a)` instead of `\(@ a)`) and coercion applications (i.e., `f @~x` instead of `f @~ x`). Fixes #17643. - - - - - 49f83a0d by Adam Sandberg Eriksson at 2020-01-12T21:28:09-05:00 improve docs for HeaderInfo.getImports [skip ci] - - - - - 9129210f by Matthew Pickering at 2020-01-12T21:28:47-05:00 Overloaded Quotation Brackets (#246) This patch implements overloaded quotation brackets which generalise the desugaring of all quotation forms in terms of a new minimal interface. The main change is that a quotation, for example, [e| 5 |], will now have type `Quote m => m Exp` rather than `Q Exp`. The `Quote` typeclass contains a single method for generating new names which is used when desugaring binding structures. The return type of functions from the `Lift` type class, `lift` and `liftTyped` have been restricted to `forall m . Quote m => m Exp` rather than returning a result in a Q monad. More details about the feature can be read in the GHC proposal. https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0246-overloaded-bracket.rst - - - - - 350e2b78 by Richard Eisenberg at 2020-01-12T21:29:27-05:00 Don't zap to Any; error instead This changes GHC's treatment of so-called Naughty Quantification Candidates to issue errors, instead of zapping to Any. Close #16775. No new test cases, because existing ones cover this well. - - - - - 0b5ddc7f by Brian Wignall at 2020-01-12T21:30:08-05:00 Fix more typos, via an improved Levenshtein-style corrector - - - - - f732dbec by Ben Gamari at 2020-01-12T21:30:49-05:00 gitlab-ci: Retain bindists used by head.hackage for longer Previously we would keep them for two weeks. However, on the stable branches two weeks can easily elapse with no pushes. - - - - - c8636da5 by Sylvain Henry at 2020-01-12T21:31:30-05:00 Fix LANG=C for readelf invocation in T14999 The test fails when used with LANG=fr_FR.UTF-8 - - - - - 077a88de by Jean-Baptiste Mazon at 2020-01-12T21:32:08-05:00 users-guide/debug-info: typo “behivior” - - - - - 61916c5d by Simon Peyton Jones at 2020-01-12T21:32:44-05:00 Add comments about TH levels - - - - - 1fd766ca by Simon Peyton Jones at 2020-01-12T21:32:44-05:00 Comments about constraint floating - - - - - de01427e by Simon Peyton Jones at 2020-01-12T21:32:45-05:00 Minor refactor around quantified constraints This patch clarifies a dark corner of quantified constraints. * See Note [Yukky eq_sel for a HoleDest] in TcSMonad * Minor refactor, breaking out new function TcInteract.doTopReactEqPred - - - - - 30be3bf1 by Simon Peyton Jones at 2020-01-12T21:32:45-05:00 Comments in TcHsType - - - - - c5977d4d by Sebastian Graf at 2020-01-16T05:58:58-05:00 Better documentation for mkEtaWW [skip ci] So that hopefully I understand it faster next time. Also got rid of the confusing `orig_expr`, which makes the call site in `etaExpand` look out of sync with the passed `n` (which is not the original `n`). - - - - - 22c0bdc3 by John Ericson at 2020-01-16T05:59:37-05:00 Handle TagToEnum in the same big case as the other primops Before, it was a panic because it was handled above. But there must have been an error in my reasoning (another caller?) because #17442 reported the panic was hit. But, rather than figuring out what happened, I can just make it impossible by construction. By adding just a bit more bureaucracy in the return types, I can handle TagToEnum in the same case as all the others, so the big case is is now total, and the panic is removed. Fixes #17442 - - - - - ee5d63f4 by John Ericson at 2020-01-16T05:59:37-05:00 Get rid of OpDest `OpDest` was basically a defunctionalization. Just turn the code that cased on it into those functions, and call them directly. - - - - - 1ff55226 by John Ericson at 2020-01-16T06:00:16-05:00 Remove special case case of bool during STG -> C-- Allow removing the no longer needed cgPrimOp, getting rid of a small a small layer violation too. Change which made the special case no longer needed was #6135 / 6579a6c73082387f82b994305011f011d9d8382b, which dates back to 2013, making me feel better. - - - - - f416fe64 by Adam Wespiser at 2020-01-16T06:00:53-05:00 replace dead html link (fixes #17661) - - - - - f6bf2ce8 by Sebastian Graf at 2020-01-16T06:01:32-05:00 Revert "`exprOkForSpeculation` for Note [IO hack in the demand analyser]" This reverts commit ce64b397777408731c6dd3f5c55ea8415f9f565b on the grounds of the regression it would introduce in a couple of packages. Fixes #17653. Also undoes a slight metric increase in #13701 introduced by that commit that we didn't see prior to !1983. Metric Decrease: T13701 - - - - - a71323ff by Ben Gamari at 2020-01-17T08:43:16-05:00 gitlab-ci: Don't FORCE_SYMLINKS on Windows Not all runners have symlink permissions enabled. - - - - - 0499e3bc by Ömer Sinan Ağacan at 2020-01-20T15:31:33-05:00 Fix +RTS -Z flag documentation Stack squeezing is done on context switch, not on GC or stack overflow. Fix the documentation. Fixes #17685 [ci skip] - - - - - a661df91 by Ömer Sinan Ağacan at 2020-01-20T15:32:13-05:00 Document Stg.FVs module Fixes #17662 [ci skip] - - - - - db24e480 by Ben Gamari at 2020-01-20T15:32:52-05:00 llvmGen: Don't trash STG registers Fixes #13904. - - - - - f3d7fdb3 by Ben Gamari at 2020-01-20T15:32:52-05:00 llvmGen: Fix typo in readnone attribute - - - - - 442751c6 by Ben Gamari at 2020-01-20T15:32:52-05:00 llvmGen: Add lower-expect to the -O0 optimisation set @kavon says that this will improve block layout for stack checks. - - - - - e90ecc93 by Ben Gamari at 2020-01-20T15:32:52-05:00 llvmGen: Fix #14251 Fixes the calling convention for functions passing raw SSE-register values by adding padding as needed to get the values in the right registers. This problem cropped up when some args were unused an dropped from the live list. This folds together 2e23e1c7de01c92b038e55ce53d11bf9db993dd4 and 73273be476a8cc6c13368660b042b3b0614fd928 previously from @kavon. Metric Increase: T12707 ManyConstructors - - - - - 66e511a4 by Ben Gamari at 2020-01-20T15:33:28-05:00 testsuite: Preserve more information in framework failures Namely print the entire exception in hopes that this will help track down #17649. - - - - - b62b8cea by Ömer Sinan Ağacan at 2020-01-20T15:34:06-05:00 Remove deprecated -smp flag It was deprecated in 2012 with 46258b40 - - - - - 0c04a86a by Ben Gamari at 2020-01-20T15:34:43-05:00 gitlab-ci: Reenable submodule linter - - - - - 2bfabd22 by Ben Gamari at 2020-01-20T15:34:43-05:00 gitlab-ci: Allow submodule cleaning to fail on Windows Currently CI is inexplicably failing with ``` $ git submodule foreach git clean -xdf fatal: not a git repository: libffi-tarballs/../.git/modules/libffi-tarballs ``` I have no idea how this working tree got into such a state but we do need to fail more gracefully when it happens. Consequently, we allow the cleaning step to fail. - - - - - 14bced99 by Xavier Denis at 2020-01-20T15:35:21-05:00 Put the docs for :instances in alphabetical position - - - - - 7e0bb82b by Ben Gamari at 2020-01-20T15:35:57-05:00 Add missing Note [Improvement from Ground Wanteds] Closes #17659. - - - - - 17e43a7c by Ben Gamari at 2020-01-20T15:36:32-05:00 unregisterised: Fix declaration for stg_NO_FINALIZER Previously it had a redundant _entry suffix. We never noticed this previously presumably because we never generated references to it (however hard to believe this may be). However, it did start failing in !1304. - - - - - 3dae006f by PHO at 2020-01-20T15:37:08-05:00 Avoid ./configure failure on NetBSD - - - - - 738e2912 by Ben Gamari at 2020-01-24T13:42:56-05:00 testsuite: Widen acceptance window of T1969 I have seen >20% fluctuations in this number, leading to spurious failures. - - - - - ad4eb7a7 by Gabor Greif at 2020-01-25T05:19:07-05:00 Document the fact, that openFileBlocking can consume an OS thread indefinitely. Also state that a deadlock can happen with the non-threaded runtime. [ci skip] - - - - - be910728 by Sebastian Graf at 2020-01-25T05:19:46-05:00 `-ddump-str-signatures` dumps Text, not STG [skip ci] - - - - - 0e57d8a1 by Ömer Sinan Ağacan at 2020-01-25T05:20:27-05:00 Fix chaining tagged and untagged ptrs in compacting GC Currently compacting GC has the invariant that in a chain all fields are tagged the same. However this does not really hold: root pointers are not tagged, so when we thread a root we initialize a chain without a tag. When the pointed objects is evaluated and we have more pointers to it from the heap, we then add *tagged* fields to the chain (because pointers to it from the heap are tagged), ending up chaining fields with different tags (pointers from roots are NOT tagged, pointers from heap are). This breaks the invariant and as a result compacting GC turns tagged pointers into non-tagged. This later causes problem in the generated code where we do reads assuming that the pointer is aligned, e.g. 0x7(%rax) -- assumes that pointer is tagged 1 which causes misaligned reads. This caused #17088. We fix this using the "pointer tagging for large families" patch (#14373, !1742): - With the pointer tagging patch the GC can know what the tagged pointer to a CONSTR should be (previously we'd need to know the family size -- large families are always tagged 1, small families are tagged depending on the constructor). - Since we now know what the tags should be we no longer need to store the pointer tag in the info table pointers when forming chains in the compacting GC. As a result we no longer need to tag pointers in chains with 1/2 depending on whether the field points to an info table pointer, or to another field: an info table pointer is always tagged 0, everything else in the chain is tagged 1. The lost tags in pointers can be retrieved by looking at the info table. Finally, instead of using tag 1 for fields and tag 0 for info table pointers, we use two different tags for fields: - 1 for fields that have untagged pointers - 2 for fields that have tagged pointers When unchaining we then look at the pointer to a field, and depending on its tag we either leave a tagged pointer or an untagged pointer in the field. This allows chaining untagged and tagged fields together in compacting GC. Fixes #17088 Nofib results ------------- Binaries are smaller because of smaller `Compact.c` code. make mode=fast EXTRA_RUNTEST_OPTS="-cachegrind" EXTRA_HC_OPTS="-with-rtsopts=-c" NoFibRuns=1 -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- CS -0.3% 0.0% +0.0% +0.0% +0.0% CSD -0.3% 0.0% +0.0% +0.0% +0.0% FS -0.3% 0.0% +0.0% -0.0% -0.0% S -0.3% 0.0% +5.4% +0.8% +3.9% VS -0.3% 0.0% +0.0% -0.0% -0.0% VSD -0.3% 0.0% -0.0% -0.0% -0.2% VSM -0.3% 0.0% +0.0% +0.0% +0.0% anna -0.1% 0.0% +0.0% +0.0% +0.0% ansi -0.3% 0.0% +0.1% +0.0% +0.0% atom -0.2% 0.0% +0.0% +0.0% +0.0% awards -0.2% 0.0% +0.0% 0.0% -0.0% banner -0.3% 0.0% +0.0% +0.0% +0.0% bernouilli -0.3% 0.0% +0.1% +0.0% +0.0% binary-trees -0.2% 0.0% +0.0% 0.0% +0.0% boyer -0.3% 0.0% +0.2% +0.0% +0.0% boyer2 -0.2% 0.0% +0.2% +0.1% +0.0% bspt -0.2% 0.0% +0.0% +0.0% +0.0% cacheprof -0.2% 0.0% +0.0% +0.0% +0.0% calendar -0.3% 0.0% +0.0% +0.0% +0.0% cichelli -0.3% 0.0% +1.1% +0.2% +0.5% circsim -0.2% 0.0% +0.0% -0.0% -0.0% clausify -0.3% 0.0% +0.0% -0.0% -0.0% comp_lab_zift -0.2% 0.0% +0.0% +0.0% +0.0% compress -0.3% 0.0% +0.0% +0.0% +0.0% compress2 -0.3% 0.0% +0.0% -0.0% -0.0% constraints -0.3% 0.0% +0.2% +0.1% +0.1% cryptarithm1 -0.3% 0.0% +0.0% -0.0% 0.0% cryptarithm2 -0.3% 0.0% +0.0% +0.0% +0.0% cse -0.3% 0.0% +0.0% +0.0% +0.0% digits-of-e1 -0.3% 0.0% +0.0% +0.0% +0.0% digits-of-e2 -0.3% 0.0% +0.0% +0.0% -0.0% dom-lt -0.2% 0.0% +0.0% +0.0% +0.0% eliza -0.2% 0.0% +0.0% +0.0% +0.0% event -0.3% 0.0% +0.1% +0.0% -0.0% exact-reals -0.2% 0.0% +0.0% +0.0% +0.0% exp3_8 -0.3% 0.0% +0.0% +0.0% +0.0% expert -0.2% 0.0% +0.0% +0.0% +0.0% fannkuch-redux -0.3% 0.0% -0.0% -0.0% -0.0% fasta -0.3% 0.0% +0.0% +0.0% +0.0% fem -0.2% 0.0% +0.1% +0.0% +0.0% fft -0.2% 0.0% +0.0% -0.0% -0.0% fft2 -0.2% 0.0% +0.0% -0.0% +0.0% fibheaps -0.3% 0.0% +0.0% -0.0% -0.0% fish -0.3% 0.0% +0.0% +0.0% +0.0% fluid -0.2% 0.0% +0.4% +0.1% +0.1% fulsom -0.2% 0.0% +0.0% +0.0% +0.0% gamteb -0.2% 0.0% +0.1% +0.0% +0.0% gcd -0.3% 0.0% +0.0% +0.0% +0.0% gen_regexps -0.3% 0.0% +0.0% -0.0% -0.0% genfft -0.3% 0.0% +0.0% +0.0% +0.0% gg -0.2% 0.0% +0.7% +0.3% +0.2% grep -0.2% 0.0% +0.0% +0.0% +0.0% hidden -0.2% 0.0% +0.0% +0.0% +0.0% hpg -0.2% 0.0% +0.1% +0.0% +0.0% ida -0.3% 0.0% +0.0% +0.0% +0.0% infer -0.2% 0.0% +0.0% -0.0% -0.0% integer -0.3% 0.0% +0.0% +0.0% +0.0% integrate -0.2% 0.0% +0.0% +0.0% +0.0% k-nucleotide -0.2% 0.0% +0.0% +0.0% -0.0% kahan -0.3% 0.0% -0.0% -0.0% -0.0% knights -0.3% 0.0% +0.0% -0.0% -0.0% lambda -0.3% 0.0% +0.0% -0.0% -0.0% last-piece -0.3% 0.0% +0.0% +0.0% +0.0% lcss -0.3% 0.0% +0.0% +0.0% 0.0% life -0.3% 0.0% +0.0% -0.0% -0.0% lift -0.2% 0.0% +0.0% +0.0% +0.0% linear -0.2% 0.0% +0.0% +0.0% +0.0% listcompr -0.3% 0.0% +0.0% +0.0% +0.0% listcopy -0.3% 0.0% +0.0% +0.0% +0.0% maillist -0.3% 0.0% +0.0% -0.0% -0.0% mandel -0.2% 0.0% +0.0% +0.0% +0.0% mandel2 -0.3% 0.0% +0.0% +0.0% +0.0% mate -0.2% 0.0% +0.0% +0.0% +0.0% minimax -0.3% 0.0% +0.0% +0.0% +0.0% mkhprog -0.2% 0.0% +0.0% +0.0% +0.0% multiplier -0.3% 0.0% +0.0% -0.0% -0.0% n-body -0.2% 0.0% -0.0% -0.0% -0.0% nucleic2 -0.2% 0.0% +0.0% +0.0% +0.0% para -0.2% 0.0% +0.0% -0.0% -0.0% paraffins -0.3% 0.0% +0.0% -0.0% -0.0% parser -0.2% 0.0% +0.0% +0.0% +0.0% parstof -0.2% 0.0% +0.8% +0.2% +0.2% pic -0.2% 0.0% +0.1% -0.1% -0.1% pidigits -0.3% 0.0% +0.0% +0.0% +0.0% power -0.2% 0.0% +0.0% -0.0% -0.0% pretty -0.3% 0.0% -0.0% -0.0% -0.1% primes -0.3% 0.0% +0.0% +0.0% -0.0% primetest -0.2% 0.0% +0.0% -0.0% -0.0% prolog -0.3% 0.0% +0.0% -0.0% -0.0% puzzle -0.3% 0.0% +0.0% +0.0% +0.0% queens -0.3% 0.0% +0.0% +0.0% +0.0% reptile -0.2% 0.0% +0.2% +0.1% +0.0% reverse-complem -0.3% 0.0% +0.0% +0.0% +0.0% rewrite -0.3% 0.0% +0.0% -0.0% -0.0% rfib -0.2% 0.0% +0.0% +0.0% -0.0% rsa -0.2% 0.0% +0.0% +0.0% +0.0% scc -0.3% 0.0% -0.0% -0.0% -0.1% sched -0.3% 0.0% +0.0% +0.0% +0.0% scs -0.2% 0.0% +0.1% +0.0% +0.0% simple -0.2% 0.0% +3.4% +1.0% +1.8% solid -0.2% 0.0% +0.0% +0.0% +0.0% sorting -0.3% 0.0% +0.0% +0.0% +0.0% spectral-norm -0.2% 0.0% -0.0% -0.0% -0.0% sphere -0.2% 0.0% +0.0% +0.0% +0.0% symalg -0.2% 0.0% +0.0% +0.0% +0.0% tak -0.3% 0.0% +0.0% +0.0% -0.0% transform -0.2% 0.0% +0.2% +0.1% +0.1% treejoin -0.3% 0.0% +0.2% -0.0% -0.1% typecheck -0.3% 0.0% +0.0% +0.0% +0.0% veritas -0.1% 0.0% +0.0% +0.0% +0.0% wang -0.2% 0.0% +0.0% -0.0% -0.0% wave4main -0.3% 0.0% +0.0% -0.0% -0.0% wheel-sieve1 -0.3% 0.0% +0.0% -0.0% -0.0% wheel-sieve2 -0.3% 0.0% +0.0% -0.0% -0.0% x2n1 -0.3% 0.0% +0.0% +0.0% +0.0% -------------------------------------------------------------------------------- Min -0.3% 0.0% -0.0% -0.1% -0.2% Max -0.1% 0.0% +5.4% +1.0% +3.9% Geometric Mean -0.3% -0.0% +0.1% +0.0% +0.1% -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- circsim -0.2% 0.0% +1.6% +0.4% +0.7% constraints -0.3% 0.0% +4.3% +1.5% +2.3% fibheaps -0.3% 0.0% +3.5% +1.2% +1.3% fulsom -0.2% 0.0% +3.6% +1.2% +1.8% gc_bench -0.3% 0.0% +4.1% +1.3% +2.3% hash -0.3% 0.0% +6.6% +2.2% +3.6% lcss -0.3% 0.0% +0.7% +0.2% +0.7% mutstore1 -0.3% 0.0% +4.8% +1.4% +2.8% mutstore2 -0.3% 0.0% +3.4% +1.0% +1.7% power -0.2% 0.0% +2.7% +0.6% +1.9% spellcheck -0.3% 0.0% +1.1% +0.4% +0.4% -------------------------------------------------------------------------------- Min -0.3% 0.0% +0.7% +0.2% +0.4% Max -0.2% 0.0% +6.6% +2.2% +3.6% Geometric Mean -0.3% +0.0% +3.3% +1.0% +1.8% Metric changes -------------- While it sounds ridiculous, this change causes increased allocations in the following tests. We concluded that this change can't cause a difference in allocations and decided to land this patch. Fluctuations in "bytes allocated" metric is tracked in #17686. Metric Increase: Naperian T10547 T12150 T12234 T12425 T13035 T5837 T6048 - - - - - 8038cbd9 by Sebastian Graf at 2020-01-25T05:21:05-05:00 PmCheck: Formulate as translation between Clause Trees We used to check `GrdVec`s arising from multiple clauses and guards in isolation. That resulted in a split between `pmCheck` and `pmCheckGuards`, the implementations of which were similar, but subtly different in detail. Also the throttling mechanism described in `Note [Countering exponential blowup]` ultimately got quite complicated because it had to cater for both checking functions. This patch realises that pattern match checking doesn't just consider single guarded RHSs, but that it's always a whole set of clauses, each of which can have multiple guarded RHSs in turn. We do so by translating a list of `Match`es to a `GrdTree`: ```haskell data GrdTree = Rhs !RhsInfo | Guard !PmGrd !GrdTree -- captures lef-to-right match semantics | Sequence !GrdTree !GrdTree -- captures top-to-bottom match semantics | Empty -- For -XEmptyCase, neutral element of Sequence ``` Then we have a function `checkGrdTree` that matches a given `GrdTree` against an incoming set of values, represented by `Deltas`: ```haskell checkGrdTree :: GrdTree -> Deltas -> CheckResult ... ``` Throttling is isolated to the `Sequence` case and becomes as easy as one would expect: When the union of uncovered values becomes too big, just return the original incoming `Deltas` instead (which is always a superset of the union, thus a sound approximation). The returned `CheckResult` contains two things: 1. The set of values that were not covered by any of the clauses, for exhaustivity warnings. 2. The `AnnotatedTree` that enriches the syntactic structure of the input program with divergence and inaccessibility information. This is `AnnotatedTree`: ```haskell data AnnotatedTree = AccessibleRhs !RhsInfo | InaccessibleRhs !RhsInfo | MayDiverge !AnnotatedTree | SequenceAnn !AnnotatedTree !AnnotatedTree | EmptyAnn ``` Crucially, `MayDiverge` asserts that the tree may force diverging values, so not all of its wrapped clauses can be redundant. While the set of uncovered values can be used to generate the missing equations for warning messages, redundant and proper inaccessible equations can be extracted from `AnnotatedTree` by `redundantAndInaccessibleRhss`. For this to work properly, the interface to the Oracle had to change. There's only `addPmCts` now, which takes a bag of `PmCt`s. There's a whole bunch of `PmCt` variants to replace the different oracle functions from before. The new `AnnotatedTree` structure allows for more accurate warning reporting (as evidenced by a number of changes spread throughout GHC's code base), thus we fix #17465. Fixes #17646 on the go. Metric Decrease: T11822 T9233 PmSeriesS haddock.compiler - - - - - 86966d48 by Sebastian Graf at 2020-01-25T05:21:05-05:00 PmCheck: Properly handle constructor-bound type variables In https://gitlab.haskell.org/ghc/ghc/merge_requests/2192#note_246551 Simon convinced me that ignoring type variables existentially bound by data constructors have to be the same way as value binders. Sadly I couldn't think of a regression test, but I'm confident that this change strictly improves on the status quo. - - - - - c3fde723 by Ryan Scott at 2020-01-25T05:21:40-05:00 Handle local fixity declarations in DsMeta properly `DsMeta.rep_sig` used to skip over `FixSig` entirely, which had the effect of causing local fixity declarations to be dropped when quoted in Template Haskell. But there is no good reason for this state of affairs, as the code in `DsMeta.repFixD` (which handles top-level fixity declarations) handles local fixity declarations just fine. This patch factors out the necessary parts of `repFixD` so that they can be used in `rep_sig` as well. There was one minor complication: the fixity signatures for class methods in each `HsGroup` were stored both in `FixSig`s _and_ the list of `LFixitySig`s for top-level fixity signatures, so I needed to take action to prevent fixity signatures for class methods being converted to `Dec`s twice. I tweaked `RnSource.add` to avoid putting these fixity signatures in two places and added `Note [Top-level fixity signatures in an HsGroup]` in `GHC.Hs.Decls` to explain the new design. Fixes #17608. Bumps the Haddock submodule. - - - - - 6e2d9ee2 by Sylvain Henry at 2020-01-25T05:22:20-05:00 Module hierarchy: Cmm (cf #13009) - - - - - 8b726534 by PHO at 2020-01-25T05:23:01-05:00 Fix rts allocateExec() on NetBSD Similar to SELinux, NetBSD "PaX mprotect" prohibits marking a page mapping both writable and executable at the same time. Use libffi which knows how to work around it. - - - - - 6eb566a0 by Xavier Denis at 2020-01-25T05:23:39-05:00 Add ghc-in-ghci for stack based builds - - - - - b1a32170 by Xavier Denis at 2020-01-25T05:23:39-05:00 Create ghci.cabal.sh - - - - - 0a5e4f5f by Sylvain Henry at 2020-01-25T05:24:19-05:00 Split glasgow_exts into several files (#17316) - - - - - b3e5c678 by Ben Gamari at 2020-01-25T05:24:57-05:00 hadrian: Throw error on duplicate-named flavours Throw an error if the user requests a flavour for which there is more than one match. Fixes #17156. - - - - - 0940b59a by Ryan Scott at 2020-01-25T08:15:05-05:00 Do not bring visible foralls into scope in hsScopedTvs Previously, `hsScopedTvs` (and its cousin `hsWcScopedTvs`) pretended that visible dependent quantification could not possibly happen at the term level, and cemented that assumption with an `ASSERT`: ```hs hsScopedTvs (HsForAllTy { hst_fvf = vis_flag, ... }) = ASSERT( vis_flag == ForallInvis ) ... ``` It turns out that this assumption is wrong. You can end up tripping this `ASSERT` if you stick it to the man and write a type for a term that uses visible dependent quantification anyway, like in this example: ```hs {-# LANGUAGE ScopedTypeVariables #-} x :: forall a -> a -> a x = x ``` That won't typecheck, but that's not the point. Before the typechecker has a chance to reject this, the renamer will try to use `hsScopedTvs` to bring `a` into scope over the body of `x`, since `a` is quantified by a `forall`. This, in turn, causes the `ASSERT` to fail. Bummer. Instead of walking on this dangerous ground, this patch makes GHC adopt a more hardline stance by pattern-matching directly on `ForallInvis` in `hsScopedTvs`: ```hs hsScopedTvs (HsForAllTy { hst_fvf = ForallInvis, ... }) = ... ``` Now `a` will not be brought over the body of `x` at all (which is how it should be), there's no chance of the `ASSERT` failing anymore (as it's gone), and best of all, the behavior of `hsScopedTvs` does not change. Everyone wins! Fixes #17687. - - - - - 1132602f by Ryan Scott at 2020-01-27T10:03:42-05:00 Use splitLHs{ForAll,Sigma}TyInvis throughout the codebase Richard points out in #17688 that we use `splitLHsForAllTy` and `splitLHsSigmaTy` in places that we ought to be using the corresponding `-Invis` variants instead, identifying two bugs that are caused by this oversight: * Certain TH-quoted type signatures, such as those that appear in quoted `SPECIALISE` pragmas, silently turn visible `forall`s into invisible `forall`s. * When quoted, the type `forall a -> (a ~ a) => a` will turn into `forall a -> a` due to a bug in `DsMeta.repForall` that drops contexts that follow visible `forall`s. These are both ultimately caused by the fact that `splitLHsForAllTy` and `splitLHsSigmaTy` split apart visible `forall`s in addition to invisible ones. This patch cleans things up: * We now use `splitLHsForAllTyInvis` and `splitLHsSigmaTyInvis` throughout the codebase. Relatedly, the `splitLHsForAllTy` and `splitLHsSigmaTy` have been removed, as they are easy to misuse. * `DsMeta.repForall` now only handles invisible `forall`s to reduce the chance for confusion with visible `forall`s, which need to be handled differently. I also renamed it from `repForall` to `repForallT` to emphasize that its distinguishing characteristic is the fact that it desugars down to `L.H.TH.Syntax.ForallT`. Fixes #17688. - - - - - 97d0b0a3 by Matthew Pickering at 2020-01-27T10:04:19-05:00 Make Block.h compile with c++ compilers - - - - - 4bada77d by Tom Ellis at 2020-01-27T12:30:46-05:00 Disable two warnings for files that trigger them incomplete-uni-patterns and incomplete-record-updates will be in -Wall at a future date, so prepare for that by disabling those warnings on files that trigger them. - - - - - 0188404a by Tom Ellis at 2020-01-27T12:30:46-05:00 Add two warnings to stage 2 build - - - - - acae02c1 by Tom Ellis at 2020-01-27T12:30:46-05:00 Add two warnings to Hadrian - - - - - bf38a20e by Sylvain Henry at 2020-01-31T02:46:15-05:00 Call `interpretPackageEnv` from `setSessionDynFlags` interpretPackageEnv modifies the flags by reading the dreaded package environments. It is much less surprising to call it from `setSessionDynFlags` instead of reading package environments as a side-effect of `initPackages`. - - - - - 29c701c1 by Sylvain Henry at 2020-01-31T02:46:15-05:00 Refactor package related code The package terminology is a bit of a mess. Cabal packages contain components. Instances of these components when built with some flags/options/dependencies are called units. Units are registered into package databases and their metadata are called PackageConfig. GHC only knows about package databases containing units. It is a sad mismatch not fixed by this patch (we would have to rename parameters such as `package-id <unit-id>` which would affect users). This patch however fixes the following internal names: - Renames PackageConfig into UnitInfo. - Rename systemPackageConfig into globalPackageDatabase[Path] - Rename PkgConfXX into PkgDbXX - Rename pkgIdMap into unitIdMap - Rename ModuleToPkgDbAll into ModuleNameProvidersMap - Rename lookupPackage into lookupUnit - Add comments on DynFlags package related fields It also introduces a new `PackageDatabase` datatype instead of explicitly passing the following tuple: `(FilePath,[PackageConfig])`. The `pkgDatabase` field in `DynFlags` now contains the unit info for each unit of each package database exactly as they have been read from disk. Previously the command-line flag `-distrust-all-packages` would modify these unit info. Now this flag only affects the "dynamic" consolidated package state found in `pkgState` field. It makes sense because `initPackages` could be called first with this `distrust-all-packages` flag set and then again (using ghc-api) without and it should work (package databases are not read again from disk when `initPackages` is called the second time). Bump haddock submodule - - - - - 942c7148 by Ben Gamari at 2020-01-31T02:46:54-05:00 rename: Eliminate usage of mkVarOccUnique Replacing it with `newSysName`. Fixes #17061. - - - - - 41117d71 by Ben Gamari at 2020-01-31T02:47:31-05:00 base: Use one-shot kqueue on macOS The underlying reason requiring that one-shot usage be disabled (#13903) has been fixed. Closes #15768. - - - - - 01b15b83 by Ben Gamari at 2020-01-31T02:48:08-05:00 testsuite: Don't crash on encoding failure in print If the user doesn't use a Unicode locale then the testsuite driver would previously throw framework failures due to encoding failures. We now rather use the `replace` error-handling strategy. - - - - - c846618a by Ömer Sinan Ağacan at 2020-01-31T12:21:10+03:00 Do CafInfo/SRT analysis in Cmm This patch removes all CafInfo predictions and various hacks to preserve predicted CafInfos from the compiler and assigns final CafInfos to interface Ids after code generation. SRT analysis is extended to support static data, and Cmm generator is modified to allow generating static_link fields after SRT analysis. This also fixes `-fcatch-bottoms`, which introduces error calls in case expressions in CorePrep, which runs *after* CoreTidy (which is where we decide on CafInfos) and turns previously non-CAFFY things into CAFFY. Fixes #17648 Fixes #9718 Evaluation ========== NoFib ----- Boot with: `make boot mode=fast` Run: `make mode=fast EXTRA_RUNTEST_OPTS="-cachegrind" NoFibRuns=1` -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- CS -0.0% 0.0% -0.0% -0.0% -0.0% CSD -0.0% 0.0% -0.0% -0.0% -0.0% FS -0.0% 0.0% -0.0% -0.0% -0.0% S -0.0% 0.0% -0.0% -0.0% -0.0% VS -0.0% 0.0% -0.0% -0.0% -0.0% VSD -0.0% 0.0% -0.0% -0.0% -0.5% VSM -0.0% 0.0% -0.0% -0.0% -0.0% anna -0.1% 0.0% -0.0% -0.0% -0.0% ansi -0.0% 0.0% -0.0% -0.0% -0.0% atom -0.0% 0.0% -0.0% -0.0% -0.0% awards -0.0% 0.0% -0.0% -0.0% -0.0% banner -0.0% 0.0% -0.0% -0.0% -0.0% bernouilli -0.0% 0.0% -0.0% -0.0% -0.0% binary-trees -0.0% 0.0% -0.0% -0.0% -0.0% boyer -0.0% 0.0% -0.0% -0.0% -0.0% boyer2 -0.0% 0.0% -0.0% -0.0% -0.0% bspt -0.0% 0.0% -0.0% -0.0% -0.0% cacheprof -0.0% 0.0% -0.0% -0.0% -0.0% calendar -0.0% 0.0% -0.0% -0.0% -0.0% cichelli -0.0% 0.0% -0.0% -0.0% -0.0% circsim -0.0% 0.0% -0.0% -0.0% -0.0% clausify -0.0% 0.0% -0.0% -0.0% -0.0% comp_lab_zift -0.0% 0.0% -0.0% -0.0% -0.0% compress -0.0% 0.0% -0.0% -0.0% -0.0% compress2 -0.0% 0.0% -0.0% -0.0% -0.0% constraints -0.0% 0.0% -0.0% -0.0% -0.0% cryptarithm1 -0.0% 0.0% -0.0% -0.0% -0.0% cryptarithm2 -0.0% 0.0% -0.0% -0.0% -0.0% cse -0.0% 0.0% -0.0% -0.0% -0.0% digits-of-e1 -0.0% 0.0% -0.0% -0.0% -0.0% digits-of-e2 -0.0% 0.0% -0.0% -0.0% -0.0% dom-lt -0.0% 0.0% -0.0% -0.0% -0.0% eliza -0.0% 0.0% -0.0% -0.0% -0.0% event -0.0% 0.0% -0.0% -0.0% -0.0% exact-reals -0.0% 0.0% -0.0% -0.0% -0.0% exp3_8 -0.0% 0.0% -0.0% -0.0% -0.0% expert -0.0% 0.0% -0.0% -0.0% -0.0% fannkuch-redux -0.0% 0.0% -0.0% -0.0% -0.0% fasta -0.0% 0.0% -0.0% -0.0% -0.0% fem -0.0% 0.0% -0.0% -0.0% -0.0% fft -0.0% 0.0% -0.0% -0.0% -0.0% fft2 -0.0% 0.0% -0.0% -0.0% -0.0% fibheaps -0.0% 0.0% -0.0% -0.0% -0.0% fish -0.0% 0.0% -0.0% -0.0% -0.0% fluid -0.1% 0.0% -0.0% -0.0% -0.0% fulsom -0.0% 0.0% -0.0% -0.0% -0.0% gamteb -0.0% 0.0% -0.0% -0.0% -0.0% gcd -0.0% 0.0% -0.0% -0.0% -0.0% gen_regexps -0.0% 0.0% -0.0% -0.0% -0.0% genfft -0.0% 0.0% -0.0% -0.0% -0.0% gg -0.0% 0.0% -0.0% -0.0% -0.0% grep -0.0% 0.0% -0.0% -0.0% -0.0% hidden -0.0% 0.0% -0.0% -0.0% -0.0% hpg -0.1% 0.0% -0.0% -0.0% -0.0% ida -0.0% 0.0% -0.0% -0.0% -0.0% infer -0.0% 0.0% -0.0% -0.0% -0.0% integer -0.0% 0.0% -0.0% -0.0% -0.0% integrate -0.0% 0.0% -0.0% -0.0% -0.0% k-nucleotide -0.0% 0.0% -0.0% -0.0% -0.0% kahan -0.0% 0.0% -0.0% -0.0% -0.0% knights -0.0% 0.0% -0.0% -0.0% -0.0% lambda -0.0% 0.0% -0.0% -0.0% -0.0% last-piece -0.0% 0.0% -0.0% -0.0% -0.0% lcss -0.0% 0.0% -0.0% -0.0% -0.0% life -0.0% 0.0% -0.0% -0.0% -0.0% lift -0.0% 0.0% -0.0% -0.0% -0.0% linear -0.1% 0.0% -0.0% -0.0% -0.0% listcompr -0.0% 0.0% -0.0% -0.0% -0.0% listcopy -0.0% 0.0% -0.0% -0.0% -0.0% maillist -0.0% 0.0% -0.0% -0.0% -0.0% mandel -0.0% 0.0% -0.0% -0.0% -0.0% mandel2 -0.0% 0.0% -0.0% -0.0% -0.0% mate -0.0% 0.0% -0.0% -0.0% -0.0% minimax -0.0% 0.0% -0.0% -0.0% -0.0% mkhprog -0.0% 0.0% -0.0% -0.0% -0.0% multiplier -0.0% 0.0% -0.0% -0.0% -0.0% n-body -0.0% 0.0% -0.0% -0.0% -0.0% nucleic2 -0.0% 0.0% -0.0% -0.0% -0.0% para -0.0% 0.0% -0.0% -0.0% -0.0% paraffins -0.0% 0.0% -0.0% -0.0% -0.0% parser -0.1% 0.0% -0.0% -0.0% -0.0% parstof -0.1% 0.0% -0.0% -0.0% -0.0% pic -0.0% 0.0% -0.0% -0.0% -0.0% pidigits -0.0% 0.0% -0.0% -0.0% -0.0% power -0.0% 0.0% -0.0% -0.0% -0.0% pretty -0.0% 0.0% -0.3% -0.4% -0.4% primes -0.0% 0.0% -0.0% -0.0% -0.0% primetest -0.0% 0.0% -0.0% -0.0% -0.0% prolog -0.0% 0.0% -0.0% -0.0% -0.0% puzzle -0.0% 0.0% -0.0% -0.0% -0.0% queens -0.0% 0.0% -0.0% -0.0% -0.0% reptile -0.0% 0.0% -0.0% -0.0% -0.0% reverse-complem -0.0% 0.0% -0.0% -0.0% -0.0% rewrite -0.0% 0.0% -0.0% -0.0% -0.0% rfib -0.0% 0.0% -0.0% -0.0% -0.0% rsa -0.0% 0.0% -0.0% -0.0% -0.0% scc -0.0% 0.0% -0.3% -0.5% -0.4% sched -0.0% 0.0% -0.0% -0.0% -0.0% scs -0.0% 0.0% -0.0% -0.0% -0.0% simple -0.1% 0.0% -0.0% -0.0% -0.0% solid -0.0% 0.0% -0.0% -0.0% -0.0% sorting -0.0% 0.0% -0.0% -0.0% -0.0% spectral-norm -0.0% 0.0% -0.0% -0.0% -0.0% sphere -0.0% 0.0% -0.0% -0.0% -0.0% symalg -0.0% 0.0% -0.0% -0.0% -0.0% tak -0.0% 0.0% -0.0% -0.0% -0.0% transform -0.0% 0.0% -0.0% -0.0% -0.0% treejoin -0.0% 0.0% -0.0% -0.0% -0.0% typecheck -0.0% 0.0% -0.0% -0.0% -0.0% veritas -0.0% 0.0% -0.0% -0.0% -0.0% wang -0.0% 0.0% -0.0% -0.0% -0.0% wave4main -0.0% 0.0% -0.0% -0.0% -0.0% wheel-sieve1 -0.0% 0.0% -0.0% -0.0% -0.0% wheel-sieve2 -0.0% 0.0% -0.0% -0.0% -0.0% x2n1 -0.0% 0.0% -0.0% -0.0% -0.0% -------------------------------------------------------------------------------- Min -0.1% 0.0% -0.3% -0.5% -0.5% Max -0.0% 0.0% -0.0% -0.0% -0.0% Geometric Mean -0.0% -0.0% -0.0% -0.0% -0.0% -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- circsim -0.1% 0.0% -0.0% -0.0% -0.0% constraints -0.0% 0.0% -0.0% -0.0% -0.0% fibheaps -0.0% 0.0% -0.0% -0.0% -0.0% gc_bench -0.0% 0.0% -0.0% -0.0% -0.0% hash -0.0% 0.0% -0.0% -0.0% -0.0% lcss -0.0% 0.0% -0.0% -0.0% -0.0% power -0.0% 0.0% -0.0% -0.0% -0.0% spellcheck -0.0% 0.0% -0.0% -0.0% -0.0% -------------------------------------------------------------------------------- Min -0.1% 0.0% -0.0% -0.0% -0.0% Max -0.0% 0.0% -0.0% -0.0% -0.0% Geometric Mean -0.0% +0.0% -0.0% -0.0% -0.0% Manual inspection of programs in testsuite/tests/programs --------------------------------------------------------- I built these programs with a bunch of dump flags and `-O` and compared STG, Cmm, and Asm dumps and file sizes. (Below the numbers in parenthesis show number of modules in the program) These programs have identical compiler (same .hi and .o sizes, STG, and Cmm and Asm dumps): - Queens (1), andre_monad (1), cholewo-eval (2), cvh_unboxing (3), andy_cherry (7), fun_insts (1), hs-boot (4), fast2haskell (2), jl_defaults (1), jq_readsPrec (1), jules_xref (1), jtod_circint (4), jules_xref2 (1), lennart_range (1), lex (1), life_space_leak (1), bargon-mangler-bug (7), record_upd (1), rittri (1), sanders_array (1), strict_anns (1), thurston-module-arith (2), okeefe_neural (1), joao-circular (6), 10queens (1) Programs with different compiler outputs: - jl_defaults (1): For some reason GHC HEAD marks a lot of top-level `[Int]` closures as CAFFY for no reason. With this patch we no longer make them CAFFY and generate less SRT entries. For some reason Main.o is slightly larger with this patch (1.3%) and the executable sizes are the same. (I'd expect both to be smaller) - launchbury (1): Same as jl_defaults: top-level `[Int]` closures marked as CAFFY for no reason. Similarly `Main.o` is 1.4% larger but the executable sizes are the same. - galois_raytrace (13): Differences are in the Parse module. There are a lot, but some of the changes are caused by the fact that for some reason (I think a bug) GHC HEAD marks the dictionary for `Functor Identity` as CAFFY. Parse.o is 0.4% larger, the executable size is the same. - north_array: We now generate less SRT entries because some of array primops used in this program like `NewArrayOp` get eliminated during Stg-to-Cmm and turn some CAFFY things into non-CAFFY. Main.o gets 24% larger (9224 bytes from 9000 bytes), executable sizes are the same. - seward-space-leak: Difference in this program is better shown by this smaller example: module Lib where data CDS = Case [CDS] [(Int, CDS)] | Call CDS CDS instance Eq CDS where Case sels1 rets1 == Case sels2 rets2 = sels1 == sels2 && rets1 == rets2 Call a1 b1 == Call a2 b2 = a1 == a2 && b1 == b2 _ == _ = False In this program GHC HEAD builds a new SRT for the recursive group of `(==)`, `(/=)` and the dictionary closure. Then `/=` points to `==` in its SRT field, and `==` uses the SRT object as its SRT. With this patch we use the closure for `/=` as the SRT and add `==` there. Then `/=` gets an empty SRT field and `==` points to `/=` in its SRT field. This change looks fine to me. Main.o gets 0.07% larger, executable sizes are identical. head.hackage ------------ head.hackage's CI script builds 428 packages from Hackage using this patch with no failures. Compiler performance -------------------- The compiler perf tests report that the compiler allocates slightly more (worst case observed so far is 4%). However most programs in the test suite are small, single file programs. To benchmark compiler performance on something more realistic I build Cabal (the library, 236 modules) with different optimisation levels. For the "max residency" row I run GHC with `+RTS -s -A100k -i0 -h` for more accurate numbers. Other rows are generated with just `-s`. (This is because `-i0` causes running GC much more frequently and as a result "bytes copied" gets inflated by more than 25x in some cases) * -O0 | | GHC HEAD | This MR | Diff | | --------------- | -------------- | -------------- | ------ | | Bytes allocated | 54,413,350,872 | 54,701,099,464 | +0.52% | | Bytes copied | 4,926,037,184 | 4,990,638,760 | +1.31% | | Max residency | 421,225,624 | 424,324,264 | +0.73% | * -O1 | | GHC HEAD | This MR | Diff | | --------------- | --------------- | --------------- | ------ | | Bytes allocated | 245,849,209,992 | 246,562,088,672 | +0.28% | | Bytes copied | 26,943,452,560 | 27,089,972,296 | +0.54% | | Max residency | 982,643,440 | 991,663,432 | +0.91% | * -O2 | | GHC HEAD | This MR | Diff | | --------------- | --------------- | --------------- | ------ | | Bytes allocated | 291,044,511,408 | 291,863,910,912 | +0.28% | | Bytes copied | 37,044,237,616 | 36,121,690,472 | -2.49% | | Max residency | 1,071,600,328 | 1,086,396,256 | +1.38% | Extra compiler allocations -------------------------- Runtime allocations of programs are as reported above (NoFib section). The compiler now allocates more than before. Main source of allocation in this patch compared to base commit is the new SRT algorithm (GHC.Cmm.Info.Build). Below is some of the extra work we do with this patch, numbers generated by profiled stage 2 compiler when building a pathological case (the test 'ManyConstructors') with '-O2': - We now sort the final STG for a module, which means traversing the entire program, generating free variable set for each top-level binding, doing SCC analysis, and re-ordering the program. In ManyConstructors this step allocates 97,889,952 bytes. - We now do SRT analysis on static data, which in a program like ManyConstructors causes analysing 10,000 bindings that we would previously just skip. This step allocates 70,898,352 bytes. - We now maintain an SRT map for the entire module as we compile Cmm groups: data ModuleSRTInfo = ModuleSRTInfo { ... , moduleSRTMap :: SRTMap } (SRTMap is just a strict Map from the 'containers' library) This map gets an entry for most bindings in a module (exceptions are THUNKs and CAFFY static functions). For ManyConstructors this map gets 50015 entries. - Once we're done with code generation we generate a NameSet from SRTMap for the non-CAFFY names in the current module. This set gets the same number of entries as the SRTMap. - Finally we update CafInfos in ModDetails for the non-CAFFY Ids, using the NameSet generated in the previous step. This usually does the least amount of allocation among the work listed here. Only place with this patch where we do less work in the CAF analysis in the tidying pass (CoreTidy). However that doesn't save us much, as the pass still needs to traverse the whole program and update IdInfos for other reasons. Only thing we don't here do is the `hasCafRefs` pass over the RHS of bindings, which is a stateless pass that returns a boolean value, so it doesn't allocate much. (Metric changes blow are all increased allocations) Metric changes -------------- Metric Increase: ManyAlternatives ManyConstructors T13035 T14683 T1969 T9961 - - - - - 2a87a565 by Andreas Klebinger at 2020-01-31T12:21:10+03:00 A few optimizations in STG and Cmm parts: (Guided by the profiler output) - Add a few bang patterns, INLINABLE annotations, and a seqList in a few places in Cmm and STG parts. - Do not add external variables as dependencies in STG dependency analysis (GHC.Stg.DepAnal). - - - - - bef704b6 by Simon Peyton Jones at 2020-02-01T02:28:45-05:00 Improve skolemisation This patch avoids skolemiseUnboundMetaTyVar making up a fresh Name when it doesn't need to. See Note [Skolemising and identity] Improves error messsages for partial type signatures. - - - - - cd110423 by Simon Peyton Jones at 2020-02-01T02:28:45-05:00 Improve pretty-printing for TyConBinders In particular, show their kinds. - - - - - 913287a0 by Simon Peyton Jones at 2020-02-01T02:28:45-05:00 Fix scoping of TyCon binders in TcTyClsDecls This patch fixes #17566 by refactoring the way we decide the final identity of the tyvars in the TyCons of a possibly-recursive nest of type and class decls, possibly with associated types. It's all laid out in Note [Swizzling the tyvars before generaliseTcTyCon] Main changes: * We have to generalise each decl (with its associated types) all at once: TcTyClsDecls.generaliseTyClDecl * The main new work is done in TcTyClsDecls.swizzleTcTyConBndrs * The mysterious TcHsSyn.zonkRecTyVarBndrs dies altogether Other smaller things: * A little refactoring, moving bindTyClTyVars from tcTyClDecl1 to tcDataDefn, tcSynRhs, etc. Clearer, reduces the number of parameters * Reduce the amount of swizzling required. Specifically, bindExplicitTKBndrs_Q_Tv doesn't need to clone a new Name for the TyVarTv, and not cloning means that in the vasly common case, swizzleTyConBndrs is a no-op In detail: Rename newTyVarTyVar --> cloneTyVarTyVar Add newTyVarTyTyVar that doesn't clone Use the non-cloning newTyVarTyVar in bindExplicitTKBndrs_Q_Tv Rename newFlexiKindedTyVarTyVar --> cloneFlexiKindedTyVarTyVar * Define new utility function and use it HsDecls.familyDeclName :: FamilyDecl (GhcPass p) -> IdP (GhcPass p) Updates haddock submodule. - - - - - 58ed6c4a by Ben Gamari at 2020-02-01T02:29:23-05:00 rts/M32Alloc: Don't attempt to unmap non-existent pages The m32 allocator's `pages` list may contain NULLs in the case that the page was flushed. Some `munmap` implementations (e.g. FreeBSD's) don't like it if we pass them NULL. Don't do that. - - - - - 859db7d6 by Ömer Sinan Ağacan at 2020-02-01T14:18:49+03:00 Improve/fix -fcatch-bottoms documentation Old documentation suggests that -fcatch-bottoms only adds a default alternative to bottoming case expression, but that's not true. We use a very simplistic "is exhaustive" check and add default alternatives to any case expression that does not cover all constructors of the type. In case of GADTs this simple check assumes all constructors should be covered, even the ones ruled out by the type of the scrutinee. Update the documentation to reflect this. (Originally noticed in #17648) [ci skip] - - - - - 54dfa94a by John Ericson at 2020-02-03T21:14:24-05:00 Fix docs for FrontendResult Other variant was removed in ac1a379363618a6f2f17fff65ce9129164b6ef30 but docs were no changed. - - - - - 5e63d9c0 by John Ericson at 2020-02-03T21:15:02-05:00 Refactor HscMain.finish I found the old control flow a bit hard to follow; I rewrote it to first decide whether to desugar, and then use that choice when computing whether to simplify / what sort of interface file to write. I hope eventually we will always write post-tc interface files, which will make the logic of this function even simpler, and continue the thrust of this refactor. - - - - - e580e5b8 by Stefan Schulze Frielinghaus at 2020-02-04T09:29:00-05:00 Do not build StgCRunAsm.S for unregisterised builds For unregisterised builds StgRun/StgReturn are implemented via a mini interpreter in StgCRun.c and therefore would collide with the implementations in StgCRunAsm.S. - - - - - e3b0bd97 by Stefan Schulze Frielinghaus at 2020-02-04T09:29:00-05:00 fixup! fixup! Do not build StgCRunAsm.S for unregisterised builds - - - - - eb629fab by John Ericson at 2020-02-04T09:29:38-05:00 Delete some superfluous helper functions in HscMain The driver code is some of the nastiest in GHC, and I am worried about being able to untangle all the tech debt. In `HscMain` we have a number of helpers which are either not-used or little used. I delete them so we can reduce cognative load, distilling the essential complexity away from the cruft. - - - - - c90eca55 by Sebastian Graf at 2020-02-05T09:21:29-05:00 PmCheck: Record type constraints arising from existentials in `PmCoreCt`s In #17703 (a follow-up of !2192), we established that contrary to my belief, type constraints arising from existentials in code like ```hs data Ex where Ex :: a -> Ex f _ | let x = Ex @Int 15 = case x of Ex -> ... ``` are in fact useful. This commit makes a number of refactorings and improvements to comments, but fundamentally changes `addCoreCt.core_expr` to record the type constraint `a ~ Int` in addition to `x ~ Ex @a y` and `y ~ 15`. Fixes #17703. - - - - - 6d3b5d57 by Ömer Sinan Ağacan at 2020-02-05T09:22:10-05:00 testlib: Extend existing *_opts in extra_*_opts Previously we'd override the existing {run,hc} opts in extra_{run,hc}_opts, which caused flakiness in T1969, see #17712. extra_{run,hc}_opts now extends {run,hc} opts, instead of overriding. Also we shrank the allocation area for T1969 in order to increase residency sampling frequency. Fixes #17712 - - - - - 9c89a48d by Ömer Sinan Ağacan at 2020-02-05T09:22:52-05:00 Remove CafInfo-related code from STG lambda lift pass After c846618ae0 we don't have accurate CafInfos for Ids in the current module and we're free to introduce new CAFFY or non-CAFFY bindings or change CafInfos of existing binders; so no we no longer need to maintain CafInfos in Core or STG passes. - - - - - 70ddb8bf by Ryan Scott at 2020-02-05T09:23:30-05:00 Add regression test for #17773 - - - - - e8004e5d by Ben Gamari at 2020-02-05T13:55:19-05:00 gitlab-ci: Allow Windows builds to fail again Due to T7702 and the process issues described in #17777. - - - - - 29b72c00 by Ben Gamari at 2020-02-06T11:55:41-05:00 VarSet: Introduce nonDetFoldVarSet - - - - - c4e6b35d by Ben Gamari at 2020-02-06T11:55:41-05:00 Move closeOverKinds and friends to TyCoFVs - - - - - ed2f0e5c by Simon Peyton Jones at 2020-02-06T11:55:41-05:00 Reform the free variable finders for types This patch delivers on (much of) #17509. * Introduces the shallow vs deep free variable distinction * Introduce TyCoRep.foldType, foldType :: Monoid a => TyCoFolder env a -> env -> Type -> a and use it in the free variable finders. * Substitution in TyCoSubst * ASSERTs are on for checkValidSubst * checkValidSubst uses shallowTyCoVarsOfTypes etc Quite a few things still to do * We could use foldType in lots of other places * We could use mapType for substitution. (Check that we get good code!) * Some (but not yet all) clients of substitution can now save time by using shallowTyCoVarsOfTypes * All calls to tyCoVarsOfTypes should be inspected; most of them should be shallow. Maybe. * Currently shallowTyCoVarsOfTypes still returns unification variables, but not CoVarHoles. Reason: we need to return unification variables in some of the calls in TcSimplify, eg when promoting. * We should do the same thing for tyCoFVsOfTypes, which is currently unchanged. * tyCoFVsOfTypes returns CoVarHoles, because of the use in TcSimplify.mkResidualConstraints. See Note [Emitting the residual implication in simplifyInfer] * #17509 talks about "relevant" variables too. - - - - - 01a1f4fb by Simon Peyton Jones at 2020-02-06T11:55:41-05:00 Use foldTyCo for noFreeVarsOfType - - - - - 0e59afd6 by Simon Peyton Jones at 2020-02-06T11:55:41-05:00 Simplify closeOverKinds - - - - - 9ca5c88e by Simon Peyton Jones at 2020-02-06T11:55:41-05:00 Use foldTyCo for coVarsOfType - - - - - 5541b87c by Simon Peyton Jones at 2020-02-06T11:55:41-05:00 Use foldTyCo for exactTyCoVarsOfType This entailed * Adding a tcf_view field to TyCoFolder * Moving exactTyCoVarsOtType to TcType. It properly belongs there, since only the typechecker calls this function. But it also means that we can "see" and inline tcView. Metric Decrease: T14683 - - - - - 7c122851 by Simon Peyton Jones at 2020-02-06T11:56:02-05:00 Comments only - - - - - 588acb99 by Adam Sandberg Eriksson at 2020-02-08T10:15:38-05:00 slightly better named cost-centres for simple pattern bindings #17006 ``` main = do print $ g [1..100] a where g xs x = map (`mod` x) xs a :: Int = 324 ``` The above program previously attributed the cost of computing 324 to a cost centre named `(...)`, with this change the cost is attributed to `a` instead. This change only affects simple pattern bindings (decorated variables: type signatures, parens, ~ annotations and ! annotations). - - - - - 309f8cfd by Richard Eisenberg at 2020-02-08T10:16:33-05:00 Remove unnecessary parentheses - - - - - 7755ffc2 by Richard Eisenberg at 2020-02-08T10:16:33-05:00 Introduce IsPass; refactor wrappers. There are two main payloads of this patch: 1. This introduces IsPass, which allows e.g. printing code to ask what pass it is running in (Renamed vs Typechecked) and thus print extension fields. See Note [IsPass] in Hs.Extension 2. This moves the HsWrap constructor into an extension field, where it rightly belongs. This is done for HsExpr and HsCmd, but not for HsPat, which is left as an exercise for the reader. There is also some refactoring around SyntaxExprs, but this is really just incidental. This patch subsumes !1721 (sorry @chreekat). Along the way, there is a bit of refactoring in GHC.Hs.Extension, including the removal of NameOrRdrName in favor of NoGhcTc. This meant that we had no real need for GHC.Hs.PlaceHolder, so I got rid of it. Updates haddock submodule. ------------------------- Metric Decrease: haddock.compiler ------------------------- - - - - - 7d452be4 by Dylan Yudaken at 2020-02-08T10:17:17-05:00 Fix hs_try_putmvar losing track of running cap If hs_try_putmvar was called through an unsafe import, it would lose track of the running cap causing a deadlock - - - - - c2e301ae by Ben Gamari at 2020-02-08T10:17:55-05:00 compiler: Qualify imports of Data.List - - - - - aede171a by Ben Gamari at 2020-02-08T10:17:55-05:00 testsuite: Fix -Wcompat-unqualified-imports issues - - - - - 4435a8e0 by Ben Gamari at 2020-02-08T10:17:55-05:00 Introduce -Wcompat-unqualified-imports This implements the warning proposed in option (B) of the Data.List.singleton CLC [discussion][]. This warning, which is included in `-Wcompat` is intended to help users identify imports of modules that will change incompatibly in future GHC releases. This currently only includes `Data.List` due to the expected specialisation and addition of `Data.List.singleton`. Fixes #17244. [discussion]: https://groups.google.com/d/msg/haskell-core-libraries/q3zHLmzBa5E/PmlAs_kYAQAJ - - - - - 28b5349a by Ben Gamari at 2020-02-08T10:17:55-05:00 Bump stm and process submodules - - - - - 7d04b9f2 by Ben Gamari at 2020-02-08T10:18:31-05:00 hadrian: Allow override of Cabal configuration in hadrian.settings Fixes #17612 by adding a `cabal.configure.opts` key for `hadrian.settings`. - - - - - 88bf81aa by Andreas Klebinger at 2020-02-08T10:19:10-05:00 Optimize unpackCString# to allocate less. unpackCString# is a recursive function which for each iteration returns a Cons cell containing the current Char, and a thunk for unpacking the rest of the string. In this patch we change from storing addr + offset inside this thunk to storing only the addr, simply incrementing the address on each iteration. This saves one word of allocation per unpacked character. For a program like "main = print "<largishString>" this amounts to 2-3% fewer % in bytes allocated. I also removed the now redundant local unpack definitions. This removes one call per unpack operation. - - - - - bec76733 by Ben Gamari at 2020-02-08T10:19:57-05:00 Fix GhcThreaded setting This adopts a patch from NetBSD's packaging fixing the `GhcThreaded` option of the make build system. In addition we introduce a `ghcThreaded` option in hadrian's `Flavour` type. Also fix Hadrian's treatment of the `Use Threaded` entry in `settings`. Previously it would incorrectly claim `Use Threaded = True` if we were building the `threaded` runtime way. However, this is inconsistent with the `make` build system, which defines it to be whether the `ghc` executable is linked against the threaded runtime. Fixes #17692. - - - - - 545cf1e1 by Ben Gamari at 2020-02-08T10:20:37-05:00 hadrian: Depend upon libray dependencies when configuring packages This will hopefully fix #17631. - - - - - 047d3d75 by Ben Gamari at 2020-02-08T10:21:16-05:00 testsuite: Add test for #15316 This is the full testcase for T15316. - - - - - 768e5866 by Julien Debon at 2020-02-08T10:22:07-05:00 doc(Data.List): Add some examples to Data.List - - - - - 3900cb83 by Julien Debon at 2020-02-08T10:22:07-05:00 Apply suggestion to libraries/base/GHC/List.hs - - - - - bd666766 by Ben Gamari at 2020-02-08T10:22:45-05:00 users-guide: Clarify that bundled patsyns were introduced in GHC 8.0 Closes #17094. - - - - - 95741ea1 by Pepe Iborra at 2020-02-08T10:23:23-05:00 Update to hie-bios 0.3.2 style program cradle - - - - - fb5c1912 by Sylvain Henry at 2020-02-08T10:24:07-05:00 Remove redundant case This alternative is redundant and triggers no warning when building with 8.6.5 - - - - - 5d83d948 by Matthew Pickering at 2020-02-08T10:24:43-05:00 Add mkHieFileWithSource which doesn't read the source file from disk cc/ @pepeiborra - - - - - dfdae56d by Andreas Klebinger at 2020-02-08T10:25:20-05:00 Rename ghcAssert to stgAssert in hp2ps/Main.h. This fixes #17763 - - - - - 658f7ac6 by Ben Gamari at 2020-02-08T10:26:00-05:00 includes: Avoid using single-line comments in HsFFI.h While single-line comments are supported by C99, dtrace on SmartOS apparently doesn't support them yet. - - - - - c95920a6 by Ömer Sinan Ağacan at 2020-02-08T10:26:42-05:00 Import qualified Prelude in parser This is in preparation of backwards-incompatible changes in happy. See https://github.com/simonmar/happy/issues/166 - - - - - b6dc319a by Ömer Sinan Ağacan at 2020-02-08T10:27:23-05:00 Add regression test for #12760 The bug seems to be fixed in the meantime, make sure it stays fixed. Closes #12760 - - - - - b3857b62 by Ben Gamari at 2020-02-08T10:28:03-05:00 base: Drop out-of-date comment The comment in GHC.Base claimed that ($) couldn't be used in that module as it was wired-in. However, this is no longer true; ($) is merely known key and is defined in Haskell (with a RuntimeRep-polymorphic type) in GHC.Base. The one piece of magic that ($) retains is that it a special typing rule to allow type inference with higher-rank types (e.g. `runST $ blah`; see Note [Typing rule for ($)] in TcExpr). - - - - - 1183ae94 by Daniel Gröber at 2020-02-08T10:29:00-05:00 rts: Fix Arena blocks accounting for MBlock sized allocations When requesting more than BLOCKS_PER_MBLOCK blocks allocGroup can return a different number of blocks than requested. Here we use the number of requested blocks, however arenaFree will subtract the actual number of blocks we got from arena_blocks (possibly) resulting in a negative value and triggering ASSERT(arena_blocks >= 0). - - - - - 97d59db5 by Daniel Gröber at 2020-02-08T10:29:48-05:00 rts: Fix need_prealloc being reset when retainer profiling is on - - - - - 1f630025 by Krzysztof Gogolewski at 2020-02-09T02:52:27-05:00 Add a test for #15712 - - - - - 2ac784ab by Ben Gamari at 2020-02-09T02:53:05-05:00 hadrian: Add --test-metrics argument Allowing the test metric output to be captured to a file, a la the METRIC_FILE environment variable of the make build system. - - - - - f432d8c6 by Ben Gamari at 2020-02-09T02:53:05-05:00 hadrian: Fix --test-summary argument This appears to be a cut-and-paste error. - - - - - a906595f by Arnaud Spiwack at 2020-02-09T02:53:50-05:00 Fix an outdated note link This link appears to have been forgotten in 0dad81ca5fd1f63bf8a3b6ad09787559e8bd05c0 . - - - - - 3ae83da1 by Alp Mestanogullari at 2020-02-09T02:54:28-05:00 hadrian: Windows fixes (bindists, CI) This commit implements a few Windows-specific fixes which get us from a CI job that can't even get as far as starting the testsuite driver, to a state where we can run the entire testssuite (but have test failures to fix). - Don't forget about a potential extension for the haddock program, when preparing the bindist. - Build the timeout program, used by the testsuite driver on Windows in place of the Python script used elsewhere, using the boot compiler. We could alternatively build it with the compiler that we're going to test but this would be a lot more tedious to write. - Implement a wrapper-script less installation procedure for Windows, in `hadrian/bindist/Makefile. - Make dependencies a bit more accurate in the aforementioned Makefile. - Update Windows/Hadrian CI job accordingly. This patch fixes #17486. - - - - - 82f9be8c by Roland Senn at 2020-02-09T02:55:06-05:00 Fix #14628: Panic (No skolem Info) in GHCi This patch implements the [sugggestion from Simon (PJ)](https://gitlab.haskell.org/ghc/ghc/issues/14628#note_146559): - Make `TcErrors.getSkolemInfo` return a `SkolemInfo` rather than an `Implication`. - If `getSkolemInfo` gets `RuntimeUnk`s, just return a new data constructor in `SkolemInfo`, called `RuntimeUnkSkol`. - In `TcErrors.pprSkols` print something sensible for a `RuntimeUnkSkol`. The `getSkolemInfo` function paniced while formating suggestions to add type annotations (subfunction `suggestAddSig`) to a *"Couldn't match type ‘x’ with ‘y’"* error message. The `getSkolemInfo` function didn't find any Implication value and paniced. With this patch the `getSkolemInfo` function does no longer panic, if it finds `RuntimeUnkSkol`s. As the panic occured while processing an error message, we don't need to implement any new error message! - - - - - b2e18e26 by Andreas Klebinger at 2020-02-09T02:55:46-05:00 Fix -ddump-stg-final. Once again make sure this dumps the STG used for codegen. - - - - - 414e2f62 by Sylvain Henry at 2020-02-09T02:56:26-05:00 Force -fPIC for intree GMP (fix #17799) Configure intree GMP with `--with-pic` instead of patching it. Moreover the correct patching was only done for x86_64/darwin (see #17799). - - - - - f0fd72ee by Sebastian Graf at 2020-02-09T17:22:38-05:00 8.10 Release notes for improvements to the pattern-match checker [skip ci] A little late to the game, but better late than never. - - - - - 00dc0f7e by Ömer Sinan Ağacan at 2020-02-09T17:23:17-05:00 Add regression test for #13142 Closes #13142 - - - - - f3e737bb by Sebastian Graf at 2020-02-10T20:04:09-05:00 Fix long distance info for record updates For record updates where the `record_expr` is a variable, as in #17783: ```hs data PartialRec = No | Yes { a :: Int, b :: Bool } update No = No update r@(Yes {}) = r { b = False } ``` We should make use of long distance info in `-Wincomplete-record-updates` checking. But the call to `matchWrapper` in the `RecUpd` case didn't specify a scrutinee expression, which would correspond to the `record_expr` `r` here. That is fixed now. Fixes #17783. - - - - - 5670881d by Tamar Christina at 2020-02-10T20:05:04-05:00 Fs: Fix UNC remapping code. - - - - - 375b3c45 by Oleg Grenrus at 2020-02-11T05:07:30-05:00 Add singleton to Data.OldList - - - - - de32beff by Richard Eisenberg at 2020-02-11T05:08:10-05:00 Do not create nested quantified constraints Previously, we would accidentally make constraints like forall a. C a => forall b. D b => E a b c as we traversed superclasses. No longer! This patch also expands Note [Eagerly expand given superclasses] to work over quantified constraints; necessary for T16502b. Close #17202 and #16502. test cases: typecheck/should_compile/T{17202,16502{,b}} - - - - - e319570e by Ben Gamari at 2020-02-11T05:08:47-05:00 rts: Use nanosleep instead of usleep usleep was removed in POSIX.1-2008. - - - - - b75e7486 by Ben Gamari at 2020-02-11T05:09:24-05:00 rts: Remove incorrect assertions around MSG_THROWTO messages Previously we would assert that threads which are sending a `MSG_THROWTO` message must have their blocking status be blocked on the message. In the usual case of a thread throwing to another thread this is guaranteed by `stg_killThreadzh`. However, `throwToSelf`, used by the GC to kill threads which ran out of heap, failed to guarantee this. Noted while debugging #17785. - - - - - aba51b65 by Sylvain Henry at 2020-02-11T05:10:04-05:00 Add arithmetic exception primops (#14664) - - - - - b157399f by Ben Gamari at 2020-02-11T05:10:40-05:00 configure: Don't assume Gnu linker on Solaris Compl Yue noticed that the linker was dumping the link map on SmartOS. This is because Smartos uses the Solaris linker, which uses the `-64` flag, not `-m64` like Gnu ld, to indicate that it should link for 64-bits. Fix the configure script to handle the Solaris linker correctly. - - - - - d8d73d77 by Simon Peyton Jones at 2020-02-11T05:11:18-05:00 Notes only: telescopes This documentation-only patch fixes #17793 - - - - - 58a4ddef by Alp Mestanogullari at 2020-02-11T05:12:17-05:00 hadrian: build (and ship) iserv on Windows - - - - - 82023524 by Matthew Pickering at 2020-02-11T18:04:17-05:00 TemplateHaskellQuotes: Allow nested splices There is no issue with nested splices as they do not require any compile time code execution. All execution is delayed until the top-level splice. - - - - - 50e24edd by Ömer Sinan Ağacan at 2020-02-11T18:04:57-05:00 Remove Hadrian's copy of (Data.Functor.<&>) The function was added to base with base-4.11 (GHC 8.4) - - - - - f82a2f90 by Sylvain Henry at 2020-02-12T01:56:46-05:00 Document GMP build [skip ci] - - - - - da7f7479 by Sylvain Henry at 2020-02-12T01:57:27-05:00 Module hierarchy: ByteCode and Runtime (cf #13009) Update haddock submodule - - - - - 04f51297 by Ömer Sinan Ağacan at 2020-02-12T01:58:11-05:00 Fix naming of tests for #12923 - - - - - 31fc3321 by Ömer Sinan Ağacan at 2020-02-12T01:58:11-05:00 Add regression test for #12926 Closes #12926 - - - - - f0c0ee7d by Krzysztof Gogolewski at 2020-02-12T01:58:51-05:00 Fix order of arguments in specializer (#17801) See https://gitlab.haskell.org/ghc/ghc/issues/17801#note_253330 No regression test, as it's hard to trigger. - - - - - 059c3c9d by Sebastian Graf at 2020-02-12T11:00:58+01:00 Separate CPR analysis from the Demand analyser The reasons for that can be found in the wiki: https://gitlab.haskell.org/ghc/ghc/wikis/nested-cpr/split-off-cpr We now run CPR after demand analysis (except for after the final demand analysis run just before code gen). CPR got its own dump flags (`-ddump-cpr-anal`, `-ddump-cpr-signatures`), but not its own flag to activate/deactivate. It will run with `-fstrictness`/`-fworker-wrapper`. As explained on the wiki page, this step is necessary for a sane Nested CPR analysis. And it has quite positive impact on compiler performance: Metric Decrease: T9233 T9675 T9961 T15263 - - - - - f5ffd8d9 by Ben Gamari at 2020-02-12T17:22:37-05:00 base: Expose GHC.Unicode.unicodeVersion This exposes a Data.Version.Version representing the version of the Unicode database used by `base`. This should clear up some confusion I have seen in tickets regarding with which Unicode versions a given GHC can be expected to work. While in town I also regenerated (but did not update) the Unicode database with database 12.0.0. Strangely, the file cited in the README no longer existed. Consequently, I used https://www.unicode.org/Public/12.0.0/ucd/UnicodeData.txt and was slightly surprised to find that there were a few changes. - - - - - 6c2585e0 by Ben Gamari at 2020-02-12T17:22:37-05:00 base: Update Unicode database to 12.1.0 Using `curl https://www.unicode.org/Public/12.1.0/ucd/UnicodeData.txt | libraries/base/cbits/ubconfc 12.1.0`. - - - - - df084681 by Krzysztof Gogolewski at 2020-02-12T23:58:52+01:00 Always display inferred variables using braces We now always show "forall {a}. T" for inferred variables, previously this was controlled by -fprint-explicit-foralls. This implements part 1 of https://github.com/ghc-proposals/ghc-proposals/pull/179. Part of GHC ticket #16320. Furthermore, when printing a levity restriction error, we now display the HsWrap of the expression. This lets users see the full elaboration with -fprint-typechecker-elaboration (see also #17670) - - - - - 16d643cf by Sylvain Henry at 2020-02-13T09:16:04-05:00 Remove -ddump-srts flag This flag is deemed not useful. - - - - - fa28ae95 by Sylvain Henry at 2020-02-13T09:16:04-05:00 Fix flag documentation (#17826) - - - - - 1bfd8259 by Sylvain Henry at 2020-02-13T09:16:43-05:00 Ensure that Hadrian is built correctly before using it When Hadrian failed to build, the script would pick a previously built Hadrian (if available) instead of failing. - - - - - cd6e786a by Ömer Sinan Ağacan at 2020-02-14T05:29:56-05:00 Add test for #17648 - - - - - 9f2c3677 by Sylvain Henry at 2020-02-14T05:30:39-05:00 GMP expects the Target platform as --host parameter - - - - - aa6086fd by Oleg Grenrus at 2020-02-14T05:31:16-05:00 Add explicit LANGUAGE Safe to template-haskell (cherry picked from commit a5e0f376821ca882880b03b07b451aa574e289ec) - - - - - af6a0c36 by Ben Gamari at 2020-02-14T05:31:53-05:00 hadrian: Add execution and target architecture to stage-compilation figure - - - - - cf739945 by Sylvain Henry at 2020-02-14T05:32:37-05:00 Module hierarchy: HsToCore (cf #13009) - - - - - 719db318 by Simon Peyton Jones at 2020-02-14T05:33:16-05:00 De-duplicate overlapping Notes Documentation only. Fixes #17827 - - - - - 7550417a by Sylvain Henry at 2020-02-14T05:33:56-05:00 Hadrian: drop Sphinx flag checking for PDF documentation (#17825) It seems that Sphinx produces the ghc-flags.txt in doc/users_guide/_build rather than pdfRoot. We could copy ghc-flags.txt into pdfRoot (like happens naturally in the HTML case) but the benefit is pretty small. Let's just only check the HTML case. - - - - - 813842f4 by Ben Gamari at 2020-02-14T10:16:36-05:00 make: Be more selective in building windows-extra-src tarball - - - - - 0725f4bb by Ben Gamari at 2020-02-14T10:16:36-05:00 Rework handling of win32 toolchain tarballs - - - - - 565ce7ae by Ben Gamari at 2020-02-14T10:16:36-05:00 gitlab-ci: Consolidate CI logic This moves nearly all of the CI logic to .gitlab/ci.sh. This improves things in a number of ways: * it's harder for inconsistencies to arise between architectures * it's easier to share logic between architectures * on Windows, it's easier to ensure that all CI steps are executed from within a properly initialized mingw session. While in town I also add a FreeBSD build job and update the Windows job to use the gitlab-runner PowerShell executor, since cmd.exe will be deprecated soon (fixing #17699). - - - - - 9cbace74 by Ben Gamari at 2020-02-14T10:16:36-05:00 gitlab-ci: Deduplicate nightly job configuration - - - - - 6e837144 by Ben Gamari at 2020-02-14T10:16:36-05:00 integer-gmp: Fix unused command-line argument -L is only needed during linking. - - - - - e5ee07ab by Ben Gamari at 2020-02-14T10:16:36-05:00 testsuite: Don't ask sed to operate in-place on symlinks Some sed implementations (e.g. FreeBSD) refuse to operate in-place on symlinks. - - - - - 71e5e68f by Ben Gamari at 2020-02-14T10:16:36-05:00 testsuite: Disable tests that assume name of libstdc++ on FreeBSD - - - - - 7b2da0f4 by Ben Gamari at 2020-02-14T10:16:36-05:00 testsuite: Mark T6132 as broken on FreeBSD - - - - - 8ef7a15a by Ben Gamari at 2020-02-14T10:16:36-05:00 testsuite/T16930: Don't rely on gnu grep specific --include In BSD grep this flag only affects directory recursion. - - - - - 6060003e by Ben Gamari at 2020-02-14T10:16:36-05:00 Pass -Wno-unused-command-line-arguments during link on FreeBSD FreeBSD cc throws a warning if we pass -pthread without actually using any pthread symbols. - - - - - 97497bae by Ben Gamari at 2020-02-14T10:16:36-05:00 base: Always clamp reads/writes to 2GB in length Previously we did this only on Darwin due to #17414. However, even on other platforms >2GB writes are on shaky ground. POSIX explicitly says that the result is implementation-specified and Linux will write at most 0x7ffff000, even on 64-bit platforms. Moreover, getting the sign of the syscall result correct is tricky, as demonstrated by the fact that T17414 currently fails on FreeBSD. For simplicity we now just uniformly clamp to 0x7ffff000 on all platforms. - - - - - 49be2a3f by Ben Gamari at 2020-02-14T10:16:36-05:00 configure: Fix sphinx version test The check for the "v" prefix is redundant. - - - - - f7f7a556 by Ben Gamari at 2020-02-14T10:16:37-05:00 users-guide: Fix unknown link targets - - - - - a204102c by Ben Gamari at 2020-02-14T10:16:37-05:00 docs/compare-flags: Don't use python f-strings - - - - - 92e15a37 by Ben Gamari at 2020-02-14T10:16:37-05:00 gitlab-ci: Fix various shellcheck warnings - - - - - 459f7c6e by Ben Gamari at 2020-02-14T10:16:37-05:00 hadrian: Drop empty arguments from target list Fixes #17748. - - - - - c06df28d by Ben Gamari at 2020-02-14T10:16:37-05:00 users-guide: Fix "invalid file" failure I have no idea how this worked previously. Different Python version? - - - - - 3fe8444f by Ben Gamari at 2020-02-14T10:16:59-05:00 testsuite: Mark T7702 as fragile on Windows Due to #16799. There was previously an attempt to mark it as broken but the `opsys` name was incorrect. - - - - - fe02f781 by Ben Gamari at 2020-02-14T10:16:59-05:00 testsuite: Assert the opsys names are known Previously opsys would take any string. This meant it was very easy for a typo to silently render the predicate ineffective. Fix this by checking the given operating system name against a list of known values. - - - - - 149e2a3a by Ben Gamari at 2020-02-14T10:16:59-05:00 compare-flags: Don't rely on encoding flag of subprocess.check_output Apparently it isn't supported by some slightly older Python versions. - - - - - 798d59f6 by Ben Gamari at 2020-02-14T10:16:59-05:00 rts: Add more debug output to failed path in onIOComplete This will help track down #17035. - - - - - e35f3f98 by Ben Gamari at 2020-02-14T10:16:59-05:00 gitlab-ci: Allow i386 Windows builds to fail again Due to the resistance of #17736 to resolution. - - - - - 261a3cf8 by Ben Gamari at 2020-02-14T10:17:00-05:00 gitlab-ci: Build integer-simple job in the validate flavour - - - - - b613a961 by Ben Gamari at 2020-02-14T10:17:00-05:00 gitlab-ci: Always use mingw64 python on Windows - - - - - 1bc8c8cd by Ben Gamari at 2020-02-14T10:17:00-05:00 gitlab-ci: Allow Windows build to fail due to #17777 The fact that `exec` isn't POSIX compliant means that things can break in arbitrarily bad ways. Sometimes things happen to work correctly but sadly this isn't always the case. - - - - - ac63020d by Ben Gamari at 2020-02-14T10:17:00-05:00 gitlab-ci: Drop unnecessary GHC_VERSION check - - - - - 6926f369 by Ben Gamari at 2020-02-14T10:17:00-05:00 Bump process submodule Folds in the second part of Phyx's Windows process exit fixes [1], hopefully finally resolving issue #17480. [1] https://github.com/haskell/process/pull/160 - - - - - 584eee71 by Tamar Christina at 2020-02-14T10:17:00-05:00 SysTools: Use "process job" when spawning processes on Windows GHC should make calls using process jobs when calling out to GCC and LD. The reason is these use the exec () family of posix functions. Window's process model doesn't allow replacement of processes so this is emulated by creating a new process and immediately exiting the old one. Because of this when using normal Windows wait functions you would return even without the child process having finished. In this case if you are depending on data from the child you will enter a race condition. The usual fix for this is to use process jobs and wait for the termination of all children that have ever been spawn by the process you called. But also waiting for the freeing of all resources. - - - - - ecabfa28 by Tamar Christina at 2020-02-14T10:17:00-05:00 Revert "compiler: Disable atomic renaming on Windows" The original reason this was disabled should be fixed by the previous commit. This reverts commit 1c1b63d63efe8b0f789aa7d5b87cfac3edd213eb. - - - - - 06d60c66 by Ben Gamari at 2020-02-14T10:17:00-05:00 Bump Cabal submodule - - - - - 8cabb384 by Ben Gamari at 2020-02-14T10:17:00-05:00 compare-flags: Fix output - - - - - 8cf646d3 by Ben Gamari at 2020-02-14T10:17:00-05:00 users-guide: Document -ddump-srts - - - - - 932307a5 by Ben Gamari at 2020-02-14T10:17:00-05:00 users-guide: Fix broken reference - - - - - e77818de by Ben Gamari at 2020-02-15T09:26:55-05:00 Accept performance changes These manifested in the integer-simple job. Metric Decrease: T12227 T5549 T14936 T4830 Conversions T5237 T8766 T4801 T10359 Metric Increase: T12234 T6048 T3294 T14683 T3064 T9872b T9872c T783 T5837 T10678 T14697 T5631 T9203 T13719 T12707 T13056 T9630 T10547 T9872d T1969 WWRec T10370 T5321FD haddock.Cabal T5642 T9872a T15263 T12425 MultiLayerModules T5205 T9233 T13379 haddock.base T9020 T13035 T12150 T9961 - - - - - 785008c1 by Ben Gamari at 2020-02-15T09:30:13-05:00 testsuite: Sort test names in expected change output - - - - - 9e851472 by Ömer Sinan Ağacan at 2020-02-16T10:38:41+03:00 Revert "users-guide: Document -ddump-srts" This reverts commit 8cf646d36b02b8ea1c289cb52781c9171853b514. The flag was removed by 16d643cf. [ci skip] - - - - - 9792c816 by Ben Gamari at 2020-02-16T09:47:08-05:00 testsuite: Probe whether symlinks are usable on Windows Closes #17706. - - - - - ee1e5342 by Vladislav Zavialov at 2020-02-16T09:47:44-05:00 Fix the "unused terminals: 2" warning in Parser.y - - - - - b4a8ce52 by Roland Senn at 2020-02-18T20:14:42-05:00 If a :reload finds syntax errors in the module graph, remove the loaded modules. (Fixes #17549) The processing in `compiler/main/GhcMake.hs` computes the ModuleGraph. If it finds errors in the module header or in the import specifications, then the new module graph is incomplete and should not be used. The code before #17549 just reported the errors and left the old ModuleGraph in place. The new code of this MR replaces the old ModuleGraph with an empty one. - - - - - d7029cc0 by Sylvain Henry at 2020-02-18T20:15:30-05:00 Hadrian: refactor GMP in-tree build support (#17756) * Hadrian doesn't use integer-gmp/config.mk file anymore to determine if building GMP in-tree is required. "config.mk" is created by Cabal when the integer-gmp package is configured and this file is still untracked by Hadrian. This led to a tricky configure "race" because "config.mk" is built by the "setup-config" rule, but this rule is also used to find dependencies, in particular the "ghc-gmp.h" header, but the creation of this file was depending (without being tracked) on "config.mk". Now Hadrian only builds in-tree GMP if `--with-intree-gmp` is passed to the top-level configure script. * in-tree GMP isn't built once for all in a fixed stage (Stage1) anymore. It is built per stage which is required if we build a cross-compiler * switching between in-tree and external GMP is now supported without having to clean the build directory first. * "wrappers.c" now includes "ghc-gmp.h" instead of "ghc.h". It helps ensuring that the build system generates "ghc-gmp.h". * build in-tree GMP in "<root>/stageN/gmp/gmpbuild" and produce useful artefacts (libgmp.a, gmp.h, objs/*.o) in "<root>/stageN/gmp" - - - - - 40d917fb by Vladislav Zavialov at 2020-02-18T20:16:07-05:00 Remove the MonadFail P instance There were two issues with this instance: * its existence meant that a pattern match failure in the P monad would produce a user-visible parse error, but the error message would not be helpful to the user * due to the MFP migration strategy, we had to use CPP in Lexer.x, and that created issues for #17750 Updates haddock submodule. - - - - - 5a1ce45d by Joshua Price at 2020-02-18T20:16:47-05:00 Fix unboxed tuple size limit (#17837) - - - - - 192caf58 by Vladislav Zavialov at 2020-02-18T20:17:24-05:00 Fix testsuite driver output (#17847) - - - - - 1500f089 by Sylvain Henry at 2020-02-18T20:18:12-05:00 Modules: Llvm (#13009) - - - - - d53e81c0 by Niklas Hambüchen at 2020-02-20T10:36:22-05:00 8.10 Release notes for atomic .o writes [skip ci] - - - - - 19680ee5 by Niklas Hambüchen at 2020-02-20T10:37:53-05:00 8.10 Release notes for --disable-delayed-os-memory-return [skip ci] - - - - - 74ad75e8 by Simon Peyton Jones at 2020-02-20T21:17:57-05:00 Re-implement unsafe coercions in terms of unsafe equality proofs (Commit message written by Omer, most of the code is written by Simon and Richard) See Note [Implementing unsafeCoerce] for how unsafe equality proofs and the new unsafeCoerce# are implemented. New notes added: - [Checking for levity polymorphism] in CoreLint.hs - [Implementing unsafeCoerce] in base/Unsafe/Coerce.hs - [Patching magic definitions] in Desugar.hs - [Wiring in unsafeCoerce#] in Desugar.hs Only breaking change in this patch is unsafeCoerce# is not exported from GHC.Exts, instead of GHC.Prim. Fixes #17443 Fixes #16893 NoFib ----- -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- CS -0.1% 0.0% -0.0% -0.0% -0.0% CSD -0.1% 0.0% -0.0% -0.0% -0.0% FS -0.1% 0.0% -0.0% -0.0% -0.0% S -0.1% 0.0% -0.0% -0.0% -0.0% VS -0.1% 0.0% -0.0% -0.0% -0.0% VSD -0.1% 0.0% -0.0% -0.0% -0.1% VSM -0.1% 0.0% -0.0% -0.0% -0.0% anna -0.0% 0.0% -0.0% -0.0% -0.0% ansi -0.1% 0.0% -0.0% -0.0% -0.0% atom -0.1% 0.0% -0.0% -0.0% -0.0% awards -0.1% 0.0% -0.0% -0.0% -0.0% banner -0.1% 0.0% -0.0% -0.0% -0.0% bernouilli -0.1% 0.0% -0.0% -0.0% -0.0% binary-trees -0.1% 0.0% -0.0% -0.0% -0.0% boyer -0.1% 0.0% -0.0% -0.0% -0.0% boyer2 -0.1% 0.0% -0.0% -0.0% -0.0% bspt -0.1% 0.0% -0.0% -0.0% -0.0% cacheprof -0.1% 0.0% -0.0% -0.0% -0.0% calendar -0.1% 0.0% -0.0% -0.0% -0.0% cichelli -0.1% 0.0% -0.0% -0.0% -0.0% circsim -0.1% 0.0% -0.0% -0.0% -0.0% clausify -0.1% 0.0% -0.0% -0.0% -0.0% comp_lab_zift -0.1% 0.0% -0.0% -0.0% -0.0% compress -0.1% 0.0% -0.0% -0.0% -0.0% compress2 -0.1% 0.0% -0.0% -0.0% -0.0% constraints -0.1% 0.0% -0.0% -0.0% -0.0% cryptarithm1 -0.1% 0.0% -0.0% -0.0% -0.0% cryptarithm2 -0.1% 0.0% -0.0% -0.0% -0.0% cse -0.1% 0.0% -0.0% -0.0% -0.0% digits-of-e1 -0.1% 0.0% -0.0% -0.0% -0.0% digits-of-e2 -0.1% 0.0% -0.0% -0.0% -0.0% dom-lt -0.1% 0.0% -0.0% -0.0% -0.0% eliza -0.1% 0.0% -0.0% -0.0% -0.0% event -0.1% 0.0% -0.0% -0.0% -0.0% exact-reals -0.1% 0.0% -0.0% -0.0% -0.0% exp3_8 -0.1% 0.0% -0.0% -0.0% -0.0% expert -0.1% 0.0% -0.0% -0.0% -0.0% fannkuch-redux -0.1% 0.0% -0.0% -0.0% -0.0% fasta -0.1% 0.0% -0.5% -0.3% -0.4% fem -0.1% 0.0% -0.0% -0.0% -0.0% fft -0.1% 0.0% -0.0% -0.0% -0.0% fft2 -0.1% 0.0% -0.0% -0.0% -0.0% fibheaps -0.1% 0.0% -0.0% -0.0% -0.0% fish -0.1% 0.0% -0.0% -0.0% -0.0% fluid -0.1% 0.0% -0.0% -0.0% -0.0% fulsom -0.1% 0.0% +0.0% +0.0% +0.0% gamteb -0.1% 0.0% -0.0% -0.0% -0.0% gcd -0.1% 0.0% -0.0% -0.0% -0.0% gen_regexps -0.1% 0.0% -0.0% -0.0% -0.0% genfft -0.1% 0.0% -0.0% -0.0% -0.0% gg -0.1% 0.0% -0.0% -0.0% -0.0% grep -0.1% 0.0% -0.0% -0.0% -0.0% hidden -0.1% 0.0% -0.0% -0.0% -0.0% hpg -0.1% 0.0% -0.0% -0.0% -0.0% ida -0.1% 0.0% -0.0% -0.0% -0.0% infer -0.1% 0.0% -0.0% -0.0% -0.0% integer -0.1% 0.0% -0.0% -0.0% -0.0% integrate -0.1% 0.0% -0.0% -0.0% -0.0% k-nucleotide -0.1% 0.0% -0.0% -0.0% -0.0% kahan -0.1% 0.0% -0.0% -0.0% -0.0% knights -0.1% 0.0% -0.0% -0.0% -0.0% lambda -0.1% 0.0% -0.0% -0.0% -0.0% last-piece -0.1% 0.0% -0.0% -0.0% -0.0% lcss -0.1% 0.0% -0.0% -0.0% -0.0% life -0.1% 0.0% -0.0% -0.0% -0.0% lift -0.1% 0.0% -0.0% -0.0% -0.0% linear -0.1% 0.0% -0.0% -0.0% -0.0% listcompr -0.1% 0.0% -0.0% -0.0% -0.0% listcopy -0.1% 0.0% -0.0% -0.0% -0.0% maillist -0.1% 0.0% -0.0% -0.0% -0.0% mandel -0.1% 0.0% -0.0% -0.0% -0.0% mandel2 -0.1% 0.0% -0.0% -0.0% -0.0% mate -0.1% 0.0% -0.0% -0.0% -0.0% minimax -0.1% 0.0% -0.0% -0.0% -0.0% mkhprog -0.1% 0.0% -0.0% -0.0% -0.0% multiplier -0.1% 0.0% -0.0% -0.0% -0.0% n-body -0.1% 0.0% -0.0% -0.0% -0.0% nucleic2 -0.1% 0.0% -0.0% -0.0% -0.0% para -0.1% 0.0% -0.0% -0.0% -0.0% paraffins -0.1% 0.0% -0.0% -0.0% -0.0% parser -0.1% 0.0% -0.0% -0.0% -0.0% parstof -0.1% 0.0% -0.0% -0.0% -0.0% pic -0.1% 0.0% -0.0% -0.0% -0.0% pidigits -0.1% 0.0% -0.0% -0.0% -0.0% power -0.1% 0.0% -0.0% -0.0% -0.0% pretty -0.1% 0.0% -0.1% -0.1% -0.1% primes -0.1% 0.0% -0.0% -0.0% -0.0% primetest -0.1% 0.0% -0.0% -0.0% -0.0% prolog -0.1% 0.0% -0.0% -0.0% -0.0% puzzle -0.1% 0.0% -0.0% -0.0% -0.0% queens -0.1% 0.0% -0.0% -0.0% -0.0% reptile -0.1% 0.0% -0.0% -0.0% -0.0% reverse-complem -0.1% 0.0% -0.0% -0.0% -0.0% rewrite -0.1% 0.0% -0.0% -0.0% -0.0% rfib -0.1% 0.0% -0.0% -0.0% -0.0% rsa -0.1% 0.0% -0.0% -0.0% -0.0% scc -0.1% 0.0% -0.1% -0.1% -0.1% sched -0.1% 0.0% -0.0% -0.0% -0.0% scs -0.1% 0.0% -0.0% -0.0% -0.0% simple -0.1% 0.0% -0.0% -0.0% -0.0% solid -0.1% 0.0% -0.0% -0.0% -0.0% sorting -0.1% 0.0% -0.0% -0.0% -0.0% spectral-norm -0.1% 0.0% -0.0% -0.0% -0.0% sphere -0.1% 0.0% -0.0% -0.0% -0.0% symalg -0.1% 0.0% -0.0% -0.0% -0.0% tak -0.1% 0.0% -0.0% -0.0% -0.0% transform -0.1% 0.0% -0.0% -0.0% -0.0% treejoin -0.1% 0.0% -0.0% -0.0% -0.0% typecheck -0.1% 0.0% -0.0% -0.0% -0.0% veritas -0.0% 0.0% -0.0% -0.0% -0.0% wang -0.1% 0.0% -0.0% -0.0% -0.0% wave4main -0.1% 0.0% -0.0% -0.0% -0.0% wheel-sieve1 -0.1% 0.0% -0.0% -0.0% -0.0% wheel-sieve2 -0.1% 0.0% -0.0% -0.0% -0.0% x2n1 -0.1% 0.0% -0.0% -0.0% -0.0% -------------------------------------------------------------------------------- Min -0.1% 0.0% -0.5% -0.3% -0.4% Max -0.0% 0.0% +0.0% +0.0% +0.0% Geometric Mean -0.1% -0.0% -0.0% -0.0% -0.0% Test changes ------------ - break006 is marked as broken, see #17833 - The compiler allocates less when building T14683 (an unsafeCoerce#- heavy happy-generated code) on 64-platforms. Allocates more on 32-bit platforms. - Rest of the increases are tiny amounts (still enough to pass the threshold) in micro-benchmarks. I briefly looked at each one in a profiling build: most of the increased allocations seem to be because of random changes in the generated code. Metric Decrease: T14683 Metric Increase: T12150 T12234 T12425 T13035 T14683 T5837 T6048 Co-Authored-By: Richard Eisenberg <rae at cs.brynmawr.edu> Co-Authored-By: Ömer Sinan Ağacan <omeragacan at gmail.com> - - - - - 6880d6aa by Sylvain Henry at 2020-02-20T21:18:48-05:00 Disentangle DynFlags and SDoc Remove several uses of `sdocWithDynFlags`. The remaining ones are mostly CodeGen related (e.g. depend on target platform constants) and will be fixed separately. Metric Decrease: T12425 T9961 WWRec T1969 T14683 - - - - - 70a90110 by Julien Debon at 2020-02-20T21:19:27-05:00 doc(List): Add examples to GHC.List * Add examples * Cleanup documentation * Clarify merge process and Marge bot - - - - - c8439fc7 by Peter Trommler at 2020-02-20T21:20:05-05:00 Fix testsuite on powerpc64le Remove expect broken on recomp tests, #11260 was closed by !2264 and #11323 most likely by !2264 as well. GHCi scripts tests work on GHCi but not the external interpreter, adjust test configuration accordingly. Fixes unexpected passes. Mark test requiring DWARF expect fail on powerpc64[le] for #11261. - - - - - 65b7256a by Ömer Sinan Ağacan at 2020-02-20T21:20:45-05:00 Use concatMap(M) instead of `concat . map` and the monadic variant - - - - - 8b76d457 by Roland Senn at 2020-02-20T21:21:28-05:00 Fix #17832: Weird handling of exports named main in 8.10-rc1 Switching from `lookupGlobalOccRn_maybe` to `lookupInfoOccRn` to check whether a `main` function is in scope. Unfortunately `lookupGlobalOccRn_maybe` complains if there are multiple `main` functions in scope. - - - - - 466e1ad5 by Krzysztof Gogolewski at 2020-02-20T21:22:11-05:00 Use TTG for HsSplicedT constructor The constructor HsSplicedT occurs only in the GhcTc pass. This enforces this fact statically via TTG. - - - - - 4e622fca by Alexis King at 2020-02-20T21:22:49-05:00 Normalize types when dropping absent arguments from workers fixes #17852 - - - - - a533e547 by Adam Sandberg Eriksson at 2020-02-20T21:23:31-05:00 Mention users guide and release notes in merge request template - - - - - 05251b17 by Ben Gamari at 2020-02-20T21:24:08-05:00 gitlab-ci: Fix typo in BIN_DIST_PREP_TAR_COMP variable name - - - - - f44c7e67 by Ben Gamari at 2020-02-20T21:24:46-05:00 gitlab-ci: Avoid duplicating ~/.cabal contents with every build Previously our attempt to cache the cabal store would `cp cabal-cache ~/.cabal`. However, if the latter already existed this meant that we would end up with ~/.cabal/cabal-cache. Not only would this not help caching but it would exponentially grow the size of ~/.cabal. Not good! - - - - - c5ec9965 by Ben Gamari at 2020-02-20T21:56:13-05:00 GHC.Hs.Extension: Use Type instead of * - - - - - 89cb4cc4 by Ben Gamari at 2020-02-20T21:56:13-05:00 Use Type instead of * in GHC - - - - - 04eb0d6c by Ben Gamari at 2020-02-20T21:56:13-05:00 Enable -Wstar-is-type in -Wall As noted in [proposal 0143][proposal] this is supposed to happen in 8.12. Also fix an incorrect claim in the users guide that -Wstar-is-type is enabled by default. [proposal]: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0143-remove-star-kind.rst - - - - - 6de966f1 by Andreas Klebinger at 2020-02-20T21:56:15-05:00 Fix #17724 by having occAnal preserve used bindings. It sometimes happened that occAnal would remove bindings as dead code by relying on bindings to be in dependency order. The fix was contributed by SPJ. - - - - - abd7f962 by Ben Gamari at 2020-02-20T21:56:15-05:00 users-guide: Mention dependency on `exceptions` in release notes Fixes #17845. - - - - - 58175379 by Sylvain Henry at 2020-02-20T21:56:20-05:00 Hadrian: minor GMP refactoring Somehow I forgot to totally remove `gmpContext` in d7029cc09edc052c2f97effe33233c53340fcce0. This patch fixes it and adds some additional comments. - - - - - 33fa8d94 by Ryan Scott at 2020-02-20T21:56:21-05:00 Generalize liftData to work over any Quote (#17857) The Overloaded Quotations proposal generalized the type of `lift` to work over any `Quote`, but not the type of `liftData`, leading to #17857. Thankfully, generalizing `liftData` is extremely straightforward. Fixes #17857. - - - - - 3cea6795 by Sylvain Henry at 2020-02-20T21:56:23-05:00 Make: fix sdist target (#17848) - - - - - e2cce997 by Sylvain Henry at 2020-02-20T21:56:23-05:00 Hadrian: fix source-dist target (#17849) - - - - - 0a4c89b2 by Matthew Pickering at 2020-02-21T20:44:45-05:00 Special case `mkTyConApp liftedTypeKind []` We really need to make sure that these are shared because otherwise GHC will allocate thousands of identical `TyConApp` nodes. See #17292 ------------------------- Metric Decrease: haddock.Cabal T14683 ------------------------- - - - - - 0482f58a by Matthew Pickering at 2020-02-21T20:45:21-05:00 TH: wrapGenSyns, don't split the element type too much The invariant which allowed the pervious method of splitting the type of the body to find the type of the elements didn't work in the new overloaded quotation world as the type can be something like `WriterT () m a` rather than `Q a` like before. Fixes #17839 - - - - - be7068a6 by Vladislav Zavialov at 2020-02-21T20:45:59-05:00 Parser API annotations: RealSrcLoc During parsing, GHC collects lexical information about AST nodes and stores it in a map. It is needed to faithfully restore original source code, e.g. compare these expressions: a = b a = b The position of the equality sign is not recorded in the AST, so it must be stored elsewhere. This system is described in Note [Api annotations]. Before this patch, the mapping was represented by: Map (SrcSpan, AnnKeywordId) SrcSpan After this patch, the mapping is represented by: Map (RealSrcSpan, AnnKeywordId) RealSrcSpan The motivation behind this change is to avoid using the Ord SrcSpan instance (required by Map here), as it interferes with #17632 (see the discussion there). SrcSpan is isomorphic to Either String RealSrcSpan, but we shouldn't use those strings as Map keys. Those strings are intended as hints to the user, e.g. "<interactive>" or "<compiler-generated code>", so they are not a valid way to identify nodes in the source code. - - - - - 240f5bf6 by Sylvain Henry at 2020-02-21T20:46:40-05:00 Modules: Driver (#13009) submodule updates: nofib, haddock - - - - - 9d094111 by Sylvain Henry at 2020-02-21T20:47:19-05:00 Hadrian: `docs` rule needs `configure` (#17840) - - - - - 1674353a by Ben Gamari at 2020-02-23T17:31:19-05:00 fs: Port fixes from ghc-jailbreak repository * Override rename, unlink, and remove * Factor out wchar conversion - - - - - 853210f2 by Adam Sandberg Ericsson at 2020-02-23T17:32:03-05:00 show gcc linker options in configure summary - - - - - 2831544a by Adam Sandberg Ericsson at 2020-02-23T17:32:44-05:00 hadrian: docs depend on stage1 ghc - - - - - 1d9df9e0 by Adam Sandberg Ericsson at 2020-02-23T17:33:23-05:00 ci: after 5ce63d52fed the linux bindist for doc-tarball has changed name - - - - - 26e8fff3 by Vladislav Zavialov at 2020-02-24T02:05:30-05:00 Remove Ord SrcLoc, Ord SrcSpan Before this patch, GHC relied on Ord SrcSpan to identify source elements, by using SrcSpan as Map keys: blackList :: Map SrcSpan () -- compiler/GHC/HsToCore/Coverage.hs instanceMap :: Map SrcSpan Name -- compiler/GHC/HsToCore/Docs.hs Firstly, this design is not valid in presence of UnhelpfulSpan, as it distinguishes between UnhelpfulSpan "X" and UnhelpfulSpan "Y", but those strings are messages for the user, unfit to serve as identifiers for source elements. Secondly, this design made it hard to extend SrcSpan with additional data. Recall that the definition of SrcSpan is: data SrcSpan = RealSrcSpan !RealSrcSpan | UnhelpfulSpan !FastString Say we want to extend the RealSrcSpan constructor with additional information: data SrcSpan = RealSrcSpan !RealSrcSpan !AdditionalInformation | UnhelpfulSpan !FastString getAdditionalInformation :: SrcSpan -> AdditionalInformation getAdditionalInformation (RealSrcSpan _ a) = a Now, in order for Map SrcSpan to keep working correctly, we must *ignore* additional information when comparing SrcSpan values: instance Ord SrcSpan where compare (RealSrcSpan r1 _) (RealSrcSpan r2 _) = compare r1 r2 ... However, this would violate an important law: a == b therefore f a == f b Ignoring AdditionalInformation in comparisons would mean that with f=getAdditionalInformation, the law above does not hold. A more robust design is to avoid Ord SrcSpan altogether, which is what this patch implements. The mappings are changed to use RealSrcSpan instead: blackList :: Set RealSrcSpan -- compiler/GHC/HsToCore/Coverage.hs instanceMap :: Map RealSrcSpan Name -- compiler/GHC/HsToCore/Docs.hs All SrcSpan comparisons are now done with explicit comparison strategies: SrcLoc.leftmost_smallest SrcLoc.leftmost_largest SrcLoc.rightmost_smallest These strategies are not subject to the law mentioned above and can easily discard both the string stored in UnhelpfulSpan and AdditionalInformation. Updates haddock submodule. - - - - - 5aa6c188 by Ben Gamari at 2020-02-24T02:06:09-05:00 users-guide: Shuffle text - - - - - e3f17413 by Ben Gamari at 2020-02-24T02:06:09-05:00 users-guide: Drop old release notes - - - - - 84dd9610 by Ben Gamari at 2020-02-24T02:06:09-05:00 Bump directory submodule to 1.3.6.0 - - - - - e295a024 by Stefan Pavikevik at 2020-02-24T20:53:44-05:00 check for safe arguments, raising error when invalid (fix #17720) - - - - - 354e2787 by Krzysztof Gogolewski at 2020-02-24T20:54:35-05:00 Comments, small refactor * Remove outdated Note [HsForAllTy tyvar binders] and [Context quantification]. Since the wildcard refactor 1e041b7382, HsForAllTy no longer has an flag controlling explicity. The field `hsq_implicit` is gone too. The current situation is covered by Note [HsType binders] which is already linked from LHsQTyVars. * Small refactor in CoreLint, extracting common code to a function * Remove "not so sure about WpFun" in TcEvidence, per Richard's comment https://gitlab.haskell.org/ghc/ghc/merge_requests/852#note_223226 * Use mkIfThenElse in Foreign/Call, as it does exactly what we need. - - - - - 1b1067d1 by Sylvain Henry at 2020-02-24T20:55:25-05:00 Modules: CmmToAsm (#13009) - - - - - 621468f6 by Alexis King at 2020-02-26T15:08:09-05:00 Treat coercions as arguments for floating and inlining This reverts commit 8924224ecfa065ebc67b96a90d01cf9d2edd0e77 and fixes #17787. - - - - - def486c9 by Ben Gamari at 2020-02-26T15:08:47-05:00 hadrian: Allow libnuma library path to be specified - - - - - ed03d4e7 by Ben Gamari at 2020-02-26T15:08:47-05:00 hadrian: Refactor gmp arguments Move the gmp configuration to its own binding. - - - - - 09b88384 by Ben Gamari at 2020-02-26T15:08:47-05:00 hadrian: Tell Cabal about integer-gmp library location - - - - - 161e08c5 by Krzysztof Gogolewski at 2020-02-26T15:09:30-05:00 Remove dead code * FailablePattern can no longer be created since ab51bee40c82 Therefore, Opt_WarnMissingMonadFailInstances has no effect anymore. * XWrap is no longer used, it was moved to an extension field - - - - - e0d09db3 by Ben Gamari at 2020-02-26T15:10:09-05:00 gitlab-ci: Use 8.8.3 to bootstrap on Windows This should fix #17861. - - - - - 972bcf3a by Ben Gamari at 2020-02-26T15:10:09-05:00 testsuite: Fix symlink test Needs to `write` bytes, not str. - - - - - 273e60de by Ben Gamari at 2020-02-26T15:10:09-05:00 gitlab-ci: Add shell subcommand for debugging within CI environment - - - - - 43b13ed3 by Ben Gamari at 2020-02-26T15:10:09-05:00 gitlab-ci: Fix colors on Darwin Darwin sh doesn't support \e. - - - - - 217546a7 by Ben Gamari at 2020-02-26T15:10:09-05:00 testsuite: Flush stdout buffers in InitEventLogging Otherwise we are sensitive to libc's buffering strategy. Similar to the issue fixed in 543dfaab166c81f46ac4af76918ce32190aaab22. - - - - - c7d4fa55 by Ben Gamari at 2020-02-26T15:10:09-05:00 gitlab-ci: Add run_hadrian subcommand I've ruined two trees already by failing to pass --flavour to hadrian. Let's factor this out so it can be reused during troubleshooting. - - - - - 7dc54873 by Ben Gamari at 2020-02-26T15:10:09-05:00 testsuite: Allow tests to be marked as broken on the command line This allows us to work-around distribution-specific breakage easily. - - - - - 25e2458e by Ben Gamari at 2020-02-26T15:10:09-05:00 hadrian: Add --broken-test flag This exposes the flag of the same name supported by the testsuite driver. - - - - - 55769996 by Ben Gamari at 2020-02-26T15:10:09-05:00 gitlab-ci: Mark some tests as broken on Alpine - - - - - 9ee7f87d by Ben Gamari at 2020-02-26T15:10:09-05:00 SysTools: Don't use process jobs if they are broken - - - - - bfaa3961 by Ben Gamari at 2020-02-26T15:10:09-05:00 Bump hsc2hs submodule Fixes name of C compiler. - - - - - b2b49a0a by Ben Gamari at 2020-02-26T15:10:09-05:00 testsuite: Make hasMetricsFile RHS more descriptive - - - - - 817f93ea by Sylvain Henry at 2020-02-26T15:10:58-05:00 Modules: Core (#13009) Update haddock submodule - - - - - 74311e10 by Sebastian Graf at 2020-02-27T16:22:45-05:00 PmCheck: Implement Long-distance information with Covered sets Consider ```hs data T = A | B | C f :: T -> Int f A = 1 f x = case x of A -> 2 B -> 3 C -> 4 ``` Clearly, the RHS returning 2 is redundant. But we don't currently see that, because our approximation to the covered set of the inner case expression just picks up the positive information from surrounding pattern matches. It lacks the context sensivity that `x` can't be `A` anymore! Therefore, we adopt the conceptually and practically superior approach of reusing the covered set of a particular GRHS from an outer pattern match. In this case, we begin checking the `case` expression with the covered set of `f`s second clause, which encodes the information that `x` can't be `A` anymore. After this MR, we will successfully warn about the RHS returning 2 being redundant. Perhaps surprisingly, this was a great simplification to the code of both the coverage checker and the desugarer. Found a redundant case alternative in `unix` submodule, so we have to bump it with a fix. Metric Decrease: T12227 - - - - - 59c023ba by Adam Sandberg Ericsson at 2020-02-27T16:23:25-05:00 configure: correctly generate LIBRARY_template_haskell_VERSION - - - - - 9be82389 by Krzysztof Gogolewski at 2020-02-28T02:35:35-05:00 boot: Remove remote origin check Previously, we used relative paths in submodules. When cloning from GitHub, they had to be manually tweaked. Since a76b233d we use absolute paths, so this workaround can be removed. - - - - - f4b6b594 by Ben Gamari at 2020-02-28T02:36:12-05:00 nonmoving: Fix marking in compact regions Previously we were tracing the object we were asked to mark, even if it lives in a compact region. However, there is no need to do this; we need only to mark the region itself as live. I have seen a segfault due to this due to the concurrent mark seeing a an object in the process of being compacted by the mutator. - - - - - f97d1fb6 by Alp Mestanogullari at 2020-02-28T02:36:59-05:00 base: use an explicit import list in System.Environment.ExecutablePath This was making -Werror builds fail on Windows (at least with Hadrian). - - - - - 66f5d6d6 by Simon Peyton Jones at 2020-02-28T22:03:23-05:00 Improve error handling for VTA + deferred type errors This fixes #17792 See Note [VTA for out-of-scope functions] in TcExpr - - - - - 37f12603 by Ilias Tsitsimpis at 2020-02-28T22:04:04-05:00 llvm-targets: Add arm-unknown-linux-gnueabi Add arm-unknown-linux-gnueabi, which is used by Debian's ARM EABI port (armel), as an LLVM target. - - - - - 327b29e1 by Vladislav Zavialov at 2020-02-29T05:06:31-05:00 Monotonic locations (#17632) When GHC is parsing a file generated by a tool, e.g. by the C preprocessor, the tool may insert #line pragmas to adjust the locations reported to the user. As the result, the locations recorded in RealSrcLoc are not monotonic. Elements that appear later in the StringBuffer are not guaranteed to have a higher line/column number. In fact, there are no guarantees whatsoever, as #line pragmas can arbitrarily modify locations. This lack of guarantees makes ideas such as #17544 infeasible. This patch adds an additional bit of information to every SrcLoc: newtype BufPos = BufPos { bufPos :: Int } A BufPos represents the location in the StringBuffer, unaffected by any pragmas. Updates haddock submodule. Metric Increase: haddock.Cabal haddock.base haddock.compiler MultiLayerModules Naperian parsing001 T12150 - - - - - 99d2de86 by Ben Gamari at 2020-02-29T05:07:10-05:00 plugins: Ensure that loadInterface plugins can see annotations loadInterface replaces the `mi_decls`, `mi_insts`, `mi_fam_insts`, `mi_rules`, `mi_anns` fields of ModIface with `undefined` before inserting the interface into the EPS. However, we still want to give loadInterface plugins access to these fields. Consequently, we want to pass the unmodified `ModIface` the plugin. - - - - - a999ee96 by Xavier Denis at 2020-02-29T05:07:50-05:00 Rename ghci.sh and build.sh to ghci and build respectively Convert hadrian buildscripts to unsuffixed, dashed form final cleanups - - - - - b5fb58fd by Ömer Sinan Ağacan at 2020-02-29T05:08:36-05:00 Document and refactor a few things around bitmap scavenging - Added a few comments in StgPAP - Added a few comments and assertions in scavenge_small_bitmap and walk_large_bitmap - Did tiny refactor in GHC.Data.Bitmap: added some comments, deleted dead code, used PlatformWordSize type. - - - - - 18757cab by Sylvain Henry at 2020-02-29T05:09:25-05:00 Refactor runtime interpreter code In #14335 we want to be able to use both the internal interpreter (for the plugins) and the external interpreter (for TH and GHCi) at the same time. This patch performs some preliminary refactoring: the `hsc_interp` field of HscEnv replaces `hsc_iserv` and is now used to indicate which interpreter (internal, external) to use to execute TH and GHCi. Opt_ExternalInterpreter flag and iserv options in DynFlags are now queried only when we set the session DynFlags. It should help making GHC multi-target in the future by selecting an interpreter according to the selected target. - - - - - b86a6395 by Adam Sandberg Ericsson at 2020-02-29T05:10:06-05:00 docs: correct relative links to haddocks from users guide (fixes #17866) - - - - - 0f55df7f by Adam Sandberg Ericsson at 2020-02-29T05:10:06-05:00 docs: correct link to th haddocks from users guide - - - - - 252e5117 by Jean-Baptiste Mazon at 2020-02-29T05:10:46-05:00 rts: enforce POSIX numeric locale for heap profiles - - - - - 34c7d230 by Sylvain Henry at 2020-02-29T05:11:27-05:00 Fix Hadrian's ``--configure`` (fix #17883) - - - - - 04d30137 by Ömer Sinan Ağacan at 2020-02-29T05:12:06-05:00 Simplify IfaceIdInfo type IfaceIdInfo type is confusing: there's practically no difference between `NoInfo` and `HasInfo []`. The comments say NoInfo is used when -fomit-interface-pragmas is enabled, but we don't need to distinguish `NoInfo` from `HasInfo []` in when reading the interface so the distinction is not important. This patch simplifies the type by removing NoInfo. When we have no info we use an empty list. With this change we no longer read the info list lazily when reading an IfaceInfoItem, but when reading an IfaceId the ifIdInfo field is read lazily, so I doubt this is going to be a problem. - - - - - 3979485b by Roland Senn at 2020-02-29T17:36:59+01:00 Show breakpoint locations of breakpoints which were ignored during :force (#2950) GHCi is split up into 2 major parts: The user-interface (UI) and the byte-code interpreter. With `-fexternal-interpreter` they even run in different processes. Communication between the UI and the Interpreter (called `iserv`) is done using messages over a pipe. This is called `Remote GHCI` and explained in the Note [Remote GHCi] in `compiler/ghci/GHCi.hs`. To process a `:force` command the UI sends a `Seq` message to the `iserv` process. Then `iserv` does the effective evaluation of the value. When during this process a breakpoint is hit, the `iserv` process has no additional information to enhance the `Ignoring breakpoint` output with the breakpoint location. To be able to print additional breakpoint information, there are 2 possible implementation choices: 1. Store the needed information in the `iserv` process. 2. Print the `Ignoring breakpoint` from the UI process. For option 1 we need to store the breakpoint info redundantely in 2 places and this is bad. Therfore option 2 was implemented in this MR: - The user enters a `force` command - The UI sends a `Seq` message to the `iserv` process. - If processing of the `Seq` message hits a breakpoint, the `iserv` process returns control to the UI process. - The UI looks up the source location of the breakpoint, and prints the enhanced `Ignoring breakpoint` output. - The UI sends a `ResumeSeq` message to the `iserv` process, to continue forcing. - - - - - 3cf7303b by Krzysztof Gogolewski at 2020-03-02T01:18:33-05:00 Remove dead code * The names in PrelName and THNames are no longer used since TH merged types and kinds, Typeable is kind-polymorphic, .net support was removed * unqualQuasiQuote no longer used since 6f8ff0bbad3b9fa3 - - - - - dbea7e9d by Ilias Tsitsimpis at 2020-03-02T01:19:12-05:00 Do not define hs_atomic{read,write}64() on non-64bit Do not define hs_atomicread64() and hs_atomicwrite64() on machines where WORD_SIZE_IN_BITS is less than 64, just like we do with the rest of the atomic functions which work on 64-bit values. Without this, compilation fails on MIPSel and PowerPC with the following error: /usr/bin/ld: /<<PKGBUILDDIR>>/libraries/ghc-prim/dist-install/build/libHSghc-prim-0.5.3_p.a(atomic.p_o): in function `hs_atomicread64': atomic.c:(.text.hs_atomicread64+0x8): undefined reference to `__sync_add_and_fetch_8' /usr/bin/ld: /<<PKGBUILDDIR>>/libraries/ghc-prim/dist-install/build/libHSghc-prim-0.5.3_p.a(atomic.p_o): in function `hs_atomicwrite64': atomic.c:(.text.hs_atomicwrite64+0x38): undefined reference to `__sync_bool_compare_and_swap_8' Fixes #17886. - - - - - 7c0c76fb by Roland Senn at 2020-03-02T17:13:55-05:00 Set `ImpredicativeTypes` during :print command. (#14828) If ImpredicativeTypes is not enabled, then `:print <term>` will fail if the type of <term> has nested `forall`s or `=>`s. This is because the GHCi debugger's internals will attempt to unify a metavariable with the type of <term> and then display the result, but if the type has nested `forall`s or `=>`s, then unification will fail. As a result, `:print` will bail out and the unhelpful result will be `<term> = (_t1::t1)` (where `t1` is a metavariable). Beware: <term> can have nested `forall`s even if its definition doesn't use RankNTypes! Here is an example from #14828: class Functor f where fmap :: (a -> b) -> f a -> f b Somewhat surprisingly, `:print fmap` considers the type of fmap to have nested foralls. This is because the GHCi debugger sees the type `fmap :: forall f. Functor f => forall a b. (a -> b) -> f a -> f b`. We could envision deeply instantiating this type to get the type `forall f a b. Functor f => (a -> b) -> f a -> f b`, but this trick wouldn't work for higher-rank types. Instead, we adopt a simpler fix: enable `ImpredicativeTypes` when using `:print` and friends in the GHCi debugger. This is allows metavariables to unify with types that have nested (or higher-rank) `forall`s/`=>`s, which makes `:print fmap` display as `fmap = (_t1::forall a b. Functor f => (a -> b) -> f a -> f b)`, as expected. Although ImpredicativeTypes is a somewhat unpredictable from a type inference perspective, there is no danger in using it in the GHCi debugger, since all of the terms that the GHCi debugger deals with have already been typechecked. - - - - - 2a2f51d7 by Sylvain Henry at 2020-03-02T17:14:38-05:00 Use configure script to detect that we should use in-tree GMP on Windows - - - - - 8c663c2c by Andreas Klebinger at 2020-03-04T16:12:14+01:00 Be explicit about how stack usage of mvar primops are covered. This fixes #17893 [skip-ci] - - - - - cedd6f30 by Ben Gamari at 2020-03-05T14:53:12-05:00 rts: Add getCurrentThreadCPUTime helper - - - - - ace618cd by Ben Gamari at 2020-03-05T14:53:12-05:00 nonmoving-gc: Track time usage of nonmoving marking - - - - - 022b5ad5 by Ben Gamari at 2020-03-05T14:53:12-05:00 Stats: Add sync pauses to +RTS -S output - - - - - 06763234 by Ben Gamari at 2020-03-05T14:53:12-05:00 rts: Report nonmoving collector statistics in machine-readable output - - - - - 70d2b995 by Ben Gamari at 2020-03-09T06:10:52-04:00 nonmoving: Fix collection of sparks Previously sparks living in the non-moving heap would be promptly GC'd by the minor collector since pruneSparkQueue uses the BF_EVACUATED flag, which non-moving heap blocks do not have set. Fix this by implementing proper support in pruneSparkQueue for determining reachability in the non-moving heap. The story is told in Note [Spark management in the nonmoving heap]. - - - - - 9668781a by Ben Gamari at 2020-03-09T06:11:30-04:00 gitlab-ci: Disable Sphinx documentation in Alpine build - - - - - 8eb2c263 by Jean-Baptiste Mazon at 2020-03-09T16:33:37-04:00 Fix Windows breakage by not touching locales on Windows - - - - - b8dab057 by Jean-Baptiste Mazon at 2020-03-09T16:33:37-04:00 rts: ensure C numerics in heap profiles using Windows locales if needed - - - - - 7d95260f by Jean-Baptiste Mazon at 2020-03-09T16:33:37-04:00 rts: refactor and comment profile locales - - - - - 5b627813 by Ryan Scott at 2020-03-09T16:34:14-04:00 Use InstanceSigs in GND/DerivingVia-generated code (#17899) Aside from making the generated code easier to read when `-ddump-deriv` is enabled, this makes the error message in `T15073` substantially simpler (see the updated `T15073` expected stderr). Fixes #17899. - - - - - 70b50778 by Ben Gamari at 2020-03-10T02:05:42-04:00 SysTools: Ensure that error parser can handle absolute paths on Windows This fixes #17786, where the error parser fails to correctly handle the drive name in absolute Windows paths. Unfortunately I couldn't find a satisfactory way to test this. - - - - - 85b861d8 by Ben Gamari at 2020-03-10T02:05:42-04:00 testsuite: Add test for #17786 This isn't pretty but it's perhaps better than nothing. - - - - - ee2c50cb by Sylvain Henry at 2020-03-10T02:06:33-04:00 Hadrian: track missing configure results - - - - - ca8f51d4 by Ömer Sinan Ağacan at 2020-03-10T02:07:22-04:00 Add regression test for T17904 Closes #17904 - - - - - 5fa9cb82 by Richard Eisenberg at 2020-03-10T12:29:46-04:00 anyRewritableTyVar now looks in RuntimeReps Previously, anyRewritableTyVar looked only at the arg and res of `arg -> res`, but their RuntimeReps are also subject to rewriting. Easy to fix. Test case: typecheck/should_compile/T17024 Fixes #17024. - - - - - 5ba01d83 by Ben Price at 2020-03-10T12:30:27-04:00 Clarify a Lint message When developing a plugin I had a shadowing problem, where I generated code app = \f{v r7B} x{v r7B} -> f{v r7B} x{v r7B} This is obviously wrong, since the occurrence of `f` to the right of the arrow refers to the `x` binder (they share a Unique). However, it is rather confusing when Lint reports Mismatch in type between binder and occurrence Var: x{v rB7} since it is printing the binder, rather than the occurrence. It is rather easy to read this as claiming there is something wrong with the `x` occurrence! We change the report to explicitly print both the binder and the occurrence variables. - - - - - 7b2c827b by Simon Peyton Jones at 2020-03-10T12:31:15-04:00 Comments only Clarify code added in #17852 and MR !2724 - - - - - 3300eeac by Krzysztof Gogolewski at 2020-03-10T12:31:54-04:00 Misc cleanup - Remove Note [Existentials in shift_con_pat]. The function shift_con_pat has been removed 15 years ago in 23f40f0e9be6d4. - Remove kcLookupTcTyCon - it's the same as tcLookupTcTyCon - Remove ASSERT in tyConAppArgN. It's already done by getNth, and it's the only reason getNth exists. - Remove unused function nextRole - - - - - abf5736b by Krzysztof Gogolewski at 2020-03-10T18:05:01+01:00 Typos in comments [skip ci] - - - - - bb586f89 by Ben Gamari at 2020-03-11T00:14:59-04:00 rts: Prefer darwin-specific getCurrentThreadCPUTime macOS Catalina now supports a non-POSIX-compliant version of clock_gettime which cannot use the clock_gettime codepath. Fixes #17906. - - - - - 20800b9a by Sylvain Henry at 2020-03-11T08:17:19-04:00 Split GHC.Iface.Utils module * GHC.Iface.Recomp: recompilation avoidance stuff * GHC.Iface.Make: mkIface* Moved `writeIfaceFile` into GHC.Iface.Load alongside `readIface` and renamed it `writeIface` for consistency. - - - - - 1daa2029 by Greg Steuck at 2020-03-11T08:17:56-04:00 Fixed a minor typo in codegen.rst - - - - - 0bc23338 by Ryan Scott at 2020-03-11T08:18:32-04:00 Re-quantify when generalising over rewrite rule types Previously, `tcRules` would check for naughty quantification candidates (see `Note [Naughty quantification candidates]` in `TcMType`) when generalising over the type of a rewrite rule. This caused sensible-looking rewrite rules (like those in #17710) to be rejected. A more permissing (and easier-to-implement) approach is to do what is described in `Note [Generalising in tcTyFamInstEqnGuts]` in `TcTyClsDecls`: just re-quantify all the type variable binders, regardless of the order in which the user specified them. After all, the notion of type variable specificity has no real meaning in rewrite rules, since one cannot "visibly apply" a rewrite rule. I have written up this wisdom in `Note [Re-quantify type variables in rules]` in `TcRules`. As a result of this patch, compiling the `ExplicitForAllRules1` test case now generates one fewer warning than it used to. As far as I can tell, this is benign, since the thing that the disappearing warning talked about was also mentioned in an entirely separate warning. Fixes #17710. - - - - - 336eac7e by Ben Gamari at 2020-03-11T08:19:08-04:00 testsuite: Mark ghci056 and ghcilink004 as fragile in unreg As noted in #17018. Also fix fragile declaration of T13786, which only runs in the normal way. - - - - - c61b9b02 by Simon Peyton Jones at 2020-03-11T08:19:44-04:00 Deepen call stack for isIn I see quite a few warnings like: WARNING: file compiler/utils/Util.hs, line 593 Over-long elem in unionLists But the call stack is uninformative. Better to add HasDebugCallStack to isIn. Ditto isn'tIn. - - - - - 3aa9b35f by Ömer Sinan Ağacan at 2020-03-11T08:20:27-04:00 Zero any slop after compaction in compacting GC In copying GC, with the relevant debug flags enabled, we release the old blocks after a GC, and the block allocator zeroes the space before releasing a block. This effectively zeros the old heap. In compacting GC we reuse the blocks and previously we didn't zero the unused space in a compacting generation after compaction. With this patch we zero the slop between the free pointer and the end of the block when we're done with compaction and when switching to a new block (because the current block doesn't have enough space for the next object we're shifting). - - - - - 8e6febce by Sylvain Henry at 2020-03-11T20:33:37-04:00 Refactor GHC.Driver.Session (Ways and Flags) * extract flags and ways into their own modules (with some renaming) * remove one SOURCE import of GHC.Driver.Session from GHC.Driver.Phases * when GHC uses dynamic linking (WayDyn), `interpWays` was only reporting WayDyn even if the host was profiled (WayProf). Now it returns both as expected (might fix #16803). * `mkBuildTag :: [Way] -> String` wasn't reporting a canonical tag for differently ordered lists. Now we sort and nub the list to fix this. - - - - - bc41e471 by Sylvain Henry at 2020-03-11T20:33:37-04:00 Refactor interpreterDynamic and interpreterProfiled * `interpreterDynamic` and `interpreterProfiled` now take `Interp` parameters instead of DynFlags * slight refactoring of `ExternalInterp` so that we can read the iserv configuration (which is pure) without reading an MVar. - - - - - a6989971 by Sylvain Henry at 2020-03-11T20:33:37-04:00 Use a Set to represent Ways Should make `member` queries faster and avoid messing up with missing `nubSort`. Metric Increase: hie002 - - - - - cb93a1a4 by Ryan Scott at 2020-03-11T20:34:14-04:00 Make DeriveFunctor-generated code require fewer beta reductions Issue #17880 demonstrates that `DeriveFunctor`-generated code is surprisingly fragile when rank-_n_ types are involved. The culprit is that `$fmap` (the algorithm used to generate `fmap` implementations) was too keen on applying arguments with rank-_n_ types to lambdas, which fail to typecheck more often than not. In this patch, I change `$fmap` (both the specification and the implementation) to produce code that avoids creating as many lambdas, avoiding problems when rank-_n_ field types arise. See the comments titled "Functor instances" in `TcGenFunctor` for a more detailed description. Not only does this fix #17880, but it also ensures that the code that `DeriveFunctor` generates will continue to work after simplified subsumption is implemented (see #17775). What is truly amazing is that #17880 is actually a regression (introduced in GHC 7.6.3) caused by commit 49ca2a37bef18aa57235ff1dbbf1cc0434979b1e, the fix #7436. Prior to that commit, the version of `$fmap` that was used was almost identical to the one used in this patch! Why did that commit change `$fmap` then? It was to avoid severe performance issues that would arise for recursive `fmap` implementations, such as in the example below: ```hs data List a = Nil | Cons a (List a) deriving Functor -- ===> instance Functor List where fmap f Nil = Nil fmap f (Cons x xs) = Cons (f x) (fmap (\y -> f y) xs) ``` The fact that `\y -> f y` was eta expanded caused significant performance overheads. Commit 49ca2a37bef18aa57235ff1dbbf1cc0434979b1e fixed this performance issue, but it went too far. As a result, this patch partially reverts 49ca2a37bef18aa57235ff1dbbf1cc0434979b1e. To ensure that the performance issues pre-#7436 do not resurface, I have taken some precautionary measures: * I have added a special case to `$fmap` for situations where the last type variable in an application of some type occurs directly. If this special case fires, we avoid creating a lambda expression. This ensures that we generate `fmap f (Cons x xs) = Cons (f x) (fmap f xs)` in the derived `Functor List` instance above. For more details, see `Note [Avoid unnecessary eta expansion in derived fmap implementations]` in `TcGenFunctor`. * I have added a `T7436b` test case to ensure that the performance of this derived `Functor List`-style code does not regress. When implementing this, I discovered that `$replace`, the algorithm which generates implementations of `(<$)`, has a special case that is very similar to the `$fmap` special case described above. `$replace` marked this special case with a custom `Replacer` data type, which was a bit overkill. In order to use the same machinery for both `Functor` methods, I ripped out `Replacer` and instead implemented a simple way to detect the special case. See the updated commentary in `Note [Deriving <$]` for more details. - - - - - 1f9db3e7 by Kirill Elagin at 2020-03-12T09:45:51-04:00 pretty-printer: Properly parenthesise LastStmt After ApplicatveDo strips the last `return` during renaming, the pretty printer has to restore it. However, if the return was followed by `$`, the dollar was stripped too and not restored. For example, the last stamement in: ``` foo = do x <- ... ... return $ f x ``` would be printed as: ``` return f x ``` This commit preserved the dolar, so it becomes: ``` return $ f x ``` - - - - - 5cb93af7 by Kirill Elagin at 2020-03-12T09:45:51-04:00 pretty-printer: Do not print ApplicativeDo join * Do not print `join` in ApplictiveStmt, unless ppr-debug * Print parens around multiple parallel binds When ApplicativeDo is enabled, the renamer analyses the statements of a `do` block and in certain cases marks them as needing to be rewritten using `join`. For example, if you have: ``` foo = do a <- e1 b <- e2 doSomething a b ``` it will be desugared into: ``` foo = join (doSomething <$> e1 <*> e2) ``` After renaming but before desugaring the expression is stored essentially as: ``` foo = do [will need join] (a <- e1 | b <- e2) [no return] doSomething a b ``` Before this change, the pretty printer would print a call to `join`, even though it is not needed at this stage at all. The expression will be actually rewritten into one using join only at desugaring, at which point a literal call to join will be inserted. - - - - - 3a259092 by Simon Peyton Jones at 2020-03-12T09:46:29-04:00 Expose compulsory unfoldings always The unsafeCoerce# patch requires that unsafeCoerce# has a compulsory unfolding that is always available. So we have to be careful to expose compulsory unfoldings unconditionally and consistently. We didn't get this quite right: #17871. This patch fixes it. No real surprises here. See Note [Always expose compulsory unfoldings] in GHC.Iface.Tidy - - - - - 6a65b8c2 by Alp Mestanogullari at 2020-03-13T02:29:20-04:00 hadrian: improve dependency tracking for the check-* programs The code in Rules.Register responsible for finding all the build artifacts that Cabal installs when registering a library (static/shared libs, .hi files, ...) was looking in the wrong place. This patch fixes that logic and makes sure we gather all those artifacts in a list to declare that the rule for a given `.conf` file, our proxy for "Hadrian, please install this package in the package db for this stage", also produces those artifacts under the said package database. We also were completely missing some logic to declare that the check-* programs have dependencies besides their source code, at least when testing an in-tree compiler. Finally, this patch also removes redundant packages from 'testsuitePackages', since they should already be covered by the stage<N>Packages lists from Settings.Default. With this patch, after a complete build and freezing stage 1, a change to `compiler/parser/Parser.y` results in rebuilding the ghc lib, reinstalling it, and rebuilding the few programs that depend on it, _including_ `check-ppr` and `check-api-annotations` (therefore fixing #17273). - - - - - 44fad4a9 by Sylvain Henry at 2020-03-13T02:30:22-04:00 Rename isDllName I wanted to fix the dangling comment in `isDllName` ("This is the cause of #", #8696 is already mentioned earlier). I took the opportunity to change the function name to better reflect what it does. - - - - - 2f292db8 by Paavo at 2020-03-13T02:31:03-04:00 Update documentation for closureSize - - - - - f124ff0d by Ben Gamari at 2020-03-13T02:31:40-04:00 gitlab-ci: Rework triggering of release builds Use a push option instead of tagging. - - - - - 7f25557a by Ben Gamari at 2020-03-13T10:38:09-04:00 gitlab-ci: Distinguish integer-simple test envs Previously two integer-simple jobs declared the same test environment. One (the nightly job) was built in the perf way, the other in the validate way. Consequently they had appreciably different performance characteristics, causing in the nightly job to spuriously fail with performance changes. - - - - - c12a2ec5 by Simon Peyton Jones at 2020-03-14T05:25:30-04:00 Fix Lint Ticket #17590 pointed out a bug in the way the linter dealt with type lets, exposed by the new uniqAway story. The fix is described in Note [Linting type lets]. I ended up putting the in-scope Ids in a different env field, le_ids, rather than (as before) sneaking them into the TCvSubst. Surprisingly tiresome, but done. Metric Decrease: hie002 - - - - - b989845e by Sylvain Henry at 2020-03-14T05:26:11-04:00 Hadrian: fix absolute buildroot support (#17822) Shake's "**" wildcard doesn't match absolute root. We must use "//" instead. - - - - - 4f117135 by Sylvain Henry at 2020-03-14T05:26:49-04:00 Make: refactor GMP rules Document and use simpler rules for the ghc-gmp.h header. - - - - - 7432b327 by Sylvain Henry at 2020-03-14T05:27:28-04:00 Use correct option name (-opti) (fix #17314) s/pgmo/opti - - - - - 8f7dd571 by Judah Jacobson at 2020-03-14T05:28:07-04:00 Allow overriding LD_STAGE0 and AR_STAGE0 in the configure script. Previously it was possible to override the stage0 C compiler via `CC_STAGE0`, but you couldn't override `ld` or `ar` in stage0. This change allows overriding them by setting `LD_STAGE0` or `AR_STAGE0`, respectively. Our team uses this feature internally to take more control of our GHC build and make it run more hermetically. - - - - - 7c3e39a9 by Judah Jacobson at 2020-03-14T05:28:07-04:00 Use AC_ARG_VAR for LD_STAGE0 and AR_STAGE0. - - - - - 20d4d676 by Ben Gamari at 2020-03-14T05:28:43-04:00 nonmoving: Don't traverse filled segment list in pause The non-moving collector would previously walk the entire filled segment list during the preparatory pause. However, this is far more work than is strictly necessary. We can rather get away with merely collecting the allocators' filled segment list heads and process the lists themselves during the concurrent phase. This can significantly reduce the maximum gen1 GC pause time in programs with high rates of long-lived allocations. - - - - - fdfa2d01 by Ben Gamari at 2020-03-14T05:29:18-04:00 nonmoving: Remove redundant bitmap clearing nonmovingSweep already clears the bitmap in the sweep loop. There is no reason to do so a second time. - - - - - 2f8c7767 by Simon Peyton Jones at 2020-03-14T05:29:55-04:00 Simple refactor of cheapEqExpr No change in functionality. Just seems tidier (and signficantly more efficient) to deal with ticks directly than to call stripTicksTopE. - - - - - 88f7a762 by Simon Peyton Jones at 2020-03-14T05:29:55-04:00 Improve CSE.combineAlts This patch improves the way that CSE combines identical alternatives. See #17901. I'm still not happy about the duplication between CSE.combineAlts and GHC.Core.Utils.combineIdenticalAlts; see the Notes with those functions. But this patch is a step forward. Metric Decrease: T12425 T5642 - - - - - 8b95ddd3 by Ben Gamari at 2020-03-14T05:30:31-04:00 gitlab-ci: Add integer-simple release build for Windows Closes #16144. - - - - - e3c374cc by Simon Peyton Jones at 2020-03-14T05:31:07-04:00 Wrap an implication around class-sig kind errors Ticket #17841 showed that we can get a kind error in a class signature, but lack an enclosing implication that binds its skolems. This patch * Adds the wrapping implication: the new call to checkTvConstraints in tcClassDecl1 * Simplifies the API to checkTvConstraints, which was not otherwise called at all. * Simplifies TcErrors.report_unsolved by *not* initialising the TidyEnv from the typechecker lexical envt. It's enough to do so from the free vars of the unsolved constraints; and we get silly renamings if we add variables twice: once from the lexical scope and once from the implication constraint. - - - - - 73133a3b by Simon Peyton Jones at 2020-03-14T05:31:07-04:00 Refactoring in TcSMonad This patch is just refactoring: no change in behaviour. I removed the rather complicated checkConstraintsTcS checkTvConstraintsTcS in favour of simpler functions emitImplicationTcS emitTvImplicationTcS pushLevelNoWorkList The last of these is a little strange, but overall it's much better I think. - - - - - 93c88c26 by Ben Gamari at 2020-03-14T05:31:42-04:00 base: Make `open` calls interruptible As noted in #17912, `open` system calls were `safe` rather than `interruptible`. Consequently, the program could not be interrupted with SIGINT if stuck in a slow open operation. Fix this by marking `c_safe_open` as interruptible. - - - - - bee4cdad by Vladislav Zavialov at 2020-03-14T05:32:18-04:00 Remove second tcLookupTcTyCon in tcDataDefn Before this patch, tcDataDefn used to call tcLookupTcTyCon twice in a row: 1. in bindTyClTyVars itself 2. in the continuation passed to it Now bindTyClTyVars passes the TcTyCon to the continuation, making the second lookup unnecessary. - - - - - 3f116d35 by Cale Gibbard at 2020-03-14T19:34:42-04:00 Enable stage1 build of haddock The submodule has already been bumped to contain the fix. - - - - - 49e9d739 by Ömer Sinan Ağacan at 2020-03-14T19:35:24-04:00 rts: Fix printClosure when printing fwd ptrs - - - - - 1de3ab4a by Krzysztof Gogolewski at 2020-03-14T19:36:04-04:00 Remove unused field var_inline (#17915) - - - - - d30aeb4b by Krzysztof Gogolewski at 2020-03-15T03:57:41-04:00 Document restriction on SCC pragma syntax Currently, the names of cost centres must be quoted or be lowercase identifiers. Fixes #17916. - - - - - b4774598 by Brian Foley at 2020-03-15T03:58:18-04:00 Remove some dead code >From the notes.ghc.drop list found using weeder in #17713 - - - - - dd6ffe6b by Viktor Dukhovni at 2020-03-15T03:58:55-04:00 Note platform-specific Foreign.C.Types in context Also fix the markup in the general note at the top of the module. Haddock (usability trade-off), does not support multi-line emphasised text. - - - - - 2e82465f by Sylvain Henry at 2020-03-15T10:57:10-04:00 Refactor CmmToAsm (disentangle DynFlags) This patch disentangles a bit more DynFlags from the native code generator (CmmToAsm). In more details: - add a new NCGConfig datatype in GHC.CmmToAsm.Config which contains the configuration of a native code generation session - explicitly pass NCGConfig/Platform arguments when necessary - as a consequence `sdocWithPlatform` is gone and there are only a few `sdocWithDynFlags` left - remove the use of `unsafeGlobalDynFlags` from GHC.CmmToAsm.CFG - remove `sdocDebugLevel` (now we pass the debug level via NCGConfig) There are still some places where DynFlags is used, especially because of pretty-printing (CLabel), because of Cmm helpers (such as `cmmExprType`) and because of `Outputable` instance for the instructions. These are left for future refactoring as this patch is already big. - - - - - c35c545d by Judah Jacobson at 2020-03-15T10:57:48-04:00 Add a -no-haddock flag. This flag undoes the effect of a previous "-haddock" flag. Having both flags makes it easier for build systems to enable Haddock parsing in a set of global flags, but then disable it locally for specific targets (e.g., third-party packages whose comments don't pass the validation in the latest GHC). I added the flag to expected-undocumented-flags.txt since `-haddock` was alreadyin that list. - - - - - cfcc3c9a by Ömer Sinan Ağacan at 2020-03-15T10:58:27-04:00 Fix global_link of TSOs for threads reachable via dead weaks Fixes #17785 Here's how the problem occurs: - In generation 0 we have a TSO that is finished (i.e. it has no more work to do or it is killed). - The TSO only becomes reachable after collectDeadWeakPtrs(). - After collectDeadWeakPtrs() we switch to WeakDone phase where we don't move TSOs to different lists anymore (like the next gen's thread list or the resurrected_threads list). - So the TSO will never be moved to a generation's thread list, but it will be promoted to generation 1. - Generation 1 collected via mark-compact, and because the TSO is reachable it is marked, and its `global_link` field, which is bogus at this point (because the TSO is not in a list), will be threaded. - Chaos ensues. In other words, when these conditions hold: - A TSO is reachable only after collectDeadWeakPtrs() - It's finished (what_next is ThreadComplete or ThreadKilled) - It's retained by mark-compact collector (moving collector doesn't evacuate the global_list field) We end up doing random mutations on the heap because the TSO's global_list field is not valid, but it still looks like a heap pointer so we thread it during compacting GC. The fix is simple: when we traverse old_threads lists to resurrect unreachable threads the threads that won't be resurrected currently stays on the old_threads lists. Those threads will never be visited again by MarkWeak so we now reset the global_list fields. This way compacting GC does not thread pointers to nowhere. Testing ------- The reproducer in #17785 is quite large and hard to build, because of the dependencies, so I'm not adding a regression test. In my testing the reproducer would take a less than 5 seconds to run, and once in every ~5 runs would fail with a segfault or an assertion error. In other cases it also fails with a test failure. Because the tests never fail with the bug fix, assuming the code is correct, this also means that this bug can sometimes lead to incorrect runtime results. After the fix I was able to run the reproducer repeatedly for about an hour, with no runtime crashes or test failures. To run the reproducer clone the git repo: $ git clone https://github.com/osa1/streamly --branch ghc-segfault Then clone primitive and atomic-primops from their git repos and point to the clones in cabal.project.local. The project should then be buildable using GHC HEAD. Run the executable `properties` with `+RTS -c -DZ`. In addition to the reproducer above I run the test suite using: $ make slowtest EXTRA_HC_OPTS="-debug -with-rtsopts=-DS \ -with-rtsopts=-c +RTS -c -RTS" SKIPWAY='nonmoving nonmoving_thr' This enables compacting GC always in both GHC when building the test programs and when running the test programs, and also enables sanity checking when running the test programs. These set of flags are not compatible for all tests so there are some failures, but I got the same set of failures with this patch compared to GHC HEAD. - - - - - 818b3c38 by Lysxia at 2020-03-16T23:52:42-04:00 base: add strict IO functions: readFile', getContents', hGetContents' - - - - - 18a346a4 by Sylvain Henry at 2020-03-16T23:53:24-04:00 Modules: Core (#13009) Update submodule: haddock - - - - - 92327e3a by Ömer Sinan Ağacan at 2020-03-16T23:54:04-04:00 Update sanity checking for TSOs: - Remove an invalid assumption about GC checking what_next field. The GC doesn't care about what_next at all, if a TSO is reachable then all its pointers are followed (other than global_tso, which is only followed by compacting GC). - Remove checkSTACK in checkTSO: TSO stacks will be visited in checkHeapChain, or checkLargeObjects etc. - Add an assertion in checkTSO to check that the global_link field is sane. - Did some refactor to remove forward decls in checkGlobalTSOList and added braces around single-statement if statements. - - - - - e1aa4052 by PHO at 2020-03-17T07:36:09-04:00 Don't use non-portable operator "==" in configure.ac The test operator "==" is a Bash extension and produces a wrong result if /bin/sh is not Bash. - - - - - 89f034dd by Maximilian Tagher at 2020-03-17T07:36:48-04:00 Document the units of -ddump-timings Right now, in the output of -ddump-timings to a file, you can't tell what the units are: ``` CodeGen [TemplateTestImports]: alloc=22454880 time=14.597 ``` I believe bytes/milliseconds are the correct units, but confirmation would be appreciated. I'm basing it off of this snippet from `withTiming'`: ``` when (verbosity dflags >= 2 && prtimings == PrintTimings) $ liftIO $ logInfo dflags (defaultUserStyle dflags) (text "!!!" <+> what <> colon <+> text "finished in" <+> doublePrec 2 time <+> text "milliseconds" <> comma <+> text "allocated" <+> doublePrec 3 (realToFrac alloc / 1024 / 1024) <+> text "megabytes") ``` which implies time is in milliseconds, and allocations in bytes (which divided by 1024 would be KB, and again would be MB) - - - - - beffa147 by Simon Peyton Jones at 2020-03-17T07:37:25-04:00 Implement mapTyCo like foldTyCo This patch makes mapType use the successful idiom described in TyCoRep Note [Specialising foldType] I have not yet changed any functions to use mapType, though there may be some suitable candidates. This patch should be a no-op in terms of functionality but, because it inlines the mapper itself, I'm hoping that there may be some modest perf improvements. Metric Decrease: T5631 T5642 T3064 T9020 T14683 hie002 haddock.Cabal haddock.base haddock.compiler - - - - - 5800ebfe by Ömer Sinan Ağacan at 2020-03-17T07:38:08-04:00 Don't update ModDetails with CafInfos when opts are disabled This is consistent with the interface file behavior where we omit HsNoCafRefs annotations with -fomit-interface-pragmas (implied by -O0). ModDetails and ModIface are just different representations of the same thing, so they really need to be in sync. This patch does the right thing and does not need too much explanation, but here's an example of a problem not doing this causes in !2842: -- MyInteger.hs module MyInteger ( MyInteger (MyInteger) , ToMyInteger (toMyInteger) ) where newtype MyInteger = MyInteger Integer class ToMyInteger a where toMyInteger :: a -> MyInteger instance ToMyInteger Integer where toMyInteger = MyInteger {- . succ -} -- Main.hs module Main ( main ) where import MyInteger (MyInteger (MyInteger), toMyInteger) main :: IO () main = do let (MyInteger i) = (id . toMyInteger) (41 :: Integer) print i If I build this with -O0, without this fix, we generate a ModDetails with accurate LFInfo for toMyInteger (MyInteger.$fToMyIntegerInteger) which says that it's a LFReEntrant with arity 1. This means in the use site (Main) we tag the value: R3 = MyInteger.$fToMyIntegerInteger_closure + 1; R2 = GHC.Base.id_closure; R1 = GHC.Base.._closure; Sp = Sp - 16; call stg_ap_ppp_fast(R4, R3, R2, R1) args: 24, res: 0, upd: 24; Now we change the definition by uncommenting the `succ` part and it becomes a thunk: MyInteger.$fToMyIntegerInteger [InlPrag=INLINE (sat-args=0)] :: MyInteger.ToMyInteger GHC.Integer.Type.Integer [GblId[DFunId(nt)]] = {} \u [] $ctoMyInteger_rEA; and its LFInfo is now LFThunk. This change in LFInfo makes a difference in the use site: we can no longer tag it. But becuase the interface fingerprint does not change (because ModIface does not change) we don't rebuild Main and tag the thunk. (1.2% increase in allocations when building T12545 on armv7 because we generate more code without CafInfos) Metric Increase: T12545 - - - - - 5b632dad by Paavo at 2020-03-17T07:38:48-04:00 Add example for Data.Semigroup.diff - - - - - 4d85d68b by Paavo at 2020-03-17T07:38:48-04:00 Clean up - - - - - 75168d07 by Paavo at 2020-03-17T07:38:48-04:00 Make example collapsible - - - - - 53ff2cd0 by Richard Eisenberg at 2020-03-17T13:46:57+00:00 Fix #17021 by checking more return kinds All the details are in new Note [Datatype return kinds] in TcTyClsDecls. Test case: typecheck/should_fail/T17021{,b} typecheck/should_compile/T17021a Updates haddock submodule - - - - - 528df8ec by Sylvain Henry at 2020-03-18T10:06:43-04:00 Modules: Core operations (#13009) - - - - - 4e8a71c1 by Richard Eisenberg at 2020-03-18T10:07:19-04:00 Add release note about fix to #16502. We thought we needed to update the manual, but the fix for #16502 actually brings the implementation in line with the manual. So we just alert users of how to update their code. - - - - - 5cbf9934 by Andreas Klebinger at 2020-03-19T00:39:27-04:00 Update "GHC differences to the FFI Chapter" in user guide. The old entry had a heavy focus on how things had been. Which is not what I generally look for in a user guide. I also added a small section on behaviour of nested safe ffi calls. [skip-ci] - - - - - b03fd3bc by Sebastian Graf at 2020-03-19T00:40:06-04:00 PmCheck: Use ConLikeSet to model negative info In #17911, Simon recognised many warnings stemming from over-long list unions while coverage checking Cabal's `LicenseId` module. This patch introduces a new `PmAltConSet` type which uses a `UniqDSet` instead of an association list for `ConLike`s. For `PmLit`s, it will still use an assocation list, though, because a similar map data structure would entail a lot of busy work. Fixes #17911. - - - - - 64f20756 by Sylvain Henry at 2020-03-19T12:16:49-04:00 Refactoring: use Platform instead of DynFlags when possible Metric Decrease: ManyConstructors T12707 T13035 T1969 - - - - - cb1785d9 by Ömer Sinan Ağacan at 2020-03-19T12:16:54-04:00 FastString: fix eager reading of string ptr in hashStr This read causes NULL dereferencing when len is 0. Fixes #17909 In the reproducer in #17909 this bug is triggered as follows: - SimplOpt.dealWithStringLiteral is called with a single-char string ("=" in #17909) - tailFS gets called on the FastString of the single-char string. - tailFS checks the length of the string, which is 1, and calls mkFastStringByteString on the tail of the ByteString, which is an empty ByteString as the original ByteString has only one char. - ByteString's unsafeUseAsCStringLen returns (NULL, 0) for the empty ByteString, which is passed to mkFastStringWith. - mkFastStringWith gets hash of the NULL pointer via hashStr, which fails on empty strings because of this bug. - - - - - 73a7383e by Richard Eisenberg at 2020-03-20T20:42:56-04:00 Simplify treatment of heterogeneous equality Previously, if we had a [W] (a :: k1) ~ (rhs :: k2), we would spit out a [D] k1 ~ k2 and part the W as irreducible, hoping for a unification. But we needn't do this. Instead, we now spit out a [W] co :: k2 ~ k1 and then use co to cast the rhs of the original Wanted. This means that we retain the connection between the spat-out constraint and the original. The problem with this new approach is that we cannot use the casted equality for substitution; it's too like wanteds-rewriting- wanteds. So, we forbid CTyEqCans that mention coercion holes. All the details are in Note [Equalities with incompatible kinds] in TcCanonical. There are a few knock-on effects, documented where they occur. While debugging an error in this patch, Simon and I ran into infelicities in how patterns and matches are printed; we made small improvements. This patch includes mitigations for #17828, which causes spurious pattern-match warnings. When #17828 is fixed, these lines should be removed. - - - - - faa36e5b by Sylvain Henry at 2020-03-20T20:43:41-04:00 Hadrian: ignore in-tree GMP objects with ``--lint`` - - - - - 9a96ff6b by Richard Eisenberg at 2020-03-20T20:44:17-04:00 Update core spec to reflect changes to Core. Key changes: * Adds a new rule for forall-coercions over coercion variables, which was implemented but conspicuously missing from the spec. * Adds treatment for FunCo. * Adds treatment for ForAllTy over coercion variables. * Improves commentary (including restoring a Note lost in 03d4852658e1b7407abb4da84b1b03bfa6f6db3b) in the source. No changes to running code. - - - - - 7e0451c6 by Sergej Jaskiewicz at 2020-03-20T20:44:55-04:00 Fix event message in withTiming' This typo caused generating 'end' events without the corresponding 'begin' events. - - - - - 1542a626 by Ben Gamari at 2020-03-22T22:37:47-04:00 fs.h: Add missing declarations on Windows - - - - - 3bcf2ccd by Ben Gamari at 2020-03-22T22:37:47-04:00 Bump process submodule Avoids redundant case alternative warning. - - - - - 3b363ef9 by Ben Gamari at 2020-03-22T22:37:47-04:00 testsuite: Normalize slashes in ghc-api annotations output Enable `normalise_slashes` on `annotations`, `listcomps`, and `parseTree` to fix Windows failures. - - - - - 25fc9429 by Ben Gamari at 2020-03-22T22:37:47-04:00 testsuite: Update expected output on Windows - - - - - 7f58ec6d by Ben Gamari at 2020-03-22T22:37:47-04:00 testsuite: Fix TOP of T17786 - - - - - aadcd909 by GHC GitLab CI at 2020-03-22T22:37:47-04:00 testsuite: Update expected output on Windows - - - - - dc1eb10d by GHC GitLab CI at 2020-03-22T22:37:47-04:00 hadrian: Fix executable extension passed to testsuite driver - - - - - 58f62e2c by GHC GitLab CI at 2020-03-22T22:37:47-04:00 gitlab-ci: Require that Windows-hadrian job passes - - - - - 8dd2415d by Ben Gamari at 2020-03-22T22:37:47-04:00 hadrian: Eliminate redundant .exe from GHC path Previously we were invoking: bash -c "c:/GitLabRunner/builds/eEQrxK4p/0/ghc/ghc/toolchain/bin/ghc.exe.exe testsuite/mk/ghc-config.hs -o _build/test/bin/ghc-config.exe" - - - - - 373621f6 by Ben Gamari at 2020-03-22T22:37:47-04:00 Bump hsc2hs submodule - - - - - abc02b40 by Hécate at 2020-03-22T22:38:33-04:00 Annotate the non-total function in Data.Foldable as such - - - - - 19f12557 by Josef Svenningsson at 2020-03-23T14:05:33-04:00 Fix ApplicativeDo regression #17835 A previous fix for #15344 made sure that monadic 'fail' is used properly when translating ApplicativeDo. However, it didn't properly account for when a 'fail' will be inserted which resulted in some programs failing with a type error. - - - - - 2643ba46 by Paavo at 2020-03-24T08:31:32-04:00 Add example and doc for Arg (Fixes #17153) - - - - - 703221f4 by Roland Senn at 2020-03-25T14:45:04-04:00 Use export list of Main module in function TcRnDriver.hs:check_main (Fix #16453) - Provide the export list of the `Main` module as parameter to the `compiler/typecheck/TcRnDriver.hs:check_main` function. - Instead of `lookupOccRn_maybe` call the function `lookupInfoOccRn`. It returns the list `mains_all` of all the main functions in scope. - Select from this list `mains_all` all `main` functions that are in the export list of the `Main` module. - If this new list contains exactly one single `main` function, then typechecking continues. - Otherwise issue an appropriate error message. - - - - - 3e27205a by Sebastian Graf at 2020-03-25T14:45:40-04:00 Remove -fkill-absence and -fkill-one-shot flags They seem to be a benchmarking vestige of the Cardinality paper and probably shouldn't have been merged to HEAD in the first place. - - - - - 262e42aa by Peter Trommler at 2020-03-25T22:41:39-04:00 Do not panic on linker errors - - - - - 0de03cd7 by Sylvain Henry at 2020-03-25T22:42:02-04:00 DynFlags refactoring III Use Platform instead of DynFlags when possible: * `tARGET_MIN_INT` et al. replaced with `platformMinInt` et al. * no more DynFlags in PreRules: added a new `RuleOpts` datatype * don't use `wORD_SIZE` in the compiler * make `wordAlignment` use `Platform` * make `dOUBLE_SIZE` a constant Metric Decrease: T13035 T1969 - - - - - 7a04920b by Tristan Cacqueray at 2020-03-25T22:42:06-04:00 Base: fix a typo in liftA doc This change removes an extra '|' that should not be rendered in the liftA documentation. Tracking: #17929 - - - - - 1c5a15f7 by Tristan Cacqueray at 2020-03-25T22:42:06-04:00 Base: add Control.Applicative optional example This change adds an optional example. Tracking: #17929 - - - - - 6d172e63 by Tristan Cacqueray at 2020-03-25T22:42:06-04:00 Base: add markup around Except - - - - - eb2162c8 by John Ericson at 2020-03-26T12:37:08-04:00 Remove unused `ghciTablesNextToCode` from compiler proper - - - - - f51efc4b by Joachim Breitner at 2020-03-26T12:37:09-04:00 Prepare to use run-time tablesNextToCode in compiler exclusively Factor out CPP as much as possible to prepare for runtime determinattion. Progress towards #15548 - - - - - 1c446220 by Joachim Breitner at 2020-03-26T12:37:09-04:00 Use run-time tablesNextToCode in compiler exclusively (#15548) Summary: - There is no more use of the TABLES_NEXT_TO_CODE CPP macro in `compiler/`. GHCI_TABLES_NEXT_TO_CODE is also removed entirely. The field within `PlatformMisc` within `DynFlags` is used instead. - The field is still not exposed as a CLI flag. We might consider some way to ensure the right RTS / libraries are used before doing that. Original reviewers: Original subscribers: TerrorJack, rwbarton, carter Original Differential Revision: https://phabricator.haskell.org/D5082 - - - - - 1941ef4f by Sylvain Henry at 2020-03-29T17:28:51-04:00 Modules: Types (#13009) Update Haddock submodule Metric Increase: haddock.compiler - - - - - 1c7c6f1a by Sylvain Henry at 2020-03-29T17:28:51-04:00 Remove GHC.Types.Unique.Map module This module isn't used anywhere in GHC. - - - - - f1a6c73d by Sylvain Henry at 2020-03-29T17:28:51-04:00 Merge GHC.Types.CostCentre.Init into GHC.Driver.CodeOutput - - - - - 54250f2d by Simon Peyton Jones at 2020-03-29T17:29:30-04:00 Demand analysis: simplify the demand for a RHS Ticket #17932 showed that we were using a stupid demand for the RHS of a let-binding, when the result is a product. This was the result of a "fix" in 2013, which (happily) turns out to no longer be necessary. So I just deleted the code, which simplifies the demand analyser, and fixes #17932. That in turn uncovered that the anticipation of worker/wrapper in CPR analysis was inaccurate, hence the logic that decides whether to unbox an argument in WW was extracted into a function `wantToUnbox`, now consulted by CPR analysis. I tried nofib, and got 0.0% perf changes. All this came up when messing about with !2873 (ticket #17917), but is idependent of it. Unfortunately, this patch regresses #4267 and realised that it is now blocked on #16335. - - - - - 03060b2f by Ben Gamari at 2020-03-29T17:30:05-04:00 testsuite: Fix T17786 on Windows Fixes line ending normalization issue. - - - - - 1f7995ba by Ben Gamari at 2020-03-29T17:30:05-04:00 testsuite: Fix T17786 Fix missing quoting and expected exit code. - - - - - ef9c608e by Ben Gamari at 2020-03-29T17:30:05-04:00 testsuite: Mark T12971 as broken on Windows Due to #17945. - - - - - e54500c1 by Sylvain Henry at 2020-03-29T17:30:47-04:00 Store ComponentId details As far as GHC is concerned, installed package components ("units") are identified by an opaque ComponentId string provided by Cabal. But we don't want to display it to users (as it contains a hash) so GHC queries the database to retrieve some infos about the original source package (name, version, component name). This patch caches these infos in the ComponentId itself so that we don't need to provide DynFlags (which contains installed package informations) to print a ComponentId. In the future we want GHC to support several independent package states (e.g. for plugins and for target code), hence we need to avoid implicitly querying a single global package state. - - - - - 7e7cb714 by Marius Bakke at 2020-03-29T17:31:27-04:00 testsuite: Remove test that dlopens a PIE object. glibc 2.30 disallowed dlopening PIE objects, so just remove the test. Fixes #17952. - - - - - 6c8f80d8 by Andreas Klebinger at 2020-03-29T17:32:04-04:00 Correct haddocks for testBit in Data.Bits It conflated the nth bit with the bit at offset n. Now we instead give the definition in terms of `bit and `.&.` on top of clearer phrasing. - - - - - c916f190 by Andreas Klebinger at 2020-03-29T17:32:04-04:00 Apply suggestion to libraries/base/Data/Bits.hs - - - - - 64bf7f51 by Ben Gamari at 2020-03-29T17:32:41-04:00 gitlab-ci: Add FreeBSD release job - - - - - a0d8e92e by Ryan Scott at 2020-03-29T17:33:20-04:00 Run checkNewDataCon before constraint-solving newtype constructors Within `checkValidDataCon`, we used to run `checkValidType` on the argument types of a newtype constructor before running `checkNewDataCon`, which ensures that the user does not attempt non-sensical things such as newtypes with multiple arguments or constraints. This works out in most situations, but this falls over on a corner case revealed in #17955: ```hs newtype T = Coercible () T => T () ``` `checkValidType`, among other things, peforms an ambiguity check on the context of a data constructor, and that it turn invokes the constraint solver. It turns out that there is a special case in the constraint solver for representational equalities (read: `Coercible` constraints) that causes newtypes to be unwrapped (see `Note [Unwrap newtypes first]` in `TcCanonical`). This special case does not know how to cope with an ill formed newtype like `T`, so it ends up panicking. The solution is surprisingly simple: just invoke `checkNewDataCon` before `checkValidType` to ensure that the illicit newtype constructor context is detected before the constraint solver can run amok with it. Fixes #17955. - - - - - 45eb9d8c by Krzysztof Gogolewski at 2020-03-29T17:33:59-04:00 Minor cleanup - Simplify mkBuildExpr, the function newTyVars was called only on a one-element list. - TTG: use noExtCon in more places. This is more future-proof. - In zonkExpr, panic instead of printing a warning. - - - - - f024b6e3 by Sylvain Henry at 2020-03-30T12:48:39+02:00 Expect T4267 to pass Since 54250f2d8de910b094070c1b48f086030df634b1 we expected T4267 to fail, but it passes on CI. - - - - - 57b888c0 by Ryan Scott at 2020-03-31T10:54:20-04:00 Require GHC 8.8 as the minimum compiler for bootstrapping This allows us to remove several bits of CPP that are either always true or no longer reachable. As an added bonus, we no longer need to worry about importing `Control.Monad.Fail.fail` qualified to avoid clashing with `Control.Monad.fail`, since the latter is now the same as the former. - - - - - 33f09551 by Ryan Scott at 2020-03-31T10:54:57-04:00 Add regression test for #17963 The panic in #17963 happened to be fixed by commit e3c374cc5bd7eb49649b9f507f9f7740697e3f70. This patch adds a regression test to ensure that it remains fixed. Fixes #17963. - - - - - 09a36e80 by Ömer Sinan Ağacan at 2020-03-31T10:55:37-04:00 Simplify stderrSupportsAnsiColors The combinator andM is used only once, and the code is shorter and simpler if you inline it. - - - - - 95bccdd0 by Ben Gamari at 2020-03-31T10:56:19-04:00 base: Ensure that encoding global variables aren't inlined As noted in #17970, these (e.g. `getFileSystemEncoding` and `setFileSystemEncoding`) previously had unfoldings, which would break their global-ness. While not strictly necessary, I also add a NOINLINE on `initLocaleEncoding` since it is used in `System.IO`, ensuring that we only system's query the locale encoding once. Fixes #17970. - - - - - 982aaa83 by Andreas Klebinger at 2020-03-31T10:56:55-04:00 Update hadrian index revision. Required in order to build hadrian using ghc-8.10 - - - - - 4b9c5864 by Ben Gamari at 2020-03-31T10:57:32-04:00 integer-gmp: Bump version and add changelog entry - - - - - 9b39f2e6 by Ryan Scott at 2020-04-01T01:20:00-04:00 Clean up "Eta reduction for data families" Notes Before, there were two distinct Notes named "Eta reduction for data families". This renames one of them to "Implementing eta reduction for data families" to disambiguate the two and fixes references in other parts of the codebase to ensure that they are pointing to the right place. Fixes #17313. [ci skip] - - - - - 7627eab5 by Ryan Scott at 2020-04-01T01:20:38-04:00 Fix the changelog/@since information for hGetContents'/getContents'/readFile' Fixes #17979. [ci skip] - - - - - 0002db1b by Sylvain Henry at 2020-04-01T01:21:27-04:00 Kill wORDS_BIGENDIAN and replace it with platformByteOrder (#17957) Metric Decrease: T13035 T1969 - - - - - 7b217179 by Sebastian Graf at 2020-04-01T15:03:24-04:00 PmCheck: Adjust recursion depth for inhabitation test In #17977, we ran into the reduction depth limit of the typechecker. That was only a symptom of a much broader issue: The recursion depth of the coverage checker for trying to instantiate strict fields in the `nonVoid` test was far too high (100, the `defaultMaxTcBound`). As a result, we were performing quite poorly on `T17977`. Short of a proper termination analysis to prove emptyness of a type, we just arbitrarily default to a much lower recursion limit of 3. Fixes #17977. - - - - - 3c09f636 by Andreas Klebinger at 2020-04-01T15:03:59-04:00 Make hadrian pass on the no-colour setting to GHC. Fixes #17983. - - - - - b943b25d by Simon Peyton Jones at 2020-04-02T01:45:58-04:00 Re-engineer the binder-swap transformation The binder-swap transformation is implemented by the occurrence analyser -- see Note [Binder swap] in OccurAnal. However it had a very nasty corner in it, for the case where the case scrutinee was a GlobalId. This led to trouble and hacks, and ultimately to #16296. This patch re-engineers how the occurrence analyser implements the binder-swap, by actually carrying out a substitution rather than by adding a let-binding. It's all described in Note [The binder-swap substitution]. I did a few other things along the way * Fix a bug in StgCse, which could allow a loop breaker to be CSE'd away. See Note [Care with loop breakers] in StgCse. I think it can only show up if occurrence analyser sets up bad loop breakers, but still. * Better commenting in SimplUtils.prepareAlts * A little refactoring in CoreUnfold; nothing significant e.g. rename CoreUnfold.mkTopUnfolding to mkFinalUnfolding * Renamed CoreSyn.isFragileUnfolding to hasCoreUnfolding * Move mkRuleInfo to CoreFVs We observed respectively 4.6% and 5.9% allocation decreases for the following tests: Metric Decrease: T9961 haddock.base - - - - - 42d68364 by Sebastian Graf at 2020-04-02T01:46:34-04:00 Preserve precise exceptions in strictness analysis Fix #13380 and #17676 by 1. Changing `raiseIO#` to have `topDiv` instead of `botDiv` 2. Give it special treatment in `Simplifier.Util.mkArgInfo`, treating it as if it still had `botDiv`, to recover dead code elimination. This is the first commit of the plan outlined in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/2525#note_260886. - - - - - 0a88dd11 by Ömer Sinan Ağacan at 2020-04-02T01:47:25-04:00 Fix a pointer format string in RTS - - - - - 5beac042 by Ömer Sinan Ağacan at 2020-04-02T01:48:05-04:00 Remove unused closure stg_IND_direct - - - - - 88f38b03 by Ben Gamari at 2020-04-02T01:48:42-04:00 Session: Memoize stderrSupportsAnsiColors Not only is this a reasonable efficiency measure but it avoids making reentrant calls into ncurses, which is not thread-safe. See #17922. - - - - - 27740f24 by Ryan Scott at 2020-04-02T01:49:21-04:00 Make Hadrian build with Cabal-3.2 GHC 8.10 ships with `Cabal-3.2.0.0`, so it would be convenient to make Hadrian supporting building against 3.2.* instead of having to rebuild the entirety of `Cabal-3.0.0.0`. There is one API change in `Cabal-3.2.*` that affects Hadrian: the `synopsis` and `description` functions now return `ShortText` instead of `String`. Since Hadrian manipulates these `String`s in various places, I found that the simplest fix was to use CPP to convert `ShortText` to `String`s where appropriate. - - - - - 49802002 by Sylvain Henry at 2020-04-02T01:50:00-04:00 Update Stack resolver for hadrian/build-stack Broken by 57b888c0e90be7189285a6b078c30b26d0923809 - - - - - 30a63e79 by Ryan Scott at 2020-04-02T01:50:36-04:00 Fix two ASSERT buglets in reifyDataCon Two `ASSERT`s in `reifyDataCon` were always using `arg_tys`, but `arg_tys` is not meaningful for GADT constructors. In fact, it's worse than non-meaningful, since using `arg_tys` when reifying a GADT constructor can lead to failed `ASSERT`ions, as #17305 demonstrates. This patch applies the simplest possible fix to the immediate problem. The `ASSERT`s now use `r_arg_tys` instead of `arg_tys`, as the former makes sure to give something meaningful for GADT constructors. This makes the panic go away at the very least. There is still an underlying issue with the way the internals of `reifyDataCon` work, as described in https://gitlab.haskell.org/ghc/ghc/issues/17305#note_227023, but we leave that as future work, since fixing the underlying issue is much trickier (see https://gitlab.haskell.org/ghc/ghc/issues/17305#note_227087). - - - - - ef7576c4 by Zubin Duggal at 2020-04-03T06:24:56-04:00 Add outputable instances for the types in GHC.Iface.Ext.Types, add -ddump-hie flag to dump pretty printed contents of the .hie file Metric Increase: hie002 Because of the regression on i386: compile_time/bytes allocated increased from i386-linux-deb9 baseline @ HEAD~10: Expected hie002 (normal) compile_time/bytes allocated: 583014888.0 +/-10% Lower bound hie002 (normal) compile_time/bytes allocated: 524713399 Upper bound hie002 (normal) compile_time/bytes allocated: 641316377 Actual hie002 (normal) compile_time/bytes allocated: 877986292 Deviation hie002 (normal) compile_time/bytes allocated: 50.6 % *** unexpected stat test failure for hie002(normal) - - - - - 9462452a by Andreas Klebinger at 2020-04-03T06:25:33-04:00 Improve and refactor StgToCmm codegen for DataCons. We now differentiate three cases of constructor bindings: 1)Bindings which we can "replace" with a reference to an existing closure. Reference the replacement closure when accessing the binding. 2)Bindings which we can "replace" as above. But we still generate a closure which will be referenced by modules importing this binding. 3)For any other binding generate a closure. Then reference it. Before this patch 1) did only apply to local bindings and we didn't do 2) at all. - - - - - a214d214 by Moritz Bruder at 2020-04-03T06:26:11-04:00 Add singleton to NonEmpty in libraries/base This adds a definition to construct a singleton non-empty list (Data.List.NonEmpty) according to issue #17851. - - - - - f7597aa0 by Sylvain Henry at 2020-04-03T06:26:54-04:00 Testsuite: measure compiler stats for T16190 We were mistakenly measuring program stats - - - - - a485c3c4 by Sylvain Henry at 2020-04-03T06:26:54-04:00 Move blob handling into StgToCmm Move handling of big literal strings from CmmToAsm to StgToCmm. It avoids the use of `sdocWithDynFlags` (cf #10143). We might need to move this handling even higher in the pipeline in the future (cf #17960): this patch will make it easier. - - - - - cc2918a0 by Sylvain Henry at 2020-04-03T06:26:54-04:00 Refactor CmmStatics In !2959 we noticed that there was some redundant code (in GHC.Cmm.Utils and GHC.Cmm.StgToCmm.Utils) used to deal with `CmmStatics` datatype (before SRT generation) and `RawCmmStatics` datatype (after SRT generation). This patch removes this redundant code by using a single GADT for (Raw)CmmStatics. - - - - - 9e60273d by Maxim Koltsov at 2020-04-03T06:27:32-04:00 Fix haddock formatting in Control.Monad.ST.Lazy.Imp.hs - - - - - 1b7e8a94 by Andreas Klebinger at 2020-04-03T06:28:08-04:00 Turn newlines into spaces for hadrian/ghci. The newlines break the command on windows. - - - - - 4291bdda by Simon Peyton Jones at 2020-04-03T06:28:44-04:00 Major improvements to the specialiser This patch is joint work of Alexis King and Simon PJ. It does some significant refactoring of the type-class specialiser. Main highlights: * We can specialise functions with types like f :: Eq a => a -> Ord b => b => blah where the classes aren't all at the front (#16473). Here we can correctly specialise 'f' based on a call like f @Int @Bool dEqInt x dOrdBool This change really happened in an earlier patch commit 2d0cf6252957b8980d89481ecd0b79891da4b14b Author: Sandy Maguire <sandy at sandymaguire.me> Date: Thu May 16 12:12:10 2019 -0400 work that this new patch builds directly on that work, and refactors it a bit. * We can specialise functions with implicit parameters (#17930) g :: (?foo :: Bool, Show a) => a -> String Previously we could not, but now they behave just like a non-class argument as in 'f' above. * We can specialise under-saturated calls, where some (but not all of the dictionary arguments are provided (#17966). For example, we can specialise the above 'f' based on a call map (f @Int dEqInt) xs even though we don't (and can't) give Ord dictionary. This may sound exotic, but #17966 is a program from the wild, and showed significant perf loss for functions like f, if you need saturation of all dictionaries. * We fix a buglet in which a floated dictionary had a bogus demand (#17810), by using zapIdDemandInfo in the NonRec case of specBind. * A tiny side benefit: we can drop dead arguments to specialised functions; see Note [Drop dead args from specialisations] * Fixed a bug in deciding what dictionaries are "interesting"; see Note [Keep the old dictionaries interesting] This is all achieved by by building on Sandy Macguire's work in defining SpecArg, which mkCallUDs uses to describe the arguments of the call. Main changes: * Main work is in specHeader, which marched down the [InBndr] from the function definition and the [SpecArg] from the call site, together. * specCalls no longer has an arity check; the entire mechanism now handles unders-saturated calls fine. * mkCallUDs decides on an argument-by-argument basis whether to specialise a particular dictionary argument; this is new. See mk_spec_arg in mkCallUDs. It looks as if there are many more lines of code, but I think that all the extra lines are comments! - - - - - 40a85563 by Ömer Sinan Ağacan at 2020-04-03T18:26:19+03:00 Revert accidental change in 9462452 [ci skip] - - - - - bd75e5da by Ryan Scott at 2020-04-04T07:07:58-04:00 Enable ImpredicativeTypes internally when typechecking selector bindings This is necessary for certain record selectors with higher-rank types, such as the examples in #18005. See `Note [Impredicative record selectors]` in `TcTyDecls`. Fixes #18005. - - - - - dcfe29c8 by Ömer Sinan Ağacan at 2020-04-06T13:16:08-04:00 Don't override proc CafInfos in ticky builds Fixes #17947 When we have a ticky label for a proc, IdLabels for the ticky counter and proc entry share the same Name. This caused overriding proc CafInfos with the ticky CafInfos (i.e. NoCafRefs) during SRT analysis. We now ignore the ticky labels when building SRTMaps. This makes sense because: - When building the current module they don't need to be in SRTMaps as they're initialized as non-CAFFY (see mkRednCountsLabel), so they don't take part in the dependency analysis and they're never added to SRTs. (Reminder: a "dependency" in the SRT analysis is a CAFFY dependency, non-CAFFY uses are not considered as dependencies for the algorithm) - They don't appear in the interfaces as they're not exported, so it doesn't matter for cross-module concerns whether they're in the SRTMap or not. See also the new Note [Ticky labels in SRT analysis]. - - - - - cec2c71f by Simon Peyton Jones at 2020-04-06T13:16:44-04:00 Fix an tricky specialiser loop Issue #17151 was a very tricky example of a bug in which the specialiser accidentally constructs a recurive dictionary, so that everything turns into bottom. I have fixed variants of this bug at least twice before: see Note [Avoiding loops]. It was a bit of a struggle to isolate the problem, greatly aided by the work that Alexey Kuleshevich did in distilling a test case. Once I'd understood the problem, it was not difficult to fix, though it did lead me a bit of refactoring in specImports. - - - - - e850d14f by Simon Peyton Jones at 2020-04-06T13:16:44-04:00 Refactoring only This refactors DictBinds into a data type rather than a pair. No change in behaviour, just better code - - - - - f38e8d61 by Daniel Gröber at 2020-04-07T02:00:05-04:00 rts: ProfHeap: Fix memory leak when not compiled with profiling If we're doing heap profiling on an unprofiled executable we keep allocating new space in initEra via nextEra on each profiler run but we don't have a corresponding freeEra call. We do free the last era in endHeapProfiling but previous eras will have been overwritten by initEra and will never get free()ed. Metric Decrease: space_leak_001 - - - - - bcd66859 by Sebastian Graf at 2020-04-07T02:00:41-04:00 Re-export GHC.Magic.noinline from base - - - - - 3d2991f8 by Ben Gamari at 2020-04-07T18:36:09-04:00 simplifier: Kill off ufKeenessFactor We used to have another factor, ufKeenessFactor, which would scale the discounts before they were subtracted from the size. This was justified with the following comment: -- We multiple the raw discounts (args_discount and result_discount) -- ty opt_UnfoldingKeenessFactor because the former have to do with -- *size* whereas the discounts imply that there's some extra -- *efficiency* to be gained (e.g. beta reductions, case reductions) -- by inlining. However, this is highly suspect since it means that we subtract a *scaled* size from an absolute size, resulting in crazy (e.g. negative) scores in some cases (#15304). We consequently killed off ufKeenessFactor and bumped up the ufUseThreshold to compensate. Adjustment of unfolding use threshold ===================================== Since this removes a discount from our inlining heuristic, I revisited our default choice of -funfolding-use-threshold to minimize the change in overall inlining behavior. Specifically, I measured runtime allocations and executable size of nofib and the testsuite performance tests built using compilers (and core libraries) built with several values of -funfolding-use-threshold. This comes as a result of a quantitative comparison of testsuite performance and code size as a function of ufUseThreshold, comparing GHC trees using values of 50, 60, 70, 80, 90, and 100. The test set consisted of nofib and the testsuite performance tests. A full summary of these measurements are found in the description of !2608 Comparing executable sizes (relative to the base commit) across all nofib tests, we see that sizes are similar to the baseline: gmean min max median thresh 50 -6.36% -7.04% -4.82% -6.46% 60 -5.04% -5.97% -3.83% -5.11% 70 -2.90% -3.84% -2.31% -2.92% 80 -0.75% -2.16% -0.42% -0.73% 90 +0.24% -0.41% +0.55% +0.26% 100 +1.36% +0.80% +1.64% +1.37% baseline +0.00% +0.00% +0.00% +0.00% Likewise, looking at runtime allocations we see that 80 gives slightly better optimisation than the baseline: gmean min max median thresh 50 +0.16% -0.16% +4.43% +0.00% 60 +0.09% -0.00% +3.10% +0.00% 70 +0.04% -0.09% +2.29% +0.00% 80 +0.02% -1.17% +2.29% +0.00% 90 -0.02% -2.59% +1.86% +0.00% 100 +0.00% -2.59% +7.51% -0.00% baseline +0.00% +0.00% +0.00% +0.00% Finally, I had to add a NOINLINE in T4306 to ensure that `upd` is worker-wrappered as the test expects. This makes me wonder whether the inlining heuristic is now too liberal as `upd` is quite a large function. The same measure was taken in T12600. Wall clock time compiling Cabal with -O0 thresh 50 60 70 80 90 100 baseline build-Cabal 93.88 89.58 92.59 90.09 100.26 94.81 89.13 Also, this change happens to avoid the spurious test output in `plugin-recomp-change` and `plugin-recomp-change-prof` (see #17308). Metric Decrease: hie002 T12234 T13035 T13719 T14683 T4801 T5631 T5642 T9020 T9872d T9961 Metric Increase: T12150 T12425 T13701 T14697 T15426 T1969 T3064 T5837 T6048 T9203 T9872a T9872b T9872c T9872d haddock.Cabal haddock.base haddock.compiler - - - - - 255418da by Sylvain Henry at 2020-04-07T18:36:49-04:00 Modules: type-checker (#13009) Update Haddock submodule - - - - - 04b6cf94 by Ryan Scott at 2020-04-07T19:43:20-04:00 Make NoExtCon fields strict This changes every unused TTG extension constructor to be strict in its field so that the pattern-match coverage checker is smart enough any such constructors are unreachable in pattern matches. This lets us remove nearly every use of `noExtCon` in the GHC API. The only ones we cannot remove are ones underneath uses of `ghcPass`, but that is only because GHC 8.8's and 8.10's coverage checkers weren't smart enough to perform this kind of reasoning. GHC HEAD's coverage checker, on the other hand, _is_ smart enough, so we guard these uses of `noExtCon` with CPP for now. Bumps the `haddock` submodule. Fixes #17992. - - - - - 7802fa17 by Ryan Scott at 2020-04-08T16:43:44-04:00 Handle promoted data constructors in typeToLHsType correctly Instead of using `nlHsTyVar`, which hardcodes `NotPromoted`, have `typeToLHsType` pick between `Promoted` and `NotPromoted` by checking if a type constructor is promoted using `isPromotedDataCon`. Fixes #18020. - - - - - ce481361 by Ben Gamari at 2020-04-09T16:17:21-04:00 hadrian: Use --export-dynamic when linking iserv As noticed in #17962, the make build system currently does this (see 3ce0e0ba) but the change was never ported to Hadrian. - - - - - fa66f143 by Ben Gamari at 2020-04-09T16:17:21-04:00 iserv: Don't pass --export-dynamic on FreeBSD This is definitely a hack but it's probably the best we can do for now. Hadrian does the right thing here by passing --export-dynamic only to the linker. - - - - - 39075176 by Ömer Sinan Ağacan at 2020-04-09T16:18:00-04:00 Fix CNF handling in compacting GC Fixes #17937 Previously compacting GC simply ignored CNFs. This is mostly fine as most (see "What about small compacts?" below) CNF objects don't have outgoing pointers, and are "large" (allocated in large blocks) and large objects are not moved or compacted. However if we do GC *during* sharing-preserving compaction then the CNF will have a hash table mapping objects that have been moved to the CNF to their location in the CNF, to be able to preserve sharing. This case is handled in the copying collector, in `scavenge_compact`, where we evacuate hash table entries and then rehash the table. Compacting GC ignored this case. We now visit CNFs in all generations when threading pointers to the compacted heap and thread hash table keys. A visited CNF is added to the list `nfdata_chain`. After compaction is done, we re-visit the CNFs in that list and rehash the tables. The overhead is minimal: the list is static in `Compact.c`, and link field is added to `StgCompactNFData` closure. Programs that don't use CNFs should not be affected. To test this CNF tests are now also run in a new way 'compacting_gc', which just passes `-c` to the RTS, enabling compacting GC for the oldest generation. Before this patch the result would be: Unexpected failures: compact_gc.run compact_gc [bad exit code (139)] (compacting_gc) compact_huge_array.run compact_huge_array [bad exit code (1)] (compacting_gc) With this patch all tests pass. I can also pass `-c -DS` without any failures. What about small compacts? Small CNFs are still not handled by the compacting GC. However so far I'm unable to write a test that triggers a runtime panic ("update_fwd: unknown/strange object") by allocating a small CNF in a compated heap. It's possible that I'm missing something and it's not possible to have a small CNF. NoFib Results: -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- CS +0.1% 0.0% 0.0% +0.0% +0.0% CSD +0.1% 0.0% 0.0% 0.0% 0.0% FS +0.1% 0.0% 0.0% 0.0% 0.0% S +0.1% 0.0% 0.0% 0.0% 0.0% VS +0.1% 0.0% 0.0% 0.0% 0.0% VSD +0.1% 0.0% +0.0% +0.0% -0.0% VSM +0.1% 0.0% +0.0% -0.0% 0.0% anna +0.0% 0.0% -0.0% -0.0% -0.0% ansi +0.1% 0.0% +0.0% +0.0% +0.0% atom +0.1% 0.0% +0.0% +0.0% +0.0% awards +0.1% 0.0% +0.0% +0.0% +0.0% banner +0.1% 0.0% +0.0% +0.0% +0.0% bernouilli +0.1% 0.0% 0.0% -0.0% +0.0% binary-trees +0.1% 0.0% -0.0% -0.0% 0.0% boyer +0.1% 0.0% +0.0% +0.0% +0.0% boyer2 +0.1% 0.0% +0.0% +0.0% +0.0% bspt +0.1% 0.0% -0.0% -0.0% -0.0% cacheprof +0.1% 0.0% -0.0% -0.0% -0.0% calendar +0.1% 0.0% +0.0% +0.0% +0.0% cichelli +0.1% 0.0% +0.0% +0.0% +0.0% circsim +0.1% 0.0% +0.0% +0.0% +0.0% clausify +0.1% 0.0% -0.0% +0.0% +0.0% comp_lab_zift +0.1% 0.0% +0.0% +0.0% +0.0% compress +0.1% 0.0% +0.0% +0.0% 0.0% compress2 +0.1% 0.0% -0.0% 0.0% 0.0% constraints +0.1% 0.0% +0.0% +0.0% +0.0% cryptarithm1 +0.1% 0.0% +0.0% +0.0% +0.0% cryptarithm2 +0.1% 0.0% +0.0% +0.0% +0.0% cse +0.1% 0.0% +0.0% +0.0% +0.0% digits-of-e1 +0.1% 0.0% +0.0% -0.0% -0.0% digits-of-e2 +0.1% 0.0% -0.0% -0.0% -0.0% dom-lt +0.1% 0.0% +0.0% +0.0% +0.0% eliza +0.1% 0.0% +0.0% +0.0% +0.0% event +0.1% 0.0% +0.0% +0.0% +0.0% exact-reals +0.1% 0.0% +0.0% +0.0% +0.0% exp3_8 +0.1% 0.0% +0.0% -0.0% 0.0% expert +0.1% 0.0% +0.0% +0.0% +0.0% fannkuch-redux +0.1% 0.0% -0.0% 0.0% 0.0% fasta +0.1% 0.0% -0.0% +0.0% +0.0% fem +0.1% 0.0% -0.0% +0.0% 0.0% fft +0.1% 0.0% -0.0% +0.0% +0.0% fft2 +0.1% 0.0% +0.0% +0.0% +0.0% fibheaps +0.1% 0.0% +0.0% +0.0% +0.0% fish +0.1% 0.0% +0.0% +0.0% +0.0% fluid +0.0% 0.0% +0.0% +0.0% +0.0% fulsom +0.1% 0.0% -0.0% +0.0% 0.0% gamteb +0.1% 0.0% +0.0% +0.0% 0.0% gcd +0.1% 0.0% +0.0% +0.0% +0.0% gen_regexps +0.1% 0.0% -0.0% +0.0% 0.0% genfft +0.1% 0.0% +0.0% +0.0% +0.0% gg +0.1% 0.0% 0.0% +0.0% +0.0% grep +0.1% 0.0% -0.0% +0.0% +0.0% hidden +0.1% 0.0% +0.0% -0.0% 0.0% hpg +0.1% 0.0% -0.0% -0.0% -0.0% ida +0.1% 0.0% +0.0% +0.0% +0.0% infer +0.1% 0.0% +0.0% 0.0% -0.0% integer +0.1% 0.0% +0.0% +0.0% +0.0% integrate +0.1% 0.0% -0.0% -0.0% -0.0% k-nucleotide +0.1% 0.0% +0.0% +0.0% 0.0% kahan +0.1% 0.0% +0.0% +0.0% +0.0% knights +0.1% 0.0% -0.0% -0.0% -0.0% lambda +0.1% 0.0% +0.0% +0.0% -0.0% last-piece +0.1% 0.0% +0.0% 0.0% 0.0% lcss +0.1% 0.0% +0.0% +0.0% 0.0% life +0.1% 0.0% -0.0% +0.0% +0.0% lift +0.1% 0.0% +0.0% +0.0% +0.0% linear +0.1% 0.0% -0.0% +0.0% 0.0% listcompr +0.1% 0.0% +0.0% +0.0% +0.0% listcopy +0.1% 0.0% +0.0% +0.0% +0.0% maillist +0.1% 0.0% +0.0% -0.0% -0.0% mandel +0.1% 0.0% +0.0% +0.0% 0.0% mandel2 +0.1% 0.0% +0.0% +0.0% +0.0% mate +0.1% 0.0% +0.0% 0.0% +0.0% minimax +0.1% 0.0% -0.0% 0.0% -0.0% mkhprog +0.1% 0.0% +0.0% +0.0% +0.0% multiplier +0.1% 0.0% +0.0% 0.0% 0.0% n-body +0.1% 0.0% +0.0% +0.0% +0.0% nucleic2 +0.1% 0.0% +0.0% +0.0% +0.0% para +0.1% 0.0% 0.0% +0.0% +0.0% paraffins +0.1% 0.0% +0.0% -0.0% 0.0% parser +0.1% 0.0% -0.0% -0.0% -0.0% parstof +0.1% 0.0% +0.0% +0.0% +0.0% pic +0.1% 0.0% -0.0% -0.0% 0.0% pidigits +0.1% 0.0% +0.0% -0.0% -0.0% power +0.1% 0.0% +0.0% +0.0% +0.0% pretty +0.1% 0.0% -0.0% -0.0% -0.1% primes +0.1% 0.0% -0.0% -0.0% -0.0% primetest +0.1% 0.0% -0.0% -0.0% -0.0% prolog +0.1% 0.0% -0.0% -0.0% -0.0% puzzle +0.1% 0.0% -0.0% -0.0% -0.0% queens +0.1% 0.0% +0.0% +0.0% +0.0% reptile +0.1% 0.0% -0.0% -0.0% +0.0% reverse-complem +0.1% 0.0% +0.0% 0.0% -0.0% rewrite +0.1% 0.0% -0.0% -0.0% -0.0% rfib +0.1% 0.0% +0.0% +0.0% +0.0% rsa +0.1% 0.0% -0.0% +0.0% -0.0% scc +0.1% 0.0% -0.0% -0.0% -0.1% sched +0.1% 0.0% +0.0% +0.0% +0.0% scs +0.1% 0.0% +0.0% +0.0% +0.0% simple +0.1% 0.0% -0.0% -0.0% -0.0% solid +0.1% 0.0% +0.0% +0.0% +0.0% sorting +0.1% 0.0% -0.0% -0.0% -0.0% spectral-norm +0.1% 0.0% +0.0% +0.0% +0.0% sphere +0.1% 0.0% -0.0% -0.0% -0.0% symalg +0.1% 0.0% -0.0% -0.0% -0.0% tak +0.1% 0.0% +0.0% +0.0% +0.0% transform +0.1% 0.0% +0.0% +0.0% +0.0% treejoin +0.1% 0.0% +0.0% -0.0% -0.0% typecheck +0.1% 0.0% +0.0% +0.0% +0.0% veritas +0.0% 0.0% +0.0% +0.0% +0.0% wang +0.1% 0.0% 0.0% +0.0% +0.0% wave4main +0.1% 0.0% +0.0% +0.0% +0.0% wheel-sieve1 +0.1% 0.0% +0.0% +0.0% +0.0% wheel-sieve2 +0.1% 0.0% +0.0% +0.0% +0.0% x2n1 +0.1% 0.0% +0.0% +0.0% +0.0% -------------------------------------------------------------------------------- Min +0.0% 0.0% -0.0% -0.0% -0.1% Max +0.1% 0.0% +0.0% +0.0% +0.0% Geometric Mean +0.1% -0.0% -0.0% -0.0% -0.0% Bumping numbers of nonsensical perf tests: Metric Increase: T12150 T12234 T12425 T13035 T5837 T6048 It's simply not possible for this patch to increase allocations, and I've wasted enough time on these test in the past (see #17686). I think these tests should not be perf tests, but for now I'll bump the numbers. - - - - - dce50062 by Sylvain Henry at 2020-04-09T16:18:44-04:00 Rts: show errno on failure (#18033) - - - - - 045139f4 by Hécate at 2020-04-09T23:10:44-04:00 Add an example to liftIO and explain its purpose - - - - - 101fab6e by Sebastian Graf at 2020-04-09T23:11:21-04:00 Special case `isConstraintKindCon` on `AlgTyCon` Previously, the `tyConUnique` record selector would unfold into a huge case expression that would be inlined in all call sites, such as the `INLINE`-annotated `coreView`, see #18026. `constraintKindTyConKey` only occurs as the `Unique` of an `AlgTyCon` anyway, so we can make the code a lot more compact, but have to move it to GHC.Core.TyCon. Metric Decrease: T12150 T12234 - - - - - f5212dfc by Sebastian Graf at 2020-04-09T23:11:57-04:00 DmdAnal: No need to attach a StrictSig to DataCon workers In GHC.Types.Id.Make we were giving a strictness signature to every data constructor wrapper Id that we weren't looking at in demand analysis anyway. We used to use its CPR info, but that has its own CPR signature now. `Note [Data-con worker strictness]` then felt very out of place, so I moved it to GHC.Core.DataCon. - - - - - 75a185dc by Sylvain Henry at 2020-04-09T23:12:37-04:00 Hadrian: fix --summary - - - - - 723062ed by Ömer Sinan Ağacan at 2020-04-10T09:18:14+03:00 testsuite: Move no_lint to the top level, tweak hie002 - We don't want to benchmark linting so disable lints in hie002 perf test - Move no_lint to the top-level to be able to use it in tests other than those in `testsuite/tests/perf/compiler`. - Filter out -dstg-lint in no_lint. - hie002 allocation numbers on 32-bit are unstable, so skip it on 32-bit Metric Decrease: hie002 ManyConstructors T12150 T12234 T13035 T1969 T4801 T9233 T9961 - - - - - bcafaa82 by Peter Trommler at 2020-04-10T19:29:33-04:00 Testsuite: mark T11531 fragile The test depends on a link editor allowing undefined symbols in an ELF shared object. This is the standard but it seems some distributions patch their link editor. See the report by @hsyl20 in #11531. Fixes #11531 - - - - - 0889f5ee by Takenobu Tani at 2020-04-12T11:44:52+09:00 testsuite: Fix comment for a language extension [skip ci] - - - - - cd4f92b5 by Simon Peyton Jones at 2020-04-12T11:20:58-04:00 Significant refactor of Lint This refactoring of Lint was triggered by #17923, which is fixed by this patch. The main change is this. Instead of lintType :: Type -> LintM LintedKind we now have lintType :: Type -> LintM LintedType Previously, all of typeKind was effectively duplicate in lintType. Moreover, since we have an ambient substitution, we still had to apply the substition here and there, sometimes more than once. It was all very tricky, in the end, and made my head hurt. Now, lintType returns a fully linted type, with all substitutions performed on it. This is much simpler. The same thing is needed for Coercions. Instead of lintCoercion :: OutCoercion -> LintM (LintedKind, LintedKind, LintedType, LintedType, Role) we now have lintCoercion :: Coercion -> LintM LintedCoercion Much simpler! The code is shorter and less bug-prone. There are a lot of knock on effects. But life is now better. Metric Decrease: T1969 - - - - - 0efaf301 by Josh Meredith at 2020-04-12T11:21:34-04:00 Implement extensible interface files - - - - - 54ca66a7 by Ryan Scott at 2020-04-12T11:22:10-04:00 Use conLikeUserTyVarBinders to quantify field selector types This patch: 1. Writes up a specification for how the types of top-level field selectors should be determined in a new section of the GHC User's Guide, and 2. Makes GHC actually implement that specification by using `conLikeUserTyVarBinders` in `mkOneRecordSelector` to preserve the order and specificity of type variables written by the user. Fixes #18023. - - - - - 35799dda by Ben Gamari at 2020-04-12T11:22:50-04:00 hadrian: Don't --export-dynamic on Darwin When fixing #17962 I neglected to consider that --export-dynamic is only supported on ELF platforms. - - - - - e8029816 by Alexis King at 2020-04-12T11:23:27-04:00 Add an INLINE pragma to Control.Category.>>> This fixes #18013 by adding INLINE pragmas to both Control.Category.>>> and GHC.Desugar.>>>. The functional change in this patch is tiny (just two lines of pragmas!), but an accompanying Note explains in gory detail what’s going on. - - - - - 0da186c1 by Krzysztof Gogolewski at 2020-04-14T07:55:20-04:00 Change zipWith to zipWithEqual in a few places - - - - - 074c1ccd by Andreas Klebinger at 2020-04-14T07:55:55-04:00 Small change to the windows ticker. We already have a function to go from time to ms so use it. Also expand on the state of timer resolution. - - - - - b69cc884 by Alp Mestanogullari at 2020-04-14T07:56:38-04:00 hadrian: get rid of unnecessary levels of nesting in source-dist - - - - - d0c3b069 by Julien Debon at 2020-04-14T07:57:16-04:00 doc (Foldable): Add examples to Data.Foldable See #17929 - - - - - 5b08e0c0 by Ben Gamari at 2020-04-14T23:28:20-04:00 StgCRun: Enable unwinding only on Linux It's broken on macOS due and SmartOS due to assembler differences (#15207) so let's be conservative in enabling it. Also, refactor things to make the intent clearer. - - - - - 27cc2e7b by Ben Gamari at 2020-04-14T23:28:57-04:00 rts: Don't mark evacuate_large as inline This function has two callsites and is quite large. GCC consequently decides not to inline and warns instead. Given the situation, I can't blame it. Let's just remove the inline specifier. - - - - - 9853fc5e by Ben Gamari at 2020-04-14T23:29:48-04:00 base: Enable large file support for OFD locking impl. Not only is this a good idea in general but this should also avoid issue #17950 by ensuring that off_t is 64-bits. - - - - - 7b41f21b by Matthew Pickering at 2020-04-14T23:30:24-04:00 Hadrian: Make -i paths absolute The primary reason for this change is that ghcide does not work with relative paths. It also matches what cabal and stack do, they always pass absolute paths. - - - - - 41230e26 by Daniel Gröber at 2020-04-14T23:31:01-04:00 Zero out pinned block alignment slop when profiling The heap profiler currently cannot traverse pinned blocks because of alignment slop. This used to just be a minor annoyance as the whole block is accounted into a special cost center rather than the respective object's CCS, cf. #7275. However for the new root profiler we would like to be able to visit _every_ closure on the heap. We need to do this so we can get rid of the current 'flip' bit hack in the heap traversal code. Since info pointers are always non-zero we can in principle skip all the slop in the profiler if we can rely on it being zeroed. This assumption caused problems in the past though, commit a586b33f8e ("rts: Correct handling of LARGE ARR_WORDS in LDV profiler"), part of !1118, tried to use the same trick for BF_LARGE objects but neglected to take into account that shrink*Array# functions don't ensure that slop is zeroed when not compiling with profiling. Later, commit 0c114c6599 ("Handle large ARR_WORDS in heap census (fix as we will only be assuming slop is zeroed when profiling is on. This commit also reduces the ammount of slop we introduce in the first place by calculating the needed alignment before doing the allocation for small objects where we know the next available address. For large objects we don't know how much alignment we'll have to do yet since those details are hidden behind the allocateMightFail function so there we continue to allocate the maximum additional words we'll need to do the alignment. So we don't have to duplicate all this logic in the cmm code we pull it into the RTS allocatePinned function instead. Metric Decrease: T7257 haddock.Cabal haddock.base - - - - - 15fa9bd6 by Daniel Gröber at 2020-04-14T23:31:01-04:00 rts: Expand and add more notes regarding slop - - - - - caf3f444 by Daniel Gröber at 2020-04-14T23:31:01-04:00 rts: allocatePinned: Fix confusion about word/byte units - - - - - c3c0f662 by Daniel Gröber at 2020-04-14T23:31:01-04:00 rts: Underline some Notes as is conventional - - - - - e149dea9 by Daniel Gröber at 2020-04-14T23:31:38-04:00 rts: Fix nomenclature in OVERWRITING_CLOSURE macros The additional commentary introduced by commit 8916e64e5437 ("Implement shrinkSmallMutableArray# and resizeSmallMutableArray#.") unfortunately got this wrong. We set 'prim' to true in overwritingClosureOfs because we _don't_ want to call LDV_recordDead(). The reason is because of this "inherently used" distinction made in the LDV profiler so I rename the variable to be more appropriate. - - - - - 1dd3d18c by Daniel Gröber at 2020-04-14T23:31:38-04:00 Remove call to LDV_RECORD_CREATE for array resizing - - - - - 19de2fb0 by Daniel Gröber at 2020-04-14T23:31:38-04:00 rts: Assert LDV_recordDead is not called for inherently used closures The comments make it clear LDV_recordDead should not be called for inhererently used closures, so add an assertion to codify this fact. - - - - - 0b934e30 by Ryan Scott at 2020-04-14T23:32:14-04:00 Bump template-haskell version to 2.17.0.0 This requires bumping the `exceptions` and `text` submodules to bring in commits that bump their respective upper version bounds on `template-haskell`. Fixes #17645. Fixes #17696. Note that the new `text` commit includes a fair number of additions to the Haddocks in that library. As a result, Haddock has to do more work during the `haddock.Cabal` test case, increasing the number of allocations it requires. Therefore, ------------------------- Metric Increase: haddock.Cabal ------------------------- - - - - - 22cc8e51 by Ryan Scott at 2020-04-15T17:48:47-04:00 Fix #18052 by using pprPrefixOcc in more places This fixes several small oversights in the choice of pretty-printing function to use. Fixes #18052. - - - - - ec77b2f1 by Daniel Gröber at 2020-04-15T17:49:24-04:00 rts: ProfHeap: Fix wrong time in last heap profile sample We've had this longstanding issue in the heap profiler, where the time of the last sample in the profile is sometimes way off causing the rendered graph to be quite useless for long runs. It seems to me the problem is that we use mut_user_time() for the last sample as opposed to getRTSStats(), which we use when calling heapProfile() in GC.c. The former is equivalent to getProcessCPUTime() but the latter does some additional stuff: getProcessCPUTime() - end_init_cpu - stats.gc_cpu_ns - stats.nonmoving_gc_cpu_ns So to fix this just use getRTSStats() in both places. - - - - - 85fc32f0 by Sylvain Henry at 2020-04-17T12:45:25-04:00 Hadrian: fix dyn_o/dyn_hi rule (#17534) - - - - - bfde3b76 by Ryan Scott at 2020-04-17T12:46:02-04:00 Fix #18065 by fixing an InstCo oversight in Core Lint There was a small thinko in Core Lint's treatment of `InstCo` coercions that ultimately led to #18065. The fix: add an apostrophe. That's it! Fixes #18065. Co-authored-by: Simon Peyton Jones <simonpj at microsoft.com> - - - - - a05348eb by Cale Gibbard at 2020-04-17T13:08:47-04:00 Change the fail operator argument of BindStmt to be a Maybe Don't use noSyntaxExpr for it. There is no good way to defensively case on that, nor is it clear one ought to do so. - - - - - 79e27144 by John Ericson at 2020-04-17T13:08:47-04:00 Use trees that grow for rebindable operators for `<-` binds Also add more documentation. - - - - - 18bc16ed by Cale Gibbard at 2020-04-17T13:08:47-04:00 Use FailOperator in more places, define a couple datatypes (XBindStmtRn and XBindStmtTc) to help clarify the meaning of XBindStmt in the renamer and typechecker - - - - - 84cc8394 by Simon Peyton Jones at 2020-04-18T13:20:29-04:00 Add a missing zonk in tcHsPartialType I omitted a vital zonk when refactoring tcHsPartialType in commit 48fb3482f8cbc8a4b37161021e846105f980eed4 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Wed Jun 5 08:55:17 2019 +0100 Fix typechecking of partial type signatures This patch fixes it and adds commentary to explain why. Fixes #18008 - - - - - 2ee96ac1 by Ben Gamari at 2020-04-18T13:21:05-04:00 gitlab-ci: Bump FreeBSD bootstrap compiler to 8.10.1 - - - - - 434312e5 by Ben Gamari at 2020-04-18T13:21:05-04:00 gitlab-ci: Enable FreeBSD job for so-labelled MRs - - - - - ddffb227 by Ben Gamari at 2020-04-18T13:21:05-04:00 gitlab-ci: Use rules syntax for conditional jobs - - - - - e2586828 by Ben Gamari at 2020-04-18T13:21:05-04:00 Bump hsc2hs submodule - - - - - 15ab6cd5 by Ömer Sinan Ağacan at 2020-04-18T13:21:44-04:00 Improve prepForeignCall error reporting Show parameters and description of the error code when ffi_prep_cif fails. This may be helpful for debugging #17018. - - - - - 3ca52151 by Sylvain Henry at 2020-04-18T20:04:14+02:00 GHC.Core.Opt renaming * GHC.Core.Op => GHC.Core.Opt * GHC.Core.Opt.Simplify.Driver => GHC.Core.Opt.Driver * GHC.Core.Opt.Tidy => GHC.Core.Tidy * GHC.Core.Opt.WorkWrap.Lib => GHC.Core.Opt.WorkWrap.Utils As discussed in: * https://mail.haskell.org/pipermail/ghc-devs/2020-April/018758.html * https://gitlab.haskell.org/ghc/ghc/issues/13009#note_264650 - - - - - 15312bbb by Sylvain Henry at 2020-04-18T20:04:46+02:00 Modules (#13009) * SysTools * Parser * GHC.Builtin * GHC.Iface.Recomp * Settings Update Haddock submodule Metric Decrease: Naperian parsing001 - - - - - eaed0a32 by Alexis King at 2020-04-19T03:16:44-04:00 Add missing addInScope call for letrec binders in OccurAnal This fixes #18044, where a shadowed variable was incorrectly substituted by the binder swap on the RHS of a floated-in letrec. This can only happen when the uniques line up *just* right, so writing a regression test would be very difficult, but at least the fix is small and straightforward. - - - - - 36882493 by Shayne Fletcher at 2020-04-20T04:36:43-04:00 Derive Ord instance for Extension Metric Increase: T12150 T12234 - - - - - b43365ad by Simon Peyton Jones at 2020-04-20T04:37:20-04:00 Fix a buglet in redundant-constraint warnings Ticket #18036 pointed out that we were reporting a redundant constraint when it really really wasn't. Turned out to be a buglet in the SkolemInfo for the relevant implication constraint. Easily fixed! - - - - - d5fae7da by Ömer Sinan Ağacan at 2020-04-20T14:39:28-04:00 Mark T12010 fragile on 32-bit - - - - - bca02fca by Adam Sandberg Ericsson at 2020-04-21T06:38:45-04:00 docs: drop note about not supporting shared libraries on unix systems [skip ci] - - - - - 6655f933 by Sylvain Henry at 2020-04-21T06:39:32-04:00 Use ParserFlags in GHC.Runtime.Eval (#17957) Instead of passing `DynFlags` to functions such as `isStmt` and `hasImport` in `GHC.Runtime.Eval` we pass `ParserFlags`. It's a much simpler structure that can be created purely with `mkParserFlags'`. - - - - - 70be0fbc by Sylvain Henry at 2020-04-21T06:39:32-04:00 GHC.Runtime: avoid DynFlags (#17957) * add `getPlatform :: TcM Platform` helper * remove unused `DynFlags` parameter from `emptyPLS` - - - - - 35e43d48 by Sylvain Henry at 2020-04-21T06:39:32-04:00 Avoid DynFlags in Ppr code (#17957) * replace `DynFlags` parameters with `SDocContext` parameters for a few Ppr related functions: `bufLeftRenderSDoc`, `printSDoc`, `printSDocLn`, `showSDocOneLine`. * remove the use of `pprCols :: DynFlags -> Int` in Outputable. We already have the information via `sdocLineLength :: SDocContext -> Int` - - - - - ce5c2999 by Sylvain Henry at 2020-04-21T06:39:32-04:00 Avoid using sdocWithDynFlags (#17957) Remove one use of `sdocWithDynFlags` from `GHC.CmmToLlvm.llvmCodeGen'` and from `GHC.Driver.CodeOutput.profilingInitCode` - - - - - f2a98996 by Sylvain Henry at 2020-04-21T06:39:32-04:00 Avoid `sdocWithDynFlags` in `pprCLbl` (#17957) * add a `DynFlags` parameter to `pprCLbl` * put `maybe_underscore` and `pprAsmCLbl` in a `where` clause to avoid `DynFlags` parameters - - - - - 747093b7 by Sylvain Henry at 2020-04-21T06:39:32-04:00 CmmToAsm DynFlags refactoring (#17957) * Remove `DynFlags` parameter from `isDynLinkName`: `isDynLinkName` used to test the global `ExternalDynamicRefs` flag. Now we test it outside of `isDynLinkName` * Add new fields into `NCGConfig`: current unit id, sse/bmi versions, externalDynamicRefs, etc. * Replace many uses of `DynFlags` by `NCGConfig` * Moved `BMI/SSE` datatypes into `GHC.Platform` - - - - - ffd7eef2 by Takenobu Tani at 2020-04-22T23:09:50-04:00 stg-spec: Modify file paths according to new module hierarchy This patch updates file paths according to new module hierarchy [1]: * GHC/Stg/Syntax.hs <= stgSyn/StgSyn.hs * GHC/Types/Literal.hs <= basicTypes/Literal.hs * GHC/Types/CostCentre.hs <= profiling/CostCentre.hs This patch also updates old file path [2]: * utils/genapply/Main.hs <= utils/genapply/GenApply.hs [1]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular [2]: commit 0cc4aad36f [skip ci] - - - - - e8a5d81b by Jonathan DK Gibbons at 2020-04-22T23:10:28-04:00 Refactor the `MatchResult` type in the desugarer This way, it does a better job of proving whether or not the fail operator is used. - - - - - dcb7fe5a by John Ericson at 2020-04-22T23:10:28-04:00 Remove panic in dsHandleMonadicFailure Rework dsHandleMonadicFailure to be correct by construction instead of using an unreachable panic. - - - - - cde23cd4 by John Ericson at 2020-04-22T23:10:28-04:00 Inline `adjustMatchResult` It is just `fmap` - - - - - 72cb6bcc by John Ericson at 2020-04-22T23:10:28-04:00 Generalize type of `matchCanFail` - - - - - 401f7bb3 by John Ericson at 2020-04-22T23:10:28-04:00 `MatchResult'` -> `MatchResult` Inline `MatchResult` alias accordingly. - - - - - 6c9fae23 by Alexis King at 2020-04-22T23:11:12-04:00 Mark DataCon wrappers CONLIKE Now that DataCon wrappers don’t inline until phase 0 (see commit b78cc64e923716ac0512c299f42d4d0012306c05), it’s important that case-of-known-constructor and RULE matching be able to see saturated applications of DataCon wrappers in unfoldings. Making them conlike is a natural way to do it, since they are, in fact, precisely the sort of thing the CONLIKE pragma exists to solve. Fixes #18012. This also bumps the version of the parsec submodule to incorporate a patch that avoids a metric increase on the haddock perf tests. The increase was not really a flaw in this patch, as parsec was implicitly relying on inlining heuristics. The patch to parsec just adds some INLINABLE pragmas, and we get a nice performance bump out of it (well beyond the performance we lost from this patch). Metric Decrease: T12234 WWRec haddock.Cabal haddock.base haddock.compiler - - - - - 48b8951e by Roland Senn at 2020-04-22T23:11:51-04:00 Fix tab-completion for :break (#17989) In tab-completion for the `:break` command, only those identifiers should be shown, that are accepted in the `:break` command. Hence these identifiers must be - defined in an interpreted module - top-level - currently in scope - listed in a `ModBreaks` value as a possible breakpoint. The identifiers my be qualified or unqualified. To get all possible top-level breakpoints for tab-completeion with the correct qualification do: 1. Build the list called `pifsBreaks` of all pairs of (Identifier, module-filename) from the `ModBreaks` values. Here all identifiers are unqualified. 2. Build the list called `pifInscope` of all pairs of (Identifiers, module-filename) with identifiers from the `GlobalRdrEnv`. Take only those identifiers that are in scope and have the correct prefix. Here the identifiers may be qualified. 3. From the `pifInscope` list seclect all pairs that can be found in the `pifsBreaks` list, by comparing only the unqualified part of the identifier. The remaining identifiers can be used for tab-completion. This ensures, that we show only identifiers, that can be used in a `:break` command. - - - - - 34a45ee6 by Peter Trommler at 2020-04-22T23:12:27-04:00 PPC NCG: Add DWARF constants and debug labels Fixes #11261 - - - - - ffde2348 by Simon Peyton Jones at 2020-04-22T23:13:06-04:00 Do eager instantation in terms This patch implements eager instantiation, a small but critical change to the type inference engine, #17173. The main change is this: When inferring types, always return an instantiated type (for now, deeply instantiated; in future shallowly instantiated) There is more discussion in https://www.tweag.io/posts/2020-04-02-lazy-eager-instantiation.html There is quite a bit of refactoring in this patch: * The ir_inst field of GHC.Tc.Utils.TcType.InferResultk has entirely gone. So tcInferInst and tcInferNoInst have collapsed into tcInfer. * Type inference of applications, via tcInferApp and tcInferAppHead, are substantially refactored, preparing the way for Quick Look impredicativity. * New pure function GHC.Tc.Gen.Expr.collectHsArgs and applyHsArgs are beatifully dual. We can see the zipper! * GHC.Tc.Gen.Expr.tcArgs is now much nicer; no longer needs to return a wrapper * In HsExpr, HsTypeApp now contains the the actual type argument, and is used in desugaring, rather than putting it in a mysterious wrapper. * I struggled a bit with good error reporting in Unify.matchActualFunTysPart. It's a little bit simpler than before, but still not great. Some smaller things * Rename tcPolyExpr --> tcCheckExpr tcMonoExpr --> tcLExpr * tcPatSig moves from GHC.Tc.Gen.HsType to GHC.Tc.Gen.Pat Metric Decrease: T9961 Reduction of 1.6% in comiler allocation on T9961, I think. - - - - - 6f84aca3 by Ben Gamari at 2020-04-22T23:13:43-04:00 rts: Ensure that sigaction structs are initialized I noticed these may have uninitialized fields when looking into #18037. The reporter says that zeroing them doesn't fix the MSAN failures they observe but zeroing them is the right thing to do regardless. - - - - - c29f0fa6 by Andreas Klebinger at 2020-04-22T23:14:21-04:00 Add "ddump-cmm-opt" as alias for "ddump-opt-cmm". - - - - - 4b4a8b60 by Ben Gamari at 2020-04-22T23:14:57-04:00 llvmGen: Remove -fast-llvm flag Issue #18076 drew my attention to the undocumented `-fast-llvm` flag for the LLVM code generator introduced in 22733532171330136d87533d523f565f2a4f102f. Speaking to Moritz about this, the motivation for this flag was to avoid potential incompatibilities between LLVM and the assembler/linker toolchain by making LLVM responsible for machine-code generation. Unfortunately, this cannot possibly work: the LLVM backend's mangler performs a number of transforms on the assembler generated by LLVM that are necessary for correctness. These are currently: * mangling Haskell functions' symbol types to be `object` instead of `function` on ELF platforms (necessary for tables-next-to-code) * mangling AVX instructions to ensure that we don't assume alignment (which LLVM otherwise does) * mangling Darwin's subsections-via-symbols directives Given that these are all necessary I don't believe that we can support `-fast-llvm`. Let's rather remove it. - - - - - 831b6642 by Moritz Angermann at 2020-04-22T23:15:33-04:00 Fix build warning; add more informative information to the linker; fix linker for empty sections - - - - - c409961a by Ryan Scott at 2020-04-22T23:16:12-04:00 Update commentary and slightly refactor GHC.Tc.Deriv.Infer There was some out-of-date commentary in `GHC.Tc.Deriv.Infer` that has been modernized. Along the way, I removed the `bad` constraints in `simplifyDeriv`, which did not serve any useful purpose (besides being printed in debugging output). Fixes #18073. - - - - - 125aa2b8 by Ömer Sinan Ağacan at 2020-04-22T23:16:51-04:00 Remove leftover comment in tcRnModule', redundant bind The code for the comment was moved in dc8c03b2a5c but the comment was forgotten. - - - - - 8ea37b01 by Sylvain Henry at 2020-04-22T23:17:34-04:00 RTS: workaround a Linux kernel bug in timerfd Reading a timerfd may return 0: https://lkml.org/lkml/2019/8/16/335. This is currently undocumented behavior and documentation "won't happen anytime soon" (https://lkml.org/lkml/2020/2/13/295). With this patch, we just ignore the result instead of crashing. It may fix #18033 but we can't be sure because we don't have enough information. See also this discussion about the kernel bug: https://github.com/Azure/sonic-swss-common/pull/302/files/1f070e7920c2e5d63316c0105bf4481e73d72dc9 - - - - - cd8409c2 by Ryan Scott at 2020-04-23T11:39:24-04:00 Create di_scoped_tvs for associated data family instances properly See `Note [Associated data family instances and di_scoped_tvs]` in `GHC.Tc.TyCl.Instance`, which explains all of the moving parts. Fixes #18055. - - - - - 339e8ece by Ben Gamari at 2020-04-23T11:40:02-04:00 hadrian/ghci: Allow arguments to be passed to GHCi Previously the arguments passed to hadrian/ghci were passed both to `hadrian` and GHCi. This is rather odd given that there are essentially not arguments in the intersection of the two. Let's just pass them to GHCi; this allows `hadrian/ghci -Werror`. - - - - - 5946c85a by Ben Gamari at 2020-04-23T11:40:38-04:00 testsuite: Don't attempt to read .std{err,out} files if they don't exist Simon reports that he was previously seeing framework failures due to an attempt to read the non-existing T13456.stderr. While I don't know exactly what this is due to, it does seem like a non-existing .std{out,err} file should be equivalent to an empty file. Teach the testsuite driver to treat it as such. - - - - - c42754d5 by John Ericson at 2020-04-23T18:32:43-04:00 Trees That Grow refactor for `ConPat` and `CoPat` - `ConPat{In,Out}` -> `ConPat` - `CoPat` -> `XPat (CoPat ..)` Note that `GHC.HS.*` still uses `HsWrap`, but only when `p ~ GhcTc`. After this change, moving the type family instances out of `GHC.HS.*` is sufficient to break the cycle. Add XCollectPat class to decide how binders are collected from XXPat based on the pass. Previously we did this with IsPass, but that doesn't work for Haddock's DocNameI, and the constraint doesn't express what actual distinction is being made. Perhaps a class for collecting binders more generally is in order, but we haven't attempted this yet. Pure refactor of code around ConPat - InPat/OutPat synonyms removed - rename several identifiers - redundant constraints removed - move extension field in ConPat to be first - make ConPat use record syntax more consistently Fix T6145 (ConPatIn became ConPat) Add comments from SPJ. Add comment about haddock's use of CollectPass. Updates haddock submodule. - - - - - 72da0c29 by mniip at 2020-04-23T18:33:21-04:00 Add :doc to GHC.Prim - - - - - 2c23e2e3 by mniip at 2020-04-23T18:33:21-04:00 Include docs for non-primop entries in primops.txt as well - - - - - 0ac29c88 by mniip at 2020-04-23T18:33:21-04:00 GHC.Prim docs: note and test - - - - - b0fbfc75 by John Ericson at 2020-04-24T12:07:14-04:00 Switch order on `GhcMake.IsBoot` In !1798 we were requested to replace many `Bool`s with this data type. But those bools had `False` meaning `NotBoot`, so the `Ord` instance would be flipped if we use this data-type as-is. Since the planned formally-`Bool` occurrences vastly outnumber the current occurrences, we figured it would be better to conform the `Ord` instance to how the `Bool` is used now, fixing any issues, rather than fix them currently with the bigger refactor later in !1798. That way, !1798 can be a "pure" refactor with no behavioral changes. - - - - - af332442 by Sylvain Henry at 2020-04-26T13:55:14-04:00 Modules: Utils and Data (#13009) Update Haddock submodule Metric Increase: haddock.compiler - - - - - cd4434c8 by Sylvain Henry at 2020-04-26T13:55:16-04:00 Fix misleading Ptr phantom type in SerializedCompact (#15653) - - - - - 22bf5c73 by Ömer Sinan Ağacan at 2020-04-26T13:55:22-04:00 Tweak includes in non-moving GC headers We don't use hash tables in non-moving GC so remove the includes. This breaks Compact.c as existing includes no longer include Hash.h, so include Hash.h explicitly in Compact.c. - - - - - 99823ed2 by Sylvain Henry at 2020-04-27T20:24:46-04:00 TH: fix Show/Eq/Ord instances for Bytes (#16457) We shouldn't compare pointer values but the actual bytes. - - - - - c62271a2 by Alp Mestanogullari at 2020-04-27T20:25:33-04:00 hadrian: always capture both stdout and stderr when running a builder fails The idea being that when a builder('s command) fails, we quite likely want to have all the information available to figure out why. Depending on the builder _and_ the particular problem, the useful bits of information can be printed on stdout or stderr. We accomplish this by defining a simple wrapper for Shake's `cmd` function, that just _always_ captures both streams in case the command returns a non-zero exit code, and by using this wrapper everywhere in `hadrian/src/Builder.hs`. Fixes #18089. - - - - - 4b9764db by Ryan Scott at 2020-04-28T15:40:04-04:00 Define a Quote IO instance Fixes #18103. - - - - - 518a63d4 by Ryan Scott at 2020-04-28T15:40:42-04:00 Make boxed 1-tuples have known keys Unlike other tuples, which use special syntax and are "known" by way of a special `isBuiltInOcc_maybe` code path, boxed 1-tuples do not use special syntax. Therefore, in order to make sure that the internals of GHC are aware of the `data Unit a = Unit a` definition in `GHC.Tuple`, we give `Unit` known keys. For the full details, see `Note [One-tuples] (Wrinkle: Make boxed one-tuple names have known keys)` in `GHC.Builtin.Types`. Fixes #18097. - - - - - 2cfc4ab9 by Sylvain Henry at 2020-04-30T01:56:56-04:00 Document backpack fields in DynFlags - - - - - 10a2ba90 by Sylvain Henry at 2020-04-30T01:56:56-04:00 Refactor UnitInfo * Rename InstalledPackageInfo into GenericUnitInfo The name InstalledPackageInfo is only kept for alleged backward compatibility reason in Cabal. ghc-boot has its own stripped down copy of this datatype but it doesn't need to keep the name. Internally we already use type aliases (UnitInfo in GHC, PackageCacheFormat in ghc-pkg). * Rename UnitInfo fields: add "unit" prefix and fix misleading names * Add comments on every UnitInfo field * Rename SourcePackageId into PackageId "Package" already indicates that it's a "source package". Installed package components are called units. Update Haddock submodule - - - - - 69562e34 by Sylvain Henry at 2020-04-30T01:56:56-04:00 Remove unused `emptyGenericUnitInfo` - - - - - 9e2c8e0e by Sylvain Henry at 2020-04-30T01:56:56-04:00 Refactor UnitInfo load/store from databases Converting between UnitInfo stored in package databases and UnitInfo as they are used in ghc-pkg and ghc was done in a very convoluted way (via BinaryStringRep and DbUnitModuleRep type classes using fun deps, etc.). It was difficult to understand and even more to modify (I wanted to try to use a GADT for UnitId but fun deps got in the way). The new code uses much more straightforward functions to convert between the different representations. Much simpler. - - - - - ea717aa4 by Sylvain Henry at 2020-04-30T01:56:56-04:00 Factorize mungePackagePaths code This patch factorizes the duplicated code used in ghc-pkg and in GHC to munge package paths/urls. It also fixes haddock-html munging in GHC (allowed to be either a file or a url) to mimic ghc-pkg behavior. - - - - - 10d15f1e by Sylvain Henry at 2020-04-30T01:56:56-04:00 Refactoring unit management code Over the years the unit management code has been modified a lot to keep up with changes in Cabal (e.g. support for several library components in the same package), to integrate BackPack, etc. I found it very hard to understand as the terminology wasn't consistent, was referring to past concepts, etc. The terminology is now explained as clearly as I could in the Note "About Units" and the code is refactored to reflect it. ------------------- Many names were misleading: UnitId is not an Id but could be a virtual unit (an indefinite one instantiated on the fly), IndefUnitId constructor may contain a definite instantiated unit, etc. * Rename IndefUnitId into InstantiatedUnit * Rename IndefModule into InstantiatedModule * Rename UnitId type into Unit * Rename IndefiniteUnitId constructor into VirtUnit * Rename DefiniteUnitId constructor into RealUnit * Rename packageConfigId into mkUnit * Rename getPackageDetails into unsafeGetUnitInfo * Rename InstalledUnitId into UnitId Remove references to misleading ComponentId: a ComponentId is just an indefinite unit-id to be instantiated. * Rename ComponentId into IndefUnitId * Rename ComponentDetails into UnitPprInfo * Fix display of UnitPprInfo with empty version: this is now used for units dynamically generated by BackPack Generalize several types (Module, Unit, etc.) so that they can be used with different unit identifier types: UnitKey, UnitId, Unit, etc. * GenModule: Module, InstantiatedModule and InstalledModule are now instances of this type * Generalize DefUnitId, IndefUnitId, Unit, InstantiatedUnit, PackageDatabase Replace BackPack fake "hole" UnitId by a proper HoleUnit constructor. Add basic support for UnitKey. They should be used more in the future to avoid mixing them up with UnitId as we do now. Add many comments. Update Haddock submodule - - - - - 8bfb0219 by Sylvain Henry at 2020-04-30T01:56:56-04:00 Unit: split and rename modules Introduce GHC.Unit.* hierarchy for everything concerning units, packages and modules. Update Haddock submodule - - - - - 71484b09 by Alexis King at 2020-04-30T01:57:35-04:00 Allow block arguments in arrow control operators Arrow control operators have their own entries in the grammar, so they did not cooperate with BlockArguments. This was just a minor oversight, so this patch adjusts the grammar to add the desired behavior. fixes #18050 - - - - - a48cd2a0 by Alexis King at 2020-04-30T01:57:35-04:00 Allow LambdaCase to be used as a command in proc notation - - - - - f4d3773c by Alexis King at 2020-04-30T01:57:35-04:00 Document BlockArguments/LambdaCase support in arrow notation - - - - - 5bdfdd13 by Simon Peyton Jones at 2020-04-30T01:58:15-04:00 Add tests for #17873 - - - - - 19b701c2 by Simon Peyton Jones at 2020-04-30T07:30:13-04:00 Mark rule args as non-tail-called This was just an omission...b I'd failed to call markAllNonTailCall on rule args. I think this bug has been here a long time, but it's quite hard to trigger. Fixes #18098 - - - - - 014ef4a3 by Matthew Pickering at 2020-04-30T07:30:50-04:00 Hadrian: Improve tool-args command to support more components There is a new command to hadrian, tool:path/to/file.hs, which returns the options needed to compile that file in GHCi. This is now used in the ghci script with argument `ghc/Main.hs` but its main purpose is to support the new multi-component branch of ghcide. - - - - - 2aa67611 by Ben Gamari at 2020-04-30T21:34:44-04:00 nonmoving: Clear bitmap after initializing block size Previously nonmovingInitSegment would clear the bitmap before initializing the segment's block size. This is broken since nonmovingClearBitmap looks at the segment's block size to determine how much bitmap to clear. - - - - - 54dad3cf by Ben Gamari at 2020-04-30T21:34:44-04:00 nonmoving: Explicitly memoize block count A profile cast doubt on whether the compiler hoisted the bound out the loop as I would have expected here. It turns out it did but nevertheless it seems clearer to just do this manually. - - - - - 99ff8145 by Ben Gamari at 2020-04-30T21:34:44-04:00 nonmoving: Eagerly flush all capabilities' update remembered sets (cherry picked from commit 2fa79119570b358a4db61446396889b8260d7957) - - - - - 05b0a9fd by Ömer Sinan Ağacan at 2020-04-30T21:35:24-04:00 Remove OneShotInfo field of LFReEntrant, document OneShotInfo The field is only used in withNewTickyCounterFun and it's easier to directly pass a parameter for one-shot info to withNewTickyCounterFun instead of passing it via LFReEntrant. This also makes !2842 simpler. Other changes: - New Note (by SPJ) [OneShotInfo overview] added. - Arity argument of thunkCode removed as it's always 0. - - - - - a43620c6 by Ömer Sinan Ağacan at 2020-04-30T21:35:24-04:00 GHC.StgToCmm.Ticky: remove a few unused stuff - - - - - 780de9e1 by Sylvain Henry at 2020-05-01T10:37:39-04:00 Use platform in Iface Binary - - - - - f8386c7b by Sylvain Henry at 2020-05-01T10:37:39-04:00 Refactor PprDebug handling If `-dppr-debug` is set, then PprUser and PprDump styles are silently replaced with PprDebug style. This was done in `mkUserStyle` and `mkDumpStyle` smart constructors. As a consequence they needed a DynFlags parameter. Now we keep the original PprUser and PprDump styles until they are used to create an `SDocContext`. I.e. the substitution is only performed in `initSDocContext`. - - - - - b3df9e78 by Sylvain Henry at 2020-05-01T10:37:39-04:00 Remove PprStyle param of logging actions Use `withPprStyle` instead to apply a specific style to a SDoc. - - - - - de9fc995 by Sylvain Henry at 2020-05-01T10:37:39-04:00 Fully remove PprDebug PprDebug was a pain to deal with consistently as it is implied by `-dppr-debug` but it isn't really a PprStyle. We remove it completely and query the appropriate SDoc flag instead (`sdocPprDebug`) via helpers (`getPprDebug` and its friends). - - - - - 8b51fcbd by Sebastian Graf at 2020-05-01T10:38:16-04:00 PmCheck: Only call checkSingle if we would report warnings - - - - - fd7ea0fe by Sebastian Graf at 2020-05-01T10:38:16-04:00 PmCheck: Pick up `EvVar`s bound in `HsWrapper`s for long-distance info `HsWrapper`s introduce evidence bindings through `WpEvLam` which the pattern-match coverage checker should be made aware of. Failing to do so caused #18049, where the resulting impreciseness of imcompleteness warnings seemingly contradicted with `-Winaccessible-code`. The solution is simple: Collect all the evidence binders of an `HsWrapper` and add it to the ambient `Deltas` before desugaring the wrapped expression. But that means we pick up many more evidence bindings, even when they wrap around code without a single pattern match to check! That regressed `T3064` by over 300%, so now we are adding long-distance info lazily through judicious use of `unsafeInterleaveIO`. Fixes #18049. - - - - - 7bfe9ac5 by Ben Gamari at 2020-05-03T04:41:33-04:00 rts: Enable tracing of nonmoving heap census with -ln Previously this was not easily available to the user. Fix this. Non-moving collection lifecycle events are now reported with -lg. - - - - - c560dd07 by Ben Gamari at 2020-05-03T04:41:33-04:00 users guide: Move eventlog documentation users guide - - - - - 02543d5e by Ben Gamari at 2020-05-03T04:41:33-04:00 users guide: Add documentation for non-moving GC events - - - - - b465dd45 by Alexis King at 2020-05-03T04:42:12-04:00 Flatten nested casts in the simple optimizer Normally, we aren’t supposed to generated any nested casts, since mkCast takes care to flatten them, but the simple optimizer didn’t use mkCast, so they could show up after inlining. This isn’t really a problem, since the simplifier will clean them up immediately anyway, but it can clutter the -ddump-ds output, and it’s an extremely easy fix. closes #18112 - - - - - 8bdc03d6 by Simon Peyton Jones at 2020-05-04T01:56:59-04:00 Don't return a panic in tcNestedSplice In GHC.Tc.Gen.Splice.tcNestedSplice we were returning a typechecked expression of "panic". That is usually OK, because the result is discarded. But it happens that tcApp now looks at the typechecked expression, trivially, to ask if it is tagToEnum. So being bottom is bad. Moreover a debug-trace might print it out. So better to return a civilised expression, even though it is usually discarded. - - - - - 0bf640b1 by Baldur Blöndal at 2020-05-04T01:57:36-04:00 Don't require parentheses around via type (`-XDerivingVia'). Fixes #18130". - - - - - 30272412 by Artem Pelenitsyn at 2020-05-04T13:19:59-04:00 Remove custom ExceptionMonad class (#18075) (updating haddock submodule accordingly) - - - - - b9f7c08f by jneira at 2020-05-04T13:20:37-04:00 Remove unused hs-boot file - - - - - 1d8f80cd by Sylvain Henry at 2020-05-05T03:22:46-04:00 Remove references to -package-key * remove references to `-package-key` which has been removed in 2016 (240ddd7c39536776e955e881d709bbb039b48513) * remove support for `-this-package-key` which has been deprecated at the same time - - - - - 7bc3a65b by Sylvain Henry at 2020-05-05T03:23:31-04:00 Remove SpecConstrAnnotation (#13681) This has been deprecated since 2013. Use GHC.Types.SPEC instead. Make GHC.Exts "not-home" for haddock Metric Decrease: haddock.base - - - - - 3c862f63 by DenisFrezzato at 2020-05-05T03:24:15-04:00 Fix Haskell98 short description in documentation - - - - - 2420c555 by Ryan Scott at 2020-05-05T03:24:53-04:00 Add regression tests for #16244, #16245, #16758 Commit e3c374cc5bd7eb49649b9f507f9f7740697e3f70 ended up fixing quite a few bugs: * This commit fixes #16244 completely. A regression test has been added. * This commit fixes one program from #16245. (The program in https://gitlab.haskell.org/ghc/ghc/issues/16245#note_211369 still panics, and the program in https://gitlab.haskell.org/ghc/ghc/issues/16245#note_211400 still loops infinitely.) A regression test has been added for this program. * This commit fixes #16758. Accordingly, this patch removes the `expect_broken` label from the `T16758` test case, moves it from `should_compile` to `should_fail` (as it should produce an error message), and checks in the expected stderr. - - - - - 40c71c2c by Sylvain Henry at 2020-05-05T03:25:31-04:00 Fix colorized error messages (#18128) In b3df9e780fb2f5658412c644849cd0f1e6f50331 I broke colorized messages by using "dump" style instead of "user" style. This commits fixes it. - - - - - 7ab6ab09 by Richard Eisenberg at 2020-05-06T04:39:32-04:00 Refactor hole constraints. Previously, holes (both expression holes / out of scope variables and partial-type-signature wildcards) were emitted as *constraints* via the CHoleCan constructor. While this worked fine for error reporting, there was a fair amount of faff in keeping these constraints in line. In particular, and unlike other constraints, we could never change a CHoleCan to become CNonCanonical. In addition: * the "predicate" of a CHoleCan constraint was really the type of the hole, which is not a predicate at all * type-level holes (partial type signature wildcards) carried evidence, which was never used * tcNormalise (used in the pattern-match checker) had to create a hole constraint just to extract it again; it was quite messy The new approach is to record holes directly in WantedConstraints. It flows much more nicely now. Along the way, I did some cleaning up of commentary in GHC.Tc.Errors.Hole, which I had a hard time understanding. This was instigated by a future patch that will refactor the way predicates are handled. The fact that CHoleCan's "predicate" wasn't really a predicate is incompatible with that future patch. No test case, because this is meant to be purely internal. It turns out that this change improves the performance of the pattern-match checker, likely because fewer constraints are sloshing about in tcNormalise. I have not investigated deeply, but an improvement is not a surprise here: ------------------------- Metric Decrease: PmSeriesG ------------------------- - - - - - 420b957d by Ben Gamari at 2020-05-06T04:40:08-04:00 rts: Zero block flags with -DZ Block flags are very useful for determining the state of a block. However, some block allocator users don't touch them, leading to misleading values. Ensure that we zero then when zero-on-gc is set. This is safe and makes the flags more useful during debugging. - - - - - 740b3b8d by Ben Gamari at 2020-05-06T04:40:08-04:00 nonmoving: Fix incorrect failed_to_evac value during deadlock gc Previously we would incorrectly set the failed_to_evac flag if we evacuated a value due to a deadlock GC. This would cause us to mark more things as dirty than strictly necessary. It also turned up a nasty but which I will fix next. - - - - - b2d72c75 by Ben Gamari at 2020-05-06T04:40:08-04:00 nonmoving: Fix handling of dirty objects Previously we (incorrectly) relied on failed_to_evac to be "precise". That is, we expected it to only be true if *all* of an object's fields lived outside of the non-moving heap. However, does not match the behavior of failed_to_evac, which is true if *any* of the object's fields weren't promoted (meaning that some others *may* live in the non-moving heap). This is problematic as we skip the non-moving write barrier for dirty objects (which we can only safely do if *all* fields point outside of the non-moving heap). Clearly this arises due to a fundamental difference in the behavior expected of failed_to_evac in the moving and non-moving collector. e.g., in the moving collector it is always safe to conservatively say failed_to_evac=true whereas in the non-moving collector the safe value is false. This issue went unnoticed as I never wrote down the dirtiness invariant enforced by the non-moving collector. We now define this invariant as An object being marked as dirty implies that all of its fields are on the mark queue (or, equivalently, update remembered set). To maintain this invariant we teach nonmovingScavengeOne to push the fields of objects which we fail to evacuate to the update remembered set. This is a simple and reasonably cheap solution and avoids the complexity and fragility that other, more strict alternative invariants would require. All of this is described in a new Note, Note [Dirty flags in the non-moving collector] in NonMoving.c. - - - - - 9f3e6884 by Zubin Duggal at 2020-05-06T04:41:08-04:00 Allow atomic update of NameCache in readHieFile The situation arises in ghcide where multiple different threads may need to update the name cache, therefore with the older interface it could happen that you start reading a hie file with name cache A and produce name cache A + B, but another thread in the meantime updated the namecache to A + C. Therefore if you write the new namecache you will lose the A' updates from the second thread. Updates haddock submodule - - - - - edec6a6c by Ryan Scott at 2020-05-06T04:41:57-04:00 Make isTauTy detect higher-rank contexts Previously, `isTauTy` would only detect higher-rank `forall`s, not higher-rank contexts, which led to some minor bugs observed in #18127. Easily fixed by adding a case for `(FunTy InvisArg _ _)`. Fixes #18127. - - - - - a95e7fe0 by Ömer Sinan Ağacan at 2020-05-06T04:42:39-04:00 ELF linker: increment curSymbol after filling in fields of current entry The bug was introduced in a8b7cef4d45 which added a field to the `symbols` array elements and then updated this code incorrectly: - oc->symbols[curSymbol++] = nm; + oc->symbols[curSymbol++].name = nm; + oc->symbols[curSymbol].addr = symbol->addr; - - - - - cab1871a by Sylvain Henry at 2020-05-06T04:43:21-04:00 Move LeadingUnderscore into Platform (#17957) Avoid direct use of DynFlags to know if symbols must be prefixed by an underscore. - - - - - 94e7c563 by Sylvain Henry at 2020-05-06T04:43:21-04:00 Don't use DynFlags in showLinkerState (#17957) - - - - - 9afd9251 by Ryan Scott at 2020-05-06T04:43:58-04:00 Refactoring: Use bindSigTyVarsFV in rnMethodBinds `rnMethodBinds` was explicitly using `xoptM` to determine if `ScopedTypeVariables` is enabled before bringing type variables bound by the class/instance header into scope. However, this `xoptM` logic is already performed by the `bindSigTyVarsFV` function. This patch uses `bindSigTyVarsFV` in `rnMethodBinds` to reduce the number of places where we need to consult if `ScopedTypeVariables` is on. This is purely refactoring, and there should be no user-visible change in behavior. - - - - - 6f6d72b2 by Brian Foley at 2020-05-08T15:29:25-04:00 Remove further dead code found by a simple Python script. Avoid removing some functions that are part of an API even though they're not used in-tree at the moment. - - - - - 78bf8bf9 by Julien Debon at 2020-05-08T15:29:28-04:00 Add doc examples for Bifoldable See #17929 - - - - - 66f0a847 by Julien Debon at 2020-05-08T15:29:29-04:00 doc (Bitraversable): Add examples to Bitraversable * Add examples to Data.Bitraversable * Fix formatting for (,) in Bitraversable and Bifoldable * Fix mistake on bimapAccumR documentation See #17929 - - - - - 9749fe12 by Baldur Blöndal at 2020-05-08T15:29:32-04:00 Specify kind variables for inferred kinds in base. - - - - - 4e9aef9e by John Ericson at 2020-05-08T15:29:36-04:00 HsSigWcTypeScoping: Pull in documentation from stray location - - - - - f4d5c6df by John Ericson at 2020-05-08T15:29:36-04:00 Rename local `real_fvs` to `implicit_vs` It doesn't make sense to call the "free" variables we are about to implicitly bind the real ones. - - - - - 20570b4b by John Ericson at 2020-05-08T15:29:36-04:00 A few tiny style nits with renaming - Use case rather than guards that repeatedly scrutenize same thing. - No need for view pattern when `L` is fine. - Use type synnonym to convey the intent like elsewhere. - - - - - 09ac8de5 by John Ericson at 2020-05-08T15:29:36-04:00 Add `forAllOrNothing` function with note - - - - - bb35c0e5 by Joseph C. Sible at 2020-05-08T15:29:40-04:00 Document lawlessness of Ap's Num instance - - - - - cdd229ff by Joseph C. Sible at 2020-05-08T15:29:40-04:00 Apply suggestion to libraries/base/Data/Monoid.hs - - - - - 926d2aab by Joseph C. Sible at 2020-05-08T15:29:40-04:00 Apply more suggestions from Simon Jakobi - - - - - 7a763cff by Adam Gundry at 2020-05-08T15:29:41-04:00 Reject all duplicate declarations involving DuplicateRecordFields (fixes #17965) This fixes a bug that resulted in some programs being accepted that used the same identifier as a field label and another declaration, depending on the order they appeared in the source code. - - - - - 88e3c815 by Simon Peyton Jones at 2020-05-08T15:29:41-04:00 Fix specialisation for DFuns When specialising a DFun we must take care to saturate the unfolding. See Note [Specialising DFuns] in Specialise. Fixes #18120 - - - - - 86c77b36 by Greg Steuck at 2020-05-08T15:29:45-04:00 Remove unused SEGMENT_PROT_RWX It's been unused for a year and is problematic on any OS which requires W^X for security. - - - - - 9d97f4b5 by nineonine at 2020-05-08T15:30:03-04:00 Add test for #16167 - - - - - aa318338 by Ryan Scott at 2020-05-08T15:30:04-04:00 Bump exceptions submodule so that dist-boot is .gitignore'd `exceptions` is a stage-0 boot library as of commit 30272412fa437ab8e7a8035db94a278e10513413, which means that building `exceptions` in a GHC tree will generate a `dist-boot` directory. However, this directory was not specified in `exceptions`' `.gitignore` file, which causes it to dirty up the current `git` working directory. Accordingly, this bumps the `exceptions` submodule to commit ghc/packages/exceptions at 23c0b8a50d7592af37ca09beeec16b93080df98f, which adds `dist-boot` to the `.gitignore` file. - - - - - ea86360f by Ömer Sinan Ağacan at 2020-05-08T15:30:30-04:00 Linker.c: initialize n_symbols of ObjectCode with other fields - - - - - 951c1fb0 by Sylvain Henry at 2020-05-09T21:46:38-04:00 Fix unboxed-sums GC ptr-slot rubbish value (#17791) This patch allows boot libraries to use unboxed sums without implicitly depending on `base` package because of `absentSumFieldError`. See updated Note [aBSENT_SUM_FIELD_ERROR_ID] in GHC.Core.Make - - - - - b352d63c by Ben Gamari at 2020-05-09T21:47:14-04:00 rts: Make non-existent linker search path merely a warning As noted in #18105, previously this resulted in a rather intrusive error message. This is in contrast to the general expectation that search paths are merely places to look, not places that must exist. Fixes #18105. - - - - - cf4f1e2f by Ben Gamari at 2020-05-13T02:02:33-04:00 rts/CNF: Fix fixup comparison function Previously we would implicitly convert the difference between two words to an int, resulting in an integer overflow on 64-bit machines. Fixes #16992 - - - - - a03da9bf by Ömer Sinan Ağacan at 2020-05-13T02:03:16-04:00 Pack some of IdInfo fields into a bit field This reduces residency of compiler quite a bit on some programs. Example stats when building T10370: Before: 2,871,242,832 bytes allocated in the heap 4,693,328,008 bytes copied during GC 33,941,448 bytes maximum residency (276 sample(s)) 375,976 bytes maximum slop 83 MiB total memory in use (0 MB lost due to fragmentation) After: 2,858,897,344 bytes allocated in the heap 4,629,255,440 bytes copied during GC 32,616,624 bytes maximum residency (278 sample(s)) 314,400 bytes maximum slop 80 MiB total memory in use (0 MB lost due to fragmentation) So -3.9% residency, -1.3% bytes copied and -0.4% allocations. Fixes #17497 Metric Decrease: T9233 T9675 - - - - - 670c3e5c by Ben Gamari at 2020-05-13T02:03:54-04:00 get-win32-tarballs: Fix base URL Revert a change previously made for testing purposes. - - - - - 8ad8dc41 by Ben Gamari at 2020-05-13T02:03:54-04:00 get-win32-tarballs: Improve diagnostics output - - - - - 8c0740b7 by Simon Jakobi at 2020-05-13T02:04:33-04:00 docs: Add examples for Data.Semigroup.Arg{Min,Max} Context: #17153 - - - - - cb22348f by Ben Gamari at 2020-05-13T02:05:11-04:00 Add few cleanups of the CAF logic Give the NameSet of non-CAFfy names a proper newtype to distinguish it from all of the other NameSets floating about. - - - - - 90e38b81 by Emeka Nkurumeh at 2020-05-13T02:05:51-04:00 fix printf warning when using with ghc with clang on mingw - - - - - 86d8ac22 by Sebastian Graf at 2020-05-13T02:06:29-04:00 CprAnal: Don't attach CPR sigs to expandable bindings (#18154) Instead, look through expandable unfoldings in `cprTransform`. See the new Note [CPR for expandable unfoldings]: ``` Long static data structures (whether top-level or not) like xs = x1 : xs1 xs1 = x2 : xs2 xs2 = x3 : xs3 should not get CPR signatures, because they * Never get WW'd, so their CPR signature should be irrelevant after analysis (in fact the signature might even be harmful for that reason) * Would need to be inlined/expanded to see their constructed product * Recording CPR on them blows up interface file sizes and is redundant with their unfolding. In case of Nested CPR, this blow-up can be quadratic! But we can't just stop giving DataCon application bindings the CPR property, for example fac 0 = 1 fac n = n * fac (n-1) fac certainly has the CPR property and should be WW'd! But FloatOut will transform the first clause to lvl = 1 fac 0 = lvl If lvl doesn't have the CPR property, fac won't either. But lvl doesn't have a CPR signature to extrapolate into a CPR transformer ('cprTransform'). So instead we keep on cprAnal'ing through *expandable* unfoldings for these arity 0 bindings via 'cprExpandUnfolding_maybe'. In practice, GHC generates a lot of (nested) TyCon and KindRep bindings, one for each data declaration. It's wasteful to attach CPR signatures to each of them (and intractable in case of Nested CPR). ``` Fixes #18154. - - - - - e34bf656 by Ben Gamari at 2020-05-13T02:07:08-04:00 users-guide: Add discussion of shared object naming Fixes #18074. - - - - - 5d0f2445 by Ben Gamari at 2020-05-13T02:07:47-04:00 testsuite: Print sign of performance changes Executes the minor formatting change in the tabulated performance changes suggested in #18135. - - - - - 9e4b981f by Ben Gamari at 2020-05-13T02:08:24-04:00 testsuite: Add testcase for #18129 - - - - - 266310c3 by Ivan-Yudin at 2020-05-13T02:09:03-04:00 doc: Reformulate the opening paragraph of Ch. 4 in User's guide Removes mentioning of Hugs (it is not helpful for new users anymore). Changes the wording for the rest of the paragraph. Fixes #18132. - - - - - 55e35c0b by Baldur Blöndal at 2020-05-13T20:02:48-04:00 Predicate, Equivalence derive via `.. -> a -> All' - - - - - d7e0b57f by Alp Mestanogullari at 2020-05-13T20:03:30-04:00 hadrian: add a --freeze2 option to freeze stage 1 and 2 - - - - - d880d6b2 by Artem Pelenitsyn at 2020-05-13T20:04:11-04:00 Don't reload environment files on every setSessionDynFlags Makes `interpretPackageEnv` (which loads envirinment files) a part of `parseDynamicFlags` (parsing command-line arguments, which is typically done once) instead of `setSessionDynFlags` (which is typically called several times). Making several (transitive) calls to `interpretPackageEnv`, as before, caused #18125 #16318, which should be fixed now. - - - - - 102cfd67 by Ryan Scott at 2020-05-13T20:04:46-04:00 Factor out HsPatSigType for pat sigs/RULE term sigs (#16762) This implements chunks (2) and (3) of https://gitlab.haskell.org/ghc/ghc/issues/16762#note_270170. Namely, it introduces a dedicated `HsPatSigType` AST type, which represents the types that can appear in pattern signatures and term-level `RULE` binders. Previously, these were represented with `LHsSigWcType`. Although `LHsSigWcType` is isomorphic to `HsPatSigType`, the intended semantics of the two types are slightly different, as evidenced by the fact that they have different code paths in the renamer and typechecker. See also the new `Note [Pattern signature binders and scoping]` in `GHC.Hs.Types`. - - - - - b17574f7 by Hécate at 2020-05-13T20:05:28-04:00 fix(documentation): Fix the RST links to GHC.Prim - - - - - df021fb1 by Baldur Blöndal at 2020-05-13T20:06:06-04:00 Document (->) using inferred quantification for its runtime representations. Fixes #18142. - - - - - 1a93ea57 by Takenobu Tani at 2020-05-13T20:06:54-04:00 Tweak man page for ghc command This commit updates the ghc command's man page as followings: * Enable `man_show_urls` to show URL addresses in the `DESCRIPTION` section of ghc.rst, because sphinx currently removes hyperlinks for man pages. * Add a `SEE ALSO` section to point to the GHC homepage - - - - - a951e1ba by Takenobu Tani at 2020-05-13T20:07:37-04:00 GHCi: Add link to the user's guide in help message This commit adds a link to the user's guide in ghci's `:help` message. Newcomers could easily reach to details of ghci. - - - - - 404581ea by Jeff Happily at 2020-05-13T20:08:15-04:00 Handle single unused import - - - - - 1c999e5d by Ben Gamari at 2020-05-13T20:09:07-04:00 Ensure that printMinimalImports closes handle Fixes #18166. - - - - - c9f5a8f4 by Ben Gamari at 2020-05-13T20:09:51-04:00 hadrian: Tell testsuite driver about LLVM availability This reflects the logic present in the Make build system into Hadrian. Fixes #18167. - - - - - c05c0659 by Simon Jakobi at 2020-05-14T03:31:21-04:00 Improve some folds over Uniq[D]FM * Replace some non-deterministic lazy folds with strict folds. * Replace some O(n log n) folds in deterministic order with O(n) non-deterministic folds. * Replace some folds with set-operations on the underlying IntMaps. This reduces max residency when compiling `nofib/spectral/simple/Main.hs` with -O0 by about 1%. Maximum residency when compiling Cabal also seems reduced on the order of 3-9%. - - - - - 477f13bb by Simon Jakobi at 2020-05-14T03:31:58-04:00 Use Data.IntMap.disjoint Data.IntMap gained a dedicated `disjoint` function in containers-0.6.2.1. This patch applies this function where appropriate in hopes of modest compiler performance improvements. Closes #16806. - - - - - e9c0110c by Ben Gamari at 2020-05-14T12:25:53-04:00 IdInfo: Add reference to bitfield-packing ticket - - - - - 9bd20e83 by Sebastian Graf at 2020-05-15T10:42:09-04:00 DmdAnal: Improve handling of precise exceptions This patch does two things: Fix possible unsoundness in what was called the "IO hack" and implement part 2.1 of the "fixing precise exceptions" plan in https://gitlab.haskell.org/ghc/ghc/wikis/fixing-precise-exceptions, which, in combination with !2956, supersedes !3014 and !2525. **IO hack** The "IO hack" (which is a fallback to preserve precise exceptions semantics and thus soundness, rather than some smart thing that increases precision) is called `exprMayThrowPreciseException` now. I came up with two testcases exemplifying possible unsoundness (if twisted enough) in the old approach: - `T13380d`: Demonstrating unsoundness of the "IO hack" when resorting to manual state token threading and direct use of primops. More details below. - `T13380e`: Demonstrating unsoundness of the "IO hack" when we have Nested CPR. Not currently relevant, as we don't have Nested CPR yet. - `T13380f`: Demonstrating unsoundness of the "IO hack" for safe FFI calls. Basically, the IO hack assumed that precise exceptions can only be thrown from a case scrutinee of type `(# State# RealWorld, _ #)`. I couldn't come up with a program using the `IO` abstraction that violates this assumption. But it's easy to do so via manual state token threading and direct use of primops, see `T13380d`. Also similar code might be generated by Nested CPR in the (hopefully not too) distant future, see `T13380e`. Hence, we now have a more careful test in `forcesRealWorld` that passes `T13380{d,e}` (and will hopefully be robust to Nested CPR). **Precise exceptions** In #13380 and #17676 we saw that we didn't preserve precise exception semantics in demand analysis. We fixed that with minimal changes in !2956, but that was terribly unprincipled. That unprincipledness resulted in a loss of precision, which is tracked by these new test cases: - `T13380b`: Regression in dead code elimination, because !2956 was too syntactic about `raiseIO#` - `T13380c`: No need to apply the "IO hack" when the IO action may not throw a precise exception (and the existing IO hack doesn't detect that) Fixing both issues in !3014 turned out to be too complicated and had the potential to regress in the future. Hence we decided to only fix `T13380b` and augment the `Divergence` lattice with a new middle-layer element, `ExnOrDiv`, which means either `Diverges` (, throws an imprecise exception) or throws a *precise* exception. See the wiki page on Step 2.1 for more implementational details: https://gitlab.haskell.org/ghc/ghc/wikis/fixing-precise-exceptions#dead-code-elimination-for-raiseio-with-isdeadenddiv-introducing-exnordiv-step-21 - - - - - 568d7279 by Ben Gamari at 2020-05-15T10:42:46-04:00 GHC.Cmm.Opt: Handle MO_XX_Conv This MachOp was introduced by 2c959a1894311e59cd2fd469c1967491c1e488f3 but a wildcard match in cmmMachOpFoldM hid the fact that it wasn't handled. Ideally we would eliminate the match but this appears to be a larger task. Fixes #18141. - - - - - 5bcf8606 by Ryan Scott at 2020-05-17T08:46:38-04:00 Remove duplicate Note [When to print foralls] in GHC.Core.TyCo.Ppr There are two different Notes named `[When to print foralls]`. The most up-to-date one is in `GHC.Iface.Type`, but there is a second one in `GHC.Core.TyCo.Ppr`. The latter is less up-to-date, as it was written before GHC switched over to using ifaces to pretty-print types. I decided to just remove the latter and replace it with a reference to the former. [ci skip] - - - - - 55f0e783 by Fumiaki Kinoshita at 2020-05-21T12:10:44-04:00 base: Add Generic instances to various datatypes under GHC.* * GHC.Fingerprint.Types: Fingerprint * GHC.RTS.Flags: GiveGCStats, GCFlags, ConcFlags, DebugFlags, CCFlags, DoHeapProfile, ProfFlags, DoTrace, TraceFlags, TickyFlags, ParFlags and RTSFlags * GHC.Stats: RTSStats and GCStats * GHC.ByteOrder: ByteOrder * GHC.Unicode: GeneralCategory * GHC.Stack.Types: SrcLoc Metric Increase: haddock.base - - - - - a9311cd5 by Gert-Jan Bottu at 2020-05-21T12:11:31-04:00 Explicit Specificity Implementation for Ticket #16393. Explicit specificity allows users to manually create inferred type variables, by marking them with braces. This way, the user determines which variables can be instantiated through visible type application. The additional syntax is included in the parser, allowing users to write braces in type variable binders (type signatures, data constructors etc). This information is passed along through the renamer and verified in the type checker. The AST for type variable binders, data constructors, pattern synonyms, partial signatures and Template Haskell has been updated to include the specificity of type variables. Minor notes: - Bumps haddock submodule - Disables pattern match checking in GHC.Iface.Type with GHC 8.8 - - - - - 24e61aad by Ben Price at 2020-05-21T12:12:17-04:00 Lint should say when it is checking a rule It is rather confusing that when lint finds an error in a rule attached to a binder, it reports the error as in the RHS, not the rule: ... In the RHS of foo We add a clarifying line: ... In the RHS of foo In a rule attached to foo The implication that the rule lives inside the RHS is a bit odd, but this niggle is already present for unfoldings, whose pattern we are following. - - - - - 78c6523c by Ben Gamari at 2020-05-21T12:13:01-04:00 nonmoving: Optimise the write barrier - - - - - 13f6c9d0 by Andreas Klebinger at 2020-05-21T12:13:45-04:00 Refactor linear reg alloc to remember past assignments. When assigning registers we now first try registers we assigned to in the past, instead of picking the "first" one. This is in extremely helpful when dealing with loops for which variables are dead for part of the loop. This is important for patterns like this: foo = arg1 loop: use(foo) ... foo = getVal() goto loop; There we: * assign foo to the register of arg1. * use foo, it's dead after this use as it's overwritten after. * do other things. * look for a register to put foo in. If we pick an arbitrary one it might differ from the register the start of the loop expect's foo to be in. To fix this we simply look for past register assignments for the given variable. If we find one and the register is free we use that register. This reduces the need for fixup blocks which match the register assignment between blocks. In the example above between the end and the head of the loop. This patch also moves branch weight estimation ahead of register allocation and adds a flag to control it (cmm-static-pred). * It means the linear allocator is more likely to assign the hotter code paths first. * If it assign these first we are: + Less likely to spill on the hot path. + Less likely to introduce fixup blocks on the hot path. These two measure combined are surprisingly effective. Based on nofib we get in the mean: * -0.9% instructions executed * -0.1% reads/writes * -0.2% code size. * -0.1% compiler allocations. * -0.9% compile time. * -0.8% runtime. Most of the benefits are simply a result of removing redundant moves and spills. Reduced compiler allocations likely are the result of less code being generated. (The added lookup is mostly non-allocating). - - - - - edc2cc58 by Andreas Klebinger at 2020-05-21T12:14:25-04:00 NCG: Codelayout: Distinguish conditional and other branches. In #18053 we ended up with a suboptimal code layout because the code layout algorithm didn't distinguish between conditional and unconditional control flow. We can completely eliminate unconditional control flow instructions by placing blocks next to each other, not so much for conditionals. In terms of implementation we simply give conditional branches less weight before computing the layout. Fixes #18053 - - - - - b7a6b2f4 by Gleb Popov at 2020-05-21T12:15:26-04:00 gitlab-ci: Set locale to C.UTF-8. - - - - - a8c27cf6 by Stefan Holdermans at 2020-05-21T12:16:08-04:00 Allow spaces in GHCi :script file names This patch updates the user interface of GHCi so that file names passed to the ':script' command may contain spaces escaped with a backslash. For example: :script foo\ bar.script The implementation uses a modified version of 'words' that does not break on escaped spaces. Fixes #18027. - - - - - 82663959 by Stefan Holdermans at 2020-05-21T12:16:08-04:00 Add extra tests for GHCi :script syntax checks The syntax for GHCi's ":script" command allows for only a single file name to be passed as an argument. This patch adds a test for the cases in which a file name is missing or multiple file names are passed. Related to #T18027. - - - - - a0b79e1b by Stefan Holdermans at 2020-05-21T12:16:08-04:00 Allow GHCi :script file names in double quotes This patch updates the user interface of GHCi so that file names passed to the ':script' command can be wrapped in double quotes. For example: :script "foo bar.script" The implementation uses a modified version of 'words' that treats character sequences enclosed in double quotes as single words. Fixes #18027. - - - - - cf566330 by Stefan Holdermans at 2020-05-21T12:16:08-04:00 Update documentation for GHCi :script This patch adds the fixes that allow for file names containing spaces to be passed to GHCi's ':script' command to the release notes for 8.12 and expands the user-guide documentation for ':script' by mentioning how such file names can be passed. Related to #18027. - - - - - 0004ccb8 by Tuan Le at 2020-05-21T12:16:46-04:00 llvmGen: Consider Relocatable read-only data as not constantReferences: #18137 - - - - - 964d3ea2 by John Ericson at 2020-05-21T12:17:30-04:00 Use `Checker` for `tc_pat` - - - - - b797aa42 by John Ericson at 2020-05-21T12:17:30-04:00 Use `Checker` for `tc_lpat` and `tc_lpats` - - - - - 5108e84a by John Ericson at 2020-05-21T12:17:30-04:00 More judiciously panic in `ts_pat` - - - - - 510e0451 by John Ericson at 2020-05-21T12:17:30-04:00 Put `PatEnv` first in `GHC.Tc.Gen.Pat.Checker` - - - - - cb4231db by John Ericson at 2020-05-21T12:17:30-04:00 Tiny cleaup eta-reduce away a function argument In GHC, not in the code being compiled! - - - - - 6890c38d by John Ericson at 2020-05-21T12:17:30-04:00 Use braces with do in `SplicePat` case for consistency - - - - - 3451584f by buggymcbugfix at 2020-05-21T12:18:06-04:00 Fix spelling mistakes and typos - - - - - b552e531 by buggymcbugfix at 2020-05-21T12:18:06-04:00 Add INLINABLE pragmas to Enum list producers The INLINABLE pragmas ensure that we export stable (unoptimised) unfoldings in the interface file so we can do list fusion at usage sites. Related tickets: #15185, #8763, #18178. - - - - - e7480063 by buggymcbugfix at 2020-05-21T12:18:06-04:00 Piggyback on Enum Word methods for Word64 If we are on a 64 bit platform, we can use the efficient Enum Word methods for the Enum Word64 instance. - - - - - 892b0c41 by buggymcbugfix at 2020-05-21T12:18:06-04:00 Document INLINE(ABLE) pragmas that enable fusion - - - - - 2b363ebb by Richard Eisenberg at 2020-05-21T12:18:45-04:00 MR template should ask for key part - - - - - a95bbd0b by Sebastian Graf at 2020-05-21T12:19:37-04:00 Make `Int`'s `mod` and `rem` strict in their first arguments They used to be strict until 4d2ac2d (9 years ago). It's obviously better to be strict for performance reasons. It also blocks #18067. NoFib results: ``` -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- integer -1.1% +0.4% wheel-sieve2 +21.2% +20.7% -------------------------------------------------------------------------------- Min -1.1% -0.0% Max +21.2% +20.7% Geometric Mean +0.2% +0.2% ``` The regression in `wheel-sieve2` is due to reboxing that likely will go away with the resolution of #18067. See !3282 for details. Fixes #18187. - - - - - d3d055b8 by Galen Huntington at 2020-05-21T12:20:18-04:00 Clarify pitfalls of NegativeLiterals; see #18022. - - - - - 1b508a9e by Alexey Kuleshevich at 2020-05-21T12:21:02-04:00 Fix wording in primops documentation to reflect the correct reasoning: * Besides resizing functions, shrinking ones also mutate the size of a mutable array and because of those two `sizeofMutabeByteArray` and `sizeofSmallMutableArray` are now deprecated * Change reference in documentation to the newer functions `getSizeof*` instead of `sizeof*` for shrinking functions * Fix incorrect mention of "byte" instead of "small" - - - - - 4ca0c8a1 by Andreas Klebinger at 2020-05-21T12:21:53-04:00 Don't variable-length encode magic iface constant. We changed to use variable length encodings for many types by default, including Word32. This makes sense for numbers but not when Word32 is meant to represent four bytes. I added a FixedLengthEncoding newtype to Binary who's instances interpret their argument as a collection of bytes instead of a number. We then use this when writing/reading magic numbers to the iface file. I also took the libery to remove the dummy iface field. This fixes #18180. - - - - - a1275081 by Krzysztof Gogolewski at 2020-05-21T12:22:35-04:00 Add a regression test for #11506 The testcase works now. See explanation in https://gitlab.haskell.org/ghc/ghc/issues/11506#note_273202 - - - - - 8a816e5f by Krzysztof Gogolewski at 2020-05-21T12:23:55-04:00 Sort deterministically metric output Previously, we sorted according to the test name and way, but the metrics (max_bytes_used/peak_megabytes_allocated etc.) were appearing in nondeterministic order. - - - - - 566cc73f by Sylvain Henry at 2020-05-21T12:24:45-04:00 Move isDynLinkName into GHC.Types.Name It doesn't belong into GHC.Unit.State - - - - - d830bbc9 by Adam Sandberg Ericsson at 2020-05-23T13:36:20-04:00 docs: fix formatting and add some links [skip ci] - - - - - 49301ad6 by Andrew Martin at 2020-05-23T13:37:01-04:00 Implement cstringLength# and FinalPtr This function and its accompanying rule resolve issue #5218. A future PR to the bytestring library will make the internal Data.ByteString.Internal.unsafePackAddress compute string length with cstringLength#. This will improve the status quo because it is eligible for constant folding. Additionally, introduce a new data constructor to ForeignPtrContents named FinalPtr. This additional data constructor, when used in the IsString instance for ByteString, leads to more Core-to-Core optimization opportunities, fewer runtime allocations, and smaller binaries. Also, this commit re-exports all the functions from GHC.CString (including cstringLength#) in GHC.Exts. It also adds a new test driver. This test driver is used to perform substring matches on Core that is dumped after all the simplifier passes. In this commit, it is used to check that constant folding of cstringLength# works. - - - - - dcd6bdcc by Ben Gamari at 2020-05-23T13:37:48-04:00 simplCore: Ignore ticks in rule templates This fixes #17619, where a tick snuck in to the template of a rule, resulting in a panic during rule matching. The tick in question was introduced via post-inlining, as discussed in `Note [Simplifying rules]`. The solution we decided upon was to simply ignore ticks in the rule template, as discussed in `Note [Tick annotations in RULE matching]`. Fixes #18162. Fixes #17619. - - - - - 82cb8913 by John Ericson at 2020-05-23T13:38:32-04:00 Fix #18145 and also avoid needless work with implicit vars - `forAllOrNothing` now is monadic, so we can trace whether we bind an explicit `forall` or not. - #18145 arose because the free vars calculation was needlessly complex. It is now greatly simplified. - Replaced some other implicit var code with `filterFreeVarsToBind`. Co-authored-by: Ryan Scott <ryan.gl.scott at gmail.com> - - - - - a60dc835 by Ben Gamari at 2020-05-23T13:39:12-04:00 Bump process submodule Fixes #17926. - - - - - 856adf54 by Ben Gamari at 2020-05-23T13:40:21-04:00 users-guide: Clarify meaning of -haddock flag Fixes #18206. - - - - - 7ae57afd by Ben Gamari at 2020-05-23T13:41:03-04:00 git: Add ignored commits file This can be used to tell git to ignore bulk renaming commits like the recently-finished module hierarchy refactoring. Configured with, git config blame.ignoreRevsFile .git-ignore-revs - - - - - 63d30e60 by jneira at 2020-05-24T01:54:42-04:00 Add hie-bios script for windows systems It is a direct translation of the sh script - - - - - 59182b88 by jneira at 2020-05-24T01:54:42-04:00 Honour previous values for CABAL and CABFLAGS The immediate goal is let the hie-bios.bat script set CABFLAGS with `-v0` and remove all cabal output except the compiler arguments - - - - - 932dc54e by jneira at 2020-05-24T01:54:42-04:00 Add specific configuration for windows in hie.yaml - - - - - e0eda070 by jneira at 2020-05-24T01:54:42-04:00 Remove not needed hie-bios output - - - - - a0ea59d6 by Sylvain Henry at 2020-05-24T01:55:24-04:00 Move Config module into GHC.Settings - - - - - 37430251 by Sylvain Henry at 2020-05-24T01:55:24-04:00 Rename GHC.Core.Arity into GHC.Core.Opt.Arity - - - - - a426abb9 by Sylvain Henry at 2020-05-24T01:55:24-04:00 Rename GHC.Hs.Types into GHC.Hs.Type See discussion in https://gitlab.haskell.org/ghc/ghc/issues/13009#note_268610 - - - - - 1c91a7a0 by Sylvain Henry at 2020-05-24T01:55:24-04:00 Bump haddock submodule - - - - - 66bd24d1 by Ryan Scott at 2020-05-24T01:56:03-04:00 Add orderingTyCon to wiredInTyCons (#18185) `Ordering` needs to be wired in for use in the built-in `CmpNat` and `CmpSymbol` type families, but somehow it was never added to the list of `wiredInTyCons`, leading to the various oddities observed in #18185. Easily fixed by moving `orderingTyCon` from `basicKnownKeyNames` to `wiredInTyCons`. Fixes #18185. - - - - - 01c43634 by Matthew Pickering at 2020-05-24T01:56:42-04:00 Remove unused hs-boot file - - - - - 7a07aa71 by Sylvain Henry at 2020-05-24T15:22:17-04:00 Hadrian: fix cross-compiler build (#16051) - - - - - 15ccca16 by Sylvain Henry at 2020-05-24T15:22:17-04:00 Hadrian: fix distDir per stage - - - - - b420fb24 by Sylvain Henry at 2020-05-24T15:22:17-04:00 Hadrian: fix hp2ps error during cross-compilation Fixed by @alp (see https://gitlab.haskell.org/ghc/ghc/issues/16051#note_274265) - - - - - cd339ef0 by Joshua Price at 2020-05-24T15:22:56-04:00 Make Unicode brackets opening/closing tokens (#18225) The tokens `[|`, `|]`, `(|`, and `|)` are opening/closing tokens as described in GHC Proposal #229. This commit makes the unicode variants (`⟦`, `⟧`, `⦇`, and `⦈`) act the same as their ASCII counterparts. - - - - - 013d7120 by Ben Gamari at 2020-05-25T09:48:17-04:00 Revert "Specify kind variables for inferred kinds in base." As noted in !3132, this has rather severe knock-on consequences in user-code. We'll need to revisit this before merging something along these lines. This reverts commit 9749fe1223d182b1f8e7e4f7378df661c509f396. - - - - - 4c4312ed by Ben Gamari at 2020-05-25T09:48:53-04:00 Coverage: Drop redundant ad-hoc boot module check To determine whether the module is a boot module Coverage.addTicksToBinds was checking for a `boot` suffix in the module source filename. This is quite ad-hoc and shouldn't be necessary; the callsite in `deSugar` already checks that the module isn't a boot module. - - - - - 1abf3c84 by Ben Gamari at 2020-05-25T09:48:53-04:00 Coverage: Make tickBoxCount strict This could otherwise easily cause a leak of (+) thunks. - - - - - b2813750 by Ben Gamari at 2020-05-25T09:48:53-04:00 Coverage: Make ccIndices strict This just seems like a good idea. - - - - - 02e278eb by Ben Gamari at 2020-05-25T09:48:53-04:00 Coverage: Don't produce ModBreaks if not HscInterpreted emptyModBreaks contains a bottom and consequently it's important that we don't use it unless necessary. - - - - - b8c014ce by Ben Gamari at 2020-05-25T09:48:53-04:00 Coverage: Factor out addMixEntry - - - - - 53814a64 by Zubin Duggal at 2020-05-26T03:03:24-04:00 Add info about typeclass evidence to .hie files See `testsuite/tests/hiefile/should_run/HieQueries.hs` and `testsuite/tests/hiefile/should_run/HieQueries.stdout` for an example of this We add two new fields, `EvidenceVarBind` and `EvidenceVarUse` to the `ContextInfo` associated with an Identifier. These are associated with the appropriate identifiers for the evidence variables collected when we come across `HsWrappers`, `TcEvBinds` and `IPBinds` while traversing the AST. Instance dictionary and superclass selector dictionaries from `tcg_insts` and classes defined in `tcg_tcs` are also recorded in the AST as originating from their definition span This allows us to save a complete picture of the evidence constructed by the constraint solver, and will let us report this to the user, enabling features like going to the instance definition from the invocation of a class method(or any other method taking a constraint) and finding all usages of a particular instance. Additionally, - Mark NodeInfo with an origin so we can differentiate between bindings origininating in the source vs those in ghc - Along with typeclass evidence info, also include information on Implicit Parameters - Add a few utility functions to HieUtils in order to query the new info Updates haddock submodule - - - - - 6604906c by Sebastian Graf at 2020-05-26T03:04:04-04:00 Make WorkWrap.Lib.isWorkerSmallEnough aware of the old arity We should allow a wrapper with up to 82 parameters when the original function had 82 parameters to begin with. I verified that this made no difference on NoFib, but then again it doesn't use huge records... Fixes #18122. - - - - - cf772f19 by Sylvain Henry at 2020-05-26T03:04:45-04:00 Enhance Note [About units] for Backpack - - - - - ede24126 by Takenobu Tani at 2020-05-27T00:13:55-04:00 core-spec: Modify file paths according to new module hierarchy This patch updates file paths according to new module hierarchy [1]: * GHC/Core.hs <= coreSyn/CoreSyn.hs * GHC/Core/Coercion.hs <= types/Coercion.hs * GHC/Core/Coercion/Axiom.hs <= types/CoAxiom.hs * GHC/Core/Coercion/Opt.hs <= types/OptCoercion.hs * GHC/Core/DataCon.hs <= basicTypes/DataCon.hs * GHC/Core/FamInstEnv.hs <= types/FamInstEnv.hs * GHC/Core/Lint.hs <= coreSyn/CoreLint.hs * GHC/Core/Subst.hs <= coreSyn/CoreSubst.hs * GHC/Core/TyCo/Rep.hs <= types/TyCoRep.hs * GHC/Core/TyCon.hs <= types/TyCon.hs * GHC/Core/Type.hs <= types/Type.hs * GHC/Core/Unify.hs <= types/Unify.hs * GHC/Types/Literal.hs <= basicTypes/Literal.hs * GHC/Types/Var.hs <= basicTypes/Var.hs [1]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular [skip ci] - - - - - 04750304 by Ben Gamari at 2020-05-27T00:14:33-04:00 eventlog: Fix racy flushing Previously no attempt was made to avoid multiple threads writing their capability-local eventlog buffers to the eventlog writer simultaneously. This could result in multiple eventlog streams being interleaved. Fix this by documenting that the EventLogWriter's write() and flush() functions may be called reentrantly and fix the default writer to protect its FILE* by a mutex. Fixes #18210. - - - - - d6203f24 by Joshua Price at 2020-05-27T00:15:17-04:00 Make `identifier` parse unparenthesized `->` (#18060) - - - - - 28deee28 by Ben Gamari at 2020-05-28T16:23:21-04:00 GHC.Core.Unfold: Refactor traceInline This reduces duplication as well as fixes a bug wherein -dinlining-check would override -ddump-inlinings. Moreover, the new variant - - - - - 1f393e1e by Ben Gamari at 2020-05-28T16:23:21-04:00 Avoid unnecessary allocations due to tracing utilities While ticky-profiling the typechecker I noticed that hundreds of millions of SDocs are being allocated just in case -ddump-*-trace is enabled. This is awful. We avoid this by ensuring that the dump flag check is inlined into the call site, ensuring that the tracing document needn't be allocated unless it's actually needed. See Note [INLINE conditional tracing utilities] for details. Fixes #18168. Metric Decrease: T9961 haddock.Cabal haddock.base haddock.compiler - - - - - 5f621a78 by Vladislav Zavialov at 2020-05-28T16:23:58-04:00 Add Semigroup/Monoid for Q (#18123) - - - - - dc5f004c by Xavier Denis at 2020-05-28T16:24:37-04:00 Fix #18071 Run the core linter on candidate instances to ensure they are well-kinded. Better handle quantified constraints by using a CtWanted to avoid having unsolved constraints thrown away at the end by the solver. - - - - - 10e6982c by Sebastian Graf at 2020-05-28T16:25:14-04:00 FloatOut: Only eta-expand dead-end RHS if arity will increase (#18231) Otherwise we risk turning trivial RHS into non-trivial RHS, introducing unnecessary bindings in the next Simplifier run, resulting in more churn. Fixes #18231. - - - - - 08dab5f7 by Sebastian Graf at 2020-05-28T16:25:14-04:00 DmdAnal: Recognise precise exceptions from case alternatives (#18086) Consider ```hs m :: IO () m = do putStrLn "foo" error "bar" ``` `m` (from #18086) always throws a (precise or imprecise) exception or diverges. Yet demand analysis infers `<L,A>` as demand signature instead of `<L,A>x` for it. That's because the demand analyser sees `putStrLn` occuring in a case scrutinee and decides that it has to `deferAfterPreciseException`, because `putStrLn` throws a precise exception on some control flow paths. This will mask the `botDiv` `Divergence`of the single case alt containing `error` to `topDiv`. Since `putStrLn` has `topDiv` itself, the final `Divergence` is `topDiv`. This is easily fixed: `deferAfterPreciseException` works by `lub`ing with the demand type of a virtual case branch denoting the precise exceptional control flow. We used `nopDmdType` before, but we can be more precise and use `exnDmdType`, which is `nopDmdType` with `exnDiv`. Now the `Divergence` from the case alt will degrade `botDiv` to `exnDiv` instead of `topDiv`, which combines with the result from the scrutinee to `exnDiv`, and all is well. Fixes #18086. - - - - - aef95f11 by Ben Gamari at 2020-05-28T16:25:53-04:00 Ticky-ticky: Record DataCon name in ticker name This makes it significantly easier to spot the nature of allocations regressions and comes at a reasonably low cost. - - - - - 8f021b8c by Ben Gamari at 2020-05-28T16:26:34-04:00 hadrian: Don't track GHC's verbosity argument Teach hadrian to ignore GHC's -v argument in its recompilation check, thus fixing #18131. - - - - - 13d9380b by Ben Gamari at 2020-05-28T16:27:20-04:00 Rip out CmmStackInfo(updfr_space) As noted in #18232, this field is currently completely unused and moreover doesn't have a clear meaning. - - - - - f10d11fa by Andreas Klebinger at 2020-05-29T01:38:42-04:00 Fix "build/elem" RULE. An redundant constraint prevented the rule from matching. Fixing this allows a call to elem on a known list to be translated into a series of equality checks, and eventually a simple case expression. Surprisingly this seems to regress elem for strings. To avoid this we now also allow foldrCString to inline and add an UTF8 variant. This results in elem being compiled to a tight non-allocating loop over the primitive string literal which performs a linear search. In the process this commit adds UTF8 variants for some of the functions in GHC.CString. This is required to make this work for both ASCII and UTF8 strings. There are also small tweaks to the CString related rules. We now allow ourselfes the luxury to compare the folding function via eqExpr, which helps to ensure the rule fires before we inline foldrCString*. Together with a few changes to allow matching on both the UTF8 and ASCII variants of the CString functions. - - - - - bbeb2389 by Ben Gamari at 2020-05-29T01:39:19-04:00 CoreToStg: Add Outputable ArgInfo instance - - - - - 0e3361ca by Simon Peyton Jones at 2020-05-29T01:39:19-04:00 Make Lint check return type of a join point Consider join x = rhs in body It's important that the type of 'rhs' is the same as the type of 'body', but Lint wasn't checking that invariant. Now it does! This was exposed by investigation into !3113. - - - - - c49f7df0 by Simon Peyton Jones at 2020-05-29T01:39:19-04:00 Do not float join points in exprIsConApp_maybe We hvae been making exprIsConApp_maybe cleverer in recent times: commit b78cc64e923716ac0512c299f42d4d0012306c05 Date: Thu Nov 15 17:14:31 2018 +0100 Make constructor wrappers inline only during the final phase commit 7833cf407d1f608bebb1d38bb99d3035d8d735e6 Date: Thu Jan 24 17:58:50 2019 +0100 Look through newtype wrappers (Trac #16254) commit c25b135ff5b9c69a90df0ccf51b04952c2dc6ee1 Date: Thu Feb 21 12:03:22 2019 +0000 Fix exprIsConApp_maybe But alas there was still a bug, now immortalised in Note [Don't float join points] in SimpleOpt. It's quite hard to trigger because it requires a dead join point, but it came up when compiling Cabal Cabal.Distribution.Fields.Lexer.hs, when working on !3113. Happily, the fix is extremly easy. Finding the bug was not so easy. - - - - - 46720997 by Ben Gamari at 2020-05-29T01:39:19-04:00 Allow simplification through runRW# Because runRW# inlines so late, we were previously able to do very little simplification across it. For instance, given even a simple program like case runRW# (\s -> let n = I# 42# in n) of I# n# -> f n# we previously had no way to avoid the allocation of the I#. This patch allows the simplifier to push strict contexts into the continuation of a runRW# application, as explained in in Note [Simplification of runRW#] in GHC.CoreToStg.Prep. Fixes #15127. Metric Increase: T9961 Metric Decrease: ManyConstructors Co-Authored-By: Simon Peyton-Jone <simonpj at microsoft.com> - - - - - 277c2f26 by Ben Gamari at 2020-05-29T01:39:55-04:00 Eta expand un-saturated primops Now since we no longer try to predict CAFfyness we have no need for the solution to #16846. Eta expanding unsaturated primop applications is conceptually simpler, especially in the presence of levity polymorphism. This essentially reverts cac8dc9f51e31e4c0a6cd9bc302f7e1bc7c03beb, as suggested in #18079. Closes #18079. - - - - - f44d7ae0 by Simon Jakobi at 2020-05-29T01:40:34-04:00 base: Scrap deprecation plan for Data.Monoid.{First,Last} See the discussion on the libraries mailing list for context: https://mail.haskell.org/pipermail/libraries/2020-April/030357.html - - - - - 8b494895 by Jeremy Schlatter at 2020-05-29T01:41:12-04:00 Fix typo in documentation - - - - - 998450f4 by Gleb Popov at 2020-05-29T01:41:53-04:00 Always define USE_PTHREAD_FOR_ITIMER for FreeBSD. - - - - - f9a513e0 by Alp Mestanogullari at 2020-05-29T01:42:36-04:00 hadrian: introduce 'install' target Its logic is very simple. It `need`s the `binary-dist-dir` target and runs suitable `configure` and `make install` commands for the user. A new `--prefix` command line argument is introduced to specify where GHC should be installed. - - - - - 67738db1 by Travis Whitaker at 2020-05-29T13:34:48-04:00 Build a threaded stage 1 if the bootstrapping GHC supports it. - - - - - aac19e6c by Peter Trommler at 2020-05-29T13:35:24-04:00 PPC NCG: No per-symbol .section ".toc" directives All position independent symbols are collected during code generation and emitted in one go. Prepending each symbol with a .section ".toc" directive is redundant. This patch drops the per-symbol directives leading to smaller assembler files. Fixes #18250 - - - - - 4413828b by Ben Gamari at 2020-05-30T06:07:31-04:00 rts: Teach getNumProcessors to return available processors Previously we would report the number of physical processors, which can be quite wrong in a containerized setting. Now we rather return how many processors are in our affinity mask when possible. I also refactored the code to prefer platform-specific since this will report logical CPUs instead of physical (using `machdep.cpu.thread_count` on Darwin and `cpuset_getaffinity` on FreeBSD). Fixes #14781. - - - - - 1449435c by Ben Gamari at 2020-05-30T06:07:31-04:00 users-guide: Note change in getNumProcessors in users guide - - - - - 3d960169 by Ben Gamari at 2020-05-30T06:07:31-04:00 rts: Drop compatibility shims for Windows Vista We can now assume that the thread and processor group interfaces are available. - - - - - 7f8f948c by Peter Trommler at 2020-05-30T06:08:07-04:00 PPC NCG: Fix .size directive on powerpc64 ELF v1 Thanks to Sergei Trofimovich for pointing out the issue. Fixes #18237 - - - - - 7c555b05 by Andreas Klebinger at 2020-05-30T06:08:43-04:00 Optimize GHC.Utils.Monad. Many functions in this module are recursive and as such are marked loop breakers. Which means they are unlikely to get an unfolding. This is *bad*. We always want to specialize them to specific Monads. Which requires a visible unfolding at the use site. I rewrote the recursive ones from: foo f x = ... foo x' ... to foo f x = go x where go x = ... As well as giving some pragmas to make all of them available for specialization. The end result is a reduction of allocations of about -1.4% for nofib/spectral/simple/Main.hs when compiled with `-O`. ------------------------- Metric Decrease: T12425 T14683 T5631 T9233 T9675 T9961 WWRec ------------------------- - - - - - 8b1cb5df by Ben Gamari at 2020-05-30T06:09:20-04:00 Windows: Bump Windows toolchain to 0.2 - - - - - 6947231a by Zubin Duggal at 2020-05-30T06:10:02-04:00 Simplify contexts in GHC.Iface.Ext.Ast - - - - - 2ee4f36c by Daniel Gröber at 2020-06-01T06:32:56-04:00 Cleanup OVERWRITING_CLOSURE logic The code is just more confusing than it needs to be. We don't need to mix the threaded check with the ldv profiling check since ldv's init already checks for this. Hence they can be two separate checks. Taking the sanity checking into account is also cleaner via DebugFlags.sanity. No need for checking the DEBUG define. The ZERO_SLOP_FOR_LDV_PROF and ZERO_SLOP_FOR_SANITY_CHECK definitions the old code had also make things a lot more opaque IMO so I removed those. - - - - - 6159559b by Daniel Gröber at 2020-06-01T06:32:56-04:00 Fix OVERWRITING_CLOSURE assuming closures are not inherently used The new ASSERT in LDV_recordDead() was being tripped up by MVars when removeFromMVarBlockedQueue() calls OVERWRITING_CLOSURE() via OVERWRITE_INFO(). - - - - - 38992085 by Daniel Gröber at 2020-06-01T06:32:56-04:00 Always zero shrunk mutable array slop when profiling When shrinking arrays in the profiling way we currently don't always zero the leftover slop. This means we can't traverse such closures in the heap profiler. The old Note [zeroing slop] and #8402 have some rationale for why this is so but I belive the reasoning doesn't apply to mutable closures. There users already have to ensure multiple threads don't step on each other's toes so zeroing should be safe. - - - - - b0c1f2a6 by Ben Gamari at 2020-06-01T06:33:37-04:00 testsuite: Add test for #18151 - - - - - 9a99a178 by Ben Gamari at 2020-06-01T06:33:37-04:00 testsuite: Add test for desugaring of PostfixOperators - - - - - 2b89ca5b by Ben Gamari at 2020-06-01T06:33:37-04:00 HsToCore: Eta expand left sections Strangely, the comment next to this code already alluded to the fact that even simply eta-expanding will sacrifice laziness. It's quite unclear how we regressed so far. See #18151. - - - - - d412d7a3 by Kirill Elagin at 2020-06-01T06:34:21-04:00 Winferred-safe-imports: Do not exit with error Currently, when -Winferred-safe-imports is enabled, even when it is not turned into an error, the compiler will still exit with exit code 1 if this warning was emitted. Make sure it is really treated as a warning. - - - - - f945eea5 by Ben Gamari at 2020-06-01T06:34:58-04:00 nonmoving: Optimise log2_ceil - - - - - aab606e4 by Bodigrim at 2020-06-01T06:35:36-04:00 Clarify description of fromListN - - - - - 7e5220e2 by Bodigrim at 2020-06-01T06:35:36-04:00 Apply suggestion to libraries/base/GHC/Exts.hs - - - - - f3fb1ce9 by fendor at 2020-06-01T06:36:18-04:00 Add `isInScope` check to `lintCoercion` Mirrors the behaviour of `lintType`. - - - - - 5ac4d946 by fendor at 2020-06-01T06:36:18-04:00 Lint rhs of IfaceRule - - - - - 1cef6126 by Jeremy Schlatter at 2020-06-01T06:37:00-04:00 Fix wording in documentation The duplicate "orphan instance" phrase here doesn't make sense, and was probably an accident. - - - - - 5aaf08f2 by Takenobu Tani at 2020-06-01T06:37:43-04:00 configure: Modify aclocal.m4 according to new module hierarchy This patch updates file paths according to new module hierarchy [1]: * Rename: * compiler/GHC/Parser.hs <= compiler/parser/Parser.hs * compiler/GHC/Parser/Lexer.hs <= compiler/Parser/Lexer.hs * Add: * compiler/GHC/Cmm/Lexer.hs [1]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular - - - - - 15857ad8 by Ben Gamari at 2020-06-01T06:38:26-04:00 testsuite: Don't fail if we can't unlink __symlink_test Afterall, it's possible we were unable to create it due to lack of symlink permission. - - - - - 4a7229ef by Ben Gamari at 2020-06-01T06:38:26-04:00 testsuite: Refactor ghostscript detection Tamar reported that he saw crashes due to unhandled exceptions. - - - - - 2ab37eaf by Ben Gamari at 2020-06-01T06:38:26-04:00 testsuite/perf_notes: Fix ill-typed assignments - - - - - e45d5b66 by Ben Gamari at 2020-06-01T06:38:26-04:00 testsuite/testutil: Fix bytes/str mismatch - - - - - 7002d0cb by Ben Gamari at 2020-06-01T06:38:26-04:00 testsuite: Work around spurious mypy failure - - - - - 11390e3a by Takenobu Tani at 2020-06-01T06:39:05-04:00 Clean up file paths for new module hierarchy This updates comments only. This patch replaces file references according to new module hierarchy. See also: * https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular * https://gitlab.haskell.org/ghc/ghc/issues/13009 - - - - - 8f2e5732 by Takenobu Tani at 2020-06-01T06:39:05-04:00 Modify file paths to module paths for new module hierarchy This updates comments only. This patch replaces module references according to new module hierarchy [1][2]. For files under the `compiler/` directory, I replace them as module paths instead of file paths. For instance, `GHC.Unit.State` instead of `compiler/GHC/Unit/State.hs` [3]. For current and future haddock's markup, this patch encloses the module name with "" [4]. [1]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular [2]: https://gitlab.haskell.org/ghc/ghc/issues/13009 [3]: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3375#note_276613 [4]: https://haskell-haddock.readthedocs.io/en/latest/markup.html#linking-to-modules - - - - - 68b71c4a by Tom Ellis at 2020-06-01T06:39:55-04:00 Rename the singleton tuple GHC.Tuple.Unit to GHC.Tuple.Solo - - - - - 95da76c2 by Sylvain Henry at 2020-06-01T06:40:41-04:00 Hadrian: fix binary-dist target for cross-compilation - - - - - 730fcd54 by Vladislav Zavialov at 2020-06-01T06:41:18-04:00 Improve parser error messages for the @-operator Since GHC diverges from the Haskell Report by allowing the user to define (@) as an infix operator, we better give a good error message when the user does so unintentionally. In general, this is rather hard to do, as some failures will be discovered only in the renamer or the type checker: x :: (Integer, Integer) x @ (a, b) = (1, 2) This patch does *not* address this general case. However, it gives much better error messages when the binding is not syntactically valid: pairs xs @ (_:xs') = zip xs xs' Before this patch, the error message was rather puzzling: <interactive>:1:1: error: Parse error in pattern: pairs After this patch, the error message includes a hint: <interactive>:1:1: error: Parse error in pattern: pairs In a function binding for the ‘@’ operator. Perhaps you meant an as-pattern, which must not be surrounded by whitespace - - - - - 0fde5377 by Vladislav Zavialov at 2020-06-01T06:41:18-04:00 Improve parser error messages for TypeApplications With this patch, we always parse f @t as a type application, thereby producing better error messages. This steals two syntactic forms: * Prefix form of the @-operator in expressions. Since the @-operator is a divergence from the Haskell Report anyway, this is not a major loss. * Prefix form of @-patterns. Since we are stealing loose infix form anyway, might as well sacrifice the prefix form for the sake of much better error messages. - - - - - c68e7e1e by Vladislav Zavialov at 2020-06-01T06:41:18-04:00 Improve parser error messages for TemplateHaskellQuotes While [e| |], [t| |], [d| |], and so on, steal syntax from list comprehensions, [| |] and [|| ||] do not steal any syntax. Thus we can improve error messages by always accepting them in the lexer. Turns out the renamer already performs necessary validation. - - - - - 120aedbd by Ben Gamari at 2020-06-01T16:07:02-04:00 gitlab-ci: Disable use of ld.lld on ARMv7 It turns out that lld non-deterministically fails on ARMv7. I suspect this may be due to the a kernel regression as this only started happening when we upgraded to 5.4. Nevertheless, easily avoided by simply sticking with gold. Works around #18280. - - - - - d6279ff0 by Ben Gamari at 2020-06-02T13:03:30-04:00 gitlab-ci: Ensure that workaround for #18280 applies to bindisttest We need to ensure that the `configure` flags working around #18280 are propagated to the bindisttest `configure` as well. - - - - - cb5c31b5 by Ben Gamari at 2020-06-03T17:55:04-04:00 gitlab-ci: Allow ARMv7 job to fail Due to #18298. - - - - - 32a4ae90 by John Ericson at 2020-06-04T04:34:42-04:00 Clean up boot vs non-boot disambiguating types We often have (ModuleName, Bool) or (Module, Bool) pairs for "extended" module names (without or with a unit id) disambiguating boot and normal modules. We think this is important enough across the compiler that it deserves a new nominal product type. We do this with synnoyms and a functor named with a `Gen` prefix, matching other newly created definitions. It was also requested that we keep custom `IsBoot` / `NotBoot` sum type. So we have it too. This means changing many the many bools to use that instead. Updates `haddock` submodule. - - - - - c05756cd by Niklas Hambüchen at 2020-06-04T04:35:24-04:00 docs: Add more details on InterruptibleFFI. Details from https://gitlab.haskell.org/ghc/ghc/issues/8684 and https://github.com/takano-akio/filelock/pull/7#discussion_r280332430 - - - - - 1b975aed by Andrew Martin at 2020-06-04T04:36:03-04:00 Allow finalizeForeignPtr to be called on FinalPtr/PlainPtr. MR 2165 (commit 49301ad6226d9a83d110bee8c419615dd94f5ded) regressed finalizeForeignPtr by throwing exceptions when PlainPtr was encounterd. This regression did not make it into a release of GHC. Here, the original behavior is restored, and FinalPtr is given the same treatment as PlainPtr. - - - - - 2bd3929a by Luke Lau at 2020-06-04T04:36:41-04:00 Fix documentation on type families not being extracted It looks like the location of the Names used for CoAxioms on type families are now located at their type constructors. Previously, Docs.hs thought the Names were located in the RHS, so the RealSrcSpan in the instanceMap and getInstLoc didn't match up. Fixes #18241 - - - - - 6735b9d9 by Ben Gamari at 2020-06-04T04:37:21-04:00 GHC.Hs.Instances: Compile with -O0 This module contains exclusively Data instances, which are going to be slow no matter what we do. Furthermore, they are incredibly slow to compile with optimisation (see #9557). Consequently we compile this with -O0. See #18254. - - - - - c330331a by nineonine at 2020-06-04T04:37:59-04:00 Add test for #17669 - - - - - cab684f0 by Ben Gamari at 2020-06-04T04:38:36-04:00 rts: Add Windows-specific implementation of rtsSleep Previously we would use the POSIX path, which uses `nanosleep`. However, it turns out that `nanosleep` is provided by `libpthread` on Windows. In general we don't want to incur such a dependency. Avoid this by simply using `Sleep` on Windows. Fixes #18272. - - - - - ad44b504 by Ben Gamari at 2020-06-04T04:38:36-04:00 compiler: Disable use of process jobs with process < 1.6.9 Due to #17926. - - - - - 6a4098a4 by Moritz Angermann at 2020-06-04T04:55:51-04:00 [linker] Adds void printLoadedObjects(void); This allows us to dump in-memory object code locations for debugging. Fixup printLoadedObjects prototype - - - - - af5e3a88 by Artem Pelenitsyn at 2020-06-05T03:18:49-04:00 base: fix sign confusion in log1mexp implementation (fix #17125) author: claude (https://gitlab.haskell.org/trac-claude) The correct threshold for log1mexp is -(log 2) with the current specification of log1mexp. This change improves accuracy for large negative inputs. To avoid code duplication, a small helper function is added; it isn't the default implementation in Floating because it needs Ord. This patch does nothing to address that the Haskell specification is different from that in common use in other languages. - - - - - 2b792fac by Simon Peyton Jones at 2020-06-05T09:27:50-04:00 Simple subsumption This patch simplifies GHC to use simple subsumption. Ticket #17775 Implements GHC proposal #287 https://github.com/ghc-proposals/ghc-proposals/blob/master/ proposals/0287-simplify-subsumption.rst All the motivation is described there; I will not repeat it here. The implementation payload: * tcSubType and friends become noticably simpler, because it no longer uses eta-expansion when checking subsumption. * No deeplyInstantiate or deeplySkolemise That in turn means that some tests fail, by design; they can all be fixed by eta expansion. There is a list of such changes below. Implementing the patch led me into a variety of sticky corners, so the patch includes several othe changes, some quite significant: * I made String wired-in, so that "foo" :: String rather than "foo" :: [Char] This improves error messages, and fixes #15679 * The pattern match checker relies on knowing about in-scope equality constraints, andd adds them to the desugarer's environment using addTyCsDs. But the co_fn in a FunBind was missed, and for some reason simple-subsumption ends up with dictionaries there. So I added a call to addTyCsDs. This is really part of #18049. * I moved the ic_telescope field out of Implication and into ForAllSkol instead. This is a nice win; just expresses the code much better. * There was a bug in GHC.Tc.TyCl.Instance.tcDataFamInstHeader. We called checkDataKindSig inside tc_kind_sig, /before/ solveEqualities and zonking. Obviously wrong, easily fixed. * solveLocalEqualitiesX: there was a whole mess in here, around failing fast enough. I discovered a bad latent bug where we could successfully kind-check a type signature, and use it, but have unsolved constraints that could fill in coercion holes in that signature -- aargh. It's all explained in Note [Failure in local type signatures] in GHC.Tc.Solver. Much better now. * I fixed a serious bug in anonymous type holes. IN f :: Int -> (forall a. a -> _) -> Int that "_" should be a unification variable at the /outer/ level; it cannot be instantiated to 'a'. This was plain wrong. New fields mode_lvl and mode_holes in TcTyMode, and auxiliary data type GHC.Tc.Gen.HsType.HoleMode. This fixes #16292, but makes no progress towards the more ambitious #16082 * I got sucked into an enormous refactoring of the reporting of equality errors in GHC.Tc.Errors, especially in mkEqErr1 mkTyVarEqErr misMatchMsg misMatchMsgOrCND In particular, the very tricky mkExpectedActualMsg function is gone. It took me a full day. But the result is far easier to understand. (Still not easy!) This led to various minor improvements in error output, and an enormous number of test-case error wibbles. One particular point: for occurs-check errors I now just say Can't match 'a' against '[a]' rather than using the intimidating language of "occurs check". * Pretty-printing AbsBinds Tests review * Eta expansions T11305: one eta expansion T12082: one eta expansion (undefined) T13585a: one eta expansion T3102: one eta expansion T3692: two eta expansions (tricky) T2239: two eta expansions T16473: one eta determ004: two eta expansions (undefined) annfail06: two eta (undefined) T17923: four eta expansions (a strange program indeed!) tcrun035: one eta expansion * Ambiguity check at higher rank. Now that we have simple subsumption, a type like f :: (forall a. Eq a => Int) -> Int is no longer ambiguous, because we could write g :: (forall a. Eq a => Int) -> Int g = f and it'd typecheck just fine. But f's type is a bit suspicious, and we might want to consider making the ambiguity check do a check on each sub-term. Meanwhile, these tests are accepted, whereas they were previously rejected as ambiguous: T7220a T15438 T10503 T9222 * Some more interesting error message wibbles T13381: Fine: one error (Int ~ Exp Int) rather than two (Int ~ Exp Int, Exp Int ~ Int) T9834: Small change in error (improvement) T10619: Improved T2414: Small change, due to order of unification, fine T2534: A very simple case in which a change of unification order means we get tow unsolved constraints instead of one tc211: bizarre impredicative tests; just accept this for now Updates Cabal and haddock submodules. Metric Increase: T12150 T12234 T5837 haddock.base Metric Decrease: haddock.compiler haddock.Cabal haddock.base Merge note: This appears to break the `UnliftedNewtypesDifficultUnification` test. It has been marked as broken in the interest of merging. (cherry picked from commit 66b7b195cb3dce93ed5078b80bf568efae904cc5) - - - - - 2dff8141 by Ryan Scott at 2020-06-05T14:21:24-04:00 Simplify bindLHsTyVarBndrs and bindHsQTyVars Both `bindLHsTyVarBndrs` and `bindHsQTyVars` take two separate `Maybe` arguments, which I find terribly confusing. Thankfully, it's possible to remove one `Maybe` argument from each of these functions, which this patch accomplishes: * `bindHsQTyVars` takes a `Maybe SDoc` argument, which is `Just` if GHC should warn about any of the quantified type variables going unused. However, every call site uses `Nothing` in practice. This makes sense, since it doesn't really make sense to warn about unused type variables bound by an `LHsQTyVars`. For instance, you wouldn't warn about the `a` in `data Proxy a = Proxy` going unused. As a result, I simply remove this `Maybe SDoc` argument altogether. * `bindLHsTyVarBndrs` also takes a `Maybe SDoc` argument for the same reasons that `bindHsQTyVars` took one. To make things more confusing, however, `bindLHsTyVarBndrs` also takes a separate `HsDocContext` argument, which is pretty-printed (to an `SDoc`) in warnings and error messages. In practice, the `Maybe SDoc` and the `HsDocContext` often contain the same text. See the call sites for `bindLHsTyVarBndrs` in `rnFamInstEqn` and `rnConDecl`, for instance. There are only a handful of call sites where the text differs between the `Maybe SDoc` and `HsDocContext` arguments: * In `rnHsRuleDecl`, where the `Maybe SDoc` says "`In the rule`" and the `HsDocContext` says "`In the transformation rule`". * In `rnHsTyKi`/`rn_ty`, where the `Maybe SDoc` says "`In the type`" but the `HsDocContext` is inhereted from the surrounding context (e.g., if `rnHsTyKi` were called on a top-level type signature, the `HsDocContext` would be "`In the type signature`" instead) In both cases, warnings/error messages arguably _improve_ by unifying making the `Maybe SDoc`'s text match that of the `HsDocContext`. As a result, I decided to remove the `Maybe SDoc` argument to `bindLHsTyVarBndrs` entirely and simply reuse the text from the `HsDocContext`. (I decided to change the phrase "transformation rule" to "rewrite rule" while I was in the area.) The `Maybe SDoc` argument has one other purpose: signaling when to emit "`Unused quantified type variable`" warnings. To recover this functionality, I replaced the `Maybe SDoc` argument with a boolean-like `WarnUnusedForalls` argument. The only `bindLHsTyVarBndrs` call site that chooses _not_ to emit these warnings in `bindHsQTyVars`. - - - - - e372331b by Ben Gamari at 2020-06-07T08:46:41-04:00 hadrian: Add missing deriveConstants dependency on ghcplatform.h deriveConstants wants to compile C sources which #include PosixSource.h, which itself #includes ghcplatform.h. Make sure that Hadrian knows about this dependency. Fixes #18290. - - - - - b022051a by Moritz Angermann at 2020-06-07T08:46:42-04:00 ghc-prim needs to depend on libc and libm libm is just an empty shell on musl, and all the math functions are contained in libc. - - - - - 6dae6548 by Moritz Angermann at 2020-06-07T08:46:42-04:00 Disable DLL loading if without system linker Some platforms (musl, aarch64) do not have a working dynamic linker implemented in the libc, even though we might see dlopen. It will ultimately just return that this is not supported. Hence we'll add a flag to the compiler to flat our disable loading dlls. This is needed as we will otherwise try to load the shared library even if this will subsequently fail. At that point we have given up looking for static options though. - - - - - 4a158ffc by Moritz Angermann at 2020-06-07T08:46:43-04:00 Range is actually +/-2^32, not +/-2^31 See also: https://static.docs.arm.com/ihi0056/g/aaelf64.pdf - - - - - f1bfb806 by Ben Gamari at 2020-06-07T10:49:30-04:00 OccurAnal: Avoid exponential behavior due to where clauses Previously the `Var` case of `occAnalApp` could in some cases (namely in the case of `runRW#` applications) call `occAnalRhs` two. In the case of nested `runRW#`s this results in exponential complexity. In some cases the compilation time that resulted would be very long indeed (see #18296). Fixes #18296. Metric Decrease: T9961 T12150 T12234 - - - - - 9b607671 by Takenobu Tani at 2020-06-09T08:05:46-04:00 Add link to GHC's wiki in the GHC API header This adds a URL to point to GHC's wiki in the GHC API header. Newcomers could easily find more information from the GHC API's web like [1]. [1]: Current version, https://ghc.gitlab.haskell.org/ghc/doc/libraries/ghc-8.11.0.20200604/index.html [skip ci] - - - - - 72c7fe9a by Ryan Scott at 2020-06-09T08:06:24-04:00 Make GADT constructors adhere to the forall-or-nothing rule properly Issue #18191 revealed that the types of GADT constructors don't quite adhere to the `forall`-or-nothing rule. This patch serves to clean up this sad state of affairs somewhat. The main change is not in the code itself, but in the documentation, as this patch introduces two sections to the GHC User's Guide: * A "Formal syntax for GADTs" section that presents a BNF-style grammar for what is and isn't allowed in GADT constructor types. This mostly exists to codify GHC's existing behavior, but it also imposes a new restriction that addresses #18191: the outermost `forall` and/or context in a GADT constructor is not allowed to be surrounded by parentheses. Doing so would make these `forall`s/contexts nested, and GADTs do not support nested `forall`s/contexts at present. * A "`forall`-or-nothing rule" section that describes exactly what the `forall`-or-nothing rule is all about. Surprisingly, there was no mention of this anywhere in the User's Guide up until now! To adhere the new specification in the "Formal syntax for GADTs" section of the User's Guide, the following code changes were made: * A new function, `GHC.Hs.Type.splitLHsGADTPrefixTy`, was introduced. This is very much like `splitLHsSigmaTy`, except that it avoids splitting apart any parentheses, which can be syntactically significant for GADT types. See `Note [No nested foralls or contexts in GADT constructors]` in `GHC.Hs.Type`. * `ConDeclGADTPrefixPs`, an extension constructor for `XConDecl`, was introduced so that `GHC.Parser.PostProcess.mkGadtDecl` can return it when given a prefix GADT constructor. Unlike `ConDeclGADT`, `ConDeclGADTPrefixPs` does not split the GADT type into its argument and result types, as this cannot be done until after the type is renamed (see `Note [GADT abstract syntax]` in `GHC.Hs.Decls` for why this is the case). * `GHC.Renamer.Module.rnConDecl` now has an additional case for `ConDeclGADTPrefixPs` that (1) splits apart the full `LHsType` into its `forall`s, context, argument types, and result type, and (2) checks for nested `forall`s/contexts. Step (2) used to be performed the typechecker (in `GHC.Tc.TyCl.badDataConTyCon`) rather than the renamer, but now the relevant code from the typechecker can simply be deleted. One nice side effect of this change is that we are able to give a more accurate error message for GADT constructors that use visible dependent quantification (e.g., `MkFoo :: forall a -> a -> Foo a`), which improves the stderr in the `T16326_Fail6` test case. Fixes #18191. Bumps the Haddock submodule. - - - - - a47e6442 by Ryan Scott at 2020-06-10T03:39:12-04:00 Always use rnImplicitBndrs to bring implicit tyvars into scope This implements a first step towards #16762 by changing the renamer to always use `rnImplicitBndrs` to bring implicitly bound type variables into scope. The main change is in `rnFamInstEqn` and `bindHsQTyVars`, which previously used _ad hoc_ methods of binding their implicit tyvars. There are a number of knock-on consequences: * One of the reasons that `rnFamInstEqn` used an _ad hoc_ binding mechanism was to give more precise source locations in `-Wunused-type-patterns` warnings. (See https://gitlab.haskell.org/ghc/ghc/issues/16762#note_273343 for an example of this.) However, these warnings are actually a little _too_ precise, since implicitly bound type variables don't have exact binding sites like explicitly bound type variables do. A similar problem existed for "`Different names for the same type variable`" errors involving implicit tyvars bound by `bindHsQTyVars`. Therefore, we simply accept the less precise (but more accurate) source locations from `rnImplicitBndrs` in `rnFamInstEqn` and `bindHsQTyVars`. See `Note [Source locations for implicitly bound type variables]` in `GHC.Rename.HsType` for the full story. * In order for `rnImplicitBndrs` to work in `rnFamInstEqn`, it needs to be able to look up names from the parent class (in the event that we are renaming an associated type family instance). As a result, `rnImplicitBndrs` now takes an argument of type `Maybe assoc`, which is `Just` in the event that a type family instance is associated with a class. * Previously, GHC kept track of three type synonyms for free type variables in the renamer: `FreeKiTyVars`, `FreeKiTyVarsDups` (which are allowed to contain duplicates), and `FreeKiTyVarsNoDups` (which contain no duplicates). However, making is a distinction between `-Dups` and `-NoDups` is now pointless, as all code that returns `FreeKiTyVars{,Dups,NoDups}` will eventually end up being passed to `rnImplicitBndrs`, which removes duplicates. As a result, I decided to just get rid of `FreeKiTyVarsDups` and `FreeKiTyVarsNoDups`, leaving only `FreeKiTyVars`. * The `bindLRdrNames` and `deleteBys` functions are now dead code, so I took the liberty of removing them. - - - - - 24879129 by Takenobu Tani at 2020-06-10T03:39:59-04:00 Clarify leaf module names for new module hierarchy This updates comments only. This patch replaces leaf module names according to new module hierarchy [1][2] as followings: * Expand leaf names to easily find the module path: for instance, `Id.hs` to `GHC.Types.Id`. * Modify leaf names according to new module hierarchy: for instance, `Convert.hs` to `GHC.ThToHs`. * Fix typo: for instance, `GHC.Core.TyCo.Rep.hs` to `GHC.Core.TyCo.Rep` See also !3375 [1]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular [2]: https://gitlab.haskell.org/ghc/ghc/issues/13009 - - - - - 92de9e25 by Ömer Sinan Ağacan at 2020-06-10T03:41:07-04:00 rts: Remove unused GET_ENTRY closure macro This macro is not used and got broken in the meantime, as ENTRY_CODE was deleted. - - - - - 87102928 by Ömer Sinan Ağacan at 2020-06-10T03:41:50-04:00 Fix -fkeep-cafs flag name in users guide - - - - - ccd6843d by Shayne Fletcher at 2020-06-10T04:14:57-04:00 Expose impliedGFlags, impledOffGFlags, impliedXFlags - - - - - 7a737e89 by Ömer Sinan Ağacan at 2020-06-10T04:14:58-04:00 Cross-module LambdaFormInfo passing - Store LambdaFormInfos of exported Ids in interface files - Use them in importing modules This is for optimization purposes: if we know LambdaFormInfo of imported Ids we can generate more efficient calling code, see `getCallMethod`. Exporting (putting them in interface files or in ModDetails) and importing (reading them from interface files) are both optional. We don't assume known LambdaFormInfos anywhere and do not change how we call Ids with unknown LambdaFormInfos. Runtime, allocation, and residency numbers when building Cabal-the-library (commit 0d4ee7ba3): (Log and .hp files are in the MR: !2842) | | GHC HEAD | This patch | Diff | |-----|----------|------------|----------------| | -O0 | 0:35.89 | 0:34.10 | -1.78s, -4.98% | | -O1 | 2:24.01 | 2:23.62 | -0.39s, -0.27% | | -O2 | 2:52.23 | 2:51.35 | -0.88s, -0.51% | | | GHC HEAD | This patch | Diff | |-----|-----------------|-----------------|----------------------------| | -O0 | 54,843,608,416 | 54,878,769,544 | +35,161,128 bytes, +0.06% | | -O1 | 227,136,076,400 | 227,569,045,168 | +432,968,768 bytes, +0.19% | | -O2 | 266,147,063,296 | 266,749,643,440 | +602,580,144 bytes, +0.22% | NOTE: Residency is measured with extra runtime args: `-i0 -h` which effectively turn all GCs into major GCs, and do GC more often. | | GHC HEAD | This patch | Diff | |-----|----------------------------|------------------------------|----------------------------| | -O0 | 410,284,000 (910 samples) | 411,745,008 (906 samples) | +1,461,008 bytes, +0.35% | | -O1 | 928,580,856 (2109 samples) | 943,506,552 (2103 samples) | +14,925,696 bytes, +1.60% | | -O2 | 993,951,352 (2549 samples) | 1,010,156,328 (2545 samples) | +16,204,9760 bytes, +1.63% | NoFib results: -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- CS 0.0% 0.0% +0.0% +0.0% +0.0% CSD 0.0% 0.0% 0.0% +0.0% +0.0% FS 0.0% 0.0% +0.0% +0.0% +0.0% S 0.0% 0.0% +0.0% +0.0% +0.0% VS 0.0% 0.0% +0.0% +0.0% +0.0% VSD 0.0% 0.0% +0.0% +0.0% +0.1% VSM 0.0% 0.0% +0.0% +0.0% +0.0% anna 0.0% 0.0% -0.3% -0.8% -0.0% ansi 0.0% 0.0% -0.0% -0.0% 0.0% atom 0.0% 0.0% -0.0% -0.0% 0.0% awards 0.0% 0.0% -0.1% -0.3% 0.0% banner 0.0% 0.0% -0.0% -0.0% -0.0% bernouilli 0.0% 0.0% -0.0% -0.0% -0.0% binary-trees 0.0% 0.0% -0.0% -0.0% +0.0% boyer 0.0% 0.0% -0.0% -0.0% 0.0% boyer2 0.0% 0.0% -0.0% -0.0% 0.0% bspt 0.0% 0.0% -0.0% -0.2% 0.0% cacheprof 0.0% 0.0% -0.1% -0.4% +0.0% calendar 0.0% 0.0% -0.0% -0.0% 0.0% cichelli 0.0% 0.0% -0.9% -2.4% 0.0% circsim 0.0% 0.0% -0.0% -0.0% 0.0% clausify 0.0% 0.0% -0.1% -0.3% 0.0% comp_lab_zift 0.0% 0.0% -0.0% -0.0% +0.0% compress 0.0% 0.0% -0.0% -0.0% -0.0% compress2 0.0% 0.0% -0.0% -0.0% 0.0% constraints 0.0% 0.0% -0.1% -0.2% -0.0% cryptarithm1 0.0% 0.0% -0.0% -0.0% 0.0% cryptarithm2 0.0% 0.0% -1.4% -4.1% -0.0% cse 0.0% 0.0% -0.0% -0.0% -0.0% digits-of-e1 0.0% 0.0% -0.0% -0.0% -0.0% digits-of-e2 0.0% 0.0% -0.0% -0.0% -0.0% dom-lt 0.0% 0.0% -0.1% -0.2% 0.0% eliza 0.0% 0.0% -0.5% -1.5% 0.0% event 0.0% 0.0% -0.0% -0.0% -0.0% exact-reals 0.0% 0.0% -0.1% -0.3% +0.0% exp3_8 0.0% 0.0% -0.0% -0.0% -0.0% expert 0.0% 0.0% -0.3% -1.0% -0.0% fannkuch-redux 0.0% 0.0% +0.0% +0.0% +0.0% fasta 0.0% 0.0% -0.0% -0.0% +0.0% fem 0.0% 0.0% -0.0% -0.0% 0.0% fft 0.0% 0.0% -0.0% -0.0% 0.0% fft2 0.0% 0.0% -0.0% -0.0% 0.0% fibheaps 0.0% 0.0% -0.0% -0.0% +0.0% fish 0.0% 0.0% 0.0% -0.0% +0.0% fluid 0.0% 0.0% -0.4% -1.2% +0.0% fulsom 0.0% 0.0% -0.0% -0.0% 0.0% gamteb 0.0% 0.0% -0.1% -0.3% 0.0% gcd 0.0% 0.0% -0.0% -0.0% 0.0% gen_regexps 0.0% 0.0% -0.0% -0.0% -0.0% genfft 0.0% 0.0% -0.0% -0.0% 0.0% gg 0.0% 0.0% -0.0% -0.0% +0.0% grep 0.0% 0.0% -0.0% -0.0% -0.0% hidden 0.0% 0.0% -0.1% -0.4% -0.0% hpg 0.0% 0.0% -0.2% -0.5% +0.0% ida 0.0% 0.0% -0.0% -0.0% +0.0% infer 0.0% 0.0% -0.3% -0.8% -0.0% integer 0.0% 0.0% -0.0% -0.0% +0.0% integrate 0.0% 0.0% -0.0% -0.0% 0.0% k-nucleotide 0.0% 0.0% -0.0% -0.0% +0.0% kahan 0.0% 0.0% -0.0% -0.0% +0.0% knights 0.0% 0.0% -2.2% -5.4% 0.0% lambda 0.0% 0.0% -0.6% -1.8% 0.0% last-piece 0.0% 0.0% -0.0% -0.0% 0.0% lcss 0.0% 0.0% -0.0% -0.1% 0.0% life 0.0% 0.0% -0.0% -0.1% 0.0% lift 0.0% 0.0% -0.2% -0.6% +0.0% linear 0.0% 0.0% -0.0% -0.0% -0.0% listcompr 0.0% 0.0% -0.0% -0.0% 0.0% listcopy 0.0% 0.0% -0.0% -0.0% 0.0% maillist 0.0% 0.0% -0.1% -0.3% +0.0% mandel 0.0% 0.0% -0.0% -0.0% 0.0% mandel2 0.0% 0.0% -0.0% -0.0% -0.0% mate +0.0% 0.0% -0.0% -0.0% -0.0% minimax 0.0% 0.0% -0.2% -1.0% 0.0% mkhprog 0.0% 0.0% -0.1% -0.2% -0.0% multiplier 0.0% 0.0% -0.0% -0.0% -0.0% n-body 0.0% 0.0% -0.0% -0.0% +0.0% nucleic2 0.0% 0.0% -0.1% -0.2% 0.0% para 0.0% 0.0% -0.0% -0.0% -0.0% paraffins 0.0% 0.0% -0.0% -0.0% 0.0% parser 0.0% 0.0% -0.2% -0.7% 0.0% parstof 0.0% 0.0% -0.0% -0.0% +0.0% pic 0.0% 0.0% -0.0% -0.0% 0.0% pidigits 0.0% 0.0% +0.0% +0.0% +0.0% power 0.0% 0.0% -0.2% -0.6% +0.0% pretty 0.0% 0.0% -0.0% -0.0% -0.0% primes 0.0% 0.0% -0.0% -0.0% 0.0% primetest 0.0% 0.0% -0.0% -0.0% -0.0% prolog 0.0% 0.0% -0.3% -1.1% 0.0% puzzle 0.0% 0.0% -0.0% -0.0% 0.0% queens 0.0% 0.0% -0.0% -0.0% +0.0% reptile 0.0% 0.0% -0.0% -0.0% 0.0% reverse-complem 0.0% 0.0% -0.0% -0.0% +0.0% rewrite 0.0% 0.0% -0.7% -2.5% -0.0% rfib 0.0% 0.0% -0.0% -0.0% 0.0% rsa 0.0% 0.0% -0.0% -0.0% 0.0% scc 0.0% 0.0% -0.1% -0.2% -0.0% sched 0.0% 0.0% -0.0% -0.0% -0.0% scs 0.0% 0.0% -1.0% -2.6% +0.0% simple 0.0% 0.0% +0.0% -0.0% +0.0% solid 0.0% 0.0% -0.0% -0.0% 0.0% sorting 0.0% 0.0% -0.6% -1.6% 0.0% spectral-norm 0.0% 0.0% +0.0% 0.0% +0.0% sphere 0.0% 0.0% -0.0% -0.0% -0.0% symalg 0.0% 0.0% -0.0% -0.0% +0.0% tak 0.0% 0.0% -0.0% -0.0% 0.0% transform 0.0% 0.0% -0.0% -0.0% 0.0% treejoin 0.0% 0.0% -0.0% -0.0% 0.0% typecheck 0.0% 0.0% -0.0% -0.0% +0.0% veritas +0.0% 0.0% -0.2% -0.4% +0.0% wang 0.0% 0.0% -0.0% -0.0% 0.0% wave4main 0.0% 0.0% -0.0% -0.0% -0.0% wheel-sieve1 0.0% 0.0% -0.0% -0.0% -0.0% wheel-sieve2 0.0% 0.0% -0.0% -0.0% +0.0% x2n1 0.0% 0.0% -0.0% -0.0% -0.0% -------------------------------------------------------------------------------- Min 0.0% 0.0% -2.2% -5.4% -0.0% Max +0.0% 0.0% +0.0% +0.0% +0.1% Geometric Mean -0.0% -0.0% -0.1% -0.3% +0.0% Metric increases micro benchmarks tracked in #17686: Metric Increase: T12150 T12234 T12425 T13035 T5837 T6048 T9233 Co-authored-by: Andreas Klebinger <klebinger.andreas at gmx.at> - - - - - 3b22b14a by Shayne Fletcher at 2020-06-10T04:15:01-04:00 Give Language a Bounded instance - - - - - 9454511b by Simon Peyton Jones at 2020-06-10T04:17:06-04:00 Optimisation in Unique.Supply This patch switches on -fno-state-hack in GHC.Types.Unique.Supply. It turned out that my fixes for #18078 (coercion floating) changed the optimisation pathway for mkSplitUniqSupply in such a way that we had an extra allocation inside the inner loop. Adding -fno-state-hack fixed that -- and indeed the loop in mkSplitUniqSupply is a classic example of the way in which -fno-state-hack can be bad; see #18238. Moreover, the new code is better than the old. They allocate the same, but the old code ends up with a partial application. The net effect is that the test perf/should_run/UniqLoop runs 20% faster! From 2.5s down to 2.0s. The allocation numbers are the same -- but elapsed time falls. Good! The bad thing about this is that it's terribly delicate. But at least it's a good example of such delicacy in action. There is a long Note [Optimising the unique supply] which now explains all this. - - - - - 6d49d5be by Simon Peyton Jones at 2020-06-10T04:17:06-04:00 Implement cast worker/wrapper properly The cast worker/wrapper transformation transforms x = e |> co into y = e x = y |> co This is done by the simplifier, but we were being careless about transferring IdInfo from x to y, and about what to do if x is a NOINLNE function. This resulted in a series of bugs: #17673, #18093, #18078. This patch fixes all that: * Main change is in GHC.Core.Opt.Simplify, and the new prepareBinding function, which does this cast worker/wrapper transform. See Note [Cast worker/wrappers]. * There is quite a bit of refactoring around prepareRhs, makeTrivial etc. It's nicer now. * Some wrappers from strictness and cast w/w, notably those for a function with a NOINLINE, should inline very late. There wasn't really a mechanism for that, which was an existing bug really; so I invented a new finalPhase = Phase (-1). It's used for all simplifier runs after the user-visible phase 2,1,0 have run. (No new runs of the simplifier are introduced thereby.) See new Note [Compiler phases] in GHC.Types.Basic; the main changes are in GHC.Core.Opt.Driver * Doing this made me trip over two places where the AnonArgFlag on a FunTy was being lost so we could end up with (Num a -> ty) rather than (Num a => ty) - In coercionLKind/coercionRKind - In contHoleType in the Simplifier I fixed the former by defining mkFunctionType and using it in coercionLKind/RKind. I could have done the same for the latter, but the information is almost to hand. So I fixed the latter by - adding sc_hole_ty to ApplyToVal (like ApplyToTy), - adding as_hole_ty to ValArg (like TyArg) - adding sc_fun_ty to StrictArg Turned out I could then remove ai_type from ArgInfo. This is just moving the deck chairs around, but it worked out nicely. See the new Note [AnonArgFlag] in GHC.Types.Var * When looking at the 'arity decrease' thing (#18093) I discovered that stable unfoldings had a much lower arity than the actual optimised function. That's what led to the arity-decrease message. Simple solution: eta-expand. It's described in Note [Eta-expand stable unfoldings] in GHC.Core.Opt.Simplify * I also discovered that unsafeCoerce wasn't being inlined if the context was boring. So (\x. f (unsafeCoerce x)) would create a thunk -- yikes! I fixed that by making inlineBoringOK a bit cleverer: see Note [Inline unsafeCoerce] in GHC.Core.Unfold. I also found that unsafeCoerceName was unused, so I removed it. I made a test case for #18078, and a very similar one for #17673. The net effect of all this on nofib is very modest, but positive: -------------------------------------------------------------------------------- Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- anna -0.4% -0.1% -3.1% -3.1% 0.0% fannkuch-redux -0.4% -0.3% -0.1% -0.1% 0.0% maillist -0.4% -0.1% -7.8% -1.0% -14.3% primetest -0.4% -15.6% -7.1% -6.6% 0.0% -------------------------------------------------------------------------------- Min -0.9% -15.6% -13.3% -14.2% -14.3% Max -0.3% 0.0% +12.1% +12.4% 0.0% Geometric Mean -0.4% -0.2% -2.3% -2.2% -0.1% All following metric decreases are compile-time allocation decreases between -1% and -3%: Metric Decrease: T5631 T13701 T14697 T15164 - - - - - 32fd37f5 by Luke Lau at 2020-06-10T04:17:22-04:00 Fix lookupGlobalOccRn_maybe sometimes reporting an error In some cases it was possible for lookupGlobalOccRn_maybe to return an error, when it should be returning a Nothing. If it called lookupExactOcc_either when there were no matching GlobalRdrElts in the otherwise case, it would return an error message. This could be caused when lookupThName_maybe in Template Haskell was looking in different namespaces (thRdrNameGuesses), guessing different namespaces that the name wasn't guaranteed to be found in. However, by addressing this some more accurate errors were being lost in the conversion to Maybes. So some of the lookup* functions have been shuffled about so that errors should always be ignored in lookup*_maybes, and propagated otherwise. This fixes #18263 - - - - - 9b283e1b by Roland Senn at 2020-06-10T04:17:34-04:00 Initialize the allocation counter in GHCi to 0 (Fixes #16012) According to the documentation for the function `getAllocationCounter` in [System.Mem](http://hackage.haskell.org/package/base-4.14.0.0/docs/System-Mem.html) initialize the allocationCounter also in GHCi to 0. - - - - - 8d07c48c by Sylvain Henry at 2020-06-10T04:17:36-04:00 test: fix conc038 We had spurious failures of conc038 test on CI with stdout: ``` newThread started -mainThread -Haskell: 2 newThread back again +mainThread 1 sec later shutting down +Haskell: 2 ``` - - - - - 4c7e9689 by Sebastian Graf at 2020-06-11T10:37:38+02:00 Release Notes: Add news from the pattern-match checker [skip ci] - - - - - 3445b965 by Sylvain Henry at 2020-06-13T02:13:01-04:00 Only test T16190 with the NCG T16190 is meant to test a NCG feature. It has already caused spurious failures in other MRs (e.g. !2165) when LLVM is used. - - - - - 2517a51c by Sylvain Henry at 2020-06-13T02:13:01-04:00 DynFlags refactoring VIII (#17957) * Remove several uses of `sdocWithDynFlags`, especially in GHC.Llvm.* * Add LlvmOpts datatype to store Llvm backend options * Remove Outputable instances (for LlvmVar, LlvmLit, LlvmStatic and Llvm.MetaExpr) which require LlvmOpts. * Rename ppMetaExpr into ppMetaAnnotExpr (pprMetaExpr is now used in place of `ppr :: MetaExpr -> SDoc`) - - - - - 7a02599a by Sylvain Henry at 2020-06-13T02:13:02-04:00 Remove unused code - - - - - 72d08610 by Sylvain Henry at 2020-06-13T02:13:02-04:00 Refactor homeUnit * rename thisPackage into homeUnit * document and refactor several Backpack things - - - - - 8dc71f55 by Sylvain Henry at 2020-06-13T02:13:02-04:00 Rename unsafeGetUnitInfo into unsafeLookupUnit - - - - - f6be6e43 by Sylvain Henry at 2020-06-13T02:13:02-04:00 Add allowVirtualUnits field in PackageState Instead of always querying DynFlags to know whether we are allowed to use virtual units (i.e. instantiated on-the-fly, cf Note [About units] in GHC.Unit), we store it once for all in `PackageState.allowVirtualUnits`. This avoids using DynFlags too much (cf #17957) and is preliminary work for #14335. - - - - - e7272d53 by Sylvain Henry at 2020-06-13T02:13:02-04:00 Enhance UnitId use * use UnitId instead of String to identify wired-in units * use UnitId instead of Unit in the backend (Unit are only use by Backpack to produce type-checked interfaces, not real code) * rename lookup functions for consistency * documentation - - - - - 9c5572cd by Sylvain Henry at 2020-06-13T02:13:02-04:00 Remove LinkerUnitId type alias - - - - - d345edfe by Sylvain Henry at 2020-06-13T02:13:02-04:00 Refactor WiredMap * Remove WiredInUnitId and WiredUnitId type aliases - - - - - 3d171cd6 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Document and refactor `mkUnit` and `mkUnitInfoMap` - - - - - d2109b4f by Sylvain Henry at 2020-06-13T02:13:03-04:00 Remove PreloadUnitId type alias - - - - - f50c19b8 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Rename listUnitInfoMap into listUnitInfo There is no Map involved - - - - - ed533ec2 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Rename Package into Unit The terminology changed over time and now package databases contain "units" (there can be several units compiled from a single Cabal package: one per-component, one for each option set, one per instantiation, etc.). We should try to be consistent internally and use "units": that's what this renaming does. Maybe one day we'll fix the UI too (e.g. replace -package-id with -unit-id, we already have -this-unit-id and ghc-pkg has -unit-id...) but it's not done in this patch. * rename getPkgFrameworkOpts into getUnitFrameworkOpts * rename UnitInfoMap into ClosureUnitInfoMap * rename InstalledPackageIndex into UnitInfoMap * rename UnusablePackages into UnusableUnits * rename PackagePrecedenceIndex into UnitPrecedenceMap * rename PackageDatabase into UnitDatabase * rename pkgDatabase into unitDatabases * rename pkgState into unitState * rename initPackages into initUnits * rename renamePackage into renameUnitInfo * rename UnusablePackageReason into UnusableUnitReason * rename getPackage* into getUnit* * etc. - - - - - 202728e5 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Make ClosureUnitInfoMap uses UnitInfoMap - - - - - 55b4263e by Sylvain Henry at 2020-06-13T02:13:03-04:00 Remove ClosureUnitInfoMap - - - - - 653d17bd by Sylvain Henry at 2020-06-13T02:13:03-04:00 Rename Package into Unit (2) * rename PackageState into UnitState * rename findWiredInPackages into findWiredInUnits * rename lookupModuleInAll[Packages,Units] * etc. - - - - - ae900605 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Move dump_mod_map into initUnits - - - - - 598cc1dd by Sylvain Henry at 2020-06-13T02:13:03-04:00 Move wiring of homeUnitInstantiations outside of mkUnitState - - - - - 437265eb by Sylvain Henry at 2020-06-13T02:13:03-04:00 Avoid timing module map dump in initUnits - - - - - 9400aa93 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Remove preload parameter of mkUnitState * Remove preload parameter (unused) * Don't explicitly return preloaded units: redundant because already returned as "preloadUnits" field of UnitState - - - - - 266bc3d9 by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: refactor unwireUnit - - - - - 9e715c1b by Sylvain Henry at 2020-06-13T02:13:03-04:00 Document getPreloadUnitsAnd - - - - - bd5810dc by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: remove useless add_package parameter - - - - - 36e1daf0 by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: make listVisibleModuleNames take a UnitState - - - - - 5226da37 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Refactor and document add_package - - - - - 4b53aac1 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Refactor and document closeUnitDeps - - - - - 42c054f6 by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: findWiredInUnits - - - - - a444d01b by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: reportCycles, reportUnusable - - - - - 8408d521 by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: merge_databases - - - - - fca2d25f by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: add UnitConfig datatype Avoid directly querying flags from DynFlags to build the UnitState. Instead go via UnitConfig so that we could reuse this to make another UnitState for plugins. - - - - - 4274688a by Sylvain Henry at 2020-06-13T02:13:03-04:00 Move distrustAll into mkUnitState - - - - - 28d804e1 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Create helper upd_wired_in_home_instantiations - - - - - ac964c83 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Put database cache in UnitConfig - - - - - bfd0a78c by Sylvain Henry at 2020-06-13T02:13:03-04:00 Don't return preload units when we set DyNFlags Preload units can be retrieved in UnitState when needed (i.e. in GHCi) - - - - - 1fbb4bf5 by Sylvain Henry at 2020-06-13T02:13:03-04:00 NCGConfig: remove useless ncgUnitId field - - - - - c10ff7e7 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Doc: fix some comments - - - - - 456e17f0 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Bump haddock submodule and allow metric decrease Metric Decrease: T12150 T12234 T5837 Metric Increase: T16190 - - - - - 42953902 by Simon Peyton Jones at 2020-06-13T02:13:03-04:00 Trim the demand for recursive product types Ticket #18304 showed that we need to be very careful when exploring the demand (esp usage demand) on recursive product types. This patch solves the problem by trimming the demand on such types -- in effect, a form of "widening". See the Note [Trimming a demand to a type] in DmdAnal, which explains how I did this by piggy-backing on an existing mechansim for trimming demands becuase of GADTs. The significant payload of this patch is very small indeed: * Make GHC.Core.Opt.WorkWrap.Utils.typeShape use RecTcChecker to avoid looking through recursive types. But on the way * I found that ae_rec_tc was entirely inoperative and did nothing. So I removed it altogether from DmdAnal. * I moved some code around in DmdAnal and Demand. (There are no actual changes in dmdFix.) * I changed the API of DmsAnal.dmdAnalRhsLetDown to return a StrictSig rather than a decorated Id * I removed the dead function peelTsFuns from Demand Performance effects: Nofib: 0.0% changes. Not surprising, because they don't use recursive products Perf tests T12227: 1% increase in compiler allocation, becuase $cto gets w/w'd. It did not w/w before because it takes a deeply nested argument, so the worker gets too many args, so we abandon w/w altogether (see GHC.Core.Opt.WorkWrap.Utils.isWorkerSmallEnough) With this patch we trim the demands. That is not strictly necessary (since these Generic type constructors are like tuples -- they can't cause a loop) but the net result is that we now w/w $cto which is fine. UniqLoop: 16% decrease in /runtime/ allocation. The UniqSupply is a recursive product, so currently we abandon all strictness on 'churn'. With this patch 'churn' gets useful strictness, and we w/w it. Hooray Metric Decrease: UniqLoop Metric Increase: T12227 - - - - - 87d504f4 by Viktor Dukhovni at 2020-06-13T02:13:05-04:00 Add introductory prose for Data.Traversable - - - - - 9f09b608 by Oleg Grenrus at 2020-06-13T02:13:07-04:00 Fix #12073: Add MonadFix Q instance - - - - - 220c2d34 by Ben Gamari at 2020-06-13T02:13:07-04:00 testsuite: Increase size of T12150 As noted in #18319, this test was previously very fragile. Increase its size to make it more likely that its fails with its newly-increased acceptance threshold. Metric Increase: T12150 - - - - - 8bba1c26 by Ben Gamari at 2020-06-13T04:59:06-04:00 gitlab-ci: Always push perf notes Previously we ci.sh would run with `set -e` implying that we wouldn't push perf notes if the testsuite were to fail, even if it *only* failed due to perf notes. This rendered the whole performance testing story quite fragile as a single regressing commit would cause every successive commit to fail since a new baseline would not be uploaded. Fix this by ensuring that we always push performance notes. - - - - - 7a773f16 by Ben Gamari at 2020-06-13T15:10:55-04:00 gitlab-ci: Eliminate redundant push of CI metrics - - - - - a31218f7 by Ryan Scott at 2020-06-13T15:58:37-04:00 Use HsForAllTelescope to avoid inferred, visible foralls Currently, `HsForAllTy` permits the combination of `ForallVis` and `Inferred`, but you can't actually typecheck code that uses it (e.g., `forall {a} ->`). This patch refactors `HsForAllTy` to use a new `HsForAllTelescope` data type that makes a type-level distinction between visible and invisible `forall`s such that visible `forall`s do not track `Specificity`. That part of the patch is actually quite small; the rest is simply changing consumers of `HsType` to accommodate this new type. Fixes #18235. Bumps the `haddock` submodule. - - - - - c0e6dee9 by Tamar Christina at 2020-06-14T09:07:44-04:00 winio: Add Atomic Exchange PrimOp and implement Atomic Ptr exchanges. The initial version was rewritten by Tamar Christina. It was rewritten in large parts by Andreas Klebinger. Co-authored-by: Andreas Klebinger <klebinger.andreas at gmx.at> - - - - - 9a7462fb by Ben Gamari at 2020-06-14T15:35:23-04:00 codeGen: Don't discard live case binders in unsafeEqualityProof logic Previously CoreToStg would unconditionally discard cases of the form: case unsafeEqualityProof of wild { _ -> rhs } and rather replace the whole thing with `rhs`. However, in some cases (see #18227) the case binder is still live, resulting in unbound occurrences in `rhs`. Fix this by only discarding the case if the case binder is dead. Fixes #18227. - - - - - e4137c48 by Ben Gamari at 2020-06-14T15:35:23-04:00 testsuite: Add tests for #18227 T18227A is the original issue which gave rise to the ticket and depends upon bytestring. T18227B is a minimized reproducer. - - - - - 8bab9ff1 by Ben Gamari at 2020-06-14T15:35:59-04:00 hadrian: Fix rts include and library paths Fixes two bugs: * (?) and (<>) associated in a surprising way * We neglected to include libdw paths in the rts configure flags - - - - - bd761185 by Ben Gamari at 2020-06-14T15:35:59-04:00 hadrian: Drop redundant GHC arguments Cabal should already be passing this arguments to GHC. - - - - - 01f7052c by Peter Trommler at 2020-06-14T15:36:38-04:00 FFI: Fix pass small ints in foreign call wrappers The Haskell calling convention requires integer parameters smaller than wordsize to be promoted to wordsize (where the upper bits are don't care). To access such small integer parameter read a word from the parameter array and then cast that word to the small integer target type. Fixes #15933 - - - - - 502647f7 by Krzysztof Gogolewski at 2020-06-14T15:37:14-04:00 Fix "ndecreasingIndentation" in manual (#18116) - - - - - 9a9cc089 by Simon Jakobi at 2020-06-15T13:10:00-04:00 Use foldl' in unionManyUniqDSets - - - - - 761dcb84 by Moritz Angermann at 2020-06-15T13:10:36-04:00 Load .lo as well. Some archives contain so called linker objects, with the affectionate .lo suffic. For example the musl libc.a will come in that form. We still want to load those objects, hence we should not discard them and look for .lo as well. Ultimately we might want to fix this proerly by looking at the file magic. - - - - - cf01477f by Vladislav Zavialov at 2020-06-15T13:11:20-04:00 User's Guide: KnownNat evidence is Natural This bit of documentation got outdated after commit 1fcede43d2b30f33b7505e25eb6b1f321be0407f - - - - - d0dcbfe6 by Jan Hrček at 2020-06-16T20:36:38+02:00 Fix typos and formatting in user guide - - - - - 56a9e95f by Jan Hrček at 2020-06-16T20:36:38+02:00 Resolve TODO - - - - - 3e884d14 by Jan Hrček at 2020-06-16T20:36:38+02:00 Rename TcHoleErrors to GHC.Tc.Errors.Hole - - - - - d23fc678 by Stefan Schulze Frielinghaus at 2020-06-17T15:31:09-04:00 hadrian: Build with threaded runtime if available See #16873. - - - - - 0639dc10 by Sylvain Henry at 2020-06-17T15:31:53-04:00 T16190: only measure bytes_allocated Just adding `{-# LANGUAGE BangPatterns #-}` makes the two other metrics fluctuate by 13%. - - - - - 4cab6897 by Adam Sandberg Ericsson at 2020-06-17T15:32:44-04:00 docs: fix formatting in users guide - - - - - eb8115a8 by Sylvain Henry at 2020-06-17T15:33:23-04:00 Move CLabel assertions into smart constructors (#17957) It avoids using DynFlags in the Outputable instance of Clabel to check assertions at pretty-printing time. - - - - - 7faa4509 by Ben Gamari at 2020-06-17T15:43:31-04:00 base: Bump to 4.15.0.0 - - - - - 20616959 by Ben Gamari at 2020-06-17T15:43:31-04:00 configure: Use grep -q instead of --quiet The latter is apparently not supported by busybox. - - - - - 40fa237e by Krzysztof Gogolewski at 2020-06-17T16:21:58-04:00 Linear types (#15981) This is the first step towards implementation of the linear types proposal (https://github.com/ghc-proposals/ghc-proposals/pull/111). It features * A language extension -XLinearTypes * Syntax for linear functions in the surface language * Linearity checking in Core Lint, enabled with -dlinear-core-lint * Core-to-core passes are mostly compatible with linearity * Fields in a data type can be linear or unrestricted; linear fields have multiplicity-polymorphic constructors. If -XLinearTypes is disabled, the GADT syntax defaults to linear fields The following items are not yet supported: * a # m -> b syntax (only prefix FUN is supported for now) * Full multiplicity inference (multiplicities are really only checked) * Decent linearity error messages * Linear let, where, and case expressions in the surface language (each of these currently introduce the unrestricted variant) * Multiplicity-parametric fields * Syntax for annotating lambda-bound or let-bound with a multiplicity * Syntax for non-linear/multiple-field-multiplicity records * Linear projections for records with a single linear field * Linear pattern synonyms * Multiplicity coercions (test LinearPolyType) A high-level description can be found at https://ghc.haskell.org/trac/ghc/wiki/LinearTypes/Implementation Following the link above you will find a description of the changes made to Core. This commit has been authored by * Richard Eisenberg * Krzysztof Gogolewski * Matthew Pickering * Arnaud Spiwack With contributions from: * Mark Barbone * Alexander Vershilov Updates haddock submodule. - - - - - 6cb84c46 by Krzysztof Gogolewski at 2020-06-17T16:22:03-04:00 Various performance improvements This implements several general performance improvements to GHC, to offset the effect of the linear types change. General optimisations: - Add a `coreFullView` function which iterates `coreView` on the head. This avoids making function recursive solely because the iterate `coreView` themselves. As a consequence, this functions can be inlined, and trigger case-of-known constructor (_e.g._ `kindRep_maybe`, `isLiftedRuntimeRep`, `isMultiplicityTy`, `getTyVar_maybe`, `splitAppTy_maybe`, `splitFunType_maybe`, `tyConAppTyCon_maybe`). The common pattern about all these functions is that they are almost always used as views, and immediately consumed by a case expression. This commit also mark them asx `INLINE`. - In `subst_ty` add a special case for nullary `TyConApp`, which avoid allocations altogether. - Use `mkTyConApp` in `subst_ty` for the general `TyConApp`. This required quite a bit of module shuffling. case. `myTyConApp` enforces crucial sharing, which was lost during substitution. See also !2952 . - Make `subst_ty` stricter. - In `eqType` (specifically, in `nonDetCmpType`), add a special case, tested first, for the very common case of nullary `TyConApp`. `nonDetCmpType` has been made `INLINE` otherwise it is actually a regression. This is similar to the optimisations in !2952. Linear-type specific optimisations: - Use `tyConAppTyCon_maybe` instead of the more complex `eqType` in the definition of the pattern synonyms `One` and `Many`. - Break the `hs-boot` cycles between `Multiplicity.hs` and `Type.hs`: `Multiplicity` now import `Type` normally, rather than from the `hs-boot`. This way `tyConAppTyCon_maybe` can inline properly in the `One` and `Many` pattern synonyms. - Make `updateIdTypeAndMult` strict in its type and multiplicity - The `scaleIdBy` gets a specialised definition rather than being an alias to `scaleVarBy` - `splitFunTy_maybe` is given the type `Type -> Maybe (Mult, Type, Type)` instead of `Type -> Maybe (Scaled Type, Type)` - Remove the `MultMul` pattern synonym in favour of a view `isMultMul` because pattern synonyms appear not to inline well. - in `eqType`, in a `FunTy`, compare multiplicities last: they are almost always both `Many`, so it helps failing faster. - Cache `manyDataConTy` in `mkTyConApp`, to make sure that all the instances of `TyConApp ManyDataConTy []` are physically the same. This commit has been authored by * Richard Eisenberg * Krzysztof Gogolewski * Arnaud Spiwack Metric Decrease: haddock.base T12227 T12545 T12990 T1969 T3064 T5030 T9872b Metric Increase: haddock.base haddock.Cabal haddock.compiler T12150 T12234 T12425 T12707 T13035 T13056 T15164 T16190 T18304 T1969 T3064 T3294 T5631 T5642 T5837 T6048 T9020 T9233 T9675 T9872a T9961 WWRec - - - - - 57db91d8 by Sylvain Henry at 2020-06-17T16:22:03-04:00 Remove integer-simple integer-simple uses lists of words (`[Word]`) to represent big numbers instead of ByteArray#: * it is less efficient than the newer ghc-bignum native backend * it isn't compatible with the big number representation that is now shared by all the ghc-bignum backends (based on the one that was used only in integer-gmp before). As a consequence, we simply drop integer-simple - - - - - 9f96bc12 by Sylvain Henry at 2020-06-17T16:22:03-04:00 ghc-bignum library ghc-bignum is a newer package that aims to replace the legacy integer-simple and integer-gmp packages. * it supports several backends. In particular GMP is still supported and most of the code from integer-gmp has been merged in the "gmp" backend. * the pure Haskell "native" backend is new and is much faster than the previous pure Haskell implementation provided by integer-simple * new backends are easier to write because they only have to provide a few well defined functions. All the other code is common to all backends. In particular they all share the efficient small/big number distinction previously used only in integer-gmp. * backends can all be tested against the "native" backend with a simple Cabal flag. Backends are only allowed to differ in performance, their results should be the same. * Add `integer-gmp` compat package: provide some pattern synonyms and function aliases for those in `ghc-bignum`. It is intended to avoid breaking packages that depend on `integer-gmp` internals. Update submodules: text, bytestring Metric Decrease: Conversions ManyAlternatives ManyConstructors Naperian T10359 T10547 T10678 T12150 T12227 T12234 T12425 T13035 T13719 T14936 T1969 T4801 T4830 T5237 T5549 T5837 T8766 T9020 parsing001 space_leak_001 T16190 haddock.base On ARM and i386, T17499 regresses (+6% > 5%). On x86_64 unregistered, T13701 sometimes regresses (+2.2% > 2%). Metric Increase: T17499 T13701 - - - - - 96aa5787 by Sylvain Henry at 2020-06-17T16:22:03-04:00 Update compiler Thanks to ghc-bignum, the compiler can be simplified: * Types and constructors of Integer and Natural can be wired-in. It means that we don't have to query them from interfaces. It also means that numeric literals don't have to carry their type with them. * The same code is used whatever ghc-bignum backend is enabled. In particular, conversion of bignum literals into final Core expressions is now much more straightforward. Bignum closure inspection too. * GHC itself doesn't depend on any integer-* package anymore * The `integerLibrary` setting is gone. - - - - - 0f67e344 by Sylvain Henry at 2020-06-17T16:22:03-04:00 Update `base` package * GHC.Natural isn't implemented in `base` anymore. It is provided by ghc-bignum in GHC.Num.Natural. It means that we can safely use Natural primitives in `base` without fearing issues with built-in rewrite rules (cf #15286) * `base` doesn't conditionally depend on an integer-* package anymore, it depends on ghc-bignum * Some duplicated code in integer-* can now be factored in GHC.Float * ghc-bignum tries to use a uniform naming convention so most of the other changes are renaming - - - - - aa9e7b71 by Sylvain Henry at 2020-06-17T16:22:03-04:00 Update `make` based build system * replace integer-* package selection with ghc-bignum backend selection - - - - - f817d816 by Sylvain Henry at 2020-06-17T16:22:04-04:00 Update testsuite * support detection of slow ghc-bignum backend (to replace the detection of integer-simple use). There are still some test cases that the native backend doesn't handle efficiently enough. * remove tests for GMP only functions that have been removed from ghc-bignum * fix test results showing dependent packages (e.g. integer-gmp) or showing suggested instances * fix test using Integer/Natural API or showing internal names - - - - - dceecb09 by Sylvain Henry at 2020-06-17T16:22:04-04:00 Update Hadrian * support ghc-bignum backend selection in flavours and command-line * support ghc-bignum "--check" flag (compare results of selected backend against results of the native one) in flavours and command-line (e.g. pass --bignum=check-gmp" to check the "gmp" backend) * remove the hack to workaround #15286 * build GMP only when the gmp backend is used * remove hacks to workaround `text` package flags about integer-*. We fix `text` to use ghc-bignum unconditionally in another patch - - - - - fa4281d6 by Sylvain Henry at 2020-06-17T16:22:04-04:00 Bump bytestring and text submodules - - - - - 1a3f6f34 by Adam Sandberg Ericsson at 2020-06-18T23:03:36-04:00 docs: mention -hiedir in docs for -outputdir [skip ci] - - - - - 729bcb02 by Sylvain Henry at 2020-06-18T23:04:17-04:00 Hadrian: fix build on Mac OS Catalina (#17798) - - - - - 95e18292 by Andreas Klebinger at 2020-06-18T23:04:58-04:00 Relax allocation threshold for T12150. This test performs little work, so the most minor allocation changes often cause the test to fail. Increasing the threshold to 2% should help with this. - - - - - 8ce6c393 by Sebastian Graf at 2020-06-18T23:05:36-04:00 hadrian: Bump pinned cabal.project to an existent index-state - - - - - 08c1cb0f by Ömer Sinan Ağacan at 2020-06-18T23:06:21-04:00 Fix uninitialized field read in Linker.c Valgrind report of the bug when running the test `linker_unload`: ==29666== Conditional jump or move depends on uninitialised value(s) ==29666== at 0x369C5B4: setOcInitialStatus (Linker.c:1305) ==29666== by 0x369C6C5: mkOc (Linker.c:1347) ==29666== by 0x36C027A: loadArchive_ (LoadArchive.c:522) ==29666== by 0x36C0600: loadArchive (LoadArchive.c:626) ==29666== by 0x2C144CD: ??? (in /home/omer/haskell/ghc_2/testsuite/tests/rts/linker/linker_unload.run/linker_unload) ==29666== ==29666== Conditional jump or move depends on uninitialised value(s) ==29666== at 0x369C5B4: setOcInitialStatus (Linker.c:1305) ==29666== by 0x369C6C5: mkOc (Linker.c:1347) ==29666== by 0x369C9F6: preloadObjectFile (Linker.c:1507) ==29666== by 0x369CA8D: loadObj_ (Linker.c:1536) ==29666== by 0x369CB17: loadObj (Linker.c:1557) ==29666== by 0x3866BC: main (linker_unload.c:33) The problem is `mkOc` allocates a new `ObjectCode` and calls `setOcInitialStatus` without initializing the `status` field. `setOcInitialStatus` reads the field as first thing: static void setOcInitialStatus(ObjectCode* oc) { if (oc->status == OBJECT_DONT_RESOLVE) return; if (oc->archiveMemberName == NULL) { oc->status = OBJECT_NEEDED; } else { oc->status = OBJECT_LOADED; } } `setOcInitialStatus` is unsed in two places for two different purposes: in `mkOc` where we don't have the `status` field initialized yet (`mkOc` is supposed to initialize it), and `loadOc` where we do have `status` field initialized and we want to update it. Instead of splitting the function into two functions which are both called just once I inline the functions in the use sites and remove it. Fixes #18342 - - - - - da18ff99 by Tamar Christina at 2020-06-18T23:07:03-04:00 fix windows bootstrap due to linker changes - - - - - 2af0ec90 by Sylvain Henry at 2020-06-18T23:07:47-04:00 DynFlags: store default depth in SDocContext (#17957) It avoids having to use DynFlags to reach for pprUserLength. - - - - - d4a0be75 by Sylvain Henry at 2020-06-18T23:08:35-04:00 Move tablesNextToCode field into Platform tablesNextToCode is a platform setting and doesn't belong into DynFlags (#17957). Doing this is also a prerequisite to fix #14335 where we deal with two platforms (target and host) that may have different platform settings. - - - - - 809caedf by John Ericson at 2020-06-23T22:47:37-04:00 Switch from HscSource to IsBootInterface for module lookup in GhcMake We look up modules by their name, and not their contents. There is no way to separately reference a signature vs regular module; you get what you get. Only boot files can be referenced indepenently with `import {-# SOURCE #-}`. - - - - - 7750bd45 by Sylvain Henry at 2020-06-23T22:48:18-04:00 Cmm: introduce SAVE_REGS/RESTORE_REGS We don't want to save both Fn and Dn register sets on x86-64 as they are aliased to the same arch register (XMMn). Moreover, when SAVE_STGREGS was used in conjunction with `jump foo [*]` which makes a set of Cmm registers alive so that they cover all arch registers used to pass parameter, we could have Fn, Dn and XMMn alive at the same time. It made the LLVM code generator choke (see #17920). Now `SAVE_REGS/RESTORE_REGS` and `jump foo [*]` use the same set of registers. - - - - - 2636794d by Sylvain Henry at 2020-06-23T22:48:18-04:00 CmmToC: don't add extern decl to parsed Cmm data Previously, if a .cmm file *not in the RTS* contained something like: ```cmm section "rodata" { msg : bits8[] "Test\n"; } ``` It would get compiled by CmmToC into: ```c ERW_(msg); const char msg[] = "Test\012"; ``` and fail with: ``` /tmp/ghc32129_0/ghc_4.hc:5:12: error: error: conflicting types for \u2018msg\u2019 const char msg[] = "Test\012"; ^~~ In file included from /tmp/ghc32129_0/ghc_4.hc:3:0: error: /tmp/ghc32129_0/ghc_4.hc:4:6: error: note: previous declaration of \u2018msg\u2019 was here ERW_(msg); ^ /builds/hsyl20/ghc/_build/install/lib/ghc-8.11.0.20200605/lib/../lib/x86_64-linux-ghc-8.11.0.20200605/rts-1.0/include/Stg.h:253:46: error: note: in definition of macro \u2018ERW_\u2019 #define ERW_(X) extern StgWordArray (X) ^ ``` See the rationale for this on https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/backends/ppr-c#prototypes Now we don't generate these extern declarations (ERW_, etc.) for top-level data. It shouldn't change anything for the RTS (the only place we use .cmm files) as it is already special cased in `GHC.Cmm.CLabel.needsCDecl`. And hand-written Cmm can use explicit extern declarations when needed. Note that it allows `cgrun069` test to pass with CmmToC (cf #15467). - - - - - 5f6a0665 by Sylvain Henry at 2020-06-23T22:48:18-04:00 LLVM: refactor and comment register padding code (#17920) - - - - - cad62ef1 by Sylvain Henry at 2020-06-23T22:48:18-04:00 Add tests for #17920 Metric Decrease: T12150 T12234 - - - - - a2a9006b by Xavier Denis at 2020-06-23T22:48:56-04:00 Fix issue #18262 by zonking constraints after solving Zonk residual constraints in checkForExistence to reveal user type errors. Previously when `:instances` was used with instances that have TypeError constraints the result would look something like: instance [safe] s0 => Err 'A -- Defined at ../Bug2.hs:8:10 whereas after zonking, `:instances` now sees the `TypeError` and properly eliminates the constraint from the results. - - - - - 181516bc by Simon Peyton Jones at 2020-06-23T22:49:33-04:00 Fix a buglet in Simplify.simplCast This bug, revealed by #18347, is just a missing update to sc_hole_ty in simplCast. I'd missed a code path when I made the recentchanges in commit 6d49d5be904c0c01788fa7aae1b112d5b4dfaf1c Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Thu May 21 12:53:35 2020 +0100 Implement cast worker/wrapper properly The fix is very easy. Two other minor changes * Tidy up in SimpleOpt.simple_opt_expr. In fact I think this is an outright bug, introduced in the fix to #18112: we were simplifying the same coercion twice *with the same substitution*, which is just wrong. It'd be a hard bug to trigger, so I just fixed it; less code too. * Better debug printing of ApplyToVal - - - - - 625a7f54 by Simon Peyton Jones at 2020-06-23T22:50:11-04:00 Two small tweaks to Coercion.simplifyArgsWorker These tweaks affect the inner loop of simplifyArgsWorker, which in turn is called from the flattener in Flatten.hs. This is a key perf bottleneck to T9872{a,b,c,d}. These two small changes have a modest but useful benefit. No change in functionality whatsoever. Relates to #18354 - - - - - b5768cce by Sylvain Henry at 2020-06-23T22:50:49-04:00 Don't use timesInt2# with GHC < 8.11 (fix #18358) - - - - - 7ad4085c by Sylvain Henry at 2020-06-23T22:51:27-04:00 Fix invalid printf format - - - - - a1f34d37 by Krzysztof Gogolewski at 2020-06-23T22:52:09-04:00 Add missing entry to freeNamesItem (#18369) - - - - - 03a708ba by Andreas Klebinger at 2020-06-25T03:54:37-04:00 Enable large address space optimization on windows. Starting with Win 8.1/Server 2012 windows no longer preallocates page tables for reserverd memory eagerly, which prevented us from using this approach in the past. We also try to allocate the heap high in the memory space. Hopefully this makes it easier to allocate things in the low 4GB of memory that need to be there. Like jump islands for the linker. - - - - - 7e6d3d09 by Roland Senn at 2020-06-25T03:54:38-04:00 In `:break ident` allow out of scope and nested identifiers (Fix #3000) This patch fixes the bug and implements the feature request of #3000. 1. If `Module` is a real module name and `identifier` a name of a top-level function in `Module` then `:break Module.identifer` works also for an `identifier` that is out of scope. 2. Extend the syntax for `:break identifier` to: :break [ModQual.]topLevelIdent[.nestedIdent]...[.nestedIdent] `ModQual` is optional and is either the effective name of a module or the local alias of a qualified import statement. `topLevelIdent` is the name of a top level function in the module referenced by `ModQual`. `nestedIdent` is optional and the name of a function nested in a let or where clause inside the previously mentioned function `nestedIdent` or `topLevelIdent`. If `ModQual` is a module name, then `topLevelIdent` can be any top level identifier in this module. If `ModQual` is missing or a local alias of a qualified import, then `topLevelIdent` must be in scope. Breakpoints can be set on arbitrarily deeply nested functions, but the whole chain of nested function names must be specified. 3. To support the new functionality rewrite the code to tab complete `:break`. - - - - - 30e42652 by Ben Gamari at 2020-06-25T03:54:39-04:00 make: Respect XELATEX variable Previously we simply ignored the XELATEX variable when building PDF documentation. - - - - - 4acc2934 by Ben Gamari at 2020-06-25T03:54:39-04:00 hadrian/make: Detect makeindex Previously we would simply assume that makeindex was available. Now we correctly detect it in `configure` and respect this conclusion in hadrian and make. - - - - - 0d61f866 by Simon Peyton Jones at 2020-06-25T03:54:40-04:00 Expunge GhcTcId GHC.Hs.Extension had type GhcPs = GhcPass 'Parsed type GhcRn = GhcPass 'Renamed type GhcTc = GhcPass 'Typechecked type GhcTcId = GhcTc The last of these, GhcTcId, is a vestige of the past. This patch expunges it from GHC. - - - - - 8ddbed4a by Adam Wespiser at 2020-06-25T03:54:40-04:00 add examples to Data.Traversable - - - - - 284001d0 by Oleg Grenrus at 2020-06-25T03:54:42-04:00 Export readBinIface_ - - - - - 90f43872 by Zubin Duggal at 2020-06-25T03:54:43-04:00 Export everything from HsToCore. This lets us reuse these functions in haddock, avoiding synchronization bugs. Also fixed some divergences with haddock in that file Updates haddock submodule - - - - - c7dd6da7 by Takenobu Tani at 2020-06-25T03:54:44-04:00 Clean up haddock hyperlinks of GHC.* (part1) This updates haddock comments only. This patch focuses to update for hyperlinks in GHC API's haddock comments, because broken links especially discourage newcomers. This includes the following hierarchies: - GHC.Hs.* - GHC.Core.* - GHC.Stg.* - GHC.Cmm.* - GHC.Types.* - GHC.Data.* - GHC.Builtin.* - GHC.Parser.* - GHC.Driver.* - GHC top - - - - - 1eb997a8 by Takenobu Tani at 2020-06-25T03:54:44-04:00 Clean up haddock hyperlinks of GHC.* (part2) This updates haddock comments only. This patch focuses to update for hyperlinks in GHC API's haddock comments, because broken links especially discourage newcomers. This includes the following hierarchies: - GHC.Iface.* - GHC.Llvm.* - GHC.Rename.* - GHC.Tc.* - GHC.HsToCore.* - GHC.StgToCmm.* - GHC.CmmToAsm.* - GHC.Runtime.* - GHC.Unit.* - GHC.Utils.* - GHC.SysTools.* - - - - - 67a86b4d by Oleg Grenrus at 2020-06-25T03:54:46-04:00 Add MonadZip and MonadFix instances for Complex These instances are taken from https://hackage.haskell.org/package/linear-1.21/docs/Linear-Instances.html They are the unique possible, so let they be in `base`. - - - - - c50ef26e by Artem Pelenitsyn at 2020-06-25T03:54:47-04:00 test suite: add reproducer for #17516 - - - - - fe281b27 by Roland Senn at 2020-06-25T03:54:48-04:00 Enable maxBound checks for OverloadedLists (Fixes #18172) Consider the Literal `[256] :: [Data.Word.Word8]` When the `OverloadedLists` extension is not active, then the `ol_ext` field in the `OverLitTc` record that is passed to the function `getIntegralLit` contains the type `Word8`. This is a simple type, and we can use its type constructor immediately for the `warnAboutOverflowedLiterals` function. When the `OverloadedLists` extension is active, then the `ol_ext` field contains the type family `Item [Word8]`. The function `nomaliseType` is used to convert it to the needed type `Word8`. - - - - - a788d4d1 by Ben Gamari at 2020-06-25T03:54:52-04:00 rts/Hash: Simplify freeing of HashListChunks While looking at #18348 I noticed that the treatment of HashLists are a bit more complex than necessary (which lead to some initial confusion on my part). Specifically, we allocate HashLists in chunks. Each chunk allocation makes two allocations: one for the chunk itself and one for a HashListChunk to link together the chunks for the purposes of freeing. Simplify this (and hopefully make the relationship between these clearer) but allocating the HashLists and HashListChunk in a single malloc. This will both make the implementation easier to follow and reduce C heap fragmentation. Note that even after this patch we fail to bound the size of the free HashList pool. However, this is a separate bug. - - - - - d3c2d59b by Sylvain Henry at 2020-06-25T03:54:55-04:00 RTS: avoid overflow on 32-bit arch (#18375) We're now correctly computing allocated bytes on 32-bit arch, so we get huge increases. Metric Increase: haddock.Cabal haddock.base haddock.compiler space_leak_001 - - - - - a3d69dc6 by Sebastian Graf at 2020-06-25T23:06:18-04:00 GHC.Core.Unify: Make UM actions one-shot by default This MR makes the UM monad in GHC.Core.Unify into a one-shot monad. See the long Note [The one-shot state monad trick]. See also #18202 and !3309, which applies this to all Reader/State-like monads in GHC for compile-time perf improvements. The pattern used here enables something similar to the state-hack, but is applicable to user-defined monads, not just `IO`. Metric Decrease 'runtime/bytes allocated' (test_env='i386-linux-deb9'): haddock.Cabal - - - - - 9ee58f8d by Matthias Pall Gissurarson at 2020-06-26T17:12:45+00:00 Implement the proposed -XQualifiedDo extension Co-authored-by: Facundo Domínguez <facundo.dominguez at tweag.io> QualifiedDo is implemented using the same placeholders for operation names in the AST that were devised for RebindableSyntax. Whenever the renamer checks which names to use for do syntax, it first checks if the do block is qualified (e.g. M.do { stmts }), in which case it searches for qualified names in the module M. This allows users to write {-# LANGUAGE QualifiedDo #-} import qualified SomeModule as M f x = M.do -- desugars to: y <- M.return x -- M.return x M.>>= \y -> M.return y -- M.return y M.>> M.return y -- M.return y See Note [QualifiedDo] and the users' guide for more details. Issue #18214 Proposal: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0216-qualified-do.rst Since we change the constructors `ITdo` and `ITmdo` to carry the new module name, we need to bump the haddock submodule to account or the new shape of these constructors. - - - - - ce987865 by Ryan Scott at 2020-06-27T11:55:21-04:00 Revamp the treatment of auxiliary bindings for derived instances This started as a simple fix for #18321 that organically grew into a much more sweeping refactor of how auxiliary bindings for derived instances are handled. I have rewritten `Note [Auxiliary binders]` in `GHC.Tc.Deriv.Generate` to explain all of the moving parts, but the highlights are: * Previously, the OccName of each auxiliary binding would be given a suffix containing a hash of its package name, module name, and parent data type to avoid name clashes. This was needlessly complicated, so we take the more direct approach of generating `Exact` `RdrName`s for each auxiliary binding with the same `OccName`, but using an underlying `System` `Name` with a fresh `Unique` for each binding. Unlike hashes, allocating new `Unique`s does not require any cleverness and avoid name clashes all the same... * ...speaking of which, in order to convince the renamer that multiple auxiliary bindings with the same `OccName` (but different `Unique`s) are kosher, we now use `rnLocalValBindsLHS` instead of `rnTopBindsLHS` to rename auxiliary bindings. Again, see `Note [Auxiliary binders]` for the full story. * I have removed the `DerivHsBind` constructor for `DerivStuff`—which was only used for `Data.Data`-related auxiliary bindings—and refactored `gen_Data_binds` to use `DerivAuxBind` instead. This brings the treatment of `Data.Data`-related auxiliary bindings in line with every other form of auxiliary binding. Fixes #18321. - - - - - a403eb91 by Sylvain Henry at 2020-06-27T11:55:59-04:00 ghc-bignum: fix division by zero (#18359) - - - - - 1b3d13b6 by Sylvain Henry at 2020-06-27T11:55:59-04:00 Fix ghc-bignum exceptions We must ensure that exceptions are not simplified. Previously we used: case raiseDivZero of _ -> 0## -- dummyValue But it was wrong because the evaluation of `raiseDivZero` was removed and the dummy value was directly returned. See new Note [ghc-bignum exceptions]. I've also removed the exception triggering primops which were fragile. We don't need them to be primops, we can have them exported by ghc-prim. I've also added a test for #18359 which triggered this patch. - - - - - a74ec37c by Simon Peyton Jones at 2020-06-27T11:56:34-04:00 Better loop detection in findTypeShape Andreas pointed out, in !3466, that my fix for #18304 was not quite right. This patch fixes it properly, by having just one RecTcChecker rather than (implicitly) two nested ones, in findTypeShape. - - - - - a04020b8 by Sylvain Henry at 2020-06-27T11:57:11-04:00 DynFlags: don't store buildTag `DynFlags.buildTag` was a field created from the set of Ways in `DynFlags.ways`. It had to be kept in sync with `DynFlags.ways` which was fragile. We want to avoid global state like this (#17957). Moreover in #14335 we also want to support loading units with different ways: target units would still use `DynFlags.ways` but plugins would use `GHC.Driver.Ways.hostFullWays`. To avoid having to deal both with build tag and with ways, we recompute the buildTag on-the-fly (should be pretty cheap) and we remove `DynFlags.buildTag` field. - - - - - 0e83efa2 by Krzysztof Gogolewski at 2020-06-27T11:57:49-04:00 Don't generalize when typechecking a tuple section The code is simpler and cleaner. - - - - - d8ba9e6f by Peter Trommler at 2020-06-28T09:19:11-04:00 RTS: Refactor Haskell-C glue for PPC 64-bit Make sure the stack is 16 byte aligned even when reserved stack bytes are not a multiple of 16 bytes. Avoid saving r2 (TOC). On ELF v1 the function descriptor of StgReturn has the same TOC as StgRun, on ELF v2 the TOC is recomputed in the function prologue. Use the ABI provided functions to save clobbered GPRs and FPRs. Improve comments. Describe what the stack looks like and how it relates to the respective ABIs. - - - - - 42f797b0 by Ryan Scott at 2020-06-28T09:19:46-04:00 Use NHsCoreTy to embed types into GND-generated code `GeneralizedNewtypeDeriving` is in the unique situation where it must produce an `LHsType GhcPs` from a Core `Type`. Historically, this was done with the `typeToLHsType` function, which walked over the entire `Type` and attempted to construct an `LHsType` with the same overall structure. `typeToLHsType` is quite complicated, however, and has been the subject of numerous bugs over the years (e.g., #14579). Luckily, there is an easier way to accomplish the same thing: the `XHsType` constructor of `HsType`. `XHsType` bundles an `NHsCoreTy`, which allows embedding a Core `Type` directly into an `HsType`, avoiding the need to laboriously convert from one to another (as `typeToLHsType` did). Moreover, renaming and typechecking an `XHsType` is simple, since one doesn't need to do anything to a Core `Type`... ...well, almost. For the reasons described in `Note [Typechecking NHsCoreTys]` in `GHC.Tc.Gen.HsType`, we must apply a substitution that we build from the local `tcl_env` type environment. But that's a relatively modest price to pay. Now that `GeneralizedNewtypeDeriving` uses `NHsCoreTy`, the `typeToLHsType` function no longer has any uses in GHC, so this patch rips it out. Some additional tweaks to `hsTypeNeedsParens` were necessary to make the new `-ddump-deriv` output correctly parenthesized, but other than that, this patch is quite straightforward. This is a mostly internal refactoring, although it is likely that `GeneralizedNewtypeDeriving`-generated code will now need fewer language extensions in certain situations than it did before. - - - - - 68530b1c by Jan Hrček at 2020-06-28T09:20:22-04:00 Fix duplicated words and typos in comments and user guide - - - - - 15b79bef by Ryan Scott at 2020-06-28T09:20:57-04:00 Add integer-gmp's ghc.mk and GNUmakefile to .gitignore - - - - - bfa5698b by Simon Peyton Jones at 2020-06-28T09:21:32-04:00 Fix a typo in Lint This simple error in GHC.Core.Litn.lintJoinLams meant that Lint reported bogus errors. Fixes #18399 - - - - - 71006532 by Ryan Scott at 2020-06-30T07:10:42-04:00 Reject nested foralls/contexts in instance types more consistently GHC is very wishy-washy about rejecting instance declarations with nested `forall`s or contexts that are surrounded by outermost parentheses. This can even lead to some strange interactions with `ScopedTypeVariables`, as demonstrated in #18240. This patch makes GHC more consistently reject instance types with nested `forall`s/contexts so as to prevent these strange interactions. On the implementation side, this patch tweaks `splitLHsInstDeclTy` and `getLHsInstDeclHead` to not look through parentheses, which can be semantically significant. I've added a `Note [No nested foralls or contexts in instance types]` in `GHC.Hs.Type` to explain why. This also introduces a `no_nested_foralls_contexts_err` function in `GHC.Rename.HsType` to catch nested `forall`s/contexts in instance types. This function is now used in `rnClsInstDecl` (for ordinary instance declarations) and `rnSrcDerivDecl` (for standalone `deriving` declarations), the latter of which fixes #18271. On the documentation side, this adds a new "Formal syntax for instance declaration types" section to the GHC User's Guide that presents a BNF-style grammar for what is and isn't allowed in instance types. Fixes #18240. Fixes #18271. - - - - - bccf3351 by Sylvain Henry at 2020-06-30T07:10:46-04:00 Add ghc-bignum to 8.12 release notes - - - - - 81704a6f by David Eichmann at 2020-06-30T07:10:48-04:00 Update ssh keys in CI performance metrics upload script - - - - - 85310fb8 by Joshua Price at 2020-06-30T07:10:49-04:00 Add missing Ix instances for tuples of size 6 through 15 (#16643) - - - - - cbb6b62f by Vladislav Zavialov at 2020-07-01T15:41:38-04:00 Implement -XLexicalNegation (GHC Proposal #229) This patch introduces a new extension, -XLexicalNegation, which detects whether the minus sign stands for negation or subtraction using the whitespace-based rules described in GHC Proposal #229. Updates haddock submodule. - - - - - fb5a0d01 by Martin Handley at 2020-07-01T15:42:14-04:00 #17169: Clarify Fixed's Enum instance. - - - - - b316804d by Simon Peyton Jones at 2020-07-01T15:42:49-04:00 Improve debug tracing for substitution This patch improves debug tracing a bit (#18395) * Remove the ancient SDoc argument to substitution, replacing it with a HasDebugCallStack constraint. The latter does the same job (indicate the call site) but much better. * Add HasDebugCallStack to simpleOptExpr, exprIsConApp_maybe I needed this to help nail the lookupIdSubst panic in #18326, #17784 - - - - - 5c9fabb8 by Hécate at 2020-07-01T15:43:25-04:00 Add most common return values for `os` and `arch` - - - - - 76d8cc74 by Ryan Scott at 2020-07-01T15:44:01-04:00 Desugar quoted uses of DerivingVia and expression type signatures properly The way that `GHC.HsToCore.Quote` desugared quoted `via` types (e.g., `deriving via forall a. [a] instance Eq a => Eq (List a)`) and explicit type annotations in signatures (e.g., `f = id @a :: forall a. a -> a`) was completely wrong, as it did not implement the scoping guidelines laid out in `Note [Scoped type variables in bindings]`. This is easily fixed. While I was in town, I did some minor cleanup of related Notes: * `Note [Scoped type variables in bindings]` and `Note [Scoped type variables in class and instance declarations]` say very nearly the same thing. I decided to just consolidate the two Notes into `Note [Scoped type variables in quotes]`. * `Note [Don't quantify implicit type variables in quotes]` is somewhat outdated, as it predates GHC 8.10, where the `forall`-or-nothing rule requires kind variables to be explicitly quantified in the presence of an explicit `forall`. As a result, the running example in that Note doesn't even compile. I have changed the example to something simpler that illustrates the same point that the original Note was making. Fixes #18388. - - - - - 44d6a335 by Andreas Klebinger at 2020-07-02T02:54:54-04:00 T16012: Be verbose on failure. - - - - - f9853330 by Ryan Scott at 2020-07-02T02:55:29-04:00 Bump ghc-prim version to 0.7.0 Fixes #18279. Bumps the `text` submodule. - - - - - 23e4e047 by Sylvain Henry at 2020-07-02T10:46:31-04:00 Hadrian: fix PowerPC64le support (#17601) [ci skip] - - - - - 3cdd8d69 by Sylvain Henry at 2020-07-02T10:47:08-04:00 NCG: correctly handle addresses with huge offsets (#15570) Before this patch we could generate addresses of this form: movzbl cP0_str+-9223372036854775808,%eax The linker can't handle them because the offset is too large: ld.lld: error: Main.o:(.text+0xB3): relocation R_X86_64_32S out of range: -9223372036852653050 is not in [-2147483648, 2147483647] With this patch we detect those cases and generate: movq $-9223372036854775808,%rax addq $cP0_str,%rax movzbl (%rax),%eax I've also refactored `getAmode` a little bit to make it easier to understand and to trace. - - - - - 4d90b3ff by Gabor Greif at 2020-07-02T20:07:59-04:00 No need for CURSES_INCLUDE_DIRS This is a leftover from ef63ff27251a20ff11e58c9303677fa31e609a88 - - - - - f08d6316 by Sylvain Henry at 2020-07-02T20:08:36-04:00 Replace Opt_SccProfilingOn flag with sccProfilingEnabled helper function SCC profiling was enabled in a convoluted way: if WayProf was enabled, Opt_SccProfilingOn general flag was set (in `GHC.Driver.Ways.wayGeneralFlags`), and then this flag was queried in various places. There is no need to go via general flags, so this patch defines a `sccProfilingEnabled :: DynFlags -> Bool` helper function that just checks whether WayProf is enabled. - - - - - 8cc7274b by Ben Gamari at 2020-07-03T02:49:27-04:00 rts/ProfHeap: Only allocate the Censuses that we need When not LDV profiling there is no reason to allocate 32 Censuses; one will do. This is a very small memory footprint optimisation, but it comes for free. - - - - - b835112c by Ben Gamari at 2020-07-03T02:49:27-04:00 rts/ProfHeap: Free old allocations when reinitialising Censuses Previously when not LDV profiling we would repeatedly reinitialise `censuses[0]` with `initEra`. This failed to free the `Arena` and `HashTable` from the old census, resulting in a memory leak. Fixes #18348. - - - - - 34be6523 by Valery Tolstov at 2020-07-03T02:50:03-04:00 Mention flags that are not enabled by -Wall (#18372) * Mention missing flags that are not actually enabled by -Wall (docs/users_guide/using-warnings.rst) * Additionally remove -Wmissing-monadfail-instances from the list of flags enabled by -Wcompat, as it is not the case since 8.8 - - - - - edc8d22b by Sylvain Henry at 2020-07-03T02:50:40-04:00 LLVM: support R9 and R10 registers d535ef006d85dbdb7cda2b09c5bc35cb80108909 allowed the use of up to 10 vanilla registers but didn't update LLVM backend to support them. This patch fixes it. - - - - - 4bf18646 by Simon Peyton Jones at 2020-07-03T08:37:42+01:00 Improve handling of data type return kinds Following a long conversation with Richard, this patch tidies up the handling of return kinds for data/newtype declarations (vanilla, family, and instance). I have substantially edited the Notes in TyCl, so they would bear careful reading. Fixes #18300, #18357 In GHC.Tc.Instance.Family.newFamInst we were checking some Lint-like properties with ASSSERT. Instead Richard and I have added a proper linter for axioms, and called it from lintGblEnv, which in turn is called in tcRnModuleTcRnM New tests (T18300, T18357) cause an ASSERT failure in HEAD. - - - - - 41d26492 by Sylvain Henry at 2020-07-03T17:33:59-04:00 DynFlags: avoid the use of sdocWithDynFlags in GHC.Core.Rules (#17957) - - - - - 7aa6ef11 by Hécate at 2020-07-03T17:34:36-04:00 Add the __GHC_FULL_VERSION__ CPP macro to expose the full GHC version - - - - - e61d5395 by Chaitanya Koparkar at 2020-07-07T13:55:59-04:00 ghc-prim: Turn some comments into haddocks [ci skip] - - - - - 37743f91 by John Ericson at 2020-07-07T13:56:00-04:00 Support `timesInt2#` in LLVM backend - - - - - 46397e53 by John Ericson at 2020-07-07T13:56:00-04:00 `genericIntMul2Op`: Call `genericWordMul2Op` directly This unblocks a refactor, and removes partiality. It might be a PowerPC regression but that should be fixable. - - - - - 8a1c0584 by John Ericson at 2020-07-07T13:56:00-04:00 Simplify `PrimopCmmEmit` Follow @simonpj's suggestion of pushing the "into regs" logic into `emitPrimOp`. With the previous commit getting rid of the recursion in `genericIntMul2Op`, this is now an easy refactor. - - - - - 6607f203 by John Ericson at 2020-07-07T13:56:00-04:00 `opAllDone` -> `opIntoRegs` The old name was and terrible and became worse after the previous commit's refactor moved non-trivial funcationlity into its body. - - - - - fdcc53ba by Sylvain Henry at 2020-07-07T13:56:00-04:00 Optimise genericIntMul2Op We shouldn't directly call 'genericWordMul2Op' in genericIntMul2Op because a target may provide a faster primop for 'WordMul2Op': we'd better use it! - - - - - 686e7225 by Moritz Angermann at 2020-07-07T13:56:01-04:00 [linker/rtsSymbols] More linker symbols Mostly symbols needed for aarch64/armv7l and in combination with musl, where we have to rely on loading *all* objects/archives - __stack_chk_* only when not DYNAMIC - - - - - 3f60b94d by Moritz Angermann at 2020-07-07T13:56:01-04:00 better if guards. - - - - - 7abffced by Moritz Angermann at 2020-07-07T13:56:01-04:00 Fix (1) - - - - - cdfeb3f2 by Moritz Angermann at 2020-07-07T13:56:01-04:00 AArch32 symbols only on aarch32. - - - - - f496c955 by Adam Sandberg Ericsson at 2020-07-07T13:56:02-04:00 add -flink-rts flag to link the rts when linking a shared or static library #18072 By default we don't link the RTS when linking shared libraries because in the most usual mode a shared library is an intermediary product, for example a Haskell library, that will be linked into some executable in the end. So we wish to defer the RTS flavour to link to the final link. However sometimes the final product is the shared library, for example when writing a plugin for some other system, so we do wish the shared library to link the RTS. For consistency we also make -staticlib honor this flag and its inversion. -staticlib currently implies -flink-shared. - - - - - c59faf67 by Stefan Schulze Frielinghaus at 2020-07-07T13:56:04-04:00 hadrian: link check-ppr against debugging RTS if ghcDebugged - - - - - 0effc57d by Adam Sandberg Ericsson at 2020-07-07T13:56:05-04:00 rts linker: teach the linker about GLIBC's special handling of *stat, mknod and atexit functions #7072 - - - - - 96153433 by Adam Sandberg Ericsson at 2020-07-07T13:56:06-04:00 hadrian: make hadrian/ghci use the bootstrap compiler from configure #18190 - - - - - 4d24f886 by Adam Sandberg Ericsson at 2020-07-07T13:56:07-04:00 hadrian: ignore cabal configure verbosity related flags #18131 - - - - - 7332bbff by Ben Gamari at 2020-07-07T13:56:08-04:00 testsuite: Widen T12234 acceptance window to 2% Previously it wasn't uncommon to see +/-1% fluctuations in compiler allocations on this test. - - - - - 180b6313 by Gabor Greif at 2020-07-07T13:56:08-04:00 When running libtool, report it as such - - - - - d3bd6897 by Sylvain Henry at 2020-07-07T13:56:11-04:00 BigNum: rename BigNat types Before this patch BigNat names were confusing because we had: * GHC.Num.BigNat.BigNat: unlifted type used everywhere else * GHC.Num.BigNat.BigNatW: lifted type only used to share static constants * GHC.Natural.BigNat: lifted type only used for backward compatibility After this patch we have: * GHC.Num.BigNat.BigNat#: unlifted type * GHC.Num.BigNat.BigNat: lifted type (reexported from GHC.Natural) Thanks to @RyanGlScott for spotting this. - - - - - 929d26db by Sylvain Henry at 2020-07-07T13:56:12-04:00 Bignum: don't build ghc-bignum with stage0 Noticed by @Ericson2314 - - - - - d25b6851 by Sylvain Henry at 2020-07-07T13:56:12-04:00 Hadrian: ghc-gmp.h shouldn't be a compiler dependency - - - - - 0ddae2ba by Sylvain Henry at 2020-07-07T13:56:14-04:00 DynFlags: factor out pprUnitId from "Outputable UnitId" instance - - - - - 204f3f5d by Krzysztof Gogolewski at 2020-07-07T13:56:18-04:00 Remove unused function pprHsForAllExtra (#18423) The function `pprHsForAllExtra` was called only on `Nothing` since 2015 (1e041b7382b6aa). - - - - - 3033e0e4 by Adam Sandberg Ericsson at 2020-07-08T20:36:49-04:00 hadrian: add flag to skip rebuilding dependency information #17636 - - - - - b7de4b96 by Stefan Schulze Frielinghaus at 2020-07-09T09:49:22-04:00 Fix GHCi :print on big-endian platforms On big-endian platforms executing import GHC.Exts data Foo = Foo Float# deriving Show foo = Foo 42.0# foo :print foo results in an arithmetic overflow exception which is caused by function index where moveBytes equals word_size - (r + item_size_b) * 8 Here we have a mixture of units. Both, word_size and item_size_b have unit bytes whereas r has unit bits. On 64-bit platforms moveBytes equals then 8 - (0 + 4) * 8 which results in a negative and therefore invalid second parameter for a shiftL operation. In order to make things more clear the expression (word .&. (mask `shiftL` moveBytes)) `shiftR` moveBytes is equivalent to (word `shiftR` moveBytes) .&. mask On big-endian platforms the shift must be a left shift instead of a right shift. For symmetry reasons not a mask is used but two shifts in order to zero out bits. Thus the fixed version equals case endian of BigEndian -> (word `shiftL` moveBits) `shiftR` zeroOutBits `shiftL` zeroOutBits LittleEndian -> (word `shiftR` moveBits) `shiftL` zeroOutBits `shiftR` zeroOutBits Fixes #16548 and #14455 - - - - - 3656dff8 by Sylvain Henry at 2020-07-09T09:50:01-04:00 LLVM: fix MO_S_Mul2 support (#18434) The value indicating if the carry is useful wasn't taken into account. - - - - - d9f09506 by Simon Peyton Jones at 2020-07-10T10:33:44-04:00 Define multiShotIO and use it in mkSplitUniqueSupply This patch is part of the ongoing eta-expansion saga; see #18238. It implements a neat trick (suggested by Sebastian Graf) that allows the programmer to disable the default one-shot behaviour of IO (the "state hack"). The trick is to use a new multiShotIO function; see Note [multiShotIO]. For now, multiShotIO is defined here in Unique.Supply; but it should ultimately be moved to the IO library. The change is necessary to get good code for GHC's unique supply; see Note [Optimising the unique supply]. However it makes no difference to GHC as-is. Rather, it makes a difference when a subsequent commit Improve eta-expansion using ArityType lands. - - - - - bce695cc by Simon Peyton Jones at 2020-07-10T10:33:44-04:00 Make arityType deal with join points As Note [Eta-expansion and join points] describes, this patch makes arityType deal correctly with join points. What was there before was not wrong, but yielded lower arities than it could. Fixes #18328 In base GHC this makes no difference to nofib. Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- n-body -0.1% -0.1% -1.2% -1.1% 0.0% -------------------------------------------------------------------------------- Min -0.1% -0.1% -55.0% -56.5% 0.0% Max -0.0% 0.0% +16.1% +13.4% 0.0% Geometric Mean -0.0% -0.0% -30.1% -31.0% -0.0% But it starts to make real difference when we land the change to the way mkDupableAlts handles StrictArg, in fixing #13253 and friends. I think this is because we then get more non-inlined join points. - - - - - 2b7c71cb by Simon Peyton Jones at 2020-07-11T12:17:02-04:00 Improve eta-expansion using ArityType As #18355 shows, we were failing to preserve one-shot info when eta-expanding. It's rather easy to fix, by using ArityType more, rather than just Arity. This patch is important to suport the one-shot monad trick; see #18202. But the extra tracking of one-shot-ness requires the patch Define multiShotIO and use it in mkSplitUniqueSupply If that patch is missing, ths patch makes things worse in GHC.Types.Uniq.Supply. With it, however, we see these improvements T3064 compiler bytes allocated -2.2% T3294 compiler bytes allocated -1.3% T12707 compiler bytes allocated -1.3% T13056 compiler bytes allocated -2.2% Metric Decrease: T3064 T3294 T12707 T13056 - - - - - de139cc4 by Artem Pelenitsyn at 2020-07-12T02:53:20-04:00 add reproducer for #15630 - - - - - c4de6a7a by Andreas Klebinger at 2020-07-12T02:53:55-04:00 Give Uniq[D]FM a phantom type for its key. This fixes #17667 and should help to avoid such issues going forward. The changes are mostly mechanical in nature. With two notable exceptions. * The register allocator. The register allocator references registers by distinct uniques. However they come from the types of VirtualReg, Reg or Unique in various places. As a result we sometimes cast the key type of the map and use functions which operate on the now typed map but take a raw Unique as actual key. The logic itself has not changed it just becomes obvious where we do so now. * <Type>Env Modules. As an example a ClassEnv is currently queried using the types `Class`, `Name`, and `TyCon`. This is safe since for a distinct class value all these expressions give the same unique. getUnique cls getUnique (classTyCon cls) getUnique (className cls) getUnique (tcName $ classTyCon cls) This is for the most part contained within the modules defining the interface. However it requires us to play dirty when we are given a `Name` to lookup in a `UniqFM Class a` map. But again the logic did not change and it's for the most part hidden behind the Env Module. Some of these cases could be avoided by refactoring but this is left for future work. We also bump the haddock submodule as it uses UniqFM. - - - - - c2cfdfde by Aaron Allen at 2020-07-13T09:00:33-04:00 Warn about empty Char enumerations (#18402) Currently the "Enumeration is empty" warning (-Wempty-enumerations) only fires for numeric literals. This patch adds support for `Char` literals so that enumerating an empty list of `Char`s will also trigger the warning. - - - - - c3ac87ec by Stefan Schulze Frielinghaus at 2020-07-13T09:01:10-04:00 hadrian: build check-ppr dynamic if GHC is build dynamic Fixes #18361 - - - - - 9ad072b4 by Simon Peyton Jones at 2020-07-13T14:52:49-04:00 Use dumpStyle when printing inlinings This just makes debug-printing consistent, and more informative. - - - - - e78c4efb by Simon Peyton Jones at 2020-07-13T14:52:49-04:00 Comments only - - - - - 7ccb760b by Simon Peyton Jones at 2020-07-13T14:52:49-04:00 Reduce result discount in conSize Ticket #18282 showed that the result discount given by conSize was massively too large. This patch reduces that discount to a constant 10, which just balances the cost of the constructor application itself. Note [Constructor size and result discount] elaborates, as does the ticket #18282. Reducing result discount reduces inlining, which affects perf. I found that I could increase the unfoldingUseThrehold from 80 to 90 in compensation; in combination with the result discount change I get these overall nofib numbers: Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- boyer -0.2% +5.4% -3.2% -3.4% 0.0% cichelli -0.1% +5.9% -11.2% -11.7% 0.0% compress2 -0.2% +9.6% -6.0% -6.8% 0.0% cryptarithm2 -0.1% -3.9% -6.0% -5.7% 0.0% gamteb -0.2% +2.6% -13.8% -14.4% 0.0% genfft -0.1% -1.6% -29.5% -29.9% 0.0% gg -0.0% -2.2% -17.2% -17.8% -20.0% life -0.1% -2.2% -62.3% -63.4% 0.0% mate +0.0% +1.4% -5.1% -5.1% -14.3% parser -0.2% -2.1% +7.4% +6.7% 0.0% primetest -0.2% -12.8% -14.3% -14.2% 0.0% puzzle -0.2% +2.1% -10.0% -10.4% 0.0% rsa -0.2% -11.7% -3.7% -3.8% 0.0% simple -0.2% +2.8% -36.7% -38.3% -2.2% wheel-sieve2 -0.1% -19.2% -48.8% -49.2% -42.9% -------------------------------------------------------------------------------- Min -0.4% -19.2% -62.3% -63.4% -42.9% Max +0.3% +9.6% +7.4% +11.0% +16.7% Geometric Mean -0.1% -0.3% -17.6% -18.0% -0.7% I'm ok with these numbers, remembering that this change removes an *exponential* increase in code size in some in-the-wild cases. I investigated compress2. The difference is entirely caused by this function no longer inlining WriteRoutines.$woutputCodes = \ (w :: [CodeEvent]) -> let result_s1Sr = case WriteRoutines.outputCodes_$s$woutput w 0# 0# 8# 9# of (# ww1, ww2 #) -> (ww1, ww2) in (# case result_s1Sr of (x, _) -> map @Int @Char WriteRoutines.outputCodes1 x , case result_s1Sr of { (_, y) -> y } #) It was right on the cusp before, driven by the excessive result discount. Too bad! Happily, the compiler/perf tests show a number of improvements: T12227 compiler bytes-alloc -6.6% T12545 compiler bytes-alloc -4.7% T13056 compiler bytes-alloc -3.3% T15263 runtime bytes-alloc -13.1% T17499 runtime bytes-alloc -14.3% T3294 compiler bytes-alloc -1.1% T5030 compiler bytes-alloc -11.7% T9872a compiler bytes-alloc -2.0% T9872b compiler bytes-alloc -1.2% T9872c compiler bytes-alloc -1.5% Metric Decrease: T12227 T12545 T13056 T15263 T17499 T3294 T5030 T9872a T9872b T9872c - - - - - 7f0b671e by Ben Gamari at 2020-07-13T14:52:49-04:00 testsuite: Widen acceptance threshold on T5837 This test is positively tiny and consequently the bytes allocated measurement will be relatively noisy. Consequently I have seen this fail spuriously quite often. - - - - - 118e1c3d by Alp Mestanogullari at 2020-07-14T21:30:52-04:00 compiler: re-engineer the treatment of rebindable if Executing on the plan described in #17582, this patch changes the way if expressions are handled in the compiler in the presence of rebindable syntax. We get rid of the SyntaxExpr field of HsIf and instead, when rebindable syntax is on, we rewrite the HsIf node to the appropriate sequence of applications of the local `ifThenElse` function. In order to be able to report good error messages, with expressions as they were written by the user (and not as desugared by the renamer), we make use of TTG extensions to extend GhcRn expression ASTs with an `HsExpansion` construct, which keeps track of a source (GhcPs) expression and the desugared (GhcRn) expression that it gives rise to. This way, we can typecheck the latter while reporting the former in error messages. In order to discard the error context lines that arise from typechecking the desugared expressions (because they talk about expressions that the user has not written), we carefully give a special treatment to the nodes fabricated by this new renaming-time transformation when typechecking them. See Note [Rebindable syntax and HsExpansion] for more details. The note also includes a recipe to apply the same treatment to other rebindable constructs. Tests 'rebindable11' and 'rebindable12' have been added to make sure we report identical error messages as before this patch under various circumstances. We also now disable rebindable syntax when processing untyped TH quotes, as per the discussion in #18102 and document the interaction of rebindable syntax and Template Haskell, both in Note [Template Haskell quotes and Rebindable Syntax] and in the user guide, adding a test to make sure that we do not regress in that regard. - - - - - 64c774b0 by Andreas Klebinger at 2020-07-14T21:31:27-04:00 Explain why keeping DynFlags in AnalEnv saves allocation. - - - - - 254245d0 by Ben Gamari at 2020-07-14T21:32:03-04:00 docs/users-guide: Update default -funfolding-use-threshold value This was changed in 3d2991f8 but I neglected to update the documentation. Fixes #18419. - - - - - 4c259f86 by Andreas Klebinger at 2020-07-14T21:32:41-04:00 Escape backslashes in json profiling reports properly. I also took the liberty to do away the fixed buffer size for escaping. Using a fixed size here can only lead to issues down the line. Fixes #18438. - - - - - 23797224 by Sergei Trofimovich at 2020-07-14T21:33:19-04:00 .gitlab: re-enable integer-simple substitute (BIGNUM_BACKEND) Recently build system migrated from INTEGER_LIBRARY to BIGNUM_BACKEND. But gitlab CI was never updated. Let's enable BIGNUM_BACKEND=native. Bug: https://gitlab.haskell.org/ghc/ghc/-/issues/18437 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - e0db878a by Sergei Trofimovich at 2020-07-14T21:33:19-04:00 ghc-bignum: bring in sync .hs-boot files with module declarations Before this change `BIGNUM_BACKEND=native` build was failing as: ``` libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs:708:16: error: * Variable not in scope: naturalFromBigNat# :: WordArray# -> t * Perhaps you meant one of these: `naturalFromBigNat' (imported from GHC.Num.Natural), `naturalToBigNat' (imported from GHC.Num.Natural) | 708 | m' = naturalFromBigNat# m | ``` This happens because `.hs-boot` files are slightly out of date. This change brings in data and function types in sync. Bug: https://gitlab.haskell.org/ghc/ghc/-/issues/18437 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - c9f65c36 by Stefan Schulze Frielinghaus at 2020-07-14T21:33:57-04:00 rts/Disassembler.c: Use FMT_HexWord for printing values in hex format - - - - - 58ae62eb by Matthias Andreas Benkard at 2020-07-14T21:34:35-04:00 macOS: Load frameworks without stating them first. macOS Big Sur makes the following change to how frameworks are shipped with the OS: > New in macOS Big Sur 11 beta, the system ships with a built-in > dynamic linker cache of all system-provided libraries. As part of > this change, copies of dynamic libraries are no longer present on > the filesystem. Code that attempts to check for dynamic library > presence by looking for a file at a path or enumerating a directory > will fail. Instead, check for library presence by attempting to > dlopen() the path, which will correctly check for the library in the > cache. (62986286) https://developer.apple.com/documentation/macos-release-notes/macos-big-sur-11-beta-release-notes/ Therefore, the previous method of checking whether a library exists before attempting to load it makes GHC.Runtime.Linker.loadFramework fail to find frameworks installed at /System/Library/Frameworks. GHC.Runtime.Linker.loadFramework now opportunistically loads the framework libraries without checking for their existence first, failing only if all attempts to load a given framework from any of the various possible locations fail. - - - - - cdc4a6b0 by Matthias Andreas Benkard at 2020-07-14T21:34:35-04:00 loadFramework: Output the errors collected in all loading attempts. With the recent change away from first finding and then loading a framework, loadFramework had no way of communicating the real reason why loadDLL failed if it was any reason other than the framework missing from the file system. It now collects all loading attempt errors into a list and concatenates them into a string to return to the caller. - - - - - 51dbfa52 by Ben Gamari at 2020-07-15T04:05:34-04:00 StgToCmm: Use CmmRegOff smart constructor Previously we would generate expressions of the form `CmmRegOff BaseReg 0`. This should do no harm (and really should be handled by the NCG anyways) but it's better to just generate a plain `CmmReg`. - - - - - ae11bdfd by Ben Gamari at 2020-07-15T04:06:08-04:00 testsuite: Add regression test for #17744 Test due to @monoidal. - - - - - 0e3c277a by Ben Gamari at 2020-07-15T16:41:01-04:00 Bump Cabal submodule Updates a variety of tests as Cabal is now more strict about Cabal file form. - - - - - ceed994a by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Drop Windows Vista support, require Windows 7 - - - - - 00a23bfd by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Update Windows FileSystem wrapper utilities. - - - - - 459e1c5f by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Use SlimReaderLocks and ConditonalVariables provided by the OS instead of emulated ones - - - - - 763088fc by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Small linker comment and ifdef cleanups - - - - - 1a228ff9 by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Flush event logs eagerly. - - - - - e9e04dda by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Refactor Buffer structures to be able to track async operations - - - - - 356dc3fe by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Implement new Console API - - - - - 90e69f77 by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Add IOPort synchronization primitive - - - - - 71245fcc by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Add new io-manager cmdline options - - - - - d548a3b3 by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Init Windows console Codepage to UTF-8. - - - - - 58ef6366 by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Add unsafeSplat to GHC.Event.Array - - - - - d660725e by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Add size and iterate to GHC.Event.IntTable. - - - - - 050da6dd by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Switch Testsuite to test winio by default - - - - - 4bf542bf by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Multiple refactorings and support changes. - - - - - 4489af6b by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: core threaded I/O manager - - - - - 64d8f2fe by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: core non-threaded I/O manager - - - - - 8da15a09 by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Fix a scheduler bug with the threaded-runtime. - - - - - 84ea3d14 by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Relaxing some constraints in io-manager. - - - - - ccf0d107 by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Fix issues with non-threaded I/O manager after split. - - - - - b492fe6e by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Remove some barf statements that are a bit strict. - - - - - 01423fd2 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Expand comments describing non-threaded loop - - - - - 4b69004f by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: fix FileSize unstat-able handles - - - - - 9b384270 by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Implement new tempfile routines for winio - - - - - f1e0be82 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix input truncation when reading from handle. This was caused by not upholding the read buffer invariant that bufR == bufL == 0 for empty read buffers. - - - - - e176b625 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix output truncation for writes larger than buffer size - - - - - a831ce0e by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Rewrite bufWrite. I think it's far easier to follow the code now. It's also correct now as I had still missed a spot where we didn't update the offset. - - - - - 6aefdf62 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix offset set by bufReadEmpty. bufReadEmpty returns the bytes read *including* content that was already buffered, But for calculating the offset we only care about the number of bytes read into the new buffer. - - - - - 750ebaee by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Clean up code surrounding IOPort primitives. According to phyx these should only be read and written once per object. Not neccesarily in that order. To strengthen that guarantee the primitives will now throw an exception if we violate this invariant. As a consequence we can eliminate some code from their primops. In particular code dealing with multiple queued readers/writers now simply checks the invariant and throws an exception if it was violated. That is in contrast to mvars which will do things like wake up all readers, queue multi writers etc. - - - - - ffd31db9 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix multi threaded threadDelay and a few other small changes. Multithreaded threadDelay suffered from a race condition based on the ioManagerStatus. Since the status isn't needed for WIO I removed it completely. This resulted in a light refactoring, as consequence we will always wake up the IO manager using interruptSystemManager, which uses `postQueuedCompletionStatus` internally. I also added a few comments which hopefully makes the code easier to dive into for the next person diving in. - - - - - 6ec26df2 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 wionio: Make IO subsystem check a no-op on non-windows platforms. - - - - - 29bcd936 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Set handle offset when opening files in Append mode. Otherwise we would truncate the file. - - - - - 55c29700 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Remove debug event log trace - - - - - 9acb9f40 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix sqrt and openFile009 test cases - - - - - 57017cb7 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Allow hp2ps to build with -DDEBUG - - - - - b8cd9995 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Update output of T9681 since we now actually run it. - - - - - 10af5b14 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: A few more improvements to the IOPort primitives. - - - - - 39afc4a7 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix expected tempfiles output. Tempfiles now works properly on windows, as such we can delete the win32 specific output. - - - - - 99db46e0 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Assign thread labels to IOManager threads. - - - - - be6af732 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Properly check for the tso of an incall to be zero. - - - - - e2c6dac7 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Mark FD instances as unsupported under WINIO. - - - - - fd02ceed by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix threadDelay maxBound invocations. Instead of letting the ns timer overflow now clamp it at (maxBound :: Word64) ns. That still gives a few hundred years. - - - - - bc79f9f1 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Add comments/cleanup an import in base - - - - - 1d197f4b by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Mark outstanding_service_requests volatile. As far as I know C(99) gives no guarantees for code like bool condition; ... while(condition) sleep(); that condition will be updated if it's changed by another thread. So we are explicit here and mark it as volatile, this will force a reload from memory on each iteration. - - - - - dc438186 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Make last_event a local variable - - - - - 2fc957c5 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Add comment about thread safety of processCompletion. - - - - - 4c026b6c by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: nonthreaded: Create io processing threads in main thread. We now set a flag in the IO thread. The scheduler when looking for work will check the flag and create/queue threads accordingly. We used to create these in the IO thread. This improved performance but caused frequent segfaults. Thread creation/allocation is only safe to do if nothing currently accesses the storeagemanager. However without locks in the non-threaded runtime this can't be guaranteed. This shouldn't change performance all too much. In the past we had: * IO: Create/Queue thread. * Scheduler: Runs a few times. Eventually picks up IO processing thread. Now it's: * IO: Set flag to queue thread. * Scheduler: Pick up flag, if set create/queue thread. Eventually picks up IO processing thread. - - - - - f47c7208 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Add an exported isHeapAlloced function to the RTS - - - - - cc5d7bb1 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Queue IO processing threads at the front of the queue. This will unblock the IO thread sooner hopefully leading to higher throughput in some situations. - - - - - e7630115 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: ThreadDelay001: Use higher resolution timer. - - - - - 451b5f96 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Update T9681 output, disable T4808 on windows. T4808 tests functionality of the FD interface which won't be supported under WINIO. T9681 just has it's expected output tweaked. - - - - - dd06f930 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Wake io manager once per registerTimeout. Which is implicitly done in editTimeouts, so need to wake it up twice. - - - - - e87d0bf9 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Update placeholder comment with actual function name. - - - - - fc9025db by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Always lock win32 event queue - - - - - c24c9a1f by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Display thread labels when tracing scheduler events. - - - - - 06542b03 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Refactor non-threaded runner thread and scheduler interface. Only use a single communication point (registerAlertableWait) to inform the C side aobut both timeouts to use as well as outstanding requests. Also queue a haskell processing thread after each return from alertable waits. This way there is no risk of us missing a timer event. - - - - - 256299b1 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove outstanding_requests from runner. We used a variable to keep track of situations where we got entries from the IO port, but all of them had already been canceled. While we can avoid some work that way this case seems quite rare. So we give up on tracking this and instead always assume at least one of the returned entries is valid. If that's not the case no harm is done, we just perform some additional work. But it makes the runner easier to reason about. In particular we don't need to care if another thread modifies oustanding_requests after we return from waiting on the IO Port. - - - - - 3ebd8ad9 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: Various fixes related to rebase and testdriver - - - - - 6be6bcba by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: Fix rebase artifacts - - - - - 2c649dc3 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Rename unsafeSplat to unsafeCopyFromBuffer - - - - - a18b73f3 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove unused size/iterate operations from IntTable - - - - - 16bab48e by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Detect running IO Backend via peeking at RtsConfig - - - - - 8b8405a0 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: update temp path so GCC etc can handle it. Also fix PIPE support, clean up error casting, fix memory leaks - - - - - 2092bc54 by Ben Gamari at 2020-07-15T16:41:03-04:00 winio: Minor comments/renamings - - - - - a5b5b6c0 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Checking if an error code indicates completion is now a function. - - - - - 362176fd by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Small refactor in withOverlappedEx - - - - - 32e20597 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: A few comments and commented out dbxIO - - - - - a4bfc1d9 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Don't drop buffer offset in byteView/cwcharView - - - - - b3ad2a54 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: revert BHandle changes. - - - - - 3dcd87e2 by Ben Gamari at 2020-07-15T16:41:03-04:00 winio: Fix imports - - - - - 5a371890 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: update ghc-cabal to handle new Cabal submodule bump - - - - - d07ebe0d by Ben Gamari at 2020-07-15T16:41:03-04:00 winio: Only compile sources on Windows - - - - - dcb42393 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Actually return Nothing on EOF for non-blocking read - - - - - 895a3beb by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Deduplicate logic in encodeMultiByte[Raw]IO. - - - - - e06e6734 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Deduplicate openFile logic - - - - - b59430c0 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: fix -werror issue in encoding file - - - - - f8d39a51 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Don't mention windows specific functions when building on Linux. - - - - - 6a533d2a by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: add a note about file locking in the RTS. - - - - - cf37ce34 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Add version to @since annotation - - - - - 0fafa2eb by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Rename GHC.Conc.IOCP -> GHC.Conc.WinIO - - - - - 1854fc23 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Expand GHC.Conc.POSIX description It now explains users may not use these functions when using the old IO manager. - - - - - fcc7ba41 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Fix potential spaceleak in __createUUIDTempFileErrNo - - - - - 6b3fd9fa by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove redundant -Wno-missing-signatures pragmas - - - - - 916fc861 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Make it explicit that we only create one IO manager - - - - - f260a721 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Note why we don't use blocking waits. - - - - - aa0a4bbf by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove commented out pragma - - - - - d679b544 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove redundant buffer write in Handle/Text.hs:bufReadEmpty - - - - - d3f94368 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Rename SmartHandles to StdHandles - - - - - bd6b8ec1 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: add comment stating failure behaviour for getUniqueFileInfo. - - - - - 12846b85 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Update IOPort haddocks. - - - - - 9f39fb14 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Add a note cross reference - - - - - 62dd5a73 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Name Haskell/OS I/O Manager explicitly in Note - - - - - fa807828 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Expand BlockedOnIOCompletion description. - - - - - f0880a1d by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Remove historical todos - - - - - 8e58e714 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Update note, remove debugging pragma. - - - - - aa4d84d5 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: flushCharReadBuffer shouldn't need to adjust offsets. - - - - - e580893a by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Remove obsolete comment about cond. variables - - - - - d54e9d79 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix initial linux validate build - - - - - 3cd4de46 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Fix ThreadDelay001 CPP - - - - - c88b1b9f by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Fix openFile009 merge conflict leftover - - - - - 849e8889 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Accept T9681 output. GHC now reports String instead of [Char]. - - - - - e7701818 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Fix cabal006 after upgrading cabal submodule Demand cabal 2.0 syntax instead of >= 1.20 as required by newer cabal versions. - - - - - a44f0373 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Fix stderr output for ghci/linking/dyn tests. We used to filter rtsopts, i opted to instead just accept the warning of it having no effect. This works both for -rtsopts, as well as -with-rtsopts which winio adds. - - - - - 515d9896 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Adjust T15261b stdout for --io-manager flag. - - - - - 949aaacc by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Adjust T5435_dyn_asm stderr The warning about rtsopts having no consequences is expected. So accept new stderr. - - - - - 7d424e1e by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Also accept T7037 stderr - - - - - 1f009768 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix cabal04 by filtering rts args - - - - - 981a9f2e by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix cabal01 by accepting expected stderr - - - - - b7b0464e by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix safePkg01 by accepting expected stderr - - - - - 32734b29 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix T5435_dyn_gcc by accepting expected stderr - - - - - acc5cebf by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix tempfiles test on linux - - - - - c577b789 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Accept accepted stderr for T3807 - - - - - c108c527 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Accept accepted stderr for linker_unload - - - - - 2b0b9a08 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Accept accepted stderr for linker_unload_multiple_objs - - - - - 67afb03c by Tamar Christina at 2020-07-15T16:41:04-04:00 winio: clarify wording on conditional variables. - - - - - 3bd41572 by Tamar Christina at 2020-07-15T16:41:04-04:00 winio: clarify comment on cooked mode. - - - - - ded58a03 by Tamar Christina at 2020-07-15T16:41:04-04:00 winio: update lockfile signature and remove mistaken symbol in rts. - - - - - 2143c492 by Ben Gamari at 2020-07-15T16:41:04-04:00 testsuite: Add winio and winio_threaded ways Reverts many of the testsuite changes - - - - - c0979cc5 by Ben Gamari at 2020-07-16T10:56:54-04:00 Merge remote-tracking branch 'origin/wip/winio' - - - - - 750a1595 by Ben Gamari at 2020-07-18T07:26:41-04:00 rts: Add --copying-gc flag to reverse effect of --nonmoving-gc Fixes #18281. - - - - - 6ba6a881 by Hécate at 2020-07-18T07:26:42-04:00 Implement `fullCompilerVersion` Follow-up of https://gitlab.haskell.org/ghc/ghc/-/issues/18403 This MR adds `fullCompilerVersion`, a function that shares the same backend as the `--numeric-version` GHC flag, exposing a full, three-digit version datatype. - - - - - e6cf27df by Hécate at 2020-07-18T07:26:43-04:00 Add a Lint hadrian rule and an .hlint.yaml file in base/ - - - - - bcb177dd by Simon Peyton Jones at 2020-07-18T07:26:43-04:00 Allow multiple case branches to have a higher rank type As #18412 points out, it should be OK for multiple case alternatives to have a higher rank type, provided they are all the same. This patch implements that change. It sweeps away GHC.Tc.Gen.Match.tauifyMultipleBranches, and friends, replacing it with an enhanced version of fillInferResult. The basic change to fillInferResult is to permit the case in which another case alternative has already filled in the result; and in that case simply unify. It's very simple actually. See the new Note [fillInferResult] in TcMType Other refactoring: - Move all the InferResult code to one place, in GHC.Tc.Utils.TcMType (previously some of it was in Unify) - Move tcInstType and friends from TcMType to Instantiate, where it more properly belongs. (TCMType was getting very long.) - - - - - e5525a51 by Simon Peyton Jones at 2020-07-18T07:26:43-04:00 Improve typechecking of NPlusK patterns This patch (due to Richard Eisenberg) improves documentation of the wrapper returned by tcSubMult (see Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify). And, more substantially, it cleans up the multiplicity handling in the typechecking of NPlusKPat - - - - - 12f90352 by Krzysztof Gogolewski at 2020-07-18T07:26:45-04:00 Remove {-# CORE #-} pragma (part of #18048) This pragma has no effect since 2011. It was introduced for External Core, which no longer exists. Updates haddock submodule. - - - - - e504c913 by Simon Peyton Jones at 2020-07-18T07:26:45-04:00 Refactor the simplification of join binders This MR (for #18449) refactors the Simplifier's treatment of join-point binders. Specifically, it puts together, into GHC.Core.Opt.Simplify.Env.adjustJoinPointType two currently-separate ways in which we adjust the type of a join point. As the comment says: -- (adjustJoinPointType mult new_res_ty join_id) does two things: -- -- 1. Set the return type of the join_id to new_res_ty -- See Note [Return type for join points] -- -- 2. Adjust the multiplicity of arrows in join_id's type, as -- directed by 'mult'. See Note [Scaling join point arguments] I think this actually fixes a latent bug, by ensuring that the seIdSubst and seInScope have the right multiplicity on the type of join points. I did some tidying up while I was at it. No more setJoinResTy, or modifyJoinResTy: instead it's done locally in Simplify.Env.adjustJoinPointType - - - - - 49b265f0 by Chaitanya Koparkar at 2020-07-18T07:26:46-04:00 Fix minor typos in a Core.hs note - - - - - 8d59aed6 by Stefan Schulze Frielinghaus at 2020-07-18T07:26:47-04:00 GHCi: Fix isLittleEndian - - - - - c26e81d1 by Ben Gamari at 2020-07-18T07:26:47-04:00 testsuite: Mark ghci tests as fragile under unreg compiler In particular I have seen T16012 fail repeatedly under the unregisterised compiler. - - - - - 868e4523 by Moritz Angermann at 2020-07-20T04:30:38-04:00 Revert "AArch32 symbols only on aarch32." This reverts commit cdfeb3f24f76e8fd30452016676e56fbc827789a. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - c915ba84 by Moritz Angermann at 2020-07-20T04:30:38-04:00 Revert "Fix (1)" This reverts commit 7abffced01f5680efafe44f6be2733eab321b039. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - 777c452a by Moritz Angermann at 2020-07-20T04:30:38-04:00 Revert "better if guards." This reverts commit 3f60b94de1f460ca3f689152860b108a19ce193e. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - 0dd40552 by Moritz Angermann at 2020-07-20T04:30:38-04:00 Revert "[linker/rtsSymbols] More linker symbols" This reverts commit 686e72253aed3880268dd6858eadd8c320f09e97. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - 30caeee7 by Sylvain Henry at 2020-07-21T06:39:33-04:00 DynFlags: remove use of sdocWithDynFlags from GHC.Stg.* (#17957) * add StgPprOpts datatype * remove Outputable instances for types that need `StgPprOpts` to be pretty-printed and explicitly call type specific ppr functions * add default `panicStgPprOpts` for panic messages (when it's not convenient to thread StgPprOpts or DynFlags down to the ppr function call) - - - - - 863c544c by Mark at 2020-07-21T06:39:34-04:00 Fix a typo in existential_quantification.rst - - - - - 05910be1 by Krzysztof Gogolewski at 2020-07-21T14:47:07-04:00 Add release notes entry for #17816 [skip ci] - - - - - a6257192 by Matthew Pickering at 2020-07-21T14:47:19-04:00 Use a newtype `Code` for the return type of typed quotations (Proposal #195) There are three problems with the current API: 1. It is hard to properly write instances for ``Quote m => m (TExp a)`` as the type is the composition of two type constructors. Doing so in your program involves making your own newtype and doing a lot of wrapping/unwrapping. For example, if I want to create a language which I can either run immediately or generate code from I could write the following with the new API. :: class Lang r where _int :: Int -> r Int _if :: r Bool -> r a -> r a -> r a instance Lang Identity where _int = Identity _if (Identity b) (Identity t) (Identity f) = Identity (if b then t else f) instance Quote m => Lang (Code m) where _int = liftTyped _if cb ct cf = [|| if $$cb then $$ct else $$cf ||] 2. When doing code generation it is common to want to store code fragments in a map. When doing typed code generation, these code fragments contain a type index so it is desirable to store them in one of the parameterised map data types such as ``DMap`` from ``dependent-map`` or ``MapF`` from ``parameterized-utils``. :: compiler :: Env -> AST a -> Code Q a data AST a where ... data Ident a = ... type Env = MapF Ident (Code Q) newtype Code m a = Code (m (TExp a)) In this example, the ``MapF`` maps an ``Ident String`` directly to a ``Code Q String``. Using one of these map types currently requires creating your own newtype and constantly wrapping every quotation and unwrapping it when using a splice. Achievable, but it creates even more syntactic noise than normal metaprogramming. 3. ``m (TExp a)`` is ugly to read and write, understanding ``Code m a`` is easier. This is a weak reason but one everyone can surely agree with. Updates text submodule. - - - - - 58235d46 by Ben Gamari at 2020-07-21T14:47:28-04:00 users-guide: Fix :rts-flag:`--copying-gc` documentation It was missing a newline. - - - - - 19e80b9a by Vladislav Zavialov at 2020-07-21T14:50:01-04:00 Accumulate Haddock comments in P (#17544, #17561, #8944) Haddock comments are, first and foremost, comments. It's very annoying to incorporate them into the grammar. We can take advantage of an important property: adding a Haddock comment does not change the parse tree in any way other than wrapping some nodes in HsDocTy and the like (and if it does, that's a bug). This patch implements the following: * Accumulate Haddock comments with their locations in the P monad. This is handled in the lexer. * After parsing, do a pass over the AST to associate Haddock comments with AST nodes using location info. * Report the leftover comments to the user as a warning (-Winvalid-haddock). - - - - - 4c719460 by David Binder at 2020-07-22T20:17:35-04:00 Fix dead link to haskell prime discussion - - - - - f2f817e4 by BinderDavid at 2020-07-22T20:17:35-04:00 Replace broken links to old haskell-prime site by working links to gitlab instance. [skip ci] - - - - - 0bf8980e by Daniel Gröber at 2020-07-22T20:18:11-04:00 Remove length field from FastString - - - - - 1010c33b by Daniel Gröber at 2020-07-22T20:18:11-04:00 Use ShortByteString for FastString There are multiple reasons we want this: - Fewer allocations: ByteString has 3 fields, ShortByteString just has one. - ByteString memory is pinned: - This can cause fragmentation issues (see for example #13110) but also - makes using FastStrings in compact regions impossible. Metric Decrease: T5837 T12150 T12234 T12425 - - - - - 8336ba78 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Pass specialised utf8DecodeChar# to utf8DecodeLazy# for performance Currently we're passing a indexWord8OffAddr# type function to utf8DecodeLazy# which then passes it on to utf8DecodeChar#. By passing one of utf8DecodeCharAddr# or utf8DecodeCharByteArray# instead we benefit from the inlining and specialization already done for those. - - - - - 7484a9a4 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Encoding: Add comment about tricky ForeignPtr lifetime - - - - - 5536ed28 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Use IO constructor instead of `stToIO . ST` - - - - - 5b8902e3 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Encoding: Remove redundant use of withForeignPtr - - - - - 5976a161 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Encoding: Reformat utf8EncodeShortByteString to be more consistent - - - - - 9ddf1614 by Daniel Gröber at 2020-07-22T20:18:11-04:00 FastString: Reintroduce character count cache Metric Increase: ManyConstructors Metric Decrease: T4029 - - - - - e9491668 by Ben Gamari at 2020-07-22T20:18:46-04:00 get-win32-tarballs: Fix detection of missing tarballs This fixes the error message given by configure when the user attempts to configure without first download the win32 tarballs. - - - - - 9f3ff8fd by Andreas Klebinger at 2020-07-22T20:19:22-04:00 Enable BangPatterns, ScopedTypeVariables for ghc and hadrian by default. This is only for their respective codebases. - - - - - 0f17b930 by Sylvain Henry at 2020-07-22T20:19:59-04:00 Remove unused "ncg" flag This flag has been removed in 066b369de2c6f7da03c88206288dca29ab061b31 in 2011. - - - - - bab4ec8f by Sylvain Henry at 2020-07-22T20:19:59-04:00 Don't panic if the NCG isn't built (it is always built) - - - - - 8ea33edb by Sylvain Henry at 2020-07-22T20:19:59-04:00 Remove unused sGhcWithNativeCodeGen - - - - - e079bb72 by Sylvain Henry at 2020-07-22T20:19:59-04:00 Correctly test active backend Previously we used a platform settings to detect if the native code generator was used. This was wrong. We need to use the `DynFlags.hscTarget` field instead. - - - - - 735f9d6b by Sylvain Henry at 2020-07-22T20:19:59-04:00 Replace ghcWithNativeCodeGen with a proper Backend datatype * Represent backends with a `Backend` datatype in GHC.Driver.Backend * Don't detect the default backend to use for the target platform at compile time in Hadrian/make but at runtime. It makes "Settings" simpler and it is a step toward making GHC multi-target. * The latter change also fixes hadrian which has not been updated to take into account that the NCG now supports AIX and PPC64 (cf df26b95559fd467abc0a3a4151127c95cb5011b9 and d3c1dda60d0ec07fc7f593bfd83ec9457dfa7984) * Also we don't treat iOS specifically anymore (cf cb4878ffd18a3c70f98bdbb413cd3c4d1f054e1f) - - - - - f7cc4313 by Sylvain Henry at 2020-07-22T20:19:59-04:00 Replace HscTarget with Backend They both have the same role and Backend name is more explicit. Metric Decrease: T3064 Update Haddock submodule - - - - - 15ce1804 by Andreas Klebinger at 2020-07-22T20:20:34-04:00 Deprecate -fdmd-tx-dict-sel. It's behaviour is now unconditionally enabled as it's slightly beneficial. There are almost no benchmarks which benefit from disabling it, so it's not worth the keep this configurable. This fixes #18429. - - - - - ff1b7710 by Sylvain Henry at 2020-07-22T20:21:11-04:00 Add test for #18064 It has been fixed by 0effc57d48ace6b719a9f4cbeac67c95ad55010b - - - - - cfa89149 by Krzysztof Gogolewski at 2020-07-22T20:21:48-04:00 Define type Void# = (# #) (#18441) There's one backwards compatibility issue: GHC.Prim no longer exports Void#, we now manually re-export it from GHC.Exts. - - - - - 02f40b0d by Sebastian Graf at 2020-07-22T20:22:23-04:00 Add regression test for #18478 !3392 backported !2993 to GHC 8.10.2 which most probably is responsible for fixing #18478, which triggered a pattern match checker performance regression in GHC 8.10.1 as first observed in #17977. - - - - - 7f44df1e by Sylvain Henry at 2020-07-22T20:23:00-04:00 Minor refactoring of Unit display * for consistency, try to always use UnitPprInfo to display units to users * remove some uses of `unitPackageIdString` as it doesn't show the component name and it uses String - - - - - dff1cb3d by Moritz Angermann at 2020-07-23T07:55:29-04:00 [linker] Fix out of range relocations. mmap may return address all over the place. mmap_next will ensure we get the next free page after the requested address. This is especially important for linking on aarch64, where the memory model with PIC admits relocations in the +-4GB range, and as such we can't work with arbitrary object locations in memory. Of note: we map the rts into process space, so any mapped objects must not be ouside of the 4GB from the processes address space. - - - - - cdd0ff16 by Tamar Christina at 2020-07-24T18:12:23-04:00 winio: restore console cp on exit - - - - - c1f4f81d by Tamar Christina at 2020-07-24T18:13:00-04:00 winio: change memory allocation strategy and fix double free errors. - - - - - ba205046 by Simon Peyton Jones at 2020-07-24T18:13:35-04:00 Care with occCheckExpand in kind of occurrences Issue #18451 showed that we could get an infinite type, through over-use of occCheckExpand in the kind of an /occurrence/ of a type variable. See Note [Occurrence checking: look inside kinds] in GHC.Core.Type This patch fixes the problem by making occCheckExpand less eager to expand synonyms in kinds. It also improves pretty printing of kinds, by *not* suppressing the kind on a tyvar-binder like (a :: Const Type b) where type Const p q = p. Even though the kind of 'a' is Type, we don't want to suppress the kind ascription. Example: the error message for polykinds/T18451{a,b}. See GHC.Core.TyCo.Ppr Note [Suppressing * kinds]. - - - - - 02133353 by Zubin Duggal at 2020-07-25T00:44:30-04:00 Simplify XRec definition Change `Located X` usage to `XRec pass X` This increases the scope of the LPat experiment to almost all of GHC. Introduce UnXRec and MapXRec classes Fixes #17587 and #18408 Updates haddock submodule Co-authored-by: Philipp Krüger <philipp.krueger1 at gmail.com> - - - - - e443846b by Sylvain Henry at 2020-07-25T00:45:07-04:00 DynFlags: store printer in TraceBinIfaceReading We don't need to pass the whole DynFlags, just pass the logging function, if any. - - - - - 15b2b44f by Sylvain Henry at 2020-07-25T00:45:08-04:00 Rename GHC.Driver.Ways into GHC.Platform.Ways - - - - - 342a01af by Sylvain Henry at 2020-07-25T00:45:08-04:00 Add GHC.Platform.Profile - - - - - 6333d739 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Put PlatformConstants into Platform - - - - - 9dfeca6c by Sylvain Henry at 2020-07-25T00:45:08-04:00 Remove platform constant wrappers Platform constant wrappers took a DynFlags parameter, hence implicitly used the target platform constants. We removed them to allow support for several platforms at once (#14335) and to avoid having to pass the full DynFlags to every function (#17957). Metric Decrease: T4801 - - - - - 73145d57 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Remove dead code in utils/derivConstants - - - - - 7721b923 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Move GHC.Platform into the compiler Previously it was in ghc-boot so that ghc-pkg could use it. However it wasn't necessary because ghc-pkg only uses a subset of it: reading target arch and OS from the settings file. This is now done via GHC.Platform.ArchOS (was called PlatformMini before). - - - - - 459afeb5 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Fix build systems - - - - - 9e2930c3 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Bump CountParserDeps - - - - - 6e2db34b by Sylvain Henry at 2020-07-25T00:45:08-04:00 Add accessors to ArchOS - - - - - fc0f6fbc by Stefan Schulze Frielinghaus at 2020-07-25T00:45:45-04:00 Require SMP support in order to build a threaded stage1 Fixes 18266 - - - - - a7c4439a by Matthias Andreas Benkard at 2020-07-26T13:23:24-04:00 Document loadFramework changes. (#18446) Adds commentary on the rationale for the changes made in merge request !3689. - - - - - da7269a4 by Ben Gamari at 2020-07-26T13:23:59-04:00 rts/win32: Exit with EXIT_HEAPOVERFLOW if memory commit fails Since switching to the two-step allocator, the `outofmem` test fails via `osCommitMemory` failing to commit. However, this was previously exiting with `EXIT_FAILURE`, rather than `EXIT_HEAPOVERFLOW`. I think the latter is a more reasonable exit code for this case and matches the behavior on POSIX platforms. - - - - - f153a1d0 by Ben Gamari at 2020-07-26T13:23:59-04:00 testsuite: Update win32 output for parseTree - - - - - e91672f0 by Ben Gamari at 2020-07-26T13:23:59-04:00 testsuite: Normalise WinIO error message differences Previously the old Windows IO manager threw different errors than WinIO. We now canonicalise these to the WinIO errors. - - - - - 9cbfe086 by Ben Gamari at 2020-07-26T13:23:59-04:00 gitlab-ci: Kill ssh-agent after pushing test metrics Otherwise the Windows builds hang forever waiting for the process to terminate. - - - - - 8236925f by Tamar Christina at 2020-07-26T13:24:35-04:00 winio: remove dead argument to stg_newIOPortzh - - - - - ce0a1d67 by Tamar Christina at 2020-07-26T13:25:11-04:00 winio: fix detection of tty terminals - - - - - 52685cf7 by Tamar Christina at 2020-07-26T13:25:48-04:00 winio: update codeowners - - - - - aee45d9e by Vladislav Zavialov at 2020-07-27T07:06:56-04:00 Improve NegativeLiterals (#18022, GHC Proposal #344) Before this patch, NegativeLiterals used to parse x-1 as x (-1). This may not be what the user expects, and now it is fixed: x-1 is parsed as (-) x 1. We achieve this by the following requirement: * When lexing a negative literal, it must not be preceded by a 'closing token'. This also applies to unboxed literals, e.g. -1#. See GHC Proposal #229 for the definition of a closing token. A nice consequence of this change is that -XNegativeLiterals becomes a subset of -XLexicalNegation. In other words, enabling both of those extensions has the same effect as enabling -XLexicalNegation alone. - - - - - 667ab69e by leiftw at 2020-07-27T07:07:32-04:00 fix typo referring to non-existent `-ohidir` flag, should be `-hidir` I think - - - - - 6ff89c17 by Vladislav Zavialov at 2020-07-27T07:08:07-04:00 Refactor the parser a little * Create a dedicated production for type operators * Create a dedicated type for the UNPACK pragma * Remove an outdated part of Note [Parsing data constructors is hard] - - - - - aa054d32 by Ben Gamari at 2020-07-27T20:09:07-04:00 Drop 32-bit Windows support As noted in #18487, we have reached the end of this road. - - - - - 6da73bbf by Michalis Pardalos at 2020-07-27T20:09:44-04:00 Add minimal test for #12492 - - - - - 47680cb7 by Michalis Pardalos at 2020-07-27T20:09:44-04:00 Use allocate, not ALLOC_PRIM_P for unpackClosure# ALLOC_PRIM_P fails for large closures, by directly using allocate we can handle closures which are larger than the block size. Fixes #12492 - - - - - 3d345c96 by Simon Peyton Jones at 2020-07-27T20:10:19-04:00 Eta-expand the Simplifier monad This patch eta-expands the Simplifier's monad, using the method explained in GHC.Core.Unify Note [The one-shot state monad trick]. It's part of the exta-expansion programme in #18202. It's a tiny patch, but is worth a 1-2% reduction in bytes-allocated by the compiler. Here's the list, based on the compiler-performance tests in perf/compiler: Reduction in bytes allocated T10858(normal) -0.7% T12425(optasm) -1.3% T13056(optasm) -1.8% T14683(normal) -1.1% T15164(normal) -1.3% T15630(normal) -1.4% T17516(normal) -2.3% T18282(normal) -1.6% T18304(normal) -0.8% T1969(normal) -0.6% T4801(normal) -0.8% T5321FD(normal) -0.7% T5321Fun(normal) -0.5% T5642(normal) -0.9% T6048(optasm) -1.1% T9020(optasm) -2.7% T9233(normal) -0.7% T9675(optasm) -0.5% T9961(normal) -2.9% WWRec(normal) -1.2% Metric Decrease: T12425 T9020 T9961 - - - - - 57aca6bb by Ben Gamari at 2020-07-27T20:10:54-04:00 gitlab-ci: Ensure that Hadrian jobs don't download artifacts Previously the Hadrian jobs had the default dependencies, meaning that they would download artifacts from all jobs of earlier stages. This is unneccessary. - - - - - 0a815cea by Ben Gamari at 2020-07-27T20:10:54-04:00 gitlab-ci: Bump bootstrap compiler to 8.8.4 Hopefully this will make the Windows jobs a bit more reliable. - - - - - 0bd60059 by Simon Peyton Jones at 2020-07-28T02:01:49-04:00 This patch addresses the exponential blow-up in the simplifier. Specifically: #13253 exponential inlining #10421 ditto #18140 strict constructors #18282 another nested-function call case This patch makes one really significant changes: change the way that mkDupableCont handles StrictArg. The details are explained in GHC.Core.Opt.Simplify Note [Duplicating StrictArg]. Specific changes * In mkDupableCont, when making auxiliary bindings for the other arguments of a call, add extra plumbing so that we don't forget the demand on them. Otherwise we haev to wait for another round of strictness analysis. But actually all the info is to hand. This change affects: - Make the strictness list in ArgInfo be [Demand] instead of [Bool], and rename it to ai_dmds. - Add as_dmd to ValArg - Simplify.makeTrivial takes a Demand - mkDupableContWithDmds takes a [Demand] There are a number of other small changes 1. For Ids that are used at most once in each branch of a case, make the occurrence analyser record the total number of syntactic occurrences. Previously we recorded just OneBranch or MultipleBranches. I thought this was going to be useful, but I ended up barely using it; see Note [Note [Suppress exponential blowup] in GHC.Core.Opt.Simplify.Utils Actual changes: * See the occ_n_br field of OneOcc. * postInlineUnconditionally 2. I found a small perf buglet in SetLevels; see the new function GHC.Core.Opt.SetLevels.hasFreeJoin 3. Remove the sc_cci field of StrictArg. I found I could get its information from the sc_fun field instead. Less to get wrong! 4. In ArgInfo, arrange that ai_dmds and ai_discs have a simpler invariant: they line up with the value arguments beyond ai_args This allowed a bit of nice refactoring; see isStrictArgInfo, lazyArgcontext, strictArgContext There is virtually no difference in nofib. (The runtime numbers are bogus -- I tried a few manually.) Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- fft +0.0% -2.0% -48.3% -49.4% 0.0% multiplier +0.0% -2.2% -50.3% -50.9% 0.0% -------------------------------------------------------------------------------- Min -0.4% -2.2% -59.2% -60.4% 0.0% Max +0.0% +0.1% +3.3% +4.9% 0.0% Geometric Mean +0.0% -0.0% -33.2% -34.3% -0.0% Test T18282 is an existing example of these deeply-nested strict calls. We get a big decrease in compile time (-85%) because so much less inlining takes place. Metric Decrease: T18282 - - - - - 6ee07b49 by Sylvain Henry at 2020-07-28T02:02:27-04:00 Bignum: add support for negative shifts (fix #18499) shiftR/shiftL support negative arguments despite Haskell 2010 report saying otherwise. We explicitly test for negative values which is bad (it gets in the way of constant folding, etc.). Anyway, for consistency we fix Bits instancesof Integer/Natural. - - - - - f305bbfd by Peter Trommler at 2020-07-28T02:03:02-04:00 config: Fix Haskell platform constructor w/ params Fixes #18505 - - - - - 318bb17c by Oleg Grenrus at 2020-07-28T20:54:13-04:00 Fix typo in haddock Spotted by `vilpan` on `#haskell` - - - - - 39c89862 by Sergei Trofimovich at 2020-07-28T20:54:50-04:00 ghc/mk: don't build gmp packages for BIGNUM_BACKEND=native Before this change make-based `BIGNUM_BACKEND=native` build was failing as: ``` x86_64-pc-linux-gnu-gcc: error: libraries/ghc-bignum/gmp/objs/*.o: No such file or directory ``` This happens because ghc.mk was pulling in gmp-dependent ghc-bignum library unconditionally. The change avoid building ghc-bignum. Bug: https://gitlab.haskell.org/ghc/ghc/-/issues/18437 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - b9a880fc by Felix Wiemuth at 2020-07-29T15:06:35-04:00 Fix typo - - - - - c59064b0 by Brandon Chinn at 2020-07-29T15:07:11-04:00 Add regression test for #16341 - - - - - a61411ca by Brandon Chinn at 2020-07-29T15:07:11-04:00 Pass dit_rep_tc_args to dsm_stock_gen_fn - - - - - a26498da by Brandon Chinn at 2020-07-29T15:07:11-04:00 Pass tc_args to gen_fn - - - - - 44b11bad by Brandon Chinn at 2020-07-29T15:07:11-04:00 Filter out unreachable constructors when deriving stock instances (#16431) - - - - - bbc51916 by Simon Peyton Jones at 2020-07-29T15:07:47-04:00 Kill off sc_mult and as_mult fields They are readily derivable from other fields, so this is more efficient, and less error prone. Fixes #18494 - - - - - e3db4b4c by Peter Trommler at 2020-07-29T15:08:22-04:00 configure: Fix build system on ARM - - - - - 96c31ea1 by Sylvain Henry at 2020-07-29T15:09:02-04:00 Fix bug in Natural multiplication (fix #18509) A bug was lingering in Natural multiplication (inverting two limbs) despite QuickCheck tests used during the development leading to wrong results (independently of the selected backend). - - - - - e1dc3d7b by Krzysztof Gogolewski at 2020-07-29T15:09:39-04:00 Fix validation errors (#18510) Test T2632 is a stage1 test that failed because of the Q => Quote change. The remaining tests did not use quotation and failed when the path contained a space. - - - - - 6c68a842 by John Ericson at 2020-07-30T07:11:02-04:00 For `-fkeep-going` do not duplicate dependency edge code We now compute the deps for `-fkeep-going` the same way that the original graph calculates them, so the edges are correct. Upsweep really ought to take the graph rather than a topological sort so we are never recalculating anything, but at least things are recaluclated consistently now. - - - - - 502de556 by cgibbard at 2020-07-30T07:11:02-04:00 Add haddock comment for unfilteredEdges and move the note about drop_hs_boot_nodes into it. - - - - - 01c948eb by Ryan Scott at 2020-07-30T07:11:37-04:00 Clean up the inferred type variable restriction This patch primarily: * Documents `checkInferredVars` (previously called `check_inferred_vars`) more carefully. This is the function which throws an error message if a user quantifies an inferred type variable in a place where specificity cannot be observed. See `Note [Unobservably inferred type variables]` in `GHC.Rename.HsType`. Note that I now invoke `checkInferredVars` _alongside_ `rnHsSigType`, `rnHsWcSigType`, etc. rather than doing so _inside_ of these functions. This results in slightly more call sites for `checkInferredVars`, but it makes it much easier to enumerate the spots where the inferred type variable restriction comes into effect. * Removes the inferred type variable restriction for default method type signatures, per the discussion in #18432. As a result, this patch fixes #18432. Along the way, I performed some various cleanup: * I moved `no_nested_foralls_contexts_err` into `GHC.Rename.Utils` (under the new name `noNestedForallsContextsErr`), since it now needs to be invoked from multiple modules. I also added a helper function `addNoNestedForallsContextsErr` that throws the error message after producing it, as this is a common idiom. * In order to ensure that users cannot sneak inferred type variables into `SPECIALISE instance` pragmas by way of nested `forall`s, I now invoke `addNoNestedForallsContextsErr` when renaming `SPECIALISE instance` pragmas, much like when we rename normal instance declarations. (This probably should have originally been done as a part of the fix for #18240, but this task was somehow overlooked.) As a result, this patch fixes #18455 as a side effect. - - - - - d47324ce by Ryan Scott at 2020-07-30T07:12:16-04:00 Don't mark closed type family equations as occurrences Previously, `rnFamInstEqn` would mark the name of the type/data family used in an equation as an occurrence, regardless of what sort of family it is. Most of the time, this is the correct thing to do. The exception is closed type families, whose equations constitute its definition and therefore should not be marked as occurrences. Overzealously counting the equations of a closed type family as occurrences can cause certain warnings to not be emitted, as observed in #18470. See `Note [Type family equations and occurrences]` in `GHC.Rename.Module` for the full story. This fixes #18470 with a little bit of extra-casing in `rnFamInstEqn`. To accomplish this, I added an extra `ClosedTyFamInfo` field to the `NonAssocTyFamEqn` constructor of `AssocTyFamInfo` and refactored the relevant call sites accordingly so that this information is propagated to `rnFamInstEqn`. While I was in town, I moved `wrongTyFamName`, which checks that the name of a closed type family matches the name in an equation for that family, from the renamer to the typechecker to avoid the need for an `ASSERT`. As an added bonus, this lets us simplify the details of `ClosedTyFamInfo` a bit. - - - - - ebe2cf45 by Simon Peyton Jones at 2020-07-30T07:12:52-04:00 Remove an incorrect WARN in extendLocalRdrEnv I noticed this warning going off, and discovered that it's really fine. This small patch removes the warning, and docments what is going on. - - - - - 9f71f697 by Simon Peyton Jones at 2020-07-30T07:13:27-04:00 Add two bangs to improve perf of flattening This tiny patch improves the compile time of flatten-heavy programs by 1-2%, by adding two bangs. Addresses (somewhat) #18502 This reduces allocation by T9872b -1.1% T9872d -3.3% T5321Fun -0.2% T5631 -0.2% T5837 +0.1% T6048 +0.1% Metric Decrease: T9872b T9872d - - - - - 7c274cd5 by Sylvain Henry at 2020-07-30T22:54:48-04:00 Fix minimal imports dump for boot files (fix #18497) - - - - - 175cb5b4 by Sylvain Henry at 2020-07-30T22:55:25-04:00 DynFlags: don't use sdocWithDynFlags in datacon ppr We don't need to use `sdocWithDynFlags` to know whether we should display linear types for datacon types, we already have `sdocLinearTypes` field in `SDocContext`. Moreover we want to remove `sdocWithDynFlags` (#10143, #17957)). - - - - - 380638a3 by Sylvain Henry at 2020-07-30T22:56:03-04:00 Bignum: fix powMod for gmp backend (#18515) Also reenable integerPowMod test which had never been reenabled by mistake. - - - - - 56a7c193 by Sylvain Henry at 2020-07-31T19:32:09+02:00 Refactor CLabel pretty-printing Pretty-printing CLabel relies on sdocWithDynFlags that we want to remove (#10143, #17957). It uses it to query the backend and the platform. This patch exposes Clabel ppr functions specialised for each backend so that backend code can directly use them. - - - - - 3b15dc3c by Sylvain Henry at 2020-07-31T19:32:09+02:00 DynFlags: don't use sdocWithDynFlags in GHC.CmmToAsm.Dwarf.Types - - - - - e30fed6c by Vladislav Zavialov at 2020-08-01T04:23:04-04:00 Test case for #17652 The issue was fixed by 19e80b9af252eee760dc047765a9930ef00067ec - - - - - 22641742 by Ryan Scott at 2020-08-02T16:44:11-04:00 Remove ConDeclGADTPrefixPs This removes the `ConDeclGADTPrefixPs` per the discussion in #18517. Most of this patch simply removes code, although the code in the `rnConDecl` case for `ConDeclGADTPrefixPs` had to be moved around a bit: * The nested `forall`s check now lives in the `rnConDecl` case for `ConDeclGADT`. * The `LinearTypes`-specific code that used to live in the `rnConDecl` case for `ConDeclGADTPrefixPs` now lives in `GHC.Parser.PostProcess.mkGadtDecl`, which is now monadic so that it can check if `-XLinearTypes` is enabled. Fixes #18157. - - - - - f2d1accf by Leon Schoorl at 2020-08-02T16:44:47-04:00 Fix GHC_STAGE definition generated by make Fixes #18070 GHC_STAGE is the stage of the compiler we're building, it should be 1,2(,3?). But make was generating 0 and 1. Hadrian does this correctly using a similar `+ 1`: https://gitlab.haskell.org/ghc/ghc/-/blob/eb8115a8c4cbc842b66798480fefc7ab64d31931/hadrian/src/Rules/Generate.hs#L245 - - - - - 947206f4 by Niklas Hambüchen at 2020-08-03T07:52:33+02:00 hadrian: Fix running stage0/bin/ghc with wrong package DB. Fixes #17468. In the invocation of `cabal configure`, `--ghc-pkg-option=--global-package-db` was already given correctly to tell `stage0/bin/ghc-pkg` that it should use the package DB in `stage1/`. However, `ghc` needs to be given this information as well, not only `ghc-pkg`! Until now that was not the case; the package DB in `stage0` was given to `ghc` instead. This was wrong, because there is no binary compatibility guarantee that says that the `stage0` DB's `package.cache` (which is written by the stage0 == system-provided ghc-pkg) can be deserialised by the `ghc-pkg` from the source code tree. As a result, when trying to add fields to `InstalledPackageInfo` that get serialised into / deserialised from the `package.cache`, errors like _build/stage0/lib/package.conf.d/package.cache: GHC.PackageDb.readPackageDb: inappropriate type (Not a valid Unicode code point!) would appear. This was because the `stage0/bin/ghc would try to deserialise the newly added fields from `_build/stage0/lib/package.conf.d/package.cache`, but they were not in there because the system `ghc-pkg` doesn't know about them and thus didn't write them there. It would try to do that because any GHC by default tries to read the global package db in `../lib/package.conf.d/package.cache`. For `stage0/bin/ghc` that *can never work* as explained above, so we must disable this default via `-no-global-package-db` and give it the correct package DB explicitly. This is the same problem as #16534, and the same fix as in MR !780 (but in another context; that one was for developers trying out the `stage0/bin/ghc` == `_build/ghc-stage1` interactively, while this fix is for a `cabal configure` invocation). I also noticed that the fix for #16534 forgot to pass `-no-global-package-db`, and have fixed that in this commit as well. It only worked until now because nobody tried to add a new ghc-pkg `.conf` field since the introduction of Hadrian. - - - - - ef2ae81a by Alex Biehl at 2020-08-03T07:52:33+02:00 Hardcode RTS includes to cope with unregistered builds - - - - - d613ed76 by Sylvain Henry at 2020-08-05T03:59:27-04:00 Bignum: add backward compat integer-gmp functions Also enhance bigNatCheck# and isValidNatural test - - - - - 3f2f7718 by Sylvain Henry at 2020-08-05T03:59:27-04:00 Bignum: add more BigNat compat functions in integer-gmp - - - - - 5e12cd17 by Krzysztof Gogolewski at 2020-08-05T04:00:04-04:00 Rename Core.Opt.Driver -> Core.Opt.Pipeline Closes #18504. - - - - - 2bff2f87 by Ben Gamari at 2020-08-05T04:00:39-04:00 Revert "iserv: Don't pass --export-dynamic on FreeBSD" This reverts commit 2290eb02cf95e9cfffcb15fc9c593d5ef79c75d9. - - - - - 53ce0db5 by Ben Gamari at 2020-08-05T04:00:39-04:00 Refactor handling of object merging Previously to merge a set of object files we would invoke the linker as usual, adding -r to the command-line. However, this can result in non-sensical command-lines which causes lld to balk (#17962). To avoid this we introduce a new tool setting into GHC, -pgmlm, which is the linker which we use to merge object files. - - - - - eb7013c3 by Hécate at 2020-08-05T04:01:15-04:00 Remove all the unnecessary LANGUAGE pragmas - - - - - fbcb886d by Ryan Scott at 2020-08-05T04:01:51-04:00 Make CodeQ and TExpQ levity polymorphic The patch is quite straightforward. The only tricky part is that `Language.Haskell.TH.Lib.Internal` now must be `Trustworthy` instead of `Safe` due to the `GHC.Exts` import (in order to import `TYPE`). Since `CodeQ` has yet to appear in any released version of `template-haskell`, I didn't bother mentioning the change to `CodeQ` in the `template-haskell` release notes. Fixes #18521. - - - - - 686e06c5 by Vladislav Zavialov at 2020-08-06T13:34:05-04:00 Grammar for types and data/newtype constructors Before this patch, we parsed types into a reversed sequence of operators and operands. For example, (F x y + G a b * X) would be parsed as [X, *, b, a, G, +, y, x, F], using a simple grammar: tyapps : tyapp | tyapps tyapp tyapp : atype | PREFIX_AT atype | tyop | unpackedness Then we used a hand-written state machine to assemble this either into a type, using 'mergeOps', or into a constructor, using 'mergeDataCon'. This is due to a syntactic ambiguity: data T1 a = MkT1 a data T2 a = Ord a => MkT2 a In T1, what follows after the = sign is a data/newtype constructor declaration. However, in T2, what follows is a type (of kind Constraint). We don't know which of the two we are parsing until we encounter =>, and we cannot check for => without unlimited lookahead. This poses a few issues when it comes to e.g. infix operators: data I1 = Int :+ Bool :+ Char -- bad data I2 = Int :+ Bool :+ Char => MkI2 -- fine By this issue alone we are forced into parsing into an intermediate representation and doing a separate validation pass. However, should that intermediate representation be as low-level as a flat sequence of operators and operands? Before GHC Proposal #229, the answer was Yes, due to some particularly nasty corner cases: data T = ! A :+ ! B -- used to be fine, hard to parse data T = ! A :+ ! B => MkT -- bad However, now the answer is No, as this corner case is gone: data T = ! A :+ ! B -- bad data T = ! A :+ ! B => MkT -- bad This means we can write a proper grammar for types, overloading it in the DisambECP style, see Note [Ambiguous syntactic categories]. With this patch, we introduce a new class, DisambTD. Just like DisambECP is used to disambiguate between expressions, commands, and patterns, DisambTD is used to disambiguate between types and data/newtype constructors. This way, we get a proper, declarative grammar for constructors and types: infixtype : ftype | ftype tyop infixtype | unpackedness infixtype ftype : atype | tyop | ftype tyarg | ftype PREFIX_AT tyarg tyarg : atype | unpackedness atype And having a grammar for types means we are a step closer to using a single grammar for types and expressions. - - - - - 6770e199 by Vladislav Zavialov at 2020-08-06T13:34:05-04:00 Clean up the story around runPV/runECP_P/runECP_PV This patch started as a small documentation change, an attempt to make Note [Parser-Validator] and Note [Ambiguous syntactic categories] more clear and up-to-date. But it turned out that runECP_P/runECP_PV are weakly motivated, and it's easier to remove them than to find a good rationale/explanation for their existence. As the result, there's a bit of refactoring in addition to a documentation update. - - - - - 826d07db by Vladislav Zavialov at 2020-08-06T13:34:06-04:00 Fix debug_ppr_ty ForAllTy (#18522) Before this change, GHC would pretty-print forall k. forall a -> () as forall @k a. () which isn't even valid Haskell. - - - - - 0ddb4384 by Vladislav Zavialov at 2020-08-06T13:34:06-04:00 Fix visible forall in ppr_ty (#18522) Before this patch, this type: T :: forall k -> (k ~ k) => forall j -> k -> j -> Type was printed incorrectly as: T :: forall k j -> (k ~ k) => k -> j -> Type - - - - - d2a43225 by Richard Eisenberg at 2020-08-06T13:34:06-04:00 Fail eagerly on a lev-poly datacon arg Close #18534. See commentary in the patch. - - - - - 63348155 by Sylvain Henry at 2020-08-06T13:34:08-04:00 Use a type alias for Ways - - - - - 9570c212 by Takenobu Tani at 2020-08-06T19:46:46-04:00 users-guide: Rename 8.12 to 9.0 GHC 8.12.1 has been renamed to GHC 9.0.1. See also: https://mail.haskell.org/pipermail/ghc-devs/2020-July/019083.html [skip ci] - - - - - 3907ee01 by Cale Gibbard at 2020-08-07T08:34:46-04:00 A fix to an error message in monad comprehensions, and a move of dsHandleMonadicFailure as suggested by comments on !2330. - - - - - fa9bb70a by Cale Gibbard at 2020-08-07T08:34:46-04:00 Add some tests for fail messages in do-expressions and monad-comprehensions. - - - - - 5f036063 by Ben Gamari at 2020-08-07T08:35:21-04:00 cmm: Clean up Notes a bit - - - - - 6402c124 by Ben Gamari at 2020-08-07T08:35:21-04:00 CmmLint: Check foreign call argument register invariant As mentioned in Note [Register parameter passing] the arguments of foreign calls cannot refer to caller-saved registers. - - - - - 15b36de0 by Ben Gamari at 2020-08-07T08:35:21-04:00 nativeGen: One approach to fix #18527 Previously the code generator could produce corrupt C call sequences due to register overlap between MachOp lowerings and the platform's calling convention. We fix this using a hack described in Note [Evaluate C-call arguments before placing in destination registers]. - - - - - 3847ae0c by Ben Gamari at 2020-08-07T08:35:21-04:00 testsuite: Add test for #18527 - - - - - dd51d53b by Ben Gamari at 2020-08-07T08:35:21-04:00 testsuite: Fix prog001 Previously it failed as the `ghc` package was not visible. - - - - - e4f1b73a by Alan Zimmerman at 2020-08-07T23:58:10-04:00 ApiAnnotations; tweaks for ghc-exactprint update Remove unused ApiAnns, add one for linear arrow. Include API Annotations for trailing comma in export list. - - - - - 8a665db6 by Ben Gamari at 2020-08-07T23:58:45-04:00 configure: Fix double-negation in ld merge-objects check We want to only run the check if ld is gold. Fixes the fix to #17962. - - - - - a11c9678 by Adam Sandberg Ericsson at 2020-08-09T11:32:25+02:00 hadrian: depend on boot compiler version #18001 - - - - - c8873b52 by Alan Zimmerman at 2020-08-09T21:17:54-04:00 Api Annotations : Adjust SrcSpans for prefix bang (!). And prefix ~ (cherry picked from commit 8dbee2c578b1f642d45561be3f416119863e01eb) - - - - - 77398b67 by Sylvain Henry at 2020-08-09T21:18:34-04:00 Avoid allocations in `splitAtList` (#18535) As suspected by @simonpj in #18535, avoiding allocations in `GHC.Utils.Misc.splitAtList` when there are no leftover arguments is beneficial for performance: On CI validate-x86_64-linux-deb9-hadrian: T12227 -7% T12545 -12.3% T5030 -10% T9872a -2% T9872b -2.1% T9872c -2.5% Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c - - - - - 8ba41a0f by Felix Yan at 2020-08-10T20:23:29-04:00 Correct a typo in ghc.mk - - - - - 1c469264 by Felix Yan at 2020-08-10T20:23:29-04:00 Add a closing parenthesis too - - - - - acf537f9 by Sylvain Henry at 2020-08-10T20:24:09-04:00 Make splitAtList strict in its arguments Also fix its slightly wrong comment Metric Decrease: T5030 T12227 T12545 - - - - - ab4d1589 by Ben Gamari at 2020-08-11T22:18:03-04:00 typecheck: Drop SPECIALISE pragmas when there is no unfolding Previously the desugarer would instead fall over when it realized that there was no unfolding for an imported function with a SPECIALISE pragma. We now rather drop the SPECIALISE pragma and throw a warning. Fixes #18118. - - - - - 0ac8c0a5 by Ben Gamari at 2020-08-11T22:18:03-04:00 testsuite: Add test for #18118 - - - - - c43078d7 by Sven Tennie at 2020-08-11T22:18:38-04:00 Add hie.yaml to ghc-heap This enables IDE support by haskell-language-server for ghc-heap. - - - - - f1088b3f by Ben Gamari at 2020-08-11T22:19:15-04:00 testsuite: Specify metrics collected by T17516 Previously it collected everything, including "max bytes used". This is problematic since the test makes no attempt to control for deviations in GC timing, resulting in high variability. Fix this by only collecting "bytes allocated". - - - - - accbc242 by Sylvain Henry at 2020-08-12T03:50:12-04:00 DynFlags: disentangle Outputable - put panic related functions into GHC.Utils.Panic - put trace related functions using DynFlags in GHC.Driver.Ppr One step closer making Outputable fully independent of DynFlags. Bump haddock submodule - - - - - db6dd810 by Ben Gamari at 2020-08-12T03:50:48-04:00 testsuite: Increase tolerance of T16916 T16916 (testing #16916) has been slightly fragile in CI due to its reliance on CPU times. While it's hard to see how to eliminate the time-dependence entirely, we can nevertheless make it more tolerant. Fixes #16966. - - - - - bee43aca by Sylvain Henry at 2020-08-12T20:52:50-04:00 Rewrite and move the monad-state hack note The note has been rewritten by @simonpj in !3851 [skip ci] - - - - - 25fdf25e by Alan Zimmerman at 2020-08-12T20:53:26-04:00 ApiAnnotations: Fix parser for new GHC 9.0 features - - - - - 7831fe05 by Ben Gamari at 2020-08-13T03:44:17-04:00 parser: Suggest ImportQualifiedPost in prepositive import warning As suggested in #18545. - - - - - 55dec4dc by Sebastian Graf at 2020-08-13T03:44:52-04:00 PmCheck: Better long-distance info for where bindings (#18533) Where bindings can see evidence from the pattern match of the `GRHSs` they belong to, but not from anything in any of the guards (which belong to one of possibly many RHSs). Before this patch, we did *not* consider said evidence, causing #18533, where the lack of considering type information from a case pattern match leads to failure to resolve the vanilla COMPLETE set of a data type. Making available that information required a medium amount of refactoring so that `checkMatches` can return a `[(Deltas, NonEmpty Deltas)]`; one `(Deltas, NonEmpty Deltas)` for each `GRHSs` of the match group. The first component of the pair is the covered set of the pattern, the second component is one covered set per RHS. Fixes #18533. Regression test case: T18533 - - - - - cf97889a by Hécate at 2020-08-13T03:45:29-04:00 Re-add BangPatterns to CodePage.hs - - - - - ffc0d578 by Sylvain Henry at 2020-08-13T09:49:56-04:00 Add HomeUnit type Since Backpack the "home unit" is much more involved than what it was before (just an identifier obtained with `-this-unit-id`). Now it is used in conjunction with `-component-id` and `-instantiated-with` to configure module instantiations and to detect if we are type-checking an indefinite unit or compiling a definite one. This patch introduces a new HomeUnit datatype which is much easier to understand. Moreover to make GHC support several packages in the same instances, we will need to handle several HomeUnits so having a dedicated (documented) type is helpful. Finally in #14335 we will also need to handle the case where we have no HomeUnit at all because we are only loading existing interfaces for plugins which live in a different space compared to units used to produce target code. Several functions will have to be refactored to accept "Maybe HomeUnit" parameters instead of implicitly querying the HomeUnit fields in DynFlags. Having a dedicated type will make this easier. Bump haddock submodule - - - - - 8a51b2ab by Sylvain Henry at 2020-08-13T21:09:15-04:00 Make IOEnv monad one-shot (#18202) On CI (x86_64-linux-deb9-hadrian, compile_time/bytes_allocated): T10421 -1.8% (threshold: +/- 1%) T10421a -1.7% (threshold: +/- 1%) T12150 -4.9% (threshold: +/- 2%) T12227 -1.6 (threshold: +/- 1%) T12425 -1.5% (threshold: +/- 1%) T12545 -3.8% (threshold: +/- 1%) T12707 -3.0% (threshold: +/- 1%) T13035 -3.0% (threshold: +/- 1%) T14683 -10.3% (threshold: +/- 2%) T3064 -6.9% (threshold: +/- 2%) T4801 -4.3% (threshold: +/- 2%) T5030 -2.6% (threshold: +/- 2%) T5321FD -3.6% (threshold: +/- 2%) T5321Fun -4.6% (threshold: +/- 2%) T5631 -19.7% (threshold: +/- 2%) T5642 -13.0% (threshold: +/- 2%) T783 -2.7 (threshold: +/- 2%) T9020 -11.1 (threshold: +/- 2%) T9961 -3.4% (threshold: +/- 2%) T1969 (compile_time/bytes_allocated) -2.2% (threshold: +/-1%) T1969 (compile_time/max_bytes_used) +24.4% (threshold: +/-20%) Additionally on other CIs: haddock.Cabal -10.0% (threshold: +/- 5%) haddock.compiler -9.5% (threshold: +/- 5%) haddock.base (max bytes used) +24.6% (threshold: +/- 15%) T10370 (max bytes used, i386) +18.4% (threshold: +/- 15%) Metric Decrease: T10421 T10421a T12150 T12227 T12425 T12545 T12707 T13035 T14683 T3064 T4801 T5030 T5321FD T5321Fun T5631 T5642 T783 T9020 T9961 haddock.Cabal haddock.compiler Metric Decrease 'compile_time/bytes allocated': T1969 Metric Increase 'compile_time/max_bytes_used': T1969 T10370 haddock.base - - - - - 9f66fdf6 by Ben Gamari at 2020-08-14T15:50:34-04:00 testsuite: Drop --io-manager flag from testsuite configuration This is no longer necessary as there are now dedicated testsuite ways which run tests with WinIO. - - - - - 55fd1dc5 by Ben Gamari at 2020-08-14T15:51:10-04:00 llvm-targets: Add i686 targets Addresses #18422. - - - - - f4cc57fa by Ben Gamari at 2020-08-18T15:38:55-04:00 Allow unsaturated runRW# applications Previously we had a very aggressive Core Lint check which caught unsaturated applications of runRW#. However, there is nothing wrong with such applications and they may naturally arise in desugared Core. For instance, the desugared Core of Data.Primitive.Array.runArray# from the `primitive` package contains: case ($) (runRW# @_ @_) (\s -> ...) of ... In this case it's almost certain that ($) will be inlined, turning the application into a saturated application. However, even if this weren't the case there isn't a problem: CorePrep (after deleting an unnecessary case) can simply generate code in its usual way, resulting in a call to the Haskell definition of runRW#. Fixes #18291. - - - - - 3ac6ae7c by Ben Gamari at 2020-08-18T15:38:55-04:00 testsuite: Add test for #18291 - - - - - a87a0b49 by Eli Schwartz at 2020-08-18T15:39:30-04:00 install: do not install sphinx doctrees These files are 100% not needed at install time, and they contain unreproducible info. See https://reproducible-builds.org/ for why this matters. - - - - - 194b25ee by Ben Gamari at 2020-08-18T15:40:05-04:00 testsuite: Allow baseline commit to be set explicitly - - - - - fdcf7645 by Ben Gamari at 2020-08-18T15:40:05-04:00 gitlab-ci: Use MR base commit as performance baseline - - - - - 9ad5cab3 by Fendor at 2020-08-18T15:40:42-04:00 Expose UnitInfoMap as it is part of the public API - - - - - aa4b744d by Ben Gamari at 2020-08-18T22:11:36-04:00 testsuite: Only run llvm ways if llc is available As noted in #18560, we previously would always run the LLVM ways since `configure` would set `SettingsLlcCommand` to something non-null when it otherwise couldn't find the `llc` executable. Now we rather probe for the existence of the `llc` executable in the testsuite driver. Fixes #18560. - - - - - 0c5ed5c7 by Sylvain Henry at 2020-08-18T22:12:13-04:00 DynFlags: refactor GHC.CmmToAsm (#17957, #10143) This patch removes the use of `sdocWithDynFlags` from GHC.CmmToAsm.*.Ppr To do that I've had to make some refactoring: * X86' and PPC's `Instr` are no longer `Outputable` as they require a `Platform` argument * `Instruction` class now exposes `pprInstr :: Platform -> instr -> SDoc` * as a consequence, I've refactored some modules to avoid .hs-boot files * added (derived) functor instances for some datatypes parametric in the instruction type. It's useful for pretty-printing as we just have to map `pprInstr` before pretty-printing the container datatype. - - - - - 731c8d3b by nineonine at 2020-08-19T18:47:39-04:00 Implement -Wredundant-bang-patterns (#17340) Add new flag '-Wredundant-bang-patterns' that enables checks for "dead" bangs. Dead bangs are the ones that under no circumstances can force a thunk that wasn't already forced. Dead bangs are a form of redundant bangs. The new check is performed in Pattern-Match Coverage Checker along with other checks (namely, redundant and inaccessible RHSs). Given f :: Bool -> Int f True = 1 f !x = 2 we can detect dead bang patterns by checking whether @x ~ ⊥@ is satisfiable where the PmBang appears in 'checkGrdTree'. If not, then clearly the bang is dead. Such a dead bang is then indicated in the annotated pattern-match tree by a 'RedundantSrcBang' wrapping. In 'redundantAndInaccessibles', we collect all dead bangs to warn about. Note that we don't want to warn for a dead bang that appears on a redundant clause. That is because in that case, we recommend to delete the clause wholly, including its leading pattern match. Dead bang patterns are redundant. But there are bang patterns which are redundant that aren't dead, for example f !() = 0 the bang still forces the match variable, before we attempt to match on (). But it is redundant with the forcing done by the () match. We currently don't detect redundant bangs that aren't dead. - - - - - eb9bdaef by Simon Peyton Jones at 2020-08-19T18:48:14-04:00 Add right-to-left rule for pattern bindings Fix #18323 by adding a few lines of code to handle non-recursive pattern bindings. see GHC.Tc.Gen.Bind Note [Special case for non-recursive pattern bindings] Alas, this confused the pattern-match overlap checker; see #18323. Note that this patch only affects pattern bindings like that for (x,y) in this program combine :: (forall a . [a] -> a) -> [forall a. a -> a] -> ((forall a . [a] -> a), [forall a. a -> a]) breaks = let (x,y) = combine head ids in x y True We need ImpredicativeTypes for those [forall a. a->a] types to be valid. And with ImpredicativeTypes the old, unprincipled "allow unification variables to unify with a polytype" story actually works quite well. So this test compiles fine (if delicatedly) with old GHCs; but not with QuickLook unless we add this patch - - - - - 293c7fba by Sylvain Henry at 2020-08-21T09:36:38-04:00 Put CFG weights into their own module (#17957) It avoids having to query DynFlags to get them - - - - - 50eb4460 by Sylvain Henry at 2020-08-21T09:36:38-04:00 Don't use DynFlags in CmmToAsm.BlockLayout (#17957) - - - - - 659eb31b by Sylvain Henry at 2020-08-21T09:36:38-04:00 NCG: Dwarf configuration * remove references to DynFlags in GHC.CmmToAsm.Dwarf * add specific Dwarf options in NCGConfig instead of directly querying the debug level - - - - - 2d8ca917 by Sylvain Henry at 2020-08-21T09:37:15-04:00 Fix -ddump-stg flag -ddump-stg was dumping the initial STG (just after Core-to-STG pass) which was misleading because we want the final STG to know if a function allocates or not. Now we have a new flag -ddump-stg-from-core for this and -ddump-stg is deprecated. - - - - - fddddbf4 by Vladislav Zavialov at 2020-08-21T09:37:49-04:00 Import qualified Prelude in Cmm/Parser.y In preparation for the next version of 'happy', c95920 added a qualified import to GHC/Parser.y but for some reason neglected GHC/Cmm/Parser.y This patch adds the missing qualified import to GHC/Cmm/Parser.y and also adds a clarifying comment to explain why this import is needed. - - - - - 989c1c27 by Ben Gamari at 2020-08-21T11:27:53-04:00 gitlab-ci: Test master branch as well While these builds are strictly speaking redundant (since every commit is tested by @marge-bot before making it into `master`), they are nevertheless useful as they are displayed in the branch's commit list in GitLab's web interface. Fixes #18595. - - - - - e67ae884 by Aditya Gupta at 2020-08-22T03:29:00-04:00 mkUnique refactoring (#18362) Move uniqFromMask from Unique.Supply to Unique. Move the the functions that call mkUnique from Unique to Builtin.Uniques - - - - - 03cfcfd4 by Wander Hillen at 2020-08-22T03:29:36-04:00 Add ubuntu 20.04 jobs for nightly and release - - - - - 3f501545 by Craig Ferguson at 2020-08-22T03:30:13-04:00 Utils: clarify docs slightly The previous comment implies `nTimes n f` is either `f^{n+1}` or `f^{2^n}` (when in fact it's `f^n`). - - - - - 8b865092 by Krzysztof Gogolewski at 2020-08-23T14:12:53+02:00 Do not print synonyms in :i (->), :i Type (#18594) This adds a new printing flag `sdocPrintTypeAbbreviations` that is used specifically to avoid ghci printing 'type (->) = (->)' and 'type Type = Type'. - - - - - d8f61182 by Krzysztof Gogolewski at 2020-08-23T14:12:56+02:00 Move pprTyTcApp' inside pprTyTcApp No semantic change - - - - - 364258e0 by Krzysztof Gogolewski at 2020-08-24T00:32:31-04:00 Fix types in silly shifts (#18589) Patch written by Simon. I have only added a testcase. - - - - - b1eb38a0 by Sylvain Henry at 2020-08-24T00:33:13-04:00 Perf: make SDoc monad one-shot (#18202) With validate-x86_64-linux-deb9-hadrian: T1969 -3.4% (threshold: +/-1%) T3294 -3.3% (threshold: +/-1%) T12707 -1.4% (threshold: +/-1%) Additionally with validate-x86_64-linux-deb9-unreg-hadrian: T4801 -2.4% (threshold: +/-2%) T13035 -1.4% (threshold: +/-1%) T13379 -2.4% (threshold: +/-2%) ManyAlternatives -2.5% (threshold: +/-2%) ManyConstructors -3.0% (threshold: +/-2%) Metric Decrease: T12707 T1969 T3294 ManyAlternatives ManyConstructors T13035 T13379 T4801 - - - - - a77b9ec2 by Krzysztof Gogolewski at 2020-08-24T10:04:20-04:00 Add a test for #18397 The bug was fixed by !3421. - - - - - 05550a5a by Sylvain Henry at 2020-08-24T10:04:59-04:00 Avoid roundtrip through SDoc As found by @monoidal on https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3885#note_295126 - - - - - 0a1ecc5f by Ben Gamari at 2020-08-25T07:37:05-04:00 SysTools.Process: Handle exceptions in readCreateProcessWithExitCode' In #18069 we are observing MVar deadlocks from somewhere in ghc.exe. This use of MVar stood out as being one of the more likely culprits. Here we make sure that it is exception-safe. - - - - - db8793ad by Richard Eisenberg at 2020-08-25T07:37:40-04:00 Use tcView, not coreView, in the pure unifier. Addresses a lingering point within #11715. - - - - - fb77207a by Simon Peyton Jones at 2020-08-25T07:38:16-04:00 Use LIdP rather than (XRec p (IdP p)) This patch mainly just replaces use of XRec p (IdP p) with LIdP p One slightly more significant change is to parameterise HsPatSynDetails over the pass rather than the argument type, so that it's uniform with HsConDeclDetails and HsConPatDetails. I also got rid of the dead code GHC.Hs.type.conDetailsArgs But this is all just minor refactoring. No change in functionality. - - - - - 8426a136 by Krzysztof Gogolewski at 2020-08-25T07:38:54-04:00 Add a test for #18585 - - - - - 2d635a50 by Takenobu Tani at 2020-08-26T04:50:21-04:00 linters: Make CPP linter skip image files This patch adds an exclusion rule for `docs/users_guide/images`, to avoid lint errors of PDF files. - - - - - b7d98cb2 by Takenobu Tani at 2020-08-26T04:50:21-04:00 users-guide: Color the logo on the front page of the PDF This patch updates the logo with a recent color scheme. This affects only the PDF version of the user's guide. See also: * https://mail.haskell.org/pipermail/ghc-devs/2020-August/019139.html * https://gitlab.haskell.org/ghc/ghc/-/wikis/logo - - - - - 0b17fa18 by Sylvain Henry at 2020-08-26T04:50:58-04:00 Refactor UnitId pretty-printing When we pretty-print a UnitId for the user, we try to map it back to its origin package name, version and component to print "package-version:component" instead of some hash. The UnitId type doesn't carry these information, so we have to look into a UnitState to find them. This is why the Outputable instance of UnitId used `sdocWithDynFlags` in order to access the `unitState` field of DynFlags. This is wrong for several reasons: 1. The DynFlags are accessed when the message is printed, not when it is generated. So we could imagine that the unitState may have changed in-between. Especially if we want to allow unit unloading. 2. We want GHC to support several independent sessions at once, hence several UnitState. The current approach supposes there is a unique UnitState as a UnitId doesn't indicate which UnitState to use. See the Note [Pretty-printing UnitId] in GHC.Unit for the new approach implemented by this patch. One step closer to remove `sdocDynFlags` field from `SDocContext` (#10143). Fix #18124. Also fix some Backpack code to use SDoc instead of String. - - - - - dc476a50 by Sylvain Henry at 2020-08-26T04:51:35-04:00 Bignum: fix BigNat subtraction (#18604) There was a confusion between the boolean expected by withNewWordArrayTrimedMaybe and the boolean returned by subtracting functions. - - - - - fcb10b6c by Peter Trommler at 2020-08-26T10:42:30-04:00 PPC and X86: Portable printing of IEEE floats GNU as and the AIX assembler support floating point literals. SPARC seems to have support too but I cannot test on SPARC. Curiously, `doubleToBytes` is also used in the LLVM backend. To avoid endianness issues when cross-compiling float and double literals are printed as C-style floating point values. The assembler then takes care of memory layout and endianness. This was brought up in #18431 by @hsyl20. - - - - - 770100e0 by Krzysztof Gogolewski at 2020-08-26T10:43:13-04:00 primops: Remove Monadic and Dyadic categories There were four categories of primops: Monadic, Dyadic, Compare, GenPrimOp. The compiler does not treat Monadic and Dyadic in any special way, we can just replace them with GenPrimOp. Compare is still used in isComparisonPrimOp. - - - - - 01ff8c89 by Aditya Gupta at 2020-08-27T14:19:26-04:00 Consolidate imports in getMinimalImports (#18264) - - - - - bacccb73 by Ryan Scott at 2020-08-27T14:20:01-04:00 Make {hsExpr,hsType,pat}NeedsParens aware of boxed 1-tuples `hsExprNeedsParens`, `hsTypeNeedsParens`, and `patNeedsParens` previously assumed that all uses of explicit tuples in the source syntax never need to be parenthesized. This is true save for one exception: boxed one-tuples, which use the `Solo` data type from `GHC.Tuple` instead of special tuple syntax. This patch adds the necessary logic to the three `*NeedsParens` functions to handle `Solo` correctly. Fixes #18612. - - - - - c6f50cea by Krzysztof Gogolewski at 2020-08-28T02:22:36-04:00 Add missing primop documentation (#18454) - Add three pseudoops to primops.txt.pp, so that Haddock renders the documentation - Update comments - Remove special case for "->" - it's no longer exported from GHC.Prim - Remove reference to Note [Compiling GHC.Prim] - the ad-hoc fix is no longer there after updates to levity polymorphism. - Document GHC.Prim - Remove the comment that lazy is levity-polymorphic. As far as I can tell, it never was: in 80e399639, only the unfolding was given an open type variable. - Remove haddock hack in GHC.Magic - no longer neccessary after adding realWorld# to primops.txt.pp. - - - - - f065b6b0 by Tamar Christina at 2020-08-28T02:23:13-04:00 Fix use distro toolchian - - - - - 4517a382 by Tamar Christina at 2020-08-28T02:23:13-04:00 document how build system find toolchains on Windows - - - - - 329f7cb9 by Ben Gamari at 2020-08-31T22:59:14-04:00 base: Better error message on invalid getSystemTimerManager call Previously we would produce a rather unhelpful pattern match failure error in the case where the user called `getSystemTimerManager` in a program which isn't built with `-threaded`. This understandably confused the user in #15616. Fixes #15616. - - - - - f6d70a8f by Roland Senn at 2020-08-31T22:59:50-04:00 Add tests for #15617. Avoid a similar regression in the future. - - - - - e5969fd0 by Roland Senn at 2020-08-31T23:00:27-04:00 Add additional tests for #18172 (Followup MR 3543) There was still one active discussion [thread](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3543#note_284325) when MR !3543 got merged. This MR adds the requested tests exercising the changes in `compiler/GHC/HsToCore/Match/Literal.hs:warnAboutEmptyEnumerations` and its sub-functions. - - - - - fe18b482 by Ben Gamari at 2020-08-31T23:01:02-04:00 Bump Win32 and process submodules - - - - - 2da93308 by Sylvain Henry at 2020-08-31T23:01:39-04:00 Hadrian: fix slow-validate flavour (#18586) - - - - - 85e13008 by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Update dominator code with fixes from the dom-lt package. Two bugs turned out in the package that have been fixed since. This MR includes this fixes in the GHC port of the code. - - - - - dffb38fa by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Dominators.hs: Use unix line endings - - - - - 6189cc04 by Moritz Angermann at 2020-08-31T23:02:50-04:00 [fixup 3433] move debugBelch into IF_DEBUG(linker) The commit in dff1cb3d9c111808fec60190747272b973547c52 incorrectly left the `debugBelch` function without a comment or IF_DEBUG(linker,) decoration. This rectifies it. Needs at least a 8.10 backport, as it was backported in 6471cc6aff80d5deebbdb1bf7b677b31ed2af3d5 - - - - - bcb68a3f by Sylvain Henry at 2020-08-31T23:03:27-04:00 Don't store HomeUnit in UnitConfig Allow the creation of a UnitConfig (hence of a UnitState) without having a HomeUnit. It's required for #14335. - - - - - 0a372387 by Sylvain Henry at 2020-08-31T23:04:04-04:00 Fix documentation and fix "check" bignum backend (#18604) - - - - - eb85f125 by Moritz Angermann at 2020-08-31T23:04:39-04:00 Set the dynamic-system-linker flag to Manual This flag should be user controllable, hence Manual: True. - - - - - 380ef845 by Sven Tennie at 2020-08-31T23:05:14-04:00 Ignore more files Ignore files from "new style" cabal builds (dist-newstyle folders) and from clangd (C language server). - - - - - 74a7fbff by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.0 and earlier (#18620) This patch adds the upper bound of a happy version for ghc-9.0 and earlier. Currently, we can't use happy-1.20.0 for ghc-9.0. See #18620. - - - - - a4473f02 by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.2 (#18620) This patch adds the upper bound of a happy version for ghc-9.2. Currently, We can use happy-1.19 or happy-1.20 for ghc-9.2. See #18620. - - - - - a8a2568b by Sylvain Henry at 2020-08-31T23:06:28-04:00 Bignum: add BigNat compat functions (#18613) - - - - - 884245dd by Sylvain Henry at 2020-09-01T12:39:36-04:00 Fix FastString lexicographic ordering (fix #18562) - - - - - 4b4fbc58 by Sylvain Henry at 2020-09-01T12:39:36-04:00 Remove "Ord FastString" instance FastStrings can be compared in 2 ways: by Unique or lexically. We don't want to bless one particular way with an "Ord" instance because it leads to bugs (#18562) or to suboptimal code (e.g. using lexical comparison while a Unique comparison would suffice). UTF-8 encoding has the advantage that sorting strings by their encoded bytes also sorts them by their Unicode code points, without having to decode the actual code points. BUT GHC uses Modified UTF-8 which diverges from UTF-8 by encoding \0 as 0xC080 instead of 0x00 (to avoid null bytes in the middle of a String so that the string can still be null-terminated). This patch adds a new `utf8CompareShortByteString` function that performs sorting by bytes but that also takes Modified UTF-8 into account. It is much more performant than decoding the strings into [Char] to perform comparisons (which we did in the previous patch). Bump haddock submodule - - - - - b4edcde7 by Ben Gamari at 2020-09-01T14:53:42-04:00 testsuite: Add broken test for #18302 - - - - - bfab2a30 by Sebastian Graf at 2020-09-02T15:54:55-04:00 Turn on -XMonoLocalBinds by default (#18430) And fix the resulting type errors. Co-authored-by: Krzysztof Gogolewski <krz.gogolewski at gmail.com> Metric Decrease: parsing001 - - - - - c30cc0e9 by David Feuer at 2020-09-02T15:55:31-04:00 Remove potential space leak from Data.List.transpose Previously, `transpose` produced a list of heads and a list of tails independently. This meant that a function using only some heads, and only some tails, could potentially leak space. Use `unzip` to work around the problem by producing pairs and selector thunks instead. Time and allocation behavior will be worse, but there should be no more leak potential. - - - - - ffc3da47 by Sylvain Henry at 2020-09-02T15:56:11-04:00 Remove outdated note - - - - - 85e62123 by Sylvain Henry at 2020-09-02T15:56:48-04:00 Bignum: add missing compat import/export functions - - - - - 397c2b03 by Ben Gamari at 2020-09-03T17:31:47-04:00 configure: Work around Raspbian's silly packaging decisions See #17856. - - - - - 4891c18a by Kathryn Spiers at 2020-09-03T17:32:24-04:00 expected-undocumented-flags remove kill flags It looks like the flags were removed in https://gitlab.haskell.org/ghc/ghc/-/commit/3e27205a66b06a4501d87eb31e285eadbc693eb7 and can safely be removed here - - - - - 1d6d6488 by Sylvain Henry at 2020-09-04T16:24:20-04:00 Don't rely on CLabel's Outputable instance in CmmToC This is in preparation of the removal of sdocWithDynFlags (#10143), hence of the refactoring of CLabel's Outputable instance. - - - - - 89ce7cdf by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: use Platform in foldRegs* - - - - - 220ad8d6 by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: don't pass DynFlags to cmmImplementSwitchPlans - - - - - c1e54439 by Ryan Scott at 2020-09-04T16:25:35-04:00 Introduce isBoxedTupleDataCon and use it to fix #18644 The code that converts promoted tuple data constructors to `IfaceType`s in `GHC.CoreToIface` was using `isTupleDataCon`, which conflates boxed and unboxed tuple data constructors. To avoid this, this patch introduces `isBoxedTupleDataCon`, which is like `isTupleDataCon` but only works for _boxed_ tuple data constructors. While I was in town, I was horribly confused by the fact that there were separate functions named `isUnboxedTupleCon` and `isUnboxedTupleTyCon` (similarly, `isUnboxedSumCon` and `isUnboxedSumTyCon`). It turns out that the former only works for data constructors, despite its very general name! I opted to rename `isUnboxedTupleCon` to `isUnboxedTupleDataCon` (similarly, I renamed `isUnboxedSumCon` to `isUnboxedSumDataCon`) to avoid this potential confusion, as well as to be more consistent with the naming convention I used for `isBoxedTupleDataCon`. Fixes #18644. - - - - - 07bdcac3 by GHC GitLab CI at 2020-09-04T22:26:25-04:00 configure: Avoid hard-coded ld path on Windows The fix to #17962 ended up regressing on Windows as it failed to replicate the logic responsible for overriding the toolchain paths on Windows. This resulted in a hard-coded path to a directory that likely doesn't exist on the user's system (#18550). - - - - - 0be8e746 by Benjamin Maurer at 2020-09-04T22:27:01-04:00 Documented the as of yet undocumented '--print-*' GHC flags, as well as `-split-objs`, since that is related to `--print-object-splitting-supported`. See #18641 - - - - - 4813486f by Sylvain Henry at 2020-09-04T22:27:44-04:00 Move Hadrian's wiki pages in tree (fix #16165) Only the debugging page contains interesting stuff. Some of this stuff looks old (e.g. recommending "cabal install")... - - - - - 7980ae23 by GHC GitLab CI at 2020-09-05T14:50:52-04:00 rts: Consistently use stgMallocBytes instead of malloc This can help in debugging RTS memory leaks since all allocations go through the same interface. - - - - - 67059893 by Ben Gamari at 2020-09-05T14:51:27-04:00 configure: Fix whitespace - - - - - be2cc0ad by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: More intelligent detection of locale availability Previously ci.sh would unconditionally use C.UTF-8. However, this fails on Centos 7, which appears not to provide this locale. Now we first try C.UTF-8, then try en_US.UTF-8, then fail. Works around #18607. - - - - - 15dca847 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Rename RELEASE variable to RELEASE_JOB This interfered with the autoconf variable of the same name, breaking pre-release builds. - - - - - bec0d170 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Bump Windows toolchain version This should have been done when we bumped the bootstrap compiler to 8.8.4. - - - - - 9fbaee21 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Drop Windows make job These are a significant burden on our CI resources and end up failing quite often due to #18274. Here I drop the make jobs during validaion; it is now run only during the nightly builds. - - - - - 869f6e19 by Ben Gamari at 2020-09-05T14:51:27-04:00 testsuite: Drop Windows-specific output for parseTree The normalise_slashes normaliser should handle this. - - - - - 2c9f743c by Ben Gamari at 2020-09-05T14:51:28-04:00 testsuite: Mark T5975[ab] as broken on Windows Due to #7305. - - - - - 643785e3 by Ben Gamari at 2020-09-05T14:51:28-04:00 gitlab-ci: Fix typo A small typo in a rule regular expression. - - - - - c5413fc6 by Wander Hillen at 2020-09-07T09:33:54-04:00 Add clarification regarding poll/kqueue flags - - - - - 10434d60 by Ben Gamari at 2020-09-07T09:34:32-04:00 gitlab-ci: Configure bignum backend in Hadrian builds - - - - - d4bc9f0d by Ben Gamari at 2020-09-07T09:34:32-04:00 gitlab-ci: Use hadrian builds for Windows release artifacts - - - - - 4ff93292 by Moritz Angermann at 2020-09-07T21:18:39-04:00 [macOS] improved runpath handling In b592bd98ff25730bbe3c13d6f62a427df8c78e28 we started using -dead_strip_dylib on macOS when lining dynamic libraries and binaries. The underlying reason being the Load Command Size Limit in macOS Sierra (10.14) and later. GHC will produce @rpath/libHS... dependency entries together with a corresponding RPATH entry pointing to the location of the libHS... library. Thus for every library we produce two Load Commands. One to specify the dependent library, and one with the path where to find it. This makes relocating libraries and binaries easier, as we just need to update the RPATH entry with the install_name_tool. The dynamic linker will then subsitute each @rpath with the RPATH entries it finds in the libraries load commands or the environement, when looking up @rpath relative libraries. -dead_strip_dylibs intructs the linker to drop unused libraries. This in turn help us reduce the number of referenced libraries, and subsequently the size of the load commands. This however does not remove the RPATH entries. Subsequently we can end up (in extreme cases) with only a single @rpath/libHS... entry, but 100s or more RPATH entries in the Load Commands. This patch rectifies this (slighly unorthodox) by passing *no* -rpath arguments to the linker at link time, but -headerpad 8000. The headerpad argument is in hexadecimal and the maxium 32k of the load command size. This tells the linker to pad the load command section enough for us to inject the RPATHs later. We then proceed to link the library or binary with -dead_strip_dylibs, and *after* the linking inspect the library to find the left over (non-dead-stripped) dependencies (using otool). We find the corresponding RPATHs for each @rpath relative dependency, and inject them into the library or binary using the install_name_tool. Thus achieving a deadstripped dylib (and rpaths) build product. We can not do this in GHC, without starting to reimplement a dynamic linker as we do not know which symbols and subsequently libraries are necessary. Commissioned-by: Mercury Technologies, Inc. (mercury.com) - - - - - df04b81e by Sylvain Henry at 2020-09-07T21:19:20-04:00 Move DynFlags test into updateModDetailsIdInfos's caller (#17957) - - - - - ea1cbb8f by Ben Gamari at 2020-09-08T15:42:02-04:00 rts: Add stg_copyArray_barrier to RtsSymbols list It's incredible that this wasn't noticed until now. - - - - - d7b2f799 by Daishi Nakajima at 2020-09-08T15:42:41-04:00 testsuite: Output performance test results in tabular format this was suggested in #18417. Change the print format of the values. * Shorten commit hash * Reduce precision of the "Value" field * Shorten metrics name * e.g. runtime/bytes allocated -> run/alloc * Shorten "MetricsChange" * e.g. unchanged -> unch, increased -> incr And, print the baseline environment if there are baselines that were measured in a different environment than the current environment. If all "Baseline commit" are the same, print it once. - - - - - 44472daf by Ryan Scott at 2020-09-08T15:43:16-04:00 Make the forall-or-nothing rule only apply to invisible foralls (#18660) This fixes #18660 by changing `isLHsForAllTy` to `isLHsInvisForAllTy`, which is sufficient to make the `forall`-or-nothing rule only apply to invisible `forall`s. I also updated some related documentation and Notes while I was in the neighborhood. - - - - - 0c61cbff by Ben Gamari at 2020-09-08T15:43:54-04:00 gitlab-ci: Handle distributions without locales Previously we would assume that the `locale` utility exists. However, this is not so on Alpine as musl's locale support is essentially non-existent. (cherry picked from commit 17cdb7ac3b557a245fee1686e066f9f770ddc21e) - - - - - d989c842 by Ben Gamari at 2020-09-08T15:43:55-04:00 gitlab-ci: Accept Centos 7 C.utf8 locale Centos apparently has C.utf8 rather than C.UTF-8. (cherry picked from commit d9f85dd25a26a04d3485470afb3395ee2dec6464) - - - - - e5a2899c by John Ericson at 2020-09-09T00:46:05-04:00 Use "to" instead of "2" in internal names of conversion ops Change the constructors for the primop union, and also names of the literal conversion functions. "2" runs into trouble when we need to do conversions from fixed-width types, and end up with thing like "Int642Word". Only the names internal to GHC are changed, as I don't want to worry about breaking changes ATM. - - - - - 822f1057 by Ryan Scott at 2020-09-09T00:46:41-04:00 Postpone associated tyfam default checks until after typechecking Previously, associated type family defaults were validity-checked during typechecking. Unfortunately, the error messages that these checks produce run the risk of printing knot-tied type constructors, which will cause GHC to diverge. In order to preserve the current error message's descriptiveness, this patch postpones these validity checks until after typechecking, which are now located in the new function `GHC.Tc.Validity.checkValidAssocTyFamDeflt`. Fixes #18648. - - - - - 8c892689 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add OptCoercionOpts Use OptCoercionOpts to avoid threading DynFlags all the way down to GHC.Core.Coercion.Opt - - - - - 3f32a9c0 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add UnfoldingOpts and SimpleOpts Milestone: after this patch, we only use 'unsafeGlobalDynFlags' for the state hack and for debug in Outputable. - - - - - b3df72a6 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add sm_pre_inline field into SimplMode (#17957) It avoids passing and querying DynFlags down in the simplifier. - - - - - ffae5792 by Sylvain Henry at 2020-09-09T11:19:24-04:00 Add comments about sm_dflags and simpleOptExpr - - - - - 7911d0d9 by Alan Zimmerman at 2020-09-09T11:20:03-04:00 Remove GENERATED pragma, as it is not being used @alanz pointed out on ghc-devs that the payload of this pragma does not appear to be used anywhere. I (@bgamari) did some digging and traced the pragma's addition back to d386e0d2 (way back in 2006!). It appears that it was intended to be used by code generators for use in informing the code coveraging checker about generated code provenance. When it was added it used the pragma's "payload" fields as source location information to build an "ExternalBox". However, it looks like this was dropped a year later in 55a5d8d9. At this point it seems like the pragma serves no useful purpose. Given that it also is not documented, I think we should remove it. Updates haddock submodule Closes #18639 - - - - - 5aae5b32 by Ben Gamari at 2020-09-09T18:31:40-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. Additionally, we are far more careful about where tools come from, using the ALEX, HAPPY, HSCOLOR, and GHC environment variables (set in the Dockerfiles) to find bootstrapping tools. - - - - - 4ce9fe88 by Ben Gamari at 2020-09-09T18:31:40-04:00 hadrian: Fix leakage of GHC in PATH into build Previously hadrian would use GHC on PATH when configuring packages (or fail if there is no such GHC). Fix this. Unfortunately this runs into another bug in Cabal which we workaround. - - - - - 291a15dd by Ben Gamari at 2020-09-09T18:31:40-04:00 utils: Bump cabal-version of hp2ps and unlit - - - - - 4798caa0 by David Himmelstrup at 2020-09-09T18:32:16-04:00 rts comment: RTS_TICKY_SYMBOLS moved from rts/Linker.c to rts/RtsSymbols.c - - - - - 67ce72da by Sebastian Graf at 2020-09-10T10:35:33-04:00 Add long-distance info for pattern bindings (#18572) We didn't consider the RHS of a pattern-binding before, which led to surprising warnings listed in #18572. As can be seen from the regression test T18572, we get the expected output now. - - - - - 1207576a by Sebastian Graf at 2020-09-10T10:35:33-04:00 PmCheck: Big refactor using guard tree variants more closely following source syntax (#18565) Previously, we desugared and coverage checked plain guard trees as described in Lower Your Guards. That caused (in !3849) quite a bit of pain when we need to partially recover tree structure of the input syntax to return covered sets for long-distance information, for example. In this refactor, I introduced a guard tree variant for each relevant source syntax component of a pattern-match (mainly match groups, match, GRHS, empty case, pattern binding). I made sure to share as much coverage checking code as possible, so that the syntax-specific checking functions are just wrappers around the more substantial checking functions for the LYG primitives (`checkSequence`, `checkGrds`). The refactoring payed off in clearer code and elimination of all panics related to assumed guard tree structure and thus fixes #18565. I also took the liberty to rename and re-arrange the order of functions and comments in the module, deleted some dead and irrelevant Notes, wrote some new ones and gave an overview module haddock. - - - - - 95455982 by GHC GitLab CI at 2020-09-10T10:36:09-04:00 hadrian: Don't include -fdiagnostics-color in argument hash Otherwise the input hash will vary with whether colors are requested, which changed with `isatty`. Fixes #18672. - - - - - 6abe4a1c by Sebastian Graf at 2020-09-10T17:02:00+02:00 .gitignore *.hiedb files - - - - - 3777be14 by Sebastian Graf at 2020-09-10T17:03:12+02:00 PmCheck: Handle ⊥ and strict fields correctly (#18341) In #18341, we discovered an incorrect digression from Lower Your Guards. This MR changes what's necessary to support properly fixing #18341. In particular, bottomness constraints are now properly tracked in the oracle/inhabitation testing, as an additional field `vi_bot :: Maybe Bool` in `VarInfo`. That in turn allows us to model newtypes as advertised in the Appendix of LYG and fix #17725. Proper handling of ⊥ also fixes #17977 (once again) and fixes #18670. For some reason I couldn't follow, this also fixes #18273. I also added a couple of regression tests that were missing. Most of them were already fixed before. In summary, this patch fixes #18341, #17725, #18273, #17977 and #18670. Metric Decrease: T12227 - - - - - 1bd28931 by David Himmelstrup at 2020-09-11T09:59:43-04:00 Define TICKY_TICKY when compiling cmm RTS files. - - - - - 15e67801 by David Himmelstrup at 2020-09-11T09:59:43-04:00 Fix typos in TICKY_TICKY symbol names. - - - - - 8a5a91cb by David Himmelstrup at 2020-09-11T09:59:43-04:00 Enable TICKY_TICKY for debug builds when building with makefiles. - - - - - fc965c09 by Sandy Maguire at 2020-09-12T00:31:36-04:00 Add clamp function to Data.Ord - - - - - fb6e29e8 by Sandy Maguire at 2020-09-12T00:31:37-04:00 Add tests - - - - - 2a942285 by Sebastian Graf at 2020-09-12T00:32:13-04:00 PmCheck: Disattach COMPLETE pragma lookup from TyCons By not attaching COMPLETE pragmas with a particular TyCon and instead assume that every COMPLETE pragma is applicable everywhere, we can drastically simplify the logic that tries to initialise available COMPLETE sets of a variable during the pattern-match checking process, as well as fixing a few bugs. Of course, we have to make sure not to report any of the ill-typed/unrelated COMPLETE sets, which came up in a few regression tests. In doing so, we fix #17207, #18277 and #14422. There was a metric decrease in #18478 by ~20%. Metric Decrease: T18478 - - - - - 389a6683 by Ben Gamari at 2020-09-12T00:32:49-04:00 hadrian: Pass input file to makeindex Strangely I find that on Alpine (and apparently only on Alpine) the latex makeindex command expects to be given a filename, lest it reads from stdin. - - - - - 853d121a by Ryan Scott at 2020-09-12T00:33:25-04:00 Don't quote argument to Hadrian's test-env flag (#18656) Doing so causes the name of the test environment to gain an extra set of double quotes, which changes the name entirely. Fixes #18656. - - - - - 8440b5fa by Krzysztof Gogolewski at 2020-09-12T00:33:25-04:00 Make sure we can read past perf notes See #18656. - - - - - 2157be52 by theobat at 2020-09-12T21:27:04-04:00 Avoid iterating twice in `zipTyEnv` (#18535) zipToUFM is a new function to replace `listToUFM (zipEqual ks vs)`. An explicit recursion is preferred due to the sensible nature of fusion. T12227 -6.0% T12545 -12.3% T5030 -9.0% T9872a -1.6% T9872b -1.6% T9872c -2.0% ------------------------- Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c ------------------------- - - - - - 69ea2fee by Sebastian Graf at 2020-09-12T21:27:40-04:00 Make `tcCheckSatisfiability` incremental (#18645) By taking and returning an `InertSet`. Every new `TcS` session can then pick up where a prior session left with `setTcSInerts`. Since we don't want to unflatten the Givens (and because it leads to infinite loops, see !3971), we introduced a new variant of `runTcS`, `runTcSInerts`, that takes and returns the `InertSet` and makes sure not to unflatten the Givens after running the `TcS` action. Fixes #18645 and #17836. Metric Decrease: T17977 T18478 - - - - - a77e48d2 by Sebastian Graf at 2020-09-12T21:27:40-04:00 Extract definition of DsM into GHC.HsToCore.Types `DsM` was previously defined in `GHC.Tc.Types`, along with `TcM`. But `GHC.Tc.Types` is in the set of transitive dependencies of `GHC.Parser`, a set which we aim to minimise. Test case `CountParserDeps` checks for that. Having `DsM` in that set means the parser also depends on the innards of the pattern-match checker in `GHC.HsToCore.PmCheck.Types`, which is the reason we have that module in the first place. In the previous commit, we represented the `TyState` by an `InertSet`, but that pulls the constraint solver as well as 250 more modules into the set of dependencies, triggering failure of `CountParserDeps`. Clearly, we want to evolve the pattern-match checker (and the desugarer) without being concerned by this test, so this patch includes a small refactor that puts `DsM` into its own module. - - - - - fd5d622a by Sebastian Graf at 2020-09-12T21:27:40-04:00 Hackily decouple the parser from the desugarer In a hopefully temporary hack, I re-used the idea from !1957 of using a nullary type family to break the dependency from GHC.Driver.Hooks on the definition of DsM ("Abstract Data"). This in turn broke the last dependency from the parser to the desugarer. More details in `Note [The Decoupling Abstract Data Hack]`. In the future, we hope to undo this hack again in favour of breaking the dependency from the parser to DynFlags altogether. - - - - - 35a7b7ec by Adam Sandberg Eriksson at 2020-09-14T17:46:16-04:00 docs: -B rts option sounds the bell on every GC (#18351) - - - - - 5ae8212c by Wander Hillen at 2020-09-14T17:46:54-04:00 Populate gitlab cache after building - - - - - a5ffb39a by Wander Hillen at 2020-09-14T17:46:54-04:00 Move ahead cabal cache restoration to before use of cabal - - - - - e8b37c21 by Wander Hillen at 2020-09-14T17:46:54-04:00 Do the hadrian rebuild multicore - - - - - 07762eb5 by Wander Hillen at 2020-09-14T17:46:54-04:00 Also cache other hadrian builds - - - - - 8610bcbe by DenisFrezzato at 2020-09-15T15:19:08-04:00 Fix rtsopts documentation - - - - - c7182a5c by Simon Peyton Jones at 2020-09-15T15:19:44-04:00 Care with implicit-parameter superclasses Two bugs, #18627 and #18649, had the same cause: we were not account for the fact that a constaint tuple might hide an implicit parameter. The solution is not hard: look for implicit parameters in superclasses. See Note [Local implicit parameters] in GHC.Core.Predicate. Then we use this new function in two places * The "short-cut solver" in GHC.Tc.Solver.Interact.shortCutSolver which simply didn't handle implicit parameters properly at all. This fixes #18627 * The specialiser, which should not specialise on implicit parameters This fixes #18649 There are some lingering worries (see Note [Local implicit parameters]) but things are much better. - - - - - 0f3884b0 by Zubin Duggal at 2020-09-15T15:20:23-04:00 Export enrichHie from GHC.Iface.Ext.Ast This is useful for `ghcide` - - - - - b3143f5a by Sylvain Henry at 2020-09-15T15:21:06-04:00 Enhance metrics output - - - - - 4283feaa by Ryan Scott at 2020-09-15T15:21:43-04:00 Introduce and use DerivClauseTys (#18662) This switches `deriv_clause_tys` so that instead of using a list of `LHsSigType`s to represent the types in a `deriving` clause, it now uses a sum type. `DctSingle` represents a `deriving` clause with no enclosing parentheses, while `DctMulti` represents a clause with enclosing parentheses. This makes pretty-printing easier and avoids confusion between `HsParTy` and the enclosing parentheses in `deriving` clauses, which are different semantically. Fixes #18662. - - - - - 90229c4b by Ryan Scott at 2020-09-16T04:53:22-04:00 Include -f{write,validate}-ide-info in the User's Guide flag reference Previously, these were omitted from the flag reference due to a layout oversight in `docs/users_guide/flags.{rst,py}`. Fixes #18426. - - - - - ce42e187 by Ben Gamari at 2020-09-16T04:53:59-04:00 rts: Fix erroneous usage of vsnprintf As pointed out in #18685, this should be snprintf not vsnprintf. This appears to be due to a cut-and-paste error. Fixes #18658. - - - - - b695e7d7 by Sylvain Henry at 2020-09-16T04:54:38-04:00 Rename ghci flag into internal-interpreter "ghci" as a flag name was confusing because it really enables the internal-interpreter. Even the ghci library had a "ghci" flag... - - - - - 8af954d2 by Sylvain Henry at 2020-09-16T04:55:17-04:00 Make ghc-boot reexport modules from ghc-boot-th Packages don't have to import both ghc-boot and ghc-boot-th. It makes the dependency graph easier to understand and to refactor. - - - - - 6baa67f5 by Adam Sandberg Eriksson at 2020-09-16T07:45:47-04:00 docs: correct haddock reference [skip ci] - - - - - 7cf09ab0 by Simon Peyton Jones at 2020-09-17T01:27:25-04:00 Do absence analysis on stable unfoldings Ticket #18638 showed that Very Bad Things happen if we fail to do absence analysis on stable unfoldings. It's all described in Note [Absence analysis for stable unfoldings and RULES]. I'm a bit surprised this hasn't bitten us before. Fortunately the fix is pretty simple. - - - - - 76d3bcbc by Leif Metcalf at 2020-09-17T01:28:01-04:00 Replace deprecated git --recursive The --recursive flag of git-clone has been replaced by the --recurse-submodules flag since git 1.7.4, released in 2011. - - - - - da8f4ddd by Richard Eisenberg at 2020-09-17T01:28:38-04:00 Document IfaceTupleTy - - - - - 3c94c816 by HaskellMouse at 2020-09-17T08:49:51-04:00 Added explicit fixity to (~). Solves #18252 - - - - - b612e396 by Cary Robbins at 2020-09-17T08:50:30-04:00 Make the 'IsString (Const a b)' instance polykinded on 'b' - - - - - 8d0c26c4 by Ben Gamari at 2020-09-17T08:51:08-04:00 rts/win32: Fix missing #include's These slipped through CI. - - - - - 76009ec8 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 147bb598 by Ben Gamari at 2020-09-17T08:51:08-04:00 Bump version to 9.0 Bumps haskeline and haddock submodules. (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 5c7387f6 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Make Z-encoding comment into a note - - - - - c12b3041 by Leif Metcalf at 2020-09-17T08:51:43-04:00 Cosmetic - - - - - 4f461e1a by Vladislav Zavialov at 2020-09-17T08:52:19-04:00 Parser.y: clarify treatment of @{-# UNPACK #-} Before this patch, we had this parser production: ftype : ... | ftype PREFIX_AT tyarg { ... } And 'tyarg' is defined as follows: tyarg : atype { ... } | unpackedness atype { ... } So one might get the (false) impression that that parser production is intended to parse things like: F @{-# UNPACK #-} X However, the lexer wouldn't produce PREFIX_AT followed by 'unpackedness', as the '@' operator followed by '{-' is not considered prefix. Thus there's no point using 'tyarg' after PREFIX_AT, and a simple 'atype' will suffice: ftype : ... | ftype PREFIX_AT atype { ... } This change has no user-facing consequences. It just makes the grammar a bit more clear. - - - - - 9dec8600 by Benjamin Maurer at 2020-09-17T08:52:56-04:00 Documented '-m' flags for machine specific instruction extensions. See #18641 'Documenting the Expected Undocumented Flags' - - - - - ca48076a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Introduce OutputableP Some types need a Platform value to be pretty-printed: CLabel, Cmm types, instructions, etc. Before this patch they had an Outputable instance and the Platform value was obtained via sdocWithDynFlags. It meant that the *renderer* of the SDoc was responsible of passing the appropriate Platform value (e.g. via the DynFlags given to showSDoc). It put the burden of passing the Platform value on the renderer while the generator of the SDoc knows the Platform it is generating the SDoc for and there is no point passing a different Platform at rendering time. With this patch, we introduce a new OutputableP class: class OutputableP a where pdoc :: Platform -> a -> SDoc With this class we still have some polymorphism as we have with `ppr` (i.e. we can use `pdoc` on a variety of types instead of having a dedicated `pprXXX` function for each XXX type). One step closer removing `sdocWithDynFlags` (#10143) and supporting several platforms (#14335). - - - - - e45c8544 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Generalize OutputableP Add a type parameter for the environment required by OutputableP. It avoids tying Platform with OutputableP. - - - - - 37aa224a by Sylvain Henry at 2020-09-17T20:04:08-04:00 Add note about OutputableP - - - - - 7f2785f2 by Sylvain Henry at 2020-09-17T20:04:08-04:00 Remove pprPrec from Outputable (unused) - - - - - b689f3db by Sylvain Henry at 2020-09-17T20:04:46-04:00 Bignum: add clamping naturalToWord (fix #18697) - - - - - 0799b3de by Ben Gamari at 2020-09-18T15:55:50-04:00 rts/nonmoving: Add missing STM write barrier When updating a TRec for a TVar already part of a transaction we previously neglected to add the old value to the update remembered set. I suspect this was the cause of #18587. - - - - - c4921349 by Ben Gamari at 2020-09-18T15:56:25-04:00 rts: Refactor foreign export tracking This avoids calling `libc` in the initializers which are responsible for registering foreign exports. We believe this should avoid the corruption observed in #18548. See Note [Tracking foreign exports] in rts/ForeignExports.c for an overview of the new scheme. - - - - - 40dc9106 by Ben Gamari at 2020-09-18T15:56:25-04:00 rts: Refactor unloading of foreign export StablePtrs Previously we would allocate a linked list cell for each foreign export. Now we can avoid this by taking advantage of the fact that they are already broken into groups. - - - - - 45fa8218 by Simon Jakobi at 2020-09-19T06:57:36-04:00 Deprecate Data.Semigroup.Option Libraries email: https://mail.haskell.org/pipermail/libraries/2018-April/028724.html GHC issue: https://gitlab.haskell.org/ghc/ghc/issues/15028 Corresponding PRs for deepseq: * https://github.com/haskell/deepseq/pull/55 * https://github.com/haskell/deepseq/pull/57 Bumps the deepseq submodule. - - - - - 2229d570 by Vladislav Zavialov at 2020-09-19T15:47:24-04:00 Require happy >=1.20 - - - - - a89c2fba by Ben Gamari at 2020-09-19T15:47:24-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. - - - - - 2f7ef2fb by Ben Gamari at 2020-09-19T15:47:24-04:00 gitlab-ci: Ensure that cabal-install overwrites existing executables Previously cabal-install wouldn't overwrite toolchain executables if they already existed (as they likely would due to caching). - - - - - ac213d26 by Ryan Scott at 2020-09-19T15:48:01-04:00 Wire in constraint tuples This wires in the definitions of the constraint tuple classes. The key changes are in: * `GHC.Builtin.Types`, where the `mk_ctuple` function is used to define constraint tuple type constructors, data constructors, and superclass selector functions, and * `GHC.Builtin.Uniques`. In addition to wiring in the `Unique`s for constraint tuple type and data constructors, we now must wire in the superclass selector functions. Luckily, this proves to be not that challenging. See the newly added comments. Historical note: constraint tuples used to be wired-in until about five years ago, when commit 130e93aab220bdf14d08028771f83df210da340b turned them into known-key names. This was done as part of a larger refactor to reduce the number of special cases for constraint tuples, but the commit message notes that the main reason that constraint tuples were made known-key (as opposed to boxed/unboxed tuples, which are wired in) is because it was awkward to wire in the superclass selectors. This commit solves the problem of wiring in superclass selectors. Fixes #18635. ------------------------- Metric Decrease: T10421 T12150 T12227 T12234 T12425 T13056 T13253-spj T18282 T18304 T5321FD T5321Fun T5837 T9961 Metric Decrease (test_env='x86_64-linux-deb9-unreg-hadrian'): T12707 Metric Decrease (test_env='x86_64-darwin'): T4029 ------------------------- - - - - - e195dae6 by Wander Hillen at 2020-09-19T15:48:41-04:00 Export singleton function from Data.List Data.OldList exports a monomorphized singleton function but it is not re-exported by Data.List. Adding the export to Data.List causes a conflict with a 14-year old function of the same name and type by SPJ in GHC.Utils.Misc. We can't just remove this function because that leads to a problems when building GHC with a stage0 compiler that does not have singleton in Data.List yet. We also can't hide the function in GHC.Utils.Misc since it is not possible to hide a function from a module if the module does not export the function. To work around this, all places where the Utils.Misc singleton was used now use a qualified version like Utils.singleton and in GHC.Utils.Misc we are very specific about which version we export. - - - - - 9c1b8ad9 by Sylvain Henry at 2020-09-19T15:49:19-04:00 Bump Stack resolver - - - - - d05d13ce by John Ericson at 2020-09-19T15:49:57-04:00 Cinch -fno-warn-name-shadowing down to specific GHCi module - - - - - f1accd00 by Sylvain Henry at 2020-09-19T15:49:57-04:00 Add quick-validate Hadrian flavour (quick + -Werror) - - - - - 8f8d51f1 by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix docs who misstated how the RTS treats size suffixes. They are parsed as multiples of 1024. Not 1000. The docs used to imply otherwise. See decodeSize in rts/RtsFlags.c for the logic for this. - - - - - 2ae0edbd by Andreas Klebinger at 2020-09-19T15:50:33-04:00 Fix a codeblock in ghci.rst - - - - - 4df3aa95 by Ben Gamari at 2020-09-19T15:51:07-04:00 users guide: Fix various documentation issues - - - - - 885ecd18 by Ben Gamari at 2020-09-19T15:51:07-04:00 hadrian: Fail on Sphinx syntax errors Specifically the "Inline literal start-string without end-string" warning, which typically means that the user neglected to separate an inline code block from suffix text with a backslash. - - - - - b26cd867 by David Feuer at 2020-09-19T15:51:44-04:00 Unpack the MVar in Compact The `MVar` lock in `Compact` was unnecessarily lazy, creating an extra indirection and wasting two words. Make it strict. - - - - - 760307cf by Artyom Kuznetsov at 2020-09-19T15:52:21-04:00 Remove GADT self-reference check (#11554, #12081, #12174, fixes #15942) Reverts 430f5c84dac1eab550110d543831a70516b5cac8 - - - - - 057db94c by Ben Gamari at 2020-09-19T15:52:56-04:00 rts: Drop field initializer on thread_basic_info_data_t This struct has a number of fields and we only care that the value is initialized with zeros. This eliminates the warnings noted in #17905. - - - - - 87e2e2b1 by Vladislav Zavialov at 2020-09-19T23:55:30+03:00 Resolve shift/reduce conflicts with %shift (#17232) - - - - - 66cba46e by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T12971 as broken on Windows It's unclear why, but this no longer seems to fail. Closes #17945. - - - - - 816811d4 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Unmark T5975[ab] as broken on Windows Sadly it's unclear *why* they have suddenly started working. Closes #7305. - - - - - 43a43d39 by Ben Gamari at 2020-09-20T20:30:57-04:00 base/testsuite: Add missing LANGUAGE pragma in ThreadDelay001 Only affected the Windows codepath. - - - - - ced8f113 by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Update expected output for outofmem on Windows The error originates from osCommitMemory rather than getMBlocks. - - - - - ea08aead by Ben Gamari at 2020-09-20T20:30:57-04:00 testsuite: Mark some GHCi/Makefile tests as broken on Windows See #18718. - - - - - caf6a5a3 by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Fix WinIO error message normalization This wasn't being applied to stderr. - - - - - 93ab3e8d by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark tempfiles as broken on Win32 without WinIO The old POSIX emulation appears to ignore the user-requested prefix. - - - - - 9df77fed by GHC GitLab CI at 2020-09-20T20:30:57-04:00 testsuite: Mark TH_spliceE5_prof as broken on Windows Due to #18721. - - - - - 1a0f8243 by Ryan Scott at 2020-09-21T16:45:47-04:00 Remove unused ThBrackCtxt and ResSigCtxt Fixes #18715. - - - - - 2f222b12 by Ryan Scott at 2020-09-21T16:45:47-04:00 Disallow constraints in KindSigCtxt This patch cleans up how `GHC.Tc.Validity` classifies `UserTypeCtxt`s that can only refer to kind-level positions, which is important for rejecting certain classes of programs. In particular, this patch: * Introduces a new `TypeOrKindCtxt` data type and `typeOrKindCtxt :: UserTypeCtxt -> TypeOrKindCtxt` function, which determines whether a `UserTypeCtxt` can refer to type-level contexts, kind-level contexts, or both. * Defines the existing `allConstraintsAllowed` and `vdqAllowed` functions in terms of `typeOrKindCtxt`, which avoids code duplication and ensures that they stay in sync in the future. The net effect of this patch is that it fixes #18714, in which it was discovered that `allConstraintsAllowed` incorrectly returned `True` for `KindSigCtxt`. Because `typeOrKindCtxt` now correctly classifies `KindSigCtxt` as a kind-level context, this bug no longer occurs. - - - - - aaa51dcf by Ben Gamari at 2020-09-21T16:46:22-04:00 hadrian: Add extra-deps: happy-1.20 to stack.yaml GHC now requires happy-1.20, which isn't available in LTS-16.14. Fixes #18726. - - - - - 6de40f83 by Simon Peyton Jones at 2020-09-22T05:37:24-04:00 Better eta-expansion (again) and don't specilise DFuns This patch fixes #18223, which made GHC generate an exponential amount of code. There are three quite separate changes in here 1. Re-engineer eta-expansion (again). The eta-expander was generating lots of intermediate stuff, which could be optimised away, but which choked the simplifier meanwhile. Relatively easy to kill it off at source. See Note [The EtaInfo mechanism] in GHC.Core.Opt.Arity. The main new thing is the use of pushCoArg in getArg_maybe. 2. Stop Specialise specalising DFuns. This is the cause of a huge (and utterly unnecessary) blowup in program size in #18223. See Note [Do not specialise DFuns] in GHC.Core.Opt.Specialise. I also refactored the Specialise monad a bit... it was silly, because it passed on unchanging values as if they were mutable state. 3. Do an extra Simplifer run, after SpecConstra and before late-Specialise. I found (investigating perf/compiler/T16473) that failing to do this was crippling *both* SpecConstr *and* Specialise. See Note [Simplify after SpecConstr] in GHC.Core.Opt.Pipeline. This change does mean an extra run of the Simplifier, but only with -O2, and I think that's acceptable. T16473 allocates *three* times less with this change. (I changed it to check runtime rather than compile time.) Some smaller consequences * I moved pushCoercion, pushCoArg and friends from SimpleOpt to Arity, because it was needed by the new etaInfoApp. And pushCoValArg now returns a MCoercion rather than Coercion for the argument Coercion. * A minor, incidental improvement to Core pretty-printing This does fix #18223, (which was otherwise uncompilable. Hooray. But there is still a big intermediate because there are some very deeply nested types in that program. Modest reductions in compile-time allocation on a couple of benchmarks T12425 -2.0% T13253 -10.3% Metric increase with -O2, due to extra simplifier run T9233 +5.8% T12227 +1.8% T15630 +5.0% There is a spurious apparent increase on heap residency on T9630, on some architectures at least. I tried it with -G1 and the residency is essentially unchanged. Metric Increase T9233 T12227 T9630 Metric Decrease T12425 T13253 - - - - - 416bd50e by Simon Peyton Jones at 2020-09-22T05:37:59-04:00 Fix the occurrence analyser Ticket #18603 demonstrated that the occurrence analyser's handling of local RULES for imported Ids (which I now call IMP-RULES) was inadequate. It led the simplifier into an infnite loop by failing to label a binder as a loop breaker. The main change in this commit is to treat IMP-RULES in a simple and uniform way: as extra rules for the local binder. See Note [IMP-RULES: local rules for imported functions] This led to quite a bit of refactoring. The result is still tricky, but it's much better than before, and better documented I think. Oh, and it fixes the bug. - - - - - 6fe8a0c7 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck - Comments only: Replace /~ by ≁ - - - - - e9501547 by Sebastian Graf at 2020-09-22T05:38:35-04:00 PmCheck: Rewrite inhabitation test We used to produce inhabitants of a pattern-match refinement type Nabla in the checker in at least two different and mostly redundant ways: 1. There was `provideEvidence` (now called `generateInhabitingPatterns`) which is used by `GHC.HsToCore.PmCheck` to produce non-exhaustive patterns, which produces inhabitants of a Nabla as a sub-refinement type where all match variables are instantiated. 2. There also was `ensure{,All}Inhabited` (now called `inhabitationTest`) which worked slightly different, but was whenever new type constraints or negative term constraints were added. See below why `provideEvidence` and `ensureAllInhabited` can't be the same function, the main reason being performance. 3. And last but not least there was the `nonVoid` test, which tested that a given type was inhabited. We did use this for strict fields and -XEmptyCase in the past. The overlap of (3) with (2) was always a major pet peeve of mine. The latter was quite efficient and proven to work for recursive data types, etc, but could not handle negative constraints well (e.g. we often want to know if a *refined* type is empty, such as `{ x:[a] | x /= [] }`). Lower Your Guards suggested that we could get by with just one, by replacing both functions with `inhabitationTest` in this patch. That was only possible by implementing the structure of φ constraints as in the paper, namely the semantics of φ constructor constraints. This has a number of benefits: a. Proper handling of unlifted types and strict fields, fixing #18249, without any code duplication between `GHC.HsToCore.PmCheck.Oracle.instCon` (was `mkOneConFull`) and `GHC.HsToCore.PmCheck.checkGrd`. b. `instCon` can perform the `nonVoid` test (3) simply by emitting unliftedness constraints for strict fields. c. `nonVoid` (3) is thus simply expressed by a call to `inhabitationTest`. d. Similarly, `ensureAllInhabited` (2), which we called after adding type info, now can similarly be expressed as the fuel-based `inhabitationTest`. See the new `Note [Why inhabitationTest doesn't call generateInhabitingPatterns]` why we still have tests (1) and (2). Fixes #18249 and brings nice metric decreases for `T17836` (-76%) and `T17836b` (-46%), as well as `T18478` (-8%) at the cost of a few very minor regressions (< +2%), potentially due to the fact that `generateInhabitingPatterns` does more work to suggest the minimal COMPLETE set. Metric Decrease: T17836 T17836b - - - - - 086ef018 by Hécate at 2020-09-23T06:52:08-04:00 Remove the list of loaded modules from the ghci prompt - - - - - d7385f70 by Ben Gamari at 2020-09-23T06:52:44-04:00 Bump submodules * Bump bytestring to 0.10.12.0 * Bump Cabal to 3.4.0.0-rc3 * Bump Win32 to 2.10.0.0 - - - - - 667d6355 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Refactor CLabel pretty-printing * Don't depend on the selected backend to know if we print Asm or C labels: we already have PprStyle to determine this. Moreover even when a native backend is used (NCG, LLVM) we may want to C headers containing pretty-printed labels, so it wasn't a good predicate anyway. * Make pretty-printing code clearer and avoid partiality - - - - - a584366b by Sylvain Henry at 2020-09-23T20:43:48-04:00 Remove sdocWithDynFlags (fix #10143) - - - - - a997fa01 by Sylvain Henry at 2020-09-23T20:43:48-04:00 Preliminary work towards removing DynFlags -> Driver.Ppr dependency - - - - - 31fea307 by Hécate at 2020-09-23T20:44:24-04:00 Remove redundant "do", "return" and language extensions from base - - - - - 04d64331 by syd at cs-syd.eu at 2020-09-24T13:15:54-04:00 Update Lock.hs with more documentation to make sure that the Boolean return value is clear. [skip ci] - - - - - 97cff919 by Simon Peyton Jones at 2020-09-24T13:16:32-04:00 Implement Quick Look impredicativity This patch implements Quick Look impredicativity (#18126), sticking very closely to the design in A quick look at impredicativity, Serrano et al, ICFP 2020 The main change is that a big chunk of GHC.Tc.Gen.Expr has been extracted to two new modules GHC.Tc.Gen.App GHC.Tc.Gen.Head which deal with typechecking n-ary applications, and the head of such applications, respectively. Both contain a good deal of documentation. Three other loosely-related changes are in this patch: * I implemented (partly by accident) points (2,3)) of the accepted GHC proposal "Clean up printing of foralls", namely https://github.com/ghc-proposals/ghc-proposals/blob/ master/proposals/0179-printing-foralls.rst (see #16320). In particular, see Note [TcRnExprMode] in GHC.Tc.Module - :type instantiates /inferred/, but not /specified/, quantifiers - :type +d instantiates /all/ quantifiers - :type +v is killed off That completes the implementation of the proposal, since point (1) was done in commit df08468113ab46832b7ac0a7311b608d1b418c4d Author: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> Date: Mon Feb 3 21:17:11 2020 +0100 Always display inferred variables using braces * HsRecFld (which the renamer introduces for record field selectors), is now preserved by the typechecker, rather than being rewritten back to HsVar. This is more uniform, and turned out to be more convenient in the new scheme of things. * The GHCi debugger uses a non-standard unification that allows the unification variables to unify with polytypes. We used to hack this by using ImpredicativeTypes, but that doesn't work anymore so I introduces RuntimeUnkTv. See Note [RuntimeUnkTv] in GHC.Runtime.Heap.Inspect Updates haddock submodule. WARNING: this patch won't validate on its own. It was too hard to fully disentangle it from the following patch, on type errors and kind generalisation. Changes to tests * Fixes #9730 (test added) * Fixes #7026 (test added) * Fixes most of #8808, except function `g2'` which uses a section (which doesn't play with QL yet -- see #18126) Test added * Fixes #1330. NB Church1.hs subsumes Church2.hs, which is now deleted * Fixes #17332 (test added) * Fixes #4295 * This patch makes typecheck/should_run/T7861 fail. But that turns out to be a pre-existing bug: #18467. So I have just made T7861 into expect_broken(18467) - - - - - 9fa26aa1 by Simon Peyton Jones at 2020-09-24T13:16:32-04:00 Improve kind generalisation, error messages This patch does two things: * It refactors GHC.Tc.Errors a bit. In debugging Quick Look I was forced to look in detail at error messages, and ended up doing a bit of refactoring, esp in mkTyVarEqErr'. It's still quite a mess, but a bit better, I think. * It makes a significant improvement to the kind checking of type and class declarations. Specifically, we now ensure that if kind checking fails with an unsolved constraint, all the skolems are in scope. That wasn't the case before, which led to some obscure error messages; and occasional failures with "no skolem info" (eg #16245). Both of these, and the main Quick Look patch itself, affect a /lot/ of error messages, as you can see from the number of files changed. I've checked them all; I think they are as good or better than before. Smaller things * I documented the various instances of VarBndr better. See Note [The VarBndr tyep and its uses] in GHC.Types.Var * Renamed GHC.Tc.Solver.simpl_top to simplifyTopWanteds * A bit of refactoring in bindExplicitTKTele, to avoid the footwork with Either. Simpler now. * Move promoteTyVar from GHC.Tc.Solver to GHC.Tc.Utils.TcMType Fixes #16245 (comment 211369), memorialised as typecheck/polykinds/T16245a Also fixes the three bugs in #18640 - - - - - 6d0ce0eb by Sebastian Graf at 2020-09-24T13:17:07-04:00 PmCheck: Desugar string literal patterns with -XRebindableSyntax correctly (#18708) Fixes #18708. - - - - - 007940d2 by Hécate at 2020-09-24T13:17:44-04:00 Namespace the Hadrian linting rule for base - - - - - 5b727189 by Andreas Klebinger at 2020-09-25T21:10:20-04:00 Make sizeExpr strict in the size threshold to facilitate WW. - - - - - dd664031 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci.sh: Factor out common utilities - - - - - 5b78e865 by Ben Gamari at 2020-09-25T21:10:56-04:00 ci: Add ad-hoc performance testing rule - - - - - 29885f07 by Zubin Duggal at 2020-09-25T21:11:32-04:00 Stop removing definitions of record fields in GHC.Iface.Ext.Ast - - - - - 0d6519d9 by Ben Gamari at 2020-09-25T21:12:08-04:00 gitlab-ci: Drop Darwin cleanup job We now have a proper periodic clean-up script installed on the runners. - - - - - 277d20af by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add regression tests for #18371 They have been fixed by !3959, I believe. Fixes #18371. - - - - - 8edf6056 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Add a regression test for #18609 The egregious performance hits are gone since !4050. So we fix #18609. - - - - - 4a1b89a4 by Sebastian Graf at 2020-09-25T21:12:44-04:00 Accept new test output for #17218 The expected test output was plain wrong. It has been fixed for a long time. Thus we can close #17218. - - - - - 51606236 by Sven Tennie at 2020-09-25T21:13:19-04:00 Print RET_BIG stack closures A RET_BIG closure has a large bitmap that describes it's payload and can be printed with printLargeBitmap(). Additionally, the output for payload closures of small and big bitmaps is changed: printObj() is used to print a bit more information about what's on the stack. - - - - - 2707c4ea by Arnaud Spiwack at 2020-09-25T21:13:58-04:00 Pattern guards BindStmt always use multiplicity Many Fixes #18439 . The rhs of the pattern guard was consumed with multiplicity one, while the pattern assumed it was Many. We use Many everywhere instead. This is behaviour consistent with that of `case` expression. See #18738. - - - - - 92daad24 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: refactor backend modules * move backends into GHC.Num.Backend.* * split backend selection into GHC.Num.Backend and GHC.Num.Backend.Selected to avoid duplication with the Check backend - - - - - 04bc50b3 by Sylvain Henry at 2020-09-25T21:14:36-04:00 Bignum: implement extended GCD (#18427) - - - - - 6a7dae4b by Krzysztof Gogolewski at 2020-09-25T21:15:14-04:00 Fix typed holes causing linearity errors (#18491) - - - - - 83407ffc by Krzysztof Gogolewski at 2020-09-25T21:15:53-04:00 Various documentation fixes * Remove UnliftedFFITypes from conf. Some time ago, this extension was undocumented and we had to silence a warning. This is no longer needed. * Use r'' in conf.py. This fixes a Sphinx warning: WARNING: Support for evaluating Python 2 syntax is deprecated and will be removed in Sphinx 4.0. Convert docs/users_guide/conf.py to Python 3 syntax. * Mark GHCForeignImportPrim as documented * Fix formatting in template_haskell.rst * Remove 'recursive do' from the list of unsupported items in TH - - - - - af1e84e7 by Sebastian Graf at 2020-09-26T05:36:46-04:00 PmCheck: Big refactor of module structure * Move everything from `GHC.HsToCore.PmCheck.*` to `GHC.HsToCore.Pmc.*` in analogy to `GHC.Tc`, rename exported `covCheck*` functions to `pmc*` * Rename `Pmc.Oracle` to `Pmc.Solver` * Split off the LYG desugaring and checking steps into their own modules (`Pmc.Desugar` and `Pmc.Check` respectively) * Split off a `Pmc.Utils` module with stuff shared by `Pmc.{,Desugar,Check,Solver}` * Move `Pmc.Types` to `Pmc.Solver.Types`, add a new `Pmc.Types` module with all the LYG types, which form the interfaces between `Pmc.{Desugar,Check,Solver,}`. - - - - - f08f98e8 by Sebastian Graf at 2020-09-26T05:36:46-04:00 Extract SharedIdEnv into its own module It's now named `GHC.Types.Unique.SDFM.UniqSDFM`. The implementation is more clear about its stated goals and supported operations. - - - - - 1cde295c by Sylvain Henry at 2020-09-26T05:37:23-04:00 Bignum: add bigNatFromWordArray Reimplementation of integer-gmp's byteArrayToBigNat# - - - - - bda55fa0 by Krzysztof Gogolewski at 2020-09-26T13:18:22-04:00 Make 'undefined x' linear in 'x' (#18731) - - - - - 160fba4a by Krzysztof Gogolewski at 2020-09-26T13:19:00-04:00 Disallow linear types in FFI (#18472) - - - - - e124f2a7 by Krzysztof Gogolewski at 2020-09-26T13:19:36-04:00 Fix handling of function coercions (#18747) This was broken when we added multiplicity to the function type. - - - - - 7ff43382 by Vladislav Zavialov at 2020-09-27T03:01:31+03:00 Comments: change outdated reference to mergeOps As of 686e06c59c3aa6b66895e8a501c7afb019b09e36, GHC.Parser.PostProcess.mergeOps no longer exists. [ci skip] - - - - - 4edf5527 by Vladislav Zavialov at 2020-09-27T10:04:12-04:00 Don't rearrange (->) in the renamer The parser produces an AST where the (->) is already associated correctly: 1. (->) has the least possible precedence 2. (->) is right-associative Thus we don't need to handle it in mkHsOpTyRn. - - - - - a9ce159b by Vladislav Zavialov at 2020-09-27T10:04:12-04:00 Remove outdated comment in rnHsTyKi This comment dates back to 3df40b7b78044206bbcffe3e2c0a57d901baf5e8 and does not seem relevant anymore. - - - - - 583a2070 by Richard Eisenberg at 2020-09-29T00:31:27-04:00 Optimize NthCo (FunCo ...) in coercion opt We were missing this case previously. Close #18528. Metric Decrease: T18223 T5321Fun - - - - - b31a3360 by Krzysztof Gogolewski at 2020-09-29T00:32:05-04:00 Linear types: fix kind inference when checking datacons - - - - - 5830a12c by Vladislav Zavialov at 2020-09-29T00:32:05-04:00 New linear types syntax: a %p -> b (#18459) Implements GHC Proposal #356 Updates the haddock submodule. - - - - - bca4d36d by Vladislav Zavialov at 2020-09-29T00:32:05-04:00 Improve error messages for (a %m) without LinearTypes Detect when the user forgets to enable the LinearTypes extension and produce a better error message. Steals the (a %m) syntax from TypeOperators, the workaround is to write (a % m) instead. - - - - - b9635d0a by Benjamin Maurer at 2020-09-29T00:32:43-04:00 Description of flag `-H` was in 'verbosity options', moved to 'misc'. Fixes #18699 - - - - - 74c797f6 by Benjamin Maurer at 2020-09-29T00:33:20-04:00 Workaround for #18623: GHC crashes bc. under rlimit for vmem it will reserve _all_ of it, leaving nothing for, e.g., thread stacks. Fix will only allocate 2/3rds and check whether remainder is at least large enough for minimum amount of thread stacks. - - - - - 4365d77a by Ryan Scott at 2020-09-29T00:33:57-04:00 Add regression test #18501 ghc/ghc!3220 ended up fixing #18501. This patch adds a regression test for #18501 to ensure that it stays fixed. - - - - - 8e3f00dd by Sylvain Henry at 2020-09-29T17:24:03+02:00 Make the parser module less dependent on DynFlags Bump haddock submodule - - - - - 3ab0d8f7 by Sebastian Graf at 2020-09-30T02:48:27-04:00 PmCheck: Long-distance information for LocalBinds (#18626) Now `desugarLocalBind` (formerly `desugarLet`) reasons about * `FunBind`s that * Have no pattern matches (so which aren't functions) * Have a singleton match group with a single GRHS * (which may have guards) * and looks through trivial post-typechecking `AbsBinds` in doing so to pick up the introduced renamings. And desugars to `PmLet` LYG-style guards. Since GRHSs are no longer denoted simply by `NonEmpty PmGRHS`, but also need to carry a `[PmGrd]` for the `PmLet`s from `LocalBind`s, I added `PmGRHSs` to capture that. Since we call out to the desugarer more often, I found that there were superfluous warnings emitted when desugaring e.g. case expressions. Thus, I made sure that we deactivate any warnings in the LYG desugaring steps by the new wrapper function `noCheckDs`. There's a regression test in `T18626`. Fixes #18626. - - - - - f8f60efc by Ben Gamari at 2020-09-30T02:49:03-04:00 testsuite: Mark T12971 as broken on Windows Due to #17945. - - - - - 6527fc57 by Ben Gamari at 2020-09-30T02:49:03-04:00 Bump Cabal, hsc2hs, directory, process submodules Necessary for recent Win32 bump. - - - - - df3f5880 by Sylvain Henry at 2020-09-30T02:49:41-04:00 Remove unsafeGlobalDynFlags (#17957, #14597) There are still global variables but only 3 booleans instead of a single DynFlags. - - - - - 9befd94d by Sylvain Henry at 2020-09-30T02:49:41-04:00 Remove unused global variables Some removed globals variables were still declared in the RTS. They were removed in the following commits: * 4fc6524a2a4a0003495a96c8b84783286f65c198 * 0dc7985663efa1739aafb480759e2e2e7fca2a36 * bbd3c399939311ec3e308721ab87ca6b9443f358 - - - - - 7c98699f by Richard Eisenberg at 2020-09-30T02:50:17-04:00 Omit redundant kind equality check in solver See updated Note [Use loose types in inert set] in GHC.Tc.Solver.Monad. Close #18753. - - - - - 39549826 by Sebastian Graf at 2020-09-30T02:50:54-04:00 Pmc: Don't call exprType on type arguments (#18767) Fixes #18767. - - - - - 235e410f by Richard Eisenberg at 2020-09-30T02:51:29-04:00 Regression test for #10709. Close #10709 - - - - - 5c32655f by Ben Gamari at 2020-09-30T22:31:55-04:00 hadrian/doc: Clarify documentation of key-value configuration - - - - - 0bb02873 by Sylvain Henry at 2020-10-01T18:34:53-04:00 Add test for T18574 - - - - - e393f213 by Sylvain Henry at 2020-10-01T18:34:53-04:00 Allow fusion with catMaybes (#18574) Metric Decrease: T18574 - - - - - d2cfad96 by Fendor at 2020-10-01T18:35:33-04:00 Add mainModuleNameIs and demote mainModIs Add `mainModuleNameIs` to DynFlags and demote `mainModIs` to function which uses the homeUnit from DynFlags it is created from. - - - - - fc351ab8 by Fendor at 2020-10-01T18:35:33-04:00 Use HomeUnit for main module without module declaration - - - - - dca1cb22 by Fendor at 2020-10-01T18:35:33-04:00 Remove mAIN completely - - - - - a5aaceec by Sylvain Henry at 2020-10-01T18:36:11-04:00 Use ADTs for parser errors/warnings Haskell and Cmm parsers/lexers now report errors and warnings using ADTs defined in GHC.Parser.Errors. They can be printed using functions in GHC.Parser.Errors.Ppr. Some of the errors provide hints with a separate ADT (e.g. to suggest to turn on some extension). For now, however, hints are not consistent across all messages. For example some errors contain the hints in the main message. I didn't want to change any message with this patch. I expect these changes to be discussed and implemented later. Surprisingly, this patch enhances performance. On CI (x86_64/deb9/hadrian, ghc/alloc): parsing001 -11.5% T13719 -2.7% MultiLayerModules -3.5% Naperian -3.1% Bump haddock submodule Metric Decrease: MultiLayerModules Naperian T13719 parsing001 - - - - - a946c7ef by Sylvain Henry at 2020-10-01T18:36:11-04:00 Less DynFlags in Header parsing - - - - - dafe7943 by Sylvain Henry at 2020-10-01T18:36:11-04:00 Parser: remove some unused imports These are not reported by GHC because Happy adds {-# OPTIONS_GHC -w #-} - - - - - 93d5de16 by Sylvain Henry at 2020-10-01T18:36:11-04:00 Don't import GHC.Unit to reduce the number of dependencies - - - - - e3655f81 by Sebastian Graf at 2020-10-01T18:36:47-04:00 Don't attach CPR signatures to NOINLINE data structures (#18154) Because the generated `KindRep`s don't have an unfolding, !3230 did not actually stop to compute, attach and serialise unnecessary CPR signatures for them. As already said in `Note [CPR for data structures]`, that leads to bloated interface files which is ultimately quadratic for Nested CPR. So we don't attach any CPR signature to bindings that * Are not thunks (because thunks are not in WHNF) * Have arity 0 (which means the top-level constructor is not a lambda) If the data structure has an unfolding, we continue to look through it. If not (as is the case for `KindRep`s), we look at the unchanged CPR signature and see `topCprType`, as expected. - - - - - ba5965eb by Richard Eisenberg at 2020-10-01T18:37:23-04:00 Add regression test for #18755. Close #18755 - - - - - a8018c17 by Vladislav Zavialov at 2020-10-01T18:37:58-04:00 Fix pretty-printing of the mult-polymorphic arrow A follow-up to !4020 (5830a12c46e7227c276a8a71213057595ee4fc04) - - - - - e5523324 by Sylvain Henry at 2020-10-01T18:38:35-04:00 Bignum: add integerNegate RULE - - - - - 1edd6d21 by Vladislav Zavialov at 2020-10-01T18:39:10-04:00 Refactor: remove rnHsDoc It did not do any useful work. - - - - - a9ae83af by Krzysztof Gogolewski at 2020-10-02T08:00:25-04:00 Fix typos in comments [skip ci] - - - - - b81350bb by Icelandjack at 2020-10-02T08:01:01-04:00 Replaced MkT1 with T1 in type signatures. - - - - - 3c9beab7 by Vladislav Zavialov at 2020-10-02T13:51:58-04:00 Minor TTG clean-up: comments, unused families, bottom 1. Fix and update section headers in GHC/Hs/Extension.hs 2. Delete the unused 'XCoreAnn' and 'XTickPragma' families 3. Avoid calls to 'panic' in 'pprStmt' - - - - - 12c06927 by Sylvain Henry at 2020-10-02T13:52:38-04:00 Bignum: implement integerRecipMod (#18427) - - - - - 8dd4f405 by Sylvain Henry at 2020-10-02T13:52:38-04:00 Bignum: implement integerPowMod (#18427) Incidentally fix powModInteger which was crashing in integer-gmp for negative exponents when the modular multiplicative inverse for the base didn't exist. Now we compute it explicitly with integerRecipMod so that every backend returns the same result without crashing. - - - - - 1033a720 by Krzysztof Gogolewski at 2020-10-02T13:53:23-04:00 Reject linearity in kinds in checkValidType (#18780) Patch taken from https://gitlab.haskell.org/ghc/ghc/-/issues/18624#note_300673 - - - - - b0ccba66 by Krzysztof Gogolewski at 2020-10-03T19:33:02-04:00 Small documentation fixes - Fix formatting of code blocks and a few sphinx warnings - Move the Void# change to 9.2, it was done right after the branch was cut - Fix typo in linear types documentation - Note that -Wincomplete-uni-patterns affects lazy patterns [skip ci] - - - - - 70dc2f09 by Karel Gardas at 2020-10-03T19:33:06-04:00 fix rts.cabal to use real arch names and not aliasses (fixes #18654) - - - - - bc5de347 by Sebastian Graf at 2020-10-05T13:59:24-04:00 Inline `integerDecodeDouble#` and constant-fold `decodeDouble_Int64#` instead Currently, `integerDecodeDouble#` is known-key so that it can be recognised in constant folding. But that is very brittle and doesn't survive worker/wrapper, which we even do for `NOINLINE` things since #13143. Also it is a trade-off: The implementation of `integerDecodeDouble#` allocates an `Integer` box that never cancels aways if we don't inline it. Hence we recognise the `decodeDouble_Int64#` primop instead in constant folding, so that we can inline `integerDecodeDouble#`. As a result, `integerDecodeDouble#` no longer needs to be known-key. While doing so, I realised that we don't constant-fold `decodeFloat_Int#` either, so I also added a RULE for it. `integerDecodeDouble` is dead, so I deleted it. Part of #18092. This improves the 32-bit `realToFrac`/`toRational`: Metric Decrease: T10359 - - - - - 802b5e6f by Krzysztof Gogolewski at 2020-10-05T13:59:33-04:00 Fix linear types in TH splices (#18465) - - - - - 18a3ddf7 by Ben Gamari at 2020-10-05T13:59:33-04:00 rts: Fix integer width in TICK_BUMP_BY Previously `TICK_BUMP_BY` was defined as ```c #define TICK_BUMP_BY(ctr,n) CLong[ctr] = CLong[ctr] + n ``` Yet the tickers themselves were defined as `StgInt`s. This happened to work out correctly on Linux, where `CLong` is 64-bits. However, it failed on Windows, where `CLong` is 32-bits, resulting in #18782. Fixes #18783. - - - - - 5fc4243b by Rachel at 2020-10-07T14:59:45-04:00 Document profiling flags, warning flags, and no-pie - - - - - b41f7c38 by Andreas Klebinger at 2020-10-07T15:00:20-04:00 WinIO: Small changes related to atomic request swaps. Move the atomix exchange over the Ptr type to an internal module. Fix a bug caused by us passing ptr-to-ptr instead of ptr to atomic exchange. Renamed interlockedExchange to exchangePtr. I've also added an cas primitive. It turned out we don't need it for WinIO but I'm leaving it in as it's useful for other things. - - - - - 948a14e1 by Ben Gamari at 2020-10-07T15:00:55-04:00 gitlab-ci: Fix name of Ubuntu 20.04 image - - - - - 74d4017b by Sylvain Henry at 2020-10-07T15:01:35-04:00 Fix -flink-rts (#18651) Before this patch -flink-rts could link with GHC's rts instead of the selected one. - - - - - 0e8b923d by Sylvain Henry at 2020-10-07T15:01:35-04:00 Apply suggestion to compiler/GHC/SysTools.hs - - - - - d6dff830 by Alan Zimmerman at 2020-10-07T15:02:10-04:00 Preserve as-parsed arrow type for HsUnrestrictedArrow When linear types are disabled, HsUnrestrictedArrow is treated as HslinearArrow. Move this adjustment into the type checking phase, so that the parsed source accurately represents the source as parsed. Closes #18791 - - - - - 030c5ce0 by Karel Gardas at 2020-10-07T15:02:48-04:00 hadrian: use stage0 linker to merge objects when done during the stage0 Fixes #18800. - - - - - a94db588 by Ben Gamari at 2020-10-07T15:03:23-04:00 testsuite: Allow whitespace before "Metric (in|de)crease" Several people have struggled with metric change annotations in their commit messages not being recognized due to the fact that GitLab's job log inserts a space at the beginning of each line. Teach the regular expression to accept this whitespace. - - - - - e91ddddd by Krzysztof Gogolewski at 2020-10-07T15:04:07-04:00 Misc cleanup * Include funTyCon in exposedPrimTyCons. Every single place using exposedPrimTyCons was adding funTyCon manually. * Remove unused synTyConResKind and ieLWrappedName * Add recordSelectorTyCon_maybe * In exprType, panic instead of giving a trace message and dummy output. This prevents #18767 reoccurring. * Fix compilation error in fragile concprog001 test (part of #18732) - - - - - 386c2d7f by Sylvain Henry at 2020-10-09T08:40:33-04:00 Use UnitId in the backend instead of Unit In Cmm we can only have real units identified with an UnitId. Other units (on-the-fly instantiated units and holes) are only used in type-checking backpack sessions that don't produce Cmm. - - - - - a566c83d by Simon Jakobi at 2020-10-09T08:41:09-04:00 Update containers to v0.6.4.1 Updates containers submodule. - - - - - fd984d68 by Tamar Christina at 2020-10-09T08:41:50-04:00 rts: fix race condition in StgCRun On windows the stack has to be allocated 4k at a time, otherwise we get a segfault. This is done by using a helper ___chkstk_ms that is provided by libgcc. The Haskell side already knows how to handle this but we need to do the same from STG. Previously we would drop the stack in StgRun but would only make it valid whenever the scheduler loop ran. This approach was fundamentally broken in that it falls apart when you take a signal from the OS. We see it less often because you initially get allocated a 1MB stack block which you have to blow past first. Concretely this means we must always keep the stack valid. Fixes #18601. - - - - - accdb24a by Sylvain Henry at 2020-10-09T08:42:31-04:00 Expose RTS-only ways (#18651) Some RTS ways are exposed via settings (ghcThreaded, ghcDebugged) but not all. It's simpler if the RTS exposes them all itself. - - - - - d360f343 by MaxGabriel at 2020-10-09T08:43:11-04:00 Document -Wderiving-typeable Tracking: #18641 - - - - - e48cab2a by Krzysztof Gogolewski at 2020-10-09T08:43:49-04:00 Add a flag to indicate that gcc supports -no-pie Fixes #17919. - - - - - f7e2fff9 by Hécate at 2020-10-09T08:44:26-04:00 Add linting of `base` to the CI - - - - - 45a1d493 by Andreas Klebinger at 2020-10-09T08:45:05-04:00 Use proper RTS flags when collecting residency in perf tests. Replace options like collect_stats(['peak_megabytes_allocated'],4) with collect_runtime_residency(4) and so forth. Reason being that the later also supplies some default RTS arguments which make sure residency does not fluctuate too much. The new flags mean we get new (hopefully more accurate) baselines so accept the stat changes. ------------------------- Metric Decrease: T4029 T4334 T7850 Metric Increase: T13218 T7436 ------------------------- - - - - - ef65b154 by Andreas Klebinger at 2020-10-09T08:45:42-04:00 testsuite/timeout: Fix windows specific errors. We now seem to use -Werror there. Which caused some long standing warnings to become errors. I applied changes to remove the warnings allowing the testsuite to run on windows as well. - - - - - e691a5a0 by Sylvain Henry at 2020-10-09T08:46:22-04:00 Hadrian: add quick-debug flavour - - - - - 12191a99 by Sylvain Henry at 2020-10-09T08:47:00-04:00 Bignum: match on small Integer/Natural Previously we only matched on *variables* whose unfoldings were a ConApp of the form `IS lit#` or `NS lit##`. But we forgot to match on the ConApp directly... As a consequence, constant folding only worked after the FloatOut pass which creates bindings for most sub-expressions. With this patch, matching on bignums works even with -O0 (see bignumMatch test). - - - - - 36787bba by Alan Zimmerman at 2020-10-09T08:47:36-04:00 ApiAnnotations : preserve parens in GADTs A cleanup in 7f418acf61e accidentally discarded some parens in ConDeclGADT. Make sure these stay in the AST in a usable format. Also ensure the AnnLolly does not get lost in a GADT. - - - - - 32dc7698 by Krzysztof Gogolewski at 2020-10-09T08:48:15-04:00 Linear types: fix roles in GADTs (#18799) - - - - - 9657f6f3 by Ben Gamari at 2020-10-09T08:48:52-04:00 sdist: Include hadrian sources in source distribution Previously the make build system's source distribution rules neglected to include Hadrian's sources. Fixes #18794. - - - - - c832f7e2 by Tamar Christina at 2020-10-09T08:49:33-04:00 winio: fixed timeouts non-threaded. - - - - - 6f0243ae by Tamar Christina at 2020-10-09T08:50:13-04:00 winio: fix array splat - - - - - 0fd3d360 by Tamar Christina at 2020-10-09T08:50:51-04:00 winio: fixed bytestring reading interface. - - - - - dfaef1ca by Tamar Christina at 2020-10-09T08:51:30-04:00 winio: fixed more data error. - - - - - bfdccac6 by Simon Peyton Jones at 2020-10-09T08:52:07-04:00 Fix desugaring of record updates on data families This fixes a long-standing bug in the desugaring of record updates for data families, when the latter involves a GADT. It's all explained in Note [Update for GADTs] in GHC.HsToCore.Expr. Building the correct cast is surprisingly tricky, as that Note explains. Fixes #18809. The test case (in indexed-types/should_compile/T18809) contains several examples that exercise the dark corners. - - - - - e5c7c9c8 by Ben Gamari at 2020-10-09T08:52:43-04:00 Bump win32-tarballs version to 0.3 This should fix #18774. - - - - - ef950b19 by Andreas Klebinger at 2020-10-09T08:53:21-04:00 Add TyCon Set/Env and use them in a few places. Firstly this improves code clarity. But it also has performance benefits as we no longer go through the name of the TyCon to get at it's unique. In order to make this work the recursion check for TyCon has been moved into it's own module in order to avoid import cycles. - - - - - fd302e93 by Krzysztof Gogolewski at 2020-10-09T08:54:02-04:00 Add -pgmlm and -optlm flags !3798 added documentation and semantics for the flags, but not parsing. - - - - - db236ffc by Sylvain Henry at 2020-10-09T08:54:41-04:00 Testsuite: increase timeout for T18223 (#18795) - - - - - 6a243e9d by Sylvain Henry at 2020-10-09T08:55:21-04:00 Cache HomeUnit in HscEnv (#17957) Instead of recreating the HomeUnit from the DynFlags every time we need it, we store it in the HscEnv. - - - - - 5884fd32 by Fendor at 2020-10-09T19:46:28+02:00 Move File Target parser to library #18596 - - - - - ea59fd4d by Hécate at 2020-10-10T14:49:59-04:00 Lint the compiler for extraneous LANGUAGE pragmas - - - - - 22f218b7 by Krzysztof Gogolewski at 2020-10-10T14:50:42-04:00 Linear types: fix quantification in GADTs (#18790) - - - - - 74ee1237 by Sylvain Henry at 2020-10-10T14:51:20-04:00 Bignum: fix bigNatCompareWord# bug (#18813) - - - - - 274e21f0 by Hécate at 2020-10-11T10:55:56+02:00 Remove the dependency on the ghc-linters stage - - - - - 990ea991 by Daniel Rogozin at 2020-10-11T22:20:04+03:00 Fall back to types when looking up data constructors (#18740) Before this patch, referring to a data constructor in a term-level context led to a scoping error: ghci> id Int <interactive>:1:4: error: Data constructor not in scope: Int After this patch, the renamer falls back to the type namespace and successfully finds the Int. It is then rejected in the type checker with a more useful error message: <interactive>:1:4: error: • Illegal term-level use of the type constructor ‘Int’ imported from ‘Prelude’ (and originally defined in ‘GHC.Types’) • In the first argument of ‘id’, namely ‘Int’ In the expression: id Int We also do this for type variables. - - - - - 9bbc84d2 by Sylvain Henry at 2020-10-12T18:21:51-04:00 DynFlags: refactor DmdAnal Make demand analysis usable without having to provide DynFlags. - - - - - 7fdcce6d by Wander Hillen at 2020-10-13T00:12:47-04:00 Initial ShortText code and conversion of package db code Metric Decrease: Naperian T10421 T10421a T10547 T12150 T12234 T12425 T13035 T18140 T18304 T5837 T6048 T13253-spj T18282 T18223 T3064 T9961 Metric Increase T13701 HFSKJH - - - - - 0a5f2918 by Sylvain Henry at 2020-10-13T00:13:28-04:00 Parser: don't require the HomeUnitId The HomeUnitId is only used by the Cmm parser and this one has access to the DynFlags, so it can grab the UnitId of the HomeUnit from them. Bump haddock submodule - - - - - 8f4f5794 by HaskellMouse at 2020-10-13T13:05:49+03:00 Unification of Nat and Naturals This commit removes the separate kind 'Nat' and enables promotion of type 'Natural' for using as type literal. It partially solves #10776 Now the following code will be successfully typechecked: data C = MkC Natural type CC = MkC 1 Before this change we had to create the separate type for promotion data C = MkC Natural data CP = MkCP Nat type CC = MkCP 1 But CP is uninhabited in terms. For backward compatibility type synonym `Nat` has been made: type Nat = Natural The user's documentation and tests have been updated. The haddock submodule also have been updated. - - - - - 0fc1cb54 by Ben Gamari at 2020-10-14T03:42:50-04:00 gitlab-ci: Verify that Hadrian builds with Stack As noted in #18726, this regularly breaks. Let's test it. Note that we don't actually perform a build of GHC itself; we merely test that the Hadrian executable builds and works (by invoking `hadrian --version`). - - - - - 89f4d8e9 by Ben Gamari at 2020-10-14T12:03:57-04:00 Bump LLVM version to 10.0 Fixes #18267. - - - - - 716385c9 by Ryan Scott at 2020-10-14T12:04:34-04:00 Make DataKinds the sole arbiter of kind-level literals (and friends) Previously, the use of kind-level literals, promoted tuples, and promoted lists required enabling both `DataKinds` and `PolyKinds`. This made sense back in a `TypeInType` world, but not so much now that `TypeInType`'s role has been superseded. Nowadays, `PolyKinds` only controls kind polymorphism, so let's make `DataKinds` the thing that controls the other aspects of `TypeInType`, which include literals, promoted tuples and promoted lists. There are some other things that overzealously required `PolyKinds`, which this patch fixes as well: * Previously, using constraints in kinds (e.g., `data T :: () -> Type`) required `PolyKinds`, despite the fact that this is orthogonal to kind polymorphism. This now requires `DataKinds` instead. * Previously, using kind annotations in kinds (e.g., `data T :: (Type :: Type) -> Type`) required both `KindSignatures` and `PolyKinds`. This doesn't make much sense, so it only requires `KindSignatures` now. Fixes #18831. - - - - - ac300a0d by Vladislav Zavialov at 2020-10-14T12:05:11-04:00 Remove "Operator sections" from docs/users_guide/bugs.rst The issue described in that section was fixed by 2b89ca5b850b4097447cc4908cbb0631011ce979 - - - - - bf2411a3 by Vladislav Zavialov at 2020-10-14T12:05:11-04:00 Fix PostfixOperators (#18151) This fixes a regression introduced in 2b89ca5b850b4097447cc4908cbb0631011ce979 See the new T18151x test case. - - - - - e60ae8a3 by Fumiaki Kinoshita at 2020-10-14T18:06:12-04:00 Add -Wnoncanonical-{monad,monoid}-instances to standardWarnings ------------------------- Metric Decrease: T12425 Metric Increase: T17516 ------------------------- - - - - - 15d2340c by Simon Peyton Jones at 2020-10-14T18:06:48-04:00 Fix some missed opportunities for preInlineUnconditionally There are two signficant changes here: * Ticket #18815 showed that we were missing some opportunities for preInlineUnconditionally. The one-line fix is in the code for GHC.Core.Opt.Simplify.Utils.preInlineUnconditionally, which now switches off only for INLINE pragmas. I expanded Note [Stable unfoldings and preInlineUnconditionally] to explain. * When doing this I discovered a way in which preInlineUnconditionally was occasionally /too/ eager. It's all explained in Note [Occurrences in stable unfoldings] in GHC.Core.Opt.OccurAnal, and the one-line change adding markAllMany to occAnalUnfolding. I also got confused about what NoUserInline meant, so I've renamed it to NoUserInlinePrag, and changed its pretty-printing slightly. That led to soem error messate wibbling, and touches quite a few files, but there is no change in functionality. I did a nofib run. As expected, no significant changes. Program Size Allocs ---------------------------------------- sphere -0.0% -0.4% ---------------------------------------- Min -0.0% -0.4% Max -0.0% +0.0% Geometric Mean -0.0% -0.0% I'm allowing a max-residency increase for T10370, which seems very irreproducible. (See comments on !4241.) There is always sampling error for max-residency measurements; and in any case the change shows up on some platforms but not others. Metric Increase: T10370 - - - - - 0c4bfed8 by Ben Gamari at 2020-10-14T18:07:25-04:00 users-guide: Add missing :ghc-flag: directive - - - - - 51c4b851 by Krzysztof Gogolewski at 2020-10-15T04:30:27-04:00 Remove Proxy# argument in Data.Typeable.Internal No longer neccessary - TypeRep is now indexed, there is no ambiguity. Also fix a comment in Evidence.hs, IsLabel no longer takes a Proxy#. - - - - - 809f09e8 by Sylvain Henry at 2020-10-15T04:31:07-04:00 Fix parsing of PIE flags -fPIE and -fno-PIE flags were (un)setting Opt_PIC instead of Opt_PIE. Original commit: 3625728a0e3a9b56c2b85ae7ea8bcabdd83ece6a - - - - - 3d7db148 by Ben Gamari at 2020-10-15T04:31:42-04:00 testsuite: Add missing #include on <stdlib.h> This otherwise fails on newer Clangs, which warn more aggressively on undeclared symbols. - - - - - 998803dc by Andrzej Rybczak at 2020-10-15T11:40:32+02:00 Add flags for annotating Generic{,1} methods INLINE[1] (#11068) Makes it possible for GHC to optimize away intermediate Generic representation for more types. Metric Increase: T12227 - - - - - 6b14c418 by GHC GitLab CI at 2020-10-15T21:57:50-04:00 Extend mAX_TUPLE_SIZE to 64 As well a ctuples and sums. - - - - - d495f36a by Ben Gamari at 2020-10-15T21:58:27-04:00 rts: Clean-up whitespace in Interpreter - - - - - cf10becd by Ben Gamari at 2020-10-15T21:58:27-04:00 compiler/ByteCode: Use strict Maps in bytecode assembler - - - - - ae146b53 by Ben Gamari at 2020-10-15T21:58:27-04:00 compiler/ByteCode: Make LocalLabel a newtype - - - - - cc536288 by Ben Gamari at 2020-10-15T21:58:27-04:00 compiler/ByteCode: Allow 2^32 local labels This widens LocalLabel to 2^16, avoiding the crash observed in #14334. Closes #14334. - - - - - 1bb0512f by Ben Gamari at 2020-10-16T00:15:31-04:00 mingw: Extract zst toolchain archives This should have been done when the toolchain was bumped. - - - - - bf7c5b6d by Ben Gamari at 2020-10-16T00:15:31-04:00 base: Reintroduce necessary LANGUAGE pragmas These were incorrectly removed in a recent cleanup commit. - - - - - c6b4be4b by Ben Gamari at 2020-10-16T00:15:31-04:00 testsuite: Sort metrics by metric type Closes #18838. - - - - - c7989c93 by Ben Gamari at 2020-10-16T00:15:31-04:00 testsuite: Account for -Wnoncanonical-monoid-instances changes on Windows - - - - - 330a5433 by Ben Gamari at 2020-10-16T00:15:31-04:00 rts: Add __mingw_vfprintf to RtsSymbols.c Following the model of the other printf symbols. See Note [Symbols for MinGW's printf]. - - - - - c4a69f37 by Ben Gamari at 2020-10-16T00:15:31-04:00 gitlab-ci: Remove allow_failure from Windows jobs - - - - - 9a9679db by Ben Gamari at 2020-10-16T00:15:31-04:00 gitlab-ci: Fix Hadrian bindist names - - - - - 07b0db86 by f-a at 2020-10-16T10:14:39-04:00 Clarify Eq documentation #18713 - - - - - aca0e63b by Ben Gamari at 2020-10-17T10:20:31-04:00 gitlab-ci: Allow doc-tarball job to fail Currently the Hadrian build appears not to package documentation correctly, causing doc-tarball to fail due to the Windows build. - - - - - b02a9ea7 by Ben Gamari at 2020-10-17T13:26:24-04:00 gitlab-ci: s/allow_newer/allow_failure Silly mistake on my part. - - - - - 59d7c9f4 by John Ericson at 2020-10-17T22:01:38-04:00 Skip type family defaults with hs-boot and hsig files Works around #17190, possible resolution for #17224. New design is is according to accepted [GHC Propoal 320]. Instances in signatures currently unconditionally opt into associated family defaults if no explicit instance is given. This is bad for two reasons: 1. It constrains possible instantiations to use the default, rather than possibly define the associated family differently. 2. It breaks compilation as type families are unsupported in signatures. This PR simply turns off the filling in of defaults in those cases. Additionally, it squelches a missing definition warning for hs-boot too that was only squelched for hsig before. The downsides are: 1. There is no way to opt into the default, other than copying its definition. 2. If we fixed type classes in signatures, and wanted instances to have to explicitly *out of* rather than into the default, that would now be a breaking change. The change that is most unambiguously goood is harmonizing the warning squelching between hs-boot or hsig. Maybe they should have the warning (opt out of default) maybe they shouldn't (opt in to default), but surely it should be the same for both. Add hs-boot version of a backpack test regarding class-specified defaults in instances that appear in an hs-boot file. The metrics increase is very slight and makes no sense --- at least no one has figured anything out after this languishing for a while, so I'm just going to accept it. Metric Increase: T10421a [GHC proposal 320]: https://github.com/ghc-proposals/ghc-proposals/pull/320 - - - - - 7eb46a09 by Sebastian Graf at 2020-10-17T22:02:13-04:00 Arity: Refactor fixed-point iteration in GHC.Core.Opt.Arity Arity analysis used to propagate optimistic arity types during fixed-point interation through the `ArityEnv`'s `ae_cheap_fun` field, which is like `GHC.Core.Utils.exprIsCheap`, but also considers the current iteration's optimistic arity, for the binder in question only. In #18793, we have seen that this is a problematic design, because it doesn't allow us to look through PAP bindings of that binder. Hence this patch refactors to a more traditional form with an explicit signature environment, in which we record the optimistic `ArityType` of the binder in question (and at the moment is the *only* binder that is recorded in the arity environment). - - - - - 6b3eb06a by Sebastian Graf at 2020-10-17T22:02:13-04:00 Arity: Record arity types for non-recursive lets In #18793, we saw a compelling example which requires us to look at non-recursive let-bindings during arity analysis and unleash their arity types at use sites. After the refactoring in the previous patch, the needed change is quite simple and very local to `arityType`'s defn for non-recurisve `Let`. Apart from that, we had to get rid of the second item of `Note [Dealing with bottoms]`, which was entirely a safety measure and hindered optimistic fixed-point iteration. Fixes #18793. The following metric increases are all caused by this commit and a result of the fact that we just do more work now: Metric Increase: T3294 T12545 T12707 - - - - - 451455fd by Sebastian Graf at 2020-10-17T22:02:13-04:00 Testsuite: Add dead arity analysis tests We didn't seem to test these old tests at all, judging from their expected output. - - - - - 50e9df49 by Dylan Yudaken at 2020-10-17T22:02:50-04:00 When using rts_setInCallCapability, lock incall threads This diff makes sure that incall threads, when using `rts_setInCallCapability`, will be created as locked. If the thread is not locked, the thread might end up being scheduled to a different capability. While this is mentioned in the docs for `rts_setInCallCapability,`, it makes the method significantly less useful as there is no guarantees on the capability being used. This commit also adds a test to make sure things stay on the correct capability. - - - - - 0b995759 by DylanZA at 2020-10-17T22:02:50-04:00 Apply suggestion to testsuite/tests/ffi/should_run/all.T - - - - - a91dcb66 by Sylvain Henry at 2020-10-17T22:04:02-04:00 Don't get host RTS ways via settings (#18651) To correctly perform a linking hack for Windows we need to link with the RTS GHC is currently using. We used to query the RTS ways via the "settings" file but it is fragile (#18651). The hack hasn't been fixed to take into account all the ways (Tracing) and it makes linking of GHC with another RTS more difficult (we need to link with another RTS and to regenerate the settings file). So this patch uses the ways reported by the RTS itself (GHC.Platform.Ways.hostWays) instead of the "settings" file. - - - - - d858a3ae by Hécate at 2020-10-17T22:04:38-04:00 Linting corrections * Bring back LANGUAGE pragmas in GHC.IO.Handle.Lock.Windows * Exclude some modules that are wrongfully reported - - - - - b5b3e34e by Vladislav Zavialov at 2020-10-19T18:16:20-04:00 Implement -Woperator-whitespace (#18834) This patch implements two related warnings: -Woperator-whitespace-ext-conflict warns on uses of infix operators that would be parsed differently were a particular GHC extension enabled -Woperator-whitespace warns on prefix, suffix, and tight infix uses of infix operators Updates submodules: haddock, containers. - - - - - 9648d680 by Sylvain Henry at 2020-10-19T18:16:58-04:00 Remove pdocPrec pdocPrec was only used in GHC.Cmm.DebugBlock.pprUnwindExpr, so remove it. OutputableP becomes a one-function class which might be better for performance. - - - - - ee5dcdf9 by Ben Gamari at 2020-10-20T00:47:54-04:00 testsuite: Add test for #18346 This was fixed by 4291bddaea3148908c55f235ee8978e1d9aa6f20. - - - - - 6c7a5c0c by Krzysztof Gogolewski at 2020-10-20T00:48:29-04:00 Minor comments, update linear types docs - Update comments: placeHolderTypeTc no longer exists "another level check problem" was a temporary comment from linear types - Use Mult type synonym (reported in #18676) - Mention multiplicity-polymorphic fields in linear types docs - - - - - 58a1ca38 by nineonine at 2020-10-20T00:49:07-04:00 Compile modules with `-fobject-code` enabled to byte-code when loaded with `*` prefix in ghci (#8042) The documentation states that when using :add and :load, the `*` prefix forces a module to be loaded as byte-code. However, this seems to be ignored when -fobject-code has been enabled. In that case, the compiled code is always used, regardless of whether the *-form is used. The idea is to consult the Targets in HscEnv and check the 'targetAllowObjCode' flag. If the flag for given module is set, then patch up DynFlags and select compilation backend accordingly. This would require a linear scan of course, but that shouldn't be too costly. - - - - - 59b08a5d by Ben Gamari at 2020-10-20T00:49:41-04:00 gitlab-ci: Rename FLAVOUR -> BUILD_FLAVOUR Previously the Hadrian jobs used the `FLAVOUR` environment variable to communicate which flavour `ci.sh` should build whereas `make` used `BUILD_FLAVOUR`. This caused unnecessary confusion. Consolidate these two. - - - - - ea736839 by Alan Zimmerman at 2020-10-20T08:35:34+01:00 API Annotations: Keep track of unicode for linear arrow notation The linear arrow can be parsed as `%1 ->` or a direct single token unicode equivalent. Make sure that this distinction is captured in the parsed AST by using IsUnicodeSyntax where it appears, and introduce a new API Annotation, AnnMult to represent its location when unicode is not used. Updated haddock submodule - - - - - cf3c3bcd by Ben Gamari at 2020-10-20T22:56:31-04:00 testsuite: Mark T12971 as fragile on Windows Due to #17945. - - - - - e2c4a947 by Vladislav Zavialov at 2020-10-21T16:00:30+03:00 Parser regression tests, close #12862 #12446 These issues were fixed by earlier parser changes, most likely related to whitespace-sensitive parsing. - - - - - 711929e6 by Simon Peyton Jones at 2020-10-23T02:42:59-04:00 Fix error message location in tcCheckPatSynDecl Ticket #18856 showed that we were failing to set the right location for an error message. Easy to fix, happily. Turns out that this also improves the error location in test T11010, which was bogus before but we had never noticed. - - - - - 730bb590 by Ben Gamari at 2020-10-23T02:43:33-04:00 cmm: Add Note reference to ForeignHint - - - - - b9d4dd9c by Ben Gamari at 2020-10-24T20:44:17-04:00 SMP.h: Add C11-style atomic operations - - - - - ccf2d4b0 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts: Infrastructure for testing with ThreadSanitizer - - - - - a61f66d6 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/CNF: Initialize all bdescrs in group It seems wise and cheap to ensure that the whole bdescr of all blocks of a compact group is valid, even if most cases only look at the flags field. - - - - - 65136c13 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/Capability: Intialize interrupt field Previously this was left uninitialized. Also clarify some comments. - - - - - b3ce6aca by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/Task: Make comments proper Notes - - - - - d3890ac7 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/SpinLock: Move to proper atomics This is fairly straightforward; we just needed to use relaxed operations for the PROF_SPIN counters and a release store instead of a write barrier. - - - - - ef88712f by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/OSThreads: Fix data race Previously we would race on the cached processor count. Avoiding this is straightforward; just use relaxed operations. - - - - - 33a719c3 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts/ClosureMaros: Use relaxed atomics - - - - - f08951fd by Ben Gamari at 2020-10-24T20:59:39-04:00 configure: Bump minimum-supported gcc version to 4.7 Since the __atomic_* builtins are not supported until gcc 4.7. Given that this version was released in 2012 I think this is acceptable. - - - - - d584923a by Ben Gamari at 2020-10-24T20:59:39-04:00 testsuite: Fix thread leak in hs_try_putmvar00[13] - - - - - bf1b0bc7 by Ben Gamari at 2020-10-24T20:59:39-04:00 rts: Introduce SET_HDR_RELEASE Also ensure that we also store the info table pointer last to ensure that the synchronization covers all stores. - - - - - 1a2e9f5e by Ben Gamari at 2020-10-24T21:00:19-04:00 gitlab-ci: Add nightly-x86_64-linux-deb9-tsan job - - - - - 58a5b0e5 by GHC GitLab CI at 2020-10-24T21:00:19-04:00 testsuite: Mark setnumcapabilities001 as broken with TSAN Due to #18808. - - - - - d9bc7dea by GHC GitLab CI at 2020-10-24T21:00:19-04:00 testsuite: Skip divbyzero and derefnull under TSAN ThreadSanitizer changes the output of these tests. - - - - - fcc42a10 by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Skip high memory usage tests with TSAN ThreadSanitizer significantly increases the memory footprint of tests, so much so that it can send machines into OOM. - - - - - cae4bb3e by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Mark hie002 as high_memory_usage This test has a peak residency of 1GByte; this is large enough to classify as "high" in my book. - - - - - dae1b86a by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Mark T9872[abc] as high_memory_usage These all have a maximum residency of over 2 GB. - - - - - c5a0bb22 by Ben Gamari at 2020-10-24T21:00:19-04:00 gitlab-ci: Disable documentation in TSAN build Haddock chews through enough memory to cause the CI builders to OOM and there's frankly no reason to build documentation in this job anyways. - - - - - 4cb1232e by Ben Gamari at 2020-10-24T21:00:19-04:00 TSANUtils: Ensure that C11 atomics are supported - - - - - 7ed15f7f by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Mark T3807 as broken with TSAN Due to #18883. - - - - - f7e6f012 by Ben Gamari at 2020-10-24T21:00:19-04:00 testsuite: Mark T13702 as broken with TSAN due to #18884 - - - - - 16b136b0 by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Factor out logic to identify a good capability for running a task Not only does this make the control flow a bit clearer but it also allows us to add a TSAN suppression on this logic, which requires (harmless) data races. - - - - - 2781d68c by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Annotate benign race in waitForCapability - - - - - f6b4b492 by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Clarify locking behavior of releaseCapability_ - - - - - 65219810 by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Add assertions for task ownership of capabilities - - - - - 31fa87ec by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Use relaxed atomics on n_returning_tasks This mitigates the warning of a benign race on n_returning_tasks in shouldYieldCapability. See #17261. - - - - - 6517a2ea by Ben Gamari at 2020-10-24T21:00:36-04:00 rts: Mitigate races in capability interruption logic - - - - - 2e9ba3f2 by Ben Gamari at 2020-10-24T21:00:36-04:00 rts/Capability: Use relaxed operations for last_free_capability - - - - - e10dde37 by Ben Gamari at 2020-10-24T21:00:37-04:00 rts: Use relaxed operations for cap->running_task (TODO) This shouldn't be necessary since only the owning thread of the capability should be touching this. - - - - - 855325cd by Ben Gamari at 2020-10-24T21:00:37-04:00 rts/Schedule: Use relaxed operations for sched_state - - - - - 811f915d by Ben Gamari at 2020-10-24T21:00:37-04:00 rts: Accept data race in work-stealing implementation This race is okay since the task is owned by the capability pushing it. By Note [Ownership of Task] this means that the capability is free to write to `task->cap` without taking `task->lock`. Fixes #17276. - - - - - 8d2b3c3d by Ben Gamari at 2020-10-24T21:00:37-04:00 rts: Eliminate data races on pending_sync - - - - - f8871018 by Ben Gamari at 2020-10-24T21:00:37-04:00 rts/Schedule: Eliminate data races on recent_activity We cannot safely use relaxed atomics here. - - - - - d079b943 by Ben Gamari at 2020-10-24T21:00:37-04:00 rts: Avoid data races in message handling - - - - - 06f80497 by Ben Gamari at 2020-10-24T21:00:37-04:00 rts/Messages: Drop incredibly fishy write barrier executeMessage previously had a write barrier at the beginning of its loop apparently in an attempt to synchronize with another thread's writes to the Message. I would guess that the author had intended to use a load barrier here given that there are no globally-visible writes done in executeMessage. I've removed the redundant barrier since the necessary load barrier is now provided by the ACQUIRE_LOAD. - - - - - d4a87779 by Ben Gamari at 2020-10-24T21:00:38-04:00 rts/ThreadPaused: Avoid data races - - - - - 56778ab3 by Ben Gamari at 2020-10-24T21:00:38-04:00 rts/Schedule: Eliminate data races in run queue management - - - - - 086521f7 by Ben Gamari at 2020-10-24T21:00:38-04:00 rts: Eliminate shutdown data race on task counters - - - - - abad9778 by Ben Gamari at 2020-10-24T21:00:38-04:00 rts/Threads: Avoid data races (TODO) Replace barriers with appropriate ordering. Drop redundant barrier in tryWakeupThread (the RELEASE barrier will be provided by sendMessage's mutex release). We use relaxed operations on why_blocked and the stack although it's not clear to me why this is necessary. - - - - - 2f56be8a by Ben Gamari at 2020-10-24T21:00:39-04:00 rts/Messages: Annotate benign race - - - - - 7c0cdab1 by Ben Gamari at 2020-10-24T21:00:39-04:00 rts/RaiseAsync: Synchronize what_next read - - - - - 6cc2a8a5 by Ben Gamari at 2020-10-24T21:00:39-04:00 rts/Task: Move debugTrace to avoid data race Specifically, we need to hold all_tasks_mutex to read taskCount. - - - - - bbaec97d by Ben Gamari at 2020-10-24T21:00:39-04:00 Disable flawed assertion - - - - - dd175a92 by Ben Gamari at 2020-10-24T21:00:39-04:00 Document schedulePushWork race - - - - - 3416244b by Ben Gamari at 2020-10-24T21:00:40-04:00 Capabiliity: Properly fix data race on n_returning_tasks There is a real data race but can be made safe by using proper atomic (but relaxed) accesses. - - - - - dffd9432 by Ben Gamari at 2020-10-24T21:00:40-04:00 rts: Make write of to_cap->inbox atomic This is necessary since emptyInbox may read from to_cap->inbox without taking cap->lock. - - - - - 1f4cbc29 by Ben Gamari at 2020-10-24T21:00:57-04:00 rts/BlockAlloc: Use relaxed operations - - - - - d0d07cff by Ben Gamari at 2020-10-24T21:00:57-04:00 rts: Rework handling of mutlist scavenging statistics - - - - - 9e5c7f6d by Ben Gamari at 2020-10-24T21:00:57-04:00 rts: Avoid data races in StablePtr implementation This fixes two potentially problematic data races in the StablePtr implementation: * We would fail to RELEASE the stable pointer table when enlarging it, causing other cores to potentially see uninitialized memory. * We would fail to ACQUIRE when dereferencing a stable pointer. - - - - - 316add67 by Ben Gamari at 2020-10-24T21:00:57-04:00 rts/Storage: Use atomics - - - - - 5c23bc4c by Ben Gamari at 2020-10-24T21:00:58-04:00 rts/Updates: Use proper atomic operations - - - - - 3d0f033c by Ben Gamari at 2020-10-24T21:00:58-04:00 rts/Weak: Eliminate data races By taking all_tasks_mutex in stat_exit. Also better-document the fact that the task statistics are protected by all_tasks_mutex. - - - - - edb4b92b by Ben Gamari at 2020-10-24T21:01:18-04:00 rts/WSDeque: Rewrite with proper atomics After a few attempts at shoring up the previous implementation, I ended up turning to the literature and now use the proven implementation, > N.M. Lê, A. Pop, A.Cohen, and F.Z. Nardelli. "Correct and Efficient > Work-Stealing for Weak Memory Models". PPoPP'13, February 2013, > ACM 978-1-4503-1922/13/02. Note only is this approach formally proven correct under C11 semantics but it is also proved to be a bit faster in practice. - - - - - d39bbd3d by Ben Gamari at 2020-10-24T21:01:33-04:00 rts: Use relaxed atomics for whitehole spin stats - - - - - 8f802f38 by Ben Gamari at 2020-10-24T21:01:33-04:00 rts: Avoid lock order inversion during fork Fixes #17275. - - - - - cef667b0 by GHC GitLab CI at 2020-10-24T21:01:34-04:00 rts: Use proper relaxe operations in getCurrentThreadCPUTime Here we are doing lazy initialization; it's okay if we do the check more than once, hence relaxed operation is fine. - - - - - 8cf50eb1 by Ben Gamari at 2020-10-24T21:01:54-04:00 rts/STM: Use atomics This fixes a potentially harmful race where we failed to synchronize before looking at a TVar's current_value. Also did a bit of refactoring to avoid abstract over management of max_commits. - - - - - 88a7ce38 by Ben Gamari at 2020-10-24T21:01:54-04:00 rts/stm: Strengthen orderings to SEQ_CST instead of volatile Previously the `current_value`, `first_watch_queue_entry`, and `num_updates` fields of `StgTVar` were marked as `volatile` in an attempt to provide strong ordering. Of course, this isn't sufficient. We now use proper atomic operations. In most of these cases I strengthen the ordering all the way to SEQ_CST although it's possible that some could be weakened with some thought. - - - - - f97c59ce by Ben Gamari at 2020-10-24T21:02:11-04:00 Mitigate data races in event manager startup/shutdown - - - - - c7c3f8aa by Ben Gamari at 2020-10-24T21:02:22-04:00 rts: Accept benign races in Proftimer - - - - - 5a98dfca by Ben Gamari at 2020-10-24T21:02:22-04:00 rts: Pause timer while changing capability count This avoids #17289. - - - - - 01d95525 by Ben Gamari at 2020-10-24T21:02:22-04:00 Fix #17289 - - - - - 9a528985 by Ben Gamari at 2020-10-24T21:02:23-04:00 suppress #17289 (ticker) race - - - - - 1726ec41 by Ben Gamari at 2020-10-24T21:02:23-04:00 rts: Fix timer initialization Previously `initScheduler` would attempt to pause the ticker and in so doing acquire the ticker mutex. However, initTicker, which is responsible for initializing said mutex, hadn't been called yet. - - - - - bfbe4366 by Ben Gamari at 2020-10-24T21:02:23-04:00 rts: Fix races in Pthread timer backend shudown We can generally be pretty relaxed in the barriers here since the timer thread is a loop. - - - - - 297acc71 by Ben Gamari at 2020-10-24T21:02:44-04:00 rts/Stats: Hide a few unused unnecessarily global functions - - - - - 9ad51bc9 by David Beacham at 2020-10-27T13:59:35-04:00 Fix `instance Bounded a => Bounded (Down a)` (#18716) * Flip `minBound` and `maxBound` to respect the change in ordering * Remove awkward `Enum` (and hence `Integral`) instances for `Data.Ord.Down` * Update changelog - - - - - eedec53d by Vladislav Zavialov at 2020-10-27T14:00:11-04:00 Version bump: base-4.16 (#18712) Also bumps upper bounds on base in boot libraries (incl. submodules). - - - - - 412018c1 by Tamar Christina at 2020-10-27T14:00:49-04:00 winio: simplify logic remove optimization step. - - - - - 4950dd07 by Ben Gamari at 2020-10-27T14:01:24-04:00 hadrian: Suppress xelatex output unless it fails As noted in #18835, xelatex produces an absurd amount of output, nearly all of which is meaningless. Silence this. Fixes #18835. - - - - - f3d8ab2e by Ben Gamari at 2020-10-27T14:02:00-04:00 build system: Clean mingw tarballs Tamar noticed in !4293 that the build systems fail to clean up the mingw tarballs directory (`ghc-tarballs`). Fix this in both the make build system and Hadrian. - - - - - 0b3d23af by Simon Peyton Jones at 2020-10-27T14:02:34-04:00 Fix two constraint solving problems This patch fixes two problems in the constraint solver. * An actual bug #18555: we were floating out a constraint to eagerly, and that was ultimately fatal. It's explained in Note [Do not float blocked constraints] in GHC.Core.Constraint. This is all very delicate, but it's all going to become irrelevant when we stop floating constraints (#17656). * A major performance infelicity in the flattener. When flattening (ty |> co) we *never* generated Refl, even when there was nothing at all to do. Result: we would gratuitously rewrite the constraint to exactly the same thing, wasting work. Described in #18413, and came up again in #18855. Solution: exploit the special case by calling the new function castCoercionKind1. See Note [castCoercionKind1] in GHC.Core.Coercion - - - - - f76c5a08 by Sergei Trofimovich at 2020-10-27T14:03:14-04:00 ghc.mk: amend 'make sdist' Noticed 'make sdist' failure seen as: ``` "rm" -rf sdistprep/ghc/ghc-9.1.0.20201020/hadrian/_build/ (SRC_DIST_GHC_DIR)/hadrian/dist-newstyle/ /bin/sh: -c: line 0: syntax error near unexpected token `(' ``` commit 9657f6f34 ("sdist: Include hadrian sources in source distribution") added a new cleanup path without a variable expantion. The change adds variable reference. While at it move directory cleanup to a separate statement. Amends #18794 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 78b52c88 by David Eichmann at 2020-10-27T14:03:51-04:00 Use config.run_ways for multi_compile_and_run tests - - - - - e3fdd419 by Alan Zimmerman at 2020-10-27T14:04:26-04:00 Api Annotations: Introduce AnnPercent for HsExplicitMult For the case foo :: a %p -> b The location of the '%' is captured, separate from the 'p' - - - - - d2a25f42 by Ben Gamari at 2020-10-27T14:05:02-04:00 gitlab-ci: Bump ci-images Bumps bootstrap compiler to 8.10.1. - - - - - 28f98b01 by Sebastian Graf at 2020-10-27T14:05:37-04:00 DmdAnal: Kill `is_thunk` case in `splitFV` The `splitFV` function implements the highly dubious hack described in `Note [Lazy und unleashable free variables]` in GHC.Core.Opt.DmdAnal. It arranges it so that demand signatures only carry strictness info on free variables. Usage info is released through other means, see the Note. It's purely for analysis performance reasons. It turns out that `splitFV` has a quite involved case for thunks that produces slightly different usage signatures and it's not clear why we need it: `splitFV` is only relevant in the LetDown case and the only time we call it on thunks is for top-level or local recursive thunks. Since usage signatures of top-level thunks can only reference other top-level bindings and we completely discard demand info we have on top-level things (see the lack of `setIdDemandInfo` in `dmdAnalTopBind`), the `is_thunk` case is completely irrelevant here. For local, recursive thunks, the added benefit of the `is_thunk` test is marginal: We get used-multiple-times in some cases where previously we had used-once if a recursive thunk has multiple call sites. It's very unlikely and not a case to optimise for. So we kill the `is_thunk` case and inline `splitFV` at its call site, exposing `isWeakDmd` from `GHC.Types.Demand` instead. The NoFib summary supports this decision: ``` Min 0.0% -0.0% Max 0.0% +0.0% Geometric Mean -0.0% -0.0% ``` - - - - - 60322f93 by Ben Gamari at 2020-10-28T21:11:39-04:00 hadrian: Don't quote metric baseline argument Previously this was quoted inappropriately. - - - - - c85eb372 by Alan Zimmerman at 2020-10-28T21:12:15-04:00 API Annotations: put constructors in alphabetical order - - - - - 795908dc by John Ericson at 2020-10-29T03:53:14-04:00 Widen acceptance threshold for T10421a Progress towards #18842. As @sgraf812 points out, widening the window is dangerous until the exponential described in #17658 is fixed. But this test has caused enough misery and is low stakes enough that we and @bgamari think it's worth it in this one case for the time being. - - - - - 0e9f6def by Sylvain Henry at 2020-10-29T03:53:52-04:00 Split GHC.Driver.Types I was working on making DynFlags stateless (#17957), especially by storing loaded plugins into HscEnv instead of DynFlags. It turned out to be complicated because HscEnv is in GHC.Driver.Types but LoadedPlugin isn't: it is in GHC.Driver.Plugins which depends on GHC.Driver.Types. I didn't feel like introducing yet another hs-boot file to break the loop. Additionally I remember that while we introduced the module hierarchy (#13009) we talked about splitting GHC.Driver.Types because it contained various unrelated types and functions, but we never executed. I didn't feel like making GHC.Driver.Types bigger with more unrelated Plugins related types, so finally I bit the bullet and split GHC.Driver.Types. As a consequence this patch moves a lot of things. I've tried to put them into appropriate modules but nothing is set in stone. Several other things moved to avoid loops. * Removed Binary instances from GHC.Utils.Binary for random compiler things * Moved Typeable Binary instances into GHC.Utils.Binary.Typeable: they import a lot of things that users of GHC.Utils.Binary don't want to depend on. * put everything related to Units/Modules under GHC.Unit: GHC.Unit.Finder, GHC.Unit.Module.{ModGuts,ModIface,Deps,etc.} * Created several modules under GHC.Types: GHC.Types.Fixity, SourceText, etc. * Split GHC.Utils.Error (into GHC.Types.Error) * Finally removed GHC.Driver.Types Note that this patch doesn't put loaded plugins into HscEnv. It's left for another patch. Bump haddock submodule - - - - - 22f5d9a9 by Sylvain Henry at 2020-10-29T03:53:52-04:00 GC: Avoid data race (#18717, #17964) - - - - - 2ef2fac4 by Ryan Scott at 2020-10-29T04:18:52-04:00 Check for large tuples more thoroughly This fixes #18723 by: * Moving the existing `GHC.Tc.Gen.HsType.bigConstraintTuple` validity check to `GHC.Rename.Utils.checkCTupSize` for consistency with `GHC.Rename.Utils.checkTupSize`, and * Using `check(C)TupSize` when checking tuple _types_, in addition to checking names, expressions, and patterns. Note that I put as many of these checks as possible in the typechecker so that GHC can properly distinguish between boxed and constraint tuples. The exception to this rule is checking names, which I perform in the renamer (in `GHC.Rename.Env`) so that we can rule out `(,, ... ,,)` and `''(,, ... ,,)` alike in one fell swoop. While I was in town, I also removed the `HsConstraintTuple` and `HsBoxedTuple` constructors of `HsTupleSort`, which are functionally unused. This requires a `haddock` submodule bump. - - - - - 7f8be3eb by Richard Eisenberg at 2020-10-29T22:08:13-04:00 Remove unnecessary gender from comments/docs While, say, alternating "he" and "she" in sequential writing may be nicer than always using "they", reading code/documentation is almost never sequential. If this small change makes individuals feel more welcome in GHC's codebase, that's a good thing. - - - - - aad1f803 by Ben Gamari at 2020-10-30T00:41:14-04:00 rts/GC: Use atomics - - - - - d0bc0517 by Ben Gamari at 2020-10-30T00:41:14-04:00 rts: Use RELEASE ordering in unlockClosure - - - - - d44f5232 by Ben Gamari at 2020-10-30T00:41:14-04:00 rts/Storage: Accept races on heap size counters - - - - - 4e4a7386 by Ben Gamari at 2020-10-30T00:41:14-04:00 rts: Join to concurrent mark thread during shutdown Previously we would take all capabilities but fail to join on the thread itself, potentially resulting in a leaked thread. - - - - - a80cc857 by GHC GitLab CI at 2020-10-30T00:41:14-04:00 rts: Fix race in GC CPU time accounting Ensure that the GC leader synchronizes with workers before calling stat_endGC. - - - - - 9902d9ec by Viktor Dukhovni at 2020-10-30T05:28:30-04:00 [skip ci] Fix typo in `callocBytes` haddock. - - - - - 105d43db by Ben Gamari at 2020-10-30T14:02:19-04:00 rts/SpinLock: Separate out slow path Not only is this in general a good idea, but it turns out that GCC unrolls the retry loop, resulting is massive code bloat in critical parts of the RTS (e.g. `evacuate`). - - - - - f7b45cde by Ben Gamari at 2020-10-30T14:02:19-04:00 rts: Use relaxed ordering on spinlock counters - - - - - 31fcb55f by Ryan Scott at 2020-10-30T18:52:50-04:00 Split HsConDecl{H98,GADT}Details Haskell98 and GADT constructors both use `HsConDeclDetails`, which includes `InfixCon`. But `InfixCon` is never used for GADT constructors, which results in an awkward unrepresentable state. This removes the unrepresentable state by: * Renaming the existing `HsConDeclDetails` synonym to `HsConDeclH98Details`, which emphasizes the fact that it is now only used for Haskell98-style data constructors, and * Creating a new `HsConDeclGADTDetails` data type with `PrefixConGADT` and `RecConGADT` constructors that closely resemble `PrefixCon` and `InfixCon` in `HsConDeclH98Details`. The key difference is that `HsConDeclGADTDetails` lacks any way to represent infix constructors. The rest of the patch is refactoring to accommodate the new structure of `HsConDecl{H98,GADT}Details`. Some highlights: * The `getConArgs` and `hsConDeclArgTys` functions have been removed, as there is no way to implement these functions uniformly for all `ConDecl`s. For the most part, their previous call sites now pattern match on the `ConDecl`s directly and do different things for `ConDeclH98`s and `ConDeclGADT`s. I did introduce one new function to make the transition easier: `getRecConArgs_maybe`, which extracts the arguments from a `RecCon(GADT)`. This is still possible since `RecCon(GADT)`s still use the same representation in both `HsConDeclH98Details` and `HsConDeclGADTDetails`, and since the pattern that `getRecConArgs_maybe` implements is used in several places, I thought it worthwhile to factor it out into its own function. * Previously, the `con_args` fields in `ConDeclH98` and `ConDeclGADT` were both of type `HsConDeclDetails`. Now, the former is of type `HsConDeclH98Details`, and the latter is of type `HsConDeclGADTDetails`, which are distinct types. As a result, I had to rename the `con_args` field in `ConDeclGADT` to `con_g_args` to make it typecheck. A consequence of all this is that the `con_args` field is now partial, so using `con_args` as a top-level field selector is dangerous. (Indeed, Haddock was using `con_args` at the top-level, which caused it to crash at runtime before I noticed what was wrong!) I decided to add a disclaimer in the 9.2.1 release notes to advertise this pitfall. Fixes #18844. Bumps the `haddock` submodule. - - - - - 57c3db96 by Ryan Scott at 2020-10-31T02:53:55-04:00 Make typechecker equality consider visibility in ForAllTys Previously, `can_eq_nc'` would equate `ForAllTy`s regardless of their `ArgFlag`, including `forall i -> i -> Type` and `forall i. i -> Type`! To fix this, `can_eq_nc'` now uses the `sameVis` function to first check if the `ArgFlag`s are equal modulo specificity. I have also updated `tcEqType`'s implementation to match this behavior. For more explanation on the "modulo specificity" part, see the new `Note [ForAllTy and typechecker equality]` in `GHC.Tc.Solver.Canonical`. While I was in town, I fixed some related documentation issues: * I added `Note [Typechecker equality]` to `GHC.Tc.Utils.TcType` to describe what exactly distinguishes `can_eq_nc'` and `tcEqType` (which implement typechecker equality) from `eqType` (which implements definitional equality, which does not care about the `ArgFlags` of `ForAllTy`s at all). * The User's Guide had some outdated prose on the specified/inferred distinction being different for types and kinds, a holdover from #15079. This is no longer the case on today's GHC, so I removed this prose, added some new prose to take its place, and added a regression test for the programs in #15079. * The User's Guide had some _more_ outdated prose on inferred type variables not being allowed in `default` type signatures for class methods, which is no longer true as of the resolution of #18432. * The related `Note [Deferred Unification]` was being referenced as `Note [Deferred unification]` elsewhere, which made it harder to `grep` for. I decided to change the name of the Note to `Deferred unification` for consistency with the capitalization style used for most other Notes. Fixes #18863. - - - - - a98593f0 by Sylvain Henry at 2020-10-31T02:54:34-04:00 Refactor numeric constant folding rules Avoid the use of global pattern synonyms. 1) I think it's going to be helpful to implement constant folding for other numeric types, especially Natural which doesn't have a wrapping behavior. We'll have to refactor these rules even more so we'd better make them less cryptic. 2) It should also be slightly faster because global pattern synonyms matched operations for every numeric types instead of the current one: e.g., ":**:" pattern was matching multiplication for both Int# and Word# types. As we will probably want to implement constant folding for other numeric types (Int8#, Int16#, etc.), it is more efficient to only match primops for a given type as we do now. - - - - - 730ef38f by Sylvain Henry at 2020-10-31T02:54:34-04:00 Simplify constant-folding (#18032) See #18032 for the details. * Use `Lit (LitNumber _ i)` instead of `isLitValue_maybe` which does more work but that is not needed for constant-folding * Don't export `GHC.Types.Literal.isLitValue_maybe` * Kill `GHC.Types.Literal.isLitValue` which isn't used - - - - - d5a53c1a by Ben Gamari at 2020-10-31T02:55:10-04:00 primops.txt.pp: Move ByteArray# primops to separate file This file will be generated. - - - - - b4278a41 by Ben Gamari at 2020-10-31T02:55:10-04:00 primops: Generate ByteArray# index/read/write primops Previously these were mostly undocumented and was ripe for potential inconsistencies. - - - - - 08e6993a by Sylvain Henry at 2020-10-31T02:55:50-04:00 Move loadDecl into IfaceToCore - - - - - cb1f755c by Tamar Christina at 2020-10-31T09:26:56-04:00 winio: Fix unused variables warnings - - - - - eb368078 by Andrzej Rybczak at 2020-10-31T09:27:34-04:00 Add testcase for #816 - - - - - bd4abdc9 by Ben Gamari at 2020-11-01T01:10:31-04:00 testsuite: Add performance test for #18698 - - - - - dfd27445 by Hécate at 2020-11-01T01:11:09-04:00 Add the proper HLint rules and remove redundant keywords from compiler - - - - - ce1bb995 by Hécate at 2020-11-01T08:52:08-05:00 Fix a leak in `transpose` This patch was authored by David Feuer <david.feuer at gmail.com> - - - - - e63db32c by Ben Gamari at 2020-11-01T08:52:44-05:00 Scav: Use bd->gen_no instead of bd->gen->no This potentially saves a cache miss per scavenge. - - - - - b1dda153 by Ben Gamari at 2020-11-01T12:58:36-05:00 rts/Stats: Protect with mutex While on face value this seems a bit heavy, I think it's far better than enforcing ordering on every access. - - - - - 5c2e6bce by Ben Gamari at 2020-11-01T12:58:36-05:00 rts: Tear down stats_mutex after exitHeapProfiling Since the latter wants to call getRTSStats. - - - - - ef25aaa1 by Ben Gamari at 2020-11-01T13:02:11-05:00 rts: Annotate hopefully "benign" races in freeGroup - - - - - 3a181553 by Ben Gamari at 2020-11-01T13:02:18-05:00 Strengthen ordering in releaseGCThreads - - - - - af474f62 by Ben Gamari at 2020-11-01T13:05:38-05:00 Suppress data race due to close This suppresses the other side of a race during shutdown. - - - - - b4686bff by Ben Gamari at 2020-11-01T13:09:59-05:00 Merge branch 'wip/tsan/ci' into wip/tsan/all - - - - - b8e66e0e by Ben Gamari at 2020-11-01T13:10:01-05:00 Merge branch 'wip/tsan/storage' into wip/tsan/all - - - - - 375512cf by Ben Gamari at 2020-11-01T13:10:02-05:00 Merge branch 'wip/tsan/wsdeque' into wip/tsan/all - - - - - 65ebf07e by Ben Gamari at 2020-11-01T13:10:03-05:00 Merge branch 'wip/tsan/misc' into wip/tsan/all - - - - - 55c375d0 by Ben Gamari at 2020-11-01T13:10:04-05:00 Merge branch 'wip/tsan/stm' into wip/tsan/all - - - - - a9f75fe2 by Ben Gamari at 2020-11-01T13:10:06-05:00 Merge branch 'wip/tsan/event-mgr' into wip/tsan/all - - - - - 8325d658 by Ben Gamari at 2020-11-01T13:10:24-05:00 Merge branch 'wip/tsan/timer' into wip/tsan/all - - - - - 07e82ba5 by Ben Gamari at 2020-11-01T13:10:35-05:00 Merge branch 'wip/tsan/stats' into wip/tsan/all - - - - - 4ce2f7d6 by GHC GitLab CI at 2020-11-02T23:45:06-05:00 testsuite: Add --top flag to driver This allows us to make `config.top` a proper Path. Previously it was a str, which caused the Ghostscript detection logic to break. - - - - - 0b772221 by Ben Gamari at 2020-11-02T23:45:42-05:00 Document that ccall convention doesn't support varargs We do not support foreign "C" imports of varargs functions. While this works on amd64, in general the platform's calling convention may need more type information that our Cmm representation can currently provide. For instance, this is the case with Darwin's AArch64 calling convention. Document this fact in the users guide and fix T5423 which makes use of a disallowed foreign import. Closes #18854. - - - - - 81006a06 by David Eichmann at 2020-11-02T23:46:19-05:00 RtsAPI: pause and resume the RTS The `rts_pause` and `rts_resume` functions have been added to `RtsAPI.h` and allow an external process to completely pause and resume the RTS. Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - bfb1e272 by Ryan Scott at 2020-11-02T23:46:55-05:00 Display results of GHC.Core.Lint.lint* functions consistently Previously, the functions in `GHC.Core.Lint` used a patchwork of different ways to display Core Lint errors: * `lintPassResult` (which is the source of most Core Lint errors) renders Core Lint errors with a distinctive banner (e.g., `*** Core Lint errors : in result of ... ***`) that sets them apart from ordinary GHC error messages. * `lintAxioms`, in contrast, uses a completely different code path that displays Core Lint errors in a rather confusing manner. For example, the program in #18770 would give these results: ``` Bug.hs:1:1: error: Bug.hs:12:1: warning: Non-*-like kind when *-like expected: RuntimeRep when checking the body of forall: 'TupleRep '[r] In the coercion axiom Bug.N:T :: []. Bug.T ~_R Any Substitution: [TCvSubst In scope: InScope {r} Type env: [axl :-> r] Co env: []] | 1 | {-# LANGUAGE DataKinds #-} | ^ ``` * Further digging reveals that `GHC.IfaceToCore` displays Core Lint errors for iface unfoldings as though they were a GHC panic. See, for example, this excerpt from #17723: ``` ghc: panic! (the 'impossible' happened) (GHC version 8.8.2 for x86_64-unknown-linux): Iface Lint failure In interface for Lib ... ``` This patch makes all of these code paths display Core Lint errors and warnings consistently. I decided to adopt the conventions that `lintPassResult` currently uses, as they appear to have been around the longest (and look the best, in my subjective opinion). We now use the `displayLintResult` function for all three scenarios mentioned above. For example, here is what the Core Lint error for the program in #18770 looks like after this patch: ``` [1 of 1] Compiling Bug ( Bug.hs, Bug.o ) *** Core Lint errors : in result of TcGblEnv axioms *** Bug.hs:12:1: warning: Non-*-like kind when *-like expected: RuntimeRep when checking the body of forall: 'TupleRep '[r_axn] In the coercion axiom N:T :: []. T ~_R Any Substitution: [TCvSubst In scope: InScope {r_axn} Type env: [axn :-> r_axn] Co env: []] *** Offending Program *** axiom N:T :: T = Any -- Defined at Bug.hs:12:1 *** End of Offense *** <no location info>: error: Compilation had errors ``` Fixes #18770. - - - - - a9e5f52c by Simon Peyton Jones at 2020-11-02T23:47:31-05:00 Expand type synonyms with :kind! The User's Guide claims that `:kind!` should expand type synonyms, but GHCi wasn't doing this in practice. Let's just update the implementation to match the specification in the User's Guide. Fixes #13795. Fixes #18828. Co-authored-by: Ryan Scott <ryan.gl.scott at gmail.com> - - - - - 1370eda7 by Ben Gamari at 2020-11-02T23:48:06-05:00 hadrian: Don't capture RunTest output There are a few reasons why capturing the output of the RunTest builder is undesirable: * there is a large amount of output which then gets unnecessarily duplicated by Hadrian if the builder fails * the output may contain codepoints which are unrepresentable in the current codepage on Windows, causing Hadrian to crash * capturing the output causes the testsuite driver to disable its colorisation logic, making the output less legible. - - - - - 78f2767d by Matthew Pickering at 2020-11-03T17:39:53-05:00 Update inlining flags documentation - - - - - 14ce454f by Sylvain Henry at 2020-11-03T17:40:34-05:00 Linker: reorganize linker related code Move linker related code into GHC.Linker. Previously it was scattered into GHC.Unit.State, GHC.Driver.Pipeline, GHC.Runtime.Linker, etc. Add documentation in GHC.Linker - - - - - 616bec0d by Alan Zimmerman at 2020-11-03T17:41:10-05:00 Restrict Linear arrow %1 to exactly literal 1 only This disallows `a %001 -> b`, and makes sure the type literal is printed from its SourceText so it is clear why. Closes #18888 - - - - - 3486ebe6 by Sylvain Henry at 2020-11-03T17:41:48-05:00 Hadrian: don't fail if ghc-tarballs dir doesn't exist - - - - - 37f0434d by Sylvain Henry at 2020-11-03T17:42:26-05:00 Constant-folding: don't pass through GHC's Int/Word (fix #11704) Constant-folding rules for integerToWord/integerToInt were performing the following coercions at compilation time: integerToWord: target's Integer -> ghc's Word -> target's Word integerToInt : target's Integer -> ghc's Int -> target's Int 1) It was wrong for cross-compilers when GHC's word size is smaller than the target one. This patch avoids passing through GHC's word-sized types: integerToWord: target's Integer -> ghc's Integer -> target's Word integerToInt : target's Integer -> ghc's Integer -> target's Int 2) Additionally we didn't wrap the target word/int literal to make it fit into the target's range! This broke the invariant of literals only containing values in range. The existing code is wrong only with a 64-bit cross-compiling GHC, targeting a 32-bit platform, and performing constant folding on a literal that doesn't fit in a 32-bit word. If GHC was built with DEBUG, the assertion in GHC.Types.Literal.mkLitWord would fail. Otherwise the bad transformation would go unnoticed. - - - - - bff74de7 by Sylvain Henry at 2020-11-03T17:43:03-05:00 Bignum: make GMP's bignat_add not recursive bignat_add was a loopbreaker with an INLINE pragma (spotted by @mpickering). This patch makes it non recursive to avoid the issue. - - - - - bb100805 by Andreas Klebinger at 2020-11-04T16:47:24-05:00 NCG: Fix 64bit int comparisons on 32bit x86 We no compare these by doing 64bit subtraction and checking the resulting flags. We used to do this differently but the old approach was broken when the high bits compared equal and the comparison was one of >= or <=. The new approach should be both correct and faster. - - - - - b790b7f9 by Andreas Klebinger at 2020-11-04T16:47:59-05:00 Testsuite: Support for user supplied package dbs We can now supply additional package dbs to the testsuite. For make the package db can be supplied by passing PACKAGE_DB=/path/to/db. In the testsuite driver it's passed via the --test-package-db argument. - - - - - 81560981 by Sylvain Henry at 2020-11-04T16:48:42-05:00 Don't use LEA with 8-bit registers (#18614) - - - - - 17d5c518 by Viktor Dukhovni at 2020-11-05T00:50:23-05:00 Naming, value types and tests for Addr# atomics The atomic Exchange and CAS operations on integral types are updated to take and return more natural `Word#` rather than `Int#` values. These are bit-block not arithmetic operations, and the sign bit plays no special role. Standardises the names to `atomic<OpType><ValType>Addr#`, where `OpType` is one of `Cas` or `Exchange` and `ValType` is presently either `Word` or `Addr`. Eventually, variants for `Word32` and `Word64` can and should be added, once #11953 and related issues (e.g. #13825) are resolved. Adds tests for `Addr#` CAS that mirror existing tests for `MutableByteArray#`. - - - - - 2125b1d6 by Ryan Scott at 2020-11-05T00:51:01-05:00 Add a regression test for #18920 Commit f594a68a5500696d94ae36425bbf4d4073aca3b2 (`Use level numbers for generalisation`) ended up fixing #18920. Let's add a regression test to ensure that it stays fixed. Fixes #18920. - - - - - e07e383a by Ryan Scott at 2020-11-06T03:45:28-05:00 Replace HsImplicitBndrs with HsOuterTyVarBndrs This refactors the GHC AST to remove `HsImplicitBndrs` and replace it with `HsOuterTyVarBndrs`, a type which records whether the outermost quantification in a type is explicit (i.e., with an outermost, invisible `forall`) or implicit. As a result of this refactoring, it is now evident in the AST where the `forall`-or-nothing rule applies: it's all the places that use `HsOuterTyVarBndrs`. See the revamped `Note [forall-or-nothing rule]` in `GHC.Hs.Type` (previously in `GHC.Rename.HsType`). Moreover, the places where `ScopedTypeVariables` brings lexically scoped type variables into scope are a subset of the places that adhere to the `forall`-or-nothing rule, so this also makes places that interact with `ScopedTypeVariables` easier to find. See the revamped `Note [Lexically scoped type variables]` in `GHC.Hs.Type` (previously in `GHC.Tc.Gen.Sig`). `HsOuterTyVarBndrs` are used in type signatures (see `HsOuterSigTyVarBndrs`) and type family equations (see `HsOuterFamEqnTyVarBndrs`). The main difference between the former and the latter is that the former cares about specificity but the latter does not. There are a number of knock-on consequences: * There is now a dedicated `HsSigType` type, which is the combination of `HsOuterSigTyVarBndrs` and `HsType`. `LHsSigType` is now an alias for an `XRec` of `HsSigType`. * Working out the details led us to a substantial refactoring of the handling of explicit (user-written) and implicit type-variable bindings in `GHC.Tc.Gen.HsType`. Instead of a confusing family of higher order functions, we now have a local data type, `SkolemInfo`, that controls how these binders are kind-checked. It remains very fiddly, not fully satisfying. But it's better than it was. Fixes #16762. Bumps the Haddock submodule. Co-authored-by: Simon Peyton Jones <simonpj at microsoft.com> Co-authored-by: Richard Eisenberg <rae at richarde.dev> Co-authored-by: Zubin Duggal <zubin at cmi.ac.in> - - - - - c85f4928 by Sylvain Henry at 2020-11-06T03:46:08-05:00 Refactor -dynamic-too handling 1) Don't modify DynFlags (too much) for -dynamic-too: now when we generate dynamic outputs for "-dynamic-too", we only set "dynamicNow" boolean field in DynFlags instead of modifying several other fields. These fields now have accessors that take dynamicNow into account. 2) Use DynamicTooState ADT to represent -dynamic-too state. It's much clearer than the undocumented "DynamicTooConditional" that was used before. As a result, we can finally remove the hscs_iface_dflags field in HscRecomp. There was a comment on this field saying: "FIXME (osa): I don't understand why this is necessary, but I spent almost two days trying to figure this out and I couldn't .. perhaps someone who understands this code better will remove this later." I don't fully understand the details, but it was needed because of the changes made to the DynFlags for -dynamic-too. There is still something very dubious in GHC.Iface.Recomp: we have to disable the "dynamicNow" flag at some point for some Backpack's "heinous hack" to continue to work. It may be because interfaces for indefinite units are always non-dynamic, or because we mix and match dynamic and non-dynamic interfaces (#9176), or something else, who knows? - - - - - 2cb87909 by Moritz Angermann at 2020-11-06T03:46:44-05:00 [AArch64] Aarch64 Always PIC - - - - - b1d2c1f3 by Ben Gamari at 2020-11-06T03:47:19-05:00 rts/Sanity: Avoid nasty race in weak pointer sanity-checking See Note [Racing weak pointer evacuation] for all of the gory details. - - - - - 638f38c5 by Ben Gamari at 2020-11-08T09:29:16-05:00 Merge remote-tracking branch 'origin/wip/tsan/all' - - - - - 22888798 by Ben Gamari at 2020-11-08T12:08:40-05:00 Fix haddock submodule The previous merge mistakenly reverted it. - - - - - d445cf05 by Ben Gamari at 2020-11-10T10:26:20-05:00 rts/linker: Fix relocation overflow in PE linker Previously the overflow check for the IMAGE_REL_AMD64_ADDR32NB relocation failed to account for the signed nature of the value. Specifically, the overflow check was: uint64_t v; v = S + A; if (v >> 32) { ... } However, `v` ultimately needs to fit into 32-bits as a signed value. Consequently, values `v > 2^31` in fact overflow yet this is not caught by the existing overflow check. Here we rewrite the overflow check to rather ensure that `INT32_MIN <= v <= INT32_MAX`. There is now quite a bit of repetition between the `IMAGE_REL_AMD64_REL32` and `IMAGE_REL_AMD64_ADDR32` cases but I am leaving fixing this for future work. This bug was first noticed by @awson. Fixes #15808. - - - - - 4c407f6e by Sylvain Henry at 2020-11-10T10:27:00-05:00 Export SPEC from GHC.Exts (#13681) - - - - - 7814cd5b by David Eichmann at 2020-11-10T10:27:35-05:00 ghc-heap: expose decoding from heap representation Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - fa344d33 by Richard Eisenberg at 2020-11-10T10:28:10-05:00 Add test case for #17186. This got fixed sometime recently; not worth it trying to figure out which commit. - - - - - 2e63a0fb by David Eichmann at 2020-11-10T10:28:46-05:00 Add code comments for StgInfoTable and StgStack structs - - - - - fcfda909 by Ben Gamari at 2020-11-11T03:19:59-05:00 nativeGen: Make makeImportsDoc take an NCGConfig rather than DynFlags It appears this was an oversight as there is no reason the full DynFlags is necessary. - - - - - 6e23695e by Ben Gamari at 2020-11-11T03:19:59-05:00 Move this_module into NCGConfig In various places in the NCG we need the Module currently being compiled. Let's move this into the environment instead of chewing threw another register. - - - - - c6264a2d by Ben Gamari at 2020-11-11T03:20:00-05:00 codeGen: Produce local symbols for module-internal functions It turns out that some important native debugging/profiling tools (e.g. perf) rely only on symbol tables for function name resolution (as opposed to using DWARF DIEs). However, previously GHC would emit temporary symbols (e.g. `.La42b`) to identify module-internal entities. Such symbols are dropped during linking and therefore not visible to runtime tools (in addition to having rather un-helpful unique names). For instance, `perf report` would often end up attributing all cost to the libc `frame_dummy` symbol since Haskell code was no covered by any proper symbol (see #17605). We now rather follow the model of C compilers and emit descriptively-named local symbols for module internal things. Since this will increase object file size this behavior can be disabled with the `-fno-expose-internal-symbols` flag. With this `perf record` can finally be used against Haskell executables. Even more, with `-g3` `perf annotate` provides inline source code. - - - - - 584058dd by Ben Gamari at 2020-11-11T03:20:00-05:00 Enable -fexpose-internal-symbols when debug level >=2 This seems like a reasonable default as the object file size increases by around 5%. - - - - - c34a4b98 by Ömer Sinan Ağacan at 2020-11-11T03:20:35-05:00 Fix and enable object unloading in GHCi Fixes #16525 by tracking dependencies between object file symbols and marking symbol liveness during garbage collection See Note [Object unloading] in CheckUnload.c for details. - - - - - 2782487f by Ray Shih at 2020-11-11T03:20:35-05:00 Add loadNativeObj and unloadNativeObj (This change is originally written by niteria) This adds two functions: * `loadNativeObj` * `unloadNativeObj` and implements them for Linux. They are useful if you want to load a shared object with Haskell code using the system linker and have GHC call dlclose() after the code is no longer referenced from the heap. Using the system linker allows you to load the shared object above outside the low-mem region. It also loads the DWARF sections in a way that `perf` understands. `dl_iterate_phdr` is what makes this implementation Linux specific. - - - - - 7a65f9e1 by GHC GitLab CI at 2020-11-11T03:20:35-05:00 rts: Introduce highMemDynamic - - - - - e9e1b2e7 by GHC GitLab CI at 2020-11-11T03:20:35-05:00 Introduce test for dynamic library unloading This uses the highMemDynamic flag introduced earlier to verify that dynamic objects are properly unloaded. - - - - - 5506f134 by Krzysztof Gogolewski at 2020-11-11T03:21:14-05:00 Force argument in setIdMult (#18925) - - - - - 787e93ae by Ben Gamari at 2020-11-11T23:14:11-05:00 testsuite: Add testcase for #18733 - - - - - 5353fd50 by Ben Gamari at 2020-11-12T10:05:30-05:00 compiler: Fix recompilation checking In ticket #18733 we noticed a rather serious deficiency in the current fingerprinting logic for recursive groups. I have described the old fingerprinting story and its problems in Note [Fingerprinting recursive groups] and have reworked the story accordingly to avoid these issues. Fixes #18733. - - - - - 63fa3997 by Sebastian Graf at 2020-11-13T14:29:39-05:00 Arity: Rework `ArityType` to fix monotonicity (#18870) As we found out in #18870, `andArityType` is not monotone, with potentially severe consequences for termination of fixed-point iteration. That showed in an abundance of "Exciting arity" DEBUG messages that are emitted whenever we do more than one step in fixed-point iteration. The solution necessitates also recording `OneShotInfo` info for `ABot` arity type. Thus we get the following definition for `ArityType`: ``` data ArityType = AT [OneShotInfo] Divergence ``` The majority of changes in this patch are the result of refactoring use sites of `ArityType` to match the new definition. The regression test `T18870` asserts that we indeed don't emit any DEBUG output anymore for a function where we previously would have. Similarly, there's a regression test `T18937` for #18937, which we expect to be broken for now. Fixes #18870. - - - - - 197d59fa by Sebastian Graf at 2020-11-13T14:29:39-05:00 Arity: Emit "Exciting arity" warning only after second iteration (#18937) See Note [Exciting arity] why we emit the warning at all and why we only do after the second iteration now. Fixes #18937. - - - - - de7ec9dd by David Eichmann at 2020-11-13T14:30:16-05:00 Add rts_listThreads and rts_listMiscRoots to RtsAPI.h These are used to find the current roots of the garbage collector. Co-authored-by: Sven Tennie's avatarSven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering's avatarMatthew Pickering <matthewtpickering at gmail.com> Co-authored-by: default avatarBen Gamari <bgamari.foss at gmail.com> - - - - - 24a86f09 by Ben Gamari at 2020-11-13T14:30:51-05:00 gitlab-ci: Cache cabal store in linting job - - - - - 0a7e592c by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Fix procedure end addresses Previously the `.debug_aranges` and `.debug_info` (DIE) DWARF information would claim that procedures (represented with a `DW_TAG_subprogram` DIE) would only span the range covered by their entry block. This omitted all of the continuation blocks (represented by `DW_TAG_lexical_block` DIEs), confusing `perf`. Fix this by introducing a end-of-procedure label and using this as the `DW_AT_high_pc` of procedure `DW_TAG_subprogram` DIEs Fixes #17605. - - - - - 1e19183d by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Only produce DW_AT_source_note DIEs in -g3 Standard debugging tools don't know how to understand these so let's not produce them unless asked. - - - - - ad73370f by Ben Gamari at 2020-11-15T03:35:45-05:00 nativeGen/dwarf: Use DW_AT_linkage instead of DW_AT_MIPS_linkage - - - - - a2539650 by Ben Gamari at 2020-11-15T03:35:45-05:00 gitlab-ci: Add DWARF release jobs for Debian 10, Fedora27 - - - - - d61adb3d by Ryan Scott at 2020-11-15T03:36:21-05:00 Name (tc)SplitForAll- functions more consistently There is a zoo of `splitForAll-` functions in `GHC.Core.Type` (as well as `tcSplitForAll-` functions in `GHC.Tc.Utils.TcType`) that all do very similar things, but vary in the particular form of type variable that they return. To make things worse, the names of these functions are often quite misleading. Some particularly egregious examples: * `splitForAllTys` returns `TyCoVar`s, but `splitSomeForAllTys` returns `VarBndr`s. * `splitSomeForAllTys` returns `VarBndr`s, but `tcSplitSomeForAllTys` returns `TyVar`s. * `splitForAllTys` returns `TyCoVar`s, but `splitForAllTysInvis` returns `InvisTVBinder`s. (This in particular arose in the context of #18939, and this finally motivated me to bite the bullet and improve the status quo vis-à-vis how we name these functions.) In an attempt to bring some sanity to how these functions are named, I have opted to rename most of these functions en masse to use consistent suffixes that describe the particular form of type variable that each function returns. In concrete terms, this amounts to: * Functions that return a `TyVar` now use the suffix `-TyVar`. This caused the following functions to be renamed: * `splitTyVarForAllTys` -> `splitForAllTyVars` * `splitForAllTy_ty_maybe` -> `splitForAllTyVar_maybe` * `tcSplitForAllTys` -> `tcSplitForAllTyVars` * `tcSplitSomeForAllTys` -> `tcSplitSomeForAllTyVars` * Functions that return a `CoVar` now use the suffix `-CoVar`. This caused the following functions to be renamed: * `splitForAllTy_co_maybe` -> `splitForAllCoVar_maybe` * Functions that return a `TyCoVar` now use the suffix `-TyCoVar`. This caused the following functions to be renamed: * `splitForAllTy` -> `splitForAllTyCoVar` * `splitForAllTys` -> `splitForAllTyCoVars` * `splitForAllTys'` -> `splitForAllTyCoVars'` * `splitForAllTy_maybe` -> `splitForAllTyCoVar_maybe` * Functions that return a `VarBndr` now use the suffix corresponding to the most relevant type synonym. This caused the following functions to be renamed: * `splitForAllVarBndrs` -> `splitForAllTyCoVarBinders` * `splitForAllTysInvis` -> `splitForAllInvisTVBinders` * `splitForAllTysReq` -> `splitForAllReqTVBinders` * `splitSomeForAllTys` -> `splitSomeForAllTyCoVarBndrs` * `tcSplitForAllVarBndrs` -> `tcSplitForAllTyVarBinders` * `tcSplitForAllTysInvis` -> `tcSplitForAllInvisTVBinders` * `tcSplitForAllTysReq` -> `tcSplitForAllReqTVBinders` * `tcSplitForAllTy_maybe` -> `tcSplitForAllTyVarBinder_maybe` Note that I left the following functions alone: * Functions that split apart things besides `ForAllTy`s, such as `splitFunTys` or `splitPiTys`. Thankfully, there are far fewer of these functions than there are functions that split apart `ForAllTy`s, so there isn't much of a pressing need to apply the new naming convention elsewhere. * Functions that split apart `ForAllCo`s in `Coercion`s, such as `GHC.Core.Coercion.splitForAllCo_maybe`. We could theoretically apply the new naming convention here, but then we'd have to figure out how to disambiguate `Type`-splitting functions from `Coercion`-splitting functions. Ultimately, the `Coercion`-splitting functions aren't used nearly as much as the `Type`-splitting functions, so I decided to leave the former alone. This is purely refactoring and should cause no change in behavior. - - - - - 645444af by Ryan Scott at 2020-11-15T03:36:21-05:00 Use tcSplitForAllInvisTyVars (not tcSplitForAllTyVars) in more places The use of `tcSplitForAllTyVars` in `tcDataFamInstHeader` was the immediate cause of #18939, and replacing it with a new `tcSplitForAllInvisTyVars` function (which behaves like `tcSplitForAllTyVars` but only splits invisible type variables) fixes the issue. However, this led me to realize that _most_ uses of `tcSplitForAllTyVars` in GHC really ought to be `tcSplitForAllInvisTyVars` instead. While I was in town, I opted to replace most uses of `tcSplitForAllTys` with `tcSplitForAllTysInvis` to reduce the likelihood of such bugs in the future. I say "most uses" above since there is one notable place where we _do_ want to use `tcSplitForAllTyVars`: in `GHC.Tc.Validity.forAllTyErr`, which produces the "`Illegal polymorphic type`" error message if you try to use a higher-rank `forall` without having `RankNTypes` enabled. Here, we really do want to split all `forall`s, not just invisible ones, or we run the risk of giving an inaccurate error message in the newly added `T18939_Fail` test case. I debated at some length whether I wanted to name the new function `tcSplitForAllInvisTyVars` or `tcSplitForAllTyVarsInvisible`, but in the end, I decided that I liked the former better. For consistency's sake, I opted to rename the existing `splitPiTysInvisible` and `splitPiTysInvisibleN` functions to `splitInvisPiTys` and `splitPiTysInvisN`, respectively, so that they use the same naming convention. As a consequence, this ended up requiring a `haddock` submodule bump. Fixes #18939. - - - - - 8887102f by Moritz Angermann at 2020-11-15T03:36:56-05:00 AArch64/arm64 adjustments This addes the necessary logic to support aarch64 on elf, as well as aarch64 on mach-o, which Apple calls arm64. We change architecture name to AArch64, which is the official arm naming scheme. - - - - - fc644b1a by Ben Gamari at 2020-11-15T03:37:31-05:00 ghc-bin: Build with eventlogging by default We now have all sorts of great facilities using the eventlog which were previously unavailable without building a custom GHC. Fix this by linking with `-eventlog` by default. - - - - - 52114fa0 by Sylvain Henry at 2020-11-16T11:48:47+01:00 Add Addr# atomic primops (#17751) This reuses the codegen used for ByteArray#'s atomic primops. - - - - - 8150f654 by Sebastian Graf at 2020-11-18T23:38:40-05:00 PmCheck: Print types of uncovered patterns (#18932) In order to avoid confusion as in #18932, we display the type of the match variables in the non-exhaustiveness warning, e.g. ``` T18932.hs:14:1: warning: [-Wincomplete-patterns] Pattern match(es) are non-exhaustive In an equation for ‘g’: Patterns of type ‘T a’, ‘T a’, ‘T a’ not matched: (MkT2 _) (MkT1 _) (MkT1 _) (MkT2 _) (MkT1 _) (MkT2 _) (MkT2 _) (MkT2 _) (MkT1 _) (MkT2 _) (MkT2 _) (MkT2 _) ... | 14 | g (MkT1 x) (MkT1 _) (MkT1 _) = x | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ``` It also allows us to omit the type signature on wildcard matches which we previously showed in only some situations, particularly `-XEmptyCase`. Fixes #18932. - - - - - 165352a2 by Krzysztof Gogolewski at 2020-11-20T02:08:36-05:00 Export indexError from GHC.Ix (#18579) - - - - - b57845c3 by Kamil Dworakowski at 2020-11-20T02:09:16-05:00 Clarify interruptible FFI wrt masking state - - - - - 321d1bd8 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Fix strictness signatures of `prefetchValue*#` primops Their strictness signatures said the primops are strict in their first argument, which is wrong: Handing it a thunk will prefetch the pointer to the thunk, but not evaluate it. Hence not strict. The regression test `T8256` actually tests for laziness in the first argument, so GHC apparently never exploited the strictness signature. See also https://gitlab.haskell.org/ghc/ghc/-/issues/8256#note_310867, where this came up. - - - - - 0aec78b6 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Demand: Interleave usage and strictness demands (#18903) As outlined in #18903, interleaving usage and strictness demands not only means a more compact demand representation, but also allows us to express demands that we weren't easily able to express before. Call demands are *relative* in the sense that a call demand `Cn(cd)` on `g` says "`g` is called `n` times. *Whenever `g` is called*, the result is used according to `cd`". Example from #18903: ```hs h :: Int -> Int h m = let g :: Int -> (Int,Int) g 1 = (m, 0) g n = (2 * n, 2 `div` n) {-# NOINLINE g #-} in case m of 1 -> 0 2 -> snd (g m) _ -> uncurry (+) (g m) ``` Without the interleaved representation, we would just get `L` for the strictness demand on `g`. Now we are able to express that whenever `g` is called, its second component is used strictly in denoting `g` by `1C1(P(1P(U),SP(U)))`. This would allow Nested CPR to unbox the division, for example. Fixes #18903. While fixing regressions, I also discovered and fixed #18957. Metric Decrease: T13253-spj - - - - - 3a55b3a2 by Sebastian Graf at 2020-11-20T02:09:51-05:00 Update user's guide entry on demand analysis and worker/wrapper The demand signature notation has been undocumented for a long time. The only source to understand it, apart from reading the `Outputable` instance, has been an outdated wiki page. Since the previous commits have reworked the demand lattice, I took it as an opportunity to also write some documentation about notation. - - - - - fc963932 by Greg Steuck at 2020-11-20T02:10:31-05:00 Find hadrian location more reliably in cabal-install output Fix #18944 - - - - - 9f40cf6c by Ben Gamari at 2020-11-20T02:11:07-05:00 rts/linker: Align bssSize to page size when mapping symbol extras We place symbol_extras right after bss. We also need to ensure that symbol_extras can be mprotect'd independently from the rest of the image. To ensure this we round up the size of bss to a page boundary, thus ensuring that symbol_extras is also page-aligned. - - - - - b739c319 by Ben Gamari at 2020-11-20T02:11:43-05:00 gitlab-ci: Add usage message to ci.sh - - - - - 802e9180 by Ben Gamari at 2020-11-20T02:11:43-05:00 gitlab-ci: Add VERBOSE environment variable And change the make build system's default behavior to V=0, greatly reducing build log sizes. - - - - - 2a8a979c by Ben Gamari at 2020-11-21T01:13:26-05:00 users-guide: A bit of clean-up in profiling flag documentation - - - - - 56804e33 by Ben Gamari at 2020-11-21T01:13:26-05:00 testsuite: Refactor CountParserDeps - - - - - 53ad67ea by Ben Gamari at 2020-11-21T01:13:26-05:00 Introduce -fprof-callers flag This introducing a new compiler flag to provide a convenient way to introduce profiler cost-centers on all occurrences of the named identifier. Closes #18566. - - - - - ecfd0278 by Sylvain Henry at 2020-11-21T01:14:09-05:00 Move Plugins into HscEnv (#17957) Loaded plugins have nothing to do in DynFlags so this patch moves them into HscEnv (session state). "DynFlags plugins" become "Driver plugins" to still be able to register static plugins. Bump haddock submodule - - - - - 72f2257c by Sylvain Henry at 2020-11-21T01:14:09-05:00 Don't initialize plugins in the Core2Core pipeline Some plugins can be added via TH (cf addCorePlugin). Initialize them in the driver instead of in the Core2Core pipeline. - - - - - ddbeeb3c by Ryan Scott at 2020-11-21T01:14:44-05:00 Add regression test for #10504 This issue was fixed at some point between GHC 8.0 and 8.2. Let's add a regression test to ensure that it stays fixed. Fixes #10504. - - - - - a4a6dc2a by Ben Gamari at 2020-11-21T01:15:21-05:00 dwarf: Apply info table offset consistently Previously we failed to apply the info table offset to the aranges and DIEs, meaning that we often failed to unwind in gdb. For some reason this only seemed to manifest in the RTS's Cmm closures. Nevertheless, now we can unwind completely up to `main` - - - - - 69bfbc21 by Ben Gamari at 2020-11-21T01:15:56-05:00 hadrian: Disable stripping when debug information is enabled - - - - - 7e93ae8b by Ben Gamari at 2020-11-21T13:13:29-05:00 rts: Post ticky entry counts to the eventlog We currently only post the entry counters, not the other global counters as in my experience the former are more useful. We use the heap profiler's census period to decide when to dump. Also spruces up the documentation surrounding ticky-ticky a bit. - - - - - bc9c3916 by Ben Gamari at 2020-11-22T06:28:10-05:00 Implement -ddump-c-backend argument To dump output of the C backend. - - - - - 901bc220 by Ben Gamari at 2020-11-22T12:39:02-05:00 Bump time submodule to 1.11.1 Also bumps directory, Cabal, hpc, time, and unix submodules. Closes #18847. - - - - - 92c0afbf by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Dump STG when ticky is enabled This changes the "ticky" modifier to enable dumping of final STG as this is generally needed to make sense of the ticky profiles. - - - - - d23fef68 by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Introduce notion of flavour transformers This extends Hadrian's notion of "flavour", as described in #18942. - - - - - 179d0bec by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Add a viaLlvmBackend modifier Note that this also slightly changes the semantics of these flavours as we only use LLVM for >= stage1 builds. - - - - - d4d95e51 by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Add profiled_ghc and no_dynamic_ghc modifiers - - - - - 6815603f by Ben Gamari at 2020-11-22T12:39:38-05:00 hadrian: Drop redundant flavour definitions Drop the profiled, LLVM, and ThreadSanitizer flavour definitions as these can now be realized with flavour transformers. - - - - - f88f4339 by Ben Gamari at 2020-11-24T02:43:20-05:00 rts: Flush eventlog buffers from flushEventLog As noted in #18043, flushTrace failed flush anything beyond the writer. This means that a significant amount of data sitting in capability-local event buffers may never get flushed, despite the users' pleads for us to flush. Fix this by making flushEventLog flush all of the event buffers before flushing the writer. Fixes #18043. - - - - - 7c03cc50 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM job on appropriately-labelled MRs Namely, those marked with the ~"LLVM backend" label - - - - - 9b95d815 by Ben Gamari at 2020-11-24T02:43:55-05:00 gitlab-ci: Run LLVM builds on Debian 10 The current Debian 9 image doesn't provide LLVM 7. - - - - - 2ed3e6c0 by Ben Gamari at 2020-11-24T02:43:55-05:00 CmmToLlvm: Declare signature for memcmp Otherwise `opt` fails with: error: use of undefined value '@memcmp$def' - - - - - be5d74ca by Moritz Angermann at 2020-11-26T16:00:32-05:00 [Sized Cmm] properly retain sizes. This replaces all Word<N> = W<N># Word# and Int<N> = I<N># Int# with Word<N> = W<N># Word<N># and Int<N> = I<N># Int<N>#, thus providing us with properly sized primitives in the codegenerator instead of pretending they are all full machine words. This came up when implementing darwinpcs for arm64. The darwinpcs reqires us to pack function argugments in excess of registers on the stack. While most procedure call standards (pcs) assume arguments are just passed in 8 byte slots; and thus the caller does not know the exact signature to make the call, darwinpcs requires us to adhere to the prototype, and thus have the correct sizes. If we specify CInt in the FFI call, it should correspond to the C int, and not just be Word sized, when it's only half the size. This does change the expected output of T16402 but the new result is no less correct as it eliminates the narrowing (instead of the `and` as was previously done). Bumps the array, bytestring, text, and binary submodules. Co-Authored-By: Ben Gamari <ben at well-typed.com> Metric Increase: T13701 T14697 - - - - - a84e53f9 by Andreas Klebinger at 2020-11-26T16:00:32-05:00 RTS: Fix failed inlining of copy_tag. On windows using gcc-10 gcc failed to inline copy_tag into evacuate. To fix this we now set the always_inline attribute for the various copy* functions in Evac.c. The main motivation here is not the overhead of the function call, but rather that this allows the code to "specialize" for the size of the closure we copy which is often known at compile time. An earlier commit also tried to avoid evacuate_large inlining. But didn't quite succeed. So I also marked evacuate_large as noinline. Fixes #12416 - - - - - cdbd16f5 by Sylvain Henry at 2020-11-26T16:00:33-05:00 Fix toArgRep to support 64-bit reps on all systems [This is @Ericson2314 writing a commit message for @hsyl20's patch.] (Progress towards #11953, #17377, #17375) `Int64Rep` and `Word64Rep` are currently broken on 64-bit systems. This is because they should use "native arg rep" but instead use "large arg rep" as they do on 32-bit systems, which is either a non-concept or a 128-bit rep depending on one's vantage point. Now, these reps currently aren't used during 64-bit compilation, so the brokenness isn't observed, but I don't think that constitutes reasons not to fix it. Firstly, the linked issues there is a clearly expressed desire to use explicit-bitwidth constructs in more places. Secondly, per [1], there are other bugs that *do* manifest from not threading explicit-bitwidth information all the way through the compilation pipeline. One can therefore view this as one piece of the larger effort to do that, improve ergnomics, and squash remaining bugs. Also, this is needed for !3658. I could just merge this as part of that, but I'm keen on merging fixes "as they are ready" so the fixes that aren't ready are isolated and easier to debug. [1]: https://mail.haskell.org/pipermail/ghc-devs/2020-October/019332.html - - - - - a9378e69 by Tim Barnes at 2020-11-26T16:00:34-05:00 Set dynamic users-guide TOC spacing (fixes #18554) - - - - - 86a59d93 by Ben Gamari at 2020-11-26T16:00:34-05:00 rts: Use RTS_LIKELY in CHECK Most compilers probably already infer that `barf` diverges but it nevertheless doesn't hurt to be explicit. - - - - - 5757e82b by Matthew Pickering at 2020-11-26T16:00:35-05:00 Remove special case for GHC.ByteCode.Instr This was added in https://github.com/nomeata/ghc-heap-view/commit/34935206e51b9c86902481d84d2f368a6fd93423 GHC.ByteCode.Instr.BreakInfo no longer exists so the special case is dead code. Any check like this can be easily dealt with in client code. - - - - - d9c8b5b4 by Matthew Pickering at 2020-11-26T16:00:35-05:00 Split Up getClosureDataFromHeapRep Motivation 1. Don't enforce the repeated decoding of an info table, when the client can cache it (ghc-debug) 2. Allow the constructor information decoding to be overridden, this casues segfaults in ghc-debug - - - - - 3e3555cc by Andreas Klebinger at 2020-11-26T16:00:35-05:00 RegAlloc: Add missing raPlatformfield to RegAllocStatsSpill Fixes #18994 Co-Author: Benjamin Maurer <maurer.benjamin at gmail.com> - - - - - a1a75aa9 by Ben Gamari at 2020-11-27T06:20:41-05:00 rts: Allocate MBlocks with MAP_TOP_DOWN on Windows As noted in #18991, we would previously allocate heap in low memory. Due to this the linker, which typically *needs* low memory, would end up competing with the heap. In longer builds we end up running out of low memory entirely, leading to linking failures. - - - - - 75fc1ed5 by Sylvain Henry at 2020-11-28T15:40:23-05:00 Hadrian: fix detection of ghc-pkg for cross-compilers - - - - - 7cb5df96 by Sylvain Henry at 2020-11-28T15:40:23-05:00 hadrian: fix ghc-pkg uses (#17601) Make sure ghc-pkg doesn't read the compiler "settings" file by passing --no-user-package-db. - - - - - e3fd4226 by Ben Gamari at 2020-11-28T15:40:23-05:00 gitlab-ci: Introduce a nightly cross-compilation job This adds a job to test cross-compilation from x86-64 to AArch64 with Hadrian. Fixes #18234 - - - - - 698d3d96 by Ben Gamari at 2020-11-28T15:41:00-05:00 gitlab-ci: Only deploy GitLab Pages in ghc/ghc> The deployments are quite large and yet are currently only served for the ghc/ghc> project. - - - - - 625726f9 by David Eichmann at 2020-11-28T15:41:37-05:00 ghc-heap: partial TSO/STACK decoding Co-authored-by: Sven Tennie <sven.tennie at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> - - - - - 22ea9c29 by Andreas Klebinger at 2020-11-28T15:42:13-05:00 Small optimization to CmmSink. Inside `regsUsedIn` we can avoid some thunks by specializing the recursion. In particular we avoid the thunk for `(f e z)` in the MachOp/Load branches, where we know this will evaluate to z. Reduces allocations for T3294 by ~1%. - - - - - bba42c62 by John Ericson at 2020-11-28T15:42:49-05:00 Make primop handler indentation more consistent - - - - - c82bc8e9 by John Ericson at 2020-11-28T15:42:49-05:00 Cleanup some primop constructor names Harmonize the internal (big sum type) names of the native vs fixed-sized number primops a bit. (Mainly by renaming the former.) No user-facing names are changed. - - - - - ae14f160 by Ben Gamari at 2020-11-28T15:43:25-05:00 testsuite: Mark T14702 as fragile on Windows Due to #18953. - - - - - 1bc104b0 by Ben Gamari at 2020-11-29T15:33:18-05:00 withTimings: Emit allocations counter This will allow us to back out the allocations per compiler pass from the eventlog. Note that we dump the allocation counter rather than the difference since this will allow us to determine how much work is done *between* `withTiming` blocks. - - - - - e992ea84 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 ThreadPaused: Don't zero slop until free vars are pushed When threadPaused blackholes a thunk it calls `OVERWRITING_CLOSURE` to zero the slop for the benefit of the sanity checker. Previously this was done *before* pushing the thunk's free variables to the update remembered set. Consequently we would pull zero'd pointers to the update remembered set. - - - - - e82cd140 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Fix regression from TSAN work The TSAN rework (specifically aad1f803) introduced a subtle regression in GC.c, swapping `g0` in place of `gen`. Whoops! Fixes #18997. - - - - - 35a5207e by GHC GitLab CI at 2020-11-29T15:33:54-05:00 rts/Messages: Add missing write barrier in THROWTO message update After a THROWTO message has been handle the message closure is overwritten by a NULL message. We must ensure that the original closure's pointers continue to be visible to the nonmoving GC. - - - - - 0120829f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Add missing write barrier in shrinkSmallByteArray - - - - - 8a4d8fb6 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 Updates: Don't zero slop until closure has been pushed Ensure that the the free variables have been pushed to the update remembered set before we zero the slop. - - - - - 2793cfdc by GHC GitLab CI at 2020-11-29T15:33:54-05:00 OSThreads: Fix error code checking pthread_join returns its error code and apparently doesn't set errno. - - - - - e391a16f by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Don't join to mark_thread on shutdown The mark thread is not joinable as we detach from it on creation. - - - - - 60d088ab by Ben Gamari at 2020-11-29T15:33:54-05:00 nonmoving: Add reference to Ueno 2016 - - - - - 3aa60362 by GHC GitLab CI at 2020-11-29T15:33:54-05:00 nonmoving: Ensure that evacuated large objects are marked See Note [Non-moving GC: Marking evacuated objects]. - - - - - 8d304a99 by Ben Gamari at 2020-11-30T10:15:22-05:00 rts/m32: Refactor handling of allocator seeding Previously, in an attempt to reduce fragmentation, each new allocator would map a region of M32_MAX_PAGES fresh pages to seed itself. However, this ends up being extremely wasteful since it turns out that we often use fewer than this. Consequently, these pages end up getting freed which, ends up fragmenting our address space more than than we would have if we had naively allocated pages on-demand. Here we refactor m32 to avoid this waste while achieving the fragmentation mitigation previously desired. In particular, we move all page allocation into the global m32_alloc_page, which will pull a page from the free page pool. If the free page pool is empty we then refill it by allocating a region of M32_MAP_PAGES and adding them to the pool. Furthermore, we do away with the initial seeding entirely. That is, the allocator starts with no active pages: pages are rather allocated on an as-needed basis. On the whole this ends up being a pleasingly simple change, simultaneously making m32 more efficient, more robust, and simpler. Fixes #18980. - - - - - b6629289 by Ben Gamari at 2020-11-30T10:15:58-05:00 rts: Use CHECK instead of assert Use the GHC wrappers instead of <assert.h>. - - - - - 9f4efa6a by Ben Gamari at 2020-11-30T10:15:58-05:00 rts/linker: Replace some ASSERTs with CHECK In the past some people have confused ASSERT, which is for checking internal invariants, which CHECK, which should be used when checking things that might fail due to bad input (and therefore should be enabled even in the release compiler). Change some of these cases in the linker to use CHECK. - - - - - 0f8a4655 by Ryan Scott at 2020-11-30T10:16:34-05:00 Allow deploy:pages job to fail See #18973. - - - - - 49ebe369 by chessai at 2020-11-30T19:47:40-05:00 Optimisations in Data.Foldable (T17867) This PR concerns the following functions from `Data.Foldable`: * minimum * maximum * sum * product * minimumBy * maximumBy - Default implementations of these functions now use `foldl'` or `foldMap'`. - All have been marked with INLINEABLE to make room for further optimisations. - - - - - 4d79ef65 by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - 6af074ce by chessai at 2020-11-30T19:47:40-05:00 Apply suggestion to libraries/base/Data/Foldable.hs - - - - - ab334262 by Viktor Dukhovni at 2020-11-30T19:48:17-05:00 dirty MVAR after mutating TSO queue head While the original head and tail of the TSO queue may be in the same generation as the MVAR, interior elements of the queue could be younger after a GC run and may then be exposed by putMVar operation that updates the queue head. Resolves #18919 - - - - - 5eb163f3 by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Don't allow shared libraries to be loaded multiple times - - - - - 490aa14d by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Initialise CCSs from native shared objects - - - - - 6ac3db5f by Ben Gamari at 2020-11-30T19:48:53-05:00 rts/linker: Move shared library loading logic into Elf.c - - - - - b6698d73 by GHC GitLab CI at 2020-11-30T19:48:53-05:00 rts/linker: Don't declare dynamic objects with image_mapped This previously resulted in warnings due to spurious unmap failures. - - - - - b94a65af by jneira at 2020-11-30T19:49:31-05:00 Include tried paths in findToolDir error - - - - - 72a87fbc by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Move core flattening algorithm to Core.Unify This sets the stage for a later change, where this algorithm will be needed from GHC.Core.InstEnv. This commit also splits GHC.Core.Map into GHC.Core.Map.Type and GHC.Core.Map.Expr, in order to avoid module import cycles with GHC.Core. - - - - - 0dd45d0a by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Bump the # of commits searched for perf baseline The previous value of 75 meant that a feature branch with more than 75 commits would get spurious CI passes. This affects #18692, but does not fix that ticket, because if a baseline cannot be found, we should fail, not succeed. - - - - - 8bb52d91 by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Remove flattening variables This patch redesigns the flattener to simplify type family applications directly instead of using flattening meta-variables and skolems. The key new innovation is the CanEqLHS type and the new CEqCan constraint (Ct). A CanEqLHS is either a type variable or exactly-saturated type family application; either can now be rewritten using a CEqCan constraint in the inert set. Because the flattener no longer reduces all type family applications to variables, there was some performance degradation if a lengthy type family application is now flattened over and over (not making progress). To compensate, this patch contains some extra optimizations in the flattener, leading to a number of performance improvements. Close #18875. Close #18910. There are many extra parts of the compiler that had to be affected in writing this patch: * The family-application cache (formerly the flat-cache) sometimes stores coercions built from Given inerts. When these inerts get kicked out, we must kick out from the cache as well. (This was, I believe, true previously, but somehow never caused trouble.) Kicking out from the cache requires adding a filterTM function to TrieMap. * This patch obviates the need to distinguish "blocking" coercion holes from non-blocking ones (which, previously, arose from CFunEqCans). There is thus some simplification around coercion holes. * Extra commentary throughout parts of the code I read through, to preserve the knowledge I gained while working. * A change in the pure unifier around unifying skolems with other types. Unifying a skolem now leads to SurelyApart, not MaybeApart, as documented in Note [Binding when looking up instances] in GHC.Core.InstEnv. * Some more use of MCoercion where appropriate. * Previously, class-instance lookup automatically noticed that e.g. C Int was a "unifier" to a target [W] C (F Bool), because the F Bool was flattened to a variable. Now, a little more care must be taken around checking for unifying instances. * Previously, tcSplitTyConApp_maybe would split (Eq a => a). This is silly, because (=>) is not a tycon in Haskell. Fixed now, but there are some knock-on changes in e.g. TrieMap code and in the canonicaliser. * New function anyFreeVarsOf{Type,Co} to check whether a free variable satisfies a certain predicate. * Type synonyms now remember whether or not they are "forgetful"; a forgetful synonym drops at least one argument. This is useful when flattening; see flattenView. * The pattern-match completeness checker invokes the solver. This invocation might need to look through newtypes when checking representational equality. Thus, the desugarer needs to keep track of the in-scope variables to know what newtype constructors are in scope. I bet this bug was around before but never noticed. * Extra-constraints wildcards are no longer simplified before printing. See Note [Do not simplify ConstraintHoles] in GHC.Tc.Solver. * Whether or not there are Given equalities has become slightly subtler. See the new HasGivenEqs datatype. * Note [Type variable cycles in Givens] in GHC.Tc.Solver.Canonical explains a significant new wrinkle in the new approach. * See Note [What might match later?] in GHC.Tc.Solver.Interact, which explains the fix to #18910. * The inert_count field of InertCans wasn't actually used, so I removed it. Though I (Richard) did the implementation, Simon PJ was very involved in design and review. This updates the Haddock submodule to avoid #18932 by adding a type signature. ------------------------- Metric Decrease: T12227 T5030 T9872a T9872b T9872c Metric Increase: T9872d ------------------------- - - - - - d66660ba by Richard Eisenberg at 2020-12-01T19:57:41-05:00 Rename the flattener to become the rewriter. Now that flattening doesn't produce flattening variables, it's not really flattening anything: it's rewriting. This change also means that the rewriter can no longer be confused the core flattener (in GHC.Core.Unify), which is sometimes used during type-checking. - - - - - add0aeae by Ben Gamari at 2020-12-01T19:58:17-05:00 rts: Introduce mmapAnonForLinker Previously most of the uses of mmapForLinker were mapping anonymous memory, resulting in a great deal of unnecessary repetition. Factor this out into a new helper. Also fixes a few places where error checking was missing or suboptimal. - - - - - 97d71646 by Ben Gamari at 2020-12-01T19:58:17-05:00 rts/linker: Introduce munmapForLinker Consolidates munmap calls to ensure consistent error handling. - - - - - d8872af0 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/Linker: Introduce Windows implementations for mmapForLinker, et al. - - - - - c35d0e03 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/m32: Introduce NEEDS_M32 macro Instead of relying on RTS_LINKER_USE_MMAP - - - - - 41c64eb5 by Ben Gamari at 2020-12-01T19:58:18-05:00 rts/linker: Use m32 to allocate symbol extras in PEi386 - - - - - e0b08c5f by Ben Gamari at 2020-12-03T13:01:47-05:00 gitlab-ci: Fix copy-paste error Also be more consistent in quoting. - - - - - 33ec3a06 by Ben Gamari at 2020-12-03T23:11:31-05:00 gitlab-ci: Run linters through ci.sh Ensuring that the right toolchain is used. - - - - - 4a437bc1 by Shayne Fletcher at 2020-12-05T09:06:38-05:00 Fix bad span calculations of post qualified imports - - - - - 8fac4b93 by Ben Gamari at 2020-12-05T09:07:13-05:00 testsuite: Add a test for #18923 - - - - - 62ed6957 by Simon Peyton Jones at 2020-12-08T15:31:41-05:00 Fix kind inference for data types. Again. This patch fixes several aspects of kind inference for data type declarations, especially data /instance/ declarations Specifically 1. In kcConDecls/kcConDecl make it clear that the tc_res_kind argument is only used in the H98 case; and in that case there is no result kind signature; and hence no need for the disgusting splitPiTys in kcConDecls (now thankfully gone). The GADT case is a bit different to before, and much nicer. This is what fixes #18891. See Note [kcConDecls: kind-checking data type decls] 2. Do not look at the constructor decls of a data/newtype instance in tcDataFamInstanceHeader. See GHC.Tc.TyCl.Instance Note [Kind inference for data family instances]. This was a new realisation that arose when doing (1) This causes a few knock-on effects in the tests suite, because we require more information than before in the instance /header/. New user-manual material about this in "Kind inference in data type declarations" and "Kind inference for data/newtype instance declarations". 3. Minor improvement in kcTyClDecl, combining GADT and H98 cases 4. Fix #14111 and #8707 by allowing the header of a data instance to affect kind inferece for the the data constructor signatures; as described at length in Note [GADT return types] in GHC.Tc.TyCl This led to a modest refactoring of the arguments (and argument order) of tcConDecl/tcConDecls. 5. Fix #19000 by inverting the sense of the test in new_locs in GHC.Tc.Solver.Canonical.canDecomposableTyConAppOK. - - - - - 0abe3ddf by Adam Sandberg Ericsson at 2020-12-08T15:32:19-05:00 hadrian: build the _l and _thr_l rts flavours in the develN flavours The ghc binary requires the eventlog rts since fc644b1a643128041cfec25db84e417851e28bab - - - - - 51e3bb6d by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CodeGen: Make folds User/DefinerOfRegs INLINEABLE. Reduces allocation for the test case I was looking at by about 1.2%. Mostly from avoiding allocation of some folding functions which turn into let-no-escape bindings which just reuse their environment instead. We also force inlining in a few key places in CmmSink which helps a bit more. - - - - - 69ae10c3 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 CmmSink: Force inlining of foldRegsDefd Helps avoid allocating the folding function. Improves perf for T3294 by about 1%. - - - - - 6e3da800 by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm: Make a few types and utility function slightly stricter. About 0.6% reduction in allocations for the code I was looking at. Not a huge difference but no need to throw away performance. - - - - - aef44d7f by Andreas Klebinger at 2020-12-08T22:43:21-05:00 Cmm.Sink: Optimize retaining of assignments, live sets. Sinking requires us to track live local regs after each cmm statement. We used to do this via "Set LocalReg". However we can replace this with a solution based on IntSet which is overall more efficient without losing much. The thing we lose is width of the variables, which isn't used by the sinking pass anyway. I also reworked how we keep assignments to regs mentioned in skipped assignments. I put the details into Note [Keeping assignemnts mentioned in skipped RHSs]. The gist of it is instead of keeping track of it via the use count which is a `IntMap Int` we now use the live regs set (IntSet) which is quite a bit faster. I think it also matches the semantics a lot better. The skipped (not discarded) assignment does in fact keep the regs on it's rhs alive so keeping track of this in the live set seems like the clearer solution as well. Improves allocations for T3294 by yet another 1%. - - - - - 59f2249b by Andreas Klebinger at 2020-12-08T22:43:21-05:00 GHC.Cmm.Opt: Be stricter in results. Optimization either returns Nothing if nothing is to be done or `Just <cmmExpr>` otherwise. There is no point in being lazy in `cmmExpr`. We usually inspect this element so the thunk gets forced not long after. We might eliminate it as dead code once in a blue moon but that's not a case worth optimizing for. Overall the impact of this is rather low. As Cmm.Opt doesn't allocate much (compared to the rest of GHC) to begin with. - - - - - 54b88eac by Andreas Klebinger at 2020-12-08T22:43:57-05:00 Bump time submodule. This should fix #19002. - - - - - 35e7b0c6 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Clarify the default for -fomit-yields “Yield points enabled” is confusing (and probably wrong? I am not 100% sure what it means). Change it to a simple “on”. Undo this change from 2c23fff2e03e77187dc4d01f325f5f43a0e7cad2. - - - - - 3551c554 by Kirill Elagin at 2020-12-10T01:45:54-05:00 doc: Extra-clarify -fomit-yields Be more clear on what this optimisation being on by default means in terms of yields. - - - - - 6484f0d7 by Sergei Trofimovich at 2020-12-10T01:46:33-05:00 rts/linker/Elf.c: add missing <dlfcn.h> include (musl support) The change fixes build failure on musl: ``` rts/linker/Elf.c:2031:3: error: warning: implicit declaration of function 'dlclose'; did you mean 'close'? [-Wimplicit-function-declaration] 2031 | dlclose(nc->dlopen_handle); | ^~~~~~~ | close ``` Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - ab24ed9b by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Fix syntax errors Fixes errors introduced by 3a55b3a2574f913d046f3a6f82db48d7f6df32e3. - - - - - d3a24d31 by Ben Gamari at 2020-12-11T03:55:51-05:00 users guide: Describe GC lifecycle events Every time I am asked about how to interpret these events I need to figure it out from scratch. It's well past time that the users guide properly documents these. - - - - - 741309b9 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix incorrect Docker image for nightly cross job Also refactor the job definition to eliminate the bug by construction. - - - - - 19703bc8 by Ben Gamari at 2020-12-11T03:56:27-05:00 gitlab-ci: Fix name of flavour in ThreadSanitizer job It looks like I neglected to update this after introduce flavour transformers. - - - - - 381eb660 by Sylvain Henry at 2020-12-11T12:57:35-05:00 Display FFI labels (fix #18539) - - - - - 4548d1f8 by Aaron Allen at 2020-12-11T12:58:14-05:00 Elide extraneous messages for :doc command (#15784) Do not print `<has no documentation>` alongside a valid doc. Additionally, if two matching symbols lack documentation then the message will only be printed once. Hence, `<has no documentation>` will be printed at most once and only if all matching symbols are lacking docs. - - - - - 5eba91b6 by Aaron Allen at 2020-12-11T12:58:14-05:00 Add :doc test case for duplicate record fields Tests that the output of the `:doc` command is correct for duplicate record fields defined using -XDuplicateRecordFields. - - - - - 5feb9b2d by Ryan Scott at 2020-12-11T22:39:29-05:00 Delete outdated Note [Kind-checking tyvar binders for associated types] This Note has severely bitrotted, as it has no references anywhere in the codebase, and none of the functions that it mentions exist anymore. Let's just delete this. While I was in town, I deleted some outdated comments from `checkFamPatBinders` of a similar caliber. Fixes #19008. [ci skip] - - - - - f9f9f030 by Sylvain Henry at 2020-12-11T22:40:08-05:00 Arrows: correctly query arrow methods (#17423) Consider the following code: proc (C x y) -> ... Before this patch, the evidence binding for the Arrow dictionary was attached to the C pattern: proc (C x y) { $dArrow = ... } -> ... But then when we desugar this, we use arrow operations ("arr", ">>>"...) specialised for this arrow: let arr_xy = arr $dArrow -- <-- Not in scope! ... in arr_xy (\(C x y) { $dArrow = ... } -> ...) This patch allows arrow operations to be type-checked before the proc itself, avoiding this issue. Fix #17423 - - - - - aaa8f00f by Sylvain Henry at 2020-12-11T22:40:48-05:00 Validate script: fix configure command when using stack - - - - - b4a929a1 by Sylvain Henry at 2020-12-11T22:41:30-05:00 Hadrian: fix libffi tarball parsing Fix parsing of "libffi-3.3.tar.gz". NB: switch to a newer libffi isn't done in this patch - - - - - 690c8946 by Sylvain Henry at 2020-12-11T22:42:09-05:00 Parser: move parser utils into their own module Move code unrelated to runtime evaluation out of GHC.Runtime.Eval - - - - - 76be0e32 by Sylvain Henry at 2020-12-11T22:42:48-05:00 Move SizedSeq into ghc-boot - - - - - 3a16d764 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: don't compile unneeded modules - - - - - 2895fa60 by Sylvain Henry at 2020-12-11T22:42:48-05:00 ghci: reuse Arch from ghc-boot - - - - - 480a38d4 by Sylvain Henry at 2020-12-11T22:43:30-05:00 rts: don't use siginterrupt (#19019) - - - - - 4af6126d by Sylvain Henry at 2020-12-11T22:44:11-05:00 Use static array in zeroCount - - - - - 5bd71bfd by Sebastian Graf at 2020-12-12T04:45:09-05:00 DmdAnal: Annotate top-level function bindings with demands (#18894) It's useful to annotate a non-exported top-level function like `g` in ```hs module Lib (h) where g :: Int -> Int -> (Int,Int) g m 1 = (m, 0) g m n = (2 * m, 2 `div` n) {-# NOINLINE g #-} h :: Int -> Int h 1 = 0 h m | odd m = snd (g m 2) | otherwise = uncurry (+) (g 2 m) ``` with its demand `UCU(CS(P(1P(U),SP(U))`, which tells us that whenever `g` was called, the second component of the returned pair was evaluated strictly. Since #18903 we do so for local functions, where we can see all calls. For top-level functions, we can assume that all *exported* functions are demanded according to `topDmd` and thus get sound demands for non-exported top-level functions. The demand on `g` is crucial information for Nested CPR, which may the go on and unbox `g` for the second pair component. That is true even if that pair component may diverge, as is the case for the call site `g 13 0`, which throws a div-by-zero exception. In `T18894b`, you can even see the new demand annotation enabling us to eta-expand a function that we wouldn't be able to eta-expand without Call Arity. We only track bindings of function type in order not to risk huge compile-time regressions, see `isInterestingTopLevelFn`. There was a CoreLint check that rejected strict demand annotations on recursive or top-level bindings, which seems completely unjustified. All the cases I investigated were fine, so I removed it. Fixes #18894. - - - - - 3aae036e by Sebastian Graf at 2020-12-12T04:45:09-05:00 Demand: Simplify `CU(U)` to `U` (#19005) Both sub-demands encode the same information. This is a trivial change and already affects a few regression tests (e.g. `T5075`), so no separate regression test is necessary. - - - - - c6477639 by Adam Sandberg Ericsson at 2020-12-12T04:45:48-05:00 hadrian: correctly copy the docs dir into the bindist #18669 - - - - - e033dd05 by Adam Sandberg Ericsson at 2020-12-12T10:52:19+00:00 mkDocs: support hadrian bindists #18973 - - - - - 78580ba3 by John Ericson at 2020-12-13T07:14:50-05:00 Remove old .travis.yml - - - - - c696bb2f by Cale Gibbard at 2020-12-14T13:37:09-05:00 Implement type applications in patterns The haddock submodule is also updated so that it understands the changes to patterns. - - - - - 7e9debd4 by Ben Gamari at 2020-12-14T13:37:09-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 92377c27 by Ben Gamari at 2020-12-14T13:41:58-05:00 Revert "Optimise nullary type constructor usage" This was inadvertently merged. This reverts commit 7e9debd4ceb068effe8ac81892d2cabcb8f55850. - - - - - d0e8c10d by Sylvain Henry at 2020-12-14T19:45:13+01:00 Move Unit related fields from DynFlags to HscEnv The unit database cache, the home unit and the unit state were stored in DynFlags while they ought to be stored in the compiler session state (HscEnv). This patch fixes this. It introduces a new UnitEnv type that should be used in the future to handle separate unit environments (especially host vs target units). Related to #17957 Bump haddock submodule - - - - - af855ac1 by Andreas Klebinger at 2020-12-14T15:22:13-05:00 Optimize dumping of consecutive whitespace. The naive way of putting out n characters of indent would be something like `hPutStr hdl (replicate n ' ')`. However this is quite inefficient as we allocate an absurd number of strings consisting of simply spaces as we don't cache them. To improve on this we now track if we can simply write ascii spaces via hPutBuf instead. This is the case when running with -ddump-to-file where we force the encoding to be UTF8. This avoids both the cost of going through encoding as well as avoiding allocation churn from all the white space. Instead we simply use hPutBuf on a preallocated unlifted string. When dumping stg like this: > nofib/spectral/simple/Main.hs -fforce-recomp -ddump-stg-final -ddump-to-file -c +RTS -s Allocations went from 1,778 MB to 1,702MB. About a 4% reduction of allocation! I did not measure the difference in runtime but expect it to be similar. Bumps the haddock submodule since the interface of GHC's Pretty slightly changed. ------------------------- Metric Decrease: T12227 ------------------------- - - - - - dad87210 by Ben Gamari at 2020-12-14T15:22:29-05:00 Optimise nullary type constructor usage During the compilation of programs GHC very frequently deals with the `Type` type, which is a synonym of `TYPE 'LiftedRep`. This patch teaches GHC to avoid expanding the `Type` synonym (and other nullary type synonyms) during type comparisons, saving a good amount of work. This optimisation is described in `Note [Comparing nullary type synonyms]`. To maximize the impact of this optimisation, we introduce a few special-cases to reduce `TYPE 'LiftedRep` to `Type`. See `Note [Prefer Type over TYPE 'LiftedPtrRep]`. Closes #17958. Metric Decrease: T18698b T1969 T12227 T12545 T12707 T14683 T3064 T5631 T5642 T9020 T9630 T9872a T13035 haddock.Cabal haddock.base - - - - - 6c2eb223 by Andrew Martin at 2020-12-14T18:48:51-05:00 Implement BoxedRep proposal This implements the BoxedRep proposal, refacoring the `RuntimeRep` hierarchy from: ```haskell data RuntimeRep = LiftedPtrRep | UnliftedPtrRep | ... ``` to ```haskell data RuntimeRep = BoxedRep Levity | ... data Levity = Lifted | Unlifted ``` Closes #17526. - - - - - 3ee696cc by Sebastian Graf at 2020-12-15T10:53:31-05:00 Add regression test for #19053 - - - - - 535dae66 by Ben Gamari at 2020-12-15T10:53:58-05:00 testsuite: Mark divbyzero, derefnull as fragile Due to #18548. - - - - - 331f5568 by Ben Gamari at 2020-12-15T11:21:06-05:00 Revert "Implement BoxedRep proposal" This was inadvertently merged. This reverts commit 6c2eb2232b39ff4720fda0a4a009fb6afbc9dcea. - - - - - 50fae07d by Ben Gamari at 2020-12-15T15:15:16-05:00 Roll-back broken haddock commit Updates haddock submodule to revert a commit that does not build. - - - - - e9b18a75 by Ben Gamari at 2020-12-15T15:55:38-05:00 Revert haddock submodule yet again - - - - - b58cb63a by GHC GitLab CI at 2020-12-16T03:46:31+00:00 Bump haddock submodule To adapt haddock for the nullary tyconapp optimisation patch. - - - - - 80df2edd by David Eichmann at 2020-12-17T13:55:21-05:00 User guide minor typo [ci skip] - - - - - 09f28390 by nineonine at 2020-12-17T13:55:59-05:00 Force module recompilation if '*' prefix was used to load modules in ghci (#8042) Usually pre-compiled code is preferred to be loaded in ghci if available, which means that if we try to load module with '*' prefix and compilation artifacts are available on disc (.o and .hi files) or the source code was untouched, the driver would think no recompilation is required. Therefore, we need to force recompilation so that desired byte-code is generated and loaded. Forcing in this case should be ok, since this is what happens for interpreted code anyways when reloading modules. - - - - - b1178cbc by Ryan Scott at 2020-12-17T13:56:35-05:00 Reject dodgy scoping in associated family instance RHSes Commit e63518f5d6a93be111f9108c0990a1162f88d615 tried to push all of the logic of detecting out-of-scope type variables on the RHSes of associated type family instances to `GHC.Tc.Validity` by deleting a similar check in the renamer. Unfortunately, this commit went a little too far, as there are some corner cases that `GHC.Tc.Validity` doesn't detect. Consider this example: ```hs class C a where data D a instance forall a. C Int where data instance D Int = MkD a ``` If this program isn't rejected by the time it reaches the typechecker, then GHC will believe the `a` in `MkD a` is existentially quantified and accept it. This is almost surely not what the user wants! The simplest way to reject programs like this is to restore the old validity check in the renamer (search for `improperly_scoped` in `rnFamEqn`). Note that this is technically a breaking change, since the program in the `polykinds/T9574` test case (which previously compiled) will now be rejected: ```hs instance Funct ('KProxy :: KProxy o) where type Codomain 'KProxy = NatTr (Proxy :: o -> *) ``` This is because the `o` on the RHS will now be rejected for being out of scope. Luckily, this is simple to repair: ```hs instance Funct ('KProxy :: KProxy o) where type Codomain ('KProxy @o) = NatTr (Proxy :: o -> *) ``` All of the discussion is now a part of the revamped `Note [Renaming associated types]` in `GHC.Rename.Module`. A different design would be to make associated type family instances have completely separate scoping from the parent instance declaration, much like how associated type family default declarations work today. See the discussion beginning at https://gitlab.haskell.org/ghc/ghc/-/issues/18021#note_265729 for more on this point. This, however, would break even more programs that are accepted today and likely warrants a GHC proposal before going forward. In the meantime, this patch fixes the issue described in #18021 in the least invasive way possible. There are programs that are accepted today that will no longer be accepted after this patch, but they are arguably pathological programs, and they are simple to repair. Fixes #18021. - - - - - cf8ab4a6 by Tom Ellis at 2020-12-17T13:57:12-05:00 submodule update: containers and stm Needed for https://gitlab.haskell.org/ghc/ghc/-/issues/15656 as it stops the packages triggering incomplete-uni-patterns and incomplete-record-updates - - - - - df7c7faa by Richard Eisenberg at 2020-12-17T13:57:48-05:00 Unfortunate dirty hack to overcome #18998. See commentary in tcCheckUsage. Close #18998. Test case: typecheck/should_compile/T18998 - - - - - 659fcb14 by Sylvain Henry at 2020-12-17T13:58:30-05:00 Fix project version for ProjectVersionMunged (fix #19058) - - - - - 7a93435b by Ryan Scott at 2020-12-18T05:50:33-05:00 Use HsOuterExplicit in instance sigs in deriving-generated code Issue #18914 revealed that `GeneralizedNewtypeDeriving` would generate code that mentions unbound type variables, which is dangerously fragile. The problem (and fix) is described in the new `Wrinkle: Use HsOuterExplicit` in `Note [GND and QuantifiedConstraints]`. The gist of it: make sure to put the top-level `forall`s in `deriving`-generated instance signatures in an `HsOuterExplicit` to ensure that they scope over the bodies of methods correctly. A side effect of this process is that it will expand any type synonyms in the instance signature, which will surface any `forall`s that are hidden underneath type synonyms (such as in the test case for #18914). While I was in town, I also performed some maintenance on `NewHsTypeX`, which powers `GeneralizedNewtypeDeriving`: * I renamed `NewHsTypeX` to `HsCoreTy`, which more accurately describes its intended purpose (#15706). I also made `HsCoreTy` a type synonym instead of a newtype, as making it a distinct data type wasn't buying us much. * To make sure that mistakes similar to #18914 do not occur later, I added an additional validity check when renaming `HsCoreTy`s that complains if an `HsCoreTy`s contains an out-of-scope type variable. See the new `Note [Renaming HsCoreTys]` in `GHC.Rename.HsType` for the details. Fixes #15706. Fixes #18914. Bumps the `haddock` submodule. - - - - - b4fcfd0f by Andreas Klebinger at 2020-12-18T05:51:09-05:00 OSMem.c: Use proper type for mbinds mask argument. StgWord has different widths on 32/64bit. So use the proper type instead. - - - - - 09edf5e5 by Andreas Klebinger at 2020-12-18T05:51:10-05:00 rts: EventLog.c: Properly cast (potential) 32bit pointers to uint64_t - - - - - ed22678a by Andreas Klebinger at 2020-12-18T05:51:10-05:00 Rts/elf-linker: Upcast to 64bit to satisfy format string. The elf size is 32bit on 32bit builds and 64 otherwise. We just upcast to 64bits before printing now. - - - - - 52498cfa by Alfredo Di Napoli at 2020-12-18T05:51:48-05:00 Split Driver.Env module This commit splits the GHC.Driver.Env module creating a separate GHC.Driver.Env.Types module where HscEnv and Hsc would live. This will pave the way to the structured error values by avoiding one boot module later down the line. - - - - - d66b4bcd by Alfredo Di Napoli at 2020-12-18T05:52:25-05:00 Rename parser Error and Warning types This commit renames parser's Error and Warning types (and their constructors) to have a 'Ps' prefix, so that this would play nicely when more errors and warnings for other phases of the pipeline will be added. This will make more explicit which is the particular type of error and warning we are dealing with, and will be more informative for users to see in the generated Haddock. - - - - - 29f77584 by Richard Eisenberg at 2020-12-18T05:53:01-05:00 Fix #19044 by tweaking unification in inst lookup See Note [Infinitary substitution in lookup] in GHC.Core.InstEnv and Note [Unification result] in GHC.Core.Unify. Test case: typecheck/should_compile/T190{44,52} Close #19044 Close #19052 - - - - - 0204b4aa by Ben Gamari at 2020-12-18T05:53:37-05:00 rts: Fix typo in macro name THREADED_RTS was previously misspelled as THREADEDED_RTS. Fixes #19057. - - - - - 3e9b7452 by Ben Gamari at 2020-12-18T05:54:21-05:00 primops: Document semantics of Float/Int conversions Fixes #18840. - - - - - c53b38dd by Ben Gamari at 2020-12-18T05:54:56-05:00 testsuite: Fix two shell quoting issues Fixes two ancient bugs in the testsuite driver makefiles due to insufficient quoting. I have no idea how these went unnoticed for so long. Thanks to @tomjaguarpaw for testing. - - - - - 59a07641 by Richard Eisenberg at 2020-12-18T05:55:33-05:00 Cite "Kind Inference for Datatypes" - - - - - c2430398 by Simon Peyton Jones at 2020-12-19T02:14:07-05:00 Quick Look: zonk result type Provoked by #18987, this patch adds a missing zonkQuickLook of app_res_rho in tcApp. Most of the time this zonk is unnecesary. In fact, I can't think of a concrete case where it is needed -- hence no test. But even if it isn't necessary, the reasoning that allows it to be omitted is very subtle. So I've put it in. However, adding this zonk does /not/ affect the emitted constraints, so the reported symptoms for #18987 remain, but harmlessly so, and now documented in a new Note [Instantiation variables are short lived] in GHC.Tc.Gen.App. No change in behaviour, no tests. - - - - - 173112ca by Simon Peyton Jones at 2020-12-19T02:14:42-05:00 Make noinline more reliable This patch makes the desugarer rewrite noinline (f d) --> noinline f d This makes 'noinline' much more reliable: see #18995 It's explained in the improved Note [noinlineId magic] in GHC.Types.Id.Make - - - - - df8e6e90 by Douglas Wilson at 2020-12-19T02:15:19-05:00 rts: Use weaker cas in WSDeque The algorithm described in the referenced paper uses this slightly weaker atomic op. This is the first "exotic" cas we're using. I've added a macro in the <ORDERING>_OP style to match existing ones. - - - - - 366b5885 by Tom Ellis at 2020-12-19T10:18:12+00:00 submodule update: haddock Ensure it is ready for -Wincomplete-uni-patterns and -Wincomplete-record-updates in -Wall - - - - - 32b6ebe8 by Tom Ellis at 2020-12-19T10:18:55+00:00 Add two warnings to -Wall * -Wincomplete-uni-patterns * -Wincomplete-record-updates See https://gitlab.haskell.org/ghc/ghc/-/issues/15656 - - - - - e84b02ab by Richard Eisenberg at 2020-12-20T14:14:11-05:00 Correct documentation around -XTypeOperators Close #19064 - - - - - 65721691 by Krzysztof Gogolewski at 2020-12-20T14:14:50-05:00 Improve inference with linear types This fixes test Linear14. The code in Unify.hs was always using multiplicity Many instead of a new metavariable. - - - - - 35fa0786 by Adam Sandberg Ericsson at 2020-12-20T20:45:55-05:00 rts: enable thread label table in all RTS flavours #17972 - - - - - 995a8f9d by Simon Peyton Jones at 2020-12-20T20:46:31-05:00 Kill floatEqualities completely This patch delivers on #17656, by entirel killing off the complex floatEqualities mechanism. Previously, floatEqualities would float an equality out of an implication, so that it could be solved at an outer level. But now we simply do unification in-place, without floating the constraint, relying on level numbers to determine untouchability. There are a number of important new Notes: * GHC.Tc.Utils.Unify Note [Unification preconditions] describes the preconditions for unification, including both skolem-escape and touchability. * GHC.Tc.Solver.Interact Note [Solve by unification] describes what we do when we do unify * GHC.Tc.Solver.Monad Note [The Unification Level Flag] describes how we control solver iteration under this new scheme * GHC.Tc.Solver.Monad Note [Tracking Given equalities] describes how we track when we have Given equalities * GHC.Tc.Types.Constraint Note [HasGivenEqs] is a new explanation of the ic_given_eqs field of an implication A big raft of subtle Notes in Solver, concerning floatEqualities, disappears. Main code changes: * GHC.Tc.Solver.floatEqualities disappears entirely * GHC.Tc.Solver.Monad: new fields in InertCans, inert_given_eq_lvl and inert_given_eq, updated by updateGivenEqs See Note [Tracking Given equalities]. * In exchange for updateGivenEqa, GHC.Tc.Solver.Monad.getHasGivenEqs is much simpler and more efficient * I found I could kill of metaTyVarUpdateOK entirely One test case T14683 showed a 5.1% decrease in compile-time allocation; and T5631 was down 2.2%. Other changes were small. Metric Decrease: T14683 T5631 - - - - - 5eb22fa2 by Krzysztof Gogolewski at 2020-12-20T20:47:11-05:00 Fix printing in -ddump-rule-rewrites (#18668) The unapplied arguments were not printed out. - - - - - b4508bd6 by Matthew Pickering at 2020-12-20T20:47:47-05:00 Fix Haddock parse error in GHC.Parser.PostProcess.Haddock - - - - - 19823708 by Ben Gamari at 2020-12-20T21:05:13-05:00 nonmoving: Fix small CPP bug Previously an incorrect semicolon meant that we would fail to call busy_wait_nop when spinning. - - - - - a5b2fded by GHC GitLab CI at 2020-12-20T21:05:13-05:00 nonmoving: Assert deadlock-gc promotion invariant When performing a deadlock-detection GC we must ensure that all objects end up in the non-moving generation. Assert this in scavenge. - - - - - cde74994 by GHC GitLab CI at 2020-12-20T21:05:13-05:00 nonmoving: Ensure deadlock detection promotion works Previously the deadlock-detection promotion logic in alloc_for_copy was just plain wrong: it failed to fire when gct->evac_gen_no != oldest_gen->gen_no. The fix is simple: move the - - - - - a13bd3f1 by GHC GitLab CI at 2020-12-20T21:05:13-05:00 nonmoving: Refactor alloc_for_copy Pull the cold non-moving allocation path out of alloc_for_copy. - - - - - a2731d49 by Ben Gamari at 2020-12-20T21:05:13-05:00 nonmoving: Don't push objects during deadlock detect GC Previously we would push large objects and compact regions to the mark queue during the deadlock detect GC, resulting in failure to detect deadlocks. - - - - - 65b702f1 by GHC GitLab CI at 2020-12-20T21:05:13-05:00 nonmoving: Add comments to nonmovingResurrectThreads - - - - - 13874a7b by Ben Gamari at 2020-12-21T16:35:36-05:00 gitlab-ci: Use gtar on FreeBSD - - - - - 3ef94d27 by Adam Sandberg Ericsson at 2020-12-22T01:26:44-05:00 hadrian: disable ghc package environments #18988 - - - - - f27a7144 by Adam Sandberg Ericsson at 2020-12-22T01:26:44-05:00 make: disable ghc package environments #18988 - - - - - 293100ad by Matthew Pickering at 2020-12-22T01:27:20-05:00 Fix another haddock parse error - - - - - 932ee6de by Joe Hermaszewski at 2020-12-22T10:38:24-05:00 Add Monoid instances for Product and Compose Semigroup too of course - - - - - 4c3fae47 by Ryan Scott at 2020-12-22T10:39:00-05:00 Require alex < 3.2.6 A workaround for #19099. - - - - - 553c59ca by Andreas Klebinger at 2020-12-22T22:10:06-05:00 Increase -A default to 4MB. This gives a small increase in performance under most circumstances. For single threaded GC the improvement is on the order of 1-2%. For multi threaded GC the results are quite noisy but seem to fall into the same ballpark. Fixes #16499 - - - - - 53fb345d by Adam Sandberg Ericsson at 2020-12-22T22:10:45-05:00 mkDocs: fix extraction of Win32 docs from hadrian bindist - - - - - 50236ed2 by Adam Sandberg Ericsson at 2020-12-22T22:10:45-05:00 mkDocs: address shellcheck issues - - - - - 56841432 by Sebastian Graf at 2020-12-23T10:21:56-05:00 DmdAnal: Keep alive RULE vars in LetUp (#18971) I also took the liberty to refactor the logic around `ruleFVs`. - - - - - f0ec06c7 by Sebastian Graf at 2020-12-23T10:21:56-05:00 WorkWrap: Unbox constructors with existentials (#18982) Consider ```hs data Ex where Ex :: e -> Int -> Ex f :: Ex -> Int f (Ex e n) = e `seq` n + 1 ``` Worker/wrapper should build the following worker for `f`: ```hs $wf :: forall e. e -> Int# -> Int# $wf e n = e `seq` n +# 1# ``` But previously it didn't, because `Ex` binds an existential. This patch lifts that condition. That entailed having to instantiate existential binders in `GHC.Core.Opt.WorkWrap.Utils.mkWWstr` via `GHC.Core.Utils.dataConRepFSInstPat`, requiring a bit of a refactoring around what is now `DataConPatContext`. CPR W/W still won't unbox DataCons with existentials. See `Note [Which types are unboxed?]` for details. I also refactored the various `tyCon*DataCon(s)_maybe` functions in `GHC.Core.TyCon`, deleting some of them which are no longer needed (`isDataProductType_maybe` and `isDataSumType_maybe`). I cleaned up a couple of call sites, some of which weren't very explicit about whether they cared for existentials or not. The test output of `T18013` changed, because we now unbox the `Rule` data type. Its constructor carries existential state and will be w/w'd now. In the particular example, the worker functions inlines right back into the wrapper, which then unnecessarily has a (quite big) stable unfolding. I think this kind of fallout is inevitable; see also Note [Don't w/w inline small non-loop-breaker things]. There's a new regression test case `T18982`. Fixes #18982. - - - - - f59c34b8 by Sylvain Henry at 2020-12-23T10:22:35-05:00 Support package qualifier in Prelude import Fix #19082, #17045 - - - - - cce1514a by Douglas Wilson at 2020-12-23T10:23:14-05:00 spelling: thead -> thread - - - - - 79d41f93 by Simon Peyton Jones at 2020-12-23T10:23:51-05:00 Document scoping of named wildcard type variables See `Note [Scoping of named wildcards]` in GHC.Hs.Type This lack of documentation came up in #19051. - - - - - e7d8e4ee by Simon Peyton Jones at 2020-12-24T06:41:07-05:00 Clone the binders of a SAKS where necessary Given a kind signature type T :: forall k. k -> forall k. k -> blah data T a b = ... where those k's have the same unique (which is possible; see #19093) we were giving the tyConBinders in tycon T the same unique, which caused chaos. Fix is simple: ensure uniqueness when decomposing the kind signature. See GHC.Tc.Gen.HsType.zipBinders - - - - - 98094744 by Ryan Scott at 2020-12-24T06:41:43-05:00 Require ScopedTypeVariables+TypeApplications to use type applications in patterns Fixes #19109. - - - - - 6f8bafb4 by Adam Gundry at 2020-12-24T16:34:49-05:00 Refactor renamer datastructures This patch significantly refactors key renamer datastructures (primarily Avail and GlobalRdrElt) in order to treat DuplicateRecordFields in a more robust way. In particular it allows the extension to be used with pattern synonyms (fixes where mangled record selector names could be printed instead of field labels (e.g. with -Wpartial-fields or hole fits, see new tests). The key idea is the introduction of a new type GreName for names that may represent either normal entities or field labels. This is then used in GlobalRdrElt and AvailInfo, in place of the old way of representing fields using FldParent (yuck) and an extra list in AvailTC. Updates the haddock submodule. - - - - - adaa6194 by John Ericson at 2020-12-24T16:35:25-05:00 Use `hscFrontendHook` again In eb629fab I accidentally got rid of it when inlining tons of helpers. Closes #19004 - - - - - 164887da by Richard Eisenberg at 2020-12-25T03:48:37-05:00 Use mutable update to defer out-of-scope errors Previously, we let-bound an identifier to use to carry the erroring evidence for an out-of-scope variable. But this failed for levity-polymorphic out-of-scope variables, leading to a panic (#17812). The new plan is to use a mutable update to just write the erroring expression directly where it needs to go. Close #17812. Test case: typecheck/should_compile/T17812 - - - - - cbc7c3dd by Richard Eisenberg at 2020-12-25T03:49:13-05:00 Test cases for #15772 and #17139. - - - - - 2113a1d6 by John Ericson at 2020-12-28T12:28:35-05:00 Put hole instantiation typechecking in the module graph and fix driver batch mode backpack edges Backpack instantiations need to be typechecked to make sure that the arguments fit the parameters. `tcRnInstantiateSignature` checks instantiations with concrete modules, while `tcRnCheckUnit` checks instantiations with free holes (signatures in the current modules). Before this change, it worked that `tcRnInstantiateSignature` was called after typechecking the argument module, see `HscMain.hsc_typecheck`, while `tcRnCheckUnit` was called in `unsweep'` where-bound in `GhcMake.upsweep`. `tcRnCheckUnit` was called once per each instantiation once all the argument sigs were processed. This was done with simple "to do" and "already done" accumulators in the fold. `parUpsweep` did not implement the change. With this change, `tcRnCheckUnit` instead is associated with its own node in the `ModuleGraph`. Nodes are now: ```haskell data ModuleGraphNode -- | Instantiation nodes track the instantiation of other units -- (backpack dependencies) with the holes (signatures) of the current package. = InstantiationNode InstantiatedUnit -- | There is a module summary node for each module, signature, and boot module being built. | ModuleNode ExtendedModSummary ``` instead of just `ModSummary`; the `InstantiationNode` case is the instantiation of a unit to be checked. The dependencies of such nodes are the same "free holes" as was checked with the accumulator before. Both versions of upsweep on such a node call `tcRnCheckUnit`. There previously was an `implicitRequirements` function which would crawl through every non-current-unit module dep to look for all free holes (signatures) to add as dependencies in `GHC.Driver.Make`. But this is no good: we shouldn't be looking for transitive anything when building the graph: the graph should only have immediate edges and the scheduler takes care that all transitive requirements are met. So `GHC.Driver.Make` stopped using `implicitRequirements`, and instead uses a new `implicitRequirementsShallow`, which just returns the outermost instantiation node (or module name if the immediate dependency is itself a signature). The signature dependencies are just treated like any other imported module, but the module ones then go in a list stored in the `ModuleNode` next to the `ModSummary` as the "extra backpack dependencies". When `downsweep` creates the mod summaries, it adds this information too. ------ There is one code quality, and possible correctness thing left: In addition to `implicitRequirements` there is `findExtraSigImports`, which says something like "if you are an instantiation argument (you are substituted or a signature), you need to import its things too". This is a little non-local so I am not quite sure how to get rid of it in `GHC.Driver.Make`, but we probably should eventually. First though, let's try to make a test case that observes that we don't do this, lest it actually be unneeded. Until then, I'm happy to leave it as is. ------ Beside the ability to use `-j`, the other major user-visibile side effect of this change is that that the --make progress log now includes "Instantiating" messages for these new nodes. Those also are numbered like module nodes and count towards the total. ------ Fixes #17188 Updates hackage submomdule Metric Increase: T12425 T13035 - - - - - 9b563330 by Cale Gibbard at 2020-12-31T13:05:42-05:00 INLINE pragma for patterns (#12178) Allow INLINE and NOINLINE pragmas to be used for patterns. Those are applied to both the builder and matcher (where applicable). - - - - - 85d899c8 by Sylvain Henry at 2021-01-02T07:32:12-05:00 Make proper fixed-width number literals (Progress towards #11953, #17377, #17375) Besides being nicer to use, this also will allow for better constant folding for the fixed-width types, on par with what `Int#` and `Word#` have today. - - - - - 77c4a15f by Artem Pelenitsyn at 2021-01-02T07:32:50-05:00 base: add Numeric.{readBin, showBin} (fix #19036) - - - - - 87bc458d by Ben Gamari at 2021-01-02T07:33:26-05:00 rts/Messages: Relax locked-closure assertion In general we are less careful about locking closures when running with only a single capability. Fixes #19075. - - - - - 5650c79e by Simon Peyton Jones at 2021-01-02T07:34:01-05:00 Establish invariant (GivenInv) This patch establishes invariant (GivenInv) from GHC.Tc.Utils.TcType Note [TcLevel invariants]. (GivenInv) says that unification variables from level 'n' should not appear in the Givens for level 'n'. See Note [GivenInv] in teh same module. This invariant was already very nearly true, but a dark corner of partial type signatures made it false. The patch re-jigs partial type signatures a bit to avoid the problem, and documents the invariant much more thorughly Fixes #18646 along the way: see Note [Extra-constraints wildcards] in GHC.Tc.Gen.Bind I also simplified the interface to tcSimplifyInfer slightly, so that it /emits/ the residual constraint, rather than /returning/ it. - - - - - c2a007c7 by Joachim Breitner at 2021-01-02T07:34:37-05:00 Docs: Remove reference to `type_applications` in `exts/patterns.rst` it is unclear why it is there, and it is _also_ linked from `exts/types.rst`. - - - - - d9788fd2 by Douglas Wilson at 2021-01-02T07:35:14-05:00 rts: update usage text for new -A default - - - - - bc383cb0 by Hécate at 2021-01-02T07:35:54-05:00 Upstream the strictness optimisation for GHC.List.{sum,product} - - - - - 4c178374 by Hécate at 2021-01-02T07:35:54-05:00 Upstream the strictness optimisation for GHC.List.{maximum,minimum} - - - - - aa17b84d by Oleg Grenrus at 2021-01-02T07:36:33-05:00 Correct doctests It's simpler to assume that base is NoImplicitPrelude, otherwise running doctest on `GHC.*` modules would be tricky. OTOH, most `GHC.List` (where the most name clashes are) examples could be changed to use `import qualified Data.List as L`. (GHC.List examples won't show for Foldable methods...). With these changes majority of doctest examples are GHCi-"faithful", my WIP GHC-independent doctest runner reports nice summary: Examples: 582; Tried: 546; Skipped: 34; Success: 515; Errors: 33; Property Failures 2 Most error cases are *Hangs forever*. I have yet to figure out how to demonstrate that in GHCi. Some of divergences are actually stack overflows, i.e. caught by runtime. Few errorful cases are examples of infinite output, e.g. >>> cycle [42] [42,42,42,42,42,42,42,42,42,42... while correct, they confuse doctest. Another erroneous cases are where expected output has line comment, like >>> fmap show (Just 1) -- (a -> b) -> f a -> f b Just "1" -- (Int -> String) -> Maybe Int -> Maybe String I think I just have to teach doctest to strip comments from expected output. This is a first patch in a series. There is plenty of stuff already. - - - - - cc87bda6 by Asad Saeeduddin at 2021-01-02T07:37:09-05:00 Use EmptyCase instead of undefined in Generics example Fixes #19124 - - - - - a8926e95 by Simon Peyton Jones at 2021-01-02T07:37:46-05:00 Don't use absentError thunks for strict constructor fields This patch fixes #19133 by using LitRubbish for strict constructor fields, even if they are of lifted types. Previously LitRubbish worked only for unlifted (but boxed) types. The change is very easy, although I needed a boolean field in LitRubbish to say whether or not it is lifted. (That seemed easier than giving it another type argument. This is preparing for Andreas's work on establishing the invariant that strict constructor fields are always tagged and evaluated (see #16970). Meanwhile, nothing was actually wrong before, so there are no tests. - - - - - ee1161d3 by Simon Peyton Jones at 2021-01-02T14:13:25+00:00 Add regression test for #18467 - - - - - c7e16936 by Hécate at 2021-01-03T05:23:39-05:00 Add the Data.Foldable strictness optimisations to base's changelog - - - - - 0a265624 by Viktor Dukhovni at 2021-01-03T13:55:10-05:00 Maintain invariant: MVars on mut_list are dirty The fix for 18919 was somewhat incomplete: while the MVars were correctly added to the mut_list via dirty_MVAR(), their info table remained "clean". While this is mostly harmless in non-debug builds, but trips an assertion in the debug build, and may result in the MVar being needlessly being added to the mut_list multiple times. Resolves: #19145 - - - - - 26a928b8 by John Ericson at 2021-01-03T13:55:45-05:00 Rename internal primpos ahead of !4492 I'm not sure how long the submodule dance is going to take, sadly, so I'd like to chip away at things in the meantime / avoid conflicts. - - - - - 6c771aaf by Sylvain Henry at 2021-01-05T15:02:58+01:00 Implement Unique supply with Addr# atomic primop Before this patch the compiler depended on the RTS way (threaded or not) to use atomic incrementation or not. This is wrong because the RTS is supposed to be switchable at link time, without recompilation. Now we always use atomic incrementation of the unique counter. - - - - - 3e2ea550 by Ben Gamari at 2021-01-07T00:10:15-05:00 rts: Break up census logic Move the logic for taking censuses of "normal" and pinned blocks to their own functions. - - - - - 66902230 by Ben Gamari at 2021-01-07T00:10:15-05:00 rts: Implement heap census support for pinned objects It turns out that this was fairly straightforward to implement since we are now pretty careful about zeroing slop. - - - - - fb81f2ed by Ben Gamari at 2021-01-07T00:10:15-05:00 Storage: Unconditionally enable zeroing of alignment slop This is necessary since the user may enable `+RTS -hT` at any time. - - - - - 30f7137d by Ben Gamari at 2021-01-07T00:10:15-05:00 rts: Zero shrunk array slop in vanilla RTS But only when profiling or DEBUG are enabled. Fixes #17572. - - - - - ced0d752 by Ben Gamari at 2021-01-07T00:10:16-05:00 rts: Enforce that mark-region isn't used with -h As noted in #9666, the mark-region GC is not compatible with heap profiling. Also add documentation for this flag. Closes #9666. - - - - - e981023e by Ben Gamari at 2021-01-07T00:10:52-05:00 users-guide: Remove space from -ol documentation This flag requires that there be no space between the filename and the argument. - - - - - 06982b6c by John Ericson at 2021-01-07T00:11:31-05:00 Make primops for `{Int,Word}32#` Progress towards #19026. The type was added before, but not its primops. We follow the conventions in 36fcf9edee31513db2ddbf716ee0aa79766cbe69 and 2c959a1894311e59cd2fd469c1967491c1e488f3 for names and testing. Along with the previous 8- and 16-bit primops, this will allow us to avoid many conversions for 8-, 16-, and 32-bit sized numeric types. Co-authored-by: Sylvain Henry <hsyl20 at gmail.com> - - - - - 1de2050e by Roland Senn at 2021-01-07T00:12:09-05:00 GHCi: Fill field `DynFlags.dumpPrefix`. (Fixes #17500) For interactive evaluations set the field `DynFlags.dumpPrefix` to the GHCi internal module name. The GHCi module name for an interactive evaluation is something like `Ghci9`. To avoid user confusion, don't dump any data for GHCi internal evaluations. Extend the comment for `DynFlags.dumpPrefix` and fix a little typo in a comment about the GHCi internal module names. - - - - - 10499f55 by Ben Gamari at 2021-01-07T00:12:46-05:00 compiler: Initialize ForeignExportsList.n_entries The refactoring in ed57c3a9eb9286faa222f98e484a9ef3432b2025 failed to initialize this field, resulting in no exports being registered. A very silly bug and yet somehow none of our tests caught it. See #18548. Fixes #19149. - - - - - 2f629beb by Ben Gamari at 2021-01-07T00:12:46-05:00 testsuite: Add test for #19149 - - - - - 3b3fcc71 by Ben Gamari at 2021-01-07T00:13:22-05:00 rts/Linker: Add noreturn to loadNativeObj on non-ELF platforms - - - - - e0e7d2bc by Ben Gamari at 2021-01-07T00:13:59-05:00 rts/Sanity: Allow DEAD_WEAKs in weak pointer list The weak pointer check in `checkGenWeakPtrList` previously failed to account for dead weak pointers. This caused `fptr01` to fail in the `sanity` way. Fixes #19162. - - - - - ad3d2364 by Ben Gamari at 2021-01-07T00:14:35-05:00 docs: Various release notes changes * Mention changed in profiler's treatment of PINNED closures * Fix formatting * Move plugins-relevant changes to GHC API section - - - - - bd877edd by Sylvain Henry at 2021-01-07T00:15:15-05:00 Hadrian: show default ghc-bignum backend (fix #18912) - - - - - 9a62ecfa by Alfredo Di Napoli at 2021-01-09T21:18:34-05:00 Remove errShortString, cleanup error-related functions This commit removes the errShortString field from the ErrMsg type, allowing us to cleanup a lot of dynflag-dependent error functions, and move them in a more specialised 'GHC.Driver.Errors' closer to the driver, where they are actually used. Metric Increase: T4801 T9961 - - - - - f88fb8c7 by Ben Gamari at 2021-01-09T21:19:10-05:00 hadrian: Add missing dependencies ghcconfig.h, which depends upon ghcautoconf.h, and is a runtime dependency of deriveConstants. This is essentially a continuation of #18290. - - - - - c8c63dde by Richard Eisenberg at 2021-01-09T21:19:45-05:00 Never Anyify during kind inference See Note [Error on unconstrained meta-variables] in TcMType. Close #17301 Close #17567 Close #17562 Close #15474 - - - - - 0670f387 by Viktor Dukhovni at 2021-01-09T21:20:23-05:00 New overview of Foldable class Also updated stale external URL in Traversable - - - - - a2f43e26 by Viktor Dukhovni at 2021-01-09T21:20:23-05:00 More truthful synopsis examples - - - - - f9605e1a by Viktor Dukhovni at 2021-01-09T21:20:23-05:00 Reconcile extant synopses with new overview prose - Renamed new "update function" to "operator" from synopses - More accurate divergence conditions. - Fewer references to the Tree structure in examples, which may not have the definition close-by in context in other modules, e.g. Prelude. - Improved description of foldlM and foldrM - More detail on Tree instance construction - Misc fixes - - - - - e07ba458 by Viktor Dukhovni at 2021-01-09T21:20:23-05:00 More tidy synopses, and new generative recursion - Further correction and reconcialation with new overview of the existing synopses. Restored some "Tree" examples. - New section on generative recursion via Church encoding of lists. - - - - - f49d6fb2 by Douglas Wilson at 2021-01-09T21:21:02-05:00 rts: stats: Some fixes to stats for sequential gcs Solves #19147. When n_capabilities > 1 we were not correctly accounting for gc time for sequential collections. In this case par_n_gcthreads == 1, however it is not guaranteed that the single gc thread is capability 0. A similar issue for copied is addressed as well. - - - - - 06beed68 by Douglas Wilson at 2021-01-09T21:21:02-05:00 rts: stats: Fix calculation for fragmentation - - - - - 3d15d8d0 by Ben Gamari at 2021-01-09T21:21:37-05:00 rts: Use relaxed load when checking for cap ownership This check is merely a service to the user; no reason to synchronize. - - - - - 83ac5594 by Ben Gamari at 2021-01-09T21:21:37-05:00 rts: Use SEQ_CST accesses when touching `wakeup` These are the two remaining non-atomic accesses to `wakeup` which were missed by the original TSAN patch. - - - - - d1b9d679 by Ben Gamari at 2021-01-09T21:21:38-05:00 rts/Capability: Use relaxed load in findSpark When checking n_returning_tasks. - - - - - f6b843cd by Ben Gamari at 2021-01-09T21:22:14-05:00 rts/PEi386: Fix reentrant lock usage Previously lookupSymbol_PEi386 would call lookupSymbol while holding linker_mutex. Fix this by rather calling `lookupDependentSymbol`. This is safe because lookupSymbol_PEi386 unconditionally holds linker_mutex. Happily, this un-breaks `T12771`, `T13082_good`, and `T14611`, which were previously marked as broken due to #18718. Closes #19155. - - - - - 73b5cc01 by Ben Gamari at 2021-01-09T21:22:51-05:00 gitlab-ci: Don't attempt to push perf notes in cross build We don't run the testsuite in cross-compiled builds so there is nothing to push. - - - - - a9ef2399 by Greg Steuck at 2021-01-09T21:23:27-05:00 intro.rst: remove duplication of release references and fix a link - - - - - 9163b3f1 by Greg Steuck at 2021-01-09T21:23:27-05:00 gone_wrong.rst: remove duplicate term - - - - - 27544196 by Sylvain Henry at 2021-01-09T21:24:06-05:00 Natural: fix left shift of 0 (fix #19170) - - - - - 78629c24 by Ben Gamari at 2021-01-09T21:24:42-05:00 testsuite: Increase delay in conc059 As noted in #19179, conc059 can sometimes fail due to too short of a delay in the its Haskell threads. Address this by increasing the delay by an order of magnitude to 5 seconds. While I'm in town I refactored the test to eliminate a great deal of unnecessary platform dependence, eliminate use of the deprecated usleep, and properly handle interruption by signals. Fixes #19179. - - - - - 4d1ea2c3 by Nick Erdmann at 2021-01-09T21:25:19-05:00 Fix calls to varargs C function fcntl The ccall calling convention doesn't support varargs functions, so switch to capi instead. See https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/ffi.html#varargs-not-supported-by-ccall-calling-convention - - - - - a2567e99 by Oleg Grenrus at 2021-01-10T05:36:43-05:00 Correct more doctests - - - - - 4bb957de by John Ericson at 2021-01-10T05:37:19-05:00 Fix `not32Word#` -> `notWord32#` This is is correcting a mistake I unfortunately missed in !4698. But that is a recent PR so this fix is not a compatibility hazard with released versions of GHC. - - - - - 1a220bcf by Sebastian Graf at 2021-01-10T23:34:59-05:00 WorkWrap: Use SysLocal Name for Thunk Splitting (#19180) Since !4493 we annotate top-level bindings with demands, which leads to novel opportunities for thunk splitting absent top-level thunks. It turns out that thunk splitting wasn't quite equipped for that, because it re-used top-level, `External` Names for local helper Ids. That triggered a CoreLint error (#19180), reproducible with `T19180`. Fixed by adjusting the thunk splitting code to produce `SysLocal` names for the local bindings. Fixes #19180. Metric Decrease: T12227 T18282 - - - - - 2f933eb6 by Benjamin Maurer at 2021-01-10T23:35:35-05:00 Document flag -dasm-lint in debugging.rst - - - - - 0dba7841 by Benjamin Maurer at 2021-01-10T23:35:35-05:00 Update expected-undocumented-flags.txt - - - - - 9fa34289 by Hécate at 2021-01-13T19:21:40+01:00 Remove references to ApplicativeDo in the base haddocks - - - - - d930687a by Sylvain Henry at 2021-01-17T05:46:09-05:00 Show missing field types (#18869) - - - - - fe344da9 by Sylvain Henry at 2021-01-17T05:46:09-05:00 Missing fields: enhance error messages (#18869) This patch delays the detection of missing fields in record creation after type-checking. This gives us better error messages (see updated test outputs). - - - - - 23a545df by Sebastian Graf at 2021-01-17T05:46:45-05:00 PmCheck: Positive info doesn't imply there is an inhabitant (#18960) Consider `T18960`: ```hs pattern P :: a -> a pattern P x = x {-# COMPLETE P :: () #-} foo :: () foo = case () of P _ -> () ``` We know about the match variable of the case match that it is equal to `()`. After the match on `P`, we still know it's equal to `()` (positive info), but also that it can't be `P` (negative info). By the `COMPLETE` pragma, we know that implies that the refinement type of the match variable is empty after the `P` case. But in the PmCheck solver, we assumed that "has positive info" means "is not empty", thus assuming we could omit a costly inhabitation test. Which is wrong, as we saw above. A bit of a complication arises because the "has positive info" spared us from doing a lot of inhabitation tests in `T17836b`. So we keep that check, but give it a lower priority than the check for dirty variables that requires us doing an inhabitation test. Needless to say: This doesn't impact soundness of the checker at all, it just implements a better trade-off between efficiency and precision. Fixes #18960. Metric Decrease: T17836 - - - - - 9ab0f830 by Sebastian Graf at 2021-01-17T05:46:45-05:00 Accept (fixed) T14059b The `expect_broken` of `T14059b` expected outdated output. But #14059 has long been fixed, so we this commit accepts the new output and marks the test as unbroken. - - - - - 0ac5860e by Stefan Schulze Frielinghaus at 2021-01-17T05:47:24-05:00 CmmToLlvm: Sign/Zero extend parameters for foreign calls For some architectures the C calling convention is that any integer shorter than 64 bits is replaced by its 64 bits representation using sign or zero extension. Fixes #19023. - - - - - 66e281fb by Ben Gamari at 2021-01-17T05:48:01-05:00 rts/eventlog: Introduce event to demarcate new ticky sample - - - - - be3b6b57 by Ben Gamari at 2021-01-17T05:48:01-05:00 rts/eventlog: Reset ticky counters after dumping sample - - - - - 496bc4e8 by alexbiehl at 2021-01-17T05:48:39-05:00 Bump Haddock submodule Metric Decrease: haddock.base - - - - - 2facd1e9 by alexbiehl at 2021-01-17T05:48:39-05:00 Hadrian: Pass -jshakethreads to Haddock invocations - - - - - 971a88a7 by Hécate at 2021-01-17T05:49:17-05:00 Remove unused extension pragmas from the compiler code base - - - - - f395c2cb by Douglas Wilson at 2021-01-17T05:49:54-05:00 rts: gc: use mutex+condvar instead of sched_yield in gc main loop Here we remove the schedYield loop in scavenge_until_all_done+any_work, replacing it with a single mutex + condition variable. Previously any_work would check todo_large_objects, todo_q, todo_overflow of each gen for work. Comments explained that this was checking global work in any gen. However, these must have been out of date, because all of these locations are local to a gc thread. We've eliminated any_work entirely, instead simply looping back into scavenge_loop, which will quickly return if there is no work. shutdown_gc_threads is called slightly earlier than before. This ensures that n_gc_threads can never be observed to increase from 0 by a worker thread. startup_gc_threads is removed. It consisted of a single variable assignment, which is moved inline to it's single callsite. - - - - - f2d118c0 by Douglas Wilson at 2021-01-17T05:49:54-05:00 rts: remove no_work counter We are no longer busyish waiting, so this is no longer meaningful - - - - - 345ae06b by Douglas Wilson at 2021-01-17T05:49:54-05:00 rts: add max_n_todo_overflow internal counter I've never observed this counter taking a non-zero value, however I do think it's existence is justified by the comment in grab_local_todo_block. I've not added it to RTSStats in GHC.Stats, as it doesn't seem worth the api churn. - - - - - 33fc453f by Douglas Wilson at 2021-01-17T05:49:54-05:00 rts: add timedWaitCondition - - - - - d56fdad7 by Douglas Wilson at 2021-01-17T05:49:54-05:00 rts: gc: use mutex+condvar instead of spinlooks in gc entry/exit used timed wait on condition variable in waitForGcThreads fix dodgy timespec calculation - - - - - 3d3fd7d8 by Ben Gamari at 2021-01-17T05:50:31-05:00 rts/linker: Don't assume existence of dlinfo The native-code codepath uses dlinfo to identify memory regions owned by a loaded dynamic object, facilitating safe unload. Unfortunately, this interface is not always available. Add an autoconf check for it and introduce a safe fallback behavior. Fixes #19159. - - - - - 35cb5406 by Oleg Grenrus at 2021-01-17T05:51:10-05:00 Import fcntl with capi calling convention See https://gitlab.haskell.org/ghc/ghc/-/issues/18854 - - - - - 55a8f860 by Ben Gamari at 2021-01-17T05:51:46-05:00 base: Eliminate pinned allocations from IntTable This replaces the ForeignPtr used to track IntTable's pointer size with a single-entry mutable ByteArray#, eliminating the fragmentation noted in #19171. Fixes #19171. - - - - - 84dcb844 by Sylvain Henry at 2021-01-17T05:52:26-05:00 Revert "Remove SpecConstrAnnotation (#13681)" (#19168) This reverts commit 7bc3a65b467c4286377b9bded277d5a2f69160b3. NoSpecConstr is used in the wild (see #19168) - - - - - d159041b by Ben Gamari at 2021-01-17T05:53:02-05:00 rts: Initialize card table in newArray# Previously we would leave the card table of new arrays uninitialized. This wasn't a soundness issue: at worst we would end up doing unnecessary scavenging during GC, after which the card table would be reset. That being said, it seems worth initializing this properly to avoid both unnecessary work and non-determinism. Fixes #19143. - - - - - 66414bdf by Sylvain Henry at 2021-01-17T05:53:42-05:00 configure: fix the use of some obsolete macros (#19189) - - - - - 62cac31c by Krzysztof Gogolewski at 2021-01-17T05:54:19-05:00 Fix unsoundness for linear guards (#19120) - - - - - 907f1e4a by Oleg Grenrus at 2021-01-17T05:54:58-05:00 Third pass on doctest corrections. With `-K500K` rts option stack overflows are more deterministic - - - - - 6f9a817f by Sylvain Henry at 2021-01-17T05:55:37-05:00 Bignum: fix for Integer/Natural Ord instances * allow `integerCompare` to inline into `integerLe#`, etc. * use `naturalSubThrow` to implement Natural's `(-)` * use `naturalNegate` to implement Natural's `negate` * implement and use `integerToNaturalThrow` to implement Natural's `fromInteger` Thanks to @christiaanb for reporting these - - - - - 5ae73f69 by Sylvain Henry at 2021-01-17T05:56:17-05:00 Add regression test for #16577 - - - - - d2b10eac by Moritz Angermann at 2021-01-17T05:56:56-05:00 Bump gmp submodule, now with arm64 support - - - - - e516ef7e by Sylvain Henry at 2021-01-17T05:57:35-05:00 Hadrian: fix flavour parser Hadrian was silently using the "quick" flavour when "quick-debug" or "quick-validate" was used. This patch fixes the parser and ensures that the whole input is consumed. - - - - - 2ac28e4c by Simon Peyton Jones at 2021-01-17T05:58:12-05:00 Use captureTopConstraints at top level Missing this caused #19197. Easily fixed. - - - - - 98e0d08f by Ben Gamari at 2021-01-17T05:58:48-05:00 hadrian: Introduce no_profiled_libs flavour transformer Per request of @AndreasK. - - - - - b1cafb82 by Hécate at 2021-01-17T05:59:26-05:00 Add some additional information to the fail message based on exit code - - - - - 29c9eb3f by Oleg Grenrus at 2021-01-18T07:19:34-05:00 Add Eq1, Show1, Read1 Complex instances - - - - - 5c312e23 by Oleg Grenrus at 2021-01-18T07:19:34-05:00 Add lifted instances for 3 and 4 tuples - - - - - 5f1d8be0 by Oleg Grenrus at 2021-01-18T07:19:34-05:00 Add examples for Complex, (,,) and (,,,) Eq2 etc instances - - - - - 9cc50a0f by Hécate at 2021-01-18T07:20:12-05:00 Rectify Haddock typos for the Functor class - - - - - 6cfdca9f by Cheng Shao at 2021-01-19T12:52:57+00:00 Correct documentation in System.Mem.Weak [ci skip] Since #13167 is closed, exceptions thrown in finalizers are ignored and doesn't affect other finalizers in the same batch. This MR updates the documentation in System.Mem.Weak to reflect that. - - - - - 1ff61314 by Sylvain Henry at 2021-01-22T14:57:36-05:00 Fix wrong comment about UnitState [CI skip] - - - - - 092f0532 by Andreas Klebinger at 2021-01-22T14:58:14-05:00 When deriving Eq always use tag based comparisons for nullary constructors Instead of producing auxiliary con2tag bindings we now rely on dataToTag#, eliminating a fair bit of generated code. Co-Authored-By: Ben Gamari <ben at well-typed.com> - - - - - 2ed96c68 by Ben Gamari at 2021-01-22T14:58:14-05:00 Use pointer tag in dataToTag# While looking at !2873 I noticed that dataToTag# previously didn't look at a pointer's tag to determine its constructor. To be fair, there is a bit of a trade-off here: using the pointer tag requires a bit more code and another branch. On the other hand, it allows us to eliminate looking at the info table in many cases (especially now since we tag large constructor families; see #14373). - - - - - b4b2be61 by Ben Gamari at 2021-01-22T14:58:14-05:00 dataToTag#: Avoid unnecessary entry When the pointer is already tagged we can avoid entering the closure. - - - - - 01ea56a2 by Sylvain Henry at 2021-01-22T14:58:53-05:00 Arrows: collect evidence binders Evidence binders were not collected by GHC.HsToCore.Arrows.collectStmtBinders, hence bindings for dictionaries were not taken into account while computing local variables in statements. As a consequence we had a transformation similar to this: data Point a where Point :: RealFloat a => a -> Point a do p -< ... returnA -< ... (Point 0) ===> { Type-checking } do let $dRealFloat_xyz = GHC.Float.$fRealFloatFloat p -< ... returnA -< ... (Point $dRealFloat_xyz 0) ===> { Arrows HsToCore } first ... >>> arr (\(p, ()) -> case p of ... -> let $dRealFloat_xyz = GHC.Float.$fRealFloatFloat in case .. of () -> ()) >>> \((),()) -> ... (Point $dRealFloat_xyz 0) -- dictionary not in scope Now evidences are passed in the environment if necessary and we get: ===> { Arrows HsToCore } first ... >>> arr (\(p, ()) -> case p of ... -> let $dRealFloat_xyz = GHC.Float.$fRealFloatFloat in case .. of () -> $dRealFloat_xyz) >>> \(ds,()) -> let $dRealFloat_xyz = ds in ... (Point $dRealFloat_xyz 0) -- dictionary in scope Note that collectStmtBinders has been copy-pasted from GHC.Hs.Utils. This ought to be factorized but Note [Dictionary binders in ConPatOut] claims that: Do *not* gather (a) dictionary and (b) dictionary bindings as binders of a ConPatOut pattern. For most calls it doesn't matter, because it's pre-typechecker and there are no ConPatOuts. But it does matter more in the desugarer; for example, GHC.HsToCore.Utils.mkSelectorBinds uses collectPatBinders. In a lazy pattern, for example f ~(C x y) = ..., we want to generate bindings for x,y but not for dictionaries bound by C. (The type checker ensures they would not be used.) Desugaring of arrow case expressions needs these bindings (see GHC.HsToCore.Arrows and arrowcase1), but SPJ (Jan 2007) says it's safer for it to use its own pat-binder-collector: Accordingly to the last sentence, this patch doesn't make any attempt at factorizing both codes. Fix #18950 - - - - - 29173f88 by Sylvain Henry at 2021-01-22T14:58:53-05:00 Factorize and document binder collect functions Parameterize collect*Binders functions with a flag indicating if evidence binders should be collected. The related note in GHC.Hs.Utils has been updated. Bump haddock submodule - - - - - a255b4e3 by Matthew Pickering at 2021-01-22T14:59:30-05:00 ghc-heap: Allow more control about decoding CCS fields We have to be careful not to decode too much, too eagerly, as in ghc-debug this will lead to references to memory locations outside of the currently copied closure. Fixes #19038 - - - - - 34950fb8 by Simon Peyton Jones at 2021-01-22T15:00:07-05:00 Fix error recovery in solveEqualities As #19142 showed, with -fdefer-type-errors we were allowing compilation to proceed despite a fatal kind error. This patch fixes it, as described in the new note in GHC.Tc.Solver, Note [Wrapping failing kind equalities] Also fixes #19158 Also when checking default( ty1, ty2, ... ) only consider a possible default (C ty2) if ty2 is kind-compatible with C. Previously we could form kind-incompatible constraints, with who knows what kind of chaos resulting. (Actually, no chaos results, but that's only by accident. It's plain wrong to form the constraint (Num Either) for example.) I just happened to notice this during fixing #19142. - - - - - a64f21e9 by Alfredo Di Napoli at 2021-01-22T15:00:47-05:00 Parameterise Messages over e This commit paves the way to a richer and more structured representation of GHC error messages, as per GHC proposal #306. More specifically 'Messages' from 'GHC.Types.Error' now gains an extra type parameter, that we instantiate to 'ErrDoc' for now. Later, this will allow us to replace ErrDoc with something more structure (for example messages coming from the parser, the typechecker etc). - - - - - c36a4f63 by Alfredo Di Napoli at 2021-01-22T15:00:47-05:00 Fix tests relying on same-line diagnostic ordering This commit fixes 19 tests which were failing due to the use of `consBag` / `snocBag`, which have been now replaced by `addMessage`. This means that now GHC would output things in different order but only for /diagnostics on the same line/, so this is just reflecting that. The "normal" order of messages is still guaranteed. - - - - - 2267d42a by John Ericson at 2021-01-22T15:01:24-05:00 Add 32-bit ops to T file I forgot to add before - - - - - 22d01924 by John Ericson at 2021-01-22T15:01:24-05:00 C-- shift amount is always native size, not shiftee size This isn't a bug yet, because we only shift native-sized types, but I hope to change that. - - - - - faf164db by John Ericson at 2021-01-22T15:01:25-05:00 Cleanup primop constant folding rules in a few ways - `leftZero`, `rightZero` and `zeroElem` could all be written using `isZeroLit` - "modulo 1" rules could be written with `nonOneLit 1 $> Lit zero<type>` All are due to @hsyl20; thanks! - - - - - 0eaf63b6 by John Ericson at 2021-01-22T15:01:25-05:00 Add missing fixed-sized primops and constant folding - `inversePrimOp` is renamed to `semiInversePrimOp` to indicate the given primop is only a right inverse, not left inverse (and contra-wise for the primop which we are giving rules for). This explains why are new usage is not incorrect. - The removed `subsumedByPrimOp` calls were actually dead as the match on ill-typed code. @hsyl20 pointed this out in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4390#note_311912, Metric Decrease: T13701 - - - - - 6fbfde95 by John Ericson at 2021-01-22T15:01:25-05:00 Test constant folding for sized types - - - - - 887eb6ec by Sylvain Henry at 2021-01-22T15:02:05-05:00 Enhance Data instance generation Use `mkConstrTag` to explicitly pass the constructor tag instead of using `mkConstr` which queries the tag at runtime by querying the index of the constructor name (a string) in the list of constructor names. Perf improvement: T16577(normal) ghc/alloc 11325573876.0 9249786992.0 -18.3% GOOD Thanks to @sgraf812 for suggesting an additional list fusion fix during reviews. Metric Decrease: T16577 - - - - - 957b5376 by Sylvain Henry at 2021-01-22T15:02:45-05:00 Core: introduce Alt/AnnAlt/IfaceAlt datatypes Alt, AnnAlt and IfaceAlt were using triples. This patch makes them use dedicated types so that we can try to make some fields strict (for example) in the future. - - - - - db16302c by Sylvain Henry at 2021-01-22T15:03:25-05:00 LLVM: fix sized shift primops (#19215) Ensure that shift amount parameter has the same type as the parameter to shift. - - - - - fcbf21aa by Ben Gamari at 2021-01-22T15:04:02-05:00 gitlab-ci: Fix perf metric pushing Previously we would inexplicably append the key to id_rsa. Fixes #19225. - - - - - 4bb9a349 by Oleg Grenrus at 2021-01-22T15:04:42-05:00 Change replicateM doctest example - - - - - 637ae302 by Stefan Schulze Frielinghaus at 2021-01-22T15:05:21-05:00 CmmToC: Fix translation of Cmm literals to word sized literals For big-endian machines remove the byte swap in the non-recursive call of goSubWord since the integer is already in proper format. - - - - - 532337cb by Cheng Shao at 2021-01-22T15:06:00-05:00 Optimize some rts_mk/rts_get functions in RtsAPI.c - All rts_mk functions return the tagged closure address - rts_mkChar/rts_mkInt avoid allocation when the argument is within the CHARLIKE/INTLIKE range - rts_getBool avoids a memory load by checking the closure tag - In rts_mkInt64/rts_mkWord64, allocated closure payload size is either 1 or 2 words depending on target architecture word size - - - - - 13d876ba by Sylvain Henry at 2021-01-22T15:06:39-05:00 Enhance nested TransCo pretty-printing Nested TransCo were printed with a lot of indentation, e.g.: `cast` (Sub (Sym (Foo.D:R:Index[0] <Bool>_N <'[]>_N)) ; ((Index (Sym (SubDef (<1>_N, <1>_N))) <'[Bool]>_N)_R ; ... With this patch we print them as follows: `cast` (Sub (Sym (Foo.D:R:Index[0] <Bool>_N <'[]>_N)) ; (Index (Sym (SubDef (<1>_N, <1>_N))) <'[Bool]>_N)_R ; Sub (Sym (Foo.D:R:Index[1] <1>_N <Int>_N <'[Bool]>_N)) ; (Index (Sym (SubDef (<2>_N, <1>_N))) <'[Int, Bool]>_N)_R - - - - - 5836efd7 by Andreas Klebinger at 2021-01-22T15:07:16-05:00 Force inlining of deRefStablePtr to silence warnings - - - - - 7b6bb480 by Andreas Klebinger at 2021-01-22T15:07:53-05:00 Make DmdAnalOpts a newtype - - - - - 420ef55a by Cheng Shao at 2021-01-22T15:08:33-05:00 Remove legacy comment in validate script The validate flavour is already defined and used in hadrian, so this legacy comment should be removed. - - - - - 8fd855f0 by Richard Eisenberg at 2021-01-23T15:29:58-05:00 Make matchableGivens more reliably correct. This has two fixes: 1. Take TyVarTvs into account in matchableGivens. This fixes #19106. 2. Don't allow unifying alpha ~ Maybe alpha. This fixes #19107. This patch also removes a redundant Note and redirects references to a better replacement. Also some refactoring/improvements around the BindFun in the pure unifier, which now can take the RHS type into account. Close #19106. Close #19107. Test case: partial-sigs/should_compile/T19106, typecheck/should_compile/T19107 - - - - - 8f610e52 by Koz Ross at 2021-01-23T15:30:37-05:00 Implement #15993 - - - - - 28ef8a8a by Koz Ross at 2021-01-23T15:30:37-05:00 Add @since annotations for And, Ior, Xor, Iff type class instances - - - - - 1a3f3247 by Koz Ross at 2021-01-23T15:30:37-05:00 Add headers for Data.Bits documentation - - - - - 97208613 by Koz Ross at 2021-01-23T15:30:37-05:00 FiniteBits for some newtype instances, notes on why - - - - - 773e2828 by Sylvain Henry at 2021-01-23T15:31:20-05:00 Bignum: add Natural constant folding rules (#15821) * Implement constant folding rules for Natural (similar to Integer ones) * Add mkCoreUbxSum helper in GHC.Core.Make * Remove naturalTo/FromInt We now only provide `naturalTo/FromWord` as the semantics is clear (truncate/zero-extend). For Int we have to deal with negative numbers (throw an exception? convert to Word beforehand?) so we leave the decision about what to do to the caller. Moreover, now that we have sized types (Int8#, Int16#, ..., Word8#, etc.) there is no reason to bless `Int#` more than `Int8#` or `Word8#` (for example). * Replaced a few `()` with `(# #)` - - - - - e6e1cf74 by Cheng Shao at 2021-01-23T21:32:43-05:00 Add _validatebuild to .gitignore [ci skip] - - - - - 81f06655 by John Ericson at 2021-01-23T21:32:47-05:00 Separate AST from GhcPass (#18936) ---------------- What: There are two splits. The first spit is: - `Language.Haskell.Syntax.Extension` - `GHC.Hs.Extension` where the former now just contains helpers like `NoExtCon` and all the families, and the latter is everything having to do with `GhcPass`. The second split is: - `Language.Haskell.Syntax.<mod>` - `GHC.Hs.<mod>` Where the former contains all the data definitions, and the few helpers that don't use `GhcPass`, and the latter contains everything else. The second modules also reexport the former. ---------------- Why: See the issue for more details, but in short answer is we're trying to grasp at the modularity TTG is supposed to offer, after a long time of mainly just getting the safety benefits of more complete pattern matching on the AST. Now, we have an AST datatype which, without `GhcPass` is decently stripped of GHC-specific concerns. Whereas before, not was it GHC-specific, it was aware of all the GHC phases despite the parameterization, with the instances and parametric data structure side-by-side. For what it's worth there are also some smaller, imminent benefits: - The latter change also splits a strongly connected component in two, since none of the `Language.Haskell.Syntax.*` modules import the older ones. - A few TTG violations (Using GhcPass directly in the AST) in `Expr` are now more explicitly accounted for with new type families to provide the necessary indirection. ----------------- Future work: - I don't see why all the type families should live in `Language.Haskell.Syntax.Extension`. That seems anti-modular for little benefit. All the ones used just once can be moved next to the AST type they serve as an extension point for. - Decide what to do with the `Outputable` instances. Some of these are no orphans because they referred to `GhcPass`, and had to be moved. I think the types could be generalized so they don't refer to `GhcPass` and therefore can be moved back, but having gotten flak for increasing the size and complexity types when generalizing before, I did *not* want to do this. - We should triage the remaining contents of `GHC.Hs.<mod>`. The renaming helpers are somewhat odd for needing `GhcPass`. We might consider if they are a) in fact only needed by one phase b) can be generalized to be non-GhcPass-specific (e.g. take a callback rather than GADT-match with `IsPass`) and then they can live in `Language.Haskell.Syntax.<mod>`. For more details, see https://gitlab.haskell.org/ghc/ghc/-/wikis/implementing-trees-that-grow Bumps Haddock submodule - - - - - 8ec6d62a by John Ericson at 2021-01-23T21:32:47-05:00 Track the dependencies of `GHC.Hs.Expr.Types` Thery is still, in my view, far too numerous, but I believe this won't be too hard to improve upon. At the very lease, we can always add more extension points! - - - - - b18d9e97 by Sebastian Graf at 2021-01-23T21:32:47-05:00 CoreToStg.Prep: Speculative evaluation >From `Note [Speculative evaluation]`: Since call-by-value is much cheaper than call-by-need, we case-bind arguments that are either 1. Strictly evaluated anyway, according to the StrictSig of the callee, or 2. ok-for-spec, according to 'exprOkForSpeculation' While (1) is a no-brainer and always beneficial, (2) is a bit more subtle, as the careful haddock for 'exprOkForSpeculation' points out. Still, by case-binding the argument we don't need to allocate a thunk for it, whose closure must be retained as long as the callee might evaluate it. And if it is evaluated on most code paths anyway, we get to turn the unknown eval in the callee into a known call at the call site. NoFib Results: ``` -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- ansi -9.4% -10.4% maillist -0.1% -0.1% paraffins -0.7% -0.5% scc -0.0% +0.1% treejoin -0.0% -0.1% -------------------------------------------------------------------------------- Min -9.4% -10.4% Max 0.0% +0.1% Geometric Mean -0.1% -0.1% ``` Fixes #19224. - - - - - 083d7aeb by Duncan Coutts at 2021-01-25T05:11:14-05:00 Move win32/IOManager to win32/MIOManager It is only for MIO, and we want to use the generic name IOManager for the name of the common parts of the interface and dispatch. - - - - - 8bdbfdd8 by Duncan Coutts at 2021-01-25T05:11:14-05:00 Rename includes/rts/IOManager.h to IOInterface.h Naming is hard. Where we want to get to is to have a clear internal and external API for the IO manager within the RTS. What we have right now is just the external API (used in base for the Haskell side of the threaded IO manager impls) living in includes/rts/IOManager.h. We want to add a clear RTS internal API, which really ought to live in rts/IOManager.h. Several people think it's too confusing to have both: * includes/rts/IOManager.h for the external API * rts/IOManager.h for the internal API So the plan is to add rts/IOManager.{h,c} as the internal parts, and rename the external part to be includes/rts/IOInterface.h. It is admittidly not great to have .h files in includes/rts/ called "interface" since by definition, every .h fle under includes/ is an interface! Alternative naming scheme suggestions welcome! - - - - - 54946e4f by Duncan Coutts at 2021-01-25T05:11:14-05:00 Start to centralise the I/O manager hooks from other bits of the RTS It is currently rather difficult to understand or work with the various I/O manager implementations. This is for a few reasons: 1. They do not have a clear or common API. There are some common function names, but a lot of things just get called directly. 2. They have hooks into many other parts of the RTS where they get called from. 3. There is a _lot_ of CPP involved, both THREADED_RTS vs !THREADED_RTS and also mingw32_HOST_OS vs !mingw32_HOST_OS. This doesn't really identify the I/O manager implementation. 4. They have data structures with unclear ownership, or that are co-owned with other components like the scheduler. Some data structures are used by multiple I/O managers. One thing that would help is if the interface between the I/O managers and the rest of the RTS was clearer, even if it was not completely uniform. Centralising it would make it easier to see how to reduce any unnecessary diversity in the interfaces. This patch makes a start by creating a new IOManager.{h,c} module. It is initially empty, but we will move things into it in subsequent patches. - - - - - 455ad48b by Duncan Coutts at 2021-01-25T05:11:14-05:00 Move setIOManagerControlFd from Capability.c to IOManager.c This is a better home for it. It is not really an aspect of capabilities. It is specific to one of the I/O manager impls. - - - - - e93384e8 by Duncan Coutts at 2021-01-25T05:11:14-05:00 Move ioManager{Start,Wakeup,Die} to internal IOManager.h Move them from the external IOInterface.h to the internal IOManager.h. The functions are all in fact internal. They are not used from the base library at all. Remove ioManagerWakeup as an exported symbol. It is not used elsewhere. - - - - - 4ad726fc by Duncan Coutts at 2021-01-25T05:11:14-05:00 Move hooks for I/O manager startup / shutdown into IOManager.{c,h} - - - - - d345d3be by Duncan Coutts at 2021-01-25T05:11:14-05:00 Replace a direct call to ioManagerStartCap with a new hook Replace a direct call to ioManagerStartCap in the forkProcess in Schedule.c with a new hook initIOManagerAfterFork in IOManager. This replaces a direct hook in the scheduler from the a single I/O manager impl (the threaded unix one) with a generic hook. Add some commentrary on opportunities for future rationalisation. - - - - - 9a7d19ba by Duncan Coutts at 2021-01-25T05:11:14-05:00 Replace a ioManagerDie call with stopIOManager The latter is the proper hook defined in IOManager.h. The former is part of a specific I/O manager implementation (the threaded unix one). - - - - - e3564e38 by Duncan Coutts at 2021-01-25T05:11:14-05:00 Add a common wakeupIOManager hook Use in the scheduler in threaded mode. Replaces the direct call to ioManagerWakeup which are part of specific I/O manager implementations. - - - - - 34a8a0e4 by Duncan Coutts at 2021-01-25T05:11:14-05:00 Remove ioManager{Start,Die,Wakeup} from IOManager.h They are not part of the IOManager interface used within the rest of the RTS. They are the part of the interface of specific I/O manager implementations. They are no longer called directly elsewhere in the RTS, and are now only called by the dispatch functions in IOManager.c - - - - - 92573883 by Matthew Pickering at 2021-01-27T17:38:32-05:00 Deprecate -h flag It is confusing that it defaults to two different things depending on whether we are in the profiling way or not. Use -hc if you have a profiling build Use -hT if you have a normal build Fixes #19031 - - - - - 93ae0e2a by Aaron Allen at 2021-01-27T17:39:11-05:00 Add additional context to :doc output (#19055) With this change, the type/kind of an object as well as it's category and definition site are added to the output of the :doc command for each object matching the argument string. - - - - - 5d6009a8 by Ben Gamari at 2021-01-27T17:39:49-05:00 Add instances for GHC.Tuple.Solo The `Applicative` instance is the most important one (for array/vector/sequence indexing purposes), but it deserves all the usual ones. T12545 does silly 1% wibbles both ways, it seems, maybe depending on architecture. Metric Increase: T12545 Metric Decrease: T12545 - - - - - 08fba093 by Hécate at 2021-01-27T17:40:32-05:00 Remove -XMonadFailDesugaring references - - - - - e71ed07d by Hécate at 2021-01-27T17:40:32-05:00 Add a section about failable patterns in the GHC user's guide - - - - - 2f689a8b by Adam Gundry at 2021-01-27T17:41:08-05:00 Add regression test for #11228 - - - - - 189efc39 by Richard Eisenberg at 2021-01-27T17:41:44-05:00 Remove some redundant validity checks. This commit also consolidates documentation in the user manual around UndecidableSuperClasses, UndecidableInstances, and FlexibleContexts. Close #19186. Close #19187. Test case: typecheck/should_compile/T19186, typecheck/should_fail/T19187{,a} - - - - - 614cb069 by Sebastian Graf at 2021-01-27T17:42:21-05:00 hadrian: Fix `lookupInPath` on Windows (#19249) By querying the PATH variable explicitly via `getSearchPath`, we can work around the special behavior of `findExecutable` on Windows, where it also searches in System32. Fixes #19249. - - - - - 9c87f97e by Sylvain Henry at 2021-01-27T17:43:05-05:00 Fix spurious failures of T16916 on CI (#16966) * disable idle GC which has a big impact on time measures * use average measures (before and after event registration) * use warmup measures (for some reason the first measure of a batch seems to be often quite different from the others) * drop the division by monotonic clock time: this clock is impacted by the load of the runner. We only want to measure the time spent in the RTS while the mutator is idle so I don't understand why it was used. - - - - - 831ba0fb by Oleg Grenrus at 2021-01-27T17:43:49-05:00 Fix doctest examples in Data.Bits - - - - - 0da1f19e by Cheng Shao at 2021-01-27T17:44:27-05:00 Respect $AR in configure script Previously, the configure script doesn't respect $AR. This causes the nixpkgs GHC to capture "ar" instead of the absolute nix store path of ar in the global config. The original patch comes from https://github.com/input-output-hk/haskell.nix/blob/master/overlays/patches/ghc/respect-ar-path.patch. - - - - - 7b0b133d by Koz Ross at 2021-01-27T17:45:06-05:00 Implement #18519 - - - - - 644e80fe by Andreas Klebinger at 2021-01-28T14:36:48-05:00 rts: sm/GC.c: make num_idle unsigned We compare it to n_gc_idle_threads which is unsigned as well. So make both signed to avoid a warning. - - - - - b5d0a136 by Andreas Klebinger at 2021-01-28T14:36:48-05:00 Use validate flavour for all CI builds. This also means we compile GHC with -O1 instead of -O2 for some platforms for CI. As a result a lot of test metrics got worse which we now have to accept. ------------------------- Metric Increase: ManyAlternatives ManyConstructors MultiLayerModules Naperian T10421 T12150 T12227 T12234 T12425 T12545 T12707 T13035 T13253 T13253-spj T13701 T13379 T13719 T14697 T16577 T18282 T18698a T18698b T1969 T3064 T3294 T4801 T5205 T5321FD T5321Fun T5631 T6048 T783 T9020 T9203 T9233 T9630 T9872a T9872b T9872c T9872d T9961 haddock.Cabal haddock.base haddock.compiler parsing001 T5642 WWRec T14683 T15164 T18304 T18923 ------------------------- - - - - - b3b4d3c1 by Andreas Klebinger at 2021-01-28T14:37:25-05:00 SimplM: Create uniques via IO instead of threading - - - - - 2e44165f by Matthew Pickering at 2021-01-28T14:38:02-05:00 Reduce default test verbosity - - - - - 38adba6b by Joachim Breitner at 2021-01-28T14:38:39-05:00 Bump haddock submodule to get this commit: commit 0952d94a2e30a3e7cddbede811b15fa70f7b9462 (HEAD) Author: Joachim Breitner <mail at joachim-breitner.de> Date: Tue Jan 19 11:39:38 2021 +0100 Make haddock more robust to changes to the `Language` data type With the introduction of GHC2021, the `Languages` data type in GHC will grow. In preparation of that (and to avoid changing haddock with each new language), this change makes the code handle extensions to that data type gracefully. (cherry picked from commit c341dd7c9c3fc5ebc83a2d577c5a726f3eb152a5) This can go in as preparation for !4853 - - - - - 20fbb7c6 by Denis Frezzato at 2021-01-28T14:39:17-05:00 Fix code formatting in `HasCallStack` section - - - - - 0249974e by Sylvain Henry at 2021-01-28T14:39:59-05:00 Fix strictness in TyCo.Tidy (#14738) Metric Decrease: T12545 T14683 T16577 T5321Fun T5642 - - - - - 7105cda8 by Ben Gamari at 2021-01-29T04:01:52-05:00 typecheck: Account for -XStrict in irrefutability check When -XStrict is enabled the rules for irrefutability are slightly modified. Specifically, the pattern in a program like do ~(Just hi) <- expr cannot be considered irrefutable. The ~ here merely disables the bang that -XStrict would usually apply, rendering the program equivalent to the following without -XStrict do Just hi <- expr To achieve make this pattern irrefutable with -XStrict the user would rather need to write do ~(~(Just hi)) <- expr Failing to account for this resulted in #19027. To fix this isIrrefutableHsPat takes care to check for two the irrefutability of the inner pattern when it encounters a LazyPat and -XStrict is enabled. - - - - - 37378a0b by Leif Metcalf at 2021-01-29T04:02:41-05:00 Remove StgLam StgLam is used exclusively in the work of CoreToStg, but there's nothing in the type of StgExpr that indicates this, so we're forced throughout the Stg.* codebase to handle cases like: case expr of ... StgLam lam -> panic "Unexpected StgLam" ... This patch removes the StgLam constructor from the base StgExpr so these cases no longer need to be handled. Instead, we use a new intermediate type in CoreToStg, PreStgRhs, to represent the RHS expression of a binding. - - - - - 6fc92084 by Oleg Grenrus at 2021-01-29T04:03:22-05:00 Add explicit import lists to Data.List imports Related to a future change in Data.List, https://downloads.haskell.org/ghc/8.10.3/docs/html/users_guide/using-warnings.html?highlight=wcompat#ghc-flag--Wcompat-unqualified-imports Companion pull&merge requests: - https://github.com/judah/haskeline/pull/153 - https://github.com/haskell/containers/pull/762 - https://gitlab.haskell.org/ghc/packages/hpc/-/merge_requests/9 After these the actual change in Data.List should be easy to do. - - - - - 18e106a8 by Sylvain Henry at 2021-01-29T04:04:12-05:00 Add missing .hi-boot dependencies with ghc -M (#14482) - - - - - 75accd54 by Leif Metcalf at 2021-01-29T04:04:48-05:00 Warn about using quick with profiling - - - - - ae8379ab by Sylvain Henry at 2021-01-29T04:05:27-05:00 Ppr: compute length of string literals at compile time (#19266) SDoc string literals created for example with `text "xyz"` are converted into `PtrString` (`Addr#` + size in bytes) with a rewrite rule to avoid allocating a String. Before this patch, the size in bytes was still computed at runtime. For every literal, we obtained the following pseudo STG: x :: Addr# x = "xzy"# s :: PtrString s = \u [] case ffi:strlen [x realWorld#] of (# _, sz #) -> PtrString [x sz] But since GHC 9.0, we can use `cstringLength#` instead to get: x :: Addr# x = "xzy"# s :: PtrString s = PtrString! [x 3#] Literals become statically known constructor applications. Allocations seem to decrease a little in perf tests (between -0.1% and -0.7% on CI). - - - - - 5140841c by Krzysztof Gogolewski at 2021-01-29T04:06:03-05:00 Fix check-uniques script It was checking the old path compiler/prelude/*, outdated with the new module hierarchy. I added a sanity check to avoid this in the future. - - - - - 3b823533 by Simon Peyton Jones at 2021-01-29T23:09:58-05:00 Make PatSyn immutable Provoked by #19074, this patch makes GHC.Core.PatSyn.PatSyn immutable, by recording only the *Name* of the matcher and builder rather than (as currently) the *Id*. See Note [Keep Ids out of PatSyn] in GHC.Core.PatSyn. Updates haddock submodule. - - - - - bd0b2726 by Krzysztof Gogolewski at 2021-01-29T23:10:35-05:00 Fix parsing of -fstg-lift-lams-non-rec -fstg-lift-lams-rec-* and -fstg-lift-lams-non-rec-* were setting the same field. Fix manual: -fstg-lift-lams-non-rec-args is disabled by -fstg-lift-lams-non-rec-args-any, there's no -fno-stg-lift-*. - - - - - f5d62eb2 by Ben Gamari at 2021-01-30T14:11:48-05:00 ghci: Take editor from VISUAL environment variable Following the example of `git`, as noted in #19030. Fixes #19030. - - - - - 621d8cf7 by Ben Gamari at 2021-01-30T14:12:24-05:00 configure: Break up AC_CONFIG_FILES list - - - - - 55ef3bdc by Ben Gamari at 2021-01-30T14:12:24-05:00 hadrian: Introduce ghci-wrapper package This wraps the existing GHCi wrapper script (driver/ghci/ghci.c) in a cabal file and adds the package to Hadrian. - - - - - 73fa75f5 by GHC GitLab CI at 2021-01-30T14:12:24-05:00 compare-flags: Strip whitespace from flags read from --show-options Otherwise we end up with terminating \r characters on Windows. - - - - - 69cab37a by Simon Peyton Jones at 2021-01-30T14:13:00-05:00 Zonk the returned kind in tcFamTyPats The motivation is given in Note [tcFamTyPats: zonking the result kind]. Fixes #19250 -- the fix is easy. - - - - - a3d995fa by Sylvain Henry at 2021-01-30T14:13:41-05:00 Fix -dynamic-too with wired-in modules (#19264) See T19264 for a tricky corner case when explicitly importing GHC.Num.BigNat and another module. With -dynamic-too, the FinderCache contains paths for non-dynamic interfaces so they must be loaded first, which is usually the case, except for some interfaces loaded in the backend (e.g. in CorePrep). So we must run the backend for the non-dynamic way first for -dynamic-too to work as it is but I broke this invariant in c85f4928d4dbb2eb2cf906d08bfe7620d6f04ca5 by mistakenly making the backend run for the dynamic way first. - - - - - eb90d239 by Benjamin Maurer at 2021-01-30T14:14:17-05:00 Fix description of -fregs-graph (not implied by -O2, linked issue was closed) - - - - - 14c4f701 by Krzysztof Gogolewski at 2021-01-30T21:11:21+01:00 Documentation fixes - Add missing :since: for NondecreasingIndentation and OverlappingInstances - Remove duplicated descriptions for Safe Haskell flags and UndecidableInstances. Instead, the sections contain a link. - compare-flags: Also check for options supported by ghci. This uncovered two more that are not documented. The flag -smp was removed. - Formatting fixes - Remove the warning about -XNoImplicitPrelude - it was written in 1996, the extension is no longer dangerous. - Fix misspelled :reverse: flags Fixes #18958. - - - - - d4bcd37f by Ryan Scott at 2021-02-01T03:12:07-05:00 Fix accidental unsoundness in Data.Typeable.Internal.mkTypeLitFromString An accidental use of `tcSymbol` instead of `tcNat` in the `TypeLitNat` case of `mkTypeLitFromString` meant that it was possible to unsafely equate `Nat` with `Symbol`. A consequence of this is that you could write `unsafeCoerce`, as observed in #19288. This is fixed easily enough, thankfully. Fixes #19288. - - - - - 5464845a by Ryan Scott at 2021-02-01T14:05:31-05:00 Add driver/ghci/ghci-wrapper.cabal to .gitignore After commit 55ef3bdc28681a22ceccf207707c49229f9b7559, running `./configure` now generates a `driver/ghci/ghci-wrapper.cabal` file from `driver/ghci/ghci-wrapper.cabal.in`, which pollutes the `git` tree: ``` $ git status On branch master Your branch is up to date with 'origin/master'. Untracked files: (use "git add <file>..." to include in what will be committed) driver/ghci/ghci-wrapper.cabal nothing added to commit but untracked files present (use "git add" to track) ``` Since `driver/ghci/ghci-wrapper.cabal` is autogenerated, the sensible thing to do is to add it to `.gitignore`. While I was in town, I also added the standard `*.in` file disclaimer to `driver/ghci/ghci-wrapper.cabal.in`. [ci skip] - - - - - ddc2a759 by Alfredo Di Napoli at 2021-02-01T14:06:11-05:00 Remove ErrDoc and MsgDoc This commit boldly removes the ErrDoc and the MsgDoc from the codebase. The former was introduced with the only purpose of classifying errors according to their importance, but a similar result can be obtained just by having a simple [SDoc], and placing bullets after each of them. On top of that I have taken the perhaps controversial decision to also banish MsgDoc, as it was merely a type alias over an SDoc and as such it wasn't offering any extra type safety. Granted, it was perhaps making type signatures slightly more "focused", but at the expense of cognitive burden: if it's really just an SDoc, let's call it with its proper name. - - - - - b1a17507 by Alfredo Di Napoli at 2021-02-01T14:06:11-05:00 Rename ErrMsg into MsgEnvelope Updates Haddock submodule - - - - - c0709c1d by Alfredo Di Napoli at 2021-02-01T14:06:11-05:00 Introduce the DecoratedSDoc type This commit introduces a DecoratedSDoc type which replaces the old ErrDoc, and hopefully better reflects the intent. - - - - - 7d910fd8 by Ben Gamari at 2021-02-02T12:24:11-05:00 typecheck: Eliminate allocations in tc_eq_type Previously tc_eq_type would allocate a number of closures due to the two boolean "mode" flags, despite the fact that these were always statically known. To avoid this we force tc_eq_type to inline into its call sites, allowing the simplifier to eliminate both some runtime branches and the closure allocations. - - - - - ddbdec41 by Matthew Pickering at 2021-02-02T12:24:47-05:00 Add missing instances to ghc-heap types These instances are useful so that a `GenClosure` form `ghc-heap` can be used as a key in a `Map`. Therefore the order itself is not important but just the fact that there is one. - - - - - 6085cfb5 by wygulmage at 2021-02-05T19:08:50-05:00 Remove misleading 'lazy' pattern matches from 'head' and 'tail' in Data.List.NonEmpty - - - - - a5a5c7e0 by Ben Gamari at 2021-02-05T19:09:27-05:00 CallArity: Various comment fixes - - - - - 441724e3 by Ben Gamari at 2021-02-05T19:09:27-05:00 UnVarGraph: Use foldl' rather than foldr in unionUnVarSets This is avoids pushing the entire list to the stack before we can begin computing the result. - - - - - c7922ced by Matthew Pickering at 2021-02-05T19:10:04-05:00 Hadrian: Add support for packages with C++ files - - - - - c5ace760 by Andreas Klebinger at 2021-02-05T19:10:41-05:00 Try eta expanding FCode (See #18202) Also updates the note with the case of multi-argument lambdas. Seems slightly beneficial based on the Cabal test: -O0: -1MB allocations (out of 50GB) -O : -1MB allocations (out of ~200GB) - - - - - 003df39c by Stefan Schulze Frielinghaus at 2021-02-05T19:11:18-05:00 rts: Use properly sized pointers in e.g. rts_mkInt8 Since commit be5d74caab the payload of a closure of Int<N> or Word<N> is not extended anymore to the machines word size. Instead, only the first N bits of a payload are written. This patch ensures that only those bits are read/written independent of the machines endianness. - - - - - fe789978 by Sylvain Henry at 2021-02-05T19:12:01-05:00 IntVar: fix allocation size As found by @phadej in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4740/diffs#note_327510 Also fix FastMutInt which allocating the size in bits instead of bytes. - - - - - 792191e4 by Stefan Schulze Frielinghaus at 2021-02-05T19:12:39-05:00 FFI: Revisit fix pass small ints in foreign call wrappers Since commit be5d74ca small ints/words are passed according to their natural size which obsoletes fix from commit 01f7052cc1. Reverted 01f7052cc1 but kept the introduced test case. - - - - - d4618aeb by Sebastian Graf at 2021-02-05T19:13:15-05:00 Mark both parameters of SimplM one-shot (#19302) Just marking the `SimplTopEnv` parameter as one-shot was not enough to eta-expand `simplExpr`. Fixes #19302. - - - - - 97a8fe7b by Stefan Schulze Frielinghaus at 2021-02-05T19:13:52-05:00 rts: Fix arguments for foreign calls of interpreter Function arguments passed to the interpreter are extended to whole words. However, foreign function interface expects correctly typed argument pointers. Accordingly, we have to adjust argument pointers in case of a big-endian architecture. In contrast to function arguments where subwords are passed in the low bytes of a word, the return value is expected to reside in the high bytes of a word. - - - - - a9b89d5a by Andreas Klebinger at 2021-02-05T19:14:29-05:00 validate: Enable tarball autodownload by default. Fixes #19307 - - - - - 640a3ece by Basile Henry at 2021-02-05T19:15:06-05:00 Fix typo in qualified_do.rst - - - - - 7f3524ef by Daniel Rogozin at 2021-02-06T09:26:51-05:00 The Char kind (#11342) Co-authored-by: Rinat Stryungis <rinat.stryungis at serokell.io> Implement GHC Proposal #387 * Parse char literals 'x' at the type level * New built-in type families CmpChar, ConsSymbol, UnconsSymbol * New KnownChar class (cf. KnownSymbol and KnownNat) * New SomeChar type (cf. SomeSymbol and SomeNat) * CharTyLit support in template-haskell Updated submodules: binary, haddock. Metric Decrease: T5205 haddock.base Metric Increase: Naperian T13035 - - - - - 18313374 by Simon Peyton Jones at 2021-02-06T09:27:28-05:00 Fix buglet in expandSynTyCon_maybe The fix for #17958, implemented in MR !2952, introduced a small bug in GHC.Core.TyCon.expandSynTyCon_maybe, in the case of under-saturated type synonyms. This MR fixes the bug, very easy. Fixes #19279 - - - - - b8d8f31e by Andreas Klebinger at 2021-02-06T09:28:04-05:00 Make unsafeDupablePerformIO have a lazy demand When a user writes code like: unsafePerformIO $ do let x = f x writeIORef ref x return x We might expect that the write happens before we evaluate `f x`. Sadly this wasn't to case for reasons detailed in #19181. We fix this by avoiding the strict demand by turning: unsafeDupablePerformIO (IO m) = case runRW# m of (# _, a #) -> a into unsafeDupablePerformIO (IO m) = case runRW# m of (# _, a #) -> lazy a This makes the above code lazy in x. And ensures the side effect of the write happens before the evaluation of `f x`. If a user *wants* the code to be strict on the returned value he can simply use `return $! x`. This fixes #19181 - - - - - d93d7fc6 by Simon Peyton Jones at 2021-02-06T09:28:41-05:00 Make pattern synonyms play with CallStack This small patch makes pattern synonyms play nicely with CallStack constraints, using logic explained in GHC.Tc.Gen.Pat Note [Call-stack tracing of pattern synonyms] Fixes #19289 - - - - - 4e6bb326 by Krzysztof Gogolewski at 2021-02-06T09:29:17-05:00 Add a test for #18736 Commit 65721691ce9c (Improve inference with linear types, !4632) fixed the bug. Closes #18736. - - - - - 9b7dcd80 by Simon Jakobi at 2021-02-06T09:29:55-05:00 base: Fix since-annotation for Data.List.singleton - - - - - 3da472f0 by Brian Wignall at 2021-02-06T09:30:34-05:00 Fix typos - - - - - ab5fd982 by Ben Gamari at 2021-02-06T12:01:52-05:00 Bump Haddock submodule Merged ghc-8.10 into ghc-head. - - - - - 891a791f by Simon Peyton Jones at 2021-02-09T16:21:40-05:00 Reduce inlining in deeply-nested cases This adds a new heuristic, controllable via two new flags to better tune inlining behaviour. The new flags are -funfolding-case-threshold and -funfolding-case-scaling which are document both in the user guide and in Note [Avoid inlining into deeply nested cases]. Co-authored-by: Andreas Klebinger <klebinger.andreas at gmx.at> - - - - - be423178 by Krzysztof Gogolewski at 2021-02-09T16:22:17-05:00 Fix pretty-printing of invisible arguments for FUN 'Many (#19310) - - - - - 17a89b1b by Simon Peyton Jones at 2021-02-09T16:22:52-05:00 Fix a long standing bug in constraint solving When combining Inert: [W] C ty1 ty2 Work item: [D] C ty1 ty2 we were simply discarding the Derived one. Not good! We should turn the inert back into [WD] or keep both. E.g. fundeps work only on Derived (see isImprovable). This little patch fixes it. The bug is hard to tickle, but #19315 did so. The fix is a little messy (see Note [KeepBoth] plus the change in addDictCt), but I am disinclined to refine it further because it'll all be swept away when we Kill Deriveds. - - - - - 3d27bc30 by Masahiro Sakai at 2021-02-10T14:30:11-05:00 Fix example code of "Making a Haskell library that can be called from foreign code" section "+RTS" in argv[0] is interpreted as a program name and does not work as an indicator of RTS options. - - - - - 40983d23 by Fendor at 2021-02-10T14:30:54-05:00 Add -Wsafe to flags not enabled by -Wall - - - - - 8e2f85f6 by Sylvain Henry at 2021-02-13T21:27:34-05:00 Refactor Logger Before this patch, the only way to override GHC's default logging behavior was to set `log_action`, `dump_action` and `trace_action` fields in DynFlags. This patch introduces a new Logger abstraction and stores it in HscEnv instead. This is part of #17957 (avoid storing state in DynFlags). DynFlags are duplicated and updated per-module (because of OPTIONS_GHC pragma), so we shouldn't store global state in them. This patch also fixes a race in parallel "--make" mode which updated the `generatedDumps` IORef concurrently. Bump haddock submodule The increase in MultilayerModules is tracked in #19293. Metric Increase: MultiLayerModules - - - - - 4b068fc3 by Marcin Szamotulski at 2021-02-13T21:28:13-05:00 Improve bracket documentation - - - - - 448fd22d by Marcin Szamotulski at 2021-02-13T21:28:13-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - f1362008 by Joachim Breitner at 2021-02-13T21:28:49-05:00 Always set `safeInferred`, not only when it turns `False` previously, `safeFlagCheck` would be happy to switch the `safeFlag` to `False`, but not the other way around. This meant that after :set -XGeneralizedNewtypeDeriving :set -XNoGeneralizedNewtypeDeriving in GHCi all loaded files would be still be infered as unsafe. This fixes #19243. This is a corner case, but somewhat relevant once ghci by default starts with `GeneralizedNewtypeDeriving` on (due to GHC2021). - - - - - 793dcb3d by Roland Senn at 2021-02-13T21:29:30-05:00 GHCi :complete command for operators: Fix spaceless cases of #10576. When separating operators from identifiers in a `:complete` command take advantage from the different character sets of the two items: * operators contain only specialSymbol characters. * Identifiers don't contain specialSymbol characters, with the exception of dots. - - - - - 83ace021 by Marcin Szamotulski at 2021-02-13T21:30:09-05:00 Make closeFdWith uninterrupitble closeFdWith is accessing shared TMVar - the IO manager callbak table var. It might be concurrently used by different threads: either becuase it contains information about different file descriptors or a single file descriptor is accessed from different threads. For this reason `takeMVar` might block, although for a very short time as all the IO operations are using epoll (or its equivalent). This change makes hClose and Network.Socket.close safe in presence of asynchronous exceptions. This is especailly important in the context of `bracket` which expects uninterruptible close handler. - - - - - a5ec3515 by Marcin Szamotulski at 2021-02-13T21:30:09-05:00 closeFd: improve documentation I think it is worth to say that closeFd is interruptible by asynchronous exceptions. And also fix indentation of closeFd_. - - - - - a6c3ddfe by Simon Jakobi at 2021-02-13T21:30:45-05:00 Remove Data.Semigroup.Option Bumps the binary and deepseq submodules. Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/15028. - - - - - 18e53386 by Krzysztof Gogolewski at 2021-02-13T21:31:22-05:00 Add tests for solved arrow tickets #5777 #15175 Merge requests !4464 and !4474 fixed the Lint problems. Closes #5777. Closes #15175. - - - - - dcc4b2de by Krzysztof Gogolewski at 2021-02-13T21:31:59-05:00 Remove deprecated -XGenerics and -XMonoPatBinds They have no effect since 2011 (GHC 7.2/7.4), commits cb698570b2b and 49dbe60558. - - - - - be3c0d62 by Simon Peyton Jones at 2021-02-13T21:32:38-05:00 Fix a serious bug in roughMatchTcs The roughMatchTcs function enables a quick definitely-no-match test in lookupInstEnv. Unfortunately, it didn't account for type families. This didn't matter when type families were flattened away, but now they aren't flattened it matters a lot. The fix is very easy. See INVARIANT in GHC.Core.InstEnv Note [ClsInst laziness and the rough-match fields] Fixes #19336 The change makes compiler perf worse on two very-type-family-heavy benchmarks, T9872{a,d}: T9872a(normal) ghc/alloc 2172536442.7 2216337648.0 +2.0% T9872d(normal) ghc/alloc 614584024.0 621081384.0 +1.1% (Everything else is 0.0% or at most 0.1%.) I think we just have to put up with this. Some cases were being wrongly filtered out by roughMatchTcs that might actually match, which could lead to false apartness checks. And it only affects these very type-family-heavy cases. Metric Increase: T9872a T9872d - - - - - 3331b3ad by songzh at 2021-02-13T21:33:17-05:00 Fix example code in Deriving via. - - - - - 5e71dd33 by Sylvain Henry at 2021-02-13T21:33:56-05:00 Bignum: fix bogus rewrite rule (#19345) Fix the following rule: "fromIntegral/Int->Natural" fromIntegral = naturalFromWord . fromIntegral Its type wasn't constrained to Int hence #19345. - - - - - a699389f by Ben Gamari at 2021-02-14T03:35:07-05:00 base: Add unsafeWithForeignPtr - - - - - c81996a4 by Ben Gamari at 2021-02-14T03:35:07-05:00 GHC.Utils.Binary: Eliminate allocating withForeignPtr uses - - - - - 6d3d79af by Ben Gamari at 2021-02-14T03:35:07-05:00 base: Eliminate allocating withForeignPtrs from GHC.Event.Array - - - - - 3e22a935 by Ben Gamari at 2021-02-14T03:35:07-05:00 base: Use unsafeWithForeignPtr in GHC.IO.Buffer - - - - - eb9bbd38 by Ben Gamari at 2021-02-14T03:35:07-05:00 Bump bytestring submodule Teach it to use unsafeWithForeignPtr where appropriate. - - - - - 65d98c6e by Ben Gamari at 2021-02-14T03:35:07-05:00 StringBuffer: Use unsafeWithForeignPtr - - - - - 544329c8 by Ben Gamari at 2021-02-14T03:35:07-05:00 genprimopcode: Add a second levity-polymorphic tyvar This will be needed shortly. - - - - - 74fec146 by Ben Gamari at 2021-02-14T03:35:07-05:00 Introduce keepAlive primop - - - - - 2de81332 by Ben Gamari at 2021-02-14T03:35:07-05:00 base: Use keepAlive# in withForeignPtr - - - - - 267d31c1 by Ben Gamari at 2021-02-14T03:35:07-05:00 base: Use keepAlive# in Foreign.Marshal.Alloc - - - - - ee77148e by Ben Gamari at 2021-02-14T03:35:07-05:00 ghc-compact: Use keepAlive# in GHC.Compact.Serialized - - - - - 72f23083 by Ben Gamari at 2021-02-14T03:35:44-05:00 ghc-in-ghci: Drop it isovector recently noticed that it is broken and regardless it is superceded by `hadrian/ghci`. - - - - - bc5cb5f9 by Ben Gamari at 2021-02-14T03:35:44-05:00 Drop GHC_LOADED_IN_GHCI This previously supported the ghc-in-ghci script which has been since dropped. Hadrian's ghci support does not need this macro (which disabled uses of UnboxedTuples) since it uses `-fno-code` rather than produce bytecode. - - - - - 4dc2002a by Simon Peyton Jones at 2021-02-14T03:36:20-05:00 Fix over-eager inlining in SimpleOpt In GHC.Core.SimpleOpt, I found that its inlining could duplicate an arbitary redex inside a lambda! Consider (\xyz. x+y). The occurrence-analysis treats the lamdda as a group, and says that both x and y occur once, even though the occur under the lambda-z. See Note [Occurrence analysis for lambda binders] in OccurAnal. When the lambda is under-applied in a call, the Simplifier is careful to zap the occ-info on x,y, because they appear under the \z. (See the call to zapLamBndrs in simplExprF1.) But SimpleOpt missed this test, resulting in #19347. So this patch * commons up the binder-zapping in GHC.Core.Utils.zapLamBndrs. * Calls this new function from GHC.Core.Opt.Simplify * Adds a call to zapLamBndrs to GHC.Core.SimpleOpt.simple_app This change makes test T12990 regress somewhat, but it was always very delicate, so I'm going to put up with that. In this voyage I also discovered a small, rather unrelated infelicity in the Simplifier: * In GHC.Core.Opt.Simplify.simplNonRecX we should apply isStrictId to the OutId not the InId. See Note [Dark corner with levity polymorphism] It may never "bite", because SimpleOpt should have inlined all the levity-polymorphic compulsory inlnings already, but somehow it bit me at one point and it's generally a more solid thing to do. Fixing the main bug increases runtime allocation in test perf/should_run/T12990, for (acceptable) reasons explained in a comement on Metric Increase: T12990 - - - - - b9fe4cd5 by Ben Gamari at 2021-02-14T03:36:57-05:00 validate: Fix copy-pasta Previously the Hadrian codepath of `validate` inverted the logic which decides whether the test build of `xhtml` should be built with `--enable-shared`. This resulted in validate failures on Windows, which does not support dynamic linkage of Haskell code. - - - - - 3deb1387 by Daniel Gröber at 2021-02-14T22:30:19+01:00 Fix non power-of-two Storable.alignment in Capi_Ctype tests Alignments passed to alloca and friends must be a power of two for the code in allocatePinned to work properly. Commit 41230e2601 ("Zero out pinned block alignment slop when profiling") introduced an ASSERT for this but this test was still violating it. - - - - - 363414c6 by Daniel Gröber at 2021-02-14T22:30:19+01:00 Improve ByteArray# documentation regarding alignment - - - - - 637d4f22 by Daniel Gröber at 2021-02-14T22:30:19+01:00 Document word-size rounding of ByteArray# memory (Fix #14731) - - - - - f422c12d by Daniel Gröber at 2021-02-14T22:59:01+01:00 Throw IOError when allocaBytesAligned gets non-power-of-two align - - - - - 2521b041 by Adam Gundry at 2021-02-16T04:34:43-05:00 Implement NoFieldSelectors extension (ghc-proposals 160) Fixes #5972. This adds an extension NoFieldSelectors to disable the generation of selector functions corresponding to record fields. When this extension is enabled, record field selectors are not accessible as functions, but users are still able to use them for record construction, pattern matching and updates. See Note [NoFieldSelectors] in GHC.Rename.Env for details. Defining the same field multiple times requires the DuplicateRecordFields extension to be enabled, even when NoFieldSelectors is in use. Along the way, this fixes the use of non-imported DuplicateRecordFields in GHCi with -fimplicit-import-qualified (fixes #18729). Moreover, it extends DisambiguateRecordFields to ignore non-fields when looking up fields in record updates (fixes #18999), as described by Note [DisambiguateRecordFields for updates]. Co-authored-by: Simon Hafner <hafnersimon at gmail.com> Co-authored-by: Fumiaki Kinoshita <fumiexcel at gmail.com> - - - - - 1109896c by Adam Gundry at 2021-02-16T04:34:43-05:00 Make sure HasField use counts for -Wunused-top-binds This is a small fix that depends on the previous commit, because it corrected the rnExpr free variable calculation for HsVars which refer to ambiguous fields. Fixes #19213. - - - - - a01e78cc by Sylvain Henry at 2021-02-16T04:35:22-05:00 Don't build extra object with -no-hs-main We don't need to compile/link an additional empty C file when it is not needed. This patch may also fix #18938 by avoiding trying to lookup the RTS unit when there is none (yet) in the unit database. - - - - - 42ab06f7 by Sylvain Henry at 2021-02-16T04:36:02-05:00 Replace more autotools obsolete macros (#19189) - - - - - 963e1e9a by Oleg Grenrus at 2021-02-16T04:36:40-05:00 Use explicit import list for Data.List - - - - - c6faa42b by Simon Peyton Jones at 2021-02-16T16:38:01-05:00 Avoid useless w/w split This patch is just a tidy-up for the post-strictness-analysis worker wrapper split. Consider f x = x Strictnesss analysis does not lead to a w/w split, so the obvious thing is to leave it 100% alone. But actually, because the RHS is small, we ended up adding a StableUnfolding for it. There is some reason to do this if we choose /not/ do to w/w on the grounds that the function is small. See Note [Don't w/w inline small non-loop-breaker things] But there is no reason if we would not have done w/w anyway. This patch just moves the conditional to later. Easy. This does move some -ddump-simpl printouts around a bit. I also discovered that the previous code was overwritten an InlineCompulsory with InlineStable, which is utterly wrong. That in turn meant that some default methods (marked InlineCompulsory) were getting their InlineCompulsory squashed. This patch fixes that bug --- but of course that does mean a bit more inlining! Metric Decrease: T9233 T9675 Metric Increase: T12707 T11374 T3064 T4029 T9872b T9872d haddock.Cabal - - - - - c2029001 by Andrzej Rybczak at 2021-02-16T16:38:39-05:00 Add Generic tuple instances up to 15 - - - - - 7686f9f8 by Adam Gundry at 2021-02-16T16:39:14-05:00 Avoid false redundant import warning with DisambiguateRecordFields Fixes #17853. We mustn't discard the result of pickGREs, because doing so might lead to incorrect redundant import warnings. - - - - - a04179e7 by Ryan Scott at 2021-02-16T16:39:51-05:00 Parse symbolic names in ANN type correctly with otycon This adds a new `otycon` production to the parser that allows for type constructor names that are either alphanumeric (`tycon`) or symbolic (`tyconsym`), where the latter must be parenthesized appropriately. `otycon` is much like the existing `oqtycon` production, except that it does not permit qualified names. The parser now uses `otycon` to parse type constructor names in `ANN type` declarations, which fixes #19374. To make sure that all of this works, I added three test cases: * `should_compile/T19374a`: the original test case from #19374 * `should_fail/T19374b`: a test that makes sure that an `ANN` with a qualified name fails to parse * `should_fail/T19374c`: a test that makes sure that an `ANN type` with a qualified name fails to parse - - - - - 044a53b8 by Daniel Gröber at 2021-02-17T11:21:10-05:00 rts: TraverseHeap: Rename traversePushClosure to traversePushRoot - - - - - c3e8dd5f by Daniel Gröber at 2021-02-17T11:21:10-05:00 rts: TraverseHeap: Increase lifetime of stackElements This modifies the lifetime of stackElements such that they stay on the stack until processing of all child closures is complete. Currently the stackElement representing a set of child closures will be removed as soon as processing of the last closure _starts_. We will use this in a future commit to allow storing information on the stack which should be accumulated in a bottom-up manner along the closure parent-child relationship. Note that the lifetime increase does not apply to 'type == posTypeFresh' stack elements. This is because they will always be pushed right back onto the stack as regular stack elements anyways. - - - - - fd48d8b0 by Daniel Gröber at 2021-02-17T11:21:10-05:00 rts: TraverseHeap: Link parent stackElements on the stack The new 'sep' field links a stackElement to it's "parent". That is the stackElement containing it's parent closure. Currently not all closure types create long lived elements on the stack so this does not cover all parents along the path to the root but that is about to change in a future commit. - - - - - c4ad9150 by Daniel Gröber at 2021-02-17T11:21:10-05:00 rts: TraverseHeap: Introduce callback for subtree completion The callback 'return_cb' allows users to be perform additional accounting when the traversal of a subtree is completed. This is needed for example to determine the number or total size of closures reachable from a given closure. This commit also makes the lifetime increase of stackElements from commit "rts: TraverseHeap: Increase lifetime of stackElements" optional based on 'return_cb' being set enabled or not. Note that our definition of "subtree" here includes leaf nodes. So the invariant is that return_cb is called for all nodes in the traversal exactly once. - - - - - 7bca0e54 by Daniel Gröber at 2021-02-17T11:21:10-05:00 rts: TraverseHeap: Update some comments data_out was renamed to child_data at some point - - - - - eecdb053 by Daniel Gröber at 2021-02-17T11:21:10-05:00 rts: TraverseHeap: Simplify profiling header Having a union in the closure profiling header really just complicates things so get back to basics, we just have a single StgWord there for now. - - - - - d7bbaf5d by Daniel Gröber at 2021-02-17T11:21:10-05:00 rts: TraverseHeap: Make trav. data macros into functions This allows the global 'flip' variable not to be exported. This allows a future commit to also make it part of the traversalState struct. - - - - - 30c01e42 by Daniel Gröber at 2021-02-17T11:21:11-05:00 rts: TraverseHeap: Move "flip" bit into traverseState struct - - - - - 937feda3 by Daniel Gröber at 2021-02-17T11:21:11-05:00 rts: TraverseHeap: Make "flip" bit flip into it's own function - - - - - c0907fef by Daniel Gröber at 2021-02-17T11:21:11-05:00 rts: TraverseHeap: Move stackElement to header The point of this is to let user code call traversePushClosure directly instead of going through traversePushRoot. This in turn allows specifying a stackElement to be used when the traversal returns from a top-level (root) closure. - - - - - 79bb81fe by Daniel Gröber at 2021-02-17T11:21:11-05:00 rts: TraverseHeap: Add a basic test For now this just tests that the order of the callbacks is what we expect for a couple of synthetic heap graphs. - - - - - fc4bd556 by Daniel Gröber at 2021-02-17T11:21:11-05:00 rts: TraverseHeap: Allow visit_cb to be NULL - - - - - 3eac10ae by Daniel Gröber at 2021-02-17T11:21:11-05:00 rts: ProfHeap: Merge some redundant ifdefs - - - - - e640f611 by Daniel Gröber at 2021-02-17T11:21:11-05:00 rts: ProfHeap: Move definitions for Census to new header - - - - - 77d71160 by Daniel Gröber at 2021-02-17T11:21:11-05:00 rts: TraverseHeap: Fix failed to inline warnings GCC warns that varadic functions simply cannot be inlined. - - - - - bf95dd2c by Daniel Gröber at 2021-02-17T11:21:11-05:00 rts: TraverseHeap: Update resetStaticObjectForProfiling docs Simon's concern in the old comment, specifically: So all of the calls to traverseMaybeInitClosureData() here are initialising retainer sets with the wrong flip. Is actually exactly what the code was intended to do. It makes the closure data valid, then at the beginning of the traversal the flip bit is flipped resetting all closures across the heap to invalid. Now it used to be that the profiling code using the traversal has it's own sense of valid vs. invalid beyond what the traversal code does and indeed the retainer profiler still does this, there a getClosureData of NULL is considered an invalid retainer set. So in effect there wasn't any difference in invalidating closure data rather than just resetting it to a valid zero, which might be what confused Simon at the time. As the code is now it actually uses the value of the valid/invalid bit in the form of the 'first_visit' argument to the 'visit' callback so there is a difference. - - - - - 53677c96 by Peter Trommler at 2021-02-17T11:21:47-05:00 PPC NCG: print procedure end label for debug Fixes #19118 - - - - - fb94d102 by Ben Gamari at 2021-02-17T11:22:23-05:00 CallArity: Small optimisations and strictness - - - - - a70bab97 by Ben Gamari at 2021-02-17T11:22:23-05:00 UnVarGraph: Improve asymptotics This is a redesign of the UnVarGraph data structure used by the call arity analysis to avoid the pathologically-poor performance observed in issue #18789. Specifically, deletions were previously O(n) in the case of graphs consisting of many complete (bipartite) sub-graphs. Together with the nature of call arity this would produce quadratic behavior. We now encode deletions specifically, taking care to do some light normalization of empty structures. In the case of the `Network.AWS.EC2.Types.Sum` module from #19203, this brings the runtime of the call-arity analysis from over 50 seconds down to less than 2 seconds. Metric Decrease: T15164 WWRec - - - - - dbf8f6fe by Ryan Scott at 2021-02-17T11:22:58-05:00 Fix #19377 by using lookupLOcc when desugaring TH-quoted ANNs Previously, the desugarer was looking up names referenced in TH-quoted `ANN`s by using `globalVar`, which would allocate a fresh TH `Name`. In effect, this would prevent quoted `ANN`s from ever referencing the correct identifier `Name`, leading to #19377. The fix is simple: instead of `globalVar`, use `lookupLOcc`, which properly looks up the name of the in-scope identifier. Fixes #19377. - - - - - 2adfb404 by Sebastian Graf at 2021-02-18T13:45:41-05:00 Document how bottom CPR and dead-ending Divergence are related [skip ci] In a new `Note [Bottom CPR iff Dead-Ending Divergence]`. Fixes #18086. - - - - - 763d2855 by Gauvain 'GovanifY' Roussel-Tarbouriech at 2021-02-18T13:46:19-05:00 directory: ensure xdg compliance (Fix #6077) - - - - - 4dc2bcca by Matthew Pickering at 2021-02-18T13:46:56-05:00 rts: Add generic block traversal function, listAllBlocks This function is exposed in the RtsAPI.h so that external users have a blessed way to traverse all the different `bdescr`s which are known by the RTS. The main motivation is to use this function in ghc-debug but avoid having to expose the internal structure of a Capability in the API. - - - - - b5db3457 by Ben Gamari at 2021-02-18T13:47:32-05:00 Extend nullary TyConApp optimisation to all TyCons See Note [Sharing nullary TyConApps] in GHC.Core.TyCon. Closes #19367. Metric Decrease: T9872a T9872b T9872c - - - - - a4c53e3b by Ben Gamari at 2021-02-18T13:47:32-05:00 TypeMap: Use mkTyConTy instead of TyConApp constructor This allows TypeMap to benefit from the nullary TyConApp sharing optimisation described in Note [Sharing nullary TyConApps] in GHC.Core.TyCon. - - - - - 60ed2a65 by Simon Peyton Jones at 2021-02-18T13:48:09-05:00 Improve specialisation for imported functions At a SPECIALSE pragma for an imported Id, we used to check that it was marked INLINABLE. But that turns out to interact badly with worker/wrapper: see Note [Worker-wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap. So this small patch instead simply tests that we have an unfolding for the function; see Note [SPECIALISE pragmas for imported Ids] in GHC.Tc.Gen.Sig. Fixes #19246 - - - - - 94bbc45d by Sylvain Henry at 2021-02-18T13:48:51-05:00 Use target Int/Word when detecting literal overflows (#17336) And also for empty enumeration detection. - - - - - 766b11ea by Andreas Klebinger at 2021-02-18T13:49:31-05:00 Remove leftover trace messages from the keepAlive# work. - - - - - ecf967c2 by Hécate Moonlight at 2021-02-18T13:50:10-05:00 Rectify the haddock markup surrounding symbols for foldl' and foldMap' closes #19365 - - - - - a1126bac by Ben Gamari at 2021-02-18T13:50:46-05:00 base: Fix order of infix declarations in Data.Functor As pointed in #19284, previously the order was a bit confusing. This didn't affect the meaning but nevertheless it's much clearer now. Closes #19284. - - - - - 6863b196 by Ben Gamari at 2021-02-18T13:51:22-05:00 users guide: Mention that -e can be given multiple times Fixes #19122. - - - - - f78f001c by Matthew Pickering at 2021-02-18T13:51:59-05:00 Test Driver: Tweak interval of test reporting Rather than just display every 100 tests, work out how many to display based on the total number of tests. This improves the experience when running a small number of tests. For [0..100] - Report every test [100..1000] - Report every 10 tests [1000..10000] - Report every 100 tests and so on.. - - - - - 4196969c by Simon Peyton Jones at 2021-02-19T11:03:46-05:00 Improve handling of overloaded labels, literals, lists etc When implementing Quick Look I'd failed to remember that overloaded labels, like #foo, should be treated as a "head", so that they can be instantiated with Visible Type Application. This caused #19154. A very similar ticket covers overloaded literals: #19167. This patch fixes both problems, but (annoyingly, albeit temporarily) in two different ways. Overloaded labels I dealt with overloaded labels by buying fully into the Rebindable Syntax approach described in GHC.Hs.Expr Note [Rebindable syntax and HsExpansion]. There is a good overview in GHC.Rename.Expr Note [Handling overloaded and rebindable constructs]. That module contains much of the payload for this patch. Specifically: * Overloaded labels are expanded in the renamer, fixing #19154. See Note [Overloaded labels] in GHC.Rename.Expr. * Left and right sections used to have special code paths in the typechecker and desugarer. Now we just expand them in the renamer. This is harder than it sounds. See GHC.Rename.Expr Note [Left and right sections]. * Infix operator applications are expanded in the typechecker, specifically in GHC.Tc.Gen.App.splitHsApps. See Note [Desugar OpApp in the typechecker] in that module * ExplicitLists are expanded in the renamer, when (and only when) OverloadedLists is on. * HsIf is expanded in the renamer when (and only when) RebindableSyntax is on. Reason: the coverage checker treats HsIf specially. Maybe we could instead expand it unconditionally, and fix up the coverage checker, but I did not attempt that. Overloaded literals Overloaded literals, like numbers (3, 4.2) and strings with OverloadedStrings, were not working correctly with explicit type applications (see #19167). Ideally I'd also expand them in the renamer, like the stuff above, but I drew back on that because they can occur in HsPat as well, and I did not want to to do the HsExpanded thing for patterns. But they *can* now be the "head" of an application in the typechecker, and hence something like ("foo" @T) works now. See GHC.Tc.Gen.Head.tcInferOverLit. It's also done a bit more elegantly, rather than by constructing a new HsExpr and re-invoking the typechecker. There is some refactoring around tcShortCutLit. Ultimately there is more to do here, following the Rebindable Syntax story. There are a lot of knock-on effects: * HsOverLabel and ExplicitList no longer need funny (Maybe SyntaxExpr) fields to support rebindable syntax -- good! * HsOverLabel, OpApp, SectionL, SectionR all become impossible in the output of the typecheker, GhcTc; so we set their extension fields to Void. See GHC.Hs.Expr Note [Constructor cannot occur] * Template Haskell quotes for HsExpanded is a bit tricky. See Note [Quotation and rebindable syntax] in GHC.HsToCore.Quote. * In GHC.HsToCore.Match.viewLExprEq, which groups equal HsExprs for the purpose of pattern-match overlap checking, I found that dictionary evidence for the same type could have two different names. Easily fixed by comparing types not names. * I did quite a bit of annoying fiddling around in GHC.Tc.Gen.Head and GHC.Tc.Gen.App to get error message locations and contexts right, esp in splitHsApps, and the HsExprArg type. Tiresome and not very illuminating. But at least the tricky, higher order, Rebuilder function is gone. * Some refactoring in GHC.Tc.Utils.Monad around contexts and locations for rebindable syntax. * Incidentally fixes #19346, because we now print renamed, rather than typechecked, syntax in error mesages about applications. The commit removes the vestigial module GHC.Builtin.RebindableNames, and thus triggers a 2.4% metric decrease for test MultiLayerModules (#19293). Metric Decrease: MultiLayerModules T12545 - - - - - f90487ca by David Feuer at 2021-02-22T18:26:50-05:00 Make openFile exception safe * `openFile` could sometimes leak file descriptors if it received an asynchronous exception (#19114, #19115). Fix this on POSIX. * `openFile` and more importantly `openFileBlocking` could not be interrupted effectively during the `open` system call (#17912). Fix this on POSIX. * Implement `readFile'` using `withFile` to ensure the file is closed promptly on exception. * Avoid `bracket` in `withFile`, reducing the duration of masking. Closes #19130. Addresses #17912, #19114, and #19115 on POSIX systems, but not on Windows. - - - - - e1f133bf by Michiel de Bruijne at 2021-02-22T18:26:52-05:00 Prefer -Wmissing-signatures over -Wmissing-exported-signatures (#14794) - - - - - b068103d by alexbiehl at 2021-02-22T18:26:53-05:00 Ensure tcg_env is up-to-date when running typechecker plugins - - - - - 22ef7ab1 by Leif Metcalf at 2021-02-22T18:26:54-05:00 GHCi: Always show fixity We used to only show the fixity of an operator if it wasn't the default fixity. Usually this was when the fixity was undeclared, but it could also arise if one declared the fixity of an operator as infixl 9, the default fixity. This commit makes it so that :i always shows the fixity of an operator, even if it is unset. We may want in the future to keep track of whether an operator's fixity is defined, so that we can print a comment like infixl 9 # -- Assumed, since no fixity is declared. for operators with no specified fixity, and so that we can print fixity of a term with a non-symbolic term when its fixity has been manually specified as infixl 9. Implements #19200. - - - - - ece20229 by Hécate at 2021-02-22T18:26:55-05:00 Add the docspec:base rule to Hadrian - - - - - fd0945b7 by Sylvain Henry at 2021-02-22T18:27:00-05:00 Move Hooks into HscEnv - - - - - a1c85db1 by Dylan Yudaken at 2021-02-22T18:27:02-05:00 Do not cas on slowpath of SpinLock unnecessarily This is a well known technique to reduce inter-CPU bus traffic while waiting for the lock by reducing the number of writes. - - - - - 8bc9df52 by Matthew Pickering at 2021-02-22T18:27:05-05:00 Force gcp in assignArgumentsPos I observed this accumulating in the T3294 test only to be eventually forced (by a -hi profile). As it is only word big, forcing it saves quite a bit of allocation. - - - - - d1ceadc7 by Matthew Pickering at 2021-02-22T18:27:05-05:00 Make Width field in CmmType strict This value is eventually forced so don't build up thunks. Observed with T3294 and -hi profile. - - - - - db74c8f4 by Matthew Pickering at 2021-02-22T18:27:05-05:00 Make CmmType field of LocalReg strict This was observed to build up thunks which were forced by using a `-hi` profile and T3294 as a test. - - - - - 6d7086a3 by Ole Krüger at 2021-02-22T18:27:06-05:00 Fix TemplateHaskell pretty printer for CompleteP (#19270) The COMPLETE pragma was not properly terminated with a '#-}'. - - - - - 58897e24 by Ole Krüger at 2021-02-22T18:27:06-05:00 Add test case for CompleteP pretty-printer (#19270) - - - - - c7e80199 by Sergei Trofimovich at 2021-02-22T18:27:08-05:00 ModuleOrigin: print details of module conflict Before the change the error did not show details of involved module: ``` haddock: panic! (the 'impossible' happened) (GHC version 8.10.3: ModOrigin: hidden module redefined ``` After the change modile details are shown: ``` ghc-stage1: panic! (the 'impossible' happened) (GHC version 9.1.20210206: ModOrigin: package both exposed/hidden x: exposed package y: reexport by ghc-boot-9.1 ``` Fixes #19330 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 37fd1a6c by Ben Gamari at 2021-02-22T18:27:09-05:00 testsuite: Mark foreignInterruptible as fragile in GHCi As noted in #18391, foreignInterruptible fails pretty regularly under GHCi. - - - - - f78f4597 by Ben Gamari at 2021-02-22T18:27:10-05:00 testsuite: Add broken tests for #19244 - - - - - 847b0a69 by Andreas Klebinger at 2021-02-22T18:27:10-05:00 Fix Storeable instances for the windows timeout executable. alignment clearly should be a power of two. This patch makes it so. We do so by using the #alignment directive instead of using the size of the type. - - - - - 3aceea90 by Sylvain Henry at 2021-02-22T18:27:12-05:00 Don't pass homeUnitId at ExternalPackageState creation time (#10827) It makes the external package state independent of the home unit which is needed to make several home units share the EPS. - - - - - 54ba8d8a by Tamar Christina at 2021-02-22T18:27:14-05:00 linker: Fix atexit handlers on PE - - - - - 4a9d856d by Ben Gamari at 2021-02-23T15:11:06-05:00 testsuite: Mark tests affected by - - - - - 5b187ab8 by Ben Gamari at 2021-02-24T09:09:40-05:00 Revert "testsuite: Mark tests affected by #19025" This reverts commit 4a9d856d21c67b3328e26aa68a071ec9a824a7bb. - - - - - 7151eaa3 by Ben Gamari at 2021-02-24T11:15:41-05:00 testsuite: Introduce flag to ignore performance failures Needed by #19025. - - - - - 003ea780 by Ben Gamari at 2021-02-24T11:15:41-05:00 hadrian: Introduce runtest.opts key-value setting - - - - - 559e4b2b by Ben Gamari at 2021-02-24T11:15:41-05:00 hadrian: Throw error on unknown key-value setting name - - - - - 10e115d3 by Ben Gamari at 2021-02-24T11:15:41-05:00 gitlab-ci: Ignore performance test failures on Darwin Due to #19025. - - - - - bc12e7ec by Utku Demir at 2021-02-25T19:26:50-05:00 Minor fix to QualifiedDo docs about the ApplicativeDo desugaring When desugaring ApplicativeDo, GHC looks up the name `fmap`, not `<$>` (see 'GHC.Builtin.Names.fmapName'). This commit fixes the misleading documentation; since exporting the name `<$>` instead of `fmap` causes a "not in scope" error when `QualifiedDo` and `ApplicativeDo` is combined. [skip ci] - - - - - 98cb9402 by Sebastian Graf at 2021-02-26T16:24:26-05:00 hadrian: ticky_ghc should build all things with -ticky (#19405) [skip ci] With this patch, everything built by the stage1 compiler (in a `ticky_ghc`-transformed flavour) will be built with `-ticky`. Fixes #19405. - - - - - 29e7f318 by Simon Peyton Jones at 2021-02-26T16:25:02-05:00 Update MonoLocalBinds documentation Update the documentation to specify that MonoLocalBinds is lifted by a partial type signature. This came up in #19396. [skip ci] - - - - - 80eda911 by Adam Gundry at 2021-02-26T16:25:39-05:00 Implement -Wambiguous-fields Fixes #18966. Adds a new warning -Wambiguous-fields for uses of field selectors or record updates that will be rejected in the future, when the DuplicateRecordFields extension is simplified per https://github.com/ghc-proposals/ghc-proposals/pull/366. - - - - - 8d1fb46d by Ryan Scott at 2021-02-26T16:26:13-05:00 Fix #19363 by using pprName' {Applied,Infix} in the right places It was revealed in #19363 that the Template Haskell pretty-printer implemented in `Language.Haskell.TH.Ppr` did not pretty-print infix names or symbolic names correctly in certain situations, such as in data constructor declarations or fixity declarations. Easily fixed by using `pprName' Applied` (which always parenthesizes symbolic names in prefix position) or `pprName' Infix` (which always surrounds alphanumeric names with backticks in infix position) in the right spots. Fixes #19363. - - - - - 24777bb3 by Matthew Pickering at 2021-02-26T16:26:49-05:00 Reimplement Stream in "yoneda" style for efficiency 'Stream' is implemented in the "yoneda" style for efficiency. By representing a stream in this manner 'fmap' and '>>=' operations are accumulated in the function parameters before being applied once when the stream is destroyed. In the old implementation each usage of 'mapM' and '>>=' would traverse the entire stream in order to apply the substitution at the leaves. It is well-known for free monads that this representation can improve performance, and the test results demonstrate this for GHC as well. The operation mapAccumL is not used in the compiler and can't be implemented efficiently because it requires destroying and rebuilding the stream. I removed one use of mapAccumL_ which has similar problems but the other use was difficult to remove. In the future it may be worth exploring whether the 'Stream' encoding could be modified further to capture the mapAccumL pattern, and likewise defer the passing of accumulation parameter until the stream is finally consumed. The >>= operation for 'Stream' was a hot-spot in the ticky profile for the "ManyConstructors" test which called the 'cg' function many times in "StgToCmm.hs" Metric Decrease: ManyConstructors - - - - - a9f23793 by Andreas Klebinger at 2021-02-26T16:27:26-05:00 Move absentError into ghc-prim. When using -fdicts-strict we generate references to absentError while compiling ghc-prim. However we always load ghc-prim before base so this caused linker errors. We simply solve this by moving absentError into ghc-prim. This does mean it's now a panic instead of an exception which can no longer be caught. But given that it should only be thrown if there is a compiler error that seems acceptable, and in fact we already do this for absentSumFieldError which has similar constraints. - - - - - 98dd09af by Ben Gamari at 2021-02-27T07:58:57-05:00 rts: Introduce --eventlog-flush-interval flag This introduces a flag, --eventlog-flush-interval, which can be used to set an upper bound on the amount of time for which an eventlog event will remain enqueued. This can be useful in real-time monitoring settings. - - - - - 966a768e by Matthew Pickering at 2021-02-27T07:59:33-05:00 Remove the -xt heap profiling option It should be left to tooling to perform the filtering to remove these specific closure types from the profile if desired. Fixes #16795 - - - - - 60bf4d7c by Andreas Klebinger at 2021-02-27T08:00:08-05:00 Fix typechecking time bug for large rationals (#15646) When desugaring large overloaded literals we now avoid computing the `Rational` value. Instead prefering to store the significant and exponent as given where reasonable and possible. See Note [FractionalLit representation] for details. - - - - - df6d42d0 by Zubin Duggal at 2021-02-27T08:00:46-05:00 Don't catch async exceptions when evaluating Template Haskell - - - - - 902ece87 by Zubin Duggal at 2021-02-27T08:00:46-05:00 switch to using forkIO to detect async exceptions - - - - - 629dd56d by Zubin Duggal at 2021-02-27T08:00:46-05:00 Remove unnecessary killThread - - - - - c703cb39 by Zubin Duggal at 2021-02-27T08:00:46-05:00 Explain uninterruptibleMask - - - - - 5b752b1d by Sylvain Henry at 2021-02-27T08:01:25-05:00 touchy: use a valid cabal-version - - - - - bcaa36c4 by Sylvain Henry at 2021-02-27T08:01:25-05:00 Fix Windows build with autoconf >=2.70 (#19189) - - - - - 31ee48dc by Sylvain Henry at 2021-02-27T08:02:03-05:00 CI: reduce xz compression for non release/nightly jobs Reduce XZ compression level for regular jobs (it is bumped to 9 for releases and nightly jobs). In my experiments I've got the following bindist size in the given time for each compression level (with the quick flavour): XZ_OPT Time Size -9 4m06s 112 MB -8 4m00s 114 MB -7 3m50s 116 MB -6 (default) 3m40s 118 MB -5 2m47s 123 MB -4 1m57s 134 MB -3 1m03s 129 MB -2 49.73s 136 MB -1 37.72s 142 MB -0 34.40s 156 MB - - - - - 7d8f7d96 by Sebastian Graf at 2021-02-27T08:02:39-05:00 Include time.h in conc059_c (#19431) The test probably could have used `usleep` from `unistd.h` instead, but this seemed like the simplest solution. Fixes #19431. - - - - - 157fe938 by Ben Gamari at 2021-02-27T08:03:15-05:00 gitlab-ci: Fix TEST_ARGS/RUNTEST_ARGS inconsistency Finally fixes #19025. - - - - - 5680f8d4 by Ben Gamari at 2021-02-27T19:05:18-05:00 TcS: oneShot-ify Following the example of Note [The one-shot state monad trick]. c.f. #18202. Metric Decrease: T17836 T3064 T5321FD T9872a T9872b T9872c T9872d - - - - - 30500a4f by Ben Gamari at 2021-02-27T19:05:18-05:00 GHC.Tc.Solver.Rewrite: oneShot-ify Following the example of Note [The one-shot state monad trick]. c.f. #18202. - - - - - 382cd3b0 by Ben Gamari at 2021-02-27T19:05:18-05:00 Rewrite.split: Fix reboxing As noted in #19102, we would previously ended up reboxing the tuple result of `split`'s worker and then immediately take apart the boxed tuple to again unpack it into an unboxed result. Fixes #19102. - - - - - b8d40af1 by Krzysztof Gogolewski at 2021-02-27T19:05:54-05:00 Fix assertion error with linear types, #19400 The previous code using TyCoMapper could promote the same metavar twice. Use a set instead. - - - - - a3473323 by Ben Gamari at 2021-02-28T05:37:13-05:00 users guide: Update mathjax CDN URL Fixes #19423. [skip ci] - - - - - 0f2891f0 by Sylvain Henry at 2021-02-28T05:37:52-05:00 configure: avoid empty lines in AC_CONFIG_FILES Should fix failures on Windows: configure.ac:1511: error: ` ' is already registered with AC_CONFIG_FILES. - - - - - 980151aa by Alan Zimmerman at 2021-02-28T05:38:29-05:00 Add some utility functions to GHC.Types.SrcLoc pprUserSpan, isZeroWidthSpan, pprLocated, combineRealSrcSpans - - - - - 856929a5 by Sebastian Graf at 2021-02-28T05:39:05-05:00 Widen acceptance window of T12545 (#19414) This test flip-flops by +-1% in arbitrary changes in CI. While playing around with `-dunique-increment`, I could reproduce variations of 3% in compiler allocations, so I set the acceptance window accordingly. Fixes #19414. - - - - - 035d983d by Matthew Pickering at 2021-02-28T05:39:41-05:00 Fix two places where TcGblEnv was retained Found with ghc-debug on the ManyConstructors test - - - - - c3ff35bb by Sebastian Graf at 2021-02-28T06:10:38-05:00 Mark divModInt and friends as INLINE (#19267) So that we don't get a silly worker `$wdivModInt` and risk inlining `divModInt#` into `divModInt` or `$wdivModInt`, making both unlikely to inline at call sites. Fixes #19267. There's a spurious metric decrease (was an *increase*) in T12545. That seems entirely due to shifts in Unique distribution (+5% more `IntMap.$winsert` calls). The inappropriateness of the acceptance window is tracked in #19414. Metric Decrease: T12545 Metric Increase: T12545 - - - - - df2eca94 by Sebastian Graf at 2021-02-28T06:10:39-05:00 CPR analysis: Use CPR of scrutinee for Case Binder CPR (#19232) For years we have lived in a supposedly sweet spot that gave case binders the CPR property, unconditionally. Which is an optimistic hack that is now described in `Historical Note [Optimistic case binder CPR]`. In #19232 the concern was raised that this might do more harm than good and that might be better off simply by taking the CPR property of the scrutinee for the CPR type of the case binder. And indeed that's what we do now. Since `Note [CPR in a DataAlt case alternative]` is now only about field binders, I renamed and garbage collected it into `Note [Optimistic field binder CPR]`. NoFib approves: ``` NoFib Results -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- anna +0.1% +0.1% nucleic2 -1.2% -0.6% sched 0.0% +0.9% transform -0.0% -0.1% -------------------------------------------------------------------------------- Min -1.2% -0.6% Max +0.1% +0.9% Geometric Mean -0.0% +0.0% ``` Fixes #19232. - - - - - 0a85502b by Daniel Gröber at 2021-02-28T06:10:40-05:00 CODEOWNERS: Use sections to allow multiple matching entries The CODEOWNERS documentation has this to say on the current matching behaviour: > The path definition order is significant: the last pattern matching a > given path is used to find the code owners. Take this as an example: /rts/ bgamari [...] /rts/win32/ Phyx (I'm omitting the '@' so as to not notification spam everyone) This means a change in a file under win23 would only have Phyx but not bgamari as approver. I don't think that's the behaviour we want. Using "sections" we can get additive behaviour instead, from the docs: > Additionally, the usual guidance that only the last pattern matching the > file is applied is expanded such that the last pattern matching for each > section is applied. [RTS] /rts/ bgamari [...] [WinIO] /rts/win32/ Phyx So now since those entries are in different sections both would be added to the approvers list. The sections feature was introduced in Gitlab 13.2, see "Version history" on [1] we're currently running 18.8 on gitlab.haskell.org, see [2]. [1]: https://docs.gitlab.com/13.8/ee/user/project/code_owners.html#code-owners-sections [2]: https://gitlab.haskell.org/help - - - - - d262edad by Daniel Gröber at 2021-02-28T06:10:40-05:00 CODEOWNERS: Add @DanielG as maintainer for RTS heap profiling code - - - - - 72c0e078 by Sylvain Henry at 2021-02-28T06:10:42-05:00 Make known names simple ConApps (#19386) While fixing #17336 we noticed that code like this: = if | tc == intTyConName -> ... | tc == int8TyConName -> ... | tc == int16TyConName -> ... | tc == int32TyConName -> ... | tc == int64TyConName -> ... | tc == wordTyConName -> ... | tc == word8TyConName -> ... | tc == word16TyConName -> ... | tc == word32TyConName -> ... | tc == word64TyConName -> ... | tc == naturalTyConName -> ... was not transformed into a single case expression on the Name's unique as I would have expected but as a linear search. Bindings for known names are not simple constructor applications because of their strict `n_occ :: !OccName` field that needs to allocate a `FastString`: this field needs to be forced before using the `n_unique` field. This patch partially reverses ccaf7b66fc79e464b4e26f4ae62cb92ef7ba4b0f by making `n_occ` lazy and by ensuring that helper functions used to declare known names are fully inlined. The code above is then optimised as expected. Baseline Test Metric value New value Change --------------------------------------------------------------------------- ManyAlternatives(normal) ghc/alloc 822810880.0 822104032.0 -0.1% ManyConstructors(normal) ghc/alloc 4551734924.0 4480621808.0 -1.6% MultiLayerModules(normal) ghc/alloc 6029108292.0 6016024464.0 -0.2% Naperian(optasm) ghc/alloc 57396600.0 56826184.0 -1.0% PmSeriesG(normal) ghc/alloc 55666656.0 54521840.0 -2.1% PmSeriesS(normal) ghc/alloc 70204344.0 69047328.0 -1.6% PmSeriesT(normal) ghc/alloc 102273172.0 101070016.0 -1.2% PmSeriesV(normal) ghc/alloc 69157156.0 68002176.0 -1.7% T10421(normal) ghc/alloc 129875476.0 128881544.0 -0.8% T10421a(normal) ghc/alloc 92031552.0 90982800.0 -1.1% T10547(normal) ghc/alloc 34399800.0 33016760.0 -4.0% GOOD T10858(normal) ghc/alloc 208316964.0 207318616.0 -0.5% T11195(normal) ghc/alloc 304100548.0 302797040.0 -0.4% T11276(normal) ghc/alloc 140586764.0 139469832.0 -0.8% T11303b(normal) ghc/alloc 52118960.0 51120248.0 -1.9% T11374(normal) ghc/alloc 241325868.0 240692752.0 -0.3% T11822(normal) ghc/alloc 150612036.0 149582736.0 -0.7% T12150(optasm) ghc/alloc 92738452.0 91897224.0 -0.9% T12227(normal) ghc/alloc 494236296.0 493086728.0 -0.2% T12234(optasm) ghc/alloc 66786816.0 65966096.0 -1.2% T12425(optasm) ghc/alloc 112396704.0 111471016.0 -0.8% T12545(normal) ghc/alloc 1832733768.0 1828021072.0 -0.3% T12707(normal) ghc/alloc 1054991144.0 1053359696.0 -0.2% T13035(normal) ghc/alloc 116173180.0 115112072.0 -0.9% T13056(optasm) ghc/alloc 391749192.0 390687864.0 -0.3% T13253(normal) ghc/alloc 382785700.0 381550592.0 -0.3% T13253-spj(normal) ghc/alloc 168806064.0 167987192.0 -0.5% T13379(normal) ghc/alloc 403890296.0 402447920.0 -0.4% T13701(normal) ghc/alloc 2542828108.0 2534392736.0 -0.3% T13719(normal) ghc/alloc 4666717708.0 4659489416.0 -0.2% T14052(ghci) ghc/alloc 2181268580.0 2175320640.0 -0.3% T14683(normal) ghc/alloc 3094166824.0 3094524216.0 +0.0% T14697(normal) ghc/alloc 376323432.0 374024184.0 -0.6% T15164(normal) ghc/alloc 1896324828.0 1893236528.0 -0.2% T15630(normal) ghc/alloc 198932800.0 197783656.0 -0.6% T16190(normal) ghc/alloc 288186840.0 287250024.0 -0.3% T16577(normal) ghc/alloc 8324100940.0 8321580600.0 -0.0% T17096(normal) ghc/alloc 318264420.0 316961792.0 -0.4% T17516(normal) ghc/alloc 1332680768.0 1331635504.0 -0.1% T17836(normal) ghc/alloc 1296308168.0 1291098504.0 -0.4% T17836b(normal) ghc/alloc 62008340.0 60745256.0 -2.0% T17977(normal) ghc/alloc 52954564.0 51890248.0 -2.0% T17977b(normal) ghc/alloc 47824016.0 46683936.0 -2.4% T18140(normal) ghc/alloc 117408932.0 116353672.0 -0.9% T18223(normal) ghc/alloc 5603767896.0 5602037104.0 -0.0% T18282(normal) ghc/alloc 166456808.0 165396320.0 -0.6% T18304(normal) ghc/alloc 103694052.0 103513136.0 -0.2% T18478(normal) ghc/alloc 816819336.0 814459560.0 -0.3% T18698a(normal) ghc/alloc 438652404.0 437041784.0 -0.4% T18698b(normal) ghc/alloc 529448324.0 527666608.0 -0.3% T18923(normal) ghc/alloc 78360824.0 77315560.0 -1.3% T1969(normal) ghc/alloc 854223208.0 851303488.0 -0.3% T3064(normal) ghc/alloc 200655808.0 199368872.0 -0.6% T3294(normal) ghc/alloc 1791121792.0 1790033888.0 -0.1% T4801(normal) ghc/alloc 343749816.0 341760680.0 -0.6% T5030(normal) ghc/alloc 377520872.0 376492360.0 -0.3% T5321FD(normal) ghc/alloc 312680408.0 311618536.0 -0.3% T5321Fun(normal) ghc/alloc 355635656.0 354536264.0 -0.3% T5631(normal) ghc/alloc 629667068.0 629562192.0 -0.0% T5642(normal) ghc/alloc 540913864.0 539569952.0 -0.2% T5837(normal) ghc/alloc 43183652.0 42177928.0 -2.3% T6048(optasm) ghc/alloc 96395616.0 95397032.0 -1.0% T783(normal) ghc/alloc 427778908.0 426307760.0 -0.3% T9020(optasm) ghc/alloc 279523960.0 277010040.0 -0.9% T9233(normal) ghc/alloc 966717488.0 964594096.0 -0.2% T9630(normal) ghc/alloc 1585228636.0 1581428672.0 -0.2% T9675(optasm) ghc/alloc 594817892.0 591703040.0 -0.5% T9872a(normal) ghc/alloc 2216955420.0 2215648024.0 -0.1% T9872b(normal) ghc/alloc 2747814924.0 2746515472.0 -0.0% T9872c(normal) ghc/alloc 2271878772.0 2270554344.0 -0.1% T9872d(normal) ghc/alloc 623661168.0 621434064.0 -0.4% T9961(normal) ghc/alloc 409059124.0 406811120.0 -0.5% WWRec(normal) ghc/alloc 940563924.0 938008112.0 -0.3% hie002(normal) ghc/alloc 9801941116.0 9787675736.0 -0.1% parsing001(normal) ghc/alloc 494756632.0 493828512.0 -0.2% Metric Decrease: T10547 T13035 T12425 - - - - - 2454bb10 by Sebastian Graf at 2021-02-28T06:10:42-05:00 Make `Ord Literal` deterministic (#19438) Previously, non-determinism arising from a use of `uniqCompareFS` in `cmpLit` potentially crept into `CoreMap`, which we expect to behave deterministically. So we simply use `lexicalCompareFS` now. Fixes #19438. - - - - - 915daf51 by Sebastian Graf at 2021-02-28T06:10:42-05:00 Reduce code bloat in `Ord Literal` instance (#19443) Reduce code bloat by replacing a call to `(==)` (which is defined in terms of `compare`) and to `compare` by a single call to `compare`, utilising the `Semigroup Ordering` instance. The compiler was eliminate the code bloat before, so this is a rather cosmetical improvement. Fixes #19443. - - - - - 2628d61f by Ben Gamari at 2021-03-01T10:11:39-05:00 rts/eventlog: Ensure that all capability buffers are flushed The previous approach performed the flush in yieldCapability. However, as pointed out in #19435, this is wrong as it idle capabilities will not go through this codepath. The fix is simple: undo the optimisation, flushing in `flushEventLog` by calling `flushAllCapsEventsBufs` after acquiring all capabilities. Fixes #19435. - - - - - e18c430d by Ben Gamari at 2021-03-01T10:11:39-05:00 rts/eventlog: Flush MainCapability buffer in non-threaded RTS Previously flushEventLog failed to flush anything but the global event buffer in the non-threaded RTS. Fixes #19436. - - - - - f512f9e2 by Ben Gamari at 2021-03-01T10:11:39-05:00 testsuite: Accept allocations change in T10421 Metric Decrease: T10421 - - - - - 8c425bd8 by Sebastian Graf at 2021-03-01T17:29:44-05:00 Widen acceptance window of `MultiLayerModules` (#19293) [skip ci] As #19293 realises, this one keeps on flip flopping by 2.5% depending on how many modules there are within the GHC package. We should revert this once we figured out how to fix what's going on. - - - - - 7730713b by Simon Peyton Jones at 2021-03-01T17:30:21-05:00 Unify result type earlier to improve error messages Ticket #19364 helpfully points out that we do not currently take advantage of pushing the result type of an application into the arguments. This makes error messages notably less good. The fix is rather easy: move the result-type unification step earlier. It's even a bit more efficient; in the the checking case we now do one less zonk. See Note [Unify with expected type before typechecking arguments] in GHC.Tc.Gen.App This change generally improves error messages, but it made one worse: typecheck/should_fail/T16204c. That led me to the realisation that a good error can be replaced by a less-good one, which provoked me to change GHC.Tc.Solver.Interact.inertsCanDischarge. It's explained in the new Note [Combining equalities] One other refactoring: I discovered that KindEqOrigin didn't need a Maybe in its type -- a nice simplification. - - - - - 3b79e8b8 by Krzysztof Gogolewski at 2021-03-01T17:31:01-05:00 Infer multiplicity in case expressions This is a first step towards #18738. - - - - - 6429943b by Simon Peyton Jones at 2021-03-01T17:31:36-05:00 Fix terrible occurrence-analysis bug Ticket #19360 showed up a terrible bug in the occurrence analyser, in a situation like this Rec { f = g ; g = ..f... {-# RULE g .. = ...f... #-} } Then f was postInlineUnconditionally, but not in the RULE (which is simplified first), so we had a RULE mentioning a variable that was not in scope. This led me to review (again) the subtle loop-breaker stuff in the occurrence analyser. The actual changes are few, and are largely simplifications. I did a /lot/ of comment re-organising though. There was an unexpected amount of fallout. * Validation failed when compiling the stage2 compiler with profiling on. That turned to tickle a second latent bug in the same OccAnal code (at least I think it was always there), which led me to simplify still further; see Note [inl_fvs] in GHC.Core.Opt.OccurAnal. * But that in turn let me to some strange behaviour in CSE when ticks are in the picture, which I duly fixed. See Note [Dealing with ticks] in GHC.Core.Opt.CSE. * Then I got an ASSERT failure in CoreToStg, which again seems to be a latent bug. See Note [Ticks in applications] in GHC.CoreToStg * I also made one unforced change: I now simplify the RHS of a RULE in the same way as the RHS of a stable unfolding. This can allow a trivial binding to disappear sooner than otherwise, and I don't think it has any downsides. The change is in GHC.Core.Opt.Simplify.simplRules. - - - - - ce85cffc by Alan Zimmerman at 2021-03-01T17:32:12-05:00 Wrap LHsContext in Maybe in the GHC AST If the context is missing it is captured as Nothing, rather than putting a noLoc in the ParsedSource. Updates haddock submodule - - - - - 51828c6d by Sebastian Graf at 2021-03-01T17:32:48-05:00 Fix a bug causing loss of sharing in `UniqSDFM` While fixing #18610, I noticed that ```hs f :: Bool -> Int f x = case (x, x) of (True, True) -> 1 (False, False) -> 2 ``` was *not* detected as exhaustive. I tracked it down to `equateUSDFM`, where upon merging equality classes of `x` and `y`, we failed to atually indirect the *representative* `x'` of the equality class of `x` to the representative `y'` of `y`. The fixed code is much more naturally and would I should have written in the first place. I can confirm that the above example now is detected as exhaustive. The commit that fixes #18610 comes directly after and it has `f` above as a regression test, so I saw no need to open a ticket or commit a separate regression test. - - - - - e571eda7 by Sebastian Graf at 2021-03-01T17:32:48-05:00 Pmc: Implement `considerAccessible` (#18610) Consider (`T18610`): ```hs f :: Bool -> Int f x = case (x, x) of (True, True) -> 1 (False, False) -> 2 (True, False) -> 3 -- Warning: Redundant ``` The third clause will be flagged as redundant. Nevertheless, the programmer might intend to keep the clause in order to avoid bitrot. After this patch, the programmer can write ```hs g :: Bool -> Int g x = case (x, x) of (True, True) -> 1 (False, False) -> 2 (True, False) | GHC.Exts.considerAccessible -> 3 -- No warning ``` And won't be bothered any longer. See also `Note [considerAccessible]` and the updated entries in the user's guide. Fixes #18610 and #19228. - - - - - 5d7978df by Matthew Pickering at 2021-03-02T17:29:05-05:00 Define TRY_ACQUIRE_LOCK correctly when non-threaded - - - - - 8188adf0 by Ben Gamari at 2021-03-02T17:29:05-05:00 eventlog: Fix various races Previously the eventlog infrastructure had a couple of races that could pop up when using the startEventLog/endEventLog interfaces. In particular, stopping and then later restarting logging could result in data preceding the eventlog header, breaking the integrity of the stream. To fix this we rework the invariants regarding the eventlog and generally tighten up the concurrency control surrounding starting and stopping of logging. We also fix an unrelated bug, wherein log events from disabled capabilities could end up never flushed. - - - - - da351e44 by David Eichmann at 2021-03-02T17:29:05-05:00 Test start/endEventlogging: first header must be EVENT_HEADER_BEGIN - - - - - 507f8de2 by ARATA Mizuki at 2021-03-02T17:29:43-05:00 Add a test for the calling convention of "foreign import prim" on x86_64 and AArch64 - - - - - 38ebb9db by ARATA Mizuki at 2021-03-02T17:29:43-05:00 Support auto-detection of MAX_REAL_FLOAT_REG and MAX_REAL_DOUBLE_REG up to 6 Fixes #17953 - - - - - ede60537 by Ben Gamari at 2021-03-02T17:30:20-05:00 gitlab-ci: Disable utimensat in Darwin builds Fixes #17895. - - - - - 59e95bdf by Sebastian Graf at 2021-03-03T08:12:27-05:00 Fix typo in docs [skip ci] - - - - - eea96042 by Daniel Winograd-Cort at 2021-03-03T08:12:28-05:00 Add cmpNat, cmpSymbol, and cmpChar Add Data.Type.Ord Add and update tests Metric Increase: MultiLayerModules - - - - - d8dc0f96 by Sylvain Henry at 2021-03-03T08:12:29-05:00 Fix array and cleanup conversion primops (#19026) The first change makes the array ones use the proper fixed-size types, which also means that just like before, they can be used without explicit conversions with the boxed sized types. (Before, it was Int# / Word# on both sides, now it is fixed sized on both sides). For the second change, don't use "extend" or "narrow" in some of the user-facing primops names for conversions. - Names like `narrowInt32#` are misleading when `Int` is 32-bits. - Names like `extendInt64#` are flat-out wrong when `Int is 32-bits. - `narrow{Int,Word}<N>#` however map a type to itself, and so don't suffer from this problem. They are left as-is. These changes are batched together because Alex happend to use the array ops. We can only use released versions of Alex at this time, sadly, and I don't want to have to have a release thatwon't work for the final GHC 9.2. So by combining these we get all the changes for Alex done at once. Bump hackage state in a few places, and also make that workflow slightly easier for the future. Bump minimum Alex version Bump Cabal, array, bytestring, containers, text, and binary submodules - - - - - d89deeba by Matthew Pickering at 2021-03-03T08:12:29-05:00 Profiling: Allow heap profiling to be controlled dynamically. This patch exposes three new functions in `GHC.Profiling` which allow heap profiling to be enabled and disabled dynamically. 1. startHeapProfTimer - Starts heap profiling with the given RTS options 2. stopHeapProfTimer - Stops heap profiling 3. requestHeapCensus - Perform a heap census on the next context switch, regardless of whether the timer is enabled or not. - - - - - fe4202ce by Sylvain Henry at 2021-03-03T08:12:39-05:00 Always INLINE ($!) ($) is INLINE so there is no reason ($!) shouldn't. - - - - - 38748d5f by Sylvain Henry at 2021-03-03T08:12:39-05:00 Minor simplification for leak indicators Avoid returning a lazy panic value when leak indicators are disabled. - - - - - 8a433a3c by Sylvain Henry at 2021-03-03T08:12:39-05:00 Fix leaks of the HscEnv with quick flavour (#19356) Thanks @mpickering for finding them! - - - - - e81f2e4e by Ben Gamari at 2021-03-03T08:12:40-05:00 hadrian: Fix profiled flavour transformer Previously the profiled flavour transformer failed to add the profiled ways to the library and RTS ways lists, resulting in link failures. - - - - - 5c4dcc3e by Ben Gamari at 2021-03-03T08:12:40-05:00 ghc-heap: Fix profiled build Previously a255b4e38918065ac028789872e53239ac30ae1a failed to update the non-profiling codepath. - - - - - 3630b9ba by Sebastian Graf at 2021-03-03T08:12:40-05:00 DmdAnal: Better syntax for demand signatures (#19016) The update of the Outputable instance resulted in a slew of documentation changes within Notes that used the old syntax. The most important doc changes are to `Note [Demand notation]` and the user's guide. Fixes #19016. - - - - - 3f9af891 by Sylvain Henry at 2021-03-03T08:12:42-05:00 Add a flag to dump the FastString table - - - - - ad0c2073 by Andreas Klebinger at 2021-03-03T08:12:43-05:00 Build event logging rts in all flavours except GhcinGhci. This applies the fix for #19033 to all the other flavours as well. - - - - - df74e95a by Ryan Scott at 2021-03-03T08:12:43-05:00 User's Guide: document DefaultSignatures' interaction with subsumption As reported in #19432, the rules governing how `DefaultSignatures` are typechecked became stricter in GHC 9.0 due to simplified subsumption. However, this was far from obvious to me after reading the User's Guide section on `DefaultSignatures`. In this patch, I spruce up the documentation in that section so that it mentions these nuances. Resolves #19432. - - - - - 2f7e879b by Matthew Pickering at 2021-03-03T19:09:34+00:00 Revert "Remove GHC.Types.Unique.Map module" This reverts commit 1c7c6f1afc8e7f7ba5d256780bc9d5bb5f3e7601. - - - - - 8402ea95 by Matthew Pickering at 2021-03-03T19:09:34+00:00 Profiling by info table mode (-hi) This profiling mode creates bands by the address of the info table for each closure. This provides a much more fine-grained profiling output than any of the other profiling modes. The `-hi` profiling mode does not require a profiling build. - - - - - 4b297979 by Matthew Pickering at 2021-03-03T19:09:34+00:00 Add -finfo-table-map which maps info tables to source positions This new flag embeds a lookup table from the address of an info table to information about that info table. The main interface for consulting the map is the `lookupIPE` C function > InfoProvEnt * lookupIPE(StgInfoTable *info) The `InfoProvEnt` has the following structure: > typedef struct InfoProv_{ > char * table_name; > char * closure_desc; > char * ty_desc; > char * label; > char * module; > char * srcloc; > } InfoProv; > > typedef struct InfoProvEnt_ { > StgInfoTable * info; > InfoProv prov; > struct InfoProvEnt_ *link; > } InfoProvEnt; The source positions are approximated in a similar way to the source positions for DWARF debugging information. They are only approximate but in our experience provide a good enough hint about where the problem might be. It is therefore recommended to use this flag in conjunction with `-g<n>` for more accurate locations. The lookup table is also emitted into the eventlog when it is available as it is intended to be used with the `-hi` profiling mode. Using this flag will significantly increase the size of the resulting object file but only by a factor of 2-3x in our experience. - - - - - a7aac008 by Matthew Pickering at 2021-03-03T19:09:34+00:00 Add option to give each usage of a data constructor its own info table The `-fdistinct-constructor-tables` flag will generate a fresh info table for the usage of any data constructor. This is useful for debugging as now by inspecting the info table, you can determine which usage of a constructor caused that allocation rather than the old situation where the info table always mapped to the definition site of the data constructor which is useless. In conjunction with `-hi` and `-finfo-table-map` this gives a more fine grained understanding of where constructor allocations arise from in a program. - - - - - 9087899e by Matthew Pickering at 2021-03-03T19:09:34+00:00 Add whereFrom and whereFrom# primop The `whereFrom` function provides a Haskell interface for using the information created by `-finfo-table-map`. Given a Haskell value, the info table address will be passed to the `lookupIPE` function in order to attempt to find the source location information for that particular closure. At the moment it's not possible to distinguish the absense of the map and a failed lookup. - - - - - db80a5cc by Matthew Pickering at 2021-03-03T19:10:47+00:00 Add test for whereFrom# - - - - - 91d09039 by Matthew Pickering at 2021-03-03T19:11:06+00:00 Add release notes for -hi, -finfo-table-map and -fdistinct-constructor-tables - - - - - f121ffe4 by Matthew Pickering at 2021-03-03T19:11:08+00:00 Don't use FastString to convert string to UTF8 - - - - - 7b9767b8 by Matthew Pickering at 2021-03-03T19:11:08+00:00 Use a newtype for CHeader and CStub in ForeignStubs - - - - - f943edb0 by Matthew Pickering at 2021-03-03T19:11:08+00:00 IPE: Give all constructor and function tables locations During testing it was observed that quite a few info tables were not being given locations (due to not being assigned source locations, because they were not enclosed by a source note). We can at least give the module name and type for such closures even if no more accurate source information. Especially for constructors this helps find them in the STG dumps. - - - - - db898c8a by Krzysztof Gogolewski at 2021-03-04T23:14:01-05:00 Add a Template Haskell warning flag -Wimplicit-lift Part of #17804. - - - - - e679321e by Matthew Pickering at 2021-03-04T23:14:37-05:00 Hadrian: Enable -ticky-dyn-thunk in ticky_ghc transformer This produces much more detailed ticky profiles which include names of constructors. Related !3340 !2098 Fixes #19403 - - - - - c6ec7f48 by Ben Gamari at 2021-03-04T23:15:12-05:00 testsuite: Add test for #19413 This was fixed as a result of #19181. - - - - - f191fce7 by Ben Gamari at 2021-03-04T23:15:13-05:00 base: Add reference to #19413 to Note [unsafePerformIO and strictness] - - - - - 9de44e57 by Ben Gamari at 2021-03-04T23:15:48-05:00 rts: Make markLiveObject thread-safe markLiveObject is called by GC worker threads and therefore must be thread-safe. This was a rather egregious oversight which the testsuite missed. (cherry picked from commit fe28a062e47bd914a6879f2d01ff268983c075ad) - - - - - 1a52c53b by Ben Gamari at 2021-03-04T23:16:24-05:00 gitlab-ci: Build releases with hyperlinked sources Fixes #19455. - - - - - 4cdf8b5e by Cale Gibbard at 2021-03-04T23:17:00-05:00 Bring back COMPLETE sets filtered by result TyCon (#14422) Commit 2a94228 dramatically simplified the implementation and improved the performance of COMPLETE sets while making them applicable in more scenarios at the same time. But it turned out that there was a change in semantics that (to me unexpectedly) broke users' expectations (see #14422): They relied on the "type signature" of a COMPLETE pragma to restrict the scrutinee types of a pattern match for which they are applicable. This patch brings back that filtering, so the semantics is the same as it was in GHC 9.0. See the updated Note [Implementation of COMPLETE pragmas]. There are a few testsuite output changes (`completesig13`, `T14422`) which assert this change. Co-authored-by: Sebastian Graf <sebastian.graf at kit.edu> - - - - - 6467a48e by Ben Gamari at 2021-03-04T23:17:36-05:00 testsuite: Prevent T16318 from picking up .ghci Previously this test did nothing to prevent GHC from reading .ghci due to the `-e` arguments. Consequently it could fail due to multiple reloadings of DynFlags while evaluating .ghci. - - - - - 4cd98bd2 by Krzysztof Gogolewski at 2021-03-05T04:48:39-05:00 Run linear Lint on the desugarer output (part of #19165) This addresses points (1a) and (1b) of #19165. - Move mkFailExpr to HsToCore/Utils, as it can be shared - Desugar incomplete patterns and holes to an empty case, as in Note [Incompleteness and linearity] - Enable linear linting of desugarer output - Mark MultConstructor as broken. It fails Lint, but I'd like to fix this separately. Metric Decrease: T6048 - - - - - b5155a6c by Harry Garrood harry at garrood.me at 2021-03-05T04:49:18-05:00 Add new driver test for use of outdated .o files This is something that's quite important for the correctness of the incremental build system and doesn't appear to be tested currently; this test fails on my hashing branch, whereas all of the other (non-perf) tests pass. - - - - - 6141aef4 by Andreas Klebinger at 2021-03-05T14:01:20-05:00 Update bounds/hadrian to fix bootstrapping with 9.0. This fixes #19484. In detail we: * Bump the index-state of hackage. * Require alex-3.2.6, as alex-3.2.5 doesn't build with 9.0. * Allow Cabal-3.4 as 3.2 doesn't build with ghc 9.0. * Allow a newer QuickCheck version that accepts the new base version. * Some code changes to account for Cabal changes. - - - - - 31e265c1 by Andreas Schwab at 2021-03-05T14:01:56-05:00 Implement riscv64 LLVM backend This enables a registerised build for the riscv64 architecture. - - - - - dd23bd74 by Sylvain Henry at 2021-03-06T02:33:32-05:00 Windows: fix crlf on checkout Using .gitatttributes, we don't require users to set git's core.autocrlf setting to false on Windows to be able to checkout a working tree. - - - - - 9e0c0c3a by Ben Gamari at 2021-03-06T02:34:08-05:00 hadrian: Pass -fno-use-rpaths to GHC while linking This mirrors the make build system and ensures that we don't end up with references to the build directory in the final executable. Fixes #19485. - - - - - cf65cf16 by Shayne Fletcher at 2021-03-06T19:27:04-05:00 Implement record dot syntax - - - - - 3e082f8f by Ben Gamari at 2021-03-07T17:01:40-05:00 Implement BoxedRep proposal This implements the BoxedRep proposal, refactoring the `RuntimeRep` hierarchy from: ```haskell data RuntimeRep = LiftedPtrRep | UnliftedPtrRep | ... ``` to ```haskell data RuntimeRep = BoxedRep Levity | ... data Levity = Lifted | Unlifted ``` Updates binary, haddock submodules. Closes #17526. Metric Increase: T12545 - - - - - 657b5538 by Peter Trommler at 2021-03-08T07:31:39-05:00 Hadrian: Add powerpc64[le] to supported arch list Fixes #19409 - - - - - 33a4fd99 by Matthew Pickering at 2021-03-08T07:32:15-05:00 eventlog: Add MEM_RETURN event to give information about fragmentation See #19357 The event reports the * Current number of megablocks allocated * The number that the RTS thinks it needs * The number is managed to return to the OS When current > need then the difference is returned to the OS, the successful number of returned mblocks is reported by 'returned'. In a fragmented heap current > need but returned < current - need. - - - - - ffc96439 by Matthew Pickering at 2021-03-08T07:32:15-05:00 eventlog: Add BLOCKS_SIZE event The BLOCKS_SIZE event reports the size of the currently allocated blocks in bytes. It is like the HEAP_SIZE event, but reports about the blocks rather than megablocks. You can work out the current heap fragmentation by looking at the difference between HEAP_SIZE and BLOCKS_SIZE. Fixes #19357 - - - - - e145e44c by Matthew Pickering at 2021-03-08T07:32:15-05:00 eventlog: Add changelog entry for BLOCKS_SIZE and MEM_RETURN - - - - - e483775c by Daniel Winograd-Cort at 2021-03-08T07:32:53-05:00 Update changelog and release notes for Data.Type.Ord change - - - - - daa6363f by Sylvain Henry at 2021-03-08T18:24:07-05:00 DynFlags: move temp file management into HscEnv (#17957) - - - - - 47d6acd3 by Matthew Pickering at 2021-03-08T18:24:42-05:00 rts: Use a separate free block list for allocatePinned The way in which allocatePinned took blocks out of the nursery was leading to horrible fragmentation in some workloads. The strategy now is that a separate free block list is reserved for each capability and blocks are taken from there. When it's empty the global SM lock is taken and a fresh block of size PINNED_EMPTY_SIZE is allocated. Fixes #19481 - - - - - bfa86250 by Matthew Pickering at 2021-03-08T18:25:19-05:00 eventlog: Repost initialisation events when eventlog restarts If startEventlog is called after the program has already started running then quite a few useful events are missing from the eventlog because they are only posted when the program starts. This patch adds a mechanism to declare that an event should be reposted everytime the startEventlog function is called. Now in EventLog.c there is a global list of functions called `eventlog_header_funcs` which stores a list of functions which should be called everytime the eventlog starts. When calling `postInitEvent`, the event will not only be immediately posted to the eventlog but also added to the global list. When startEventLog is called, the list is traversed and the events reposted. - - - - - 0a709dd9 by Ryan Scott at 2021-03-09T02:46:20-05:00 Require GHC 8.10 as the minimum compiler for bootstrapping Now that GHC 9.0.1 is released, it is time to drop support for bootstrapping with GHC 8.8, as we only support building with the previous two major GHC releases. As an added bonus, this allows us to remove several bits of CPP that are either always true or no longer reachable. - - - - - 376427ec by Ryan Scott at 2021-03-09T02:46:56-05:00 Document operator sections' interaction with subsumption This resolves #19457 by making a note of breaking changes (introduced in GHC 9.2) to the way that GHC typechecks operator sections where the operator has nested `forall`s or contexts in its type signature. - - - - - 7a728ca6 by Andreas Klebinger at 2021-03-09T02:47:31-05:00 Add a distclean command to hadrian. Hadrian should behave well and not delete files created by configure with the clean command. With this patch hadrian now deletes the fs/mingw tarballs only with distclean. This fixes #19320. The main impact being that validate won't have to redownload the tarballs when re-run. - - - - - aaa5fc21 by Vladislav Zavialov at 2021-03-09T18:51:55-05:00 Replace Ord TyLit with nonDetCmpTyLit (#19441) The Ord instance was non-deterministic, but it's easy assume that it is deterministic. In fact, haddock-api used to do exactly that before haddock/7e8c7c3491f3e769368b8e6c767c62a33e996c80 - - - - - 8fe274e2 by Simon Peyton Jones at 2021-03-09T18:52:32-05:00 Fixes to dealing with the export of main It's surprisingly tricky to deal with 'main' (#19397). This patch does quite bit of refactoring do to it right. Well, more-right anyway! The moving parts are documented in GHC.Tc.Module Note [Dealing with main] Some other oddments: * Rename tcRnExports to rnExports; no typechecking here! * rnExports now uses checkNoErrs rather than failIfErrsM; the former fails only if rnExports itself finds errors * Small improvements to tcTyThingCategory, which ultimately weren't important to the patch, but I've retained as a minor improvement. - - - - - e9189745 by Ryan Scott at 2021-03-09T18:53:07-05:00 Fix some warnings when bootstrapping with GHC 9.0 This fixes two classes of warnings that appear when bootstrapping with GHC 9.0: * `ghc-boot.cabal` was using `cabal-version: >=1.22`, which `cabal-install-3.4` now warns about, instead recommending the use of `cabal-version: 1.22`. * Several pattern matches were producing `Pattern match(es) are non-exhaustive` because of incorrect CPP. The pattern-match coverage checker _did_ become smarter in GHC 9.1, however, so I ended up needing to keep the CPP, adjusting them to use `#if __GLASGOW_HASKELL__ < 901` instead. - - - - - df8e8ba2 by Vladislav Zavialov at 2021-03-09T18:53:43-05:00 Location for tuple section pattern error (#19504) This fixes a regression that led to loss of location information in error messages about the use of tuple sections in patterns. - - - - - afc357d2 by Matthew Pickering at 2021-03-10T10:33:36-05:00 rts: Gradually return retained memory to the OS Related to #19381 #19359 #14702 After a spike in memory usage we have been conservative about returning allocated blocks to the OS in case we are still allocating a lot and would end up just reallocating them. The result of this was that up to 4 * live_bytes of blocks would be retained once they were allocated even if memory usage ended up a lot lower. For a heap of size ~1.5G, this would result in OS memory reporting 6G which is both misleading and worrying for users. In long-lived server applications this results in consistent high memory usage when the live data size is much more reasonable (for example ghcide) Therefore we have a new (2021) strategy which starts by retaining up to 4 * live_bytes of blocks before gradually returning uneeded memory back to the OS on subsequent major GCs which are NOT caused by a heap overflow. Each major GC which is NOT caused by heap overflow increases the consec_idle_gcs counter and the amount of memory which is retained is inversely proportional to this number. By default the excess memory retained is oldGenFactor (controlled by -F) / 2 ^ (consec_idle_gcs * returnDecayFactor) On a major GC caused by a heap overflow, the `consec_idle_gcs` variable is reset to 0 (as we could continue to allocate more, so retaining all the memory might make sense). Therefore setting bigger values for `-Fd` makes the rate at which memory is returned slower. Smaller values make it get returned faster. Setting `-Fd0` disables the memory return completely, which is the behaviour of older GHC versions. The default is `-Fd4` which results in the following scaling: > mapM print [(x, 1/ (2**(x / 4))) | x <- [1 :: Double ..20]] (1.0,0.8408964152537146) (2.0,0.7071067811865475) (3.0,0.5946035575013605) (4.0,0.5) (5.0,0.4204482076268573) (6.0,0.35355339059327373) (7.0,0.29730177875068026) (8.0,0.25) (9.0,0.21022410381342865) (10.0,0.17677669529663687) (11.0,0.14865088937534013) (12.0,0.125) (13.0,0.10511205190671433) (14.0,8.838834764831843e-2) (15.0,7.432544468767006e-2) (16.0,6.25e-2) (17.0,5.255602595335716e-2) (18.0,4.4194173824159216e-2) (19.0,3.716272234383503e-2) (20.0,3.125e-2) So after 13 consecutive GCs only 0.1 of the maximum memory used will be retained. Further to this decay factor, the amount of memory we attempt to retain is also influenced by the GC strategy for the oldest generation. If we are using a copying strategy then we will need at least 2 * live_bytes for copying to take place, so we always keep that much. If using compacting or nonmoving then we need a lower number, so we just retain at least `1.2 * live_bytes` for some protection. In future we might want to make this behaviour more aggressive, some relevant literature is > Ulan Degenbaev, Jochen Eisinger, Manfred Ernst, Ross McIlroy, and Hannes Payer. 2016. Idle time garbage collection scheduling. SIGPLAN Not. 51, 6 (June 2016), 570–583. DOI:https://doi.org/10.1145/2980983.2908106 which describes the "memory reducer" in the V8 javascript engine which on an idle collection immediately returns as much memory as possible. - - - - - d095954b by Adam Gundry at 2021-03-10T10:33:36-05:00 Do not remove shadowed record selectors from interactive context (fixes #19322) - - - - - 5581e7b4 by Adam Gundry at 2021-03-10T10:33:36-05:00 Simplify shadowing of DuplicateRecordFields in GHCi (fixes #19314) Previously, defining fields with DuplicateRecordFields in GHCi lead to strange shadowing behaviour, whereby fields would (accidentally) not shadow other fields. This simplifies things so that fields are shadowed in the same way whether or not DuplicateRecordFields is enabled. - - - - - 7d212b49 by Ben Gamari at 2021-03-10T13:18:17-05:00 FastMutInt: Drop FastMutPtr This appears to be unused. - - - - - e6c9b1e6 by Ben Gamari at 2021-03-10T13:20:49-05:00 FastMutInt: Ensure that newFastMutInt initializes value Updates haddock submodule. - - - - - 41b183d6 by Ben Gamari at 2021-03-10T13:20:55-05:00 FastMutInt: Introduce atomicFetchAddFastMutInt This will be needed by FastString. - - - - - aa9dc323 by Ben Gamari at 2021-03-10T13:20:55-05:00 FastString: Use FastMutInt instead of IORef Int This saves at least one I# allocation per FastString. - - - - - e687ba83 by Ben Gamari at 2021-03-10T15:55:09-05:00 Bump bytestring submodule to 0.11.1.0 - - - - - 8a59f49a by Luke Lau at 2021-03-10T15:55:09-05:00 template-haskell: Add putDoc, getDoc, withDecDoc and friends This adds two new methods to the Quasi class, putDoc and getDoc. They allow Haddock documentation to be added to declarations, module headers, function arguments and class/type family instances, as well as looked up. It works by building up a map of names to attach pieces of documentation to, which are then added in the extractDocs function in GHC.HsToCore.Docs. However because these template haskell names need to be resolved to GHC names at the time they are added, putDoc cannot directly add documentation to declarations that are currently being spliced. To remedy this, withDecDoc/withDecsDoc wraps the operation with addModFinalizer, and provides a more ergonomic interface for doing so. Similarly, the funD_doc, dataD_doc etc. combinators provide a more ergonomic interface for documenting functions and their arguments simultaneously. This also changes ArgDocMap to use an IntMap rather than an Map Int, for efficiency. Part of the work towards #5467 - - - - - 30ccf9ed by Joachim Breitner at 2021-03-10T16:57:59-05:00 Introduce GHC2021 language This adds support for -XGHC2021, as described in Proposal 0380 [1]. [1] https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0380-ghc2021.rst - - - - - 115cd3c8 by Joachim Breitner at 2021-03-10T16:58:50-05:00 Use GHC2021 as default language - - - - - fcfc66e5 by Roland Senn at 2021-03-10T16:59:05-05:00 Ignore breakpoint for a specified number of iterations. (#19157) * Implement new debugger command `:ignore` to set an `ignore count` for a specified breakpoint. * Allow new optional parameter on `:continue` command to set an `ignore count` for the current breakpoint. * In the Interpreter replace the current `Word8` BreakArray with an `Int` array. * Change semantics of values in `BreakArray` to: n < 0 : Breakpoint is disabled. n == 0 : Breakpoint is enabled. n > 0 : Breakpoint is enabled, but ignore next `n` iterations. * Rewrite `:enable`/`:disable` processing as a special case of `:ignore`. * Remove references to `BreakArray` from `ghc/UI.hs`. - - - - - d964d6fa by GHC GitLab CI at 2021-03-11T23:13:16-05:00 testsuite: Update Win32 test output for GHC2021 Fixes the Windows CI jobs. Requires update of the Win32 submodule. - - - - - 4fb704a5 by Tamar Christina at 2021-03-12T15:19:15-05:00 Update win32 submodule - - - - - edc9f7d4 by Moritz Angermann at 2021-03-13T01:09:03-05:00 Shorten the build pipeline - - - - - abe0f45b by Moritz Angermann at 2021-03-13T20:27:31+08:00 bump submodule nofib - - - - - ba601db4 by Moritz Angermann at 2021-03-13T23:29:03+08:00 Force eol=lf; to prevent windows breakage. - - - - - 96b3c66b by Moritz Angermann at 2021-03-14T11:52:56+08:00 Allow perf-nofib to fail - - - - - b73c9c5f by Sebastian Graf at 2021-03-14T12:54:29-04:00 Implement the UnliftedDatatypes extension GHC Proposal: 0265-unlifted-datatypes.rst Discussion: https://github.com/ghc-proposals/ghc-proposals/pull/265 Issues: https://gitlab.haskell.org/ghc/ghc/-/issues/19523 Implementation Details: Note [Implementation of UnliftedDatatypes] This patch introduces the `UnliftedDatatypes` extension. When this extension is enabled, GHC relaxes the restrictions around what result kinds are allowed in data declarations. This allows data types for which an unlifted or levity-polymorphic result kind is inferred. The most significant changes are in `GHC.Tc.TyCl`, where `Note [Implementation of UnliftedDatatypes]` describes the details of the implementation. Fixes #19523. - - - - - cd793767 by Matthew Pickering at 2021-03-14T12:55:07-04:00 Correct module name in `-fprof-callers` documentation - - - - - 1793ca9d by Sebastian Graf at 2021-03-14T12:55:45-04:00 Pmc: Consider Required Constraints when guessing PatSyn arg types (#19475) This patch makes `guessConLikeUnivTyArgsFromResTy` consider required Thetas of PatSynCons, by treating them as Wanted constraints to be discharged with the constraints from the Nabla's TyState and saying "does not match the match type" if the Wanted constraints are unsoluble. It calls out into a new function `GHC.Tc.Solver.tcCheckWanteds` to do so. In pushing the failure logic around call sites of `initTcDsForSolver` inside it by panicking, I realised that there was a bunch of dead code surrounding `pmTopMoraliseType`: I was successfully able to delete the `NoChange` data constructor of `TopNormaliseTypeResult`. The details are in `Note [Matching against a ConLike result type]` and `Note [Instantiating a ConLike]. The regression test is in `T19475`. It's pretty much a fork of `T14422` at the moment. Co-authored-by: Cale Gibbard <cgibbard at gmail.com> - - - - - b15c876d by Matthew Pickering at 2021-03-14T12:56:21-04:00 Make traceHeapEventInfo an init event This means it will be reposted everytime the eventlog is started. - - - - - d412cd10 by Sylvain Henry at 2021-03-14T12:57:01-04:00 Write explicit IOEnv's Functor and MonadIO instances (#18202) - - - - - 87ae062a by Sylvain Henry at 2021-03-14T12:57:40-04:00 Compute length only once in foldBal - - - - - 7ea7624c by Ryan Scott at 2021-03-15T00:42:27-04:00 Document the interaction between ScopedTypeVariables and StandaloneKindSignatures This documents a limitation of `StandaloneKindSignatures`—namely, that it does not bring type variables bound by an outermost `forall` into scope over a type-level declaration—in the GHC User's Guide. See #19498 for more discussion. - - - - - 92d98424 by Vladislav Zavialov at 2021-03-15T00:43:05-04:00 Fix record dot precedence (#19521) By moving the handling of TIGHT_INFIX_PROJ to the correct place, we can remove the isGetField hack and fix a bug at the same time. - - - - - 545cfefa by Vladislav Zavialov at 2021-03-15T00:43:05-04:00 Test chained record construction/update/access According to the proposal, we have the following equivalence: e{lbl1 = val1}.val2 == (e{lbl1 = val1}).val2 This is a matter of parsing. Record construction/update must have the same precedence as dot access. Add a test case to ensure this. - - - - - b5b51c54 by Moritz Angermann at 2021-03-16T10:04:23+08:00 [ci] Skip test's on windows that often fail in CI. - - - - - 58cfcc65 by Hécate Moonlight at 2021-03-17T00:57:17-04:00 Make the CI jobs interruptible closes #19362 - - - - - 43a64744 by Moritz Angermann at 2021-03-17T04:16:27-04:00 [ci] don't make marge double build. This fixes !18744 - - - - - f11954b1 by ARATA Mizuki at 2021-03-17T19:05:13-04:00 Add a test for fromInteger :: Integer -> Float/Double (#15926, #17231, #17782) - - - - - 540fa6b2 by ARATA Mizuki at 2021-03-17T19:05:13-04:00 fromInteger :: Integer -> {Float,Double} now always round to nearest even integerToFloat# and integerToDouble# were moved from ghc-bignum to base. GHC.Integer.floatFromInteger and doubleFromInteger were removed. Fixes #15926, #17231, #17782 - - - - - 84927818 by Ben Gamari at 2021-03-17T19:05:50-04:00 llvmGen: Accept range of LLVM versions Previously we would support only one LLVM major version. Here we generalize this to accept a range, taking this range to be LLVM 10 to 11, as 11 is necessary for Apple M1 support. We also accept 12, as that is what apple ships with BigSur on the M1. - - - - - d14a2068 by Sylvain Henry at 2021-03-17T19:06:33-04:00 Enhance pass result forcing When we use `withTiming` we need to force the results of each timed pass to better represent the time spent in each phase. This patch forces some results that weren't before. It also retrieve timings for the CoreToStg and WriteIface passes. - - - - - 665b757f by Ben Gamari at 2021-03-17T19:07:10-04:00 IfaceToType: Ensure that IfaceTyConInfo is shared In #19194 mpickering detailed that there are a LOT of allocations of IfaceTyConInfo: There are just two main cases: IfaceTyConInfo IsPromoted IfaceNormalTyCon and IfaceTyConInfo NotPromoted IfaceNormalTyCon. These should be made into CAFs and shared. From my analysis, the most common case is IfaceTyConInfo NotPromoted IfaceNormalTyCon (53 000) then IfaceTyConInfo IsPromoted IfaceNormalTyCon (28 000). This patch makes it so these are properly shared by using a smart constructor. Fixes #19194. - - - - - 4fbc8558 by Ben Gamari at 2021-03-17T19:07:47-04:00 Eliminate selector thunk allocations - - - - - 42049339 by Ben Gamari at 2021-03-17T19:07:47-04:00 CmmToAsm.Reg.Linear: Make linearRA body a join point Avoid top-level recursion. - - - - - fe6cad22 by Ben Gamari at 2021-03-17T19:07:47-04:00 CmmtoAsm.Reg.Linear: Rewrite process CmmToAsm.Reg.Linear: More strictness More strictness - - - - - 6b10163e by Sylvain Henry at 2021-03-17T19:08:27-04:00 Disable bogus assertion (#19489) - - - - - 26d26974 by Ryan Scott at 2021-03-17T19:09:03-04:00 Document how GADT patterns are matched from left-to-right, outside-in This adds some bullet points to the GHC User's Guide section on `GADTs` to explain some subtleties in how GHC typechecks GADT patterns. In particular, this adds examples of programs being rejected for matching on GADTs in a way that does not mesh with GHC's left-to-right, outside-in order for checking patterns, which can result in programs being rejected for seemingly counterintuitive reasons. (See #12018 for examples of confusion that arose from this.) In addition, now that we have visible type application in data constructor patterns, I mention a possible workaround of using `TypeApplications` to repair programs of this sort. Resolves #12018. - - - - - 30285415 by Vladislav Zavialov at 2021-03-17T19:09:40-04:00 Built-in type families: CharToNat, NatToChar (#19535) Co-authored-by: Daniel Rogozin <daniel.rogozin at serokell.io> Co-authored-by: Rinat Stryungis <rinat.stryungis at serokell.io> - - - - - 0a986685 by Ben Gamari at 2021-03-19T19:58:52-04:00 testsuite: Make --ignore-perf-tests more expressive Allow skipping of only increases/decreases. - - - - - d03d8761 by Ben Gamari at 2021-03-19T19:58:52-04:00 gitlab-ci: Ignore performance improvements in marge jobs Currently we have far too many merge failures due to cumulative performance improvements. Avoid this by accepting metric decreases in marge-bot jobs. Fixes #19562. - - - - - 7d027433 by Gaël Deest at 2021-03-20T07:48:01-04:00 [skip ci] Fix 'Ord' documentation inconsistency Current documentation for the `Ord` typeclass is inconsistent. It simultaneously mentions that: > The 'Ord' class is used for totally ordered datatypes. And: > The Haskell Report defines no laws for 'Ord'. However, '<=' is > customarily expected to implement a non-strict partial order […] The Haskell report (both 98 and 2010 versions) mentions total ordering, which implicitly does define laws. Moreover, `compare :: Ord a => a -> a -> Ordering` and `data Ordering = LT | EQ | GT` imply that the order is indeed total (there is no way to say that two elements are not comparable). This MR fixes the Haddock comment, and adds a comparability law to the list of suggested properties. - - - - - f940fd46 by Alan Zimmerman at 2021-03-20T07:48:37-04:00 Add the main types to be used for exactprint in the GHC AST The MR introducing the API Annotations, !2418 is huge. Conceptually it is two parts, the one deals with introducing the new types to be used for annotations, and outlining how they will be used. This is a small change, localised to compiler/GHC/Parser/Annotation.hs and is contained in this commit. The follow-up, larger commit deals with mechanically working this through the entire AST and updating all the parts affected by it. It is being split so the part that needs good review feedback can be seen in isolation, prior to the rest coming in. - - - - - 95275a5f by Alan Zimmerman at 2021-03-20T07:48:38-04:00 GHC Exactprint main commit Metric Increase: T10370 parsing001 Updates haddock submodule - - - - - adf93721 by GHC GitLab CI at 2021-03-20T07:48:38-04:00 check-ppr,check-exact: Write out result as binary Previously we would use `writeFile` to write the intermediate files to check for round-tripping. However, this will open the output handle as a text handle, which on Windows will change line endings. Avoid this by opening as binary. Explicitly use utf8 encoding. This is for tests only, do not need to worry about user compatibility. - - - - - ceef490b by GHC GitLab CI at 2021-03-20T07:48:38-04:00 testsuite: Normalise slashes In the `comments` and `literals` tests, since they contain file paths. - - - - - dd11f2d5 by Luite Stegeman at 2021-03-20T07:49:15-04:00 Save the type of breakpoints in the Breakpoint tick in STG GHCi needs to know the types of all breakpoints, but it's not possible to get the exprType of any expression in STG. This is preparation for the upcoming change to make GHCi bytecode from STG instead of Core. - - - - - 26328a68 by Luite Stegeman at 2021-03-20T07:49:15-04:00 remove superfluous 'id' type parameter from GenTickish The 'id' type is now determined by the pass, using the XTickishId type family. - - - - - 0107f356 by Luite Stegeman at 2021-03-20T07:49:15-04:00 rename Tickish to CoreTickish - - - - - 7de3532f by Luite Stegeman at 2021-03-20T07:49:15-04:00 Transfer tickish things to GHC.Types.Tickish Metric Increase: MultiLayerModules - - - - - 1f94e0f7 by Luite Stegeman at 2021-03-20T07:49:15-04:00 Generate GHCi bytecode from STG instead of Core and support unboxed tuples and sums. fixes #1257 - - - - - 62b0e1bc by Andreas Klebinger at 2021-03-20T07:49:50-04:00 Make the simplifier slightly stricter. This commit reduces allocations by the simplifier by 3% for the Cabal test at -O2. We do this by making a few select fields, bindings and arguments strict which reduces allocations for the simplifier by around 3% in total for the Cabal test. Which is about 2% fewer allocations in total at -O2. ------------------------- Metric Decrease: T18698a T18698b T9233 T9675 T9872a T9872b T9872c T9872d T10421 T12425 T13253 T5321FD T9961 ------------------------- - - - - - 044e5be3 by Sebastian Graf at 2021-03-20T07:50:26-04:00 Nested CPR light (#19398) While fixing #19232, it became increasingly clear that the vestigial hack described in `Note [Optimistic field binder CPR]` is complicated and causes reboxing. Rather than make the hack worse, this patch gets rid of it completely in favor of giving deeply unboxed parameters the Nested CPR property. Example: ```hs f :: (Int, Int) -> Int f p = case p of (x, y) | x == y = x | otherwise = y ``` Based on `p`'s `idDemandInfo` `1P(1P(L),1P(L))`, we can see that both fields of `p` will be available unboxed. As a result, we give `p` the nested CPR property `1(1,1)`. When analysing the `case`, the field CPRs are transferred to the binders `x` and `y`, respectively, so that we ultimately give `f` the CPR property. I took the liberty to do a bit of refactoring: - I renamed `CprResult` ("Constructed product result result") to plain `Cpr`. - I Introduced `FlatConCpr` in addition to (now nested) `ConCpr` and and according pattern synonym that rewrites flat `ConCpr` to `FlatConCpr`s, purely for compiler perf reasons. - Similarly for performance reasons, we now store binders with a Top signature in a separate `IntSet`, see `Note [Efficient Top sigs in SigEnv]`. - I moved a bit of stuff around in `GHC.Core.Opt.WorkWrap.Utils` and introduced `UnboxingDecision` to replace the `Maybe DataConPatContext` type we used to return from `wantToUnbox`. - Since the `Outputable Cpr` instance changed anyway, I removed the leading `m` which we used to emit for `ConCpr`. It's just noise, especially now that we may output nested CPRs. Fixes #19398. - - - - - 8592a246 by Simon Jakobi at 2021-03-20T07:51:01-04:00 Add compiler perf regression test for #9198 - - - - - d4605e7c by Simon Peyton Jones at 2021-03-20T07:51:36-04:00 Fix an levity-polymorphism error As #19522 points out, we did not account for visible type application when trying to reject naked levity-polymorphic functions that have no binding. This patch tidies up the code, and fixes the bug too. - - - - - 3fa3fb79 by John Ericson at 2021-03-20T07:52:12-04:00 Add more boundary checks for `rem` and `mod` It's quite backend-dependent whether we will actually handle that case right, so let's just always do this as a precaution. In particular, once we replace the native primops used here with the new sized primops, the 16-bit ones on x86 will begin to use 16-bit sized instructions where they didn't before. Though I'm not sure of any arch which has 8-bit scalar instructions, I also did those for consistency. Plus, there are *vector* 8-bit ops in the wild, so if we ever got into autovectorization or something maybe it's prudent to put this here as a reminder not to forget about catching overflows. Progress towards #19026 - - - - - 8e054ff3 by John Ericson at 2021-03-20T07:52:47-04:00 Fix literals for unregisterized backend of small types All credit to @hsyl20, who in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4717#note_338560 figured out this was a problem. To fix this, we use casts in addition to the shrinking and suffixing that is already done. It might make for more verbose code, I don't think that matters too much. In the future, perhaps some of the shrinking and suffixing can be removed for being redundant. That proved less trivial than it sounds, so this wasn't done at this time. Progress towards #19026 Metric Increase: T12707 T13379 Co-authored-by: Sylvain Henry <hsyl20 at gmail.com> - - - - - 226cefd0 by Sylvain Henry at 2021-03-20T07:53:24-04:00 Fix fake import in GHC.Exception.Type boot module It seems like I imported "GHC.Types ()" thinking that it would transitively import GHC.Num.Integer when I wrote that module; but it doesn't. This led to build failures. See https://mail.haskell.org/pipermail/ghc-devs/2021-March/019641.html - - - - - e84e2805 by Viktor Dukhovni at 2021-03-20T07:54:01-04:00 Add fold vs. mconcat test T17123 - - - - - fa499356 by Sebastian Graf at 2021-03-20T07:54:36-04:00 Remove outdated Vagrantfile - - - - - 71e609fb by Moritz Angermann at 2021-03-20T07:55:11-04:00 Add error information to osCommitMemory on failure. - - - - - fb939498 by Ben Gamari at 2021-03-20T10:20:30-04:00 gitlab-ci: Always start with fresh clone Currently we are suffering from issues that appear to be caused by non-hermetic builds. Try avoiding this by setting `GIT_STRATEGY` to `clone`. - - - - - c53faa0c by Ben Gamari at 2021-03-20T15:12:12-04:00 Clean up TBDs in changelog (cherry picked from commit 4f334120c8e9cc4aefcbf11d99f169f648af9fde) - - - - - 91ddac2f by Ryan Scott at 2021-03-20T15:12:12-04:00 Move miscategorized items in template-haskell changelog - - - - - 6a375b53 by Ryan Scott at 2021-03-20T15:12:12-04:00 Bump template-haskell version to 2.18.0.0 This requires bumping the `exceptions` and `text` submodules to bring in commits that bump their respective upper version bounds on `template-haskell`. Fixes #19083. - - - - - adbaa9a9 by Ryan Scott at 2021-03-21T19:40:02-04:00 Remove unnecessary extendTyVarEnvFVRn function The `extendTyVarEnvFVRn` function does the exact same thing as `bindLocalNamesFV`. I see no meaningful distinction between the two functions, so let's just remove the former (which is only used in a handful of places) in favor of the latter. Historical note: `extendTyVarEnvFVRn` and `bindLocalNamesFV` used to be distinct functions, but their implementations were synchronized in 2004 as a part of commit 20e39e0e07e4a8e9395894b2785d6675e4e3e3b3. - - - - - 0cbdba27 by Moritz Angermann at 2021-03-21T21:04:42-04:00 [ci/arm/darwin/testsuite] Forwards ports from GHC-8.10 This is a set of forward ports (cherry-picks) from 8.10 - a7d22795ed [ci] Add support for building on aarch64-darwin - 5109e87e13 [testlib/driver] denoise - 307d34945b [ci] default value for CONFIGURE_ARGS - 10a18cb4e0 [testsuite] mark ghci056 as fragile - 16c13d5acf [ci] Default value for MAKE_ARGS - ab571457b9 [ci/build] Copy config.sub around - 251892b98f [ci/darwin] bump nixpkgs rev - 5a6c36ecb4 [testsuite/darwin] fix conc059 - aae95ef0c9 [ci] add timing info - 3592d1104c [Aarch64] No div-by-zero; disable test. - 57671071ad [Darwin] mark stdc++ tests as broken - 33c4d49754 [testsuite] filter out superfluous dylib warnings - 4bea83afec [ci/nix-shell] Add Foundation and Security - 6345530062 [testsuite/json2] Fix failure with LLVM backends - c3944bc89d [ci/nix-shell] [Darwin] Stop the ld warnings about libiconv. - b821fcc714 [testsuite] static001 is not broken anymore. - f7062e1b0c [testsuite/arm64] fix section_alignment - 820b076698 [darwin] stop the DYLD_LIBRARY_PATH madness - 07b1af0362 [ci/nix-shell] uniquify NIX_LDFLAGS{_FOR_TARGET} As well as a few additional fixups needed to make this block compile: - Fixup all.T - Set CROSS_TARGET, BROKEN_TESTS, XZ, RUNTEST_ARGS, default value. - [ci] shell.nix bump happy - - - - - c46e8147 by Moritz Angermann at 2021-03-21T21:04:42-04:00 [elf/aarch64] Fall Through decoration - - - - - 069abe27 by Moritz Angermann at 2021-03-21T21:04:42-04:00 [llvm/darwin] change vortex cpu to generic For now only the apple flavoured llvm knows vortex, as we build against other toolchains, lets stay with generic for now. - - - - - 2907949c by Moritz Angermann at 2021-03-21T21:04:42-04:00 [ci] Default values for GITLAB_CI_BRANCH, and IGNORE_PERF_FAILURES - - - - - e82d32d6 by Ben Gamari at 2021-03-22T09:22:29-04:00 compiler: Introduce mutableByteArrayContents# primop As noted in #19540, a number of users within and outside of GHC rely on unsafeCoerceUnlifted to work around the fact that this was missing - - - - - eeba7a3a by Ben Gamari at 2021-03-22T09:22:29-04:00 base: Use mutableByteArrayContents - - - - - a9129f9f by Simon Peyton Jones at 2021-03-22T09:23:04-04:00 Short-circuit warning generation for partial type signatures This Note says it all: Note [Skip type holes rapidly] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Suppose we have module with a /lot/ of partial type signatures, and we compile it while suppressing partial-type-signature warnings. Then we don't want to spend ages constructing error messages and lists of relevant bindings that we never display! This happened in #14766, in which partial type signatures in a Happy-generated parser cause a huge increase in compile time. The function ignoreThisHole short-circuits the error/warning generation machinery, in cases where it is definitely going to be a no-op. It makes a pretty big difference on the Sigs.hs example in #14766: Compile-time allocation GHC 8.10 5.6G Before this patch 937G With this patch 4.7G Yes, that's more than two orders of magnitude! - - - - - 6e437a12 by Ben Gamari at 2021-03-22T18:35:24-04:00 UniqSM: oneShot-ify Part of #18202 ------------------------- Metric Decrease: T12707 T3294 ------------------------- - - - - - 26dd1f88 by Simon Peyton Jones at 2021-03-23T08:09:05-04:00 More improvement to MonoLocalBinds documentation - - - - - 26ba86f7 by Peter Trommler at 2021-03-23T08:09:40-04:00 PPC NCG: Fix int to float conversion In commit 540fa6b2 integer to float conversions were changed to round to the nearest even. Implement a special case for 64 bit integer to single precision floating point numbers. Fixes #19563. - - - - - 7a657751 by Ben Gamari at 2021-03-23T13:00:37-04:00 rts: Use long-path-aware stat Previously `pathstat` relied on msvcrt's `stat` implementation, which was not long-path-aware. It should rather be defined in terms of the `stat` implementation provided by `utils/fs`. Fixes #19541. - - - - - 05c5c054 by Sylvain Henry at 2021-03-23T13:01:15-04:00 Move loader state into Interp The loader state was stored into HscEnv. As we need to have two interpreters and one loader state per interpreter in #14335, it's natural to make the loader state a field of the Interp type. As a side effect, many functions now only require a Interp parameter instead of HscEnv. Sadly we can't fully free GHC.Linker.Loader of HscEnv yet because the loader is initialised lazily from the HscEnv the first time it is used. This is left as future work. HscEnv may not contain an Interp value (i.e. hsc_interp :: Maybe Interp). So a side effect of the previous side effect is that callers of the modified functions now have to provide an Interp. It is satisfying as it pushes upstream the handling of the case where HscEnv doesn't contain an Interpreter. It is better than raising a panic (less partial functions, "parse, don't validate", etc.). - - - - - df895b3f by Ben Gamari at 2021-03-23T20:43:36-04:00 gitlab-ci: Rework handling of head.hackage job trigger GitLab 12.3 now has reasonable support [1] for cross-project job dependencies, allowing us to drop the awful hack of a shell script we used previously. [1] https://docs.gitlab.com/ee/ci/multi_project_pipelines.html#mirroring-status-from-triggered-pipeline - - - - - 25306ddc by GHC GitLab CI at 2021-03-23T20:44:11-04:00 EPA: Run exactprint transformation tests as part of CI EPA == exact print annotations. When !2418 landed, it did not run the tests brought over from ghc-exactprint for making sure the AST prints correctly efter being edited. This enables those tests. - - - - - 55fd158d by Ben Gamari at 2021-03-24T12:35:23+01:00 CmmToAsm.Reg.Linear: Use concat rather than repeated (++) - - - - - 23f4bc89 by Ben Gamari at 2021-03-24T12:35:23+01:00 CmmToAsm.Reg.Linear: oneShot-ify RegM ------------------------- Metric Decrease: T783 T4801 T12707 T13379 T3294 T4801 T5321FD ------------------------- - - - - - 60127035 by Andreas Klebinger at 2021-03-24T16:10:07-04:00 STG AST - Make ConstructorNumber always a field. It's used by all passes and already used as a regular field. So I figured it would be both more consistent and performant to make it a regular field for all constructors. I also added a few bangs in the process. - - - - - 5483b1a4 by Adam Sandberg Ericsson at 2021-03-24T23:31:09-04:00 hadrian: remove alex and happy from build-tools Hadrian doesn't actually depend on them as built-tools and normal usage where you want to compile GHC will pick up the tools before you run hadrian via the ./configure script. Not building an extra copy of alex and happy might also improve overall build-times when building from scratch. - - - - - aa99f516 by Simon Peyton Jones at 2021-03-24T23:31:44-04:00 Fix the binder-swap transformation in OccurAnal The binder-swap transformation needs to be iterated, as shown by #19581. The fix is pretty simple, and is explained in point (BS2) of Note [The binder-swap substitution]. Net effect: - sometimes, fewer simplifier iterations - sometimes, more case merging - - - - - 0029df2b by Hécate at 2021-03-25T04:52:41-04:00 Add compiler linting to CI This commit adds the `lint:compiler` Hadrian target to the CI runner. It does also fixes hints in the compiler/ and libraries/base/ codebases. - - - - - 1350a5cd by GHC GitLab CI at 2021-03-25T04:53:16-04:00 EPA : Remove ApiAnn from ParsedModule All the comments are now captured in the AST, there is no need for a side-channel structure for them. - - - - - c74bd3da by GHC GitLab CI at 2021-03-25T17:31:57+00:00 EPA: Tidy up some GHC.Parser.Annotation comments This is a follow up from !2418 / #19579 [skip ci] - - - - - 0d5d344d by Oleg Grenrus at 2021-03-25T17:36:50-04:00 Implement -Wmissing-kind-signatures Fixes #19564 - - - - - d930fecb by Sylvain Henry at 2021-03-26T19:00:07-04:00 Refactor interface loading In order to support several home-units and several independent unit-databases, it's easier to explicitly pass UnitState, DynFlags, etc. to interface loading functions. This patch converts some functions using monads such as IfG or TcRnIf with implicit access to HscEnv to use IO instead and to pass them specific fields of HscEnv instead of an HscEnv value. - - - - - 872a9444 by Sylvain Henry at 2021-03-26T19:00:07-04:00 Refactor NameCache * Make NameCache the mutable one and replace NameCacheUpdater with it * Remove NameCache related code duplicated into haddock Bump haddock submodule - - - - - 599efd90 by Sylvain Henry at 2021-03-26T19:00:07-04:00 Refactor FinderCache - - - - - 532c6a54 by Sylvain Henry at 2021-03-26T19:00:07-04:00 Remove UniqSupply from NameCache As suggested by @alexbiehl, this patch replaces the always updated UniqSupply in NameCache with a fixed Char and use it with `uniqFromMask` to generate uniques. This required some refactoring because getting a new unique from the NameCache can't be done in pure code anymore, in particular not in an atomic update function for `atomicModifyIORef`. So we use an MVar instead to store the OrigNameCache field. For some reason, T12545 increases (+1%) on i386 while it decreases on other CI runners. T9630 ghc/peak increases only with the dwarf build on CI (+16%). Metric Decrease: T12425 T12545 T9198 T12234 Metric Increase: T12545 T9630 Update haddock submodule - - - - - 89ee9206 by Sylvain Henry at 2021-03-26T19:00:07-04:00 Use foldGet in getSymbolTable Implement @alexbiehl suggestion of using a foldGet function to avoid the creation of an intermediate list while reading the symbol table. Do something similar for reading the Hie symbol table and the interface dictionary. Metric Decrease: T10421 - - - - - a9c0b3ca by Sylvain Henry at 2021-03-26T19:00:07-04:00 Bump haddock submodule - - - - - 628417b4 by Sylvain Henry at 2021-03-26T19:00:07-04:00 Fix lint issue - - - - - ef03fa6f by GHC GitLab CI at 2021-03-26T19:00:42-04:00 Bump Win32 to 2.13.0.0 Bumps Win32 submodule. - - - - - 5741caeb by Sylvain Henry at 2021-03-26T19:01:20-04:00 Only update config.sub when it already exists (#19574) - - - - - 57d21e6a by Sebastian Graf at 2021-03-26T23:02:15-04:00 Rubbish literals for all representations (#18983) This patch cleans up the complexity around WW's `mk_absent_let` by broadening the scope of `LitRubbish`. Rubbish literals now store the `PrimRep` they represent and are ultimately lowered in Cmm. This in turn allows absent literals of `VecRep` or `VoidRep`. The latter allows absent literals for unlifted coercions, as requested in #18983. I took the liberty to rewrite and clean up `Note [Absent fillers]` and `Note [Rubbish values]` to account for the new implementation and to make them more orthogonal in their description. I didn't add a new regression test, as `T18982` already contains the test in the ticket and its test output changes as expected. Fixes #18983. - - - - - c83e4d05 by Adam Sandberg Ericsson at 2021-03-26T23:02:52-04:00 hadrian: build ghc-stageN wrapper when building the stageN:exe:ghc-bin target - - - - - 59375de1 by Viktor Dukhovni at 2021-03-27T18:09:31-04:00 bump submodule nofib - - - - - f72d4ebb by Ben Gamari at 2021-03-27T18:10:06-04:00 rts: Fix joinOSThread on Windows Previously we were treating the thread ID as a HANDLE, but it is not. We must first OpenThread. - - - - - f6960b18 by Simon Peyton Jones at 2021-03-28T00:11:46-04:00 Make RULES more robust in GHC.Float The RULES that use hand-written specialised code for overloaded class methods like floor, ceiling, truncate etc were fragile to certain transformations. This patch makes them robust. See #19582. It's all described in Note [Rules for overloaded class methods]. No test case because currently we don't do the transformation (floating out over-saturated applications) that makes this patch have an effect. But we may so so in future, and this patch makes the RULES much more robust. - - - - - b02c8ef7 by Sebastian Graf at 2021-03-28T00:12:21-04:00 Rename StrictSig to DmdSig (#19597) In #19597, we also settled on the following renamings: * `idStrictness` -> `idDmdSig`, `strictnessInfo` -> `dmdSigInfo`, `HsStrictness` -> `HsDmdSig` * `idCprInfo` -> `idCprSig`, `cprInfo` -> `cprSigInfo`, `HsCpr` -> `HsCprSig` Fixes #19597. - - - - - 29d75863 by Fendor at 2021-03-28T17:26:37-04:00 Add UnitId to Target record In the future, we want `HscEnv` to support multiple home units at the same time. This means, that there will be 'Target's that do not belong to the current 'HomeUnit'. This is an API change without changing behaviour. Update haddock submodule to incorporate API changes. - - - - - 9594f6f6 by Ben Gamari at 2021-03-28T17:27:12-04:00 gitlab-ci: Bump ci-images Upgrades bootstrap GHC to 8.10.4, hopefully avoiding #19600. - - - - - 9c9e40e5 by Oleg Grenrus at 2021-03-28T17:27:49-04:00 Replace - with negate It also failed to parse with HLint (I wonder how GHC itself handles it?) - - - - - c30af951 by Alfredo Di Napoli at 2021-03-29T07:58:00+02:00 Add `MessageClass`, rework `Severity` and add `DiagnosticReason`. Other than that: * Fix T16167,json,json2,T7478,T10637 tests to reflect the introduction of the `MessageClass` type * Remove `makeIntoWarning` * Remove `warningsToMessages` * Refactor GHC.Tc.Errors 1. Refactors GHC.Tc.Errors so that we use `DiagnosticReason` for "choices" (defer types errors, holes, etc); 2. We get rid of `reportWarning` and `reportError` in favour of a general `reportDiagnostic`. * Introduce `DiagnosticReason`, `Severity` is an enum: This big commit makes `Severity` a simple enumeration, and introduces the concept of `DiagnosticReason`, which classifies the /reason/ why we are emitting a particular diagnostic. It also adds a monomorphic `DiagnosticMessage` type which is used for generic messages. * The `Severity` is computed (for now) from the reason, statically. Later improvement will add a `diagReasonSeverity` function to compute the `Severity` taking `DynFlags` into account. * Rename `logWarnings` into `logDiagnostics` * Add note and expand description of the `mkHoleError` function - - - - - 4421fb34 by Moritz Angermann at 2021-03-29T17:25:48-04:00 [macho] improved linker with proper plt support This is a pre-requisite for making aarch64-darwin work. - - - - - e754ff7f by Moritz Angermann at 2021-03-29T17:25:49-04:00 Allocate Adjustors and mark them readable in two steps This drops allocateExec for darwin, and replaces it with a alloc, write, mark executable strategy instead. This prevents us from trying to allocate an executable range and then write to it, which X^W will prohibit on darwin. This will *only* work if we can use mmap. - - - - - 026a53e0 by Moritz Angermann at 2021-03-29T17:25:49-04:00 [linker] Additional FALLTHROUGH decorations. - - - - - dc6fa61c by Moritz Angermann at 2021-03-29T17:25:49-04:00 [linker] SymbolExtras are only used on PPC and X86 - - - - - 710ef9d2 by Moritz Angermann at 2021-03-29T17:25:49-04:00 [linker] align prototype with implementation signature. - - - - - e72a2f77 by Moritz Angermann at 2021-03-29T17:25:49-04:00 [linker/aarch64-elf] support section symbols for GOT relocation - - - - - 38504b6f by Moritz Angermann at 2021-03-29T17:25:49-04:00 [testsuite] Fix SubsectionsViaSymbols test - - - - - 93b8db6b by Moritz Angermann at 2021-03-29T17:25:49-04:00 [linker] no munmap if either agument is invalid. - - - - - 095e1624 by Moritz Angermann at 2021-03-29T17:25:49-04:00 [rts] cast return value to struct. - - - - - 09ea36cf by Moritz Angermann at 2021-03-29T17:25:49-04:00 [aarch64-darwin] be very careful of warnings. So we did *not* have the stgCallocBytes prototype, and subsequently the C compiler defaulted to `int` as a return value. Thus generating sxtw instructions for the return value of stgCalloBytes to produce the expected void *. - - - - - 4bbd1445 by Moritz Angermann at 2021-03-29T17:25:49-04:00 [testlib] ignore strip warnings - - - - - df08d548 by Moritz Angermann at 2021-03-29T17:25:49-04:00 [armv7] arm32 needs symbols! - - - - - f3c23939 by Moritz Angermann at 2021-03-29T17:25:49-04:00 [testsuite/aarch64] disable T18623 - - - - - 142950d9 by Moritz Angermann at 2021-03-29T17:25:49-04:00 [testsuite/aarch64-darwin] disable T12674 - - - - - 66044095 by Moritz Angermann at 2021-03-29T17:25:49-04:00 [armv7] PIC by default + [aarch64-linux] T11276 metric increase Metric Increase: T11276 - - - - - afdacc55 by Takenobu Tani at 2021-03-30T20:41:46+09:00 users-guide: Correct markdown for ghc-9.2 This patch corrects some markdown. [skip ci] - - - - - 470839c5 by Oleg Grenrus at 2021-03-30T17:39:39-04:00 Additionally export asum from Control.Applicative Fixes #19575 - - - - - 128fd85c by Simon Jakobi at 2021-03-30T17:40:14-04:00 Add regression test for #5298 Closes #5298. - - - - - 86e7aa01 by Ben Gamari at 2021-03-30T19:14:19-04:00 gitlab-ci: Trigger head.hackage jobs via pipeline ID As noted in ghc/head.hackage!152, the previous plan of using the commit didn't work when the triggering pipeline had not yet successfully finished. - - - - - 59e82fb3 by Oleg Grenrus at 2021-03-31T11:12:17-04:00 import Data.List with explicit import list - - - - - 44774dc5 by Oleg Grenrus at 2021-03-31T11:12:17-04:00 Add -Wcompat to hadrian Update submodules haskeline and hpc - - - - - dbadd672 by Simon Peyton Jones at 2021-03-31T11:12:52-04:00 The result kind of a signature can't mention quantified vars This patch fixes a small but egregious bug, which allowed a type signature like f :: forall a. blah not to fail if (blah :: a). Acutally this only showed up as a ASSERT error (#19495). The fix is very short, but took quite a bit of head scratching Hence the long Note [Escaping kind in type signatures] While I was in town, I also added a short-cut for the common case of having no quantifiers to tcImplicitTKBndrsX. Metric Decrease: T9198 Metric Increase: T9198 - - - - - 2fcebb72 by Alan Zimmerman at 2021-03-31T11:13:28-04:00 EPA : Rename AddApiAnn to AddEpAnn As port of the process of migrating naming from API Annotations to exact print annotations (EPA) Follow-up from !2418, see #19579 - - - - - 0fe5175a by Alan Zimmerman at 2021-03-31T11:13:28-04:00 EPA : Rename ApiAnn to EPAnn Follow-up from !2418, see #19579 Updates haddock submodule - - - - - d03005e6 by Alan Zimmerman at 2021-03-31T11:13:28-04:00 EPA : rename 'api annotations' to 'exact print annotations' In comments, and notes. Follow-up from !2418, see #19579 - - - - - 49bc1e9e by Alan Zimmerman at 2021-03-31T11:13:28-04:00 EPA : rename AnnAnchor to EpaAnchor Follow-up from !2418, see #19579 - - - - - 798d8f80 by Alan Zimmerman at 2021-03-31T11:13:28-04:00 EPA : Rename AnnComment to EpaComment Follow-up from !2418, see #19579 - - - - - 317295da by Simon Peyton Jones at 2021-03-31T11:14:04-04:00 Avoid fundep-caused loop in the typechecker Ticket #19415 showed a nasty typechecker loop, which can happen with fundeps that do not satisfy the coverage condition. This patch fixes the problem. It's described in GHC.Tc.Solver.Interact Note [Fundeps with instances] It's not a perfect solution, as the Note explains, but it's better than the status quo. - - - - - aaf8e293 by Ryan Scott at 2021-03-31T11:14:39-04:00 Add regression tests for #17772 and #18308 Resolves #17772. Addresses one part of #18308. - - - - - efe5fdab by Ben Gamari at 2021-03-31T11:15:14-04:00 gitlab-ci: Extend expiration time of simple perf job artifacts - - - - - 5192183f by Oleg Grenrus at 2021-04-01T00:39:28-04:00 import Data.List with explicit import list - - - - - bddecda1 by Oleg Grenrus at 2021-04-01T00:39:28-04:00 Data.List specialization to [] - Remove GHC.OldList - Remove Data.OldList - compat-unqualified-imports is no-op - update haddock submodule - - - - - 751b2144 by Sylvain Henry at 2021-04-01T00:40:07-04:00 Encapsulate the EPS IORef in a newtype - - - - - 29326979 by Sylvain Henry at 2021-04-01T00:40:07-04:00 Properly initialise UnitEnv - - - - - 0219297c by Sylvain Henry at 2021-04-01T00:40:07-04:00 Move unit DBs in UnitEnv Also make the HomeUnit optional to keep the field strict and prepare for UnitEnvs without a HomeUnit (e.g. in Plugins envs, cf #14335). - - - - - 7acfb617 by Sylvain Henry at 2021-04-01T00:40:07-04:00 Move HPT in UnitEnv - - - - - 85d7056a by Sylvain Henry at 2021-04-01T00:40:07-04:00 Move the EPS into UnitEnv - - - - - 706fad60 by Sylvain Henry at 2021-04-01T00:40:07-04:00 Fix tests - - - - - b2f51099 by Ben Gamari at 2021-04-01T08:21:30-04:00 ghc-bignum: Add missing source files to cabal file - - - - - 9b05b601 by Ben Gamari at 2021-04-01T08:21:30-04:00 ghc-boot: Use cabal-version: 3.0 - - - - - 75e594d0 by Ben Gamari at 2021-04-01T08:21:30-04:00 libiserv: Add description - - - - - 2266bdae by Ben Gamari at 2021-04-01T08:21:30-04:00 configure: Update comment describing versioning policy As noted in my comment on #19058, this comment was previously a bit misleading in the case of stable branches. - - - - - 65c50d8d by Ben Gamari at 2021-04-01T08:21:30-04:00 gitlab-ci: Drop Debian 8 job - - - - - d44e42a2 by Vladislav Zavialov at 2021-04-01T08:22:06-04:00 Add missing axiom exports for CharToNat/NatToChar When the CharToNat and NatToChar type families were added, the corresponding axioms were not exported. This led to a failure much like #14934 - - - - - 15b6c9f9 by Alfredo Di Napoli at 2021-04-01T16:13:23-04:00 Compute Severity of diagnostics at birth This commit further expand on the design for #18516 by getting rid of the `defaultReasonSeverity` in favour of a function called `diagReasonSeverity` which correctly takes the `DynFlags` as input. The idea is to compute the `Severity` and the `DiagnosticReason` of each message "at birth", without doing any later re-classifications, which are potentially error prone, as the `DynFlags` might evolve during the course of the program. In preparation for a proper refactoring, now `pprWarning` from the Parser.Ppr module has been renamed to `mkParserWarn`, which now takes a `DynFlags` as input. We also get rid of the reclassification we were performing inside `printOrThrowWarnings`. Last but not least, this commit removes the need for reclassify inside GHC.Tc.Errors, and also simplifies the implementation of `maybeReportError`. Update Haddock submodule - - - - - 84b76f60 by Viktor Dukhovni at 2021-04-01T16:13:59-04:00 Chiral foldable caveats - - - - - 07393306 by Viktor Dukhovni at 2021-04-01T16:13:59-04:00 Address review feedback on chirality Also added nested foldr example for `concat`. - - - - - 8ef6eaf7 by Ben Gamari at 2021-04-02T05:15:23-04:00 sdist: Fix packaging of Windows tarballs These now live in the ghc-tarballs/mingw-w64 directory. Fixes #19316. - - - - - 82d8847e by Ben Gamari at 2021-04-02T05:15:23-04:00 gitlab-ci: CI wibbles Ensure that deb10-dwarf artifacts are preserved. - - - - - ee877571 by Ben Gamari at 2021-04-02T05:15:23-04:00 gitlab-ci: Ignore performance metrics failures in release jobs We don't want these failing merely due to performance metrics - - - - - ee55d57e by Matthew Pickering at 2021-04-02T05:15:59-04:00 Fix copy+pasto in Sanity.c - - - - - 78ca4a27 by Ben Gamari at 2021-04-02T05:16:35-04:00 testsuite: Make passFail a boolean - - - - - a9154662 by Ben Gamari at 2021-04-02T05:16:35-04:00 testsuite: Check test stats only after test correctness Ticket #19576 noted that a test that failed in correctness (e.g. due to stderr mismatch) *and* failed due to a metrics change would report misleading stats. This was due to the testsuite driver *first* checking stats, before checking for correctness. Fix this. Closes #19576. - - - - - c265d19f by Ben Gamari at 2021-04-02T05:17:11-04:00 testsuite: Add test for #7275 - - - - - ce706fae by Sebastian Graf at 2021-04-02T05:17:47-04:00 Pmc: Add regression test for #19622 It appears that the issue has already been fixed. Judging by the use of a pattern synonym with a provided constraint, my bet is on 1793ca9d. Fixes #19622. - - - - - 918d5021 by Ben Gamari at 2021-04-05T20:37:28-04:00 configure: Fix parsing of ARM triples To support proper parsing of arm64 targets, we needed to adjust the GHC_LLVM_TARGET function to allow parsing arm64-apple-darwin into aarch64. This however discared the proper os detection. To rectify this, we'll pull the os detection into separate block. Fixes #19173. - - - - - 9c9adbd0 by Oleg Grenrus at 2021-04-05T20:38:07-04:00 Implement proposal 403: Lexer cleanup This allows Other Numbers to be used in identifiers, and also documents other, already existing lexer divergence from Haskell Report - - - - - 89acbf35 by Matthew Pickering at 2021-04-05T20:38:42-04:00 Add special case to stripStgTicksTop for [] In the common case where the list of ticks is empty, building a thunk just applies 'reverse' to '[]' which is quite wasteful. - - - - - 77772bb1 by Harry Garrood harry at garrood.me at 2021-04-05T20:39:19-04:00 Add type signature for TargetContents.go These changes made it slightly easier for me to work out what was going on in this test. I've also fixed a typo in the comments. - - - - - 49528121 by Alfredo Di Napoli at 2021-04-05T20:39:54-04:00 Introduce SevIgnore Severity to suppress warnings This commit introduces a new `Severity` type constructor called `SevIgnore`, which can be used to classify diagnostic messages which are not meant to be displayed to the user, for example suppressed warnings. This extra constructor allows us to get rid of a bunch of redundant checks when emitting diagnostics, typically in the form of the pattern: ``` when (optM Opt_XXX) $ addDiagnosticTc (WarningWithFlag Opt_XXX) ... ``` Fair warning! Not all checks should be omitted/skipped, as evaluating some data structures used to produce a diagnostic might still be expensive (e.g. zonking, etc). Therefore, a case-by-case analysis must be conducted when deciding if a check can be removed or not. Last but not least, we remove the unnecessary `CmdLine.WarnReason` type, which is now redundant with `DiagnosticReason`. - - - - - 3483c3de by Alfredo Di Napoli at 2021-04-05T20:39:54-04:00 Correct warning for deprecated and unrecognised flags Fixes #19616. This commit changes the `GHC.Driver.Errors.handleFlagWarnings` function to rely on the newly introduced `DiagnosticReason`. This allows us to correctly pretty-print the flags which triggered some warnings and in turn remove the cruft around this function (like the extra filtering and the `shouldPrintWarning` function. - - - - - 54247fb1 by Joachim Breitner at 2021-04-05T20:40:30-04:00 ./configure: Indicate that GHC=… should be a full path and not just the name on the binary on the `$PATH`. - - - - - 5db116e9 by Joachim Breitner at 2021-04-05T20:40:30-04:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 2783d498 by Luite Stegeman at 2021-04-05T20:41:06-04:00 fix sub-word literals in GHCi - - - - - 33b88645 by Andreas Klebinger at 2021-04-05T20:41:41-04:00 Add regression test for T19474. In version 0.12.2.0 of vector when used with GHC-9.0 we rebox values from storeable mutable vectors. This should catch such a change in the future. - - - - - 939fa61c by Łukasz Gołębiewski at 2021-04-05T20:42:17-04:00 Fixes Monad's associativity docs It is incorrectly displayed in hackage as: `m1 <*> m2 = m1 >>= (x1 -> m2 >>= (x2 -> return (x1 x2)))` which isn't correct Haskell - - - - - 10782edf by Simon Jakobi at 2021-04-05T20:42:53-04:00 Mark p6 and T3333 as fragile See #17018. - - - - - 048af266 by Andreas Klebinger at 2021-04-05T20:43:27-04:00 One-Shotify GHC.Utils.Monad.State (#18202) - - - - - 83654240 by Matthew Pickering at 2021-04-05T20:44:02-04:00 Add (expect_broken) test for #11545 - - - - - 53cf2c04 by Ben Gamari at 2021-04-05T20:44:37-04:00 hadrian: Refactor hlint target Not only does this eliminate some code duplication but we also add a maximum core count to HLint's command-line, hopefully avoiding issue #19600. - - - - - eac9d376 by Ben Gamari at 2021-04-05T20:45:12-04:00 hadrian: Fix build-stack-nix As noted by #19589, `stack` is not stateful and therefore must be passed `--nix` on every invocation. Do so. Fixes #19589. - - - - - bfe8ef8e by Ben Gamari at 2021-04-05T20:45:46-04:00 rts: Fix usage of pthread_setname_np Previously we used this non-portable function unconditionally, breaking FreeBSD. Fixes #19637. - - - - - 403bf88c by Ben Gamari at 2021-04-05T20:46:21-04:00 Revert "[ci/arm/darwin/testsuite] Forwards ports from GHC-8.10" This reverts commit 0cbdba2768d84a0f6832ae5cf9ea1e98efd739da. - - - - - 54880c13 by Sylvain Henry at 2021-04-05T20:46:59-04:00 Bignum: fix invalid hs-boot declaration (#19638) - - - - - 247684ad by Sylvain Henry at 2021-04-05T20:47:37-04:00 Bignum: remove unused extra files - - - - - 2e3a6fba by Adam Sandberg Ericsson at 2021-04-07T12:37:11-04:00 hadrian: don't hardcode -fuse-ld=gold in hsc2hs wrapper #19514 - - - - - b06e457d by Simon Peyton Jones at 2021-04-07T12:37:47-04:00 Make specialisation a bit more aggressive The patch commit c43c981705ec33da92a9ce91eb90f2ecf00be9fe Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Oct 23 16:15:51 2009 +0000 Fix Trac #3591: very tricky specialiser bug fixed a nasty specialisation bug /for DFuns/. Eight years later, this patch commit 2b74bd9d8b4c6b20f3e8d9ada12e7db645cc3c19 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Wed Jun 7 12:03:51 2017 +0100 Stop the specialiser generating loopy code extended it to work for /imported/ DFuns. But in the process we lost the fact that it was needed only for DFuns! As a result we started silently losing useful specialisation for non-DFuns. But there was no regression test to spot the lossage. Then, nearly four years later, Andreas filed #19599, which showed the lossage in high relief. This patch restores the DFun test, and adds Note [Avoiding loops (non-DFuns)] to explain why. This is undoubtedly a very tricky corner of the specialiser, and one where I would love to have a more solid argument, even a paper! But meanwhile I think this fixes the lost specialisations without introducing any new loops. I have two regression tests, T19599 and T19599a, so I hope we'll know if we lose them again in the future. Vanishingly small effect on nofib. A couple of compile-time benchmarks improve T9872a(normal) ghc/alloc 1660559328.0 1643827784.0 -1.0% GOOD T9872c(normal) ghc/alloc 1691359152.0 1672879384.0 -1.1% GOOD Many others wiggled around a bit. Metric Decrease: T9872a T9872c - - - - - 546f8b14 by Matthew Pickering at 2021-04-07T12:38:22-04:00 hadrian: Don't try to build iserv-prof if we don't have profiled libraries Workaround for #19624 - - - - - d014ab0d by Sylvain Henry at 2021-04-07T12:39:00-04:00 Remove dynamic-by-default (#16782) Dynamic-by-default was a mechanism to automatically select the -dynamic way for some targets. It was implemented in a convoluted way: it was defined as a flavour option, hence it couldn't be passed as a global settings (which are produced by `configure` before considering flavours), so a build system rule was used to pass -DDYNAMIC_BY_DEFAULT to the C compiler so that deriveConstants could infer it. * Make build system has it disabled for 8 years (951e28c0625ece7e0db6ac9d4a1e61e2737b10de) * It has never been implemented in Hadrian * Last time someone tried to enable it 1 year ago it didn't work (!2436) * Having this as a global constant impedes making GHC multi-target (see !5427) This commit fully removes support for dynamic-by-default. If someone wants to reimplement something like this, it would probably need to move the logic in the compiler. (Doing this would probably need some refactoring of the way the compiler handles DynFlags: DynFlags are used to store and to pass enabled ways to many parts of the compiler. It can be set by command-line flags, GHC API, global settings. In multi-target GHC, we will use DynFlags to load the target platform and its constants: but at this point with the current DynFlags implementation we can't easily update the existing DynFlags with target-specific options such as dynamic-by-default without overriding ways previously set by the user.) - - - - - 88d8a0ed by James Foster at 2021-04-07T14:17:31-04:00 Change foldl' to inline when partially applied (#19534) And though partially applied foldl' is now again inlined, #4301 has not resurfaced, and appears to be resolved. - - - - - 898afe90 by Matthew Pickering at 2021-04-08T08:07:10-04:00 Stop retaining SimplEnvs in unforced Unfoldings Related to #15455 - - - - - 8417e866 by Matthew Pickering at 2021-04-08T08:07:10-04:00 Don't retain reference to whole TcLclEnv in SkolemTV - - - - - 352a463b by Matthew Pickering at 2021-04-08T08:07:10-04:00 Use DmdEnv rather than VarEnv DmdEnv - - - - - adc52bc8 by Matthew Pickering at 2021-04-08T08:07:10-04:00 Make updTcRef force the result This can lead to a classic thunk build-up in a TcRef Fixes #19596 - - - - - eaa1461a by Matthew Pickering at 2021-04-08T08:07:11-04:00 Make sure mergeWithKey is inlined and applied strictly In the particular case of `DmdEnv`, not applying this function strictly meant 500MB of thunks were accumulated before the values were forced at the end of demand analysis. - - - - - 629a5e98 by Matthew Pickering at 2021-04-08T08:07:11-04:00 Some extra strictness in Demand.hs It seems that these places were supposed to be forced anyway but the forcing has no effect because the result was immediately placed in a lazy box. - - - - - 42d88003 by Matthew Pickering at 2021-04-08T08:07:11-04:00 Make sure result of demand analysis is forced promptly This avoids a big spike in memory usage during demand analysis. Part of fixing #15455 ------------------------- Metric Decrease: T18698a T18698b T9233 T9675 T9961 ------------------------- - - - - - e0d861d4 by Matthew Pickering at 2021-04-08T08:07:11-04:00 T11545 now also passes due to modifications in demand analysis Fixes #11545 - - - - - a3cc9a29 by Ryan Scott at 2021-04-08T08:07:45-04:00 Fix #19649 by using filterInScopeM in rnFamEqn Previously, associated type family instances would incorrectly claim to implicitly quantify over type variables bound by the instance head in the `HsOuterImplicit`s that `rnFamEqn` returned. This is fixed by using `filterInScopeM` to filter out any type variables that the instance head binds. Fixes #19649. - - - - - 6e8e2e08 by Alfredo Di Napoli at 2021-04-08T08:08:20-04:00 Move Iface.Load errors into Iface.Errors module This commit moves the error-related functions in `GHC.Iface.Load` into a brand new module called `GHC.Iface.Errors`. This will avoid boot files and circular dependencies in the context of #18516, in the pretty-printing modules. - - - - - 8a099701 by Ben Gamari at 2021-04-09T03:30:26-04:00 CoreTidy: enhance strictness note - - - - - 0bdb867e by Sylvain Henry at 2021-04-09T03:30:26-04:00 CoreTidy: handle special cases to preserve more sharing. Metric Decrease: T16577 - - - - - c02ac1bb by Andreas Klebinger at 2021-04-09T03:31:02-04:00 Re-export GHC.Bits from GHC.Prelude with custom shift implementation. This allows us to use the unsafe shifts in non-debug builds for performance. For older versions of base we instead export Data.Bits See also #19618 - - - - - 35407d67 by Peter Trommler at 2021-04-09T03:31:37-04:00 testsuite: Skip T18623 on powerpc64le In commit f3c23939 T18623 is disabled for aarch64. The limit seems to be too low for powerpc64le, too. This could be because tables next to code is not supported and our code generator produces larger code on PowerPC. - - - - - d8f04425 by Peter Trommler at 2021-04-09T03:31:37-04:00 Fix typo - - - - - fd5ca9c3 by Peter Trommler at 2021-04-09T03:31:37-04:00 testsuite/ppc64le: Mark UnboxedTuples test broken - - - - - d4a71b0c by Matthew Pickering at 2021-04-09T03:32:12-04:00 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 - - - - - 28d2d646 by Matthew Pickering at 2021-04-09T03:32:47-04:00 Don't tidy type in pprTypeForUser There used to be some cases were kinds were not generalised properly before being printed in GHCi. This seems to have changed in the past so now it's uncessary to tidy before printing out the test case. ``` > :set -XPolyKinds > data A x y > :k A k1 -> k2 -> A ``` This tidying was causing issues with an attempt to increase sharing by making `mkTyConApp` (see !4762) - - - - - 6d29e635 by Matthew Pickering at 2021-04-09T03:33:22-04:00 Add perf test for #15304 The test max memory usage improves dramatically with the fixes to memory usage in demand analyser from #15455 - - - - - 70c39e22 by Douglas Wilson at 2021-04-09T03:33:56-04:00 [docs] release notes for !4729 + !3678 Also includes small unrelated type fix - - - - - c1d6daab by Matthew Pickering at 2021-04-09T03:34:31-04:00 Update HACKING.md - - - - - a951e069 by Sylvain Henry at 2021-04-09T03:35:08-04:00 Bignum: add BigNat Eq/Ord instances (#19647) - - - - - cd391756 by Richard Eisenberg at 2021-04-10T05:29:21-04:00 Tweak kick-out condition K2b to deal with LHSs Kick out condition K2b really only makes sense for inerts with a type variable on the left. This updates the commentary and the code to skip this check for inerts with type families on the left. Also cleans up some commentary around solver invariants and adds Note [K2b]. Close #19042. test case: typecheck/should_compile/T19042 - - - - - 7536126e by Richard Eisenberg at 2021-04-10T05:29:21-04:00 Kick out fewer equalities by thinking harder Close #17672. By scratching our heads quite hard, we realized that we should never kick out Given/Nominal equalities. This commit tweaks the kick-out conditions accordingly. See also Note [K4] which describes what is going on. This does not fix a known misbehavior, but it should be a small improvement in both practice (kicking out is bad, and we now do less of it) and theory (a Given/Nominal should behave just like a filled-in metavariable, which has no notion of kicking out). - - - - - 449be647 by Richard Eisenberg at 2021-04-10T05:29:21-04:00 Clarify commentary around the constraint solver No changes to code; no changes to theory. Just better explanation. - - - - - 3c98dda6 by Richard Eisenberg at 2021-04-10T05:29:21-04:00 Test #19665 as expect_broken, with commentary - - - - - 6b1d0b9c by Koz Ross at 2021-04-10T05:29:59-04:00 Implement list `fold` and `foldMap` via mconcat - This allows specialized mconcat implementations an opportunity to combine elements efficiently in a single pass. - Inline the default implementation of `mconcat`, this may result in list fusion. - In Monoids with strict `mappend`, implement `mconcat` as a strict left fold: * And (FiniteBits) * Ior (FiniteBits) * Xor (FiniteBits) * Iff (FiniteBits) * Max (Ord) * Min (Ord) * Sum (Num) * Product (Num) * (a -> m) (Monoid m) - Delegate mconcat for WrappedMonoid to the underlying monoid. Resolves: #17123 Per the discussion in !4890, we expect some stat changes: * T17123(normal) run/alloc 403143160.0 4954736.0 -98.8% GOOD This is the expected improvement in `fold` for a long list of `Text` elements. * T13056(optasm) ghc/alloc 381013328.0 447700520.0 +17.5% BAD Here there's an extra simplifier run as a result of the new methods of the Foldable instance for List. It looks benign. The test is a micro benchmark that compiles just the derived foldable instances for a pair of structures, a cost of this magnitude is not expected to extend to more realistic programs. * T9198(normal) ghc/alloc 504661992.0 541334168.0 +7.3% BAD This test regressed from 8.10 and 9.0 back to exponential blowup. This metric also fluctuates, for reasons not yet clear. The issue here is the exponetial blowup, not this MR. Metric Decrease: T17123 Metric Increase: T9198 T13056 - - - - - 3f851bbd by Sylvain Henry at 2021-04-10T05:30:37-04:00 Enhance pretty-printing perf A few refactorings made after looking at Core/STG * Use Doc instead of SDoc in pprASCII to avoid passing the SDocContext that is never used. * Inline every SDoc wrappers in GHC.Utils.Outputable to expose Doc constructs * Add text/[] rule for empty strings (i.e., text "") * Use a single occurrence of pprGNUSectionHeader * Use bangs on Platform parameters and some others Metric Decrease: ManyAlternatives ManyConstructors T12707 T13035 T13379 T18698a T18698b T1969 T3294 T4801 T5321FD T783 - - - - - 9c762f27 by Sylvain Henry at 2021-04-10T05:31:14-04:00 Generate parser for DerivedConstants.h deriveConstants utility now generates a Haskell parser for DerivedConstants.h. It can be used to replace the one used to read platformConstants file. - - - - - 085983e6 by Sylvain Henry at 2021-04-10T05:31:14-04:00 Read constants header instead of global platformConstants With this patch we switch from reading the globally installed platformConstants file to reading the DerivedConstants.h header file that is bundled in the RTS unit. When we build the RTS unit itself, we get it from its includes directories. The new parser is more efficient and strict than the Read instance for PlatformConstants and we get about 2.2MB less allocations in every cases. However it only really shows in tests that don't allocate much, hence the following metric decreases. Metric Decrease: Naperian T10421 T10547 T12150 T12234 T12425 T13035 T18304 T18923 T5837 T6048 T18140 - - - - - 2cdc95f9 by Sylvain Henry at 2021-04-10T05:31:14-04:00 Don't produce platformConstants file It isn't used for anything anymore - - - - - b699c4fb by Sylvain Henry at 2021-04-10T05:31:14-04:00 Constants: add a note and fix minor doc glitches - - - - - eb1a86bb by John Ericson at 2021-04-10T05:31:49-04:00 Allow C-- to scrutinize non-native-size words - - - - - c363108e by John Ericson at 2021-04-10T05:31:49-04:00 Add missing relational constant folding for sized numeric types - - - - - b39dec86 by Facundo Domínguez at 2021-04-10T05:32:28-04:00 Report actual port in libiserv:Remote.Slave.startSlave This allows to start iserv by passing port 0 to startSlave, which in turns allows to get an available port when no port is known to be free a priori. - - - - - 94d48ec9 by Matthew Pickering at 2021-04-10T05:33:03-04:00 Use CI_MERGE_REQUEST_SOURCE_BRANCH_NAME rather than undefined GITLAB_CI_BRANCH env var See https://docs.gitlab.com/ee/ci/variables/predefined_variables.html - - - - - d39a2b24 by Matthew Pickering at 2021-04-10T05:33:03-04:00 tests: Allow --skip-perf-tests/--only-perf-tests to be used with --ignore-perf-failures - - - - - 6974c9e4 by Matthew Pickering at 2021-04-10T05:33:38-04:00 Fix magicDict in ghci (and in the presence of other ticks) The problem was that ghci inserts some ticks around the crucial bit of the expression. Just like in some of the other rules we now strip the ticks so that the rule fires more reliably. It was possible to defeat magicDict by using -fhpc as well, so not just an issue in ghci. Fixes #19667 and related to #19673 - - - - - 792d9289 by Simon Peyton Jones at 2021-04-12T13:50:49-04:00 More accurate SrcSpan when reporting redundant constraints We want an accurate SrcSpan for redundant constraints: • Redundant constraint: Eq a • In the type signature for: f :: forall a. Eq a => a -> () | 5 | f :: Eq a => a -> () | ^^^^ This patch adds some plumbing to achieve this * New data type GHC.Tc.Types.Origin.ReportRedundantConstraints (RRC) * This RRC value is kept inside - FunSigCtxt - ExprSigCtxt * Then, when reporting the error in GHC.Tc.Errors, use this SrcSpan to control the error message: GHC.Tc.Errors.warnRedundantConstraints Quite a lot of files are touched in a boring way. - - - - - 18cbff86 by Matthew Pickering at 2021-04-12T13:51:23-04:00 template-haskell: Run TH splices with err_vars from current context Otherwise, errors can go missing which arise when running the splices. Fixes #19470 - - - - - 89ff1230 by Matthew Pickering at 2021-04-12T13:51:58-04:00 Add regression test for T19615 Fixes #19615 - - - - - 9588f3fa by Matthew Pickering at 2021-04-12T13:52:33-04:00 Turn T11545 into a normal performance test This makes it more robust to people running it with `quick` flavour and so on. - - - - - d1acda98 by Matthew Pickering at 2021-04-12T17:07:01-04:00 CI: Also ignore metric decreases on master Otherwise, if the marge batch has decreased metrics, they will fail on master which will result in the pipeline being cut short and the expected metric values for the other jobs will not be updated. - - - - - 6124d172 by Stefan Schulze Frielinghaus at 2021-04-13T18:42:40-04:00 hadrian: Provide build rule for ghc-stage3 wrapper - - - - - ef013593 by Simon Peyton Jones at 2021-04-13T18:43:15-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 T13056, because we generate more specialised code. This seems OK. Metric Increase: T13056 - - - - - 8d87975e by Sylvain Henry at 2021-04-13T18:43:53-04:00 Produce constant file atomically (#19684) - - - - - 1e2e62a4 by Ryan Scott at 2021-04-13T18:44:28-04:00 Add {lifted,unlifted}DataConKey to pretendNameIsInScope's list of Names Fixes #19688. - - - - - b665d983 by Ben Gamari at 2021-04-13T20:04:53-04:00 configure: Bump version to 9.3 Bumps the `haddock` submodule. - - - - - 726da09e by Matthew Pickering at 2021-04-14T05:07:45-04:00 Always generate ModDetails from ModIface This vastly reduces memory usage when compiling with `--make` mode, from about 900M when compiling Cabal to about 300M. As a matter of uniformity, it also ensures that reading from an interface performs the same as using the in-memory cache. We can also delete all the horrible knot-tying in updateIdInfos. Goes some way to fixing #13586 Accept new output of tests fixing some bugs along the way ------------------------- Metric Decrease: T12545 ------------------------- - - - - - 78ed7adf by Hécate Moonlight at 2021-04-14T14:40:46-04:00 Data.List strictness optimisations for maximumBy and minimumBy follow-up from !4675 - - - - - 79e5c867 by Peter Trommler at 2021-04-14T14:41:21-04:00 Prelude: Fix version bound on Bits import Fixes #19683 - - - - - 5f172299 by Adam Gundry at 2021-04-14T19:42:18-04:00 Add isInjectiveTyCon check to opt_univ (fixes #19509) - - - - - cc1ba576 by Matthew Pickering at 2021-04-14T19:42:53-04:00 Fix some negation issues when creating FractionalLit There were two different issues: 1. integralFractionalLit needed to be passed an already negated value. (T19680) 2. negateFractionalLit did not actually negate the argument, only flipped the negation flag. (T19680A) Fixes #19680 - - - - - da92e728 by Matthew Pickering at 2021-04-15T12:27:44-04:00 hie: Initialise the proper environment for calling dsExpr We now use DsM as the base monad for writing hie files and properly initialise it from the TcGblEnv. Before, we would end up reading the interface file from disk for the module we were currently compiling. The modules iface then ended up in the EPS causing all sorts of subtle carnage, including difference in the generated core and haddock emitting a lot of warnings. With the fix, the module in the TcGblEnv is set correctly so the lookups happen in the local name env rather than thinking the identifier comes from an external package. Fixes #19693 and #19334 - - - - - 0a8c14bd by Simon Peyton Jones at 2021-04-15T12:28:18-04:00 Fix handling ze_meta_tv_env in GHC.Tc.Utils.Zonk As #19668 showed, there was an /asymptotic/ slow-down in zonking in GHC 9.0, exposed in test T9198. The bug was actually present in earlier compilers, but by a fluke didn't actually show up in any of our tests; but adding Quick Look exposed it. The bug was that in zonkTyVarOcc we 1. read the meta-tyvar-env variable 2. looked up the variable in the env 3. found a 'miss' 4. looked in the variable, found `Indirect ty` 5. zonked `ty` 6. update the env *gotten from step 1* to map the variable to its zonked type. The bug is that we thereby threw away all teh work done in step 4. In T9198 that made an enormous, indeed asymptotic difference. The fix is easy: use updTcRef. I commented in `Note [Sharing when zonking to Type]` ------------------------- Metric Decrease: T9198 ------------------------- - - - - - 7bd12940 by Simon Peyton Jones at 2021-04-17T22:56:32+01:00 Improve CSE in STG-land This patch fixes #19717, a long-standing bug in CSE for STG, which led to a stupid loss of CSE in some situations. It's explained in Note [Trivial case scrutinee], which I have substantially extended. - - - - - c71b2204 by Simon Peyton Jones at 2021-04-17T23:03:56+01:00 Improvements in SpecConstr * Allow under-saturated calls to specialise See Note [SpecConstr call patterns] This just allows a bit more specialisation to take place. * Don't discard calls from un-specialised RHSs. This was a plain bug in `specialise`, again leading to loss of specialisation. Refactoring yields an `otherwise` case that is easier to grok. * I refactored CallPat to become a proper data type, not a tuple. All this came up when I was working on eta-reduction. The ticket is #19672. The nofib results are mostly zero, with a couple of big wins: Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- awards +0.2% -0.1% -18.7% -18.8% 0.0% comp_lab_zift +0.2% -0.2% -23.9% -23.9% 0.0% fft2 +0.2% -1.0% -34.9% -36.6% 0.0% hpg +0.2% -0.3% -18.4% -18.4% 0.0% mate +0.2% -15.7% -19.3% -19.3% +11.1% parser +0.2% +0.6% -16.3% -16.3% 0.0% puzzle +0.4% -19.7% -33.7% -34.0% 0.0% rewrite +0.2% -0.5% -20.7% -20.7% 0.0% -------------------------------------------------------------------------------- Min +0.2% -19.7% -48.1% -48.9% 0.0% Max +0.4% +0.6% -1.2% -1.1% +11.1% Geometric Mean +0.2% -0.4% -21.0% -21.1% +0.1% I investigated the 0.6% increase on 'parser'. It comes because SpecConstr has a limit of 3 specialisations. With HEAD, hsDoExpr has 2 specialisations, and then a further several from the specialised bodies, of which 1 is picked. With this patch we get 3 specialisations right off the bat, so we discard all from the recursive calls. Turns out that that's not the best choice, but there is no way to tell that. I'm accepting it. NB: these figures actually come from this patch plus the preceding one for StgCSE, but I think the gains come from SpecConstr. - - - - - 40d28436 by Matthew Pickering at 2021-04-18T11:09:32-04:00 Only load package environment file once when starting GHCi Since d880d6b2e48268f5ed4d3eb751fe24cc833e9221 the parsing of the environment files was moved to `parseDynamicFlags`, under the assumption it was typically only called once. It turns out not to be true in GHCi and this led to continually reparsing the environment file whenever a new option was set, the options were appended to the package state and hence all packages reloaded, as it looked like the options were changed. The simplest fix seems to be a clearer specification: > Package environment files are only loaded in GHCi during initialisation. Fixes #19650 - - - - - a4234697 by Ben Gamari at 2021-04-18T20:12:26-04:00 Fix Haddock reference - - - - - 78288b97 by Ben Gamari at 2021-04-18T20:12:26-04:00 users-guide: Clarify GHC2021 documentation Point out that GHC2021 doesn't offer the same degree of stability that Haskell2010 does, as noted by @phadej. - - - - - b5189749 by Ben Gamari at 2021-04-18T20:12:26-04:00 users guide: Sort lists of implied language extensions - - - - - 0165b029 by Ben Gamari at 2021-04-18T20:12:26-04:00 users-guide: Add missing FieldSelectors to GHC2021 list - - - - - 0b398d55 by Ryan Scott at 2021-04-18T20:13:01-04:00 Use correct precedence in Complex's Read1/Show1 instances Fixes #19719. - - - - - 8b5e5b05 by Andreas Schwab at 2021-04-19T15:40:25-04:00 Enable tables next to code for riscv64 This requires adding another rewrite to the mangler, to avoid generating PLT entries. - - - - - 0619fb0f by Alan Zimmerman at 2021-04-19T15:41:00-04:00 EPA: cleanups after the merge Remove EpaAnn type synonym, rename EpaAnn' to EpaAnn. Closes #19705 Updates haddock submodule -- Change data EpaAnchor = AR RealSrcSpan | AD DeltaPos To instead be data EpaAnchor = AnchorReal RealSrcSpan | AnchorDelta DeltaPos Closes #19699 -- Change data DeltaPos = DP { deltaLine :: !Int, deltaColumn :: !Int } To instead be data DeltaPos = SameLine { deltaColumn :: !Int } | DifferentLine { deltaLine :: !Int, startColumn :: !Int } Closes #19698 -- Also some clean-ups of unused parts of check-exact. - - - - - 99bd4ae6 by Sebastian Graf at 2021-04-20T10:17:52+02:00 Factor out DynFlags from WorkWrap.Utils Plus a few minor refactorings: * Introduce `normSplitTyConApp_maybe` to Core.Utils * Reduce boolean blindness in the Bool argument to `wantToUnbox` * Let `wantToUnbox` also decide when to drop an argument, cleaning up `mkWWstr_one` - - - - - ee5dadad by Sebastian Graf at 2021-04-20T10:17:55+02:00 Refactor around `wantToUnbox` I renamed `wantToUnbox` to `wantToUnboxArg` and then introduced `wantToUnboxResult`, which we call in `mkWWcpr_one` now. I also deleted `splitArgType_maybe` (the single call site outside of `wantToUnboxArg` actually cared about the result type of a function, not an argument) and `splitResultType_maybe` (which is entirely superceded by `wantToUnboxResult`. - - - - - 0e541137 by Sebastian Graf at 2021-04-20T10:17:55+02:00 Worker/wrapper: Consistent names - - - - - fdbead70 by Sebastian Graf at 2021-04-20T14:55:16+02:00 Worker/wrapper: Refactor CPR WW to work for nested CPR (#18174) In another small step towards bringing a manageable variant of Nested CPR into GHC, this patch refactors worker/wrapper to be able to exploit Nested CPR signatures. See the new Note [Worker/wrapper for CPR]. The nested code path is currently not triggered, though, because all signatures that we annotate are still flat. So purely a refactoring. I am very confident that it works, because I ripped it off !1866 95% unchanged. A few test case outputs changed, but only it's auxiliary names only. I also added test cases for #18109 and #18401. There's a 2.6% metric increase in T13056 after a rebase, caused by an additional Simplifier run. It appears b1d0b9c saw a similar additional iteration. I think it's just a fluke. Metric Increase: T13056 - - - - - b7980b5d by Simon Peyton Jones at 2021-04-20T21:33:09-04:00 Fix occAnalApp In OccurAnal the function occAnalApp was failing to reset occ_encl to OccVanilla. This omission sometimes resulted in over-pessimistic occurrence information. I tripped over this when analysing eta-expansions. Compile times in perf/compiler fell slightly (no increases) PmSeriesG(normal) ghc/alloc 50738104.0 50580440.0 -0.3% PmSeriesS(normal) ghc/alloc 64045284.0 63739384.0 -0.5% PmSeriesT(normal) ghc/alloc 94430324.0 93800688.0 -0.7% PmSeriesV(normal) ghc/alloc 63051056.0 62758240.0 -0.5% T10547(normal) ghc/alloc 29322840.0 29307784.0 -0.1% T10858(normal) ghc/alloc 191988716.0 189801744.0 -1.1% T11195(normal) ghc/alloc 282654016.0 281839440.0 -0.3% T11276(normal) ghc/alloc 142994648.0 142338688.0 -0.5% T11303b(normal) ghc/alloc 46435532.0 46343376.0 -0.2% T11374(normal) ghc/alloc 256866536.0 255653056.0 -0.5% T11822(normal) ghc/alloc 140210356.0 138935296.0 -0.9% T12234(optasm) ghc/alloc 60753880.0 60720648.0 -0.1% T14052(ghci) ghc/alloc 2235105796.0 2230906584.0 -0.2% T17096(normal) ghc/alloc 297725396.0 296237112.0 -0.5% T17836(normal) ghc/alloc 1127785292.0 1125316160.0 -0.2% T17836b(normal) ghc/alloc 54761928.0 54637592.0 -0.2% T17977(normal) ghc/alloc 47529464.0 47397048.0 -0.3% T17977b(normal) ghc/alloc 42906972.0 42809824.0 -0.2% T18478(normal) ghc/alloc 777385708.0 774219280.0 -0.4% T18698a(normal) ghc/alloc 415097664.0 409009120.0 -1.5% GOOD T18698b(normal) ghc/alloc 500082104.0 493124016.0 -1.4% GOOD T18923(normal) ghc/alloc 72252364.0 72216016.0 -0.1% T1969(normal) ghc/alloc 811581860.0 804883136.0 -0.8% T5837(normal) ghc/alloc 37688048.0 37666288.0 -0.1% Nice! Metric Decrease: T18698a T18698b - - - - - 7f4d06e6 by Matthew Pickering at 2021-04-22T16:59:42-04:00 driver: Consider dyn_o files when checking recompilation in -c When -dynamic-too is enabled, there are two result files, .o and .dyn_o, therefore we should check both to decide whether to set SourceModified or not. The whole recompilation logic is very messy, a more thorough refactor would be beneficial in this area but this is the minimal patch to fix this more high priority problem. Fixes #17968 and hopefully #17534 - - - - - 4723652a by Fendor at 2021-04-22T17:00:19-04:00 Move 'nextWrapperNum' into 'DsM' and 'TcM' Previously existing in 'DynFlags', 'nextWrapperNum' is a global variable mapping a Module to a number for name generation for FFI calls. This is not the right location for 'nextWrapperNum', as 'DynFlags' should not contain just about any global variable. - - - - - 350f4f61 by Viktor Dukhovni at 2021-04-22T17:00:54-04:00 Support R_X86_64_TLSGD relocation on FreeBSD The FreeBSD C <ctype.h> header supports per-thread locales by exporting a static inline function that references the `_ThreadRuneLocale` thread-local variable. This means that object files that use e.g. isdigit(3) end up with TLSGD(19) relocations, and would not load into ghci or the language server. Here we add support for this type of relocation, for now just on FreeBSD, and only for external references to thread-specifics defined in already loaded dynamic modules (primarily libc.so). This is sufficient to resolve the <ctype.h> issues. Runtime linking of ".o" files which *define* new thread-specific variables would be noticeably more difficult, as this would likely require new rtld APIs. - - - - - aa685c50 by Viktor Dukhovni at 2021-04-22T17:00:55-04:00 Add background note in elf_tlsgd.c. Also some code cleanup, and a fix for an (extant unrelated) missing <pthread_np.h> include that should hopefully resolve a failure in the FreeBSD CI build, since it is best to make sure that this MR actually builds on FreeBSD systems other than mine. Some unexpected metric changes on FreeBSD (perhaps because CI had been failing for a while???): Metric Decrease: T3064 T5321Fun T5642 T9020 T12227 T13253-spj T15164 T18282 WWRec Metric Increase: haddock.compiler - - - - - 72b48c44 by Viktor Dukhovni at 2021-04-22T17:00:55-04:00 Block signals in the ticker thread This avoids surprises in the non-threaded runtime with blocked signals killing the process because they're only blocked in the main thread and not in the ticker thread. - - - - - 7bc7eea3 by Viktor Dukhovni at 2021-04-22T17:00:55-04:00 Make tests more portable on FreeBSD - - - - - 0015f019 by Adam Gundry at 2021-04-23T23:05:04+01:00 Rename references to Note [Trees That Grow] consistently [skip ci] I tend to find Notes by (case-sensitive) grep, and I spent a surprisingly long time looking for this Note, because it was referenced inconsistently with different cases, and without the module name. - - - - - d38397fa by Sebastian Graf at 2021-04-26T23:53:56-04:00 Parser: Unbox `ParseResult` Using `UnliftedNewtypes`, unboxed tuples and sums and a few pattern synonyms, we can make `ParseResult` completely allocation-free. Part of #19263. - - - - - 045e5f49 by Oleg Grenrus at 2021-04-26T23:54:34-04:00 Add Eq1 and Ord1 Fixed instances - - - - - 721ea018 by Ben Gamari at 2021-04-26T23:55:09-04:00 codeGen: Teach unboxed sum rep logic about levity Previously Unarise would happily project lifted and unlifted fields to lifted slots. This broke horribly in #19645, where a ByteArray# was passed in a lifted slot and consequently entered. The simplest way to fix this is what I've done here, distinguishing between lifted and unlifted slots in unarise. However, one can imagine more clever solutions, where we coerce the binder to the correct levity with respect to the sum's tag. I doubt that this would be worth the effort. Fixes #19645. - - - - - 9f9fab15 by Ben Gamari at 2021-04-26T23:55:09-04:00 testsuite: Add test for #19645 - - - - - 3339ed49 by Ben Gamari at 2021-04-26T23:55:44-04:00 users-guide: Document deprecation of -funfolding-keeness-factor See #15304. - - - - - 9d34f454 by Ben Gamari at 2021-04-26T23:55:44-04:00 users guide: Various other cleanups - - - - - 06654a6e by Matthew Pickering at 2021-04-26T23:56:18-04:00 Correct treatment of rexported modules in mkModuleNameProvidersMap Before we would get the incorrect error message saying that the rexporting package was the same as the defining package. I think this only affects error messages for now. ``` - it is bound as p-0.1.0.0:P2 by a reexport in package p-0.1.0.0 - it is bound as P by a reexport in package p-0.1.0.0 + it is bound as p-0.1.0.0:P2 by a reexport in package q-0.1.0.0 + it is bound as P by a reexport in package r-0.1.0.0 ``` and the output of `-ddump-mod-map` claimed.. ``` Moo moo-0.0.0.1 (hidden package, reexport by moo-0.0.0.1) ``` - - - - - 6c7fff0b by Simon Peyton Jones at 2021-04-26T23:56:53-04:00 Eliminate unsafeEqualityProof in CorePrep The main idea here is to avoid treating * case e of {} * case unsafeEqualityProof of UnsafeRefl co -> blah specially in CoreToStg. Instead, nail them in CorePrep, by converting case e of {} ==> e |> unsafe-co case unsafeEqualityProof of UnsafeRefl cv -> blah ==> blah[unsafe-co/cv] in GHC.Core.Prep. Now expressions that we want to treat as trivial really are trivial. We can get rid of cpExprIsTrivial. And we fix #19700. A downside is that, at least under unsafeEqualityProof, we substitute in types and coercions, which is more work. But a big advantage is that it's all very simple and principled: CorePrep really gets rid of the unsafeCoerce stuff, as it does empty case, runRW#, lazyId etc. I've updated the overview in GHC.Core.Prep, and added Note [Unsafe coercions] in GHC.Core.Prep Note [Implementing unsafeCoerce] in base:Unsafe.Coerce We get 3% fewer bytes allocated when compiling perf/compiler/T5631, which uses a lot of unsafeCoerces. (It's a happy-generated parser.) Metric Decrease: T5631 - - - - - b9e2491d by Rafal Gwozdzinski at 2021-04-26T23:57:29-04:00 Add GHC.Utils.Error.pprMessages - - - - - 72c1812f by Ben Gamari at 2021-04-26T23:58:16-04:00 rts/m32: Fix bounds check Previously we would check only that the *start* of the mapping was in the bottom 32-bits of address space. However, we need the *entire* mapping to be in low memory. Fix this. Noticed by @Phyx. - - - - - dd0a95a3 by Sasha Bogicevic at 2021-04-26T23:58:56-04:00 18000 Use GHC.IO.catchException in favor of Exception.catch fix #18000 - - - - - c1549069 by Adam Sandberg Ericsson at 2021-04-26T23:59:32-04:00 docs: add a short up-front description for -O, -n, -qn, -I and -Iw - - - - - d9ceb2fb by iori tsu at 2021-04-27T00:00:08-04:00 Add documentation for GHC.Exts.sortWith sortWith has the same type definition as `Data.List.sortOn` (eg: `Ord b => (a -> b) -> [a] -> [a]`). Nonetheless, they behave differently, sortOn being more efficient. This merge request add documentation to reflect on this differences - - - - - dd121fa1 by Ryan Scott at 2021-04-27T00:00:43-04:00 Pretty-print HsArgPar applications correctly (#19737) Previously, the `Outputable` instance for `HsArg` was being used to pretty-print each `HsArgPar` in a list of `HsArg`s individually, which simply doesn't work. In lieu of the `Outputable` instance, we now use a dedicated `pprHsArgsApp` function to print a list of `HsArg`s as a single unit. I have also added documentation to the `Outputable` instance for `HsArg` to more clearly signpost that it is only suitable for debug pretty-printing. Fixes #19737. - - - - - 484a8b2d by Ben Gamari at 2021-04-27T21:57:56-04:00 Introduce -ddump-verbose-inlinings Previously -ddump-inlinings and -dverbose-core2core used in conjunction would have the side-effect of dumping additional information about all inlinings considered by the simplifier. However, I have sometimes wanted this inlining information without the firehose of information produced by -dverbose-core2core. Introduce a new dump flag for this purpose. - - - - - 9ead1b35 by Daniel Rogozin at 2021-04-27T21:58:32-04:00 fix #19736 - - - - - d2399a46 by Sasha Bogicevic at 2021-04-27T21:59:08-04:00 19079 DerivingVia: incorrectly accepts deriving via types with differing runtime representations - - - - - 59cf287d by Sylvain Henry at 2021-04-29T17:26:43-04:00 Refactor divInt# to make it branchless (#18067, #19636) - - - - - 8d069477 by Sylvain Henry at 2021-04-29T17:26:43-04:00 Refactor modInt# to make it branchless - - - - - e50d0675 by Sylvain Henry at 2021-04-29T17:26:43-04:00 Allow divInt#/modInt# to inline (#18067) - - - - - c308c9af by Sylvain Henry at 2021-04-29T17:26:43-04:00 Make divModInt# branchless - - - - - 7bb3443a by Sylvain Henry at 2021-04-29T17:26:43-04:00 Fix inlining of division wrappers - - - - - 7d18e1ba by Alfredo Di Napoli at 2021-04-29T17:27:19-04:00 Add GhcMessage and ancillary types This commit adds GhcMessage and ancillary (PsMessage, TcRnMessage, ..) types. These types will be expanded to represent more errors generated by different subsystems within GHC. Right now, they are underused, but more will come in the glorious future. See https://gitlab.haskell.org/ghc/ghc/-/wikis/Errors-as-(structured)-values for a design overview. Along the way, lots of other things had to happen: * Adds Semigroup and Monoid instance for Bag * Fixes #19746 by parsing OPTIONS_GHC pragmas into Located Strings. See GHC.Parser.Header.toArgs (moved from GHC.Utils.Misc, where it didn't belong anyway). * Addresses (but does not completely fix) #19709, now reporting desugarer warnings and errors appropriately for TH splices. Not done: reporting type-checker warnings for TH splices. * Some small refactoring around Safe Haskell inference, in order to keep separate classes of messages separate. * Some small refactoring around initDsTc, in order to keep separate classes of messages separate. * Separate out the generation of messages (that is, the construction of the text block) from the wrapping of messages (that is, assigning a SrcSpan). This is more modular than the previous design, which mixed the two. Close #19746. This was a collaborative effort by Alfredo di Napoli and Richard Eisenberg, with a key assist on #19746 by Iavor Diatchki. Metric Increase: MultiLayerModules - - - - - 5981ac7d by Ryan Scott at 2021-04-29T17:27:54-04:00 Redesign withDict (formerly magicDict) This gives a more precise type signature to `magicDict` as proposed in #16646. In addition, this replaces the constant-folding rule for `magicDict` in `GHC.Core.Opt.ConstantFold` with a special case in the desugarer in `GHC.HsToCore.Expr.dsHsWrapped`. I have also renamed `magicDict` to `withDict` in light of the discussion in https://mail.haskell.org/pipermail/ghc-devs/2021-April/019833.html. All of this has the following benefits: * `withDict` is now more type safe than before. Moreover, if a user applies `withDict` at an incorrect type, the special-casing in `dsHsWrapped` will now throw an error message indicating what the user did incorrectly. * `withDict` can now work with classes that have multiple type arguments, such as `Typeable @k a`. This means that `Data.Typeable.Internal.withTypeable` can now be implemented in terms of `withDict`. * Since the special-casing for `withDict` no longer needs to match on the structure of the expression passed as an argument to `withDict`, it no longer cares about the presence or absence of `Tick`s. In effect, this obsoletes the fix for #19667. The new `T16646` test case demonstrates the new version of `withDict` in action, both in terms of `base` functions defined in terms of `withDict` as well as in terms of functions from the `reflection` and `singletons` libraries. The `T16646Fail` test case demonstrates the error message that GHC throws when `withDict` is applied incorrectly. This fixes #16646. By adding more tests for `withDict`, this also fixes #19673 as a side effect. - - - - - 51470000 by Ryan Scott at 2021-04-29T17:28:30-04:00 Expand synonyms in mkCastTy when necessary Doing so is important to maintain invariants (EQ3) and (EQ4) from `Note [Respecting definitional equality]` in `GHC.Core.TyCo.Rep`. For the details, see the new `Note [Using coreView in mk_cast_ty]`. Fixes #19742. - - - - - c2541c49 by Ryan Scott at 2021-04-29T17:29:05-04:00 Propagate free variables in extract_lctxt correctly This fixes an oversight in the implementation of `extract_lctxt` which was introduced in commit ce85cffc. Fixes #19759. - - - - - 1d03d8be by Sylvain Henry at 2021-04-29T17:29:44-04:00 Replace (ptext .. sLit) with `text` 1. `text` is as efficient as `ptext . sLit` thanks to the rewrite rules 2. `text` is visually nicer than `ptext . sLit` 3. `ptext . sLit` encourages using one `ptext` for several `sLit` as in: ptext $ case xy of ... -> sLit ... ... -> sLit ... which may allocate SDoc's TextBeside constructors at runtime instead of sharing them into CAFs. - - - - - 2d2985a7 by Adam Sandberg Ericsson at 2021-04-29T17:30:20-04:00 rts: export allocateWrite, freeWrite and markExec #19763 - - - - - c0c0b4e0 by Viktor Dukhovni at 2021-04-30T23:21:34-04:00 Tighten scope of non-POSIX visibility macros The __BSD_VISIBLE and _DARWIN_C_SOURCE macros expose non-POSIX prototypes in system header files. We should scope these to just the ".c" modules that actually need them, and avoid defining them in header files used in other C modules. - - - - - c7ca3619 by Sylvain Henry at 2021-04-30T23:22:13-04:00 Interpreter: replace DynFlags with EvalOpts/BCOOpts - - - - - 491266ee by Sylvain Henry at 2021-04-30T23:22:13-04:00 Make GHC.Runtime.Interpreter independent of GHC.Driver - - - - - 48c2c2af by Sylvain Henry at 2021-04-30T23:22:13-04:00 Fix genprimopcode warning - - - - - 6623790d by Sylvain Henry at 2021-04-30T23:22:13-04:00 Hadrian: build check-* with -Wall/-Werror Otherwise CI fails only with make build system. - - - - - 460afbe6 by Ryan Scott at 2021-04-30T23:22:48-04:00 Bring tcTyConScopedTyVars into scope in tcClassDecl2 It is possible that the type variables bound by a class header will map to something different in the typechecker in the presence of `StandaloneKindSignatures`. `tcClassDecl2` was not aware of this, however, leading to #19738. To fix it, in `tcTyClDecls` we map each class `TcTyCon` to its `tcTyConScopedTyVars` as a `ClassScopedTVEnv`. We then plumb that `ClassScopedTVEnv` to `tcClassDecl2` where it can be used. Fixes #19738. - - - - - e61d2d47 by Sylvain Henry at 2021-04-30T23:23:26-04:00 Make sized division primops ok-for-spec (#19026) - - - - - 1b9df111 by Harry Garrood harry at garrood.me at 2021-05-03T19:48:21-04:00 Add test case for #8144 Fixes #8144 - - - - - 4512ad2d by John Ericson at 2021-05-03T19:48:56-04:00 Use fix-sized bit-fiddling primops for fixed size boxed types Like !5572, this is switching over a portion of the primops which seems safe to use. - - - - - 8d6b2525 by Sylvain Henry at 2021-05-03T19:48:56-04:00 Move shift ops out of GHC.Base With a quick flavour I get: before T12545(normal) ghc/alloc 8628109152 after T12545(normal) ghc/alloc 8559741088 - - - - - 3a2f2475 by bit at 2021-05-03T19:49:32-04:00 Update documentation of 'Weak' - - - - - 4e546834 by Tamar Christina at 2021-05-03T19:50:10-04:00 pe: enable code unloading for Windows - - - - - 5126a07e by Philipp Dargel at 2021-05-03T19:50:46-04:00 Remove duplicate modules in GHCi %s prompt fixes #19757 - - - - - 0680e9a5 by Hécate Moonlight at 2021-05-03T19:51:22-04:00 Disable HLint colours closes #19776 - - - - - 7f5ee719 by iori tsu at 2021-05-03T19:51:58-04:00 visually align expected and actual modules name before: > /home/matt/Projects/persistent/persistent/Database/Persist/ImplicitIdDef.hs:1:8: error: > File name does not match module name: > Saw: ‘A.B.Module’ > Expected: ‘A.B.Motule’ > | > 1 | module A.B.Motule > | ^^^^^^^^^^> after: > /home/matt/Projects/persistent/persistent/Database/Persist/ImplicitIdDef.hs:1:8: error: > File name does not match module name: > Saw: ‘A.B.Module’ > Expected: ‘A.B.Motule’ > | > 1 | module A.B.Motule > | ^^^^^^^^^^> - - - - - 24a9b170 by sheaf at 2021-05-03T19:52:34-04:00 Improve hs-boot binds error (#19781) - - - - - 39020600 by Roland Senn at 2021-05-04T16:00:13-04:00 Tweak function `quantifyType` to fix #12449 In function `compiler/GHC/Runtime/Heap/Inspect.hs:quantifyType` replace `tcSplitForAllInvisTyVars` by `tcSplitNestedSigmaTys`. This will properly split off the nested foralls in examples like `:print fmap`. Do not remove the `forall`s from the `snd` part of the tuple returned by `quantifyType`. It's not necessary and the reason for the bug in #12449. Some code simplifications at the calling sites of `quantifyTypes`. - - - - - 6acadb79 by Simon Peyton Jones at 2021-05-04T16:00:48-04:00 Persist CorePrepProv into IfaceUnivCoProv CorePrepProv is only created in CorePrep, so I thought it wouldn't be needed in IfaceUnivCoProv. But actually IfaceSyn is used during pretty-printing, and we can certainly pretty-print things after CorePrep as #19768 showed. So the simplest thing is to represent CorePrepProv in IfaceSyn. To improve what Lint can do I also added a boolean to CorePrepProv, to record whether it is homogeneously kinded or not. It is introduced in two distinct ways (see Note [Unsafe coercions] in GHC.CoreToStg.Prep), one of which may be hetero-kinded (e.g. Int ~ Int#) beause it is casting a divergent expression; but the other is not. The boolean keeps track. - - - - - 7ffbdc3f by Ben Gamari at 2021-05-05T05:42:38-04:00 Break up aclocal.m4 - - - - - 34452fbd by Ben Gamari at 2021-05-05T05:42:38-04:00 configure: Move pthreads checks to macro - - - - - 0de2012c by Ben Gamari at 2021-05-05T05:42:38-04:00 configure: Move libnuma check to macro - - - - - 958c6fbd by Ben Gamari at 2021-05-05T05:42:38-04:00 configure: Move libdw search logic to macro - - - - - 101d25fc by Alfredo Di Napoli at 2021-05-05T05:43:14-04:00 Add some DriverMessage type constructors This commit expands the DriverMessage type with new type constructors, making the number of diagnostics GHC can emit richer. In particular: * Add DriverMissingHomeModules message * Add DriverUnusedPackage message * Add DriverUnnecessarySourceImports message This commit adds the `DriverUnnecessarySourceImports` message and fixes a small bug in its reporting: inside `warnUnnecessarySourceImports` we were checking for `Opt_WarnUnusedSourceImports` to be set, but we were emitting the diagnostic with `WarningWithoutFlag`. This also adjusts the T10637 test to reflect that. * Add DriverDuplicatedModuleDeclaration message * Add DriverModuleNotFound message * Add DriverFileModuleNameMismatch message * Add DriverUnexpectedSignature message * Add DriverFileNotFound message * Add DriverStaticPointersNotSupported message * Add DriverBackpackModuleNotFound message - - - - - e9617fba by Matthew Pickering at 2021-05-05T05:43:49-04:00 test driver: Make sure RESIDENCY_OPTS is passed for 'all' perf tests Fixes #19731 ------------------------- Metric Decrease: T11545 Metric Increase: T12545 T15304 ------------------------- - - - - - f464e477 by Jaro Reinders at 2021-05-05T05:44:26-04:00 More specific error messages for annotations (fixes #19740) - - - - - 3280eb22 by Luite Stegeman at 2021-05-05T05:45:03-04:00 support LiftedRep and UnliftedRep in GHCi FFI fixes #19733 - - - - - 049c3a83 by Hécate Moonlight at 2021-05-05T05:45:39-04:00 Add an .editorconfig file closes #19793 - - - - - a5e9e5b6 by Ben Gamari at 2021-05-06T02:30:18-04:00 Re-introduce Note [keepAlive# magic] Somewhere in the course of forward- and back-porting the keepAlive# branch the Note which described the mechanism was dropped. Reintroduce it. Closes #19712. - - - - - c4f4193a by John Ericson at 2021-05-06T02:30:54-04:00 Use fix-sized arithmetic primops for fixed size boxed types We think the compiler is ready, so we can do this for all over the 8-, 16-, and 32-bit boxed types. We are holding off on doing all the primops at once so things are easier to investigate. Metric Decrease: T12545 - - - - - 418295ea by Sasha Bogicevic at 2021-05-06T02:31:31-04:00 19486 Nearly all uses of `uniqCompareFS` are dubious and lack a non-determinism justification - - - - - 1635d5c2 by Alan Zimmerman at 2021-05-06T02:32:06-04:00 EPA: properly capture semicolons between Matches in a FunBind For the source module MatchSemis where { a 0 = 1; a _ = 2; } Make sure that the AddSemiAnn entries for the two trailing semicolons are attached to the component Match elements. Closes #19784 - - - - - e5778365 by PHO at 2021-05-06T02:32:44-04:00 rts/posix/GetTime.c: Use Solaris-specific gethrvtime(3) on OpenSolaris derivatives The constant CLOCK_THREAD_CPUTIME_ID is defined in a system header but it isn't acutally usable. clock_gettime(2) always returns EINVAL. - - - - - 87d8c008 by Ben Gamari at 2021-05-06T12:44:06-04:00 Bump binary submodule Fixes #19631. - - - - - 0281dae8 by Aaron Allen at 2021-05-06T12:44:43-04:00 Disallow -XDerivingVia when -XSafe is on (#19786) Since `GeneralizedNewtypeDeriving` is considered unsafe, `DerivingVia` should be as well. - - - - - 30f6923a by Ben Gamari at 2021-05-06T12:45:19-04:00 hadrian: Don't depend upon bash from PATH Previously Hadrian depended implicitly upon whatever `bash` it found in `PATH`, offerring no way for the user to override. Fix this by detecting `sh` in `configure` and passing the result to Hadrian. Fixes #19797. - - - - - c5454dc7 by Moritz Angermann at 2021-05-07T09:17:22+08:00 [ci] Add support for building on aarch64-darwin This will fail for now. But allows us to add aarch64-darwin machines to CI. (cherry picked from commit a7d22795ed118abfe64f4fc55d96d8561007ce1e) - - - - - 41b0c288 by Moritz Angermann at 2021-05-07T09:17:22+08:00 [testlib/driver] denoise this prevents the testlib/driver to be overly noisy, and will also kill some noise produiced by the aarch64-darwin cc (for now). Fixing sysctl, will allow us to run the test's properly in a nix-shell on aarch64-darwin (cherry picked from commit 5109e87e13ab45d799db2013535f54ca35f1f4dc) - - - - - bb78df78 by Moritz Angermann at 2021-05-07T09:17:22+08:00 [ci] default value for CONFIGURE_ARGS (cherry picked from commit 307d34945b7d932156e533736c91097493e6181b) - - - - - 5f5b02c2 by Moritz Angermann at 2021-05-07T09:17:22+08:00 [ci] Default value for MAKE_ARGS We don't pass MAKE_ARGS for windows builds, so this should unbreak them. (cherry picked from commit 16c13d5acfdc8053f7de9e908cc9d845e9bd34bb) - - - - - 79019dd6 by Moritz Angermann at 2021-05-07T09:17:23+08:00 [testsuite/darwin] fix conc059 This resolves the following: Compile failed (exit code 1) errors were: conc059_c.c:27:5: error: error: implicitly declaring library function 'exit' with type 'void (int) __attribute__((noreturn))' [-Werror,-Wimplicit-function-declaration] exit(0); ^ conc059_c.c:27:5: error: note: include the header <stdlib.h> or explicitly provide a declaration for 'exit' (cherry picked from commit 5a6c36ecb41fccc07c1b01fe0f330cd38c2a0c76) - - - - - 8a36ebfa by Moritz Angermann at 2021-05-07T09:17:23+08:00 [Aarch64] No div-by-zero; disable test. (cherry picked from commit 3592d1104c47b006fd9f4127d93916f477a6e010) - - - - - 10b5dc88 by Moritz Angermann at 2021-05-07T09:19:47+08:00 [Darwin] mark stdc++ tests as broken There is no libstdc++, only libc++ (cherry picked from commit 57671071adeaf0b45e86bb0ee050e007e3b161fb) - - - - - 035f4bb1 by Moritz Angermann at 2021-05-07T09:19:47+08:00 [testsuite] filter out superfluous dylib warnings (cherry picked from commit 33c4d497545559a38bd8d1caf6c94e5e2a77647b) - - - - - 3f09c6f8 by Moritz Angermann at 2021-05-07T09:19:47+08:00 [ci/nix-shell] Add Foundation and Security (cherry picked from commit 4bea83afec009dfd3c6313cac4610d00ba1f9a3d) - - - - - 65440597 by Moritz Angermann at 2021-05-07T09:19:47+08:00 [testsuite/json2] Fix failure with LLVM backends -Wno-unsupported-llvm-version should suppress the LLVM version missmatch warning that messes up the output. (cherry picked from commit 63455300625fc12b2aafc3e339eb307510a6e8bd) - - - - - 582fc583 by Moritz Angermann at 2021-05-07T09:19:47+08:00 [ci/nix-shell] [Darwin] Stop the ld warnings about libiconv. (cherry picked from commit c3944bc89d062a4850946904133c7a1464d59012) - - - - - 7df44e43 by Moritz Angermann at 2021-05-07T09:19:48+08:00 [testsuite] static001 is not broken anymore. (cherry picked from commit b821fcc7142edff69aa4c47dc1a5bd30b13c1ceb) - - - - - 49839322 by Moritz Angermann at 2021-05-07T09:19:48+08:00 [testsuite/arm64] fix section_alignment (cherry picked from commit f7062e1b0c91e8aa78e245a3dab9571206fce16d) - - - - - ccea6117 by Moritz Angermann at 2021-05-07T09:19:48+08:00 [ci/nix-shell] uniquify NIX_LDFLAGS{_FOR_TARGET} (cherry picked from commit 07b1af0362beaaf221cbee7b17bbe0a5606fd87d) - - - - - cceb461a by Moritz Angermann at 2021-05-07T09:19:48+08:00 [darwin] stop the DYLD_LIBRARY_PATH madness this causes *significant* slowdown on macOS as the linker ends up looking through all the paths. Slowdown can be as bad as 100% or more. (cherry picked from commit 820b0766984d42c06c977a6c32da75c429106f7f) - - - - - a664a2ad by Moritz Angermann at 2021-05-07T09:19:48+08:00 [ci] Default values for CI_COMMIT_BRANCH, CI_PROJECT_PATH - - - - - 8e0f48bd by Simon Peyton Jones at 2021-05-07T09:43:57-04:00 Allow visible type application for levity-poly data cons This patch was driven by #18481, to allow visible type application for levity-polymorphic newtypes. As so often, it started simple but grew: * Significant refactor: I removed HsConLikeOut from the client-independent Language.Haskell.Syntax.Expr, and put it where it belongs, as a new constructor `ConLikeTc` in the GHC-specific extension data type for expressions, `GHC.Hs.Expr.XXExprGhcTc`. That changed touched a lot of files in a very superficial way. * Note [Typechecking data constructors] explains the main payload. The eta-expansion part is no longer done by the typechecker, but instead deferred to the desugarer, via `ConLikeTc` * A little side benefit is that I was able to restore VTA for data types with a "stupid theta": #19775. Not very important, but the code in GHC.Tc.Gen.Head.tcInferDataCon is is much, much more elegant now. * I had to refactor the levity-polymorphism checking code in GHC.HsToCore.Expr, see Note [Checking for levity-polymorphic functions] Note [Checking levity-polymorphic data constructors] - - - - - 740103c5 by PHO at 2021-05-07T20:06:43-04:00 rts/posix/OSThreads.c: Implement getNumberOfProcessors() for NetBSD - - - - - 39be3283 by PHO at 2021-05-07T20:06:43-04:00 rts: Correctly call pthread_setname_np() on NetBSD NetBSD supports pthread_setname_np() but it expects a printf-style format string and a string argument. Also use pthread for itimer on this platform. - - - - - a32eb0f3 by Simon Peyton Jones at 2021-05-07T20:07:19-04:00 Fix newtype eta-reduction The eta-reduction we do for newype axioms was generating an inhomogeneous axiom: see #19739. This patch fixes it in a simple way; see GHC.Tc.TyCl.Build Note [Newtype eta and homogeneous axioms] - - - - - ad5a3aeb by Alan Zimmerman at 2021-05-08T11:19:26+01:00 EPA: update some comments in Annotations. Follow-up from !2418, see #19579 - - - - - 736d47ff by Alan Zimmerman at 2021-05-09T18:13:40-04:00 EPA: properly capture leading semicolons in statement lists For the fragment blah = do { ; print "a" ; print "b" } capture the leading semicolon before 'print "a"' in 'al_rest' in AnnList instead of in 'al_trailing'. Closes #19798 - - - - - c4a85e3b by Andreas Klebinger at 2021-05-11T05:34:52-04:00 Expand Note [Data con representation]. Not perfect. But I consider this to be a documentation fix for #19789. - - - - - 087ac4eb by Simon Peyton Jones at 2021-05-11T05:35:27-04:00 Minor refactoring in WorkWrap This patch just does the tidying up from #19805. No change in behaviour. - - - - - 32367cac by Alan Zimmerman at 2021-05-11T05:36:02-04:00 EPA: Use custom AnnsIf structure for HsIf and HsCmdIf This clearly identifies the presence and location of optional semicolons in an if statement. Closes #19813 - - - - - 09918343 by Andreas Klebinger at 2021-05-11T16:58:38-04:00 Don't warn about ClassOp bindings not specialising. Fixes #19586 - - - - - 5daf1aa9 by Andreas Klebinger at 2021-05-11T16:59:17-04:00 Document unfolding treatment of simplLamBndr. Fixes #19817 - - - - - c7717949 by Simon Peyton Jones at 2021-05-11T23:00:27-04:00 Fix strictness and arity info in SpecConstr In GHC.Core.Opt.SpecConstr.spec_one we were giving join-points an incorrect join-arity -- this was fallout from commit c71b220491a6ae46924cc5011b80182bcc773a58 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Thu Apr 8 23:36:24 2021 +0100 Improvements in SpecConstr * Allow under-saturated calls to specialise See Note [SpecConstr call patterns] This just allows a bit more specialisation to take place. and showed up in #19780. I refactored the code to make the new function calcSpecInfo which treats join points separately. In doing this I discovered two other small bugs: * In the Var case of argToPat we were treating UnkOcc as uninteresting, but (by omission) NoOcc as interesting. As a result we were generating SpecConstr specialisations for functions with unused arguments. But the absence anlyser does that much better; doing it here just generates more code. Easily fixed. * The lifted/unlifted test in GHC.Core.Opt.WorkWrap.Utils.mkWorkerArgs was back to front (#19794). Easily fixed. * In the same function, mkWorkerArgs, we were adding an extra argument nullary join points, which isn't necessary. I added a test for this. That in turn meant I had to remove an ASSERT in CoreToStg.mkStgRhs for nullary join points, which was always bogus but now trips; I added a comment to explain. - - - - - c3868451 by Alan Zimmerman at 2021-05-11T23:01:03-04:00 EPA: record annotations for braces in LetStmt Closes #19814 - - - - - 6967088d by Ben Gamari at 2021-05-11T23:01:38-04:00 base: Update Unicode data to 13.0.0 (cherry picked from commit d22e087f7bf74341c4468f11b4eb0273033ca931) - - - - - 673ff667 by Matthew Pickering at 2021-05-11T23:02:14-04:00 hadrian: Don't always links against libffi The RTS flag `ffi` is set to either True or False depending on whether we want to link against `libffi`, therefore in order to work out whether to add the build tree to the arguments we check whether `ffi` is in the extraLibs or not before adding the argument. Fixes #16022 - - - - - d22e8d89 by Matthew Pickering at 2021-05-11T23:02:50-04:00 rts: Remove trailing whitespace from Adjustor.c - - - - - f0b73ddd by Sylvain Henry at 2021-05-11T23:03:28-04:00 Hadrian: add comment to avoid surprises - - - - - 55223780 by Andreas Klebinger at 2021-05-12T14:49:23-04:00 W/W: Always zap useless idInfos. tryWW used to always returns an Id with a zapped: * DmdEnv * Used Once info except in the case where the ID was guaranteed to be inlined. We now also zap the info in that case. Fixes #19818. - - - - - 541665b7 by Matthew Pickering at 2021-05-12T14:49:58-04:00 hadrian: Fix dynamic+debug flag combination for check-ppr executable - - - - - a7473e03 by Peter Trommler at 2021-05-12T14:50:33-04:00 Hadrian: Enable SMP on powerpc64{le} Fixes #19825 - - - - - f78c25da by Sylvain Henry at 2021-05-12T21:41:43-04:00 Move GlobalVar macros into GHC.Utils.GlobalVars That's the only place where they are used and they shouldn't be used elsewhere. - - - - - da56ed41 by Sylvain Henry at 2021-05-12T21:41:43-04:00 Ensure assert from Control.Exception isn't used - - - - - bfabf94f by Sylvain Henry at 2021-05-12T21:41:43-04:00 Replace CPP assertions with Haskell functions There is no reason to use CPP. __LINE__ and __FILE__ macros are now better replaced with GHC's CallStack. As a bonus, assert error messages now contain more information (function name, column). Here is the mapping table (HasCallStack omitted): * ASSERT: assert :: Bool -> a -> a * MASSERT: massert :: Bool -> m () * ASSERTM: assertM :: m Bool -> m () * ASSERT2: assertPpr :: Bool -> SDoc -> a -> a * MASSERT2: massertPpr :: Bool -> SDoc -> m () * ASSERTM2: assertPprM :: m Bool -> SDoc -> m () - - - - - 0ef11907 by Sylvain Henry at 2021-05-12T21:41:44-04:00 Fully remove HsVersions.h Replace uses of WARN macro with calls to: warnPprTrace :: Bool -> SDoc -> a -> a Remove the now unused HsVersions.h Bump haddock submodule - - - - - 67a5a91e by Sylvain Henry at 2021-05-12T21:41:44-04:00 Remove useless {-# LANGUAGE CPP #-} pragmas - - - - - c34f4c0c by Alan Zimmerman at 2021-05-12T21:42:21-04:00 EPA: Fix incorrect SrcSpan for FamDecl The SrcSpan for a type family declaration did not include the family equations. Closes #19821 - - - - - e0ded198 by Matthew Pickering at 2021-05-12T21:42:57-04:00 ci: Fix unbound CI_MERGE_REQUEST_SOURCE_BRANCH_NAME variable Fixes #19831 - - - - - c6de5805 by John Ericson at 2021-05-13T16:44:23-04:00 Use fix-sized order primops for fixed size boxed types Progress towards #19026 - - - - - fc9546ca by Sylvain Henry at 2021-05-13T16:45:03-04:00 genprimopcode: fix bootstrap errors * Fix for unqualified Data.List import * Fix monad instance - - - - - 60f088b3 by Matthew Pickering at 2021-05-19T09:10:16+01:00 CI: Disable darwin builds They are taking over 4 hours to complete which is stalling the rest of the merge pipeline. - - - - - baa969c3 by Koz Ross at 2021-05-19T23:31:51-04:00 Implement bitwise infix ops - - - - - c8564c63 by Alfredo Di Napoli at 2021-05-19T23:32:27-04:00 Add some TcRn diagnostic messages This commit converts some TcRn diagnostic into proper structured errors. Ported by this commit: * Add TcRnImplicitLift This commit adds the TcRnImplicitLift diagnostic message and a prototype API to be able to log messages which requires additional err info. * Add TcRnUnusedPatternBinds * Add TcRnDodgyExports * Add TcRnDodgyImports message * Add TcRnMissingImportList - - - - - 38faeea1 by Matthew Pickering at 2021-05-19T23:33:02-04:00 Remove transitive information about modules and packages from interface files This commit modifies interface files so that *only* direct information about modules and packages is stored in the interface file. * Only direct module and direct package dependencies are stored in the interface files. * Trusted packages are now stored separately as they need to be checked transitively. * hs-boot files below the compiled module in the home module are stored so that eps_is_boot can be calculated in one-shot mode without loading all interface files in the home package. * The transitive closure of signatures is stored separately This is important for two reasons * Less recompilation is needed, as motivated by #16885, a lot of redundant compilation was triggered when adding new imports deep in the module tree as all the parent interface files had to be redundantly updated. * Checking an interface file is cheaper because you don't have to perform a transitive traversal to check the dependencies are up-to-date. In the code, places where we would have used the transitive closure, we instead compute the necessary transitive closure. The closure is not computed very often, was already happening in checkDependencies, and was already happening in getLinkDeps. Fixes #16885 ------------------------- Metric Decrease: MultiLayerModules T13701 T13719 ------------------------- - - - - - 29d104c6 by nineonine at 2021-05-19T23:33:40-04:00 Implement :info for record pattern synonyms (#19462) - - - - - d45e3cda by Matthew Pickering at 2021-05-19T23:34:15-04:00 hadrian: Make copyFileLinked a bit more robust Previously it only worked if the two files you were trying to symlink were already in the same directory. - - - - - 176b1305 by Matthew Pickering at 2021-05-19T23:34:15-04:00 hadrian: Build check-ppr and check-exact using normal hadrian rules when in-tree Fixes #19606 #19607 - - - - - 3c04e7ac by Andreas Klebinger at 2021-05-19T23:34:49-04:00 Fix LitRubbish being applied to values. This fixes #19824 - - - - - 32725617 by Matthew Pickering at 2021-05-19T23:35:24-04:00 Tidy: Ignore rules (more) when -fomit-interface-pragmas is on Before this commit, the RHS of a rule would expose additional definitions, despite the fact that the rule wouldn't get exposed so it wouldn't be possible to ever use these definitions. The net-result is slightly less recompilation when specialisation introduces rules. Related to #19836 - - - - - 10ae305e by Alan Zimmerman at 2021-05-19T23:35:59-04:00 EPA: Remove duplicate annotations from HsDataDefn They are repeated in the surrounding DataDecl and FamEqn. Updates haddock submodule Closes #19834 - - - - - 8e7f02ea by Richard Eisenberg at 2021-05-19T23:36:35-04:00 Point posters to ghc-proposals - - - - - 6844ead4 by Matthew Pickering at 2021-05-19T23:37:09-04:00 testsuite: Don't copy .hi-boot and .o-boot files into temp dir - - - - - e87b8e10 by Sebastian Graf at 2021-05-19T23:37:44-04:00 CPR: Detect constructed products in `runRW#` apps (#19822) In #19822, we realised that the Simplifier's new habit of floating cases into `runRW#` continuations inhibits CPR analysis from giving key functions of `text` the CPR property, such as `singleton`. This patch fixes that by anticipating part of !5667 (Nested CPR) to give `runRW#` the proper CPR transformer it now deserves: Namely, `runRW# (\s -> e)` should have the CPR property iff `e` has it. The details are in `Note [Simplification of runRW#]` in GHC.CoreToStg.Prep. The output of T18086 changed a bit: `panic` (which calls `runRW#`) now has `botCpr`. As outlined in Note [Bottom CPR iff Dead-Ending Divergence], that's OK. Fixes #19822. Metric Decrease: T9872d - - - - - d3ef2dc2 by Baldur Blöndal at 2021-05-19T23:38:20-04:00 Add pattern TypeRep (#19691), exported by Type.Reflection. - - - - - f192e623 by Sylvain Henry at 2021-05-19T23:38:58-04:00 Cmm: fix sinking after suspendThread Suppose a safe call: myCall(x,y,z) It is lowered into three unsafe calls in Cmm: r = suspendThread(...); myCall(x,y,z); resumeThread(r); Consider the following situation for myCall arguments: x = Sp[..] -- stack y = Hp[..] -- heap z = R1 -- global register r = suspendThread(...); myCall(x,y,z); resumeThread(r); The sink pass assumes that unsafe calls clobber memory (heap and stack), hence x and y assignments are not sunk after `suspendThread`. The sink pass also correctly handles global register clobbering for all unsafe calls, except `suspendThread`! `suspendThread` is special because it releases the capability the thread is running on. Hence the sink pass must also take into account global registers that are mapped into memory (in the capability). In the example above, we could get: r = suspendThread(...); z = R1 myCall(x,y,z); resumeThread(r); But this transformation isn't valid if R1 is (BaseReg->rR1) as BaseReg is invalid between suspendThread and resumeThread. This caused argument corruption at least with the C backend ("unregisterised") in #19237. Fix #19237 - - - - - df4a0a53 by Sylvain Henry at 2021-05-19T23:39:37-04:00 Bignum: bump to version 1.1 (#19846) - - - - - d48b7e5c by Shayne Fletcher at 2021-05-19T23:40:12-04:00 Changes to HsRecField' - - - - - 441fdd6c by Adam Sandberg Ericsson at 2021-05-19T23:40:47-04:00 driver: check if clang is the assembler when passing clang specific arguments (#19827) Previously we assumed that the assembler was the same as the c compiler, but we allow setting them to different programs with -pgmc and -pgma. - - - - - 6a577cf0 by Peter Trommler at 2021-05-19T23:41:22-04:00 PPC NCG: Fix unsigned compare with 16-bit constants Fixes #19852 and #19609 - - - - - c4099b09 by Matthew Pickering at 2021-05-19T23:41:57-04:00 Make setBndrsDemandInfo work with only type variables Fixes #19849 Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - 4b5de954 by Matthew Pickering at 2021-05-19T23:42:32-04:00 constant folding: Make shiftRule for Word8/16/32# types return correct type Fixes #19851 - - - - - 82b097b3 by Sylvain Henry at 2021-05-19T23:43:09-04:00 Remove wired-in names hs-boot check bypass (#19855) The check bypass is no longer necessary and the check would have avoided #19638. - - - - - 939a56e7 by Baldur Blöndal at 2021-05-19T23:43:46-04:00 Added new regresion test for #18036 from ticket #19865. - - - - - 43139064 by Ben Gamari at 2021-05-20T11:36:55-04:00 gitlab-ci: Add Alpine job linking against gmp integer backend As requested by Michael Snoyman. - - - - - 7c066734 by Roland Senn at 2021-05-20T11:37:32-04:00 Use pprSigmaType to print GHCi debugger Suspension Terms (Fix #19355) In the GHCi debugger use the function `pprSigmaType` to print out Suspension Terms. The function `pprSigmaType` respect the flag `-f(no-)print-explicit-foralls` and so it fixes #19355. Switch back output of existing tests to default mode (no explicit foralls). - - - - - aac87bd3 by Alfredo Di Napoli at 2021-05-20T18:08:37-04:00 Extensible Hints for diagnostic messages This commit extends the GHC diagnostic hierarchy with a `GhcHint` type, modelling helpful suggestions emitted by GHC which can be used to deal with a particular warning or error. As a direct consequence of this, the `Diagnostic` typeclass has been extended with a `diagnosticHints` method, which returns a `[GhcHint]`. This means that now we can clearly separate out the printing of the diagnostic message with the suggested fixes. This is done by extending the `printMessages` function in `GHC.Driver.Errors`. On top of that, the old `PsHint` type has been superseded by the new `GhcHint` type, which de-duplicates some hints in favour of a general `SuggestExtension` constructor that takes a `GHC.LanguageExtensions.Extension`. - - - - - 649d63db by Divam at 2021-05-20T18:09:13-04:00 Add tests for code generation options specified via OPTIONS_GHC in multi module compilation - - - - - 5dcb8619 by Matthías Páll Gissurarson at 2021-05-20T18:09:50-04:00 Add exports to GHC.Tc.Errors.Hole (fixes #19864) - - - - - 703c0c3c by Sylvain Henry at 2021-05-20T18:10:31-04:00 Bump libffi submodule to libffi-3.3 (#16940) - - - - - d9eb8bbf by Jakob Brünker at 2021-05-21T06:22:47-04:00 Only suggest names that make sense (#19843) * Don't show suggestions for similar variables when a data constructor in a pattern is not in scope. * Only suggest record fields when a record field for record creation or updating is not in scope. * Suggest similar record fields when a record field is not in scope with -XOverloadedRecordDot. * Show suggestions for data constructors if a type constructor or type is not in scope, but only if -XDataKinds is enabled. Fixes #19843. - - - - - ec10cc97 by Matthew Pickering at 2021-05-21T06:23:26-04:00 hadrian: Reduce verbosity on failed testsuite run When the testsuite failed before it would print a big exception which gave you the very long command line which was used to invoke the testsuite. By capturing the exit code and rethrowing the exception, the error is must less verbose: ``` Error when running Shake build system: at want, called at src/Main.hs:104:30 in main:Main * Depends on: test * Raised the exception: user error (tests failed) ``` - - - - - f5f74167 by Matthew Pickering at 2021-05-21T06:24:02-04:00 Only run armv7-linux-deb10 build nightly - - - - - 6eed426b by Sylvain Henry at 2021-05-21T06:24:44-04:00 SysTools: make file copy more efficient - - - - - 0da85d41 by Alan Zimmerman at 2021-05-21T15:05:44-04:00 EPA: Fix explicit specificity and unicode linear arrow annotations Closes #19839 Closes #19840 - - - - - 5ab174e4 by Alan Zimmerman at 2021-05-21T15:06:20-04:00 Remove Maybe from Context in HsQualTy Updates haddock submodule Closes #19845 - - - - - b4d240d3 by Matthew Pickering at 2021-05-22T00:07:42-04:00 hadrian: Reorganise modules so KV parser can be used to define transformers - - - - - 8c871c07 by Matthew Pickering at 2021-05-22T00:07:42-04:00 hadrian: Add omit_pragmas transformer This transformer builds stage2 GHC with -fomit-interface-pragmas which can greatly reduce the amount of rebuilding but still allows most the tests to pass. - - - - - c6806912 by Matthew Pickering at 2021-05-22T00:08:18-04:00 Remove ANN pragmas in check-ppr and check-exact This fixes the `devel2+werror` build combo as stage1 does not have TH enabled. ``` utils/check-exact/Preprocess.hs:51:1: error: [-Werror] Ignoring ANN annotations, because this is a stage-1 compiler without -fexternal-interpreter or doesn't support GHCi | 51 | {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ``` - - - - - e2d4f241 by PHO at 2021-05-22T00:08:55-04:00 Support NetBSD/aarch64 via LLVM codegen Only adding "aarch64-unknown-netbsd" to gen-data-layout.sh was sufficient to get it working. No other changes were strictly required. - - - - - ef4d2999 by nineonine at 2021-05-22T00:09:32-04:00 Add regression test for #19287 - - - - - 0b1eed74 by Shayne Fletcher at 2021-05-23T08:02:58+10:00 Change representation of field selector occurences - Change the names of the fields in in `data FieldOcc` - Renames `HsRecFld` to `HsRecSel` - Replace `AmbiguousFieldOcc p` in `HsRecSel` with `FieldOcc p` - Contains a haddock submodule update The primary motivation of this change is to remove `AmbiguousFieldOcc`. This is one of a suite of changes improving how record syntax (most notably record update syntax) is represented in the AST. - - - - - 406cd90b by Alan Zimmerman at 2021-05-23T02:07:36-04:00 EPA: AnnAt missing for type application in patterns Ensure that the exact print annotations accurately record the `@` for code like tyApp :: Con k a -> Proxy a tyApp (Con @kx @ax (x :: Proxy ax)) = x :: Proxy (ax :: kx) Closes #19850 - - - - - 82c6a939 by Vladislav Zavialov at 2021-05-23T18:53:13-04:00 Pre-add test case for #19156 - - - - - d82d3823 by Vladislav Zavialov at 2021-05-23T18:53:13-04:00 Introduce Strict.Maybe, Strict.Pair (#19156) This patch fixes a space leak related to the use of Maybe in RealSrcSpan by introducing a strict variant of Maybe. In addition to that, it also introduces a strict pair and uses the newly introduced strict data types in a few other places (e.g. the lexer/parser state) to reduce allocations. Includes a regression test. - - - - - f8c6fce4 by Vladislav Zavialov at 2021-05-23T18:53:50-04:00 HsToken for HsPar, ParPat, HsCmdPar (#19523) This patch is a first step towards a simpler design for exact printing. - - - - - fc23ae89 by nineonine at 2021-05-24T00:14:53-04:00 Add regression test for #9985 - - - - - 3e4ef4b2 by Sylvain Henry at 2021-05-24T00:15:33-04:00 Move warning flag handling into Flags module I need this to make the Logger independent of DynFlags. Also fix copy-paste errors: Opt_WarnNonCanonicalMonadInstances was associated to "noncanonical-monadfail-instances" (MonadFailInstances vs MonadInstances). In the process I've also made the default name for each flag more explicit. - - - - - 098c7794 by Matthew Pickering at 2021-05-24T09:47:52-04:00 check-{ppr/exact}: Rewrite more directly to just parse files There was quite a large amount of indirection in these tests, so I have rewritten them to just directly parse the files rather than making a module graph and entering other twisty packages. - - - - - a3665a7a by Matthew Pickering at 2021-05-24T09:48:27-04:00 docs: Fix example in toIntegralSized Thanks to Mathnerd3141 for the fixed example. Fixes #19880 - - - - - f243acf4 by Divam at 2021-05-25T05:50:51-04:00 Refactor driver code; de-duplicate and split APIs (#14095, !5555) This commit does some de-duplication of logic between the one-shot and --make modes, and splitting of some of the APIs so that its easier to do the fine-grained parallelism implementation. This is the first part of the implementation plan as described in #14095 * compileOne now uses the runPhase pipeline for most of the work. The Interpreter backend handling has been moved to the runPhase. * hscIncrementalCompile has been broken down into multiple APIs. * haddock submodule bump: Rename of variables in html-test ref: This is caused by a change in ModDetails in case of NoBackend. Now the initModDetails is used to recreate the ModDetails from interface and in-memory ModDetails is not used. - - - - - 6ce8e687 by Zubin Duggal at 2021-05-25T05:51:26-04:00 Make tcIfaceCompleteMatch lazier. Insufficient lazyness causes a loop while typechecking COMPLETE pragmas from interfaces (#19744). - - - - - 8f22af8c by Moritz Angermann at 2021-05-25T05:52:02-04:00 [ci] darwin uses hadrian Make is bad, and really slow, and we should just stop using it outright, or kill hadrian. Let's rather go for hadrian all the way and phase out make. - - - - - 4d100f68 by Moritz Angermann at 2021-05-25T05:52:02-04:00 [ci] no more brew or pip We pull dependencies (reliably) via nix, and open up nix where needed. - - - - - c67c9e82 by Moritz Angermann at 2021-05-25T05:52:02-04:00 [bindist] inject xattr -c -r . into the darwin install phase This is so awful, but at least it might get the job done. - - - - - 544414ba by Moritz Angermann at 2021-05-25T05:52:02-04:00 [ci/darwin] use system provided iconv and curses Also make sure to be able to build with non-apple-clang, while using apple's SDK on macOS - - - - - 527543fc by Moritz Angermann at 2021-05-25T05:52:02-04:00 [ci/darwin] cabal-cache dir can be specified per arch Also while we are at it, run shellcheck on ci.sh - - - - - 7b1eeabf by Moritz Angermann at 2021-05-25T05:52:02-04:00 [ci/darwin] set SH to /bin/bash This should prevent some other `bash` to leak into the binary distributions. - - - - - f101e019 by Moritz Angermann at 2021-05-25T05:52:02-04:00 [hadrian] Do not add full tool paths This prohuibits CC=clang to work generically and will always bake in the clang that is found on the build machine in PATH, what ever clang that might be. It might not even be on the final host. - - - - - c4b4b1d7 by Moritz Angermann at 2021-05-25T05:52:02-04:00 [ci] faster pipeline - - - - - 50c3061d by Moritz Angermann at 2021-05-25T05:52:02-04:00 [hadrian] Properly build hsc2hs wrapper - - - - - 11bdf3cd by Matthew Pickering at 2021-05-25T05:52:02-04:00 Revert "hadrian: Don't always links against libffi" This reverts commit 673ff667c98eafc89e6746d1ac69d33b8330d755. - - - - - 2023b344 by Richard Eisenberg at 2021-05-25T09:08:36-04:00 Add 9.2 release note about linear case This is part of #18738 [skip ci] - - - - - cdbce8fc by Alfredo Di Napoli at 2021-05-26T16:03:15-04:00 Support new parser types in GHC This commit converts the lexers and all the parser machinery to use the new parser types and diagnostics infrastructure. Furthermore, it cleans up the way the parser code was emitting hints. As a result of this systematic approach, the test output of the `InfixAppPatErr` and `T984` tests have been changed. Previously they would emit a `SuggestMissingDo` hint, but this was not at all helpful in resolving the error, and it was even confusing by just looking at the original program that triggered the errors. Update haddock submodule - - - - - 9faafb0a by Pepe Iborra at 2021-05-26T16:03:52-04:00 Avoid fingerprinting the absolute path to the source file This change aims to make source files relocatable w.r.t. to the interface files produced by the compiler. This is so that we can download interface files produced by a cloud build system and then reuse them in a local ghcide session catch another case of implicit includes actually use the implicit quote includes add another missing case recomp020 test that .hi files are reused even if .hs files are moved to a new location Added recomp021 to record behaviour with non implicit includes add a note additional pointer to the note Mention #16956 in Note - - - - - 03d69e4b by Andreas Klebinger at 2021-05-27T02:35:11-04:00 Enable strict dicts by default at -O2. In the common case this is a straight performance win at a compile time cost so we enable it at -O2. In rare cases it can lead to compile time regressions because of changed inlining behaviour. Which can very rarely also affect runtime performance. Increasing the inlining threshold can help to avoid this which is documented in the user guide. In terms of measured results this reduced instructions executed for nofib by 1%. However for some cases (e.g. Cabal) enabling this by default increases compile time by 2-3% so we enable it only at -O2 where it's clear that a user is willing to trade compile time for runtime. Most of the testsuite runs without -O2 so there are few perf changes. Increases: T12545/T18698: We perform more WW work because dicts are now treated strict. T9198: Also some more work because functions are now subject to W/W Decreases: T14697: Compiling empty modules. Probably because of changes inside ghc. T9203: I can't reproduce this improvement locally. Might be spurious. ------------------------- Metric Decrease: T12227 T14697 T9203 Metric Increase: T9198 T12545 T18698a T18698b ------------------------- - - - - - 9935e99c by Shayne Fletcher at 2021-05-27T02:35:47-04:00 Change representation of HsGetField and HsProjection Another change in a series improving record syntax in the AST. The key change in this commit is the renaming of `HsFieldLabel` to `DotFieldOcc`. - - - - - ce1b8f42 by Andreas Klebinger at 2021-05-27T02:36:23-04:00 Improve deriveConstants error message. This fixes #19823 - - - - - 6de8ac89 by Alan Zimmerman at 2021-05-27T19:25:24+01:00 [EPA] exact print linear arrows. Closes #19903 Note: the normal ppr does not reproduce unicode linear arrows, so that part of the normal printing test is ommented out in the Makefile for this test. See #18846 - - - - - f74204c4 by Boris Lykah at 2021-05-28T15:32:01-04:00 Document release when TypeApplications allowed declaring variables as inferred - - - - - df997fac by Sylvain Henry at 2021-05-28T15:32:44-04:00 Use quotRemWord in showWord Using the following high-quality benchmark (with -O2): main :: IO () main = do let go 0 = "" go n@(W# n#) = showWord n# (go (n -1)) print $ length (go 10000000) I get the following performance results: - remWord+quotRem: 0,76s user 0,00s system 99% cpu 0,762 total - quotRemWord: 0,45s user 0,01s system 99% cpu 0,456 total Note that showSignedInt already uses quotRemInt. - - - - - 5ae070f1 by Thomas Winant at 2021-05-29T05:04:00-04:00 Add -Wmissing-exported-pattern-synonym-signatures After !4741, it was no longer possible to silence a warning about a missing pattern synonym signature if the `-Wmissing-signatures` flag was on. Restore the previous semantics while still adhering to the principle "enabling an additional warning flag should never make prior warnings disappear". For more symmetry and granularity, introduce `-Wmissing-exported-pattern-synonym-signatures`. See Note [Missing signatures] for an overview of all flags involved. - - - - - 28e0dca2 by Luite Stegeman at 2021-05-29T05:04:39-04:00 Work around LLVM backend overlapping register limitations The stg_ctoi_t and stg_ret_t procedures which convert unboxed tuples between the bytecode an native calling convention were causing a panic when using the LLVM backend. Fixes #19591 - - - - - 6412bf6e by parsonsmatt at 2021-05-29T05:05:18-04:00 Add `newDeclarationGroup` and provide documentation in reifyInstances and isInstance - - - - - 99b5cce9 by parsonsmatt at 2021-05-29T05:05:18-04:00 Address review comments, export from TH - - - - - 76902415 by parsonsmatt at 2021-05-29T05:05:18-04:00 Apply 2 suggestion(s) to 1 file(s) - - - - - 0c0e1855 by parsonsmatt at 2021-05-29T05:05:18-04:00 sigh - - - - - 10f48e22 by Matthew Pickering at 2021-05-29T05:05:55-04:00 ghci: Enable -fkeep-going by default This also demotes the error message about -fkeep-going to a trace message which matches the behaviour of other build systems (such as cabal-install and nix) which don't print any message like this on a failure. We want to remove the stable module check in a future patch, which is an approximation of `-fkeep-going`. At the moment this change shouldn't do very much. - - - - - 492b2dc5 by Zubin Duggal at 2021-05-29T05:06:32-04:00 Fix Note [Positioning of forkM] - - - - - 45387760 by Sylvain Henry at 2021-05-29T10:18:01-04:00 Bignum: match on DataCon workers in rules (#19892) We need to match on DataCon workers for the rules to be triggered. T13701 ghc/alloc decreases by ~2.5% on some archs Metric Decrease: T13701 - - - - - 0f8872ec by Sylvain Henry at 2021-05-29T10:18:01-04:00 Fix and slight improvement to datacon worker/wrapper notes - - - - - 6db8a0f7 by Richard Eisenberg at 2021-05-29T10:18:37-04:00 Rip GHC.Tc.Solver.Monad asunder (only) This creates new modules GHC.Tc.Solver.InertSet and GHC.Tc.Solver.Types. The Monad module is still pretty big, but this is an improvement. Moreover, it means that GHC.HsToCore.Pmc.Solver.Types no longer depends on the constraint solver (it now depends on GHC.Tc.Solver.InertSet), making the error-messages work easier. This patch thus contributes to #18516. - - - - - 42c611cf by Ben Gamari at 2021-05-29T11:57:51-04:00 Split GHC.Utils.Monad.State into .Strict and .Lazy - - - - - ec646247 by Ben Gamari at 2021-05-29T11:58:45-04:00 Use GHC's State monad consistently GHC's internal State monad benefits from oneShot annotations on its state, allowing for more aggressive eta expansion. We currently don't have monad transformers with the same optimisation, so we only change uses of the pure State monad here. See #19657 and 19380. Metric Decrease: hie002 - - - - - 21bdd9b7 by Ben Gamari at 2021-05-29T11:58:52-04:00 StgM: Use ReaderT rather than StateT - - - - - 6b6c4b9a by Viktor Dukhovni at 2021-06-02T04:38:47-04:00 Improve wording of fold[lr]M documentation. The sequencing of monadic effects in foldlM and foldrM was described as respectively right-associative and left-associative, but this could be confusing, as in essence we're just composing Kleisli arrows, whose composition is simply associative. What matters therefore is the order of sequencing of effects, which can be described more clearly without dragging in associativity as such. This avoids describing these folds as being both left-to-right and right-to-left depending on whether we're tracking effects or operator application. The new text should be easier to understand. - - - - - fcd124d5 by Roland Senn at 2021-06-02T04:39:23-04:00 Allow primops in a :print (and friends) command. Fix #19394 * For primops from `GHC.Prim` lookup the HValues in `GHC.PrimopWrappers`. * Add short error messages if a user tries to use a *Non-Id* value or a `pseudoop` in a `:print`, `:sprint` or `force`command. * Add additional test cases for `Magic Ids`. - - - - - adddf248 by Zubin Duggal at 2021-06-02T04:39:58-04:00 Fail before checking instances in checkHsigIface if exports don't match (#19244) - - - - - c5a9e32e by Divam at 2021-06-02T04:40:34-04:00 Specify the reason for import for the backpack's extra imports - - - - - 7d8e1549 by Vladislav Zavialov at 2021-06-02T04:41:08-04:00 Disallow linear arrows in GADT records (#19928) Before this patch, GHC used to silently accept programs such as the following: data R where D1 :: { d1 :: Int } %1 -> R The %1 annotation was completely ignored. Now it is a proper error. One remaining issue is that in the error message (⊸) turns into (%1 ->). This is to be corrected with upcoming exactprint updates. - - - - - 437a6ccd by Matthew Pickering at 2021-06-02T16:23:53-04:00 hadrian: Speed up lint:base rule The rule before decided to build the whole stage1 compiler, but this was unecessary as we were just missing one header file which can be generated directly by calling configure. Before: 18 minutes After: 54s - - - - - de33143c by Matthew Pickering at 2021-06-02T16:23:53-04:00 Run both lint jobs together - - - - - 852a12c8 by Matthew Pickering at 2021-06-02T16:23:53-04:00 CI: Don't explicitly build hadrian before using run_hadrian This causes hadrian to be built twice because the second time uses a different index state. - - - - - b66cf8ad by Matthew Pickering at 2021-06-02T16:24:27-04:00 Fix infinite looping in hptSomeModulesBelow When compiling Agda we entered into an infinite loop as the stopping condition was a bit wrong in hptSomeModulesBelow. The bad situation was something like * We would see module A (NotBoot) and follow it dependencies * Later on we would encounter A (Boot) and follow it's dependencies, because the lookup would not match A (NotBoot) and A (IsBoot) * Somewhere in A (Boot)s dependencies, A (Boot) would appear again and lead us into an infinite loop. Now the state marks whether we have been both variants (IsBoot and NotBoot) so we don't follow dependencies for A (Boot) many times. - - - - - b585aff0 by Sebastian Graf at 2021-06-02T23:06:18-04:00 WW: Mark absent errors as diverging again As the now historic part of `NOTE [aBSENT_ERROR_ID]` explains, we used to have `exprIsHNF` respond True to `absentError` and give it a non-bottoming demand signature, in order to perform case-to-let on certain `case`s we used to emit that scrutinised `absentError` (Urgh). What changed, why don't we emit these questionable absent errors anymore? The absent errors in question filled in for binders that would end up in strict fields after being seq'd. Apparently, the old strictness analyser would give these binders an absent demand, but today we give them head-strict demand `1A` and thus don't replace with absent errors at all. This fixes items (1) and (2) of #19853. - - - - - 79d12d34 by Shayne Fletcher at 2021-06-02T23:06:52-04:00 CountDeps: print graph of module dependencies in dot format The tests `CountParserDeps.hs` and `CountAstDeps.hs` are implemented by calling `CountDeps`. In this MR, `CountDeps.printDeps` is updated such tat by uncommenting a line, you can print a module's dependency graph showing what includes what. The output is in a format suitable for use with graphviz. - - - - - 25977ab5 by Matthew Pickering at 2021-06-03T08:46:47+01:00 Driver Rework Patch This patch comprises of four different but closely related ideas. The net result is fixing a large number of open issues with the driver whilst making it simpler to understand. 1. Use the hash of the source file to determine whether the source file has changed or not. This makes the recompilation checking more robust to modern build systems which are liable to copy files around changing their modification times. 2. Remove the concept of a "stable module", a stable module was one where the object file was older than the source file, and all transitive dependencies were also stable. Now we don't rely on the modification time of the source file, the notion of stability is moot. 3. Fix TH/plugin recompilation after the removal of stable modules. The TH recompilation check used to rely on stable modules. Now there is a uniform and simple way, we directly track the linkables which were loaded into the interpreter whilst compiling a module. This is an over-approximation but more robust wrt package dependencies changing. 4. Fix recompilation checking for dynamic object files. Now we actually check if the dynamic object file exists when compiling with -dynamic-too Fixes #19774 #19771 #19758 #17434 #11556 #9121 #8211 #16495 #7277 #16093 - - - - - d5b89ed4 by Alfredo Di Napoli at 2021-06-03T15:58:33-04:00 Port HsToCore messages to new infrastructure This commit converts a bunch of HsToCore (Ds) messages to use the new GHC's diagnostic message infrastructure. In particular the DsMessage type has been expanded with a lot of type constructors, each encapsulating a particular error and warning emitted during desugaring. Due to the fact that levity polymorphism checking can happen both at the Ds and at the TcRn level, a new `TcLevityCheckDsMessage` constructor has been added to the `TcRnMessage` type. - - - - - 7a05185a by Roland Senn at 2021-06-03T15:59:10-04:00 Follow up #12449: Improve function `Inspect.hs:check2` * Add a Note to clarify RttiTypes. * Don't call `quantifyType` at all the call sites of `check2`. * Simplyfy arguments of functions `Inspect.hs:check1` and `Inspect.hs:check2`. - `check1` only uses the two lists of type variables, but not the types. - `check2` only uses the two types, but not the lists of type variables. * In `Inspect.hs:check2` send only the tau part of the type to `tcSplitTyConApp_maybe`. - - - - - 1bb0565c by Thomas Winant at 2021-06-04T00:30:22-04:00 Fix incorrect mention of -Wprepositive-qualified-syntax in docs The flag is called `-Wprepositive-qualified-module`, not `-Wprepositive-qualified-syntax`. Use the `:ghc-flag:` syntax, which would have caught the mistake in the first place. - - - - - 44d131af by Takenobu Tani at 2021-06-04T00:30:59-04:00 users-guide: Add OverloadedRecordDot and OverloadedRecordUpdate for ghc-9.2 This patch adds OverloadedRecordDot and OverloadedRecordUpdate in 9.2.1's release note. - - - - - f1b748b4 by Alfredo Di Napoli at 2021-06-04T12:43:41-04:00 Add PsHeaderMessage diagnostic (fixes #19923) This commit replaces the PsUnknownMessage diagnostics over at `GHC.Parser.Header` with a new `PsHeaderMessage` type (part of the more general `PsMessage`), so that we can throw parser header's errors which can be correctly caught by `GHC.Driver.Pipeline.preprocess` and rewrapped (correctly) as Driver messages (using the `DriverPsHeaderMessage`). This gets rid of the nasty compiler crash as part of #19923. - - - - - 733757ad by sheaf at 2021-06-04T12:44:19-04:00 Make some simple primops levity-polymorphic Fixes #17817 - - - - - 737b0ae1 by Sylvain Henry at 2021-06-04T12:45:01-04:00 Fix Integral instances for Words * ensure that division wrappers are INLINE * make div/mod/divMod call quot/rem/quotRem (same code) * this ensures that the quotRemWordN# primitive is used to implement divMod (it wasn't the case for sized Words) * make first argument strict for Natural and Integer (similarly to other numeric types) - - - - - 1713cbb0 by Shayne Fletcher at 2021-06-05T03:47:48-04:00 Make 'count-deps' a ghc/util standalone program - Move 'count-deps' into 'ghc/utils' so that it can be called standalone. - Move 'testsuite/tests/parser/should_run/' tests 'CountParserDeps' and 'CountAstDeps' to 'testsuite/tests/count-deps' and reimplement in terms of calling the utility - Document how to use 'count-deps' in 'ghc/utils/count-deps/README' - - - - - 9a28680d by Sylvain Henry at 2021-06-05T03:48:25-04:00 Put Unique related global variables in the RTS (#19940) - - - - - 8c90e6c7 by Richard Eisenberg at 2021-06-05T10:29:22-04:00 Fix #19682 by breaking cycles in Deriveds This commit expands the old Note [Type variable cycles in Givens] to apply as well to Deriveds. See the Note for details and examples. This fixes a regression introduced by my earlier commit that killed off the flattener in favor of the rewriter. A few other things happened along the way: * unifyTest was renamed to touchabilityTest, because that's what it does. * isInsolubleOccursCheck was folded into checkTypeEq, which does much of the same work. To get this to work out, though, we need to keep more careful track of what errors we spot in checkTypeEq, and so CheckTyEqResult has become rather more glorious. * A redundant Note or two was eliminated. * Kill off occCheckForErrors; due to Note [Rewriting synonyms], the extra occCheckExpand here is always redundant. * Store blocked equalities separately from other inerts; less stuff to look through when kicking out. Close #19682. test case: typecheck/should_compile/T19682{,b} - - - - - 3b1aa7db by Moritz Angermann at 2021-06-05T10:29:57-04:00 Adds AArch64 Native Code Generator In which we add a new code generator to the Glasgow Haskell Compiler. This codegen supports ELF and Mach-O targets, thus covering Linux, macOS, and BSDs in principle. It was tested only on macOS and Linux. The NCG follows a similar structure as the other native code generators we already have, and should therfore be realtively easy to follow. It supports most of the features required for a proper native code generator, but does not claim to be perfect or fully optimised. There are still opportunities for optimisations. Metric Decrease: ManyAlternatives ManyConstructors MultiLayerModules PmSeriesG PmSeriesS PmSeriesT PmSeriesV T10421 T10421a T10858 T11195 T11276 T11303b T11374 T11822 T12227 T12545 T12707 T13035 T13253 T13253-spj T13379 T13701 T13719 T14683 T14697 T15164 T15630 T16577 T17096 T17516 T17836 T17836b T17977 T17977b T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T3064 T5030 T5321FD T5321Fun T5631 T5642 T5837 T783 T9198 T9233 T9630 T9872d T9961 WWRec Metric Increase: T4801 - - - - - db1e07f1 by Moritz Angermann at 2021-06-05T10:29:57-04:00 [ci] -llvm with --way=llvm - - - - - 1b2f894f by Moritz Angermann at 2021-06-05T10:29:57-04:00 [ci] no docs for aarch64-linux-llvm - - - - - a1fed3a5 by Moritz Angermann at 2021-06-05T10:29:57-04:00 [ci] force CC=clang for aarch64-linux - - - - - 4db2d44c by Moritz Angermann at 2021-06-05T10:29:57-04:00 [testsuite] fix T13702 with clang - - - - - ecc3a405 by Moritz Angermann at 2021-06-05T10:29:57-04:00 [testsuite] fix T6132 when using the LLVM toolchain - - - - - cced9454 by Shayne Fletcher at 2021-06-05T19:23:11-04:00 Countdeps: Strictly documentation markup fixes [ci skip] - - - - - ea9a4ef6 by Simon Peyton Jones at 2021-06-05T19:23:46-04:00 Avoid useless w/w split, take 2 This commit: commit c6faa42bfb954445c09c5680afd4fb875ef03758 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Mon Mar 9 10:20:42 2020 +0000 Avoid useless w/w split This patch is just a tidy-up for the post-strictness-analysis worker wrapper split. Consider f x = x Strictnesss analysis does not lead to a w/w split, so the obvious thing is to leave it 100% alone. But actually, because the RHS is small, we ended up adding a StableUnfolding for it. There is some reason to do this if we choose /not/ do to w/w on the grounds that the function is small. See Note [Don't w/w inline small non-loop-breaker things] But there is no reason if we would not have done w/w anyway. This patch just moves the conditional to later. Easy. turns out to have a bug in it. Instead of /moving/ the conditional, I /duplicated/ it. Then in a subsequent unrelated tidy-up (087ac4eb) I removed the second (redundant) test! This patch does what I originally intended. There is also a small refactoring in GHC.Core.Unfold, to make the code clearer, but with no change in behaviour. It does, however, have a generally good effect on compile times, because we aren't dealing with so many silly stable unfoldings. Here are the non-zero changes: Metrics: compile_time/bytes allocated ------------------------------------- Baseline Test Metric value New value Change --------------------------------------------------------------------------- ManyAlternatives(normal) ghc/alloc 791969344.0 792665048.0 +0.1% ManyConstructors(normal) ghc/alloc 4351126824.0 4358303528.0 +0.2% PmSeriesG(normal) ghc/alloc 50362552.0 50482208.0 +0.2% PmSeriesS(normal) ghc/alloc 63733024.0 63619912.0 -0.2% T10421(normal) ghc/alloc 121224624.0 119695448.0 -1.3% GOOD T10421a(normal) ghc/alloc 85256392.0 83714224.0 -1.8% T10547(normal) ghc/alloc 29253072.0 29258256.0 +0.0% T10858(normal) ghc/alloc 189343152.0 187972328.0 -0.7% T11195(normal) ghc/alloc 281208248.0 279727584.0 -0.5% T11276(normal) ghc/alloc 141966952.0 142046224.0 +0.1% T11303b(normal) ghc/alloc 46228360.0 46259024.0 +0.1% T11545(normal) ghc/alloc 2663128768.0 2667412656.0 +0.2% T11822(normal) ghc/alloc 138686944.0 138760176.0 +0.1% T12227(normal) ghc/alloc 482836000.0 475421056.0 -1.5% GOOD T12234(optasm) ghc/alloc 60710520.0 60781808.0 +0.1% T12425(optasm) ghc/alloc 104089000.0 104022424.0 -0.1% T12545(normal) ghc/alloc 1711759416.0 1705711528.0 -0.4% T12707(normal) ghc/alloc 991541120.0 991921776.0 +0.0% T13035(normal) ghc/alloc 108199872.0 108370704.0 +0.2% T13056(optasm) ghc/alloc 414642544.0 412580384.0 -0.5% T13253(normal) ghc/alloc 361701272.0 355838624.0 -1.6% T13253-spj(normal) ghc/alloc 157710168.0 157397768.0 -0.2% T13379(normal) ghc/alloc 370984400.0 371345888.0 +0.1% T13701(normal) ghc/alloc 2439764144.0 2441351984.0 +0.1% T14052(ghci) ghc/alloc 2154090896.0 2156671400.0 +0.1% T15164(normal) ghc/alloc 1478517688.0 1440317696.0 -2.6% GOOD T15630(normal) ghc/alloc 178053912.0 172489808.0 -3.1% T16577(normal) ghc/alloc 7859948896.0 7854524080.0 -0.1% T17516(normal) ghc/alloc 1271520128.0 1202096488.0 -5.5% GOOD T17836(normal) ghc/alloc 1123320632.0 1123922480.0 +0.1% T17836b(normal) ghc/alloc 54526280.0 54576776.0 +0.1% T17977b(normal) ghc/alloc 42706752.0 42730544.0 +0.1% T18140(normal) ghc/alloc 108834568.0 108693816.0 -0.1% T18223(normal) ghc/alloc 5539629264.0 5579500872.0 +0.7% T18304(normal) ghc/alloc 97589720.0 97196944.0 -0.4% T18478(normal) ghc/alloc 770755472.0 771232888.0 +0.1% T18698a(normal) ghc/alloc 408691160.0 374364992.0 -8.4% GOOD T18698b(normal) ghc/alloc 492419768.0 458809408.0 -6.8% GOOD T18923(normal) ghc/alloc 72177032.0 71368824.0 -1.1% T1969(normal) ghc/alloc 803523496.0 804655112.0 +0.1% T3064(normal) ghc/alloc 198411784.0 198608512.0 +0.1% T4801(normal) ghc/alloc 312416688.0 312874976.0 +0.1% T5321Fun(normal) ghc/alloc 325230680.0 325474448.0 +0.1% T5631(normal) ghc/alloc 592064448.0 593518968.0 +0.2% T5837(normal) ghc/alloc 37691496.0 37710904.0 +0.1% T783(normal) ghc/alloc 404629536.0 405064432.0 +0.1% T9020(optasm) ghc/alloc 266004608.0 266375592.0 +0.1% T9198(normal) ghc/alloc 49221336.0 49268648.0 +0.1% T9233(normal) ghc/alloc 913464984.0 742680256.0 -18.7% GOOD T9675(optasm) ghc/alloc 552296608.0 466322000.0 -15.6% GOOD T9872a(normal) ghc/alloc 1789910616.0 1793924472.0 +0.2% T9872b(normal) ghc/alloc 2315141376.0 2310338056.0 -0.2% T9872c(normal) ghc/alloc 1840422424.0 1841567224.0 +0.1% T9872d(normal) ghc/alloc 556713248.0 556838432.0 +0.0% T9961(normal) ghc/alloc 383809160.0 384601600.0 +0.2% WWRec(normal) ghc/alloc 773751272.0 753949608.0 -2.6% GOOD Residency goes down too: Metrics: compile_time/max_bytes_used ------------------------------------ Baseline Test Metric value New value Change ----------------------------------------------------------- T10370(optasm) ghc/max 42058448.0 39481672.0 -6.1% T11545(normal) ghc/max 43641392.0 43634752.0 -0.0% T15304(normal) ghc/max 29895824.0 29439032.0 -1.5% T15630(normal) ghc/max 8822568.0 8772328.0 -0.6% T18698a(normal) ghc/max 13882536.0 13787112.0 -0.7% T18698b(normal) ghc/max 14714112.0 13836408.0 -6.0% T1969(normal) ghc/max 24724128.0 24733496.0 +0.0% T3064(normal) ghc/max 14041152.0 14034768.0 -0.0% T3294(normal) ghc/max 32769248.0 32760312.0 -0.0% T9630(normal) ghc/max 41605120.0 41572184.0 -0.1% T9675(optasm) ghc/max 18652296.0 17253480.0 -7.5% Metric Decrease: T10421 T12227 T15164 T17516 T18698a T18698b T9233 T9675 WWRec Metric Increase: T12545 - - - - - 52a524f7 by Simon Peyton Jones at 2021-06-05T19:23:46-04:00 Re-do rubbish literals As #19882 pointed out, we were simply doing rubbish literals wrong. (I'll refrain from explaining the wrong-ness here -- see the ticket.) This patch fixes it by adding a Type (of kind RuntimeRep) as field of LitRubbish, rather than [PrimRep]. The Note [Rubbish literals] in GHC.Types.Literal explains the details. - - - - - 34424b9d by Simon Peyton Jones at 2021-06-05T19:23:46-04:00 Drop absent bindings in worker/wrapper Consider this (from #19824) let t = ...big... in ...(f t x)... were `f` ignores its first argument. With luck f's wrapper will inline thereby dropping `t`, but maybe not: the arguments to f all look boring. So we pre-empt the problem by replacing t's RHS with an absent filler during w/w. Simple and effective. The main payload is the new `isAbsDmd` case in `tryWw`, but there are some other minor refactorings: * To implment this I had to refactor `mk_absent_let` to `mkAbsentFiller`, which can be called from `tryWW`. * wwExpr took both WwOpts and DynFlags which seems silly. I combined them into one. * I renamed the historical mkInineRule to mkWrapperUnfolding - - - - - 3e343292 by Ben Gamari at 2021-06-05T19:23:46-04:00 testsuite: Eliminate fragility of ioprof As noted in #10037, the `ioprof` test would change its stderr output (specifically the stacktrace produced by `error`) depending upon optimisation level. As the `error` backtrace is not the point of this test, we now ignore the `stderr` output. - - - - - 5e1a2244 by Ben Gamari at 2021-06-05T19:23:46-04:00 testsuite: Fix Note style - - - - - 4dc681c7 by Sylvain Henry at 2021-06-07T10:35:39+02:00 Make Logger independent of DynFlags Introduce LogFlags as a independent subset of DynFlags used for logging. As a consequence in many places we don't have to pass both Logger and DynFlags anymore. The main reason for this refactoring is that I want to refactor the systools interfaces: for now many systools functions use DynFlags both to use the Logger and to fetch their parameters (e.g. ldInputs for the linker). I'm interested in refactoring the way they fetch their parameters (i.e. use dedicated XxxOpts data types instead of DynFlags) for #19877. But if I did this refactoring before refactoring the Logger, we would have duplicate parameters (e.g. ldInputs from DynFlags and linkerInputs from LinkerOpts). Hence this patch first. Some flags don't really belong to LogFlags because they are subsystem specific (e.g. most DumpFlags). For example -ddump-asm should better be passed in NCGConfig somehow. This patch doesn't fix this tight coupling: the dump flags are part of the UI but they are passed all the way down for example to infer the file name for the dumps. Because LogFlags are a subset of the DynFlags, we must update the former when the latter changes (not so often). As a consequence we now use accessors to read/write DynFlags in HscEnv instead of using `hsc_dflags` directly. In the process I've also made some subsystems less dependent on DynFlags: - CmmToAsm: by passing some missing flags via NCGConfig (see new fields in GHC.CmmToAsm.Config) - Core.Opt.*: - by passing -dinline-check value into UnfoldingOpts - by fixing some Core passes interfaces (e.g. CallArity, FloatIn) that took DynFlags argument for no good reason. - as a side-effect GHC.Core.Opt.Pipeline.doCorePass is much less convoluted. - - - - - 3a90814f by Sylvain Henry at 2021-06-07T11:19:35+02:00 Parser: make less DynFlags dependent This is an attempt at reducing the number of dependencies of the Parser (as reported by CountParserDeps). Modules in GHC.Parser.* don't import GHC.Driver.Session directly anymore. Sadly some GHC.Driver.* modules are still transitively imported and the number of dependencies didn't decrease. But it's a step in the right direction. - - - - - 40c0f67f by Sylvain Henry at 2021-06-07T11:19:35+02:00 Bump haddock submodule - - - - - 9e724f6e by Viktor Dukhovni at 2021-06-07T15:35:22-04:00 Small ZipList optimisation In (<|>) for ZipList, avoid processing the first argument twice (both as first argument of (++) and for its length in drop count of the second argument). Previously, the entire first argument was forced into memory, now (<|>) can run in constant space even with long inputs. - - - - - 7ea3b7eb by Ryan Scott at 2021-06-08T01:07:10+05:30 Introduce `hsExprType :: HsExpr GhcTc -> Type` in the new module `GHC.Hs.Syn.Type` The existing `hsPatType`, `hsLPatType` and `hsLitType` functions have also been moved to this module This is a less ambitious take on the same problem that !2182 and !3866 attempt to solve. Rather than have the `hsExprType` function attempt to efficiently compute the `Type` of every subexpression in an `HsExpr`, this simply computes the overall `Type` of a single `HsExpr`. - Explicitly forbids the `SplicePat` `HsIPVar`, `HsBracket`, `HsRnBracketOut` and `HsTcBracketOut` constructors during the typechecking phase by using `Void` as the TTG extension field - Also introduces `dataConCantHappen` as a domain specific alternative to `absurd` to handle cases where the TTG extension points forbid a constructor. - Turns HIE file generation into a pure function that doesn't need access to the `DsM` monad to compute types, but uses `hsExprType` instead. - Computes a few more types during HIE file generation - Makes GHCi's `:set +c` command also use `hsExprType` instead of going through the desugarer to compute types. Updates haddock submodule Co-authored-by: Zubin Duggal <zubin.duggal at gmail.com> - - - - - 378c0bba by Tamar Christina at 2021-06-08T15:40:50-04:00 winio: use synchronous access explicitly for handles that may not be asynchronous. - - - - - 31bfafec by Baldur Blöndal at 2021-06-09T09:46:17-04:00 Added a regression test, this would trigger a Core Lint error before GHC 9 - - - - - d69067a1 by Matthew Pickering at 2021-06-09T09:46:51-04:00 FinderCache: Also cache file hashing in interface file checks Now that we hash object files to decide when to recompile due to TH, this can make a big difference as each interface file in a project will contain reference to the object files of all package dependencies. Especially when these are statically linked, hashing them can add up. The cache is invalidated when `depanalPartial` is called, like the normal finder cache. - - - - - f4a5e30e by Simon Peyton Jones at 2021-06-10T02:38:19-04:00 Do not add unfoldings to lambda-binders For reasons described in GHC.Core.Opt.Simplify Historical Note [Case binders and join points], we used to keep a Core unfolding in one of the lambda-binders for a join point. But this was always a gross hack -- it's very odd to have an unfolding in a lambda binder, that refers to earlier lambda binders. The hack bit us in various ways: * Most seriously, it is incompatible with linear types in Core. * It complicated demand analysis, and could worsen results * It required extra care in the simplifier (simplLamBinder) * It complicated !5641 (look for "join binder unfoldings") So this patch just removes the hack. Happily, doind so turned out to have no effect on performance. - - - - - 8baa8874 by Li-yao Xia at 2021-06-10T02:38:54-04:00 User's Guide: reword and fix punctuation in description of PostfixOperators - - - - - fb6b6379 by Matthew Pickering at 2021-06-10T02:39:29-04:00 Add (broken) test for #19966 - - - - - 61c51c00 by Sylvain Henry at 2021-06-10T02:40:07-04:00 Fix redundant import - - - - - 472c2bf0 by sheaf at 2021-06-10T13:54:05-04:00 Reword: representation instead of levity fixes #19756, updates haddock submodule - - - - - 3d5cb335 by Simon Peyton Jones at 2021-06-10T13:54:40-04:00 Fix INLINE pragmas in desugarer In #19969 we discovered that GHC has has a bug *forever* that means it sometimes essentially discarded INLINE pragams. This happened when you have * Two more more mutually recursive functions * Some of which (presumably not all!) have an INLINE pragma * Completely monomorphic. This hits a particular case in GHC.HsToCore.Binds.dsAbsBinds, which was simply wrong -- it put the INLINE pragma on the wrong binder. This patch fixes the bug, rather easily, by adjusting the no-tyvar, no-dict case of GHC.HsToCore.Binds.dsAbsBinds. I also discovered that the GHC.Core.Opt.Pipeline.shortOutIndirections was not doing a good job for {-# INLINE lcl_id #-} lcl_id = BIG gbl_id = lcl_id Here we want to transfer the stable unfolding to gbl_id (we do), but we also want to remove it from lcl_id (we were not doing that). Otherwise both Ids have large stable unfoldings. Easily fixed. Note [Transferring IdInfo] explains. - - - - - 2a7e29e5 by Ben Gamari at 2021-06-16T16:58:37+00:00 gitlab-ci: Bump ci-images - - - - - 6c131ba0 by Baldur Blöndal at 2021-06-16T20:18:35-04:00 DerivingVia for Hsc instances. GND for NonDetFastString and LexicalFastString. - - - - - a2e4cb80 by Vladislav Zavialov at 2021-06-16T20:19:10-04:00 HsUniToken and HsToken for HsArrow (#19623) Another step towards a simpler design for exact printing. Updates the haddock submodule. - - - - - 01fd2617 by Matthew Pickering at 2021-06-16T20:19:45-04:00 profiling: Look in RHS of rules for cost centre ticks There are some obscure situations where the RHS of a rule can contain a tick which is not mentioned anywhere else in the program. If this happens you end up with an obscure linker error. The solution is quite simple, traverse the RHS of rules to also look for ticks. It turned out to be easier to implement if the traversal was moved into CoreTidy rather than at the start of code generation because there we still had easy access to the rules. ./StreamD.o(.text+0x1b9f2): error: undefined reference to 'StreamK_mkStreamFromStream_HPC_cc' ./MArray.o(.text+0xbe83): error: undefined reference to 'StreamK_mkStreamFromStream_HPC_cc' Main.o(.text+0x6fdb): error: undefined reference to 'StreamK_mkStreamFromStream_HPC_cc' - - - - - d8bfebec by AriFordsham at 2021-06-16T20:20:22-04:00 Corrected typo - - - - - 34484c89 by Divam at 2021-06-16T20:20:59-04:00 Remove the backend correction logic, as it is already been fixed at this point - - - - - e25772a0 by Peter Trommler at 2021-06-16T20:21:34-04:00 PPC NCG: Fix panic in linear register allocator - - - - - a83d2999 by Krzysztof Gogolewski at 2021-06-16T20:22:09-04:00 Fix error message for record updates, #19972 Fix found by Adam Gundry. - - - - - a0622459 by Matthew Pickering at 2021-06-17T11:55:17+01:00 Move validate-x86_64-linux-deb9-hadrian back to quick-build This increases the critical path length but in practice will reduce pressure on runners because less jobs overall will be spawned. See #20003 [skip ci] - - - - - 3b783496 by Simon Peyton Jones at 2021-06-18T12:27:33-04:00 Enhance cast worker/wrapper for INLINABLE In #19890 we realised that cast worker/wrapper didn't really work properly for functions with an INLINABLE pragma, and hence a stable unfolding. This patch fixes the problem. Instead of disabling cast w/w when there is a stable unfolding (as we did before), we now tranfer the stable unfolding to the worker. It turned out that it was easier to do that if I moved the cast w/w stuff from prepareBinding to completeBind. No chnages at all in nofib results: -------------------------------------------------------------------------------- Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- Min -0.0% 0.0% -63.8% -78.2% 0.0% Max -0.0% 0.0% +11.8% +11.7% 0.0% Geometric Mean -0.0% -0.0% -26.6% -33.4% -0.0% Small decreases in compile-time allocation for two tests (below) of around 2%. T12545 increased in compile-time alloc by 4%, but it's not reproducible on my machine, and is a known-wobbly test. Metric Increase: T12545 Metric Decrease: T18698a T18698b - - - - - c6a00c15 by Simon Peyton Jones at 2021-06-18T12:27:33-04:00 Improve abstractVars quantification ordering When floating a binding out past some type-variable binders, don't gratuitiously change the order of the binders. This small change gives code that is simpler, has less risk of non-determinism, and does not gratuitiously change type-variable order. See Note [Which type variables to abstract over] in GHC.Core.Opt.Simplify.Utils. This is really just refactoring; no change in behaviour. - - - - - db7e6dc5 by Simon Peyton Jones at 2021-06-18T12:27:33-04:00 Improve pretty-printing of coercions With -dsuppress-coercions, it's still good to be able to see the type of the coercion. This patch prints the type. Maybe we should have a flag to control this too. - - - - - 5d3d9925 by Gleb Popov at 2021-06-18T12:27:36-04:00 Pass -DLIBICONV_PLUG when building base library on FreeBSD. If libiconv is installed from packages on the build machine, there is a high chance that the build system will pick up /usr/local/include/iconv.h instead of base /usr/include/iconv.h This additional preprocessor define makes package's libiconv header compatible with system one, fixing the build. Closes issue #19958 - - - - - 1e2ba8a4 by Matthew Pickering at 2021-06-19T12:22:27-04:00 CI: Keep the value of PERF_NOTE_KEY in darwin environments This fixes the performance test tracking for all darwin environments. - - - - - 028b9474 by Simon Peyton Jones at 2021-06-19T12:23:02-04:00 Add comments explaining why #19833 is wrong I realised that the suggestion in #19833 doesn't work, and documented why in Note [Zapping Used Once info in WorkWrap] - - - - - 6b2952cf by Sylvain Henry at 2021-06-19T12:23:39-04:00 RTS: fix indentation warning - - - - - a6548a66 by David at 2021-06-19T12:24:15-04:00 Correct haddock annotations in GetOpt - - - - - 23bb09c9 by Sylvain Henry at 2021-06-19T12:24:52-04:00 Perf: fix appendFS To append 2 FastString we don't need to convert them into ByteString: use ShortByteString's Semigroup instance instead. - - - - - 1c79ddc8 by Matthew Pickering at 2021-06-19T12:25:26-04:00 RTS: Fix flag parsing for --eventlog-flush-interval Fixes #20006 - - - - - fc8ad5f3 by Simon Peyton Jones at 2021-06-19T12:26:01-04:00 Fix type and strictness signature of fork# When working eta-expansion and reduction, I found that fork# had a weaker strictness signature than it should have (#19992). In particular, it didn't record that it applies its argument exactly once. To this I needed to give it a proper type (its first argument is always a function, which in turn entailed a small change to the call in GHC.Conc.Sync This patch fixes it. - - - - - 217b4dcc by Krzysztof Gogolewski at 2021-06-19T12:26:35-04:00 Deprecate -Wmissing-monadfail-instances (#17875) Also document deprecation of Wnoncanonical-monadfail-instances and -Wimplicit-kind-vars - - - - - 8838241f by Sylvain Henry at 2021-06-19T12:27:12-04:00 Fix naturalToFloat/Double * move naturalToFloat/Double from ghc-bignum to base:GHC.Float and make them wired-in (as their integerToFloat/Double counterparts) * use the same rounding method as integerToFloat/Double. This is an oversight of 540fa6b2cff3802877ff56a47ab3611e33a9ac86 * add passthrough rules for intToFloat, intToDouble, wordToFloat, wordToDouble. - - - - - 3f60a7e5 by Vladislav Zavialov at 2021-06-19T22:58:33-04:00 Do not reassociate lexical negation (#19838) - - - - - 4c87a3d1 by Ryan Scott at 2021-06-19T22:59:08-04:00 Simplify pprLHsContext This removes an _ad hoc_ special case for empty `LHsContext`s in `pprLHsContext`, fixing #20011. To avoid regressions in pretty-printing data types and classes constructed via TH, we now apply a heuristic where we convert empty datatype contexts and superclasses to a `Nothing` (rather than `Just` an empty context). This will, for instance, avoid pretty-printing every TH-constructed data type as `data () => Blah ...`. - - - - - a6a8d3f5 by Moritz Angermann at 2021-06-20T07:11:58-04:00 Guard Allocate Exec via LIBFFI by LIBFFI We now have two darwin flavours. AArch64-Darwin, and x86_64-darwin, the latter one which has proper custom adjustor support, the former though relies on libffi. Mixing both leads to odd crashes, as the closures might not fit the size of the libffi closures. Hence this needs to be guarded by the USE_LBFFI_FOR_ADJUSTORS guard. Original patch by Hamish Mackenzie - - - - - 689016dc by Matthew Pickering at 2021-06-20T07:12:32-04:00 Darwin CI: Don't explicitly pass ncurses/iconv paths Passing --with-ncurses-libraries means the path which gets backed in progagate into the built binaries. This is incorrect when we want to distribute the binaries because the user might not have the library in that specific place. It's the user's reponsibility to direct the dynamic linker to the right place. Fixes #19968 - - - - - 4a65c0f8 by Matthew Pickering at 2021-06-20T07:12:32-04:00 rts: Pass -Wl,_U,___darwin_check_fd_set_overflow on Darwin Note [fd_set_overflow] ~~~~~~~~~~~~~~~~~~~~~~ In this note is the very sad tale of __darwin_fd_set_overflow. The 8.10.5 release was broken because it was built in an environment where the libraries were provided by XCode 12.*, these libraries introduced a reference to __darwin_fd_set_overflow via the FD_SET macro which is used in Select.c. Unfortunately, this symbol is not available with XCode 11.* which led to a linker error when trying to link anything. This is almost certainly a bug in XCode but we still have to work around it. Undefined symbols for architecture x86_64: "___darwin_check_fd_set_overflow", referenced from: _awaitEvent in libHSrts.a(Select.o) ld: symbol(s) not found for architecture x86_64 One way to fix this is to upgrade your version of xcode, but this would force the upgrade on users prematurely. Fortunately it also seems safe to pass the linker option "-Wl,-U,___darwin_check_fd_set_overflow" because the usage of the symbol is guarded by a guard to check if it's defined. __header_always_inline int __darwin_check_fd_set(int _a, const void *_b) { if ((uintptr_t)&__darwin_check_fd_set_overflow != (uintptr_t) 0) { return __darwin_check_fd_set_overflow(_a, _b, 1); return __darwin_check_fd_set_overflow(_a, _b, 0); } else { return 1; } Across the internet there are many other reports of this issue See: https://github.com/mono/mono/issues/19393 , https://github.com/sitsofe/fio/commit/b6a1e63a1ff607692a3caf3c2db2c3d575ba2320 The issue was originally reported in #19950 Fixes #19950 - - - - - 6c783817 by Zubin Duggal at 2021-06-20T07:13:07-04:00 Set min LLVM version to 9 and make version checking use a non-inclusive upper bound. We use a non-inclusive upper bound so that setting the upper bound to 13 for example means that all 12.x versions are accepted. - - - - - 6281a333 by Matthew Pickering at 2021-06-20T07:13:41-04:00 Linker/darwin: Properly honour -fno-use-rpaths The specification is now simple * On linux, use `-Xlinker -rpath -Xlinker` to set the rpath of the executable * On darwin, never use `-Xlinker -rpath -Xlinker`, always inject the rpath afterwards, see `runInjectRPaths`. * If `-fno-use-rpaths` is passed then *never* inject anything into the rpath. Fixes #20004 - - - - - 5abf5997 by Fraser Tweedale at 2021-06-20T07:14:18-04:00 hadrian/README.md: update bignum options - - - - - 65bad0de by Matthew Pickering at 2021-06-22T02:33:00-04:00 CI: Don't set EXTRA_HC_OPTS in head.hackage job Upstream environment variables take precedance over downstream variables. It is more consistent (and easier to modify) if the variables are all set in the head.hackage CI file rather than setting this here. [skip ci] - - - - - 14956cb8 by Sylvain Henry at 2021-06-22T02:33:38-04:00 Put tracing functions into their own module Now that Outputable is independent of DynFlags, we can put tracing functions using SDocs into their own module that doesn't transitively depend on any GHC.Driver.* module. A few modules needed to be moved to avoid loops in DEBUG mode. - - - - - 595dfbb0 by Matthew Pickering at 2021-06-22T02:34:13-04:00 rts: Document --eventlog-flush-interval in RtsFlags Fixes #19995 - - - - - 362f078e by Krzysztof Gogolewski at 2021-06-22T02:34:49-04:00 Typos, minor comment fixes - Remove fstName, sndName, fstIdKey, sndIdKey - no longer used, removed from basicKnownKeyNames - Remove breakpointId, breakpointCondId, opaqueTyCon, unknownTyCon - they were used in the old implementation of the GHCi debugger - Fix typos in comments - Remove outdated comment in Lint.hs - Use 'LitRubbish' instead of 'RubbishLit' for consistency - Remove comment about subkinding - superseded by Note [Kind Constraint and kind Type] - Mention ticket ID in a linear types error message - Fix formatting in using-warnings.rst and linear-types.rst - Remove comment about 'Any' in Dynamic.hs - Dynamic now uses Typeable + existential instead of Any - Remove codeGen/should_compile/T13233.hs This was added by accident, it is not used and T13233 is already in should_fail - - - - - f7e41d78 by Matthew Pickering at 2021-06-22T02:35:24-04:00 ghc-bignum: trimed ~> trimmed Just a small typo which propagated through ghc-bignum - - - - - 62d720db by Potato Hatsue at 2021-06-22T02:36:00-04:00 Fix a typo in pattern synonyms doc - - - - - 87f57ecf by Adam Sandberg Ericsson at 2021-06-23T02:58:00-04:00 ci: fix ci.sh by creating build.mk in one place Previously `prepare_build_mk` created a build.mk that was overwritten right after. This makes the BIGNUM_BACKEND choice take effect, fixing #19953, and causing the metric increase below in the integer-simple job. Metric Increase: space_leak_001 - - - - - 7f6454fb by Matthew Pickering at 2021-06-23T02:58:35-04:00 Optimiser: Correctly deal with strings starting with unicode characters in exprConApp_maybe For example: "\0" is encoded to "C0 80", then the rule would correct use a decoding function to work out the first character was "C0 80" but then just used BS.tail so the rest of the string was "80". This resulted in "\0" being transformed into '\C0\80' : unpackCStringUTF8# "80" Which is obviously bogus. I rewrote the function to call utf8UnconsByteString directly and avoid the roundtrip through Faststring so now the head/tail is computed by the same call. Fixes #19976 - - - - - e14b893a by Matthew Pickering at 2021-06-23T02:59:09-04:00 testsuite: Don't try to run tests with missing libraries As noticed by sgraf, we were still running reqlib tests, even if the library was not available. The reasons for this were not clear to me as they would never work and it was causing some issues with empty stderr files being generated if you used --test-accept. Now if the required library is not there, the test is just skipped, and a counter increased to mark the fact. Perhaps in the future it would be nicer to explicitly record why certain tests are skipped. Missing libraries causing a skip is a special case at the moment. Fixes #20005 - - - - - aa1d0eb3 by sheaf at 2021-06-23T02:59:48-04:00 Enable TcPlugin tests on Windows - - - - - d8e5b274 by Matthew Pickering at 2021-06-23T03:00:23-04:00 ghci: Correct free variable calculation in StgToByteCode Fixes #20019 - - - - - 6bf82316 by Matthew Pickering at 2021-06-23T03:00:57-04:00 hadrian: Pass correct leading_underscore configuration to tests - - - - - 8fba28ec by Moritz Angermann at 2021-06-23T03:01:32-04:00 [testsuite] mark T3007 broken on darwin. Cabal explicitly passes options to set the rpath, which we then also try to set using install_name_tool. Cabal should also pass `-fno-use-rpaths` to suppress the setting of the rpath from within GHC. - - - - - 633bbc1f by Douglas Wilson at 2021-06-23T08:52:26+01:00 ci: Don't allow the nightly pipeline to be interrupted. Since 58cfcc65 the default for jobs has been "interruptible", this means that when new commits are pushed to a branch which already has a running pipeline then the old pipelines for this branch are cancelled. This includes the master branch, and in particular, new commits merged to the master branch will cancel the nightly job. The semantics of pipeline cancelling are actually a bit more complicated though. The interruptible flag is *per job*, but once a pipeline has run *any* non-interruptible job, then the whole pipeline is considered non-interruptible (ref https://gitlab.com/gitlab-org/gitlab/-/issues/32837). This leads to the hack in this MR where by default all jobs are `interruptible: True`, but for pipelines we definitely want to run, there is a dummy job which happens first, which is `interreuptible: False`. This has the effect of dirtying the whole pipeline and preventing another push to master from cancelling it. For now, this patch solves the immediate problem of making sure nightly jobs are not cancelled. In the future, we may want to enable this job also for the master branch, making that change might mean we need more CI capacity than currently available. [skip ci] Ticket: #19554 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 8191785e by Aaron Allen at 2021-06-23T20:33:48-04:00 Converts diagnostics for two errors in Ghc.Tc.Module (#19926) This adds constructors to TcRnMessage to replace use of TcRnUnknownMessage in Ghc.Tc.Module. Adds a test case for the UnsafeDueToPlugin warning. Closes #19926 - - - - - e2d8023d by Sylvain Henry at 2021-06-23T20:34:23-04:00 Add some tests for sized primops - - - - - d79530d1 by Moritz Angermann at 2021-06-23T20:34:23-04:00 [aarch64 NCG] Add better support for sub-word primops During the intial NCG development, GHC did not have support for anything below Words. As such the NCG didn't support any of this either. AArch64-Darwin however needs support for subword, as arguments in excess of the first eight (8) passed via registers are passed on the stack, and there in a packed fashion. Thus ghc learned about subword sizes. This than lead us to gain subword primops, and these subsequently highlighted deficiencies in the AArch64 NCG. This patch rectifies the ones I found through via the test-suite. I do not claim this to be exhaustive. Fixes: #19993 Metric Increase: T10421 T13035 T13719 T14697 T1969 T9203 T9872a T9872b T9872c T9872d T9961 haddock.Cabal haddock.base parsing001 - - - - - 38a6d8b8 by Viktor Dukhovni at 2021-06-23T20:34:58-04:00 Fix typo in Note [Quick Look for particular Ids] Fixes #20029 - - - - - 74c87414 by Tamar Christina at 2021-06-24T12:01:58-04:00 rts: move xxxHash out of the user namespace - - - - - 4023d4d9 by Krzysztof Gogolewski at 2021-06-24T12:02:33-04:00 Fix desugaring with unboxed types (#19883) - - - - - 4c6af6be by Alan Zimmerman at 2021-06-24T12:03:10-04:00 EPA: Bringing over tests and updates from ghc-exactprint - - - - - d6ab9c60 by Moritz Angermann at 2021-06-24T12:03:45-04:00 [aarch64-macho] Fix off-by-one error in the linker We need to be careful about the sign bit for BR26 relocation otherwise we end up encoding a large positive number and reading back a large negative number. - - - - - 48171833 by Matthew Pickering at 2021-06-24T12:04:19-04:00 CI: Fix the cabal_test job to compile the Distribution.Simple target The "Cabal test" was previously testing the compilation of the very advanced Setup.hs file. Now we compile the whole library, as the test intended. - - - - - 171413c6 by Matthew Pickering at 2021-06-24T12:04:19-04:00 cabal_test: Make output more like head.hackage output This helps with the import of the results into the performance database. - - - - - 138b7a57 by Viktor Dukhovni at 2021-06-24T12:04:54-04:00 There's no "errorWithCallStack", just use "error". There's no `errorWithCallStack`, only `errorWithStackTrace`, but the latter is now deprecated, since `error` now defaults to returning a stack strace. So rather than change this to the intended deprecated function we replace `errorWithCallStack` with `error` instead. - - - - - 4d5967b5 by Krzysztof Gogolewski at 2021-06-24T20:35:56-04:00 Fixes around incomplete guards (#20023, #20024) - Fix linearity error with incomplete MultiWayIf (#20023) - Fix partial pattern binding error message (#20024) - Remove obsolete test LinearPolyTest It tested the special typing rule for ($), which was removed during the implementation of Quick Look 97cff9190d3. - Fix ticket numbers in linear/*/all.T, they referred to linear types issue tracker - - - - - c1c29808 by Christian Takle at 2021-06-24T20:36:32-04:00 Update quantified_constraints.rst - - - - - 1c811959 by Moritz Angermann at 2021-06-24T20:37:07-04:00 [iserv] learn -wait cli flag Often times when attaching a debugger to iserv it's helpful to have iserv wait a few seconds for the debugger to attach. -wait can be passed via -opti-wait if needed. - - - - - f926ecfd by Matthew Pickering at 2021-06-24T20:37:42-04:00 linker: Replace one missed usage of Opt_RPath with useXLinkerRPath Thanks to @wz1000 for spotting this oversight. - - - - - fa6451b7 by Luite Stegeman at 2021-06-24T20:38:18-04:00 fix sdist for base library config.sub and config.guess aren't used anymore, so they should be removed from the base.cabal file - - - - - d1f59540 by sheaf at 2021-06-25T05:19:18-04:00 Make reallyUnsafePtrEquality# levity-polymorphic fixes #17126, updates containers submodule - - - - - 30afb381 by Matthew Pickering at 2021-06-25T05:19:53-04:00 ghci: Add test for #18330 This test was fixed by 25977ab542a30df4ae71d9699d015bcdd1ab7cfb Fixes #18330 - - - - - f43a11d7 by Matthew Pickering at 2021-06-25T05:19:53-04:00 driver: Add test for #17481 Fixed in 25977ab542a30df4ae71d9699d015bcdd1ab7cfb Fixes #17481 - - - - - eb39981a by Matthew Pickering at 2021-06-25T05:19:53-04:00 driver: Add test for T14923 - - - - - 83dce402 by Zubin Duggal at 2021-06-25T05:20:27-04:00 Add regression test for #19921 - - - - - 0bb78838 by Vladislav Zavialov at 2021-06-25T15:41:24-04:00 Suggest similar names when reporting types in terms (#19978) This fixes an error message regression. - - - - - 6cc80766 by Matthew Pickering at 2021-06-25T15:41:58-04:00 driver: Add implicit package dependencies for template-haskell package When TemplateHaskellQuotes is enabled, we also generate programs which mention symbols from the template-haskell module. So that package is added conditionally if the extension is turned on. We should really do the same for other wired-in packages: * base * ghc-bignum * ghc-prim * rts When we link an executable, we must also link against these libraries. In accordance with every other package, these dependencies should be added into the direct dependencies for a module automatically and end up in the interface file to record the fact the object file was created by linking against these packages. Unfortunately it is not so easy to work out when symbols from each of these libraries ends up in the generated program. You might think that `base` would always be used but the `ghc-prim` package doesn't depend on `base`, so you have to be a bit careful and this futher enhancement is left to a future patch. - - - - - 221a104f by GHC GitLab CI at 2021-06-26T22:42:03-04:00 codeGen: Fix header size for array write barriers Previously the code generator's logic for invoking the nonmoving write barrier was inconsistent with the write barrier itself. Namely, the code generator treated the header size argument as being in words whereas the barrier expected bytes. This was the cause of #19715. Fixes #19715. - - - - - 30f233fe by GHC GitLab CI at 2021-06-26T22:42:03-04:00 rts: Eliminate redundant branch Previously we branched unnecessarily on IF_NONMOVING_WRITE_BARRIER_ENABLED on every trip through the array barrier push loop. - - - - - 9b776cbb by sheaf at 2021-06-26T22:42:39-04:00 Re-export UnliftedRep and UnliftedType from GHC.Exts - - - - - b1792fef by Zubin Duggal at 2021-06-27T06:14:36-04:00 user-guide: Improve documentation of NumDecimals - - - - - 3e71874b by Jakob Brünker at 2021-06-27T06:15:11-04:00 Tc: Allow Typeable in quantified constraints Previously, when using Typeable in a quantified constraint, GHC would complain that user-specified instances of Typeable aren't allowed. This was because checking for SigmaCtxt was missing from a check for whether an instance head is a hand-written binding. Fixes #20033 - - - - - d7758da4 by Sebastian Graf at 2021-06-27T14:57:39-04:00 Simplifier: Do Cast W/W for INLINE strong loop-breakers Strong loop-breakers never inline, INLINE pragma or not. Hence they should be treated as if there was no INLINE pragma on them. Also not doing Cast W/W for INLINE strong loop-breakers will trip up Strictness W/W, because it treats them as if there was no INLINE pragma. Subsequently, that will lead to a panic once Strictness W/W will no longer do eta-expansion, as we discovered while implementing !5814. I also renamed to `unfoldingInfo` to `realUnfoldingInfo` and redefined `unfoldingInfo` to zap the unfolding it returns in case of a strong loop-breaker. Now the naming and semantics is symmetrical to `idUnfolding`/`realIdUnfolding`. Now there was no more reason for `hasInlineUnfolding` to operate on `Id`, because the zapping of strong loop-breaker unfoldings moved from `idUnfolding` to `unfoldingInfo`, so I refactored it to take `IdInfo` and call it both from the Simplifier and WorkWrap, making it utterly clear that both checks are equivalent. - - - - - eee498bf by Sebastian Graf at 2021-06-27T14:57:39-04:00 WorkWrap: Remove mkWWargs (#19874) `mkWWargs`'s job was pushing casts inwards and doing eta expansion to match the arity with the number of argument demands we w/w for. Nowadays, we use the Simplifier to eta expand to arity. In fact, in recent years we have even seen the eta expansion done by w/w as harmful, see Note [Don't eta expand in w/w]. If a function hasn't enough manifest lambdas, don't w/w it! What purpose does `mkWWargs` serve in this world? Not a great one, it turns out! I could remove it by pulling some important bits, notably Note [Freshen WW arguments] and Note [Join points and beta-redexes]. Result: We reuse the freshened binder names of the wrapper in the worker where possible (see testuite changes), much nicer! In order to avoid scoping errors due to lambda-bound unfoldings in worker arguments, we zap those unfoldings now. In doing so, we fix #19766. Fixes #19874. - - - - - 37472a10 by Sebastian Graf at 2021-06-27T14:57:39-04:00 WorkWrap: Make mkWWstr and mkWWcpr generate fewer let bindings In https://gitlab.haskell.org/ghc/ghc/-/merge_requests/5814#note_355144, Simon noted that `mkWWstr` and `mkWWcpr` could generate fewer let bindings and be implemented less indirectly by returning the rebuilt expressions directly, e.g. instead of ``` f :: (Int, Int) -> Int f (x, y) = x+y ==> f :: (Int, Int) -> Int f p = case p of (x, y) -> case x of I# x' -> case y of I# y' -> case $wf x' y' of r' -> let r = I# r' -- immediately returned in r f :: Int# -> Int# -> Int# $wf x' y' = let x = I# x' in -- only used in p let y = I# y' in -- only used in p let p = (x, y) in -- only used in the App below case (\(x,y) -> x+y) p of I# r' -> r' ``` we know generate ``` f :: (Int, Int) -> Int f p = case p of (x, y) -> case x of I# x' -> case y of I# y' -> case $wf x' y' of r' -> I# r' -- 1 fewer let f :: Int# -> Int# -> Int# $wf x' y' = case (\(x,y) -> x+y) (I# x, I# y) of I# r' -> -- 3 fewer lets r' ``` Which is much nicer and makes it easier to comprehend the output of worker-wrapper pre-Simplification as well as puts less strain on the Simplifier. I had to drop support for #18983, but we found that it's broken anyway. Simon is working on a patch that provides a bit more justification. - - - - - e69d070b by Sebastian Graf at 2021-06-27T14:57:39-04:00 Add regression test for #17819 The only item left in #17819. Fixes #17819. - - - - - b92479f9 by Sebastian Graf at 2021-06-27T14:57:39-04:00 Inliner: Regard LitRubbish as TrivArg and not ConLike Part of fixing #19766 required the emission of `LitRubbish` as absent filler in places where we used `absentError` before. In WWRec we have the situation that such bindings occur in the argument to functions. With `LitRubbish` we inlined those functions, because 1. The absent binding was regarded as ConLike. So I fixed `exprIsHNFLike` to respond `False` to `LitRubbish`. 2. The other source of inlining was that after inlining such an absent binding, `LitRubbish` itself was regarded `ValueArg` by `interestingArg`, leading to more inlining. It now responds `TrivArg` to `LitRubbish`. Fixes #20035. There's one slight 1.6% ghc/alloc regression left in T15164 that is due to an additional specialisation `$s$cget`. I've no idea why that happens; the Core output before is identical and has the call site that we specialise for. Metric Decrease: WWRec - - - - - 43bbf4b2 by Sebastian Graf at 2021-06-27T14:57:39-04:00 testsuite: Widen acceptance window of T12545 (#19414) In a sequel of #19414, I wrote a script that measures min and max allocation bounds of T12545 based on randomly modifying -dunique-increment. I got a spread of as much as 4.8%. But instead of widening the acceptance window further (to 5%), I committed the script as part of this commit, so that false positive increases can easily be diagnosed by comparing min and max bounds to HEAD. Indeed, for !5814 we have seen T12545 go from -0.3% to 3.3% after a rebase. I made sure that the min and max bounds actually stayed the same. In the future, this kind of check can very easily be done in a matter of a minute. Maybe we should increase the acceptance threshold if we need to check often (leave a comment on #19414 if you had to check), but I've not been bitten by it for half a year, which seems OK. Metric Increase: T12545 - - - - - 469126b3 by Matthew Pickering at 2021-06-27T14:58:14-04:00 Revert "Make reallyUnsafePtrEquality# levity-polymorphic" This reverts commit d1f59540e8b7be96b55ab4b286539a70bc75416c. This commit breaks the build of unordered-containers ``` [3 of 9] Compiling Data.HashMap.Internal.Array ( Data/HashMap/Internal/Array.hs, dist/build/Data/HashMap/Internal/Array.o, dist/build/Data/HashMap/Internal/Array.dyn_o ) *** Parser [Data.HashMap.Internal.Array]: Parser [Data.HashMap.Internal.Array]: alloc=21043544 time=13.621 *** Renamer/typechecker [Data.HashMap.Internal.Array]: Renamer/typechecker [Data.HashMap.Internal.Array]: alloc=151218672 time=187.083 *** Desugar [Data.HashMap.Internal.Array]: ghc: panic! (the 'impossible' happened) GHC version 9.3.20210625: expectJust splitFunTy CallStack (from HasCallStack): error, called at compiler/GHC/Data/Maybe.hs:68:27 in ghc:GHC.Data.Maybe expectJust, called at compiler/GHC/Core/Type.hs:1247:14 in ghc:GHC.Core.Type ``` Revert containers submodule update - - - - - 46c2d0b0 by Peter Trommler at 2021-06-28T10:45:54-04:00 Fix libffi on PowerPC Update submodule libffi-tarballs to upstream commit 4f9e20a. Remove C compiler flags that suppress warnings in the RTS. Those warnings have been fixed by libffi upstream. Fixes #19885 - - - - - d4c43df1 by Zubin Duggal at 2021-06-28T10:46:29-04:00 Update docs for change in parsing behaviour of infix operators like in GHC 9 - - - - - 755cb2b0 by Alfredo Di Napoli at 2021-06-28T16:57:28-04:00 Try to simplify zoo of functions in `Tc.Utils.Monad` This commit tries to untangle the zoo of diagnostic-related functions in `Tc.Utils.Monad` so that we can have the interfaces mentions only `TcRnMessage`s while we push the creation of these messages upstream. It also ports TcRnMessage diagnostics to use the new API, in particular this commit switch to use TcRnMessage in the external interfaces of the diagnostic functions, and port the old SDoc to be wrapped into TcRnUnknownMessage. - - - - - a7f9670e by Ryan Scott at 2021-06-28T16:58:03-04:00 Fix type and strictness signature of forkOn# This is a follow-up to #19992, which fixes the type and strictness signature for `fork#`. The `forkOn#` primop also needs analogous changes, which this patch accomplishes. - - - - - b760c1f7 by Sebastian Graf at 2021-06-29T15:35:29-04:00 Demand: Better representation (#19050) In #19050, we identified several ways in which we could make more illegal states irrepresentable. This patch introduces a few representation changes around `Demand` and `Card` with a better and earlier-failing API exported through pattern synonyms. Specifically, 1. The old enum definition of `Card` led to severely bloated code of operations on it. I switched to a bit vector representation; much nicer overall IMO. See Note [Bit vector representation for Card]. Most of the gripes with the old representation were related to where which kind of `Card` was allowed and the fact that it doesn't make sense for an absent or bottoming demand to carry a `SubDemand` that describes an evaluation context that is never realised. 2. So I refactored the `Demand` representation so that it has two new data constructors for `AbsDmd` and `BotDmd`. The old `(:*)` data constructor becomes a pattern synonym which expands absent demands as needed, so that it still forms a complete match and a versatile builder. The new `Demand` data constructor now carries a `CardNonAbs` and only occurs in a very limited number of internal call sites. 3. Wherever a full-blown `Card` might end up in a `CardNonAbs` field (like that of `D` or `Call`), I assert the consistency. When the smart builder of `(:*)` is called with an absent `Card`, I assert that the `SubDemand` is the same that we would expand to in the matcher. 4. `Poly` now takes a `CardNonOnce` and encodes the previously noticed invariant that we never produce `Poly C_11` or `Poly C_01`. I made sure that we never construct a `Poly` with `C_11` or `C_01`. Fixes #19050. We lose a tiny bit of anal perf overall, probably because the new `Demand` definition can't be unboxed. The biggest loser is WWRec, where allocations go from 16MB to 26MB in DmdAnal, making up for a total increase of (merely) 1.6%. It's all within acceptance thresholds. There are even two ghc/alloc metric decreases. T11545 decreases by *67%*! Metric Decrease: T11545 T18304 - - - - - 4e9f58c7 by sheaf at 2021-06-29T15:36:08-04:00 Use HsExpansion for overloaded list patterns Fixes #14380, #19997 - - - - - 2ce7c515 by Matthew Pickering at 2021-06-29T15:36:42-04:00 ci: Don't allow aarch64-darwin to fail Part way to #20013 - - - - - f79615d2 by Roland Senn at 2021-07-01T03:29:58-04:00 Add testcase for #19460 Avoid an other regression. - - - - - b51b4b97 by Sylvain Henry at 2021-07-01T03:30:36-04:00 Make withException use SDocContext instead of DynFlags - - - - - 6f097a81 by Sylvain Henry at 2021-07-01T03:30:36-04:00 Remove useless .hs-boot - - - - - 6d712150 by Sylvain Henry at 2021-07-01T03:30:36-04:00 Dynflags: introduce DiagOpts Use DiagOpts for diagnostic options instead of directly querying DynFlags (#17957). Surprising performance improvements on CI: T4801(normal) ghc/alloc 313236344.0 306515216.0 -2.1% GOOD T9961(normal) ghc/alloc 384502736.0 380584384.0 -1.0% GOOD ManyAlternatives(normal) ghc/alloc 797356128.0 786644928.0 -1.3% ManyConstructors(normal) ghc/alloc 4389732432.0 4317740880.0 -1.6% T783(normal) ghc/alloc 408142680.0 402812176.0 -1.3% Metric Decrease: T4801 T9961 T783 ManyAlternatives ManyConstructors Bump haddock submodule - - - - - d455c39e by Emily Martins at 2021-07-01T03:31:13-04:00 Unify primary and secondary GHCi prompt Fixes #20042 Signed-off-by: Emily Martins <emily.flakeheart at gmail.com> Signed-off-by: Hécate Moonlight <hecate at glitchbra.in> - - - - - 05ae4772 by Emily Martins at 2021-07-01T03:31:13-04:00 Unify remaining GHCi prompt example Signed-off-by: Emily Martins <emily.flakeheart at gmail.com> - - - - - c22761fa by Moritz Angermann at 2021-07-01T03:31:48-04:00 [ci] don't allow aarch64-linux (ncg) to fail by accepting the current state of metrics (and the NCG is new, so this seems prudent to do), we can require aarch64-linux (ncg) to build without permitting failure. Metric Increase: T13035 T13719 T14697 T1969 T9203 T9872a T9872b T9872c T9872d T9961 WWRec haddock.Cabal haddock.base parsing001 - - - - - 82e6a4d2 by Moritz Angermann at 2021-07-01T03:31:48-04:00 [ci] Separate llvm and NCG test metrics for aarch64-linux - - - - - e8192ae4 by Moritz Angermann at 2021-07-01T03:31:48-04:00 [Parser: Lexer] Fix !6132 clang's cpp injects spaces prior to #!/. - - - - - 66bd5931 by Moritz Angermann at 2021-07-01T03:31:48-04:00 [ci] Enable T6132 across all targets We should have fixed clangs mess now. - - - - - 66834286 by Marco Zocca at 2021-07-01T10:23:52+00:00 float out some docstrings and comment some function parameters - - - - - a3c451be by Roland Senn at 2021-07-01T16:05:21-04:00 Remove redundant test case print036. The test case `print036` was marked `broken` by #9046. Issue #9046 is a duplicate of #12449. However the test case `T12449` contains several test that are similar to those in `print036`. Hence test case `print036` is redundant and can be deleted. - - - - - 6ac9ea86 by Simon Peyton Jones at 2021-07-02T00:27:04-04:00 One-shot changes (#20008) I discovered that GHC.Core.Unify.bindTv was getting arity 2, rather than 3, in one of my builds. In HEAD it does get the right arity, but only because CallArity (just) manages to spot it. In my situation it (just) failed to discover this. Best to make it robust, which this patch does. See Note [INLINE pragmas and (>>)] in GHC.Utils.Monad. There a bunch of other modules that probably should have the same treatment: GHC.CmmToAsm.Reg.Linear.State GHC.Tc.Solver.Monad GHC.Tc.Solver.Rewrite GHC.Utils.Monad.State.Lazy GHC.Utils.Monad.State.Strict but doing so is not part of this patch - - - - - a820f900 by Sylvain Henry at 2021-07-02T00:27:42-04:00 Detect underflow in fromIntegral/Int->Natural rule Fix #20066 - - - - - bb716a93 by Viktor Dukhovni at 2021-07-02T04:28:34-04:00 Fix cut/paste typo foldrM should be foldlM - - - - - 39d665e4 by Moritz Angermann at 2021-07-02T04:29:09-04:00 Revert "Move validate-x86_64-linux-deb9-hadrian back to quick-build" This reverts commit a0622459f1d9a7068e81b8a707ffc63e153444f8. - - - - - c1c98800 by Moritz Angermann at 2021-07-02T04:29:09-04:00 Move aarch64-linux-llvm to nightly This job takes by far the longest time on its own, we now have a NCG. Once we have fast aarch64 machines, we can consider putting this one back. - - - - - 5e30451d by Luite Stegeman at 2021-07-02T23:24:38-04:00 Support unlifted datatypes in GHCi fixes #19628 - - - - - 9b1d9cbf by Sebastian Graf at 2021-07-02T23:25:13-04:00 Arity: Handle shadowing properly In #20070, we noticed that `findRhsArity` copes badly with shadowing. A simple function like `g_123 x_123 = x_123`, where the labmda binder shadows, already regressed badly. Indeed, the whole `arityType` function wasn't thinking about shadowing *at all*. I rectified that and established the invariant that `ae_join` and `am_sigs` should always be disjoint. That entails deleting bindings from `ae_join` whenever we add something to `am_sigs` and vice versa, which would otherwise be a bug in the making. That *should* fix (but I don't want to close it) #20070. - - - - - 4b4c5e43 by Fraser Tweedale at 2021-07-06T13:36:46-04:00 Implement improved "get executable path" query System.Environment.getExecutablePath has some problems: - Some system-specific implementations throw an exception in some scenarios, e.g. when the executable file has been deleted - The Linux implementation succeeds but returns an invalid FilePath when the file has been deleted. - The fallback implementation returns argv[0] which is not necessarily an absolute path, and is subject to manipulation. - The documentation does not explain any of this. Breaking the getExecutablePath API or changing its behaviour is not an appealing direction. So we will provide a new API. There are two facets to the problem of querying the executable path: 1. Does the platform provide a reliable way to do it? This is statically known. 2. If so, is there a valid answer, and what is it? This may vary, even over the runtime of a single process. Accordingly, the type of the new mechanism is: Maybe (IO (Maybe FilePath)) This commit implements this mechanism, defining the query action for FreeBSD, Linux, macOS and Windows. Fixes: #10957 Fixes: #12377 - - - - - a4e742c5 by Fraser Tweedale at 2021-07-06T13:36:46-04:00 Add test for executablePath - - - - - 4002bd1d by Ethan Kiang at 2021-07-06T13:37:24-04:00 Pass '-x c++' and '-std=c++11' to `cc` for cpp files, in Hadrian '-x c++' was found to be required on Darwin Clang 11 and 12. '-std=c++' was found to be needed on Clang 12 but not 11. - - - - - 354ac99d by Sylvain Henry at 2021-07-06T13:38:06-04:00 Use target platform in guessOutputFile - - - - - 17091114 by Edward at 2021-07-06T13:38:42-04:00 Fix issue 20038 - Change 'variable' -> 'variables' - - - - - 6618008b by Andreas Klebinger at 2021-07-06T21:17:37+00:00 Fix #19889 - Invalid BMI2 instructions generated. When arguments are 8 *or 16* bits wide, then truncate before/after and use the 32bit operation. - - - - - 421beb3f by Matthew Pickering at 2021-07-07T11:56:36-04:00 driver: Convert runPipeline to use a free monad This patch converts the runPipeline function to be implemented in terms of a free monad rather than the previous CompPipeline. The advantages of this are three-fold: 1. Different parts of the pipeline can return different results, the limits of runPipeline were being pushed already by !5555, this opens up futher fine-grainedism of the pipeline. 2. The same mechanism can be extended to build-plan at the module level so the whole build plan can be expressed in terms of one computation which can then be treated uniformly. 3. The pipeline monad can now be interpreted in different ways, for example, you may want to interpret the `TPhase` action into the monad for your own build system (such as shake). That bit will probably require a bit more work, but this is a step in the right directin. There are a few more modules containing useful functions for interacting with the pipelines. * GHC.Driver.Pipeline: Functions for building pipelines at a high-level * GHC.Driver.Pipeline.Execute: Functions for providing the default interpretation of TPhase, in terms of normal IO. * GHC.Driver.Pipeline.Phases: The home for TPhase, the typed phase data type which dictates what the phases are. * GHC.Driver.Pipeline.Monad: Definitions to do with the TPipelineClass and MonadUse class. Hooks consumers may notice the type of the `phaseHook` has got slightly more restrictive, you can now no longer control the continuation of the pipeline by returning the next phase to execute but only override individual phases. If this is a problem then please open an issue and we will work out a solution. ------------------------- Metric Decrease: T4029 ------------------------- - - - - - 5a31abe3 by Matthew Pickering at 2021-07-07T11:56:36-04:00 driver: Add test for #12983 This test has worked since 8.10.2 at least but was recently broken and is now working again after this patch. Closes #12983 - - - - - 56eb57a6 by Alfredo Di Napoli at 2021-07-08T08:13:23+02:00 Rename getErrorMessages and getMessages function in parser code This commit renames the `getErrorMessages` and `getMessages` function in the parser code to `getPsErrorMessages` and `getPsMessages`, to avoid import conflicts, as we have already `getErrorMessages` and `getMessages` defined in `GHC.Types.Error`. Fixes #19920. Update haddock submodule - - - - - 82284ba1 by Matthew Pickering at 2021-07-09T08:46:09-04:00 Remove reqlib from cgrun025 test - - - - - bc38286c by Matthew Pickering at 2021-07-09T08:46:09-04:00 Make throwto002 a normal (not reqlib) test - - - - - 573012c7 by Alfredo Di Napoli at 2021-07-09T08:46:44-04:00 Add the TcRnShadowedName constructor to TcRnMessage This commit adds the TcRnShadowedName to the TcRnMessage type and it uses it in GHC.Rename.Utils. - - - - - 55872423 by Alfredo Di Napoli at 2021-07-09T08:46:44-04:00 Add the TcRnDuplicateWarningDecls to TcRnMessage - - - - - 1e805517 by Alfredo Di Napoli at 2021-07-09T08:46:44-04:00 Add TcRnSimplifierTooManyIterations to TcRnMessage - - - - - bc2c00dd by Alfredo Di Napoli at 2021-07-09T08:46:44-04:00 Add TcRnIllegalPatSynDecl to TcRnMessage - - - - - 52353476 by Alfredo Di Napoli at 2021-07-09T08:46:44-04:00 Add TcRnEmptyRecordUpdate to TcRnMessage - - - - - f0a02dcc by Alfredo Di Napoli at 2021-07-09T08:46:44-04:00 Add TcRnIllegalFieldPunning to TcRnMessage - - - - - 5193bd06 by Alfredo Di Napoli at 2021-07-09T08:46:44-04:00 Add TcRnIllegalWildCardsInRecord to TcRnMessage - - - - - e17850c4 by Alfredo Di Napoli at 2021-07-09T08:46:44-04:00 Add TcRnDuplicateFieldName to TcRnMessage - - - - - 6b4f3a99 by Alfredo Di Napoli at 2021-07-09T08:46:44-04:00 Add TcRnIllegalViewPattern to TcRnMessage - - - - - 8d28b481 by Alfredo Di Napoli at 2021-07-09T08:46:44-04:00 Add TcRnCharLiteralOutOfRange to TcRnMessage - - - - - 64e20521 by Alfredo Di Napoli at 2021-07-09T08:46:44-04:00 Remove redundant patSigErr - - - - - 60fabd7e by Alfredo Di Napoli at 2021-07-09T08:46:44-04:00 Add TcRnIllegalWildcardsInConstructor to TcRnMessage - - - - - 2d4cdfda by Sylvain Henry at 2021-07-09T08:47:22-04:00 Avoid unsafePerformIO for getProgName getProgName was used to append the name of the program (e.g. "ghc") to printed error messages in the Show instance of GhcException. It doesn't belong here as GHCi and GHC API users may want to override this behavior by setting a different error handler. So we now call it in the defaultErrorHandler instead. - - - - - 901f0e1b by sheaf at 2021-07-10T13:29:03+02:00 Don't return unitExpr in dsWhenNoErrs - fixes #18149 and #14765 dsWhenNoErrs now returns "runtimeError @ty" when disallowed representation polymorphism is detected, where ty is the type of the result CoreExpr. "ty" is passed as an additional argument to dsWhenNoErrs, and is used only in the case of such an error. The calls to dsWhenNoErrs must now compute the type of the CoreExpr they are trying to build, so that an error of the right type can be used in case of a representation polymorphism failure. - - - - - c38bce73 by Matthew Pickering at 2021-07-10T19:59:34-04:00 ci: Copy the cache from inside the nix-shell where $HOME is different on darwin Hopefully fixes the flaky CI failures we have seen recently. Co-authored-by: Moritz Angerman <moritz.angermann at gmail.com> - - - - - a181313e by Alfredo Di Napoli at 2021-07-12T14:19:22+02:00 Add proper GHCHints for most PsMessage constructors This commit adds proper hints to most diagnostic types in the `GHC.Parser.Errors.Types` module. By "proper" we mean that previous to this commit the hints were bundled together with the diagnostic message, whereas now we moved most of them as proper `[GhcHint]` in the implementation of `diagnosticHints`. More specifically, this is the list of constructors which now has proper hints: * PsErrIllegalBangPattern * PsWarnOperatorWhitespaceExtConflict * PsErrLambdaCase * PsErrIllegalPatSynExport * PsWarnOperatorWhitespace * PsErrMultiWayIf * PsErrIllegalQualifiedDo * PsErrNumUnderscores * PsErrLinearFunction * PsErrIllegalTraditionalRecordSyntax * PsErrIllegalExplicitNamespace * PsErrOverloadedRecordUpdateNotEnabled * PsErrIllegalDataTypeContext * PsErrSemiColonsInCondExpr * PsErrSemiColonsInCondCmd * PsWarnStarIsType * PsWarnImportPreQualified * PsErrImportPostQualified * PsErrEmptyDoubleQuotes * PsErrIllegalRoleName * PsWarnStarBinder For some reason, this patch increases the peak_megabyte_allocated of the T11545 test to 90 (from a baseline of 80) but that particular test doesn't emit any parsing diagnostic or hint and the metric increase happens only for the `aarch64-linux-deb10`. Metric Increase: T11545 - - - - - aef7d513 by Matthew Pickering at 2021-07-13T15:16:19-04:00 driver: Fix interaction of -Wunused-packages and reexported-modules Spurious warnings were previously emitted if an import came from a reexport due to how -Wunused-packages were implemented. Removing the dependency would cause compilation to fail. The fix is to reimplement the warning a bit more directly, by searching for which package each import comes from using the normal module finding functions rather than consulting the EPS. This has the advantage that the check could be performed at any time after downsweep rather than also relying on a populated EPS. Fixes #19518 and #19777 - - - - - bb8e0df8 by Adrien at 2021-07-13T15:16:56-04:00 Added a hopefully clarificatory sentence about the notion of "atomicity" presupposed in the documentation on MVar. - - - - - 99921593 by Zubin Duggal at 2021-07-13T20:45:44+00:00 Don't panic on 'no skolem info' and add failing tests - - - - - de98a0ce by Sylvain Henry at 2021-07-15T23:29:09-04:00 Additional constant-folding rule for binary AND/OR Add a constant folding rule allowing the subsumption of an application if the same argument is applied twice, e.g. (v .&. 0xFF) .&. 0xFF ~~> v .&. 0xFF (v .|. 0xFF) .|. 0xFF ~~> v .|. 0xFF - - - - - 41d6cfc4 by Sylvain Henry at 2021-07-15T23:29:09-04:00 Add Word64#/Int64# primops Word64#/Int64# are only used on 32-bit architectures. Before this patch, operations on these types were directly using the FFI. Now we use real primops that are then lowered into ccalls. The advantage of doing this is that we can now perform constant folding on Word64#/Int64# (#19024). Most of this work was done by John Ericson in !3658. However this patch doesn't go as far as e.g. changing Word64 to always be using Word64#. Noticeable performance improvements T9203(normal) run/alloc 89870808.0 66662456.0 -25.8% GOOD haddock.Cabal(normal) run/alloc 14215777340.8 12780374172.0 -10.1% GOOD haddock.base(normal) run/alloc 15420020877.6 13643834480.0 -11.5% GOOD Metric Decrease: T9203 haddock.Cabal haddock.base - - - - - 5b187575 by Simon Peyton Jones at 2021-07-19T10:59:38+01:00 Better sharing of join points (#19996) This patch, provoked by regressions in the text package (#19557), improves sharing of join points. This also fixes the terrible behaviour in #20049. See Note [Duplicating join points] in GHC.Core.Opt.Simplify. * In the StrictArg case of mkDupableContWithDmds, don't use Plan A for data constructors * In postInlineUnconditionally, don't inline JoinIds Avoids inlining join $j x = Just x in case blah of A -> $j x1 B -> $j x2 C -> $j x3 * In mkDupableStrictBind and mkDupableStrictAlt, create join points (much) more often: exprIsTrivial rather than exprIsDupable. This may be much, but we'll see. Metric Decrease: T12545 T13253-spj T13719 T18140 T18282 T18304 T18698a T18698b Metric Increase: T16577 T18923 T9961 - - - - - e5a4cfa5 by Sylvain Henry at 2021-07-19T19:36:37-04:00 Bignum: don't allocate in bignat_mul (#20028) We allocated the recursively entered `mul` helper function because it captures some args. - - - - - 952ba18e by Matthew Pickering at 2021-07-19T19:37:12-04:00 th: Weaken return type of myCoreToStgExpr The previous code assumed properties of the CoreToStg translation, namely that a core let expression which be translated to a single non-recursive top-level STG binding. This assumption was false, as evidenced by #20060. The consequence of this was the need to modify the call sites of `myCoreToStgExpr`, the main one being in hscCompileCoreExpr', which the meant we had to use byteCodeGen instead of stgExprToBCOs to convert the returned value to bytecode. I removed the `stgExprToBCOs` function as it is no longer used in the compiler. There is still some partiallity with this patch (the lookup in hscCompileCoreExpr') but this should be more robust that before. Fixes #20060 - - - - - 3e8b39ea by Alfredo Di Napoli at 2021-07-19T19:37:47-04:00 Rename RecordPuns to NamedFieldPuns in LangExt.Extension This commit renames the `RecordPuns` type constructor inside `GHC.LanguageExtensions.Type.hs` to `NamedFieldPuns`. The rationale is that the `RecordPuns` language extension was deprecated a long time ago, but it was still present in the AST, introducing an annoying mismatch between what GHC suggested (i.e. "use NamedFieldPuns") and what that translated into in terms of Haskell types. - - - - - 535123e4 by Simon Peyton Jones at 2021-07-19T19:38:21-04:00 Don't duplicate constructors in the simplifier Ticket #20125 showed that the Simplifier could sometimes duplicate a constructor binding. CSE would often eliminate it later, but doing it in the first place was utterly wrong. See Note [Do not duplicate constructor applications] in Simplify.hs I also added a short-cut to Simplify.simplNonRecX for the case when the RHS is trivial. I don't think this will change anything, just make the compiler run a tiny bit faster. - - - - - 58b960d2 by Sylvain Henry at 2021-07-19T19:38:59-04:00 Make TmpFs independent of DynFlags This is small step towards #19877. We want to make the Loader/Linker interface more abstract to be easily reused (i.e. don't pass it DynFlags) but the system linker uses TmpFs which required a DynFlags value to get its temp directory. We explicitly pass the temp directory now. Similarly TmpFs was consulting the DynFlags to decide whether to clean or: this is now done by the caller in the driver code. - - - - - d706fd04 by Matthew Pickering at 2021-07-20T09:22:46+01:00 hadrian: Update docs targets documentation [skip ci] The README had got a little out of sync with the current state of affairs. - - - - - 9eb1641e by Matthew Pickering at 2021-07-21T02:45:39-04:00 driver: Fix recompilation for modules importing GHC.Prim The GHC.Prim module is quite special as there is no interface file, therefore it doesn't appear in ms_textual_imports, but the ghc-prim package does appear in the direct package dependencies. This confused the recompilation checking which couldn't find any modules from ghc-prim and concluded that the package was no longer a dependency. The fix is to keep track of whether GHC.Prim is imported separately in the relevant places. Fixes #20084 - - - - - 06d1ca85 by Alfredo Di Napoli at 2021-07-21T02:46:13-04:00 Refactor SuggestExtension constructor in GhcHint This commit refactors the SuggestExtension type constructor of the GhcHint to be more powerful and flexible. In particular, we can now embed extra user information (essentially "sugar") to help clarifying the suggestion. This makes the following possible: Suggested fix: Perhaps you intended to use GADTs or a similar language extension to enable syntax: data T where We can still give to IDEs and tools a `LangExt.Extension` they can use, but in the pretty-printed message we can tell the user a bit more on why such extension is needed. On top of that, we now have the ability to express conjuctions and disjunctons, for those cases where GHC suggests to enable "X or Y" and for the cases where we need "X and Y". - - - - - 5b157eb2 by Fendor at 2021-07-21T02:46:50-04:00 Use Ways API instead of Set specific functions - - - - - 10124b16 by Mario Blažević at 2021-07-21T02:47:25-04:00 template-haskell: Add support for default declarations Fixes #19373 - - - - - e8f7734d by John Ericson at 2021-07-21T22:51:41+00:00 Fix #19931 The issue was the renderer for x86 addressing modes assumes native size registers, but we were passing in a possibly-smaller index in conjunction with a native-sized base pointer. The easist thing to do is just extend the register first. I also changed the other NGC backends implementing jump tables accordingly. On one hand, I think PowerPC and Sparc don't have the small sub-registers anyways so there is less to worry about. On the other hand, to the extent that's true the zero extension can become a no-op. I should give credit where it's due: @hsyl20 really did all the work for me in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4717#note_355874, but I was daft and missed the "Oops" and so ended up spending a silly amount of time putting it all back together myself. The unregisterised backend change is a bit different, because here we are translating the actual case not a jump table, and the fix is to handle right-sized literals not addressing modes. But it makes sense to include here too because it's the same change in the subsequent commit that exposes both bugs. - - - - - 024020c3 by John Ericson at 2021-07-21T22:52:52+00:00 Use fix-sized equality primops for fixed size boxed types These are the last to be converted. - - - - - fd7e272e by Sylvain Henry at 2021-07-23T21:05:41-04:00 Perf: fix strictness in OccurAnal This patch enhances OccurAnal perf by using a dedicated WithUsageDetails datatype instead of a tuple (similarly to what has been done in demand-analysis) with strict fields. OccEnv is also passed strictly with more strict fields as it improves results even more. T9198 flukes isn't reproducible locally (cf https://gitlab.haskell.org/ghc/ghc/-/merge_requests/5667#note_364358) Metric Decrease: ManyConstructors T10421 T12150 T12425 T12707 T13056 T13253 T13253-spj T15164 T16577 T18282 T18698a T18698b T1969 T4801 T5642 T9020 T9233 T9630 T9675 T9961 WWRec T12227 T13035 T18304 T6048 T12234 T783 T20049 Metric Increase: T9198 - - - - - ba302877 by sheaf at 2021-07-23T21:06:18-04:00 Add nontrivial type-checking plugin tests Three new tests for type-checking plugins: - TcPlugin_Nullary, solving a nullary class constraint - TcPlugin_Args, providing evidence for a (unary) class constraint using arguments supplied to the plugin - TcPlugin_TyFam, solving an equality constraint to rewrite a type-family application More extensive descriptions of the plugins can be found in their respective defining modules. - - - - - 5d670abd by sheaf at 2021-07-23T21:06:56-04:00 Generalise reallyUnsafePtrEquality# and use it fixes #9192 and #17126 updates containers submodule 1. Changes the type of the primop `reallyUnsafePtrEquality#` to the most general version possible (heterogeneous as well as levity-polymorphic): > reallyUnsafePtrEquality# > :: forall {l :: Levity} {k :: Levity} > (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)) > . a -> b -> Int# 2. Adds a new internal module, `GHC.Ext.PtrEq`, which contains pointer equality operations that are now subsumed by `reallyUnsafePtrEquality#`. These functions are then re-exported by `GHC.Exts` (so that no function goes missing from the export list of `GHC.Exts`, which is user-facing). More specifically, `GHC.Ext.PtrEq` defines: - A new function: * reallyUnsafePtrEquality :: forall (a :: Type). a -> a -> Int# - Library definitions of ex-primops: * `sameMutableArray#` * `sameSmallMutableArray` * `sameMutableByteArray#` * `sameMutableArrayArray#` * `sameMutVar#` * `sameTVar#` * `sameMVar#` * `sameIOPort#` * `eqStableName#` - New functions for comparing non-mutable arrays: * `sameArray#` * `sameSmallArray#` * `sameByteArray#` * `sameArrayArray#` These were requested in #9192. Generally speaking, existing libraries that use `reallyUnsafePtrEquality#` will continue to work with the new, levity-polymorphic version. But not all! Some (`containers`, `unordered-containers`, `dependent-map`) contain the following: > unsafeCoerce# reallyUnsafePtrEquality# a b If we make `reallyUnsafePtrEquality#` levity-polymorphic, this code fails the current GHC representation-polymorphism checks. We agreed that the right solution here is to modify the library; in this case by deleting the call to `unsafeCoerce#`, since `reallyUnsafePtrEquality#` is now type-heterogeneous too. - - - - - 4beb12db by Matthew Pickering at 2021-07-23T21:07:31-04:00 Add test for #13157 Closes #13157 - - - - - 509445b5 by Matthew Pickering at 2021-07-23T21:08:05-04:00 Check the buffer size *before* calling the continuation in withEncodedCString This fixes a very subtle bug in withEncodedCString where a reference would be kept to the whole continuation until the continuation had finished executing. This was because the call to tryFillBufferAndCall could fail, if the buffer was already full and so the `go` helper would be recursively called on failure which necessitated keeping a reference to `act`. The failure could only happen during the initial checking phase of the function but not during the call to the continuation. Therefore the fix is to first perform the size check, potentially recursively and then finally calling tail calling the continuation. In the real world, this broke writing lazy bytestrings because a reference to the head of the bytestring would be retained in the continuation until the whole string had been written to a file. Fixes #20107 - - - - - 6c79981e by Fendor at 2021-07-23T21:08:42-04:00 Introduce FinderLocations for decoupling Finder from DynFlags - - - - - b26a7065 by Matthew Pickering at 2021-07-23T21:09:17-04:00 Fix a few retainer leaks of TcGblEnv Methodology: Create a -hi profile and then search for TcGblEnv then use ghc-debug to work out why they are being retained and remove the reason. Retaining TcGblEnv is dangerous because it contains pointers to things such as a TypeEnv which is updated throughout compilation. I found two places which were retaining a TcGblEnv unecessarily. Also fix a few places where an OccName was retaining an Id. - - - - - efaad7ad by Matthew Pickering at 2021-07-23T21:09:17-04:00 Stop ug_boring_info retaining a chain of old CoreExpr It was noticed in #20134 that each simplifier iteration used an increasing amount of memory and that a certain portion of memory was not released until the simplfier had completely finished. I profiled the program using `-hi` profiling and observed that there was a thunk arising in the computation of `ug_boring_ok`. On each iteration `ug_boring_ok` would be updated, but not forced, which would leave a thunk in the shape of ug_boring_ok = inlineBoringOk expr0 || inlineBoringOk expr2 || inlineBoringOk expr3 || ... which would retain all previous `expr` until `ug_boring_ok` was forced or discarded. Forcing this accumulator eagerly results in a flat profile over multiple simplifier runs. This reduces the maximum residency when compiling the test in #20134 from 2GB to 1.3G. ------------------------- Metric Decrease: T11545 ------------------------- - - - - - b6434ed3 by Ben Gamari at 2021-07-23T21:09:52-04:00 Cmm.Opt: Fix type of shift amount in constant folding Previously the `MO_S_Quot` constant folding rule would incorrectly pass the shift amount of the same width as the shifted value. However, the machop's type expects the shift amount to be a Word. Fixes #20142. - - - - - a31aa271 by Ben Gamari at 2021-07-23T21:09:52-04:00 testsuite: Add test for #20142 - - - - - 3801b35a by Moritz Angermann at 2021-07-25T09:41:46-04:00 [CI] absolutely no caching on darwin We failed at doing caching properly, so for now we won't do any caching at all. This is not safe in a concurrent setting, however all our darwin builders run with concurrency 1, and -j8, on 8 core m1 mac minis. - - - - - 1832676a by Moritz Angermann at 2021-07-25T09:41:46-04:00 [rts] Untag bq->bh prior to reading the info table In `checkBlockingQueues` we must always untag the `bh` field of an `StgBlockingQueue`. While at first glance it might seem a sensible assumption that `bh` will always be a blackhole and therefore never be tagged, the GC could shortcut the indirection and put a tagged pointer into the indirection. This blew up on aarch64-darwin with a misaligned access. `bh` pointed to an address that always ended in 0xa. On architectures that are a little less strict about alignment, this would have read a garbage info table pointer, which very, very unlikely would have been equal to `stg_BLACKHOLE_info` and therefore things accidentally worked. However, on AArch64, the read of the info table pointer resulted in a SIGBUS due to misaligned read. Fixes #20093. - - - - - 5b39a107 by Ben Gamari at 2021-07-25T17:30:52+00:00 hadrian: Don't add empty -I arguments Previously hadrian would add a -I$FfiIncludeDir flag to compiler invocations even if FfiIncludeDir was null, resulting in compilation errors. - - - - - 5f3991c7 by Sylvain Henry at 2021-07-26T04:55:03-04:00 RTS: try to fix timer races * Pthread based timer was initialized started while some other parts of the RTS assume it is initialized stopped, e.g. in hs_init_ghc: /* Start the "ticker" and profiling timer but don't start until the * scheduler is up. However, the ticker itself needs to be initialized * before the scheduler to ensure that the ticker mutex is initialized as * moreCapabilities will attempt to acquire it. */ * after a fork, don't start the timer before the IOManager is initialized: the timer handler (handle_tick) might call wakeUpRts to perform an idle GC, which calls wakeupIOManager/ioManagerWakeup Found while debugging #18033/#20132 but I couldn't confirm if it fixes them. - - - - - 0462750f by Fendor at 2021-07-27T04:46:42-04:00 Remove unused module GHC.Rename.Doc - - - - - 51ff0365 by Ben Gamari at 2021-07-27T04:47:16-04:00 rename: Avoid unnecessary map lookup Previously the -Wcompat-unqualified-imports warning would first check whether an import is of a covered module, incurring an map lookup, before checking the simple boolean predicate of whether it is qualified. This is more expensive than strictly necessary (although at the moment the warning is unused, so this will make little difference). - - - - - 167a01f7 by Ben Gamari at 2021-07-27T04:47:51-04:00 rts: Document CPP guards - - - - - 246f08ac by Ben Gamari at 2021-07-27T04:47:51-04:00 rts: Move libffi interfaces all to Adjustor Previously the libffi Adjustor implementation would use allocateExec to create executable mappings. However, allocateExec is also used elsewhere in GHC to allocate things other than ffi_closure, which is a use-case which libffi does not support. - - - - - 2ce48fe9 by Ben Gamari at 2021-07-27T04:47:51-04:00 rts: Break up adjustor logic - - - - - 3b07d827 by Ben Gamari at 2021-07-27T04:47:51-04:00 rts/adjustor: Drop redundant commments - - - - - 0e875c3f by Ben Gamari at 2021-07-27T04:47:51-04:00 rts: Introduce and use ExecPage abstraction Here we introduce a very thin abstraction for allocating, filling, and freezing executable pages to replace allocateExec. - - - - - f6e366c0 by Ben Gamari at 2021-07-27T04:47:51-04:00 rts: Drop allocateExec and friends All uses of these now use ExecPage. - - - - - dd3c9602 by Ben Gamari at 2021-07-27T04:47:51-04:00 hadrian: Always specify flag values explicitly Previously we would often allow cabal flags to default, making it harder than necessary to reason about the effective build configuration. - - - - - 63184a71 by Ben Gamari at 2021-07-27T04:47:51-04:00 rts: Don't declare libCffi as bundled when using system libffi Previously the rts's cabal file would claim that it bundled libffi, even if we are using the system's libffi. Fixes #19869. - - - - - 8c5c27f1 by Andreas Klebinger at 2021-07-27T04:48:26-04:00 Rename itimer to ticker in rts/posix for consistency. - - - - - 5457a124 by Andreas Klebinger at 2021-07-27T04:48:26-04:00 Use pthread if available on linux - - - - - b19f1a6a by Ben Gamari at 2021-07-27T04:49:00-04:00 rts/OSThreads: Ensure that we catch failures from pthread_mutex_lock Previously we would only catch EDEADLK errors. - - - - - 0090517a by Ben Gamari at 2021-07-27T04:49:00-04:00 rts/OSThreads: Improve error handling consistency Previously we relied on the caller to check the return value from broadcastCondition and friends, most of whom neglected to do so. Given that these functions should not fail anyways, I've opted to drop the return value entirely and rather move the result check into the OSThreads functions. This slightly changes the semantics of timedWaitCondition which now returns false only in the case of timeout, rather than any error as previously done. - - - - - 229b4e51 by Ben Gamari at 2021-07-27T04:49:36-04:00 rts: Fix inconsistent signatures for collect_pointers Fixes #20160. - - - - - c2893361 by Fraser Tweedale at 2021-07-27T04:50:13-04:00 doc: fix copy/paste error The `divInt#` implementation note has heading: See Note [divInt# implementation] This seems to be a copy/paste mistake. Remove "See" from the heading. - - - - - 4816d9b7 by Alina Banerjee at 2021-07-27T12:01:15-04:00 validate: fix #18477, improve syntax & add if-else checks for test outcomes/validation paths ShellCheck(https://github.com/koalaman/shellcheck/wiki) has been used to check the script. - - - - - 575f1f2f by Alina Banerjee at 2021-07-27T12:01:15-04:00 validate: add flags using Hadrian's user settings for ignoring changes in performance tests - - - - - 421110b5 by Alina Banerjee at 2021-07-27T12:01:15-04:00 validate: add a debug flag (in both Hadrian and legacy Make) for running tests - - - - - 9d8cb93e by Alina Banerjee at 2021-07-27T12:01:15-04:00 validate: update quick-validate flavour for validation with --fast - - - - - 07696269 by Alina Banerjee at 2021-07-27T12:01:15-04:00 validate: change test ghc based on BINDIST value (YES/NO) - - - - - 83a88988 by Alina Banerjee at 2021-07-27T12:01:15-04:00 validate: run stage1 tests using stage1 compiler when BINSTIST is false - - - - - 64b6bc23 by Alina Banerjee at 2021-07-27T12:01:15-04:00 validate: check both stage1, stage2 test failures for deciding success of entire test run - - - - - 74b79191 by Alina Banerjee at 2021-07-27T12:01:15-04:00 validate: Add note for BINDIST variable, GitLab validation; clean up comments - - - - - 888eadb9 by Matthew Pickering at 2021-07-27T12:01:51-04:00 packaging: Be more precise about which executables to copy and wrappers to create Exes ---- Before: The whole bin/ folder was copied which could contain random old/stale/testsuite executables After: Be precise Wrappers -------- Before: Wrappers were created for everything in the bin folder, including internal executables such as "unlit" After: Only create wrappers for the specific things which we want to include in the user's path. This makes the hadrian bindists match up more closely with the make bindists. - - - - - e4c25261 by Matthew Pickering at 2021-07-27T12:01:51-04:00 packaging: Give ghc-pkg the same version as ProjectVersion - - - - - 8e43dc90 by Matthew Pickering at 2021-07-27T12:01:51-04:00 hadrian: Update hsc2hs wrapper to match current master - - - - - 172fd5d1 by Matthew Pickering at 2021-07-27T12:01:51-04:00 hadrian: Remove special haddock copying rule - - - - - f481c189 by Matthew Pickering at 2021-07-27T12:01:51-04:00 packaging: Create both versioned and unversioned executables Before we would just copy the unversioned executable into the bindist. Now the actual executable is copied into the bindist and a version suffix is added. Then a wrapper or symlink is added which points to the versioned executable. Fixes #20074 - - - - - acc47bd2 by Matthew Pickering at 2021-07-27T12:01:51-04:00 packaging: Add note about wrappers - - - - - 5412730e by Matthew Pickering at 2021-07-27T12:01:51-04:00 packaging: Don't include configure scripts in windows bindist Fixes #19868 - - - - - 22a16b0f by Matthew Pickering at 2021-07-27T12:01:51-04:00 hadrian: Install windows bindist by copying in test_hadrian - - - - - 45f05554 by Matthew Pickering at 2021-07-27T12:01:51-04:00 hadrian: Add exe suffix to executables in testsuite - - - - - 957fe359 by Matthew Pickering at 2021-07-27T12:01:51-04:00 hadrian: Call ghc-pkg recache after copying package database into bindist The package.cache needs to have a later mod-time than all of the .conf files. This invariant can be destroyed by `cp -r` and so we run `ghc-pkg recache` to ensure the package database which is distributed is consistent. If you are installing a relocatable bindist, for example, on windows, you should preserve mtimes by using cp -a or run ghc-pkg recache after installing. - - - - - 7b0ceafb by Matthew Pickering at 2021-07-27T12:01:51-04:00 testsuite: Add more debug output on failure to call ghc-pkg - - - - - 0c4a0c3b by Simon Peyton Jones at 2021-07-27T12:02:25-04:00 Make CallStacks work better with RebindableSyntax As #19918 pointed out, the CallStack mechanism didn't work well with RebindableSyntax. This patch improves matters. See GHC.Tc.Types.Evidence Note [Overview of implicit CallStacks] * New predicate isPushCallStackOrigin distinguishes when a CallStack constraint should be solved "directly" or by pushing an item on the stack. * The constructor EvCsPushCall now has a FastString, which can describe not only a function call site, but also things like "the literal 42" or "an if-then-else expression". * I also fixed #20126 thus: exprCtOrigin (HsIf {}) = IfThenElseOrigin (Previously it was "can't happen".) - - - - - 6d2846f7 by Simon Peyton Jones at 2021-07-27T12:02:25-04:00 Eta expand through CallStacks This patch fixes #20103, by treating HasCallStack constraints as cheap when eta-expanding. See Note [Eta expanding through CallStacks] in GHC.Core.Opt.Arity - - - - - 9bf8d530 by Simon Peyton Jones at 2021-07-27T12:03:00-04:00 Eliminate unnecessary unsafeEqualityProof This patch addresses #20143, which wants to discard unused calls to unsafeEqualityProof. There are two parts: * In exprOkForSideEffects, we want to know that unsafeEqualityProof indeed terminates, without any exceptions etc * But we can only discard the case if we know that the coercion variable is not used, which means we have to gather accurate occurrence info for CoVars. Previously OccurAnal only did a half hearted job of doing so; this patch finishes the job. See Note [Gather occurrences of coercion variables] in OccurAnal. Because the occurrence analyser does more work, there is a small compile-time cost but it's pretty small. The compiler perf tests are usually 0.0% but occasionally up to 0.3% increase. I'm just going to accept this -- gathering accurate occurrence information really seems like the Right Thing to do. There is an increase in `compile_time/peak_megabytes_allocated`, for T11545, or around 14%; but I can't reproduce it on my machine (it's the same before and after), and the peak-usage stats are vulnerable to when exactly the GC takes place, so I'm just going to accept it. Metric Increase: T11545 - - - - - cca08c2c by Krzysztof Gogolewski at 2021-07-27T12:03:35-04:00 Parser: suggest TemplateHaskell on $$(...) (#20157) - - - - - 20b352eb by Andreas Abel at 2021-07-27T12:04:12-04:00 Doc: tabs to spaces - - - - - ebcdf3fa by Andreas Abel at 2021-07-27T12:04:12-04:00 Doc: warnings: since: remove minor version number for uniformity New warnings are only released in major versions, it seems. One way or the other, a .1 minor version can always be dropped. - - - - - 0b403319 by Andreas Abel at 2021-07-27T12:04:12-04:00 Issue #18087: :since: for warnings of ghc 6/7/8 Added :since: fields to users_guide on warning, for warnings introduced starting GHC 6.0. The data was extracted from the HTML docs on warnings, see https://gitlab.haskell.org/ghc/ghc/-/issues/18087 and partially verified by consulting the change logs. - - - - - f27dba8b by Andreas Abel at 2021-07-27T12:04:12-04:00 Re #18087 !6238 Empty line in front of :since: Ack. @monoidal - - - - - c7c0964c by Krzysztof Gogolewski at 2021-07-27T21:35:17-04:00 Simplify FFI code Remains of the dotnet FFI, see a7d8f43718 and 1fede4bc95 - - - - - 97e0837d by Krzysztof Gogolewski at 2021-07-27T21:35:17-04:00 Remove some unused names The comment about 'parError' was obsolete. - - - - - cab890f7 by Krzysztof Gogolewski at 2021-07-27T21:35:17-04:00 Add a regression test for #17697 - - - - - 9da20e3d by Krzysztof Gogolewski at 2021-07-27T21:35:17-04:00 Don't abort on representation polymorphism check This is reverting a change introduced in linear types commit 40fa237e1da. Previously, we had to abort early, but thanks to later changes, this is no longer needed. There's no test, but the behavior should be better. The plan is to remove levity polymorphism checking in the desugarer anyway. - - - - - cddafcf6 by Sylvain Henry at 2021-07-27T21:35:55-04:00 PIC: test for cross-module references - - - - - 323473e8 by Sylvain Henry at 2021-07-28T06:16:58-04:00 Hadrian: disable profiled RTS with no_profiled_libs flavour transformer Hadrian uses the RTS ways to determine which iserv programs to embed into bindist. But profiled iserv program (and any other code) can't be built without profiling libs and Hadrian fails. So we disable the profiling RTS way with the no_profiled_libs flavour transformer. - - - - - 10678945 by Ben Gamari at 2021-07-28T06:17:32-04:00 rts: Don't rely on configuration when CLEANING=YES The make build system doesn't source config.mk when CLEANING=YES, consequently we previously failed to identify an appropriate adjustor implementation to use during cleaning. Fixes #20166. - - - - - f3256769 by Krzysztof Gogolewski at 2021-07-28T13:18:31-04:00 Docs: use :default: and :ghc-ticket: - - - - - dabe6113 by Krzysztof Gogolewski at 2021-07-28T13:18:31-04:00 Document DerivingVia unsafety (#19786) - - - - - 2625d48e by Krzysztof Gogolewski at 2021-07-28T13:18:31-04:00 Improve docs of bang patterns (#19068) - - - - - a57e4a97 by Krzysztof Gogolewski at 2021-07-28T13:18:31-04:00 Functor docs: link to free theorem explanation (#19300) - - - - - d43a9029 by Simon Peyton Jones at 2021-07-28T13:19:06-04:00 Fix smallEnoughToInline I noticed that smallEnoughToInline said "no" to UnfWhen guidance, which seems quite wrong -- those functions are particularly small. - - - - - 4e4ca28c by Simon Peyton Jones at 2021-07-28T13:19:06-04:00 Print out module name in "bailing out" message - - - - - 9dbab4fd by Simon Peyton Jones at 2021-07-28T13:19:06-04:00 Improve postInlineUnconditionally See Note [Use occ-anald RHS in postInlineUnconditionally]. This explains how to eliminate an extra round of simplification, which can happen if postInlineUnconditionally uses a RHS that is no occurrence-analysed. This opportunity has been there for ages; I discovered it when looking at a compile-time perf regression that happened because the opportunity wasn't exploited. - - - - - 25ca0b5a by Simon Peyton Jones at 2021-07-28T13:19:06-04:00 Extend the in-scope set to silence substExpr warnings substExpr warns if it finds a LocalId that isn't in the in-scope set. This patch extends the in-scope set to silence the warnings. (It has no effect on behaviour.) - - - - - a67e6814 by Simon Peyton Jones at 2021-07-28T13:19:06-04:00 White space, spelling, and a tiny refactor No change in behaviour - - - - - 05f54bb4 by Simon Peyton Jones at 2021-07-28T13:19:06-04:00 Make the occurrence analyser a bit stricter occAnalArgs and occAnalApp are very heavily used functions, so it pays to make them rather strict: fewer thunks constructed. All these thunks are ultimately evaluated anyway. This patch gives a welcome reduction compile time allocation of around 0.5% across the board. For T9961 it's a 2.2% reduction. Metric Decrease: T9961 - - - - - 2567d13b by Simon Peyton Jones at 2021-07-28T13:19:06-04:00 Inline less logging code When eyeballing calls of GHC.Core.Opt.Simplify.Monad.traceSmpl, I saw that lots of cold-path logging code was getting inlined into the main Simplifier module. So in GHC.Utils.Logger I added a NOINLINE on logDumpFile'. For logging, the "hot" path, up to and including the conditional, should be inlined, but after that we should inline as little as possible, to reduce code size in the caller. - - - - - a199d653 by Simon Peyton Jones at 2021-07-28T13:19:40-04:00 Simplify and improve the eta expansion mechanism Previously the eta-expansion would return lambdas interspersed with casts; now the cast is just pushed to the outside: #20153. This actually simplifies the code. I also improved mkNthCo to account for SymCo, so that mkNthCo n (SymCo (TyConAppCo tc cos)) would work well. - - - - - 299b7436 by Simon Peyton Jones at 2021-07-28T13:19:41-04:00 Improve performance of eta expansion Eta expansion was taking ages on T18223. This patch * Aggressively squash reflexive casts in etaInfoApp. See Note [Check for reflexive casts in eta expansion] These changes decreased compile-time allocation by 80%! * Passes the Simplifier's in-scope set to etaExpandAT, so we don't need to recompute it. (This alone saved 10% of compile time.) Annoyingly several functions in the Simplifier (namely makeTrivialBinding and friends) need to get SimplEnv, rather than SimplMode, but that is no big deal. Lots of small changes in compile-time allocation, less than 1% and in both directions. A couple of bigger changes, including the rather delicate T18223 T12425(optasm) ghc/alloc 98448216.0 97121224.0 -1.3% GOOD T18223(normal) ghc/alloc 5454689676.0 1138238008.0 -79.1% GOOD Metric Decrease: T12425 T18223 - - - - - 91eb1857 by Simon Peyton Jones at 2021-07-28T13:19:41-04:00 Fix a subtle scoping error in simplLazyBind In the call to prepareBinding (in simplLazyBind), I had failed to extend the in-scope set with the binders from body_floats1. As as result, when eta-expanding deep inside prepareBinding we made up an eta-binder that shadowed a variable free in body1. Yikes. It's hard to trigger this bug. It showed up when I was working on !5658, and I started using the in-scope set for eta-expansion, rather than taking free variables afresh. But even then it only showed up when compiling a module in Haddock utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs Sadly Haddock is compiled without Core Lint, so we ultimately got a seg-fault. Lint nailed it fast once I realised that it was off. There is some other tiny refactoring in this patch. - - - - - 7dc0dc99 by CarrieMY at 2021-07-28T13:20:17-04:00 Fix type check error message grammar (fixes #20122) Remove trailing spaces - - - - - 3382b3d6 by CarrieMY at 2021-07-28T13:20:17-04:00 Update expected stderr for affected tests, which are not under Tc directory - - - - - 4a2ef3dd by Alfredo Di Napoli at 2021-07-28T13:20:52-04:00 Port more DriverUnknownMessage into richer DriverMessage constructors In order: * Introduce the `PsErrUnknownOptionsPragma` diagnostic message This commit changes the diagnostic emitted inside `GHC.Parser.Header.checkProcessArgsResult` from an (erroneous) and unstructured `DriverUnknownMessage` to a `PsErrUnknownOPtionsPragma`, i.e. a new data constructor of a `PsHeaderMessage`. * Add the `DriverUserDefinedRuleIgnored` diagnostic message * Add `DriverUserDefinedRuleIgnored` data constructor This commit adds (and use) a new data constructor to the `DriverMessage` type, replacing a `DriverUnknownMessage` with it. * Add and use `DriverCannotLoadInterfaceFile` constructor This commit introduces the DriverCannotLoadInterfaceFile constructor for the `DriverMessage` type and it uses it to replace and occurrence of `DriverUnknownMessage`. * Add and use the `DriverInferredSafeImport` constructor This commit adds a new `DriverInferredSafeImport` constructor to the `DriverMessage` type, and uses it in `GHC.Driver.Main` to replace one occurrence of `DriverUnknownMessage`. * Add and use `DriverCannotImportUnsafeModule` constructor This commit adds the `DriverCannotImportUnsafeModule` constructor to the `DriverMessage` type, and later using it to replace one usage of `DriverUnknownMessage` in the `GHC.Driver.Main` module. * Add and use `DriverMissingSafeHaskellMode` constructor * Add and use `DriverPackageNotTrusted` constructor * Introduce and use `DriverInferredSafeModule` constructor * Add and use `DriverMarkedTrustworthyButInferredSafe` constructor * Add and use `DriverCannotImportFromUntrustedPackage` - - - - - de262930 by Peter Trommler at 2021-07-29T13:12:10-04:00 Delete ToDo about incorrect optimisation [skip ci] On big-endian systems a narrow after a load cannot be replaced with a narrow load. - - - - - 296ed739 by Daniel Gröber at 2021-07-29T13:12:47-04:00 rts: Allow building with ASSERTs on in non-DEBUG way We have a couple of places where the conditions in asserts depend on code ifdefed out when DEBUG is off. I'd like to allow compiling assertions into non-DEBUG RTSen so that won't do. Currently if we remove the conditional around the definition of ASSERT() the build will not actually work due to a deadlock caused by initMutex not initializing mutexes with PTHREAD_MUTEX_ERRORCHECK because DEBUG is off. - - - - - e6731578 by Daniel Gröber at 2021-07-29T13:12:47-04:00 Add configure flag to enable ASSERTs in all ways Running the test suite with asserts enabled is somewhat tricky at the moment as running it with a GHC compiled the DEBUG way has some hundred failures from the start. These seem to be unrelated to assertions though. So this provides a toggle to make it easier to debug failing assertions using the test suite. - - - - - 4d5b4ed2 by Ben Gamari at 2021-07-29T13:13:21-04:00 compiler: Name generated locals more descriptively Previously `GHC.Types.Id.Make.newLocal` would name all locals `dt`, making it unnecessarily difficult to determine their origin. Noticed while looking at #19557. - - - - - 20173629 by Sergei Trofimovich at 2021-07-29T13:13:59-04:00 UNREG: implement 64-bit mach ops for 32-bit targets Noticed build failures like ``` ghc-stage1: panic! (the 'impossible' happened) GHC version 9.3.20210721: pprCallishMachOp_for_C: MO_x64_Ne not supported! ``` on `--tagget=hppa2.0-unknown-linux-gnu`. The change does not fix all 32-bit unreg target problems, but at least allows linking final ghc binaries. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 9b916e81 by Matthew Pickering at 2021-07-29T13:14:33-04:00 Add test for #18567 Closes #18567 - - - - - f4aea1a2 by Krzysztof Gogolewski at 2021-07-29T13:15:09-04:00 Reject pattern synonyms with linear types (#18806) - - - - - 54d6b201 by Shayne Fletcher at 2021-07-29T13:15:43-04:00 Improve preprocessor error message - - - - - 266a7452 by Ben Gamari at 2021-08-02T04:10:18-04:00 ghc: Introduce --run mode As described in #18011, this mode provides similar functionality to the `runhaskell` command, but doesn't require that the user know the path of yet another executable, simplifying interactions with upstream tools. - - - - - 7e8c578e by Simon Jakobi at 2021-08-02T04:10:52-04:00 base: Document overflow behaviour of genericLength - - - - - b4d39adb by Peter Trommler at 2021-08-02T04:11:27-04:00 PrimOps: Add CAS op for all int sizes PPC NCG: Implement CAS inline for 32 and 64 bit testsuite: Add tests for smaller atomic CAS X86 NCG: Catch calls to CAS C fallback Primops: Add atomicCasWord[8|16|32|64]Addr# Add tests for atomicCasWord[8|16|32|64]Addr# Add changelog entry for new primops X86 NCG: Fix MO-Cmpxchg W64 on 32-bit arch ghc-prim: 64-bit CAS C fallback on all archs - - - - - a4ca6caa by Baldur Blöndal at 2021-08-02T04:12:04-04:00 Add Generically (generic Semigroup, Monoid instances) and Generically1 (generic Functor, Applicative, Alternative, Eq1, Ord1 instances) to GHC.Generics. - - - - - 2114a8ac by Julian Ospald at 2021-08-02T04:12:41-04:00 Improve documentation of openTempFile args https://docs.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-gettempfilenamew Specifically: > The null-terminated prefix string. The function uses up to the first > three characters of this string as the prefix of the file name. This > string must consist of characters in the OEM-defined character set. - - - - - 4ae1e53c by Sylvain Henry at 2021-08-02T04:12:41-04:00 Fix spelling - - - - - 022c7945 by Moritz Angermann at 2021-08-02T04:13:15-04:00 [AArch64/Darwin] fix packed calling conv alignment Apparently we need some padding as well. Fixes #20137 - - - - - 2de8f031 by Ben Gamari at 2021-08-02T04:13:15-04:00 testsuite: Add test for #20137 - - - - - 2e0f4ca1 by Adam Sandberg Ericsson at 2021-08-02T04:13:50-04:00 docs: rename the "Running a compiled program" section in the users guide This hopefully makes it easier to find the right section when scanning the table of contents. - - - - - f454c0ea by Ben Gamari at 2021-08-02T04:14:25-04:00 rts/OSThreads: Fix reference clock of timedWaitCondition Previously `timedWaitCondition` assumed that timeouts were referenced against `CLOCK_MONOTONIC`. This is wrong; by default `pthread_cond_timedwait` references against `CLOCK_REALTIME`, although this can be overridden using `pthread_condattr_setclock`. Fix this and add support for using `CLOCK_MONOTONIC` whenever possible as it is more robust against system time changes and is likely cheaper to query. Unfortunately, this is complicated by the fact that older versions of Darwin did not provide `clock_gettime`, which means we also need to introduce a fallback path using `gettimeofday`. Fixes #20144. - - - - - 7bad93a2 by Sylvain Henry at 2021-08-02T04:15:03-04:00 Only create callstack in DEBUG builds - - - - - 3968cd0c by Sylvain Henry at 2021-08-02T04:15:41-04:00 Constant-fold unpackAppendCString (fix #20174) Minor renaming: since 1ed0409010afeaa318676e351b833aea659bf93a rules get an InScopeEnv arg (containing an IdUnfoldingFun) instead of an IdUnfoldingFun directly, hence I've renamed the parameter from "id_unf" to "env" for clarity. - - - - - 901c79d8 by Sylvain Henry at 2021-08-02T04:15:41-04:00 Lookup string literals in top-level thunks (fix #16373) - - - - - 3e93a370 by Ben Gamari at 2021-08-02T04:16:16-04:00 validate: Look for python3 executable in python detection Previously we would only look for a `python` executable, but in general we should prefer `python3` and sometimes `python` doesn't exist. - - - - - 8631ccf2 by Krzysztof Gogolewski at 2021-08-02T04:16:51-04:00 Remove Semigroup instance for UniqDFM (#19654) The (<>) operator was not associative. Fortunately, the instance is not used anywhere, except to derive another unused instance for UniqDSet. - - - - - 20ef67a3 by Ben Gamari at 2021-08-02T04:17:26-04:00 hadrian: Drop --configure support Hadrian's `--configure` support has long been a point of contention. While it's convenient, it also introduces a fair bit of implementation complexity and quite a few non-trivial failure modes (see #19804, 17883, and #15948). Moreover, the feature is actively misleading to the user: `./configure` is the primary means for the user to inform the build system about the system environment and in general will require input from the user. This commits removes the feature, replacing the flag with a stub message informing the user of the deprecation. Closes #20167. - - - - - 13af2fee by Krzysztof Gogolewski at 2021-08-02T04:18:00-04:00 Disallow nonlinear fields in Template Haskell (#18378) - - - - - e1538184 by Shayne Fletcher at 2021-08-02T04:18:35-04:00 Supply missing case for '.' in - - - - - 34e35217 by Simon Peyton Jones at 2021-08-02T04:19:09-04:00 Catch type-checker exceptions when splicing In GHC.Tc.Gen.Splice.tcTopSpliceExpr we were forgetting to catch exceptions. As a result we missed the kind error in the unsolved constraints. This patch has an easy fix, which cures #20179 - - - - - c248e7cc by Jens Petersen at 2021-08-03T10:14:36-04:00 include README in hadrian.cabal [skip ci] - - - - - bbee89dd by Zubin Duggal at 2021-08-03T10:15:11-04:00 Remove hschooks.c and -no-hs-main for ghc-bin - - - - - 9807350a by Zubin Duggal at 2021-08-03T10:15:11-04:00 Properly escape arguments in ghc-cabal - - - - - d22ec8a9 by Ben Gamari at 2021-08-03T10:15:46-04:00 Bump process submodule - - - - - 694ec53b by Matthew Pickering at 2021-08-03T10:16:20-04:00 Remove eager forcing of RuleInfo in substRuleInfo substRuleInfo updates the IdInfo for an Id, therefore it is important to not force said IdInfo whilst updating it, otherwise we end up in an infinite loop. This is what happened in #20112 where `mkTick` forced the IdInfo being updated by checking the arity in isSaturatedConApp. The fix is to stop the expression being forced so early by removing the call to seqRuleInfo. The call sequence looked something like: * `substRecBndrs` * `substIdBndr` * `substIdInfo` * `substRuleInfo` * `substRule` * `substExpr` * `mkTick` * `isSaturatedConApp` * Look at `IdInfo` for thing we are currently substituting because the rule is attached to `transpose` and mentions it in the `RHS` of the rule. Which arose because the `transpose` Id had a rule attached where the RHS of the rule also mentioned `transpose`. This call to seqRuleInfo was introduced in 4e7d56fde0f44d38bbb9a6fc72cf9c603264899d where it was explained > I think there are now *too many* seqs, and they waste work, but I don't have > time to find which ones. We also observe that there is the ominous note on `substRule` about making sure substExpr is called lazily. > {- Note [Substitute lazily] > ~~~~~~~~~~~~~~~~~~~~~~~~~~~ > The functions that substitute over IdInfo must be pretty lazy, because > they are knot-tied by substRecBndrs. > > One case in point was #10627 in which a rule for a function 'f' > referred to 'f' (at a different type) on the RHS. But instead of just > substituting in the rhs of the rule, we were calling simpleOptExpr, which > looked at the idInfo for 'f'; result <<loop>>. > > In any case we don't need to optimise the RHS of rules, or unfoldings, > because the simplifier will do that. Before `seqRuleInfo` was removed, this note was pretty much ignored in the `substSpec` case because the expression was immediately forced after `substRule` was called. Unfortunately it's a bit tricky to add a test for this as the failure only manifested (for an unknown reason) with a dwarf enabled compiler *AND* compiling with -g3. Fortunatley there is currently a CI configuration which builds a dwarf compiler to test this. Also, for good measure, finish off the work started in 840df33685e8c746ade4b9d4d0eb7c764a773e48 which renamed SpecInfo to RuleInfo but then didn't rename 'substSpec' to 'substRuleInfo'. Fixes #20112 - - - - - c0e66524 by Krzysztof Gogolewski at 2021-08-03T10:16:55-04:00 Add "fast-ci" label, for skipping most builds (#19280) If "fast-ci" is present, only the following parts of full-build are run: - validate-x86_64-linux-deb9-debug - validate-x86_64-windows-hadrian - validate-x86_64-linux-deb9-unreg-hadrian - - - - - bd287400 by Andreas Klebinger at 2021-08-03T10:17:29-04:00 Improve documentation for HscTypes.usg_mod_hash - - - - - 5155eafa by Zubin Duggal at 2021-08-03T10:18:04-04:00 Handle OverloadedRecordDot in TH (#20185) - - - - - 9744c6f5 by Tito Sacchi at 2021-08-03T17:19:14-04:00 Correctly unload libs on GHCi with external iserv Fix #17669 `hostIsDynamic` is basically a compile-time constant embedded in the RTS. Therefore, GHCi didn't unload object files properly when used with an external interpreter built in a different way. - - - - - 3403c028 by Luite Stegeman at 2021-08-03T17:19:51-04:00 move bytecode preparation into the STG pipeline this makes it possible to combine passes to compute free variables more efficiently in a future change - - - - - 6ad25367 by Sylvain Henry at 2021-08-03T17:20:29-04:00 Fix ASSERTS_ENABLED CPP - - - - - 4f672677 by Sylvain Henry at 2021-08-03T17:21:07-04:00 Don't store tmpDir in Settings There was no point in doing this as indicated by the TODO. - - - - - 2c714f07 by Krzysztof Gogolewski at 2021-08-04T01:33:03-04:00 Disable -fdefer-type-errors for linear types (#20083) - - - - - 9b719549 by Krzysztof Gogolewski at 2021-08-04T01:33:38-04:00 Linear types: fix linting of multiplicities (#19165) The previous version did not substitute the type used in the scrutinee. - - - - - 1b6e646e by John Ericson at 2021-08-04T10:05:52-04:00 Make HsWrapper a Monoid See instance documentation for caviat. - - - - - ce7eeda5 by Matthew Pickering at 2021-08-04T10:06:26-04:00 hadrian: Create relative rather than absolute symlinks in binary dist folder The symlink structure now looks like: ``` lrwxrwxrwx 1 matt users 16 Aug 3 16:27 _build/bindist/ghc-9.3.20210721-x86_64-unknown-linux/bin/ghc -> ghc-9.3.20210721 -rwxr-xr-x 1 matt users 1750336 Aug 3 15:00 _build/bindist/ghc-9.3.20210721-x86_64-unknown-linux/bin/ghc-9.3.20210721 lrwxrwxrwx 1 matt users 22 Aug 3 16:27 _build/bindist/ghc-9.3.20210721-x86_64-unknown-linux/bin/ghc-iserv -> ghc-iserv-9.3.20210721 -rwxr-xr-x 1 matt users 31703176 Aug 3 15:00 _build/bindist/ghc-9.3.20210721-x86_64-unknown-linux/bin/ghc-iserv-9.3.20210721 lrwxrwxrwx 1 matt users 26 Aug 3 16:27 _build/bindist/ghc-9.3.20210721-x86_64-unknown-linux/bin/ghc-iserv-dyn -> ghc-iserv-dyn-9.3.20210721 -rwxr-xr-x 1 matt users 40808 Aug 3 15:00 _build/bindist/ghc-9.3.20210721-x86_64-unknown-linux/bin/ghc-iserv-dyn-9.3.20210721 lrwxrwxrwx 1 matt users 20 Aug 3 16:27 _build/bindist/ghc-9.3.20210721-x86_64-unknown-linux/bin/ghc-pkg -> ghc-pkg-9.3.20210721 -rwxr-xr-x 1 matt users 634872 Aug 3 15:00 _build/bindist/ghc-9.3.20210721-x86_64-unknown-linux/bin/ghc-pkg-9.3.20210721 lrwxrwxrwx 1 matt users 14 Aug 3 16:27 _build/bindist/ghc-9.3.20210721-x86_64-unknown-linux/bin/haddock -> haddock-2.24.0 -rwxr-xr-x 1 matt users 4336664 Aug 3 15:00 _build/bindist/ghc-9.3.20210721-x86_64-unknown-linux/bin/haddock-2.24.0 lrwxrwxrwx 1 matt users 9 Aug 3 16:27 _build/bindist/ghc-9.3.20210721-x86_64-unknown-linux/bin/hp2ps -> hp2ps-0.1 -rwxr-xr-x 1 matt users 49312 Aug 3 15:00 _build/bindist/ghc-9.3.20210721-x86_64-unknown-linux/bin/hp2ps-0.1 lrwxrwxrwx 1 matt users 8 Aug 3 16:27 _build/bindist/ghc-9.3.20210721-x86_64-unknown-linux/bin/hpc -> hpc-0.68 -rwxr-xr-x 1 matt users 687896 Aug 3 15:00 _build/bindist/ghc-9.3.20210721-x86_64-unknown-linux/bin/hpc-0.68 lrwxrwxrwx 1 matt users 13 Aug 3 16:27 _build/bindist/ghc-9.3.20210721-x86_64-unknown-linux/bin/hsc2hs -> hsc2hs-0.68.8 -rwxr-xr-x 1 matt users 729904 Aug 3 15:00 _build/bindist/ghc-9.3.20210721-x86_64-unknown-linux/bin/hsc2hs-0.68.8 lrwxrwxrwx 1 matt users 19 Aug 3 16:27 _build/bindist/ghc-9.3.20210721-x86_64-unknown-linux/bin/runghc -> runghc-9.3.20210721 -rwxr-xr-x 1 matt users 57672 Aug 3 15:00 _build/bindist/ghc-9.3.20210721-x86_64-unknown-linux/bin/runghc-9.3.20210721 lrwxrwxrwx 1 matt users 9 Aug 3 16:27 _build/bindist/ghc-9.3.20210721-x86_64-unknown-linux/bin/unlit -> unlit-0.1 -rwxr-xr-x 1 matt users 14896 Aug 3 15:00 _build/bindist/ghc-9.3.20210721-x86_64-unknown-linux/bin/unlit-0.1 ``` Fixes #20198 - - - - - 477bc2dd by Zubin Duggal at 2021-08-04T16:38:02-04:00 Fix GHCi completion (#20101) Updates haskeline submodule - - - - - 7a9d8803 by sheaf at 2021-08-04T16:38:40-04:00 Use Reductions to keep track of rewritings We define Reduction = Reduction Coercion !Type. A reduction of the form 'Reduction co new_ty' witnesses an equality ty ~co~> new_ty. That is, the rewriting happens left-to-right: the right-hand-side type of the coercion is the rewritten type, and the left-hand-side type the original type. Sticking to this convention makes the codebase more consistent, helping to avoid certain applications of SymCo. This replaces the parts of the codebase which represented reductions as pairs, (Coercion,Type) or (Type,Coercion). Reduction being strict in the Type argument improves performance in some programs that rewrite many type families (such as T9872). Fixes #20161 ------------------------- Metric Decrease: T5321Fun T9872a T9872b T9872c T9872d ------------------------- - - - - - 1f809093 by Bodigrim at 2021-08-05T07:14:04-04:00 Add Data.ByteArray, derived from primitive - - - - - 5d651c78 by Krzysztof Gogolewski at 2021-08-05T07:14:39-04:00 Minor fix to pretty-printing of linear types The function ppr_arrow_chain was not printing multiplicities. Also remove the Outputable instance: no longer used, and could cover bugs like those. - - - - - fb45e632 by Viktor Dukhovni at 2021-08-08T13:53:00-04:00 Rewrite of Traversable overview - - - - - 2bf417f6 by Viktor Dukhovni at 2021-08-08T13:53:00-04:00 Consistent use of coercion and TypeApplications This makes the implementations of: - mapAccumL - mapAccumR - fmapDefault - foldMapDefault more uniform and match the approach in the overview. - - - - - cf7e6c8d by Ben Gamari at 2021-08-09T08:10:11-04:00 testsuite: Add test for #20199 Ensures that Rts.h can be parsed as C++. - - - - - 080ffd4b by Ben Gamari at 2021-08-09T08:10:11-04:00 rts: Fix use of sized array in Heap.h Sized arrays cannot be used in headers that might be imported from C++. Fixes #20199. - - - - - b128a880 by Sylvain Henry at 2021-08-09T15:11:22-04:00 Ensure that newtype deriving strategy is used for CTypes - - - - - 74863638 by Sylvain Henry at 2021-08-09T15:11:23-04:00 Remove ad-hoc fromIntegral rules fromIntegral is defined as: {-# NOINLINE [1] fromIntegral #-} fromIntegral :: (Integral a, Num b) => a -> b fromIntegral = fromInteger . toInteger Before this patch, we had a lot of rewrite rules for fromIntegral, to avoid passing through Integer when there is a faster way, e.g.: "fromIntegral/Int->Word" fromIntegral = \(I# x#) -> W# (int2Word# x#) "fromIntegral/Word->Int" fromIntegral = \(W# x#) -> I# (word2Int# x#) "fromIntegral/Word->Word" fromIntegral = id :: Word -> Word Since we have added sized types and primops (Word8#, Int16#, etc.) and Natural, this approach didn't really scale as there is a combinatorial explosion of types. In addition, we really want these conversions to be optimized for all these types and in every case (not only when fromIntegral is explicitly used). This patch removes all those ad-hoc fromIntegral rules. Instead we rely on inlining and built-in constant-folding rules. There are not too many native conversions between Integer/Natural and fixed size types, so we can handle them all explicitly. Foreign.C.Types was using rules to ensure that fromIntegral rules "sees" through the newtype wrappers,e.g.: {-# RULES "fromIntegral/a->CSize" fromIntegral = \x -> CSize (fromIntegral x) "fromIntegral/CSize->a" fromIntegral = \(CSize x) -> fromIntegral x #-} But they aren't necessary because coercions due to newtype deriving are pushed out of the way. So this patch removes these rules (as fromIntegral is now inlined, they won't match anymore anyway). Summary: * INLINE `fromIntegral` * Add some missing constant-folding rules * Remove every fromIntegral ad-hoc rules (fix #19907) Fix #20062 (missing fromIntegral rules for sized primitives) Performance: - T12545 wiggles (tracked by #19414) Metric Decrease: T12545 T10359 Metric Increase: T12545 - - - - - db7098fe by John Ericson at 2021-08-09T15:11:58-04:00 Clean up whitespace in /includes I need to do this now or when I move these files the linter will be mad. - - - - - fc350dba by John Ericson at 2021-08-09T15:11:58-04:00 Make `PosixSource.h` installed and under `rts/` is used outside of the rts so we do this rather than just fish it out of the repo in ad-hoc way, in order to make packages in this repo more self-contained. - - - - - d5de970d by John Ericson at 2021-08-09T15:11:58-04:00 Move `/includes` to `/rts/include`, sort per package better In order to make the packages in this repo "reinstallable", we need to associate source code with a specific packages. Having a top level `/includes` dir that mixes concerns (which packages' includes?) gets in the way of this. To start, I have moved everything to `rts/`, which is mostly correct. There are a few things however that really don't belong in the rts (like the generated constants haskell type, `CodeGen.Platform.h`). Those needed to be manually adjusted. Things of note: - No symlinking for sake of windows, so we hard-link at configure time. - `CodeGen.Platform.h` no longer as `.hs` extension (in addition to being moved to `compiler/`) so as not to confuse anyone, since it is next to Haskell files. - Blanket `-Iincludes` is gone in both build systems, include paths now more strictly respect per-package dependencies. - `deriveConstants` has been taught to not require a `--target-os` flag when generating the platform-agnostic Haskell type. Make takes advantage of this, but Hadrian has yet to. - - - - - 8b9acc4d by Sylvain Henry at 2021-08-09T15:12:36-04:00 Hadrian: fix .cabal file `stack sdist` in the hadrian directory reported: Package check reported the following errors: To use the 'extra-doc-files' field the package needs to specify at least 'cabal-version: >= 1.18'. - - - - - 741fdf0e by David Simmons-Duffin at 2021-08-10T15:00:05-04:00 Add a Typeable constraint to fromStaticPtr, addressing #19729 - - - - - 130f94db by Artyom Kuznetsov at 2021-08-10T15:00:42-04:00 Refactor HsStmtContext and remove HsDoRn Parts of HsStmtContext were split into a separate data structure HsDoFlavour. Before this change HsDo used to have HsStmtContext inside, but in reality only parts of HsStmtContext were used and other cases were invariants handled with panics. Separating those parts into its own data structure helps us to get rid of those panics as well as HsDoRn type family. - - - - - 92b0037b by Sylvain Henry at 2021-08-10T15:01:20-04:00 Fix recomp021 locale `diff` uses the locale to print its message. - - - - - 7bff8bf5 by Sylvain Henry at 2021-08-10T15:01:58-04:00 Fix pprDeps Copy-paste error in 38faeea1a94072ffd9f459d9fe570f06bc1da84a - - - - - c65a7ffa by Moritz Angermann at 2021-08-11T06:49:38+00:00 Update HACKING.md - - - - - f5fdace5 by Sven Tennie at 2021-08-11T18:14:30-04:00 Optimize Info Table Provenance Entries (IPEs) Map creation and lookup Using a hash map reduces the complexity of lookupIPE(), making it non linear. On registration each IPE list is added to a temporary IPE lists buffer, reducing registration time. The hash map is built lazily on first lookup. IPE event output to stderr is added with tests. For details, please see Note [The Info Table Provenance Entry (IPE) Map]. A performance test for IPE registration and lookup can be found here: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/5724#note_370806 - - - - - 100ffe75 by Alina Banerjee at 2021-08-11T18:15:05-04:00 Modify InlineSpec data constructor (helps fix #18138) The inl_inline field of the InlinePragma record is modified to store pragma source text by adding a data constructor of type SourceText. This can help in tracking the actual text of pragma names. Add/modify functions, modify type instance for InlineSpec type Modify parser, lexer to handle InlineSpec constructors containing SourceText Modify functions with InlineSpec type Extract pragma source from InlineSpec for SpecSig, InlineSig types Modify cvtInline function to add SourceText to InlineSpec type Extract name for InlineSig, SpecSig from pragma, SpectInstSig from source (fixes #18138) Extract pragma name for SpecPrag pragma, SpecSig signature Add Haddock annotation for inlinePragmaName function Add Haddock annotations for using helper functions in hsSigDoc Remove redundant ppr in pragma name for SpecSig, InlineSig; update comment Rename test to T18138 for misplaced SPECIALIZE pragma testcase - - - - - 7ad813a4 by Dr. ERDI Gergo at 2021-08-13T07:53:53-04:00 Move `ol_witness` to `OverLitTc` We also add a new `ol_from_fun` field to renamed (but not yet typechecked) OverLits. This has the nice knock-on effect of making total some typechecker functions that used to be partial. Fixes #20151 - - - - - c367b39e by Sylvain Henry at 2021-08-13T07:54:32-04:00 Refactoring module dependencies * Make mkDependencies pure * Use Sets instead of sorted lists Notable perf changes: MultiLayerModules(normal) ghc/alloc 4130851520.0 2981473072.0 -27.8% T13719(normal) ghc/alloc 4313296052.0 4151647512.0 -3.7% Metric Decrease: MultiLayerModules T13719 - - - - - 9d4ba36f by sheaf at 2021-08-13T14:40:16+02:00 Add rewriting to typechecking plugins Type-checking plugins can now directly rewrite type-families. The TcPlugin record is given a new field, tcPluginRewrite. The plugin specifies how to rewrite certain type-families with a value of type `UniqFM TyCon TcPluginRewriter`, where: type TcPluginRewriter = RewriteEnv -- Rewriter environment -> [Ct] -- Givens -> [TcType] -- type family arguments -> TcPluginM TcPluginRewriteResult data TcPluginRewriteResult = TcPluginNoRewrite | TcPluginRewriteTo { tcPluginRewriteTo :: Reduction , tcRewriterNewWanteds :: [Ct] } When rewriting an exactly-saturated type-family application, GHC will first query type-checking plugins for possible rewritings before proceeding. Includes some changes to the TcPlugin API, e.g. removal of the EvBindsVar parameter to the TcPluginM monad. - - - - - 0bf8e73a by Matthew Pickering at 2021-08-13T21:47:26-04:00 Revert "hadrian: Make copyFileLinked a bit more robust" This reverts commit d45e3cda669c5822aa213d42bf7f7c551b9d1bbf. - - - - - 9700b9a8 by Matthew Pickering at 2021-08-13T21:47:26-04:00 Create absolute symlink for test executables This is necessary because the symlink needs to be created between two arbritary filepaths in the build tree, it's hard to compute how to get between them relatively. As this symlink doesn't end up in a bindist then it's fine for it to be absolute. - - - - - a975583c by Matthew Pickering at 2021-08-13T21:48:03-04:00 hadrian: Also produce versioned wrapper scripts Since !6133 we are more consistent about producing versioned executables but we still didn't produce versioned wrappers. This patch adds the corresponding versioned wrappers to match the versioned executables in the relocatable bindist. I also fixed the ghci wrapper so that it wasn't overwritten during installation. The final bindir looks like: ``` lrwxrwxrwx 1 matt users 16 Aug 12 11:56 ghc -> ghc-9.3.20210809 -rwxr-xr-x 1 matt users 674 Aug 12 11:56 ghc-9.3.20210809 lrwxrwxrwx 1 matt users 17 Aug 12 11:56 ghci -> ghci-9.3.20210809 -rwxr-xr-x 1 matt users 708 Aug 12 11:56 ghci-9.3.20210809 lrwxrwxrwx 1 matt users 20 Aug 12 11:56 ghc-pkg -> ghc-pkg-9.3.20210809 -rwxr-xr-x 1 matt users 734 Aug 12 11:56 ghc-pkg-9.3.20210809 lrwxrwxrwx 1 matt users 14 Aug 12 11:56 haddock -> haddock-2.24.0 -rwxr-xr-x 1 matt users 682 Aug 12 11:56 haddock-2.24.0 lrwxrwxrwx 1 matt users 9 Aug 12 11:56 hp2ps -> hp2ps-0.1 -rwxr-xr-x 1 matt users 648 Aug 12 11:56 hp2ps-0.1 lrwxrwxrwx 1 matt users 8 Aug 12 11:56 hpc -> hpc-0.68 -rwxr-xr-x 1 matt users 646 Aug 12 11:56 hpc-0.68 lrwxrwxrwx 1 matt users 13 Aug 12 11:56 hsc2hs -> hsc2hs-0.68.8 -rwxr-xr-x 1 matt users 1.4K Aug 12 11:56 hsc2hs-0.68.8 lrwxrwxrwx 1 matt users 19 Aug 12 11:56 runghc -> runghc-9.3.20210809 -rwxr-xr-x 1 matt users 685 Aug 12 11:56 runghc-9.3.20210809 ``` Fixes #20225 - - - - - 1e896b47 by sheaf at 2021-08-15T09:00:29-04:00 Detect TypeError when checking for insolubility We detect insoluble Givens by making getInertInsols take into account TypeError constraints, on top of insoluble equalities such as Int ~ Bool (which it already took into account). This allows pattern matches with insoluble contexts to be reported as redundant (tyOracle calls tcCheckGivens which calls getInertInsols). As a bonus, we get to remove a workaround in Data.Typeable.Internal: we can directly use a NotApplication type family, as opposed to needing to cook up an insoluble equality constraint. Fixes #11503 #14141 #16377 #20180 - - - - - 71130bf8 by sheaf at 2021-08-15T09:01:06-04:00 Update TcPlugin_RewritePerf performance test This test exhibited inconsistent behaviour, with different CI runs having a 98% decrease in allocations. This commit addresses this problem by ensuring that we measure allocations of the whole collection of modules used in the test. ------------------------- Metric Increase: TcPlugin_RewritePerf ------------------------- - - - - - 0f6fb7d3 by Simon Peyton Jones at 2021-08-15T14:18:52+01:00 TypeError is OK on the RHS of a type synonym We should not complain about TypeError in type T = TypeError blah This fixes #20181 The error message for T13271 changes, because that test did indeed have a type synonym with TypeError on the RHS - - - - - 149bce42 by Krzysztof Gogolewski at 2021-08-15T16:13:35-04:00 Fix lookupIdSubst call during RULE matching As #20200 showed, there was a call to lookupIdSubst during RULE matching, where the variable being looked up wasn't in the InScopeSet. This patch fixes the problem at source, by dealing separately with nested and non-nested binders. As a result we can change the trace call in lookupIdSubst to a proper panic -- if it happens, we really want to know. - - - - - 7f217429 by Simon Peyton Jones at 2021-08-15T16:13:35-04:00 Use the right InScopeSet for findBest This is the right thing to do, easy to do, and fixes a second not-in-scope crash in #20200 (see !6302) The problem occurs in the findBest test, which compares two RULES. Repro case in simplCore/should_compile/T20200a - - - - - 31dc013f by Greg Steuck at 2021-08-15T21:09:23+00:00 Fix iconv detection in configure on OpenBSD This regressed in 544414ba604b13e0992ad87e90b8bdf45c43011c causing configure: error: iconv is required on non-Windows platforms More details: https://gitlab.haskell.org/ghc/ghc/-/commit/544414ba604b13e0992ad87e90b8bdf45c43011c#3bae3b74ae866493bd6b79df16cb638a5f2e0f87_106_106 - - - - - acb188e0 by Matthew Pickering at 2021-08-17T08:05:34-04:00 ghci: Fix rec statements in interactive prompt We desugar a recursive Stmt to somethign like (a,_,c) <- mfix (\(a,b,_) -> do { ... ; return (a,b,c) }) ...stuff after the rec... The knot-tied tuple must contain * All the variables that are used before they are bound in the `rec` block * All the variables that are used after the entire `rec` block In the case of GHCi, however, we don't know what variables will be used after the `rec` (#20206). For example, we might have ghci> rec { x <- e1; y <- e2 } ghci> print x ghci> print y So we have to assume that *all* the variables bound in the `rec` are used afterwards. We use `Nothing` in the argument to segmentRecStmts to signal that all the variables are used. Fixes #20206 - - - - - b784a51e by John Ericson at 2021-08-17T20:58:33+00:00 Test non-native switch C-- with twos compliment We don't want regressions like e8f7734d8a052f99b03e1123466dc9f47b48c311 to regress. Co-Authored-By: Sylvain Henry <hsyl20 at gmail.com> - - - - - 5798357d by Sylvain Henry at 2021-08-17T21:01:44+00:00 StgToCmm: use correct bounds for switches on sized values StgToCmm was only using literals signedness to determine whether using Int and Word range in Cmm switches. Now that we have sized literals (Int8#, Int16#, etc.), it needs to take their ranges into account. - - - - - 0ba21dbe by Matthew Pickering at 2021-08-18T05:43:57-04:00 Fix parsing of rpaths which include spaces in runInjectRPaths The logic didn't account for the fact that the paths could contain spaces before which led to errors such as the following from install_name_tool. Stderr ( T14304 ): Warning: -rtsopts and -with-rtsopts have no effect with -shared. Call hs_init_ghc() from your main() function to set these options. error: /nix/store/a6j5761iy238pbckxq2xrhqr2d5kra4m-cctools-binutils-darwin-949.0.1/bin/install_name_tool: for: dist/build/libHSp-0.1-ghc8.10.6.dylib (for architecture arm64) option "-add_rpath /Users/matt/ghc/bindisttest/install dir/lib/ghc-8.10.6/ghc-prim-0.6.1" would duplicate path, file already has LC_RPATH for: /Users/matt/ghc/bindisttest/install dir/lib/ghc-8.10.6/ghc-prim-0.6.1 `install_name_tool' failed in phase `Install Name Tool'. (Exit code: 1) Fixes #20212 This apparently also fixes #20026, which is a nice surprise. - - - - - 5f0d2dab by Matthew Pickering at 2021-08-18T17:57:42-04:00 Driver rework pt3: the upsweep This patch specifies and simplifies the module cycle compilation in upsweep. How things work are described in the Note [Upsweep] Note [Upsweep] ~~~~~~~~~~~~~~ Upsweep takes a 'ModuleGraph' as input, computes a build plan and then executes the plan in order to compile the project. The first step is computing the build plan from a 'ModuleGraph'. The output of this step is a `[BuildPlan]`, which is a topologically sorted plan for how to build all the modules. ``` data BuildPlan = SingleModule ModuleGraphNode -- A simple, single module all alone but *might* have an hs-boot file which isn't part of a cycle | ResolvedCycle [ModuleGraphNode] -- A resolved cycle, linearised by hs-boot files | UnresolvedCycle [ModuleGraphNode] -- An actual cycle, which wasn't resolved by hs-boot files ``` The plan is computed in two steps: Step 1: Topologically sort the module graph without hs-boot files. This returns a [SCC ModuleGraphNode] which contains cycles. Step 2: For each cycle, topologically sort the modules in the cycle *with* the relevant hs-boot files. This should result in an acyclic build plan if the hs-boot files are sufficient to resolve the cycle. The `[BuildPlan]` is then interpreted by the `interpretBuildPlan` function. * `SingleModule nodes` are compiled normally by either the upsweep_inst or upsweep_mod functions. * `ResolvedCycles` need to compiled "together" so that the information which ends up in the interface files at the end is accurate (and doesn't contain temporary information from the hs-boot files.) - During the initial compilation, a `KnotVars` is created which stores an IORef TypeEnv for each module of the loop. These IORefs are gradually updated as the loop completes and provide the required laziness to typecheck the module loop. - At the end of typechecking, all the interface files are typechecked again in the retypecheck loop. This time, the knot-tying is done by the normal laziness based tying, so the environment is run without the KnotVars. * UnresolvedCycles are indicative of a proper cycle, unresolved by hs-boot files and are reported as an error to the user. The main trickiness of `interpretBuildPlan` is deciding which version of a dependency is visible from each module. For modules which are not in a cycle, there is just one version of a module, so that is always used. For modules in a cycle, there are two versions of 'HomeModInfo'. 1. Internal to loop: The version created whilst compiling the loop by upsweep_mod. 2. External to loop: The knot-tied version created by typecheckLoop. Whilst compiling a module inside the loop, we need to use the (1). For a module which is outside of the loop which depends on something from in the loop, the (2) version is used. As the plan is interpreted, which version of a HomeModInfo is visible is updated by updating a map held in a state monad. So after a loop has finished being compiled, the visible module is the one created by typecheckLoop and the internal version is not used again. This plan also ensures the most important invariant to do with module loops: > If you depend on anything within a module loop, before you can use the dependency, the whole loop has to finish compiling. The end result of `interpretBuildPlan` is a `[MakeAction]`, which are pairs of `IO a` actions and a `MVar (Maybe a)`, somewhere to put the result of running the action. This list is topologically sorted, so can be run in order to compute the whole graph. As well as this `interpretBuildPlan` also outputs an `IO [Maybe (Maybe HomeModInfo)]` which can be queried at the end to get the result of all modules at the end, with their proper visibility. For example, if any module in a loop fails then all modules in that loop will report as failed because the visible node at the end will be the result of retypechecking those modules together. Along the way we also fix a number of other bugs in the driver: * Unify upsweep and parUpsweep. * Fix #19937 (static points, ghci and -j) * Adds lots of module loop tests due to Divam. Also related to #20030 Co-authored-by: Divam Narula <dfordivam at gmail.com> ------------------------- Metric Decrease: T10370 ------------------------- - - - - - d9cf2ec8 by Matthew Pickering at 2021-08-18T17:57:42-04:00 recomp: Check backend type rather than -fwrite-interface to decide whether we need any objects This was a small oversight in the original patch which leads to spurious recompilation when using `-fno-code` but not `-fwrite-interface`, which you plausibly might do when using ghci. Fixes #20216 - - - - - 4a10f0ff by sheaf at 2021-08-18T17:58:19-04:00 Don't look for TypeError in type family arguments Changes checkUserTypeError to no longer look for custom type errors inside type family arguments. This means that a program such as foo :: F xyz (TypeError (Text "blah")) -> bar does not throw a type error at definition site. This means that more programs can be accepted, as the custom type error might disappear upon reducing the above type family F. This applies only to user-written type signatures, which are checked within checkValidType. Custom type errors in type family arguments continue to be reported when they occur in unsolved Wanted constraints. Fixes #20241 - - - - - cad5a141 by Viktor Dukhovni at 2021-08-19T01:19:29-04:00 Fix missing can_fail annotation on two CAS primops Also note why has_side_effects is needed with reads of mutable data, using text provided by Simon Peyton-Jones. - - - - - 4ff4d434 by Simon Peyton Jones at 2021-08-19T01:20:03-04:00 Get the in-scope set right during RULE matching There was a subtle error in the in-scope set during RULE matching, which led to #20200 (not the original report, but the reports of failures following an initial bug-fix commit). This patch fixes the problem, and simplifies the code a bit. In pariticular there was a very mysterious and ad-hoc in-scope set extension in rnMatchBndr2, which is now moved to the right place, namely in the Let case of match, where we do the floating. I don't have a small repro case, alas. - - - - - d43442cb by John Ericson at 2021-08-19T18:02:13-04:00 Make Int64#/Word64# unconditionally available This prepares us to actually use them when the native size is 64 bits too. I more than saitisfied my curiosity finding they were gated since 47774449c9d66b768a70851fe82c5222c1f60689. - - - - - ad28ae41 by Matthew Pickering at 2021-08-19T18:02:48-04:00 Add -Wl,-U,___darwin_check_fd_set_overflow to rts/package.conf.in The make build system apparently uses this special package.conf rather than generating it from the cabal file. Ticket: #19950 (cherry picked from commit e316a0f3e7a733fac0c30633767487db086c4cd0) - - - - - 69fb6f6a by Ben Gamari at 2021-08-23T13:33:41-04:00 users guide: Document -hpcdir flag Previously this was undocumented. - - - - - 27c27f7d by Matthew Pickering at 2021-08-23T13:34:16-04:00 hadrian: Include runhaskell in bindist Fixes #19571 bin folder now containers/ ``` ghc ghc-iserv-dyn-9.3.20210813 hp2ps hsc2hs-0.68.8 unlit ghc-9.3.20210813 ghc-pkg hp2ps-0.1 runghc unlit-0.1 ghc-iserv ghc-pkg-9.3.20210813 hpc runghc-9.3.20210813 ghc-iserv-9.3.20210813 haddock hpc-0.68 runhaskell ghc-iserv-dyn haddock-2.24.0 hsc2hs runhaskell-9.3.20210813 ``` which installed via wrappers looks like ``` lrwxrwxrwx 1 matt users 16 Aug 13 17:32 ghc -> ghc-9.3.20210813 -rwxr-xr-x 1 matt users 446 Aug 13 17:32 ghc-9.3.20210813 lrwxrwxrwx 1 matt users 17 Aug 13 17:32 ghci -> ghci-9.3.20210813 -rwxr-xr-x 1 matt users 480 Aug 13 17:32 ghci-9.3.20210813 lrwxrwxrwx 1 matt users 20 Aug 13 17:32 ghc-pkg -> ghc-pkg-9.3.20210813 -rwxr-xr-x 1 matt users 506 Aug 13 17:32 ghc-pkg-9.3.20210813 lrwxrwxrwx 1 matt users 14 Aug 13 17:32 haddock -> haddock-2.24.0 -rwxr-xr-x 1 matt users 454 Aug 13 17:32 haddock-2.24.0 lrwxrwxrwx 1 matt users 9 Aug 13 17:32 hp2ps -> hp2ps-0.1 -rwxr-xr-x 1 matt users 420 Aug 13 17:32 hp2ps-0.1 lrwxrwxrwx 1 matt users 8 Aug 13 17:32 hpc -> hpc-0.68 -rwxr-xr-x 1 matt users 418 Aug 13 17:32 hpc-0.68 lrwxrwxrwx 1 matt users 13 Aug 13 17:32 hsc2hs -> hsc2hs-0.68.8 -rwxr-xr-x 1 matt users 1.2K Aug 13 17:32 hsc2hs-0.68.8 lrwxrwxrwx 1 matt users 19 Aug 13 17:32 runghc -> runghc-9.3.20210813 -rwxr-xr-x 1 matt users 457 Aug 13 17:32 runghc-9.3.20210813 lrwxrwxrwx 1 matt users 23 Aug 13 17:32 runhaskell -> runhaskell-9.3.20210813 -rwxr-xr-x 1 matt users 465 Aug 13 17:32 runhaskell-9.3.20210813 ``` - - - - - 7dde84ad by Matthew Pickering at 2021-08-23T13:34:16-04:00 hadrian: Write version wrappers in C rather than Haskell This reduces the resulting binary size on windows where the executables were statically linked. - - - - - 6af7d127 by Matthew Pickering at 2021-08-23T13:34:16-04:00 hadrian: Use ghc version as suffix for all executables ``` [matt at nixos:~/ghc-unique-spin]$ ls _build/bindist/ghc-9.3.20210813-x86_64-unknown-linux/bin/ ghc haddock runghc ghc-9.3.20210813 haddock-ghc-9.3.20210813 runghc-9.3.20210813 ghc-iserv hp2ps runhaskell ghc-iserv-dyn hp2ps-ghc-9.3.20210813 runhaskell-9.3.20210813 ghc-iserv-dyn-ghc-9.3.20210813 hpc unlit ghc-iserv-ghc-9.3.20210813 hpc-ghc-9.3.20210813 unlit-ghc-9.3.20210813 ghc-pkg hsc2hs ghc-pkg-9.3.20210813 hsc2hs-ghc-9.3.20210813 [matt at nixos:~/ghc-unique-spin]$ ls _build/bindist/ghc-9.3.20210813-x86_64-unknown-linux/wrappers/ ghc ghc-pkg-9.3.20210813 hpc runghc-9.3.20210813 ghc-9.3.20210813 haddock hpc-ghc-9.3.20210813 runhaskell ghci haddock-ghc-9.3.20210813 hsc2hs runhaskell-9.3.20210813 ghci-9.3.20210813 hp2ps hsc2hs-ghc-9.3.20210813 ghc-pkg hp2ps-ghc-9.3.20210813 runghc ``` See the discussion on #19571 where we decided that it was most sensible to use the same version number as a suffix for all executables. For those whose version number is different to normal (for example, haddock as it's own versioning scheme) the additional "ghc" suffix is used. Cabal already knows to look for this suffix so should work nicely with existing tooling. - - - - - 06aa8da5 by Sebastian Graf at 2021-08-23T13:34:51-04:00 Pmc: Better SCC annotations and trace output While investigating #20106, I made a few refactorings to the pattern-match checker that I don't want to lose. Here are the changes: * Some key functions of the checker now have SCC annotations * Better `-ddump-ec-trace` diagnostics for easier debugging. I added 'traceWhenFailPm' to see *why* a particular `MaybeT` computation fails and made use of it in `instCon`. I also increased the acceptance threshold of T11545, which seems to fail randomly lately due to ghc/max flukes. - - - - - c1acfd21 by Matthew Pickering at 2021-08-23T13:35:26-04:00 driver: Only check for unused package warning in after succesful downsweep Before we would check for the unused package warning even if the module graph was compromised due to an error in downsweep. This is easily fixed by pushing warmUnusedPackages into depanalE, and then returning the errors like the other downsweep errors. Fixes #20242 - - - - - f3892b5f by Krzysztof Gogolewski at 2021-08-23T13:36:00-04:00 Convert lookupIdSubst panic back to a warning (#20200) - - - - - c0407538 by Andreas Abel at 2021-08-23T13:36:38-04:00 Doc fix #20259: suggest bang patterns instead of case in hints.rst - - - - - d94e7ebd by Andreas Abel at 2021-08-23T13:37:15-04:00 Doc fix #20226: formatting issues in 9.2.1 release notes RST is brittle... - - - - - 8a939b40 by sheaf at 2021-08-23T23:39:15-04:00 TcPlugins: solve and report contras simultaneously This changes the TcPlugin datatype to allow type-checking plugins to report insoluble constraints while at the same time solve some other constraints. This allows better error messages, as the plugin can still simplify constraints, even when it wishes to report a contradiction. Pattern synonyms TcPluginContradiction and TcPluginOk are provided for backwards compatibility: existing type-checking plugins should continue to work without modification. - - - - - 03fc0393 by Matthew Pickering at 2021-08-23T23:39:49-04:00 driver: Correctly pass custom messenger to logging function This was an oversight from !6718 - - - - - 64696202 by Matthew Pickering at 2021-08-23T23:39:49-04:00 driver: Initialise common plugins once, before starting the pipeline This fixes an error message regression and is a slight performance improvement. See #20250 - - - - - 886ecd31 by Matthew Pickering at 2021-08-23T23:39:49-04:00 Add plugin-recomp-change-2 test This test tests that if there are two modules which use a plugin specified on the command line then both are recompiled when the plugin changes. - - - - - 31752b55 by Matthew Pickering at 2021-08-24T11:03:01-04:00 hadrian: Use cp -RP rather than -P in install to copy symlinks For some inexplicable reason `-P` only takes effect on the mac version of p when you also pass `-R`. > Symbolic links are always followed unless the -R flag is set, in which case symbolic > links are not followed, by default. > -P If the -R option is specified, no symbolic links are followed. This is the > default. Fixes #20254 - - - - - fdb2bfab by Fendor at 2021-08-24T11:03:38-04:00 Export PreloadUnitClosure as it is part of the public API - - - - - 71e8094d by Matthew Pickering at 2021-08-24T17:23:58+01:00 Fix colourised output in error messages This fixes a small mistake in 4dc681c7c0345ee8ae268749d98b419dabf6a3bc which forced the dump rather than user style for error messages. In particular, this change replaced `defaultUserStyle` with `log_default_dump_context` rather than `log_default_user_context` which meant the PprStyle was PprDump rather than PprUser for error messages. https://gitlab.haskell.org/ghc/ghc/-/commit/4dc681c7c0345ee8ae268749d98b419dabf6a3bc?expanded=1&page=4#b62120081f64009b94c12d04ded5c68870d8c647_285_405 Fixes #20276 - - - - - 0759c069 by Ryan Scott at 2021-08-25T19:35:12-04:00 Desugarer: Bring existentials in scope when substituting into record GADTs This fixes an outright bug in which the desugarer did not bring the existentially quantified type variables of a record GADT into `in_subst`'s in-scope set, leading to #20278. It also addresses a minor inefficiency in which `out_subst` was made into a substitution when a simpler `TvSubstEnv` would suffice. Fixes #20278. - - - - - b3653351 by Sebastian Graf at 2021-08-26T13:39:34-04:00 CallArity: Consider shadowing introduced by case and field binders In #20283, we saw a regression in `simple` due to CallArity for a very subtle reason: It simply didn't handle shadowing of case binders and constructor field binders! The test case T20283 has a very interesting binding `n_X1` that we want to eta-expand and that has a Unique (on GHC HEAD) that is reused by the Simplifier for a case binder: ``` let { n_X1 = ... } in ... let { lvl_s1Ul = ... case x_a1Rg of wild_X1 { __DEFAULT -> f_s1Tx rho_value_awA (GHC.Types.I# wild_X1); 0# -> lvl_s1TN } ... } in letrec { go3_X3 = \ (x_X4 :: GHC.Prim.Int#) (v_a1P9 [OS=OneShot] :: Double) -> let { karg_s1Wu = ... case lvl_s1Ul of { GHC.Types.D# y_a1Qf -> ... } } in case GHC.Prim.==# x_X4 y_a1R7 of { __DEFAULT -> go3_X3 (GHC.Prim.+# x_X4 1#) karg_s1Wu; 1# -> n_X1 karg_s1Wu -- Here we will assume that karg calls n_X1! }; } in go3_X3 0#; ``` Since the Case case of CallArity doesn't delete `X1` from the set of variables it is interested in knowing the usages of, we leak a very boring usage (of the case binder!) into the co-call graph that we mistakenly take for a usage of `n_X1`. We conclude that `lvl_s1Ul` and transitively `karg_s1Wu` call `n_X1` when really they don't. That culminates in the conclusion that `n_X1 karg_s1Wu` calls `n_X1` more than once. Wrong! Fortunately, this bug (which has been there right from CallArity's inception, I suppose) will never lead to a CallArity that is too optimistic. So by fixing this bug, we get strictly more opportunities for CallArity and all of them should be sound to exploit. Fixes #20283. - - - - - d551199c by Simon Peyton Jones at 2021-08-26T13:40:09-04:00 Fix GHC.Core.Subst.substDVarSet substDVarSet looked up coercion variables in the wrong environment! The fix is easy. It is still a pretty strange looking function, but the bug is gone. This fixes another manifestation of #20200. - - - - - 14c80432 by Aaron Allen at 2021-08-27T17:37:42-04:00 GHC.Tc.Gen Diagnostics Conversion (Part 1) Converts uses of `TcRnUnknownMessage` in these modules: - compiler/GHC/Tc/Gen/Annotation.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Arrow.hs - compiler/GHC/Tc/Gen/Bind.hs - - - - - e28773fc by David Feuer at 2021-08-27T17:38:19-04:00 Export Solo from Data.Tuple * The `Solo` type is intended to be the canonical lifted unary tuple. Up until now, it has only been available from `GHC.Tuple` in `ghc-prim`. Export it from `Data.Tuple` in `base`. I proposed this on the libraries list in December, 2020. https://mail.haskell.org/pipermail/libraries/2020-December/031061.html Responses from chessai https://mail.haskell.org/pipermail/libraries/2020-December/031062.html and George Wilson https://mail.haskell.org/pipermail/libraries/2021-January/031077.html were positive. There were no other responses. * Add Haddock documentation for Solo. * Give `Solo` a single field, `getSolo`, a custom `Show` instance that does *not* use record syntax, and a `Read` instance that accepts either record syntax or non-record syntax. - - - - - 38748530 by Aaron Allen at 2021-08-27T22:19:23-05:00 Convert IFace Rename Errors (#19927) Converts uses of TcRnUnknownMessage in GHC.Iface.Rename. Closes #19927 - - - - - 8057a350 by ARATA Mizuki at 2021-08-28T14:25:14-04:00 AArch64 NCG: Emit FABS instructions for fabsFloat# and fabsDouble# Closes #20275 - - - - - 922c6bc8 by ARATA Mizuki at 2021-08-28T14:25:14-04:00 Add a test for #20275 - - - - - af41496f by hainq at 2021-09-01T15:09:08+07:00 Convert diagnostics in GHC.Tc.Validity to proper TcRnMessage. - Add 19 new messages. Update test outputs accordingly. - Pretty print suggest-extensions hints: remove space before interspersed commas. - Refactor Rank's MonoType constructors. Each MonoType constructor should represent a specific case. With the Doc suggestion belonging to the TcRnMessage diagnostics instead. - Move Rank from Validity to its own `GHC.Tc.Types.Rank` module. - Remove the outdated `check_irred_pred` check. - Remove the outdated duplication check in `check_valid_theta`, which was subsumed by `redundant-constraints`. - Add missing test cases for quantified-constraints/T16474 & th/T12387a. - - - - - 5b413533 by Peter Lebbing at 2021-09-06T12:14:35-04:00 fromEnum Natural: Throw error for non-representable values Starting with commit fe770c21, an error was thrown only for the values 2^63 to 2^64-1 inclusive (on a 64-bit machine), but not for higher values. Now, errors are thrown for all non-representable values again. Fixes #20291 - - - - - 407d3b3a by Alan Zimmerman at 2021-09-06T22:57:55-04:00 EPA: order of semicolons and comments for top-level decls is wrong A comment followed by a semicolon at the top level resulted in the preceding comments being attached to the following declaration. Capture the comments as belonging to the declaration preceding the semicolon instead. Closes #20258 - - - - - 89820293 by Oleg Grenrus at 2021-09-06T22:58:32-04:00 Define returnA = id - - - - - 3fb1afea by Sylvain Henry at 2021-09-06T22:59:10-04:00 GHCi: don't discard plugins on reload (#20335) Fix regression introduced in ecfd0278 - - - - - f72aa31d by Sylvain Henry at 2021-09-07T08:02:28-04:00 Bignum: refactor conversion rules * make "passthrough" rules non built-in: they don't need to * enhance note about efficient conversions between numeric types * make integerFromNatural a little more efficient * fix noinline pragma for naturalToWordClamp# (at least with non built-in rules, we get warnings in cases like this) - - - - - 81975ef3 by Ben Gamari at 2021-09-07T08:03:03-04:00 hadrian: Ensure that settings is regenerated during bindist installation Previously Hadrian would simply install the settings file generated in the build environment during the binary distribution installation. This is wrong since these environments may differ (e.g. different `cc` versions). We noticed on Darwin when installation of a binary distribution produced on a newer Darwin release resulted in a broken compiler due to the installed `settings` file incorrectly claiming that `cc` supported `-no-pie`. Fixing this sadly requires a bit of code duplication since `settings` is produced by Hadrian and not `configure`. For now I have simply duplicated the `settings` generation logic used by the Make build system into Hadrian's bindist Makefile. Ultimately the solution will probably involve shipping a freestanding utility to replace `configure`'s toolchain probing logic and generate a toolchain description file (similar to `settings`) as described in #19877. Fixes #20253. - - - - - 2735f5a6 by Ben Gamari at 2021-09-07T08:03:03-04:00 gitlab-ci: Fix bash version-dependence in ci.sh As described in https://stackoverflow.com/questions/7577052, safely expanding bash arrays is very-nearly impossible. The previous incantation failed under the bash version shipped with Centos 7. - - - - - 7fa8c32c by Alfredo Di Napoli at 2021-09-07T12:24:12-04:00 Add and use new constructors to TcRnMessage This commit adds the following constructors to the TcRnMessage type and uses them to replace sdoc-based diagnostics in some parts of GHC (e.g. TcRnUnknownMessage). It includes: * Add TcRnMonomorphicBindings diagnostic * Convert TcRnUnknownMessage in Tc.Solver.Interact * Add and use the TcRnOrphanInstance constructor to TcRnMessage * Add TcRnFunDepConflict and TcRnDupInstanceDecls constructors to TcRnMessage * Add and use TcRnConflictingFamInstDecls constructor to TcRnMessage * Get rid of TcRnUnknownMessage from GHC.Tc.Instance.Family - - - - - 6ea9b3ee by ARATA Mizuki at 2021-09-07T12:24:49-04:00 Fix code example in the documentation of subsumption - - - - - beef6135 by John Ericson at 2021-09-08T02:57:55-04:00 Let LLVM and C handle > native size arithmetic NCG needs to call slow FFI functions where we "borrow" the C compiler's implementation, but there is no reason why we need to do that for LLVM, or the unregisterized backend where everything is via C anyways! - - - - - 5b5c2452 by Jens Petersen at 2021-09-08T02:58:33-04:00 base Data.Fixed: fix documentation typo: succ (0.000 :: Milli) /= 1.001 ie `succ (0000) == 0001` -- (not 1001) - - - - - 7a4bde22 by Joshua Price at 2021-09-08T02:59:10-04:00 Fix broken haddock @since fields in base - - - - - ebbb1fa2 by Guillaume Bouchard at 2021-09-08T02:59:47-04:00 base: Numeric: remove 'Show' constraint on 'showIntAtBase' The constraint was there in order to show the 'Integral' value in case of error. Instead we can show the result of `toInteger`, which will be close (i.e. it will still show the same integer except if the 'Show' instance was funky). This changes a bit runtime semantic (i.e. exception string may be a bit different). - - - - - fb1e0a5d by Matthew Pickering at 2021-09-08T03:00:22-04:00 ffi: Don't allow wrapper stub with CApi convention Fixes #20272 - - - - - dcc1599f by Krzysztof Gogolewski at 2021-09-08T03:00:57-04:00 Minor doc fixes - Fix markup in 9.4 release notes - Document -ddump-cs-trace - Mention that ImpredicativeTypes is really supported only since 9.2 - Remove "There are some restrictions on the use of unboxed tuples". This used to be a list, but all those restrictions were removed. - Mark -fimplicit-import-qualified as documented - Remove "The :main and :run command" - duplicated verbatim in options - Avoid calling "main" a function (cf. #7816) - Update System.getArgs: the old location was before hierarchical modules - Note that multiplicity multiplication is not supported (#20319) - - - - - 330e6e9c by Krzysztof Gogolewski at 2021-09-08T03:00:57-04:00 Documentation: use https links - - - - - 9fc0fe00 by Ben Gamari at 2021-09-08T03:01:32-04:00 rts: Factor out TRACE_ cache update logic Just a small refactoring to perhaps enable code reuse later. - - - - - 86e5a6c3 by Alan Zimmerman at 2021-09-08T16:58:51-04:00 EPA: Capture '+' location for NPlusKPat The location of the plus symbol was being discarded, we now capture it. Closes #20243 - - - - - 87d93745 by Sylvain Henry at 2021-09-08T16:59:29-04:00 Only dump Core stats when requested to do so (#20342) - - - - - 74a87aa3 by Ben Gamari at 2021-09-11T08:53:50-04:00 distrib: Drop FP_GMP from configure script None of the configure options defined by `FP_GMP` are applicable to binary distributions. - - - - - 089de88e by Sylvain Henry at 2021-09-11T08:54:29-04:00 Canonicalize bignum literals Before this patch Integer and Natural literals were desugared into "real" Core in Core prep. Now we desugar them directly into their final ConApp form in HsToCore. We only keep the double representation for BigNat# (literals larger than a machine Word/Int) which are still desugared in Core prep. Using the final form directly allows case-of-known-constructor to fire for bignum literals, fixing #20245. Slight increase (+2.3) in T4801 which is a pathological case with Integer literals. Metric Increase: T4801 T11545 - - - - - f987ec1a by nineonine at 2021-09-11T08:55:06-04:00 Add test for #18181 - - - - - 5615737a by Oleg Grenrus at 2021-09-11T08:55:43-04:00 Remove dubious Eq1 and Ord1 Fixed instances. Fixes #20309 - - - - - 88f871ef by nineonine at 2021-09-11T08:56:20-04:00 Add performance test for #19695 - - - - - c3776542 by Ben Gamari at 2021-09-11T08:56:55-04:00 Ensure that zapFragileUnfolding preseves evaluatedness As noted in #20324, previously we would drop the fact that an unfolding was evaluated, despite what the documentation claims. - - - - - 070ae69c by Ben Gamari at 2021-09-11T08:57:29-04:00 ncg: Kill incorrect unreachable code As noted in #18183, these cases were previously incorrect and unused. Closes #18183. - - - - - 2d151752 by Sebastian Graf at 2021-09-11T08:58:04-04:00 Break recursion in GHC.Float.roundingMode# (#20352) Judging from the Assumption, we should never call `roundingMode#` on a negative number. Yet the strange "dummy" conversion from `IN` to `IP` and the following recursive call where making the function recursive. Replacing the call by a panic makes `roundingMode#` non-recursive, so that we may be able to inline it. Fixes #20352. It seems we trigger #19414 on some jobs, hence Metric Decrease: T12545 - - - - - 7bfa8955 by CarrieMY at 2021-09-13T09:35:07-04:00 Fix #20203 improve constant fold for `and`/`or` This patch follows the rules specified in note [Constant folding through nested expressions]. Modifications are summarized below. - Added andFoldingRules, orFoldingRules to primOpRules under those xxxxAndOp, xxxxOrOp - Refactored some helper functions - Modify data NumOps to include two fields: numAnd and numOr Resolves: #20203 See also: #19204 - - - - - dda61f79 by Ben Gamari at 2021-09-13T09:35:44-04:00 Don't depend unconditionally on xattr in darwin_install Previously the Darwin installation logic would attempt to call xattr unconditionally. This would break on older Darwin releases where this utility did not exist. - - - - - 3c885880 by Ben Gamari at 2021-09-13T09:36:20-04:00 testsuite: Mark hDuplicateTo001 as fragile in concurrent ways As noted in #17568. - - - - - a2a16e4c by Ben Gamari at 2021-09-13T09:36:54-04:00 hadrian: Recommend use of +werror over explicit flavour modification As noted in #20327, the previous guidance was out-of-date. - - - - - 64923cf2 by Joshua Price at 2021-09-13T09:37:31-04:00 Add test for #17865 - - - - - 885f17c8 by Christiaan Baaij at 2021-09-17T09:35:18-04:00 Improve error messages involving operators from Data.Type.Ord Fixes #20009 - - - - - 4564f00f by Krzysztof Gogolewski at 2021-09-17T09:35:53-04:00 Improve pretty-printer defaulting logic (#19361) When determining whether to default a RuntimeRep or Multiplicity variable, use isMetaTyVar to distinguish between metavariables (which can be hidden) and skolems (which cannot). - - - - - 6a7ae5ed by Tito Sacchi at 2021-09-17T09:36:31-04:00 Emit warning if bang is applied to unlifted types GHC will trigger a warning similar to the following when a strictness flag is applied to an unlifted type (primitive or defined with the Unlifted* extensions) in the definition of a data constructor. Test.hs:7:13: warning: [-Wredundant-strictness-flags] • Strictness flag has no effect on unlifted type ‘Int#’ • In the definition of data constructor ‘TestCon’ In the data type declaration for ‘Test’ | 7 | data Test = TestCon !Int# | ^^^^^^^^^^^^^ Fixes #20187 - - - - - 0d996d02 by Ben Gamari at 2021-09-17T09:37:06-04:00 testsuite: Add test for #18382 - - - - - 9300c736 by Alan Zimmerman at 2021-09-17T09:37:41-04:00 EPA: correctly capture comments between 'where' and binds In the following foo = x where -- do stuff doStuff = do stuff The "-- do stuff" comment is captured in the HsValBinds. Closes #20297 - - - - - bce230c2 by Artem Pelenitsyn at 2021-09-17T09:38:19-04:00 driver: -M allow omitting the -dep-suffix (means empty) (fix #15483) - - - - - 01e07ab1 by Ziyang Liu at 2021-09-17T09:38:56-04:00 Ensure .dyn_hi doesn't overwrite .hi This commit fixes the following bug: when `outputHi` is set, and both `.dyn_hi` and `.hi` are needed, both would be written to `outputHi`, causing `.dyn_hi` to overwrite `.hi`. This causes subsequent `readIface` to fail - "mismatched interface file profile tag (wanted "", got "dyn")" - triggering unnecessary rebuild. - - - - - e7c2ff88 by Sven Tennie at 2021-09-17T09:39:31-04:00 Add compile_flags.txt for clangd (C IDE) support This file configures clangd (C Language Server for IDEs) for the GHC project. Please note that this only works together with Haskell Language Server, otherwise .hie-bios/stage0/lib does not exist. - - - - - aa6caab0 by Thomas M. DuBuisson at 2021-09-17T09:40:09-04:00 Update error message to suggest the user consider OOM over RTS bug. Fix #17039 - - - - - bfddee13 by Matthew Pickering at 2021-09-17T09:40:44-04:00 Stop leaking <defunct> llc processes We needed to wait for the process to exit in the clean-up script as otherwise the `llc` process will not be killed until compilation finishes. This leads to running out of process spaces on some OSs. Thanks to Edsko de Vries for suggesting this fix. Fixes #20305 - - - - - a6529ffd by Matthew Pickering at 2021-09-17T09:41:20-04:00 driver: Clean up temporary files after a module has been compiled The refactoring accidently removed these calls to eagerly remove temporary files after a module has been compiled. This caused some issues with tmpdirs getting filled up on my system when the project had a large number of modules (for example, Agda) Fixes #20293 - - - - - 4a7f8d5f by Matthew Pickering at 2021-09-17T09:41:55-04:00 Remove Cabal dependency from check-exact and check-ppr executables Neither uses anything from Cabal, so the dependency can just be removed. - - - - - 987180d4 by Ben Gamari at 2021-09-17T09:42:30-04:00 testsuite: Add broken testcase for #19350 - - - - - ef8a3fbf by Ben Gamari at 2021-09-17T09:42:30-04:00 ghc-boot: Fix metadata handling of writeFileAtomic Previously the implementation of writeFileAtomic (which was stolen from Cabal) failed to preserve file mode, user and group, resulting in #14017. Fixes #14017. - - - - - 18283be3 by Ben Gamari at 2021-09-17T09:43:05-04:00 compiler: Ensure that all CoreTodos have SCCs In #20365 we noticed that a significant amount of time is spend in the Core2Core cost-center, suggesting that some passes are likely missing SCC pragmas. Try to fix this. - - - - - 15a5b7a5 by Matthew Pickering at 2021-09-17T09:43:40-04:00 Add "ipe" flavour transformer to add support for building with IPE debug info The "ipe" transformer compilers everything in stage2 with `-finfo-table-map` and `-fdistinct-constructor-tables` to produce a compiler which is usable with `-hi` profiling and ghc-debug. - - - - - 053a5c2c by Ziyang Liu at 2021-09-17T09:44:18-04:00 Add doc for -dyno, -dynosuf, -dynhisuf - - - - - 9eff805a by Matthew Pickering at 2021-09-17T09:44:53-04:00 Code Gen: Use strict map rather than lazy map in loop analysis We were ending up with a big 1GB thunk spike as the `fmap` operation did not force the key values promptly. This fixes the high maximum memory consumption when compiling the mmark package. Compilation is still slow and allocates a lot more than previous releases. Related to #19471 - - - - - 44e7120d by Matthew Pickering at 2021-09-17T09:44:53-04:00 Code Gen: Replace another lazy fmap with strict mapMap - - - - - b041ea77 by Matthew Pickering at 2021-09-17T09:44:53-04:00 Code Gen: Optimise successors calculation in loop calculation Before this change, the whole map would be traversed in order to delete a node from the graph before calculating successors. This is quite inefficient if the CFG is big, as was the case in the mmark package. A more efficient alternative is to leave the CFG untouched and then just delete the node once after the lookups have been performed. Ticket: #19471 - - - - - 53dc8e41 by Matthew Pickering at 2021-09-17T09:44:53-04:00 Code Gen: Use more efficient block merging algorithm The previous algorithm scaled poorly when there was a large number of blocks and edges. The algorithm links together block chains which have edges between them in the CFG. The new algorithm uses a union find data structure in order to efficiently merge together blocks and calculate which block chain each block id belonds to. I copied the UnionFind data structure which already existed in Cabal into the GHC library rathert than reimplement it myself. This change results in a very significant reduction in allocations when compiling the mmark package. Ticket: #19471 - - - - - c480f8f2 by Matthew Pickering at 2021-09-17T09:44:53-04:00 Code Gen: Rewrite shortcutWeightMap more efficiently This function was one of the main sources of allocation in a ticky profile due to how it repeatedly deleted nodes from a large map. Now firstly the cuts are normalised, so that chains of cuts are elimated before any rewrites are applied. Then the CFG is traversed and reconstructed once whilst applying the necessary rewrites to remove shortcutted edges (based on the normalised cuts). Ticket: #19471 - - - - - da60e627 by Sylvain Henry at 2021-09-17T09:45:36-04:00 Fix annoying warning about Data.List unqualified import - - - - - c662ac7e by Sylvain Henry at 2021-09-17T09:45:36-04:00 Refactor module dependencies code * moved deps related code into GHC.Unit.Module.Deps * refactored Deps module to not export Dependencies constructor to help maintaining invariants - - - - - f6a69fb8 by Sylvain Henry at 2021-09-17T09:45:36-04:00 Use an ADT for RecompReason - - - - - d41cfdd4 by Sylvain Henry at 2021-09-17T09:46:15-04:00 Constant folding for ctz/clz/popCnt (#20376) - - - - - 20e6fec8 by Matthew Pickering at 2021-09-17T09:46:51-04:00 Testsuite: Mark T12903 as fragile on i386 Closes #20377 - - - - - 7bc16521 by David Feuer at 2021-09-18T12:01:10-04:00 Add more instances for Solo Oleg Grenrus pointed out that `Solo` was missing `Eq`, `Ord`, `Bounded`, `Enum`, and `Ix` instances, which were all apparently available for the `OneTuple` type (in the `OneTuple` package). Though only the first three really seem useful, there's no reason not to take them all. For `Ix`, `Solo` naturally fills a gap between `()` and `(,)`. - - - - - 4d245e54 by Sebastian Graf at 2021-09-18T12:01:44-04:00 WorkWrap: Update Note [Wrapper activation] (#15056) The last point of the Conclusion was wrong; we inline functions without pragmas after the initial phase. It also appears that #15056 was fixed, as there already is a test T15056 which properly does foldr/build fusion for the reproducer. I made sure that T15056's `foo` is just large enough for WW to happen (which it wasn't), but for the worker to be small enough to inline into `blam`. Fixes #15056. - - - - - 2c28919f by Sebastian Graf at 2021-09-18T12:01:44-04:00 CoreUtils: Make exprIsHNF return True for unlifted variables (#20140) Clearly, evaluating an unlifted variable will never perform any work. Fixes #20140. - - - - - e17a37df by Joaquin "Florius" Azcarate at 2021-09-18T12:02:21-04:00 Fix formatting of link in base/Type.Reflection - - - - - 78d27dd8 by Matthew Pickering at 2021-09-18T12:02:56-04:00 docs: Fix examples for (un)escapeArgs The examples were just missing the surrounding brackets. ghci> escapeArgs ["hello \"world\""] "hello\\ \\\"world\\\"\n" Fixes #20340 - - - - - 1350c220 by Matthew Pickering at 2021-09-18T12:03:31-04:00 deriving: Always use module prefix in dataTypeName This fixes a long standard bug where the module prefix was omitted from the data type name supplied by Data.Typeable instances. Instead of reusing the Outputable instance for TyCon, we now take matters into our own hands and explicitly print the module followed by the type constructor name. Fixes #20371 - - - - - 446ca8b9 by Ben Gamari at 2021-09-18T12:04:06-04:00 users-guide: Improve documentation of ticky events - - - - - d99fc250 by Matthew Pickering at 2021-09-18T12:04:41-04:00 hadrian: Disable verbose timing information Before the output contain a lot of verbose information about timining various things to do with shake which wasn't so useful for developers. ``` shakeArgsWith 0.000s 0% Function shake 0.010s 0% Database read 0.323s 12% === With database 0.031s 1% Running rules 2.301s 86% ========================= Pool finished (1786 threads, 5 max) 0.003s 0% Cleanup 0.000s 0% Total 2.669s 100% Build completed in 2.67s ``` Now the output just contains the last line ``` Build completed in 2.67s ``` Ticket #20381 - - - - - 104bf6bf by Oleg Grenrus at 2021-09-22T08:23:08-04:00 Clarify that malloc, free etc. are the ones from stdlib.h - - - - - bb37026e by Aaron Allen at 2021-09-22T08:23:45-04:00 Convert Diagnostics in GHC.Tc.Gen.* (Part 2) Converts diagnostics in: (#20116) - GHC.Tc.Gen.Default - GHC.Tc.Gen.Export - - - - - 92257abd by Sylvain Henry at 2021-09-22T08:24:23-04:00 Link with libm dynamically (#19877) The compiler should be independent of the target. - - - - - b47fafd9 by alirezaghey at 2021-09-22T08:25:00-04:00 Fix minor inconsistency in documentation fixes #20388 - - - - - 3d328eb5 by Benjamin Maurer at 2021-09-22T08:25:37-04:00 Remove unused, undocumented debug/dump flag `-ddump-vt-trace`. See 20403. - - - - - 65c837a3 by Matthew Pickering at 2021-09-23T10:44:19+01:00 Typo [skip ci] - - - - - 69b35afd by Sven Tennie at 2021-09-23T15:59:38-04:00 deriveConstants: Add hie.yaml - - - - - 022d9717 by Sven Tennie at 2021-09-23T15:59:38-04:00 base: Generalize newStablePtrPrimMVar Make it polymorphic in the type of the MVar's value. This simple generalization makes it usable for `MVar a` instead of only `MVar ()` values. - - - - - 6f7f5990 by Sven Tennie at 2021-09-23T15:59:38-04:00 Introduce stack snapshotting / cloning (#18741) Add `StackSnapshot#` primitive type that represents a cloned stack (StgStack). The cloning interface consists of two functions, that clone either the treads own stack (cloneMyStack) or another threads stack (cloneThreadStack). The stack snapshot is offline/cold, i.e. it isn't evaluated any further. This is useful for analyses as it prevents concurrent modifications. For technical details, please see Note [Stack Cloning]. Co-authored-by: Ben Gamari <bgamari.foss at gmail.com> Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 29717ecb by Sven Tennie at 2021-09-23T15:59:38-04:00 Use Info Table Provenances to decode cloned stack (#18163) Emit an Info Table Provenance Entry (IPE) for every stack represeted info table if -finfo-table-map is turned on. To decode a cloned stack, lookupIPE() is used. It provides a mapping between info tables and their source location. Please see these notes for details: - [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)] - [Mapping Info Tables to Source Positions] Metric Increase: T12545 - - - - - aafda13d by Ben Gamari at 2021-09-23T16:00:17-04:00 ci: Drop redundant `cabal update`s `cabal update` is already implied by `ci.sh setup`. - - - - - ca88d91c by Ben Gamari at 2021-09-23T16:00:17-04:00 ci: Consolidate handling of cabal cache Previously the cache persistence was implemented as various ad-hoc `cp` commands at the end of the individual CI scripts. Here we move all of this logic into `ci.sh`. - - - - - cbfc0e93 by Ben Gamari at 2021-09-23T16:00:17-04:00 ci: Isolate build from HOME - - - - - 55112fbf by Ben Gamari at 2021-09-23T16:00:17-04:00 ci: Move phase timing logic into ci.sh - - - - - be11120f by Ben Gamari at 2021-09-23T16:00:17-04:00 ci: More surgical use of nix in Darwin builds - - - - - f48d747d by Ben Gamari at 2021-09-23T16:00:17-04:00 configure: Move nm search logic to new file - - - - - ee7bdc5c by Ben Gamari at 2021-09-23T16:00:18-04:00 configure: Add check for whether CC supports --target - - - - - 68509e1c by Ben Gamari at 2021-09-23T16:00:18-04:00 ci: Add version to cache key - - - - - dae4a068 by Ben Gamari at 2021-09-23T16:00:18-04:00 gitlab-ci: Ensure that CABAL_DIR is a Windows path Otherwise cabal-install falls over. - - - - - 1c91e721 by Ben Gamari at 2021-09-23T16:00:18-04:00 gitlab-ci: Use correct CABAL executable - - - - - 8a6598c7 by Ben Gamari at 2021-09-23T16:00:18-04:00 Ensure that cabal update is invoked before building - - - - - d7ee5295 by Ben Gamari at 2021-09-23T16:00:18-04:00 gitlab-ci: bash fixes - - - - - 98a30147 by GHC GitLab CI at 2021-09-23T16:00:18-04:00 hadrian: Pass CFLAGS to gmp configure - - - - - 02827066 by Ben Gamari at 2021-09-23T16:00:18-04:00 configure: Fix copy/paste error Previously both the --with-system-libffi path and the non--with-system-libffi path set CabalUseSystemLibFFI=True. This was wrong. - - - - - 316ac68f by Ben Gamari at 2021-09-23T16:00:18-04:00 configure: Clarify meaning of CabalHaveLibffi Previously the meaning of this flag was unclear and as a result I suspect that CabalHaveLibffi could be incorrectly False. - - - - - 552b32f1 by Ben Gamari at 2021-09-23T16:00:18-04:00 testsuite: Pass CFLAGS to hsc2hs tests - - - - - 7e19cb1c by Ben Gamari at 2021-09-23T16:00:18-04:00 testsuite: Fix ipeMap ipeMap.c failed to #include <string.h> - - - - - c9a87dca by Ben Gamari at 2021-09-23T16:00:18-04:00 testsuite: Make unsigned_reloc_macho_x64 and section_alignment makefile_tests - - - - - b30f90c4 by Ben Gamari at 2021-09-23T16:00:18-04:00 testsuite: Don't use cc directly in section_alignment test - - - - - a940ba7f by Ben Gamari at 2021-09-23T16:00:18-04:00 testsuite: Fix gnu sed-ism The BSD sed implementation doesn't allow `sed -i COMMAND FILE`; one must rather use `sed -i -e COMMAND FILE`. - - - - - e78752df by Ben Gamari at 2021-09-23T16:00:18-04:00 rts: Ensure that headers don't refer to undefined __STDC_VERSION__ Previously the C/C++ language version check in STG could throw an undefined macro warning due to __STDC_VERSION__ when compiled with a C++ compiler. Fix this by defining __STDC_VERSION__==0 when compiling with a C++ compiler. Fixes #20394. - - - - - 6716a4bd by Ben Gamari at 2021-09-23T16:00:18-04:00 gitlab-ci: Unset MACOSX_DEPLOYMENT_TARGET in stage0 build Otherwise we may get warnings from the toolchain if the bootstrap compiler was built with a different deployment target. - - - - - ac378d3e by Ben Gamari at 2021-09-23T16:00:18-04:00 testsuite: Ensure that C++11 is used in T20199 Otherwise we are dependent upon the C++ compiler's default language. - - - - - 33eb4a4e by Sylvain Henry at 2021-09-23T16:01:00-04:00 Constant-folding for timesInt2# (#20374) - - - - - 4b7ba3ae by Ben Gamari at 2021-09-24T23:14:31-04:00 gitlab-ci: Don't rely on $HOME when pushing test metrics As of cbfc0e933660626c9f4eaf5480076b6fcd31dceb we set $HOME to a non-existent directory to ensure hermeticity. - - - - - 8127520e by Ben Gamari at 2021-09-27T16:06:04+00:00 gitlab-ci: Ensure that temporary home exists - - - - - 0da019be by Artyom Kuznetsov at 2021-09-28T01:51:48-04:00 Remove NoGhcTc usage from HsMatchContext NoGhcTc is removed from HsMatchContext. As a result of this, HsMatchContext GhcTc is now a valid type that has Id in it, instead of Name and tcMatchesFun now takes Id instead of Name. - - - - - e38facf8 by Matthew Pickering at 2021-09-28T01:52:23-04:00 driver: Fix Ctrl-C handling with -j1 Even in -j1 we now fork all the work into it's own thread so that Ctrl-C exceptions are thrown on the main thread, which is blocked waiting for the work thread to finish. The default exception handler then picks up Ctrl-C exception and the dangling thread is killed. Fixes #20292 - - - - - 45a674aa by Sylvain Henry at 2021-09-28T01:53:01-04:00 Add `-dsuppress-core-sizes` flag (#20342) This flag is used to remove the output of core stats per binding in Core dumps. - - - - - 1935c42f by Matthew Pickering at 2021-09-28T01:53:36-04:00 hadrian: Reduce default verbosity This change reduces the default verbosity of error messages to omit the stack trace information from the printed output. For example, before all errors would have a long call trace: ``` Error when running Shake build system: at action, called at src/Rules.hs:39:19 in main:Rules at need, called at src/Rules.hs:61:5 in main:Rules * Depends on: _build/stage1/lib/package.conf.d/ghc-9.3.conf * Depends on: _build/stage1/compiler/build/libHSghc-9.3.a * Depends on: _build/stage1/compiler/build/GHC/Tc/Solver/Rewrite.o * Depends on: _build/stage1/compiler/build/GHC/Tc/Solver/Rewrite.o _build/stage1/compiler/build/GHC/Tc/Solver/Rewrite.hi at cmd', called at src/Builder.hs:330:23 in main:Builder at cmd, called at src/Builder.hs:432:8 in main:Builder * Raised the exception: ``` Which can be useful but it confusing for GHC rather than hadrian developers. Ticket #20386 - - - - - 219f7f50 by Matthew Pickering at 2021-09-28T01:53:36-04:00 hadrian: Remove deprecated tracing functions - - - - - 28963690 by Matthew Pickering at 2021-09-28T01:53:36-04:00 hadrian: Rework the verbosity levels Before we really only had two verbosity levels, normal and verbose. There are now three levels: Normal: Commands show stderr (no stdout) and minimal build failure messages. Verbose (-V): Commands also show stdout, build failure message contains callstack and additional information Diagnostic (-VV): Very verbose output showing all command lines and passing -v3 to cabal commands. -V is similar to the default verbosity from before (but a little more verbose) - - - - - 66c85e2e by Matthew Pickering at 2021-09-28T01:53:36-04:00 ci: Increase default verbosity level to `-V` (Verbose) Given the previous commit, `-V` allows us to see some useful information in CI (such as the call stack on failure) which normally people don't want to see. As a result the $VERBOSE variable now tweaks the diagnostic level one level higher (to Diagnostic), which produces a lot of output. - - - - - 58fea28e by Matthew Pickering at 2021-09-28T01:53:36-04:00 hadrian: Update documentation for new verbosity options - - - - - 26f24aec by Matthew Pickering at 2021-09-28T01:53:36-04:00 hadrian: Update comments on verbosity handling - - - - - 62b4a89b by taylorfausak at 2021-09-28T09:57:37-04:00 Remove outdated note about pragma layout - - - - - 028abd5b by Benjamin Maurer at 2021-09-28T09:58:13-04:00 Documented yet undocumented dump flags #18641 - - - - - b8d98827 by Richard Eisenberg at 2021-09-29T09:40:14-04:00 Compare FunTys as if they were TyConApps. See Note [Equality on FunTys] in TyCoRep. Close #17675. Close #17655, about documentation improvements included in this patch. Close #19677, about a further mistake around FunTy. test cases: typecheck/should_compile/T19677 - - - - - be77a9e0 by Fabian Thorand at 2021-09-29T09:40:51-04:00 Remove special case for large objects in allocateForCompact allocateForCompact() is called when the current allocation for the compact region does not fit in the nursery. It previously had a special case for objects exceeding the large object threshold. In that case, it would allocate a new compact region block just for that object. That led to a lot of small blocks being allocated in compact regions with a larger default block size (`autoBlockW`). This commit removes this special case because having a lot of small compact region blocks contributes significantly to memory fragmentation. The removal should be valid because - a more generic case for allocating a new compact region block follows at the end of allocateForCompact(), and that one takes `autoBlockW` into account - the reason for allocating separate blocks for large objects in the main heap seems to be to avoid copying during GCs, but once inside the compact region, the object will never be copied anyway. Fixes #18757. A regression test T18757 was added. - - - - - cd603062 by Kirill Zaborsky at 2021-09-29T09:41:27-04:00 Fix comment typos - - - - - 162492ea by Alexander Kjeldaas at 2021-09-29T09:41:27-04:00 Document interaction between unsafe FFI and GC In the multi-threaded RTS this can lead to hard to debug performance issues. - - - - - 361da88a by Kamil Dworakowski at 2021-09-29T09:42:04-04:00 Add a regression test for #17912 - - - - - 5cc4bd57 by Benjamin Maurer at 2021-09-29T09:42:41-04:00 Rectifying COMMENT and `mkComment` across platforms to work with SDoc and exhibit similar behaviors. Issue 20400 - - - - - a2be9f34 by Ziyang Liu at 2021-09-29T09:43:19-04:00 Document that `eqType`/`coreView` do not look through type families This isn't clear from the existing doc. - - - - - c668fd2c by Andrea Condoluci at 2021-09-29T09:44:04-04:00 TH stage restriction check for constructors, selectors, and class methods Closes ticket #17820. - - - - - d46e34d0 by Andrea Condoluci at 2021-09-29T09:44:04-04:00 Add tests for T17820 - - - - - 770fcac8 by Ben Gamari at 2021-09-29T09:44:40-04:00 GHC: Drop dead packageDbModules It was already commented out and contained a reference to the non-deterministic nameEnvElts so let's just drop it. - - - - - 42492b76 by Ben Gamari at 2021-09-29T09:44:40-04:00 compiler: Reimplement seqEltsUFM in terms of fold Rather than nonDetEltsUFM; this should eliminate some unnecessary list allocations. - - - - - 97ffd6d9 by Ben Gamari at 2021-09-29T09:44:40-04:00 compiler: Rewrite all eltsUFM occurrences to nonDetEltsUFM And remove the former. - - - - - df8c5961 by Ben Gamari at 2021-09-29T09:44:40-04:00 compiler: Fix name of GHC.Core.TyCon.Env.nameEnvElts Rename to nonDetTyConEnvElts. - - - - - 1f2ba67a by Ben Gamari at 2021-09-29T09:44:40-04:00 compiler: Make nubAvails deterministic Surprisingly this previously didn't appear to introduce any visible non-determinism but it seems worth avoiding non-determinism here. - - - - - 7c90a180 by Ben Gamari at 2021-09-29T09:44:40-04:00 compiler: Rename nameEnvElts -> nonDetNameEnvElts - - - - - 2e68d4fa by Ben Gamari at 2021-09-29T09:44:40-04:00 compiler: Use seqEltsNameEnv rather that nameEnvElts - - - - - f66eaefd by Ben Gamari at 2021-09-29T09:44:40-04:00 compiler: occEnvElts -> nonDetOccEnvElts - - - - - 594ee2f4 by Matthew Pickering at 2021-09-30T00:56:30-04:00 testsuite: Make cabal01 more robust to large environments Sebastian unfortunately wrote a very long commit message in !5667 which caused `xargs` to fail on windows because the environment was too big. Fortunately `xargs` and `rm` don't need anything from the environment so just run those commands in an empty environment (which is what env -i achieves). - - - - - c261f220 by Sebastian Graf at 2021-09-30T00:56:30-04:00 Nested CPR light unleashed (#18174) This patch enables worker/wrapper for nested constructed products, as described in `Note [Nested CPR]`. The machinery for expressing Nested CPR was already there, since !5054. Worker/wrapper is equipped to exploit Nested CPR annotations since !5338. CPR analysis already handles applications in batches since !5753. This patch just needs to flip a few more switches: 1. In `cprTransformDataConWork`, we need to look at the field expressions and their `CprType`s to see whether the evaluation of the expressions terminates quickly (= is in HNF) or if they are put in strict fields. If that is the case, then we retain their CPR info and may unbox nestedly later on. More details in `Note [Nested CPR]`. 2. Enable nested `ConCPR` signatures in `GHC.Types.Cpr`. 3. In the `asConCpr` call in `GHC.Core.Opt.WorkWrap.Utils`, pass CPR info of fields to the `Unbox`. 4. Instead of giving CPR signatures to DataCon workers and wrappers, we now have `cprTransformDataConWork` for workers and treat wrappers by analysing their unfolding. As a result, the code from GHC.Types.Id.Make went away completely. 5. I deactivated worker/wrappering for recursive DataCons and wrote a function `isRecDataCon` to detect them. We really don't want to give `repeat` or `replicate` the Nested CPR property. See Note [CPR for recursive data structures] for which kind of recursive DataCons we target. 6. Fix a couple of tests and their outputs. I also documented that CPR can destroy sharing and lead to asymptotic increase in allocations (which is tracked by #13331/#19326) in `Note [CPR for data structures can destroy sharing]`. Nofib results: ``` -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- ben-raytrace -3.1% -0.4% binary-trees +0.8% -2.9% digits-of-e2 +5.8% +1.2% event +0.8% -2.1% fannkuch-redux +0.0% -1.4% fish 0.0% -1.5% gamteb -1.4% -0.3% mkhprog +1.4% +0.8% multiplier +0.0% -1.9% pic -0.6% -0.1% reptile -20.9% -17.8% wave4main +4.8% +0.4% x2n1 -100.0% -7.6% -------------------------------------------------------------------------------- Min -95.0% -17.8% Max +5.8% +1.2% Geometric Mean -2.9% -0.4% ``` The huge wins in x2n1 (loopy list) and reptile (see #19970) are due to refraining from unboxing (:). Other benchmarks like digits-of-e2 or wave4main regress because of that. Ultimately there are no great improvements due to Nested CPR alone, but at least it's a win. Binary sizes decrease by 0.6%. There are a significant number of metric decreases. The most notable ones (>1%): ``` ManyAlternatives(normal) ghc/alloc 771656002.7 762187472.0 -1.2% ManyConstructors(normal) ghc/alloc 4191073418.7 4114369216.0 -1.8% MultiLayerModules(normal) ghc/alloc 3095678333.3 3128720704.0 +1.1% PmSeriesG(normal) ghc/alloc 50096429.3 51495664.0 +2.8% PmSeriesS(normal) ghc/alloc 63512989.3 64681600.0 +1.8% PmSeriesV(normal) ghc/alloc 62575424.0 63767208.0 +1.9% T10547(normal) ghc/alloc 29347469.3 29944240.0 +2.0% T11303b(normal) ghc/alloc 46018752.0 47367576.0 +2.9% T12150(optasm) ghc/alloc 81660890.7 82547696.0 +1.1% T12234(optasm) ghc/alloc 59451253.3 60357952.0 +1.5% T12545(normal) ghc/alloc 1705216250.7 1751278952.0 +2.7% T12707(normal) ghc/alloc 981000472.0 968489800.0 -1.3% GOOD T13056(optasm) ghc/alloc 389322664.0 372495160.0 -4.3% GOOD T13253(normal) ghc/alloc 337174229.3 341954576.0 +1.4% T13701(normal) ghc/alloc 2381455173.3 2439790328.0 +2.4% BAD T14052(ghci) ghc/alloc 2162530642.7 2139108784.0 -1.1% T14683(normal) ghc/alloc 3049744728.0 2977535064.0 -2.4% GOOD T14697(normal) ghc/alloc 362980213.3 369304512.0 +1.7% T15164(normal) ghc/alloc 1323102752.0 1307480600.0 -1.2% T15304(normal) ghc/alloc 1304607429.3 1291024568.0 -1.0% T16190(normal) ghc/alloc 281450410.7 284878048.0 +1.2% T16577(normal) ghc/alloc 7984960789.3 7811668768.0 -2.2% GOOD T17516(normal) ghc/alloc 1171051192.0 1153649664.0 -1.5% T17836(normal) ghc/alloc 1115569746.7 1098197592.0 -1.6% T17836b(normal) ghc/alloc 54322597.3 55518216.0 +2.2% T17977(normal) ghc/alloc 47071754.7 48403408.0 +2.8% T17977b(normal) ghc/alloc 42579133.3 43977392.0 +3.3% T18923(normal) ghc/alloc 71764237.3 72566240.0 +1.1% T1969(normal) ghc/alloc 784821002.7 773971776.0 -1.4% GOOD T3294(normal) ghc/alloc 1634913973.3 1614323584.0 -1.3% GOOD T4801(normal) ghc/alloc 295619648.0 292776440.0 -1.0% T5321FD(normal) ghc/alloc 278827858.7 276067280.0 -1.0% T5631(normal) ghc/alloc 586618202.7 577579960.0 -1.5% T5642(normal) ghc/alloc 494923048.0 487927208.0 -1.4% T5837(normal) ghc/alloc 37758061.3 39261608.0 +4.0% T9020(optasm) ghc/alloc 257362077.3 254672416.0 -1.0% T9198(normal) ghc/alloc 49313365.3 50603936.0 +2.6% BAD T9233(normal) ghc/alloc 704944258.7 685692712.0 -2.7% GOOD T9630(normal) ghc/alloc 1476621560.0 1455192784.0 -1.5% T9675(optasm) ghc/alloc 443183173.3 433859696.0 -2.1% GOOD T9872a(normal) ghc/alloc 1720926653.3 1693190072.0 -1.6% GOOD T9872b(normal) ghc/alloc 2185618061.3 2162277568.0 -1.1% GOOD T9872c(normal) ghc/alloc 1765842405.3 1733618088.0 -1.8% GOOD TcPlugin_RewritePerf(normal) ghc/alloc 2388882730.7 2365504696.0 -1.0% WWRec(normal) ghc/alloc 607073186.7 597512216.0 -1.6% T9203(normal) run/alloc 107284064.0 102881832.0 -4.1% haddock.Cabal(normal) run/alloc 24025329589.3 23768382560.0 -1.1% haddock.base(normal) run/alloc 25660521653.3 25370321824.0 -1.1% haddock.compiler(normal) run/alloc 74064171706.7 73358712280.0 -1.0% ``` The biggest exception to the rule is T13701 which seems to fluctuate as usual (not unlike T12545). T14697 has a similar quality, being a generated multi-module test. T5837 is small enough that it similarly doesn't measure anything significant besides module loading overhead. T13253 simply does one additional round of Simplification due to Nested CPR. There are also some apparent regressions in T9198, T12234 and PmSeriesG that we (@mpickering and I) were simply unable to reproduce locally. @mpickering tried to run the CI script in a local Docker container and actually found that T9198 and PmSeriesG *improved*. In MRs that were rebased on top this one, like !4229, I did not experience such increases. Let's not get hung up on these regression tests, they were meant to test for asymptotic regressions. The build-cabal test improves by 1.2% in -O0. Metric Increase: T10421 T12234 T12545 T13035 T13056 T13701 T14697 T18923 T5837 T9198 Metric Decrease: ManyConstructors T12545 T12707 T13056 T14683 T16577 T18223 T1969 T3294 T9203 T9233 T9675 T9872a T9872b T9872c T9961 TcPlugin_RewritePerf - - - - - 205f0f92 by Andrea Condoluci at 2021-09-30T00:57:09-04:00 Trees That Grow refactor for HsTick and HsBinTick Move HsTick and HsBinTick to XExpr, the extension tree of HsExpr. Part of #16830 . - - - - - e0923b98 by Ben Gamari at 2021-09-30T00:57:44-04:00 ghc-boot: Eliminate unnecessary use of getEnvironment Previously we were using `System.Environment.getEnvironment`, which decodes all environment variables into Haskell `String`s, where a simple environment lookup would do. This made the compiler's allocations unnecessarily dependent on the environment. Fixes #20431. - - - - - 941d3792 by Sylvain Henry at 2021-09-30T19:41:09-04:00 Rules for sized conversion primops (#19769) Metric Decrease: T12545 - - - - - adc41a77 by Matthew Pickering at 2021-09-30T19:41:44-04:00 driver: Fix -E -XCPP, copy output from CPP ouput rather than .hs output Fixes #20416 I thought about adding a test for this case but I struggled to think of something robust. Grepping -v3 will include different paths on different systems and the structure of the result file depends on which preprocessor you are using. - - - - - 94f3ce7e by Matthew Pickering at 2021-09-30T19:42:19-04:00 Recompilation: Handle -plugin-package correctly If a plugins was specified using the -plugin-package-(id) flag then the module it applied to was always recompiled. The recompilation checker was previously using `findImportedModule`, which looked for packages in the HPT and then in the package database but only for modules specified using `-package`. The correct lookup function for plugins is `findPluginModule`, therefore we check normal imports with `findImportedModule` and plugins with `findPluginModule`. Fixes #20417 - - - - - ef92a009 by Andreas Klebinger at 2021-09-30T19:42:54-04:00 NCG: Linear-reg-alloc: A few small implemenation tweaks. Removed an intermediate list via a fold. realRegsAlias: Manually inlined the list functions to get better code. Linear.hs added a bang somewhere. - - - - - 9606774d by Aaron Allen at 2021-10-01T09:04:10-04:00 Convert Diagnostics GHC.Tc.Gen.* (Part 3) Converts all diagnostics in the `GHC.Tc.Gen.Expr` module. (#20116) - - - - - 9600a5fb by Matthew Pickering at 2021-10-01T09:04:46-04:00 code gen: Improve efficiency of findPrefRealReg Old strategy: For each variable linearly scan through all the blocks and check to see if the variable is any of the block register mappings. This is very slow when you have a lot of blocks. New strategy: Maintain a map from virtual registers to the first real register the virtual register was assigned to. Consult this map in findPrefRealReg. The map is updated when the register mapping is updated and is hidden behind the BlockAssigment abstraction. On the mmark package this reduces compilation time from about 44s to 32s. Ticket: #19471 - - - - - e3701815 by Matthew Pickering at 2021-10-01T09:05:20-04:00 ci: Unset CI_* variables before run_hadrian and test_make The goal here is to somewhat sanitize the environment so that performance tests don't fluctuate as much as they have been doing. In particular the length of the commit message was causing benchmarks to increase because gitlab stored the whole commit message twice in environment variables. Therefore when we used `getEnvironment` it would cause more allocation because more string would be created. See #20431 ------------------------- Metric Decrease: T10421 T13035 T18140 T18923 T9198 T12234 T12425 ------------------------- - - - - - e401274a by Ben Gamari at 2021-10-02T05:18:03-04:00 gitlab-ci: Bump docker images To install libncurses-dev on Debian targets. - - - - - 42f49c4e by Ben Gamari at 2021-10-02T05:18:03-04:00 Bump terminfo submodule to 0.4.1.5 Closes #20307. - - - - - cb862ecf by Andreas Schwab at 2021-10-02T05:18:40-04:00 CmmToLlvm: Sign/Zero extend parameters for foreign calls on RISC-V Like S390 and PPC64, RISC-V requires parameters for foreign calls to be extended to full words. - - - - - 0d455a18 by Richard Eisenberg at 2021-10-02T05:19:16-04:00 Use eqType, not tcEqType, in metavar kind check Close #20356. See addendum to Note [coreView vs tcView] in GHC.Core.Type for the details. Also killed old Note about metaTyVarUpdateOK, which has been gone for some time. test case: typecheck/should_fail/T20356 - - - - - 4264e74d by Ben Gamari at 2021-10-02T05:19:51-04:00 rts: Add missing write barriers in MVar wake-up paths Previously PerformPut failed to respect the non-moving collector's snapshot invariant, hiding references to an MVar and its new value by overwriting a stack frame without dirtying the stack. Fix this. PerformTake exhibited a similar bug, failing to dirty (and therefore mark) the blocked stack before mutating it. Closes #20399. - - - - - 040c347e by Ben Gamari at 2021-10-02T05:19:51-04:00 rts: Unify stack dirtiness check This fixes an inconsistency where one dirtiness check would not mask out the STACK_DIRTY flag, meaning it may also be affected by the STACK_SANE flag. - - - - - 4bdafb48 by Sylvain Henry at 2021-10-02T05:20:29-04:00 Add (++)/literal rule When we derive the Show instance of the big record in #16577, I get the following compilation times (with -O): Before: 0.91s After: 0.77s Metric Decrease: T19695 - - - - - 8b3d98ff by Sylvain Henry at 2021-10-02T05:21:07-04:00 Don't use FastString for UTF-8 encoding only - - - - - f4554f1d by Ben Gamari at 2021-10-03T14:23:36-04:00 ci: Use https:// transport and access token to push perf notes Previously we would push perf notes using a standard user and SSH key-based authentication. However, configuring SSH is unnecessarily fiddling. We now rather use HTTPS and a project access token. - - - - - 91cd1248 by Ben Gamari at 2021-10-03T14:23:45-04:00 ci/test-metrics: Clean up various bash quoting issues - - - - - ed0e29f1 by Ben Gamari at 2021-10-03T23:24:37-04:00 base: Update Unicode database to 14.0 Closes #20404. - - - - - e8693713 by Ben Gamari at 2021-10-03T23:25:11-04:00 configure: Fix redundant-argument warning from -no-pie check Modern clang versions are quite picky when it comes to reporting redundant arguments. In particular, they will warn when -no-pie is passed when no linking is necessary. Previously the configure script used a `$CC -Werror -no-pie -E` invocation to test whether `-no-pie` is necessary. Unfortunately, this meant that clang would throw a redundant argument warning, causing configure to conclude that `-no-pie` was not supported. We now rather use `$CC -Werror -no-pie`, ensuring that linking is necessary and avoiding this failure mode. Fixes #20463. - - - - - b3267fad by Sylvain Henry at 2021-10-04T08:28:23+00:00 Constant folding for negate (#20347) Only for small integral types for now. - - - - - 2308a130 by Vladislav Zavialov at 2021-10-04T18:44:07-04:00 Clean up HiePass constraints - - - - - 40c81dd2 by Matthew Pickering at 2021-10-04T23:45:11-04:00 ci: Run hadrian builds verbosely, but not tests This reduces the output from the testsuite to a more manageable level. Fixes #20432 - - - - - 347537a5 by Ben Gamari at 2021-10-04T23:45:46-04:00 compiler: Improve Haddocks of atomic MachOps - - - - - a0f44ceb by Ben Gamari at 2021-10-04T23:45:46-04:00 compiler: Fix racy ticker counter registration Previously registration of ticky entry counters was racy, performing a read-modify-write to add the new counter to the ticky_entry_ctrs list. This could result in the list becoming cyclic if multiple threads entered the same closure simultaneously. Fixes #20451. - - - - - a7629334 by Vladislav Zavialov at 2021-10-04T23:46:21-04:00 Bespoke TokenLocation data type The EpaAnnCO we were using contained an Anchor instead of EpaLocation, making it harder to work with. At the same time, using EpaLocation by itself isn't possible either, as we may have tokens without location information. Hence the new data type: data TokenLocation = NoTokenLoc | TokenLoc !EpaLocation - - - - - a14d0e63 by sheaf at 2021-10-04T23:46:58-04:00 Bump TcLevel of failing kind equality implication Not bumping the TcLevel meant that we could end up trying to add evidence terms for the implication constraint created to wrap failing kind equalities (to avoid their deferral). fixes #20043 - - - - - 48b0f17a by sheaf at 2021-10-04T23:47:35-04:00 Add a regression test for #17723 The underlying bug was fixed by b8d98827, see MR !2477 - - - - - 5601b9e2 by Matthías Páll Gissurarson at 2021-10-05T03:18:39-04:00 Speed up valid hole-fits by adding early abort and checks. By adding an early abort flag in `TcSEnv`, we can fail fast in the presence of insoluble constraints. This helps us avoid a lot of work in valid hole-fits, and we geta massive speed-up by avoiding a lot of useless work solving constraints that never come into play. Additionally, we add a simple check for degenerate hole types, such as when the type of the hole is an immutable type variable (as is the case when the hole is completely unconstrained). Then the only valid fits are the locals, so we can ignore the global candidates. This fixes #16875 - - - - - 298df16d by Krzysztof Gogolewski at 2021-10-05T03:19:14-04:00 Reject type family equation with wrong name (#20260) We should reject "type family Foo where Bar = ()". This check was done in kcTyFamInstEqn but not in tcTyFamInstEqn. I factored out arity checking, which was duplicated. - - - - - 643b6f01 by Sebastian Graf at 2021-10-05T14:32:51-04:00 WorkWrap: Nuke CPR signatures of join points (#18824) In #18824 we saw that the Simplifier didn't nuke a CPR signature of a join point when it pushed a continuation into it when it better should have. But join points are local, mostly non-exported bindings. We don't use their CPR signature anyway and would discard it at the end of the Core pipeline. Their main purpose is to propagate CPR info during CPR analysis and by the time worker/wrapper runs the signature will have served its purpose. So we zap it! Fixes #18824. - - - - - b4c0cc36 by Sebastian Graf at 2021-10-05T14:32:51-04:00 Simplifier: Get rid of demand zapping based on Note [Arity decrease] The examples in the Note were inaccurate (`$s$dm` has arity 1 and that seems OK) and the code didn't actually nuke the demand *signature* anyway. Specialise has to nuke it, but it starts from a clean IdInfo anyway (in `newSpecIdM`). So I just deleted the code. Fixes #20450. - - - - - cd1b016f by Sebastian Graf at 2021-10-05T14:32:51-04:00 CprAnal: Activate Sum CPR for local bindings We've had Sum CPR (#5075) for top-level bindings for a couple of years now. That begs the question why we didn't also activate it for local bindings, and the reasons for that are described in `Note [CPR for sum types]`. Only that it didn't make sense! The Note said that Sum CPR would destroy let-no-escapes, but that should be a non-issue since we have syntactic join points in Core now and we don't WW for them (`Note [Don't w/w join points for CPR]`). So I simply activated CPR for all bindings of sum type, thus fixing #5075 and \#16570. NoFib approves: ``` -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- comp_lab_zift -0.0% +0.7% fluid +1.7% +0.7% reptile +0.1% +0.1% -------------------------------------------------------------------------------- Min -0.0% -0.2% Max +1.7% +0.7% Geometric Mean +0.0% +0.0% ``` There were quite a few metric decreases on the order of 1-4%, but T6048 seems to regress significantly, by 26.1%. WW'ing for a `Just` constructor and the nested data type meant additional Simplifier iterations and a 30% increase in term sizes as well as a 200-300% in type sizes due to unboxed 9-tuples. There's not much we can do about it, I'm afraid: We're just doing much more work there. Metric Decrease: T12425 T18698a T18698b T20049 T9020 WWRec Metric Increase: T6048 - - - - - 000f2a30 by Viktor Dukhovni at 2021-10-05T14:33:29-04:00 Address some Foldable documentation nits - Add link to laws from the class head - Simplify wording of left/right associativity intro paragraph - Avoid needless mention of "endomorphisms" - - - - - 7059a729 by Viktor Dukhovni at 2021-10-05T14:33:29-04:00 Add laws link and tweak Traversable class text - - - - - 43358ab9 by Viktor Dukhovni at 2021-10-05T14:33:29-04:00 Note linear `elem` cost This is a writeup of the state of play for better than linear `elem` via a helper type class. - - - - - 56899c8d by Viktor Dukhovni at 2021-10-05T14:33:29-04:00 Note elem ticket 20421 - - - - - fb6b772f by Viktor Dukhovni at 2021-10-05T14:33:29-04:00 Minor wording tweaks/fixes - - - - - f49c7012 by Viktor Dukhovni at 2021-10-05T14:33:29-04:00 Adopt David Feuer's explantion of foldl' via foldr - - - - - 5282eaa1 by Viktor Dukhovni at 2021-10-05T14:33:29-04:00 Explain Endo, Dual, ... in laws - - - - - f52df067 by Alfredo Di Napoli at 2021-10-05T14:34:04-04:00 Make GHC.Utils.Error.Validity type polymorphic This commit makes the `Validity` type polymorphic: ``` data Validity' a = IsValid -- ^ Everything is fine | NotValid a -- ^ A problem, and some indication of why -- | Monomorphic version of @Validity'@ specialised for 'SDoc's. type Validity = Validity' SDoc ``` The type has been (provisionally) renamed to Validity' to not break existing code, as the monomorphic `Validity` type is quite pervasive in a lot of signatures in GHC. Why having a polymorphic Validity? Because it carries the evidence of "what went wrong", but the old type carried an `SDoc`, which clashed with the new GHC diagnostic infrastructure (#18516). Having it polymorphic it means we can carry an arbitrary, richer diagnostic type, and this is very important for things like the `checkOriginativeSideConditions` function, which needs to report the actual diagnostic error back to `GHC.Tc.Deriv`. It also generalises Validity-related functions to be polymorphic in @a at . - - - - - ac275f42 by Alfredo Di Napoli at 2021-10-05T14:34:04-04:00 Eradicate TcRnUnknownMessage from GHC.Tc.Deriv This (big) commit finishes porting the GHC.Tc.Deriv module to support the new diagnostic infrastructure (#18516) by getting rid of the legacy calls to `TcRnUnknownMessage`. This work ended up being quite pervasive and touched not only the Tc.Deriv module but also the Tc.Deriv.Utils and Tc.Deriv.Generics module, which needed to be adapted to use the new infrastructure. This also required generalising `Validity`. More specifically, this is a breakdown of the work done: * Add and use the TcRnUselessTypeable data constructor * Add and use TcRnDerivingDefaults data constructor * Add and use the TcRnNonUnaryTypeclassConstraint data constructor * Add and use TcRnPartialTypeSignatures * Add T13324_compile2 test to test another part of the TcRnPartialTypeSignatures diagnostic * Add and use TcRnCannotDeriveInstance data constructor, which introduces a new data constructor to TcRnMessage called TcRnCannotDeriveInstance, which is further sub-divided to carry a `DeriveInstanceErrReason` which explains the reason why we couldn't derive a typeclass instance. * Add DerivErrSafeHaskellGenericInst data constructor to DeriveInstanceErrReason * Add DerivErrDerivingViaWrongKind and DerivErrNoEtaReduce * Introduce the SuggestExtensionInOrderTo Hint, which adds (and use) a new constructor to the hint type `LanguageExtensionHint` called `SuggestExtensionInOrderTo`, which can be used to give a bit more "firm" recommendations when it's obvious what the required extension is, like in the case for the `DerivingStrategies`, which automatically follows from having enabled both `DeriveAnyClass` and `GeneralizedNewtypeDeriving`. * Wildcard-free pattern matching in mk_eqn_stock, which removes `_` in favour of pattern matching explicitly on `CanDeriveAnyClass` and `NonDerivableClass`, because that determine whether or not we can suggest to the user `DeriveAnyClass` or not. - - - - - 52400ebb by Simon Peyton Jones at 2021-10-05T14:34:39-04:00 Ensure top-level binders in scope in SetLevels Ticket #20200 (the Agda failure) showed another case in which lookupIdSubst would fail to find a local Id in the InScopeSet. This time it was because SetLevels was given a program in which the top-level bindings were not in dependency order. The Simplifier (see Note [Glomming] in GHC.Core.Opt.Occuranal) and the specialiser (see Note [Top level scope] in GHC.Core.Opt.Specialise) may both produce top-level bindings where an early binding refers to a later one. One solution would be to run the occurrence analyser again to put them all in the right order. But a simpler one is to make SetLevels OK with this input by bringing all top-level binders into scope at the start. That's what this patch does. - - - - - 11240b74 by Sylvain Henry at 2021-10-05T14:35:17-04:00 Constant folding for (.&.) maxBound (#20448) - - - - - 29ee04f3 by Zubin Duggal at 2021-10-05T14:35:52-04:00 docs: Clarify documentation of `getFileSystemEncoding` (#20344) It may not always be a Unicode encoding - - - - - 435ff398 by Mann mit Hut at 2021-10-06T00:11:07-04:00 Corrected types of thread ids obtained from the RTS While the thread ids had been changed to 64 bit words in e57b7cc6d8b1222e0939d19c265b51d2c3c2b4c0 the return type of the foreign import function used to retrieve these ids - namely 'GHC.Conc.Sync.getThreadId' - was never updated accordingly. In order to fix that this function returns now a 'CUULong'. In addition to that the types used in the thread labeling subsystem were adjusted as well and several format strings were modified throughout the whole RTS to display thread ids in a consistent and correct way. Fixes #16761 - - - - - 89e98bdf by Alan Zimmerman at 2021-10-06T00:11:42-04:00 EPA: Remove duplicate AnnOpenP/AnnCloseP in DataDecl The parens EPAs were added in the tyvars where they belong, but also at the top level of the declaration. Closes #20452 - - - - - fc4c7ffb by Ryan Scott at 2021-10-06T00:12:17-04:00 Remove the Maybe in primRepName's type There's no need for this `Maybe`, as it will always be instantiated to `Just` in practice. Fixes #20482. - - - - - 4e91839a by sheaf at 2021-10-06T00:12:54-04:00 Add a regression test for #13233 This test fails on GHC 8.0.1, only when profiling is enabled, with the error: ghc: panic! (the 'impossible' happened) kindPrimRep.go a_12 This was fixed by commit b460d6c9. - - - - - 7fc986e1 by Sebastian Graf at 2021-10-06T00:13:29-04:00 CprAnal: Two regression tests For #16040 and #2387. - - - - - 9af29e7f by Matthew Pickering at 2021-10-06T10:57:24-04:00 Disable -dynamic-too if -dynamic is also passed Before if you passed both options then you would generate two identical hi/dyn_hi and o/dyn_o files, both in the dynamic way. It's better to warn this is happening rather than duplicating the work and causing potential confusion. -dynamic-too should only be used with -static. Fixes #20436 - - - - - a466b024 by sheaf at 2021-10-06T10:58:03-04:00 Improve overlap error for polykinded constraints There were two problems around `mkDictErr`: 1. An outdated call to `flattenTys` meant that we missed out on some instances. As we no longer flatten type-family applications, the logic is obsolete and can be removed. 2. We reported "out of scope" errors in a poly-kinded situation because `BoxedRep` and `Lifted` were considered out of scope. We fix this by using `pretendNameIsInScope`. fixes #20465 - - - - - b041fc6e by Ben Gamari at 2021-10-07T03:40:49-04:00 hadrian: Generate ghcii.sh in binary distributions Technically we should probably generate this in the in-place build tree as well, but I am not bothering to do so here as ghcii.sh will be removed in 9.4 when WinIO becomes the default anyways (see #12720). Fixes #19339. - - - - - 75a766a3 by Ben Gamari at 2021-10-07T03:40:49-04:00 hadrian: Fix incorrect ticket reference This was supposed to refer to #20253. - - - - - 62157287 by Teo Camarasu at 2021-10-07T03:41:27-04:00 fix non-moving gc heap space requirements estimate The space requirements of the non-moving gc are comparable to the compacting gc, not the copying gc. The copying gc requires a much larger overhead. Fixes #20475 - - - - - e82c8dd2 by Joachim Breitner at 2021-10-07T03:42:01-04:00 Fix rst syntax mistakes in release notes - - - - - 358f6222 by Benjamin Maurer at 2021-10-07T03:42:36-04:00 Removed left-over comment from `nonDetEltsUFM`-removal in `seqEltsUFM`. - - - - - 0cf23263 by Alan Zimmerman at 2021-10-07T03:43:11-04:00 EPA: Add comments to EpaDelta The EpaDelta variant of EpaLocation cannot be sorted by location. So we capture any comments that need to be printed between the prior output and this location, when creating an EpaDelta offset in ghc-exactprint. And make the EpaLocation fields strict. - - - - - e1d02fb0 by Sylvain Henry at 2021-10-07T20:20:01-04:00 Bignum: allow naturalEq#/Ne# to inline (#20361) We now perform constant folding on bigNatEq# instead. - - - - - 44886aab by Sylvain Henry at 2021-10-07T20:20:01-04:00 Bignum: allow inlining of naturalEq/Ne/Gt/Lt/Ge/Le/Compare (#20361) Perform constant folding on bigNatCompare instead. Some functions of the Enum class for Natural now need to be inlined explicitly to be specialized at call sites (because `x > lim` for Natural is inlined and the resulting function is a little too big to inline). If we don't do this, T17499 runtime allocations regresses by 16%. - - - - - 3a5a5c85 by Sylvain Henry at 2021-10-07T20:20:01-04:00 Bignum: allow naturalToWordClamp/Negate/Signum to inline (#20361) We don't need built-in rules now that bignum literals (e.g. 123 :: Natural) match with their constructors (e.g. NS 123##). - - - - - 714568bb by Sylvain Henry at 2021-10-07T20:20:01-04:00 Bignum: remove outdated comment - - - - - 4d44058d by Sylvain Henry at 2021-10-07T20:20:01-04:00 Bignum: transfer NOINLINE from Natural to BigNat - - - - - 01f5324f by Joachim Breitner at 2021-10-07T20:20:36-04:00 Recover test case for T11547 commit 98c7749 has reverted commit 59d7ee53, including the test that that file added. That test case is still valuable, so I am re-adding it. I add it with it’s current (broken) behavior so that whoever fixes it intentionally or accidentially will notice and then commit the actual desired behavior (which is kinda unspecified, see https://gitlab.haskell.org/ghc/ghc/-/issues/20455#note_382030) - - - - - 3d31f11e by Sylvain Henry at 2021-10-08T13:08:16-04:00 Don't link plugins' units with target code (#20218) Before this patch, plugin units were linked with the target code even when the unit was passed via `-plugin-package`. This is an issue to support plugins in cross-compilers (plugins are definitely not ABI compatible with target code). We now clearly separate unit dependencies for plugins and unit dependencies for target code and only link the latter ones. We've also added a test to ensure that plugin units passed via `-package` are linked with target code so that `thNameToGhcName` can still be used in plugins that need it (see T20218b). - - - - - 75aea732 by Joachim Breitner at 2021-10-08T13:08:51-04:00 New test case: Variant of T14052 with data type definitions previous attempts at fixing #11547 and #20455 were reverted because they showed some quadratic behaviour, and the test case T15052 was added to catch that. I believe that similar quadratic behavor can be triggered with current master, by using type definitions rather than value definitions, so this adds a test case similar to T14052. I have hopes that my attempts at fixing #11547 will lead to code that avoid the quadratic increase here. Or not, we will see. In any case, having this in `master` and included in future comparisons will be useful. - - - - - 374a718e by Teo Camarasu at 2021-10-08T18:09:56-04:00 Fix nonmoving gen label in gc stats report The current code assumes the non-moving generation is always generation 1, but this isn't the case if the amount of generations is greater than 2 Fixes #20461 - - - - - a37275a3 by Matthew Pickering at 2021-10-08T18:10:31-04:00 ci: Remove BROKEN_TESTS for x86 darwin builds The tests Capi_Ctype_001 Capi_Ctype_002 T12010 pass regularly on CI so let's mark them unbroken and hopefully then we can fix #20013. - - - - - e6838872 by Matthew Pickering at 2021-10-08T18:10:31-04:00 ci: Expect x86-darwin to pass Closes #20013 - - - - - 1f160cd9 by Matthew Pickering at 2021-10-08T18:10:31-04:00 Normalise output of T20199 test - - - - - 816d2561 by CarrieMY at 2021-10-08T18:11:08-04:00 Fix -E -fno-code undesirable interactions #20439 - - - - - 55a6377a by Matthew Pickering at 2021-10-08T18:11:43-04:00 code gen: Disable dead code elimination when -finfo-table-map is enabled It's important that when -finfo-table-map is enabled that we generate IPE entries just for those info tables which are actually used. To this end, the info tables which are used are collected just before code generation starts and entries only created for those tables. Not accounted for in this scheme was the dead code elimination in the native code generator. When compiling GHC this optimisation removed an info table which had an IPE entry which resulting in the following kind of linker error: ``` /home/matt/ghc-with-debug/_build/stage1/lib/../lib/x86_64-linux-ghc-9.3.20210928/libHSCabal-3.5.0.0-ghc9.3.20210928.so: error: undefined reference to '.Lc5sS_info' /home/matt/ghc-with-debug/_build/stage1/lib/../lib/x86_64-linux-ghc-9.3.20210928/libHSCabal-3.5.0.0-ghc9.3.20210928.so: error: undefined reference to '.Lc5sH_info' /home/matt/ghc-with-debug/_build/stage1/lib/../lib/x86_64-linux-ghc-9.3.20210928/libHSCabal-3.5.0.0-ghc9.3.20210928.so: error: undefined reference to '.Lc5sm_info' collect2: error: ld returned 1 exit status `cc' failed in phase `Linker'. (Exit code: 1) Development.Shake.cmd, system command failed ``` Unfortunately, by the time this optimisation happens the structure of the CmmInfoTable has been lost, we only have the generated code for the info table to play with so we can no longer just collect all the used info tables and generate the IPE map. This leaves us with two options: 1. Return a list of the names of the discarded info tables and then remove them from the map. This is awkward because we need to do code generation for the map as well. 2. Just disable this small code size optimisation when -finfo-table-map is enabled. The option produces very big object files anyway. Option 2 is much easier to implement and means we don't have to thread information around awkwardly. It's at the cost of slightly larger object files (as dead code is not eliminated). Disabling this optimisation allows an IPE build of GHC to complete successfully. Fixes #20428 - - - - - a76409c7 by Andrei Barbu at 2021-10-08T19:45:29-04:00 Add defaulting plugins. Like the built-in type defaulting rules these plugins can propose candidates to resolve ambiguous type variables. Machine learning and other large APIs like those for game engines introduce new numeric types and other complex typed APIs. The built-in defaulting mechanism isn't powerful enough to resolve ambiguous types in these cases forcing users to specify minutia that they might not even know how to do. There is an example defaulting plugin linked in the documentation. Applications include defaulting the device a computation executes on, if a gradient should be computed for a tensor, or the size of a tensor. See https://github.com/ghc-proposals/ghc-proposals/pull/396 for details. - - - - - 31983ab4 by sheaf at 2021-10-09T04:46:05-04:00 Reject GADT pattern matches in arrow notation Tickets #20469 and #20470 showed that the current implementation of arrows is not at all up to the task of supporting GADTs: GHC produces ill-scoped Core programs because it doesn't propagate the evidence introduced by a GADT pattern match. For the time being, we reject GADT pattern matches in arrow notation. Hopefully we are able to add proper support for GADTs in arrows in the future. - - - - - a356bd56 by Matthew Pickering at 2021-10-10T15:07:52+02:00 driver: Fix assertion failure on self-import Fixes #20459 - - - - - 245ab166 by Ben Gamari at 2021-10-10T17:55:10-04:00 hadrian: Include Cabal flags in verbose configure output - - - - - 9f9d6280 by Zejun Wu at 2021-10-12T01:39:53-04:00 Derive Eq instance for the HieTypeFix type We have `instance Eq a => Eq (HieType a)` already. This instance can be handy when we want to impement a function to find all `fromIntegral :: a -> a` using `case ty of { Roll (HFunTy _ a b) -> a == b; _ -> False }`. - - - - - 8d6de541 by Ben Gamari at 2021-10-12T01:40:29-04:00 nonmoving: Fix and factor out mark_trec_chunk We need to ensure that the TRecChunk itself is marked, in addition to the TRecs it contains. - - - - - aa520ba1 by Ben Gamari at 2021-10-12T01:40:29-04:00 rts/nonmoving: Rename mark_* to trace_* These functions really do no marking; they merely trace pointers. - - - - - 2c02ea8d by Ben Gamari at 2021-10-12T01:40:29-04:00 rts/primops: Fix write barrier in stg_atomicModifyMutVarzuzh Previously the call to dirty_MUT_VAR in stg_atomicModifyMutVarzuzh was missing its final argument. Fixes #20414. - - - - - 2e0c13ab by Ben Gamari at 2021-10-12T01:40:29-04:00 rts/nonmoving: Enable selector optimisation by default - - - - - 2c06720e by GHC GitLab CI at 2021-10-12T01:41:04-04:00 rts/Linker: Fix __dso_handle handling Previously the linker's handling of __dso_handle was quite wrong. Not only did we claim that __dso_handle could be NULL when statically linking (which it can not), we didn't even implement this mislead theory faithfully and instead resolved the symbol to a random pointer. This lead to the failing relocations on AArch64 noted in #20493. Here we try to implement __dso_handle as a dynamic linker would do, choosing an address within the loaded object (specifically its start address) to serve as the object's handle. - - - - - 58223dfa by Carrie Xu at 2021-10-12T01:41:41-04:00 Add Hint to "Empty 'do' block" Error Message#20147 - - - - - 8e88ef36 by Carrie Xu at 2021-10-12T01:41:41-04:00 Change affected tests stderr - - - - - 44384696 by Zubin Duggal at 2021-10-12T01:42:15-04:00 driver: Share the graph of dependencies We want to share the graph instead of recomputing it for each key. - - - - - e40feab0 by Matthew Pickering at 2021-10-12T01:42:50-04:00 Make ms_ghc_prim_import field strict If you don't promptly force this field then it ends up retaining a lot of data structures related to parsing. For example, the following retaining chain can be observed when using GHCi. ``` PState 0x4289365ca0 0x4289385d68 0x4289385db0 0x7f81b37a7838 0x7f81b3832fd8 0x4289365cc8 0x4289365cd8 0x4289365cf0 0x4289365cd8 0x4289365d08 0x4289385e48 0x7f81b4e4c290 0x7f818f63f440 0x7f818f63f440 0x7f81925ccd18 0x7f81b4e41230 0x7f818f63f440 0x7f81925ccd18 0x7f818f63f4a8 0x7f81b3832fd8 0x7f81b3832fd8 0x4289365d20 0x7f81b38233b8 0 19 <PState:GHC.Parser.Lexer:_build-ipe/stage1/compiler/build/GHC/Parser/Lexer.hs:3779:46> _thunk( ) 0x4289384230 0x4289384160 <([LEpaComment], [LEpaComment]):GHC.Parser.Lexer:> _thunk( ) 0x4289383250 <EpAnnComments:GHC.Parser.Lexer:compiler/GHC/Parser/Lexer.x:2306:19-40> _thunk( ) 0x4289399850 0x7f818f63f440 0x4289399868 <SrcSpanAnnA:GHC.Parser:_build-ipe/stage1/compiler/build/GHC/Parser.hs:12527:13-30> L 0x4289397600 0x42893975a8 <GenLocated:GHC.Parser:_build-ipe/stage1/compiler/build/GHC/Parser.hs:12527:32> 0x4289c4e8c8 : 0x4289c4e8b0 <[]:GHC.Parser.Header:compiler/GHC/Parser/Header.hs:104:36-54> (0x4289c4da70,0x7f818f63f440) <(,):GHC.Parser.Header:compiler/GHC/Parser/Header.hs:104:36-54> _thunk( ) 0x4289c4d030 <Bool:GHC.Parser.Header:compiler/GHC/Parser/Header.hs:(112,22)-(115,27)> ExtendedModSummary 0x422e9c8998 0x7f81b617be78 0x422e9c89b0 0x4289c4c0c0 0x7f81925ccd18 0x7f81925ccd18 0x7f81925ccd18 0x7f81925ccd18 0x7f818f63f440 0x4289c4c0d8 0x4289c4c0f0 0x7f81925ccd18 0x422e9c8a20 0x4289c4c108 0x4289c4c730 0x7f818f63f440 <ExtendedModSummary:GHC.Driver.Make:compiler/GHC/Driver/Make.hs:2041:30-38> ModuleNode 0x4289c4b850 <ModuleGraphNode:GHC.Unit.Module.Graph:compiler/GHC/Unit/Module/Graph.hs:139:14-36> 0x4289c4b590 : 0x4289c4b578 <[]:GHC.Unit.Module.Graph:compiler/GHC/Unit/Module/Graph.hs:139:31-36> ModuleGraph 0x4289c4b2f8 0x4289c4b310 0x4289c4b340 0x7f818f63f4a0 <ModuleGraph:GHC.Driver.Make:compiler/GHC/Driver/Make.hs:(242,19)-(244,40)> HscEnv 0x4289d9a4a8 0x4289d9aad0 0x4289d9aae8 0x4217062a88 0x4217060b38 0x4217060b58 0x4217060b68 0x7f81b38a7ce0 0x4217060b78 0x7f818f63f440 0x7f818f63f440 0x4217062af8 0x4289d9ab10 0x7f81b3907b60 0x4217060c00 114 <HscEnv:GHC.Runtime.Eval:compiler/GHC/Runtime/Eval.hs:790:31-44> ``` - - - - - 5c266b59 by Ben Gamari at 2021-10-12T19:16:40-04:00 hadrian: Introduce `static` flavour - - - - - 683011c7 by Ben Gamari at 2021-10-12T19:16:40-04:00 gitlab-ci: Introduce static Alpine job - - - - - 9257abeb by Ben Gamari at 2021-10-12T19:16:40-04:00 testsuite: Drop :set from ghci scripts The ghci scripts for T9293 and ghci057 used `:set` to print the currently-set options. However, in neither case was this necessary to the correctness of the test and moreover it would introduce spurious platform-dependence (e.g. since `-fexternal-dynamic-refs` is set by default only on platforms that support dynamic linking). - - - - - 82a89df7 by Ben Gamari at 2021-10-12T19:16:40-04:00 rts/linker: Define _DYNAMIC when necessary Usually the dynamic linker would define _DYNAMIC. However, when dynamic linking is not supported (e.g. on musl) it is safe to define it to be NULL. - - - - - fcd970b5 by GHC GitLab CI at 2021-10-12T19:16:40-04:00 rts/linker: Resolve __fini_array_* symbols to NULL If the __fini_array_{start,end} symbols are not defined (e.g. as is often the case when linking against musl) then resolve them to NULL. - - - - - 852ec4f5 by Ben Gamari at 2021-10-12T19:16:40-04:00 testsuite: Mark T13702 as requiring share libraries It fails on statically-built Alpine with ``` T13702.hs:1:1: error: Could not find module ‘Prelude’ Perhaps you haven't installed the "dyn" libraries for package ‘base-4.15.0.0’? Use -v (or `:set -v` in ghci) to see a list of the files searched for. | 1 | {-# LANGUAGE ForeignFunctionInterface #-} | ^ ``` - - - - - b604bfd9 by Ben Gamari at 2021-10-12T19:16:40-04:00 testsuite: Mark ghcilink00[25] as requiring dynamic linking - - - - - d709a133 by Ben Gamari at 2021-10-12T19:16:40-04:00 testsuite: Mark all ghci/linking/dyn tests as requiring dynamic linking - - - - - 99b8177a by Ben Gamari at 2021-10-12T19:16:40-04:00 testsuite: Mark T14931 as requiring dynamic linking - - - - - 2687f65e by Ben Gamari at 2021-10-12T19:16:40-04:00 testsuite: Compile safeInfered tests with -v0 This eliminates some spurious platform-dependence due to static linking (namely in UnsafeInfered02 due to dynamic-too). - - - - - 587d7e66 by Brian Jaress at 2021-10-12T19:16:40-04:00 documentation: flavours.md static details - - - - - 91cfe121 by Ben Gamari at 2021-10-12T19:16:40-04:00 testsuite: Make recomp021 less environment-sensitive Suppress output from diff to eliminate unnecessary environmental-dependence. - - - - - dc094597 by Ben Gamari at 2021-10-12T19:16:40-04:00 testsuite: Make T12600 more robust Previously we would depend upon `grep ... | head -n1`. In principle this should work, but on Alpine Linux `grep` complains when its stdout stream has been closed. - - - - - cdd45a61 by Ben Gamari at 2021-10-12T19:16:40-04:00 gitlab-ci: Mark more broken tests on Alpine - - - - - 9ebda74e by Ben Gamari at 2021-10-12T19:16:40-04:00 rts/RtsSymbols: Add environ - - - - - 08aa7a1d by Ben Gamari at 2021-10-12T19:16:40-04:00 rts/linker: Introduce a notion of strong symbols - - - - - 005b1848 by Ben Gamari at 2021-10-12T19:16:40-04:00 rts/RtsSymbols: Declare atexit as a strong symbol - - - - - 5987357b by Ben Gamari at 2021-10-12T19:16:40-04:00 rts/RtsSymbols: fini array - - - - - 9074b748 by Ben Gamari at 2021-10-12T19:16:40-04:00 testsuite: Move big-obj test from ghci/linking/dyn to ghci/linking There was nothing dynamic about this test. - - - - - 3b1c12d3 by Ben Gamari at 2021-10-12T19:16:40-04:00 testsuite: Fix overzealous command-line mangling Previously this attempt at suppressing make's -s flag would mangle otherwise valid arguments. - - - - - 05303f68 by Ben Gamari at 2021-10-12T19:16:40-04:00 testsuite: Clean up dynlib support predicates Previously it was unclear whether req_shared_libs should require: * that the platform supports dynamic library loading, * that GHC supports dynamic linking of Haskell code, or * that the dyn way libraries were built Clarify by splitting the predicate into two: * `req_dynamic_lib_support` demands that the platform support dynamic linking * `req_dynamic_hs` demands that the GHC support dynamic linking of Haskell code on the target platform Naturally `req_dynamic_hs` cannot be true unless `req_dynamic_lib_support` is also true. - - - - - 9859eede by Ben Gamari at 2021-10-12T19:16:40-04:00 gitlab-ci: Bump docker images Bumps bootstrap compiler to GHC 9.0.1. - - - - - af5ed156 by Matthew Pickering at 2021-10-12T19:17:15-04:00 Make the OccName field of NotOrphan strict In GHCi, by default the ModIface is not written to disk, this can leave a thunk which retains a TyCon which ends up retaining a great deal more on the heap. For example, here is the retainer trace from ghc-debug. ``` ... many other closures ... <TyCon:GHC.Core.TyCon:compiler/GHC/Core/TyCon.hs:1755:34-97> Just 0x423162aaa8 <Maybe:GHC.Core.TyCon:compiler/GHC/Core/TyCon.hs:(1936,11)-(1949,13)> FamilyTyCon 0x4231628318 0x4210e06260 0x4231628328 0x4231628340 0x421730a398 0x4231628358 0x4231628380 0x4231628390 0x7f0f5a171d18 0x7f0f7b1d7850 0x42316283a8 0x7f0f7b1d7830 <TyCon:GHC.Core.TyCon:compiler/GHC/Cor e/TyCon.hs:1948:30-32> _thunk( ) 0x4231624000 <OccName:GHC.Iface.Make:compiler/GHC/Iface/Make.hs:724:22-43> NotOrphan 0x42357d8ed8 <IsOrphan:GHC.Iface.Make:compiler/GHC/Iface/Make.hs:724:12-43> IfaceFamInst 0x4210e06260 0x42359aed10 0x4210e0c6b8 0x42359aed28 <IfaceFamInst:GHC.Iface.Make:> ``` Making the field strict squashes this retainer leak when using GHCi. - - - - - 0c5d9ca8 by Matthew Pickering at 2021-10-12T19:17:15-04:00 Be more careful about retaining KnotVars It is quite easy to end up accidently retaining a KnotVars, which contains pointers to a stale TypeEnv because they are placed in the HscEnv. One place in particular we have to be careful is when loading a module into the EPS in `--make` mode, we have to remove the reference to KnotVars as otherwise the interface loading thunks will forever retain reference to the KnotVars which are live at the time the interface was loaded. These changes do not go as far as to enforce the invariant described in Note [KnotVar invariants] * At the end of upsweep, there should be no live KnotVars but at least improve the situation. This is left for future work (#20491) - - - - - 105e2711 by Matthew Pickering at 2021-10-12T19:17:15-04:00 driver: Pass hsc_env with empty HPT into upsweep Otherwise you end up retaining the whole old HPT when reloading in GHCi. - - - - - 7215f6de by Matthew Pickering at 2021-10-12T19:17:15-04:00 Make fields of Linkable strict The Module field can end up retaining part of a large structure and is always calculated by projection. - - - - - 053d9deb by Matthew Pickering at 2021-10-12T19:17:15-04:00 Make the fields of MakeEnv strict There's no reason for them to be lazy, and in particular we would like to make sure the old_hpt field is evaluated. - - - - - 0d711791 by Matthew Pickering at 2021-10-12T19:17:15-04:00 More strictness around HomePackageTable This patch makes some operations to do with HomePackageTable stricter * Adding a new entry into the HPT would not allow the old HomeModInfo to be collected because the function used by insertWith wouldn't be forced. * We're careful to force the new MVar value before it's inserted into the global MVar as otherwise we retain references to old entries. - - - - - ff0409d0 by Matthew Pickering at 2021-10-12T19:17:15-04:00 driver: Filter out HPT modules **before** typecheck loop It's better to remove the modules first before performing the typecheckLoop as otherwise you can end up with thunks which reference stale HomeModInfo which are difficult to force due to the knot-tie. - - - - - c2ce1b17 by Matthew Pickering at 2021-10-12T19:17:15-04:00 Add GHCi recompilation performance test - - - - - 82938981 by Matthew Pickering at 2021-10-12T19:17:15-04:00 Force name_exe field to avoid retaining entire UnitEnv (including whole HPT) Not forcing this one place will result in GHCi using 2x memory on a reload. - - - - - 90f06a0e by Haochen Tong at 2021-10-12T19:17:53-04:00 Check for libatomic dependency for atomic operations Some platforms (e.g. RISC-V) require linking against libatomic for some (e.g. sub-word-sized) atomic operations. Fixes #19119. - - - - - 234bf368 by Haochen Tong at 2021-10-12T19:17:53-04:00 Move libatomic check into m4/fp_gcc_supports_atomics.m4 - - - - - 4cf43b2a by Haochen Tong at 2021-10-12T19:17:53-04:00 Rename fp_gcc_supports__atomics to fp_cc_supports__atomics - - - - - 0aae1b4e by Joachim Breitner at 2021-10-13T01:07:45+00:00 shadowNames: Accept an OccName, not a GreName previously, the `shadowNames` function would take `[GreName]`. This has confused me for two reasons: * Why `GreName` and not `Name`? Does the difference between a normal name and a field name matter? The code of `shadowNames` shows that it does not, but really its better if the type signatures says so. * Why `Name` and not `OccName`? The point of `shadowNames` is to shadow _unqualified names_, at least in the two use cases I am aware of (names defined on the GHCI prompt or in TH splices). The code of `shadowNames` used to have cases that peek at the module of the given name and do something if that module appears in the `GlobalRdrElt`, but I think these cases are dead code, I don’t see how they could occur in the above use cases. Also, I replaced them with `errors` and GHC would still validate. Hence removing this code (yay!) This change also allows `shadowNames` to accept an `OccSet` instead, which allows for a faster implemenation; I’ll try that separately. This in stead might help with !6703. - - - - - 19cd403b by Norman Ramsey at 2021-10-13T03:32:21-04:00 Define and export Outputable instance for StgOp - - - - - 58bd0cc1 by Zubin Duggal at 2021-10-13T13:50:10+05:30 ci: build validate-x86_64-linux-deb9-debug with hyperlinked source (#20067) - - - - - 4536e8ca by Zubin Duggal at 2021-10-13T13:51:00+05:30 hadrian, testsuite: Teach Hadrian to query the testsuite driver for dependencies Issues #19072, #17728, #20176 - - - - - 60d3e33d by Zubin Duggal at 2021-10-13T13:51:03+05:30 hadrian: Fix location for haddocks in installed pkgconfs - - - - - 337a31db by Zubin Duggal at 2021-10-13T13:51:03+05:30 testsuite: Run haddock tests on out of tree compiler - - - - - 8c224b6d by Zubin Duggal at 2021-10-13T13:51:03+05:30 ci: test in-tree compiler in hadrian - - - - - 8d5a5ecf by Zubin Duggal at 2021-10-13T13:51:03+05:30 hadrian: avoid building check-{exact,ppr} and count-deps when the tests don't need them hadrian: build optional dependencies with test compiler - - - - - d0e87d0c by Zubin Duggal at 2021-10-13T13:51:03+05:30 testsuite: remove 'req_smp' from testwsdeque - - - - - 3c0e60b8 by Zubin Duggal at 2021-10-13T13:51:03+05:30 testsuite: strip windows line endings for haddock haddock: deterministic SCC Updates haddock submodule Metric Increase: haddock.Cabal haddock.base haddock.compiler - - - - - 64460b20 by Ben Gamari at 2021-10-13T18:44:12-04:00 distrib/configure: Add AC_CONFIG_MACRO_DIRS Sadly, autoconf cannot warn when it encounters an undefined macro and therefore this bug went unnoticed for altogether far too long. - - - - - e46edfcf by sheaf at 2021-10-13T18:44:49-04:00 Set logger flags in --backpack mode Backpack used to initialise the logger before obtaining the DynFlags. This meant that logging options (such as dump flags) were not set. Initialising the logger after the session flags have been set fixes the issue. fixes #20396 - - - - - df016e4e by Matthew Pickering at 2021-10-14T08:41:17-04:00 Make sure paths are quoted in install Makefile Previously it would fail with this error: ``` if [ -L wrappers/ghc ]; then echo "ghc is a symlink"; fi ghc is a symlink cp: target 'dir/bin/ghc' is not a directory make: *** [Makefile:197: install_wrappers] Error 1 ``` which is because the install path contains a space. Fixes #20506 - - - - - 7f2ce0d6 by Joachim Breitner at 2021-10-14T08:41:52-04:00 Move BreakInfo into own module while working on GHCi stuff, e.g. `GHC.Runtime.Eval.Types`, I observed a fair amount of modules being recompiled that I didn’t expect to depend on this, from byte code interpreters to linkers. Turns out that the rather simple `BreakInfo` type is all these modules need from the `GHC.Runtime.Eval.*` hierarchy, so by moving that into its own file we make the dependency tree wider and shallower, which is probably worth it. - - - - - 557d26fa by Ziyang Liu at 2021-10-14T14:32:57-04:00 Suggest -dynamic-too in failNonStd when applicable I encountered an error that says ``` Cannot load -dynamic objects when GHC is built the normal way To fix this, either: (1) Use -fexternal-interpreter, or (2) Build the program twice: once the normal way, and then with -dynamic using -osuf to set a different object file suffix. ``` Or it could say ``` (2) Use -dynamic-too ``` - - - - - f450e948 by Joachim Breitner at 2021-10-14T14:33:32-04:00 fuzzyLookup: More deterministic order else the output may depend on the input order, which seems it may depend on the concrete Uniques, which is causing headaches when including test cases about that. - - - - - 8b7f5424 by Alan Zimmerman at 2021-10-14T14:34:07-04:00 EPA: Preserve semicolon order in annotations Ensure the AddSemiAnn items appear in increasing order, so that if they are converted to delta format they are still in the correct order. Prior to this the exact printer sorted by Span, which is meaningless for EpaDelta locations. - - - - - 481e6b54 by Matthew Pickering at 2021-10-14T14:34:42-04:00 Some extra strictness in annotation fields Locations can be quite long-lived so it's important that things which live in locations, such as annotations are forced promptly. Otherwise they end up retaining the entire PState, as evidenced by this retainer trace: ``` PState 0x4277ce6cd8 0x4277ce6d00 0x7f61f12d37d8 0x7f61f12d37d8 0x7f61f135ef78 0x4277ce6d48 0x4277ce6d58 0x4277ce6d70 0x4277ce6d58 0x4277ce6d88 0x4277ce6da0 0x7f61f29782f0 0x7f61cd16b440 0x7f61cd16b440 0x7f61d00f8d18 0x7f61f296d290 0x7f61cd16b440 0x7f61d00f8d18 0x7f61cd16b4a8 0x7f61f135ef78 0x4277ce6db8 0x4277ce6dd0 0x7f61f134f358 0 3 <PState:GHC.Parser.Lexer:_build-ipe/stage1/compiler/build/GHC/Parser/Lexer.hs:3779:46> _thunk( ) 0x4277ce6280 0x4277ce68a0 <([LEpaComment], [LEpaComment]):GHC.Parser.Lexer:> _thunk( ) 0x4277ce6568 <EpAnnComments:GHC.Parser.Lexer:compiler/GHC/Parser/Lexer.x:2306:19-40> _thunk( ) 0x4277ce62b0 0x4277ce62c0 0x4277ce6280 0x7f61f287fc58 <EpAnn AnnList:GHC.Parser:_build-ipe/stage1/compiler/build/GHC/Parser.hs:12664:13-32> SrcSpanAnn 0x4277ce6060 0x4277ce6048 <SrcSpanAnn':GHC.Parser:_build-ipe/stage1/compiler/build/GHC/Parser.hs:12664:3-35> L 0x4277ce4e70 0x428f8c9158 <GenLocated:GHC.Data.BooleanFormula:compiler/GHC/Data/BooleanFormula.hs:40:23-29> 0x428f8c8318 : 0x428f8c8300 <[]:GHC.Base:libraries/base/GHC/Base.hs:1316:16-29> Or 0x428f8c7890 <BooleanFormula:GHC.Data.BooleanFormula:compiler/GHC/Data/BooleanFormula.hs:40:23-29> IfConcreteClass 0x7f61cd16b440 0x7f61cd16b440 0x428f8c7018 0x428f8c7030 <IfaceClassBody:GHC.Iface.Make:compiler/GHC/Iface/Make.hs:(640,12)-(645,13)> ``` Making these few places strict is sufficient for now but there are perhaps more places which will need strictifying in future. ------------------------- Metric Increase: parsing001 ------------------------- - - - - - 7a8171bc by Tom Sydney Kerckhove at 2021-10-15T06:51:18+00:00 Insert warnings in the documentation of dangerous functions - - - - - 1cda768c by Joachim Breitner at 2021-10-15T18:15:36-04:00 GHC.Builtin.Uniques: Remove unused code a number of functions exported by this module are (no longer) used, so let’s remove them. In particular, it no longer seems to be the case that type variables have tag `'t'`, so removed the special handling when showing them. * the use of `initTyVarUnique` was removed in 7babb1 (with the notable commit message of "Before merging to HEAD we need to tidy up and write a proper commit message.") * `mkPseudoUniqueD`and `mkPseudoUniqueH` were added in 423d477, but never ever used? * `mkCoVarUnique` was added in 674654, but never ever used? - - - - - 88e913d4 by Oleg Grenrus at 2021-10-15T18:16:14-04:00 Null eventlog writer - - - - - bbb1f6da by Sylvain Henry at 2021-10-15T18:16:51-04:00 Hadrian: display command line above errors (#20490) - - - - - b6954f0c by Joachim Breitner at 2021-10-15T18:17:26-04:00 shadowNames: Use OccEnv a, not [OccName] this allows us to use a smarter implementation based on `Data.IntSet.differenceWith`, which should do less work. Also, it will unblock improvements to !6703. The `OccEnv a` really denotes a set of `OccName`s. We are not using `OccSet`, though, because that is an `OccEnv OccName`, and we in !6703 we want to use this with differently-valued `OccEnv`s. But `OccSet`s are readily and safely coerced into `OccEnv`s. There is no other use of `delLocalRdrEnvList` remaining, so removing that. - - - - - c9922a8e by Matthew Pickering at 2021-10-15T18:18:00-04:00 hadrian: Document lint targets Fixes #20508 - - - - - 65bf3992 by Matthew Pickering at 2021-10-17T14:06:08-04:00 ghci: Explicitly store and restore interface file cache In the old days the old HPT was used as an interface file cache when using ghci. The HPT is a `ModuleEnv HomeModInfo` and so if you were using hs-boot files then the interface file from compiling the .hs file would be present in the cache but not the hi-boot file. This used to be ok, because the .hi file used to just be a better version of the .hi-boot file, with more information so it was fine to reuse it. Now the source hash of a module is kept track of in the interface file and the source hash for the .hs and .hs-boot file are correspondingly different so it's no longer safe to reuse an interface file. I took the decision to move the cache management of interface files to GHCi itself, and provide an API where `load` can be provided with a list of interface files which can be used as a cache. An alternative would be to manage this cache somewhere in the HscEnv but it seemed that an API user should be responsible for populating and suppling the cache rather than having it managed implicitly. Fixes #20217 - - - - - 81740ce8 by sheaf at 2021-10-17T14:06:46-04:00 Introduce Concrete# for representation polymorphism checks PHASE 1: we never rewrite Concrete# evidence. This patch migrates all the representation polymorphism checks to the typechecker, using a new constraint form Concrete# :: forall k. k -> TupleRep '[] Whenever a type `ty` must be representation-polymorphic (e.g. it is the type of an argument to a function), we emit a new `Concrete# ty` Wanted constraint. If this constraint goes unsolved, we report a representation-polymorphism error to the user. The 'FRROrigin' datatype keeps track of the context of the representation-polymorphism check, for more informative error messages. This paves the way for further improvements, such as allowing type families in RuntimeReps and improving the soundness of typed Template Haskell. This is left as future work (PHASE 2). fixes #17907 #20277 #20330 #20423 #20426 updates haddock submodule ------------------------- Metric Decrease: T5642 ------------------------- - - - - - 19d1237e by Koz Ross at 2021-10-19T03:29:40-04:00 Fix infelicities in docs for lines, unlines, words, unwords - - - - - 3035d1a2 by Matthew Pickering at 2021-10-19T03:30:16-04:00 tests: Remove $(CABAL_MINIMAL_CONFIGURATION) from T16219 There is a latent issue in T16219 where -dynamic-too is enabled when compiling a signature file which causes us to enter the DT_Failed state because library-a-impl doesn't generate dyn_o files. Somehow this used to work in 8.10 (that also entered the DT_Failed state) We don't need dynamic object files when compiling a signature file but the code loads interfaces, and if dynamic-too is enabled then it will also try to load the dyn_hi file and check the two are consistent. There is another hack to do with this in `GHC.Iface.Recomp`. The fix for this test is to remove CABAL_MINIMAL_CONFIGURATION, which stops cabal building shared libraries by default. I'm of the opinion that the DT_Failed state indicates an error somewhere so we should hard fail rather than this confusing (broken) rerun logic. Whether this captures the original intent of #16219 is debateable, but it's not clear how it was supposed to work in the first place if the libraries didn't build dynamic object files. Module C imports module A, which is from a library where shared objects are not built so the test would never have worked anyway (if anything from A was used in a TH splice). - - - - - d25868b6 by Matthew Pickering at 2021-10-19T03:30:16-04:00 dynamic-too: Expand GHC.Iface.Recomp comment about the backpack hack - - - - - 837ce6cf by Matthew Pickering at 2021-10-19T03:30:16-04:00 driver: Check the correct flag to see if dynamic-too is enabled. We just need to check the flag here rather than read the variable which indicates whether dynamic-too compilation has failed. - - - - - 981f2c74 by Matthew Pickering at 2021-10-19T03:30:16-04:00 driver: Update cached DynFlags in ModSummary if we are enabling -dynamic-too - - - - - 1bc77a85 by Matthew Pickering at 2021-10-19T03:30:16-04:00 dynamic-too: Check the dynamic-too status in hscPipeline This "fixes" DT_Failed in --make mode, but only "fixes" because I still believe DT_Failed is pretty broken. - - - - - 51281e81 by Matthew Pickering at 2021-10-19T03:30:16-04:00 Add test for implicit dynamic too This test checks that we check for missing dynamic objects if dynamic-too is enabled implicitly by the driver. - - - - - 8144a92f by Matthew Pickering at 2021-10-19T03:30:16-04:00 WW: Use module name rather than filename for absent error messages WwOpts in WorkWrap.Utils initialised the wo_output_file field with the result of outputFile dflags. This is misguided because outputFile is only set when -o is specified, which is barely ever (and never in --make mode). It seems this is just used to add more context to an error message, a more appropriate thing to use I think would be a module name. Fixes #20438 - - - - - df419c1a by Matthew Pickering at 2021-10-19T03:30:16-04:00 driver: Cleanups related to ModLocation ModLocation is the data type which tells you the locations of all the build products which can affect recompilation. It is now computed in one place and not modified through the pipeline. Important locations will now just consult ModLocation rather than construct the dynamic object path incorrectly. * Add paths for dynamic object and dynamic interface files to ModLocation. * Always use the paths from mod location when looking for where to find any interface or object file. * Always use the paths in a ModLocation when deciding where to write an interface and object file. * Remove `dynamicOutputFile` and `dynamicOutputHi` functions which *calculated* (incorrectly) the location of `dyn_o` and `dyn_hi` files. * Don't set `outputFile_` and so-on in `enableCodeGenWhen`, `-o` and hence `outputFile_` should not affect the location of object files in `--make` mode. It is now sufficient to just update the ModLocation with the temporary paths. * In `hscGenBackendPipeline` don't recompute the `ModLocation` to account for `-dynamic-too`, the paths are now accurate from the start of the run. * Rename `getLocation` to `mkOneShotModLocation`, as that's the only place it's used. Increase the locality of the definition by moving it close to the use-site. * Load the dynamic interface from ml_dyn_hi_file rather than attempting to reconstruct it in load_dynamic_too. * Add a variety of tests to check how -o -dyno etc interact with each other. Some other clean-ups * DeIOify mkHomeModLocation and friends, they are all pure functions. * Move FinderOpts into GHC.Driver.Config.Finder, next to initFinderOpts. * Be more precise about whether we mean outputFile or outputFile_: there were many places where outputFile was used but the result shouldn't have been affected by `-dyno` (for example the filename of the resulting executable). In these places dynamicNow would never be set but it's still more precise to not allow for this possibility. * Typo fixes suffices -> suffixes in the appropiate places. - - - - - 3d6eb85e by Matthew Pickering at 2021-10-19T03:30:16-04:00 driver: Correct output of -fno-code and -dynamic-too Before we would print [1 of 3] Compiling T[boot] ( T.hs-boot, nothing, T.dyn_o ) Which was clearly wrong for two reasons. 1. No dynamic object file was produced for T[boot] 2. The file would be called T.dyn_o-boot if it was produced. Fixes #20300 - - - - - 753b921d by Matthew Pickering at 2021-10-19T03:30:16-04:00 Remove DT_Failed state At the moment if `-dynamic-too` fails then we rerun the whole pipeline as if we were just in `-dynamic` mode. I argue this is a misfeature and we should remove the so-called `DT_Failed` mode. In what situations do we fall back to `DT_Failed`? 1. If the `dyn_hi` file corresponding to a `hi` file is missing completely. 2. If the interface hash of `dyn_hi` doesn't match the interface hash of `hi`. What happens in `DT_Failed` mode? * The whole compiler pipeline is rerun as if the user had just passed `-dynamic`. * Therefore `dyn_hi/dyn_o` files are used which don't agree with the `hi/o` files. (As evidenced by `dynamicToo001` test). * This is very confusing as now a single compiler invocation has produced further `hi`/`dyn_hi` files which are different to each other. Why should we remove it? * In `--make` mode, which is predominately used `DT_Failed` does not work (#19782), there can't be users relying on this functionality. * In `-c` mode, the recovery doesn't fix the root issue, which is the `dyn_hi` and `hi` files are mismatched. We should instead produce an error and pass responsibility to the build system using `-c` to ensure that the prerequisites for `-dynamic-too` (dyn_hi/hi) files are there before we start compiling. * It is a misfeature to support use cases like `dynamicToo001` which allow you to mix different versions of dynamic/non-dynamic interface files. It's more likely to lead to subtle bugs in your resulting programs where out-dated build products are used rather than a deliberate choice. * In practice, people are usually compiling with `-dynamic-too` rather than separately with `-dynamic` and `-static`, so the build products always match and `DT_Failed` is only entered due to compiler bugs (see !6583) What should we do instead? * In `--make` mode, for home packages check during recompilation checking that `dyn_hi` and `hi` are both present and agree, recompile the modules if they do not. * For package modules, when loading the interface check that `dyn_hi` and `hi` are there and that they agree but fail with an error message if they are not. * In `--oneshot` mode, fail with an error message if the right files aren't already there. Closes #19782 #20446 #9176 #13616 - - - - - 7271bf78 by Joachim Breitner at 2021-10-19T03:30:52-04:00 InteractiveContext: Smarter caching when rebuilding the ic_rn_gbl_env The GlobalRdrEnv of a GHCI session changes in odd ways: New bindings are not just added "to the end", but also "in the middle", namely when changing the set of imports: These are treated as if they happened before all bindings from the prompt, even those that happened earlier. Previously, this meant that the `ic_rn_gbl_env` is recalculated from the `ic_tythings`. But this wasteful if `ic_tythings` has many entries that define the same unqualified name. By separately keeping track of a `GlobalRdrEnv` of all the locally defined things we can speed this operation up significantly. This change improves `T14052Type` by 60% (It used to be 70%, but it looks that !6723 already reaped some of the rewards). But more importantly, it hopefully unblocks #20455, becaues with this smarter caching, the change needed to fix that issue will no longer make `T14052` explode. I hope. It does regress `T14052` by 30%; caching isn’t free. Oh well. Metric Decrease: T14052Type Metric Increase: T14052 - - - - - 53c0e771 by Matthew Pickering at 2021-10-19T03:31:27-04:00 Add test for T20509 This test checks to see whether a signature can depend on another home module. Whether it should or not is up for debate, see #20509 for more details. - - - - - fdfb3b03 by Matthew Pickering at 2021-10-19T03:31:27-04:00 Make the fields of Target and TargetId strict Targets are long-lived through GHC sessions so we don't want to end up retaining In particular in 'guessTarget', the call to `unitIdOrHomeUnit` was retaining reference to an entire stale HscEnv, which in turn retained reference to a stale HomePackageTable. Making the fields strict forces that place promptly and helps ensure that mistakes like this don't happen again. - - - - - 877e6685 by Matthew Pickering at 2021-10-19T03:31:27-04:00 Temporary fix for leak with -fno-code (#20509) This hack inserted for backpack caused a very bad leak when using -fno-code where EPS entries would end up retaining stale HomePackageTables. For any interactive user, such as HLS, this is really bad as once the entry makes it's way into the EPS then it's there for the rest of the session. This is a temporary fix which "solves" the issue by filtering the HPT to only the part which is needed for the hack to work, but in future we want to separate out hole modules from the HPT entirely to avoid needing to do this kind of special casing. ------------------------- Metric Decrease: MultiLayerModulesDefsGhci ------------------------- - - - - - cfacac68 by Matthew Pickering at 2021-10-19T03:31:27-04:00 Add performance test for ghci, -fno-code and reloading (#20509) This test triggers the bad code path identified by #20509 where an entry into the EPS caused by importing Control.Applicative will retain a stale HomePackageTable. - - - - - 12d74ef7 by Richard Eisenberg at 2021-10-19T13:36:36-04:00 Care about specificity in pattern type args Close #20443. - - - - - 79c9c816 by Zubin Duggal at 2021-10-19T13:37:12-04:00 Don't print Shake Diagnostic messages (#20484) - - - - - f8ce38e6 by Emily Martins at 2021-10-19T22:21:26-04:00 Fix #19884: add warning to tags command, drop T10989 - - - - - d73131b9 by Ben Gamari at 2021-10-19T22:22:02-04:00 hadrian: Fix quoting in binary distribution installation Makefile Previously we failed to quote various paths in Hadrian's installation Makefile, resulting in #20506. - - - - - 949d7398 by Matthew Pickering at 2021-10-20T14:05:23-04:00 Add note about heap invariants [skip ci] At the moment the note just covers three important invariants but now there is a place to add more to if we think of them. - - - - - 2f75ffac by Ben Gamari at 2021-10-20T14:06:00-04:00 hadrian/doc: Add margin to staged-compilation figure - - - - - 5f274fbf by Ben Gamari at 2021-10-20T14:06:00-04:00 hadrian: Fix binary-dist support for cross-compilers Previously the logic which called ghc-pkg failed to account for the fact that the executable name may be prefixed with a triple. Moreover, the call must occur before we delete the settings file as ghc-pkg needs the latter. Fixes #20267. - - - - - 3e4b51ff by Matthew Pickering at 2021-10-20T14:06:36-04:00 Fix perf-nofib CI job The main change is to install the necessary build dependencies into an environment file using `caball install --lib`. Also updates the nofib submodule with a few fixes needed for the job to work. - - - - - ef92d889 by Matthew Pickering at 2021-10-20T14:07:12-04:00 Distribute HomeModInfo cache before starting upsweep This change means the HomeModInfo cache isn't retained until the end of upsweep and each cached interface can be collected immediately after its module is compiled. The result is lower peak memory usage when using GHCi. For Agda it reduced peak memory usage from about 1600M to 1200M. - - - - - 05b8a218 by Matthew Pickering at 2021-10-20T14:07:49-04:00 Make fields of GlobalRdrElt strict In order to do this I thought it was prudent to change the list type to a bag type to avoid doing a lot of premature work in plusGRE because of ++. Fixes #19201 - - - - - 0b575899 by Sylvain Henry at 2021-10-20T17:49:07-04:00 Bignum: constant folding for bigNatCompareWord# (#20361) - - - - - 758e0d7b by Sylvain Henry at 2021-10-20T17:49:07-04:00 Bignum: allow Integer predicates to inline (#20361) T17516 allocations increase by 48% because Integer's predicates are inlined in some Ord instance methods. These methods become too big to be inlined while they probably should: this is tracked in #20516. Metric Increase: T17516 - - - - - a901a1ae by Sylvain Henry at 2021-10-20T17:49:07-04:00 Bignum: allow Integer's signum to inline (#20361) Allow T12545 to increase because it only happens on CI with dwarf enabled and probably not related to this patch. Metric Increase: T12545 - - - - - 9ded1b17 by Matthew Pickering at 2021-10-20T17:49:42-04:00 Make sure ModIface values are still forced even if not written When we are not writing a ModIface to disk then the result can retain a lot of stuff. For example, in the case I was debugging the DocDeclsMap field was holding onto the entire HomePackageTable due to a single unforced thunk. Therefore, now if we're not going to write the interface then we still force deeply it in order to remove these thunks. The fields in the data structure are not made strict because when we read the field from the interface we don't want to load it immediately as there are parts of an interface which are unused a lot of the time. Also added a note to explain why not all the fields in a ModIface field are strict. The result of this is being able to load Agda in ghci and not leaking information across subsequent reloads. - - - - - 268857af by Matthew Pickering at 2021-10-20T17:50:19-04:00 ci: Move hlint jobs from quick-built into full-build This somewhat fixes the annoyance of not getting any "useful" feedback from a CI pipeline if you have a hlint failure. Now the hlint job runs in parallel with the other CI jobs so the feedback is recieved at the same time as other testsuite results. Fixes #20507 - - - - - f6f24515 by Joachim Breitner at 2021-10-20T17:50:54-04:00 instance Ord Name: Do not repeat default methods it is confusing to see what looks like it could be clever code, only to see that it does precisely the same thing as the default methods. Cleaning this up, to spare future readers the confusion. - - - - - 56b2b04f by Ziyang Liu at 2021-10-22T10:57:28-04:00 Document that `InScopeSet` is a superset of currently in-scope variables - - - - - 7f4e0e91 by Moritz Angermann at 2021-10-22T10:58:04-04:00 Do not sign extend CmmInt's unless negative. Might fix #20526. - - - - - 77c6f3e6 by sheaf at 2021-10-22T10:58:44-04:00 Use tcEqType in GHC.Core.Unify.uVar Because uVar used eqType instead of tcEqType, it was possible to accumulate a substitution that unified Type and Constraint. For example, a call to `tc_unify_tys` with arguments tys1 = [ k, k ] tys2 = [ Type, Constraint ] would first add `k = Type` to the substitution. That's fine, but then the second call to `uVar` would claim that the substitution also unifies `k` with `Constraint`. This could then be used to cause trouble, as per #20521. Fixes #20521 - - - - - fa5870d3 by Sylvain Henry at 2021-10-22T19:20:05-04:00 Add test for #19641 Now that Bignum predicates are inlined (!6696), we only need to add a test. Fix #19641 - - - - - 6fd7da74 by Sylvain Henry at 2021-10-22T19:20:44-04:00 Remove Indefinite We no longer need it after previous IndefUnitId refactoring. - - - - - 806e49ae by Sylvain Henry at 2021-10-22T19:20:44-04:00 Refactor package imports Use an (Raw)PkgQual datatype instead of `Maybe FastString` to represent package imports. Factorize the code that renames RawPkgQual into PkgQual in function `rnPkgQual`. Renaming consists in checking if the FastString is the magic "this" keyword, the home-unit unit-id or something else. Bump haddock submodule - - - - - 47ba842b by Haochen Tong at 2021-10-22T19:21:21-04:00 Fix compilerConfig stages Fix the call to compilerConfig because it accepts 1-indexed stage numbers. Also fixes `make stage=3`. - - - - - 621608c9 by Matthew Pickering at 2021-10-22T19:21:56-04:00 driver: Don't use the log queue abstraction when j = 1 This simplifies the code path for -j1 by not using the log queue queue abstraction. The result is that trace output isn't interleaved with other dump output like it can be with -j<N>. - - - - - dd2dba80 by Sebastian Graf at 2021-10-22T19:22:31-04:00 WorkWrap: `isRecDataCon` should not eta-reduce NewTyCon field tys (#20539) In #20539 we had a type ```hs newtype Measured a = Measured { unmeasure :: () -> a } ``` and `isRecDataCon Measured` recursed into `go_arg_ty` for `(->) ()`, because `unwrapNewTyConEtad_maybe` eta-reduced it. That triggered an assertion error a bit later. Eta reducing the field type is completely wrong to do here! Just call `unwrapNewTyCon_maybe` instead. Fixes #20539 and adds a regression test T20539. - - - - - 8300ca2e by Ben Gamari at 2021-10-24T01:26:11-04:00 driver: Export wWarningFlagMap A new feature requires Ghcide to be able to convert warnings to CLI flags (WarningFlag -> String). This is most easily implemented in terms of the internal function flagSpecOf, which uses an inefficient implementation based on linear search through a linked list. This PR derives Ord for WarningFlag, and replaces that list with a Map. Closes #19087. - - - - - 3bab222c by Sebastian Graf at 2021-10-24T01:26:46-04:00 DmdAnal: Implement Boxity Analysis (#19871) This patch fixes some abundant reboxing of `DynFlags` in `GHC.HsToCore.Match.Literal.warnAboutOverflowedLit` (which was the topic of #19407) by introducing a Boxity analysis to GHC, done as part of demand analysis. This allows to accurately capture ad-hoc unboxing decisions previously made in worker/wrapper in demand analysis now, where the boxity info can propagate through demand signatures. See the new `Note [Boxity analysis]`. The actual fix for #19407 is described in `Note [No lazy, Unboxed demand in demand signature]`, but `Note [Finalising boxity for demand signature]` is probably a better entry-point. To support the fix for #19407, I had to change (what was) `Note [Add demands for strict constructors]` a bit (now `Note [Unboxing evaluated arguments]`). In particular, we now take care of it in `finaliseBoxity` (which is only called from demand analaysis) instead of `wantToUnboxArg`. I also had to resurrect `Note [Product demands for function body]` and rename it to `Note [Unboxed demand on function bodies returning small products]` to avoid huge regressions in `join004` and `join007`, thereby fixing #4267 again. See the updated Note for details. A nice side-effect is that the worker/wrapper transformation no longer needs to look at strictness info and other bits such as `InsideInlineableFun` flags (needed for `Note [Do not unbox class dictionaries]`) at all. It simply collects boxity info from argument demands and interprets them with a severely simplified `wantToUnboxArg`. All the smartness is in `finaliseBoxity`, which could be moved to DmdAnal completely, if it wasn't for the call to `dubiousDataConInstArgTys` which would be awkward to export. I spent some time figuring out the reason for why `T16197` failed prior to my amendments to `Note [Unboxing evaluated arguments]`. After having it figured out, I minimised it a bit and added `T16197b`, which simply compares computed strictness signatures and thus should be far simpler to eyeball. The 12% ghc/alloc regression in T11545 is because of the additional `Boxity` field in `Poly` and `Prod` that results in more allocation during `lubSubDmd` and `plusSubDmd`. I made sure in the ticky profiles that the number of calls to those functions stayed the same. We can bear such an increase here, as we recently improved it by -68% (in b760c1f). T18698* regress slightly because there is more unboxing of dictionaries happening and that causes Lint (mostly) to allocate more. Fixes #19871, #19407, #4267, #16859, #18907 and #13331. Metric Increase: T11545 T18698a T18698b Metric Decrease: T12425 T16577 T18223 T18282 T4267 T9961 - - - - - 691c450f by Alan Zimmerman at 2021-10-24T01:27:21-04:00 EPA: Use LocatedA for ModuleName This allows us to use an Anchor with a DeltaPos in it when exact printing. - - - - - 3417a81a by Joachim Breitner at 2021-10-24T01:27:57-04:00 undefined: Neater CallStack in error message Users of `undefined` don’t want to see ``` files.hs: Prelude.undefined: CallStack (from HasCallStack): error, called at libraries/base/GHC/Err.hs:79:14 in base:GHC.Err undefined, called at file.hs:151:19 in main:Main ``` but want to see ``` files.hs: Prelude.undefined: CallStack (from HasCallStack): undefined, called at file.hs:151:19 in main:Main ``` so let’s make that so. The function for that is `withFrozenCallStack`, but that is not usable here (module dependencies, and also not representation-polymorphic). And even if it were, it could confuse GHC’s strictness analyzer, leading to big regressions in some perf tests (T10421 in particular). So after shuffling modules and definitions around, I eventually noticed that the easiest way is to just not call `error` here. Fixes #19886 - - - - - 98aa29d3 by John Ericson at 2021-10-24T01:28:33-04:00 Fix dangling reference to RtsConfig.h It hasn't existed since a2a67cd520b9841114d69a87a423dabcb3b4368e -- in 2009! - - - - - 9cde38a0 by John Ericson at 2021-10-25T17:45:15-04:00 Remove stray reference to `dist-ghcconstants` I think this hasn't been a thing since 86054b4ab5125a8b71887b06786d0a428539fb9c, almost 10 years ago! - - - - - 0f7541dc by Viktor Dukhovni at 2021-10-25T17:45:51-04:00 Tweak descriptions of lines and unlines It seems more clear to think of lines as LF-terminated rather than LF-separated. - - - - - 0255ef38 by Zubin Duggal at 2021-10-26T12:36:24-04:00 Warn if unicode bidirectional formatting characters are found in the source (#20263) - - - - - 9cc6c193 by sheaf at 2021-10-26T12:37:02-04:00 Don't default type variables in type families This patch removes the following defaulting of type variables in type and data families: - type variables of kind RuntimeRep defaulting to LiftedRep - type variables of kind Levity defaulting to Lifted - type variables of kind Multiplicity defaulting to Many It does this by passing "defaulting options" to the `defaultTyVars` function; when calling from `tcTyFamInstEqnGuts` or `tcDataFamInstHeader` we pass options that avoid defaulting. This avoids wildcards being defaulted, which caused type families to unexpectedly fail to reduce. Note that kind defaulting, applicable only with -XNoPolyKinds, is not changed by this patch. Fixes #17536 ------------------------- Metric Increase: T12227 ------------------------- - - - - - cc113616 by Artyom Kuznetsov at 2021-10-26T20:27:33+00:00 Change CaseAlt and LambdaExpr to FunRhs in deriving Foldable and Traversable (#20496) - - - - - 9bd6daa4 by John Ericson at 2021-10-27T13:29:39-04:00 Make build system: Generalize and/or document distdirs `manual-package-config` should not hard-code the distdir, and no longer does Elsewhere, we must continue to hard-code due to inconsitent distdir names across stages, so we document this referring to the existing note "inconsistent distdirs". - - - - - 9d577ea1 by John Ericson at 2021-10-27T13:30:15-04:00 Compiler dosen't need to know about certain settings from file - RTS and libdw - SMP - RTS ways I am leaving them in the settings file because `--info` currently prints all the fields in there, but in the future I do believe we should separate the info GHC actually needs from "extra metadata". The latter could go in `+RTS --info` and/or a separate file that ships with the RTS for compile-time inspection instead. - - - - - ed9ec655 by Ben Gamari at 2021-10-27T13:30:55-04:00 base: Note export of Data.Tuple.Solo in changelog - - - - - 638f6548 by Ben Gamari at 2021-10-27T13:30:55-04:00 hadrian: Turn the `static` flavour into a transformer This turns the `static` flavour into the `+fully_static` flavour transformer. - - - - - 522eab3f by Ziyang Liu at 2021-10-29T05:01:50-04:00 Show family TyCons in mk_dict_error in the case of a single match - - - - - 71700526 by Sebastian Graf at 2021-10-29T05:02:25-04:00 Add more INLINABLE and INLINE pragmas to `Enum Int*` instances Otherwise the instances aren't good list producers. See Note [Stable Unfolding for list producers]. - - - - - 925c47b4 by Sebastian Graf at 2021-10-29T05:02:25-04:00 WorkWrap: Update Unfolding with WW'd body prior to `tryWW` (#20510) We have a function in #20510 that is small enough to get a stable unfolding in WW: ```hs small :: Int -> Int small x = go 0 x where go z 0 = z * x go z y = go (z+y) (y-1) ``` But it appears we failed to use the WW'd RHS as the stable unfolding. As a result, inlining `small` would expose the non-WW'd version of `go`. That appears to regress badly in #19727 which is a bit too large to extract a reproducer from that is guaranteed to reproduce across GHC versions. The solution is to simply update the unfolding in `certainlyWillInline` with the WW'd RHS. Fixes #20510. - - - - - 7b67724b by John Ericson at 2021-10-29T16:57:48-04:00 make build system: RTS should use dist-install not dist This is the following find and replace: - `rts/dist` -> `rts/dist-install` # for paths - `rts_dist` -> `rts_dist-install` # for make rules and vars - `,dist` -> `,dist-install` # for make, just in rts/ghc.mk` Why do this? Does it matter when the RTS is just built once? The answer is, yes, I think it does, because I want the distdir--stage correspondence to be consistent. In particular, for #17191 and continuing from d5de970dafd5876ef30601697576167f56b9c132 I am going to make the headers (`rts/includes`) increasingly the responsibility of the RTS (hence their new location). However, those headers are current made for multiple stages. This will probably become unnecessary as work on #17191 progresses and the compiler proper becomes more of a freestanding cabal package (e.g. a library that can be downloaded from Hackage and built without any autoconf). However, until that is finished, we have will transitional period where the RTS and headers need to agree on dirs for multiple stages. I know the make build system is going away, but it's not going yet, so I need to change it to unblock things :). - - - - - b0a1ed55 by Sylvain Henry at 2021-10-29T16:58:35-04:00 Add test for T15547 (#15547) Fix #15547 - - - - - c8d89f62 by Sylvain Henry at 2021-10-29T16:58:35-04:00 Bignum: add missing rule Add missing "Natural -> Integer -> Word#" rule. - - - - - 2a4581ff by sheaf at 2021-10-29T16:59:13-04:00 User's guide: data family kind-inference changes Explain that the kind of a data family instance must now be fully determined by the header of the instance, and how one might migrate code to account for this change. Fixes #20527 - - - - - ea862ef5 by Ben Gamari at 2021-10-30T15:43:28-04:00 ghci: Make getModBreaks robust against DotO Unlinked Previously getModBreaks assumed that an interpreted linkable will have only a single `BCOs` `Unlinked` entry. However, in general an object may also contain `DotO`s; ignore these. Fixes #20570. - - - - - e4095c0c by John Ericson at 2021-10-31T09:04:41-04:00 Make build system: Put make generated include's in RTS distdirs These are best thought of as being part of the RTS. - After !6791, `ghcautoconf.h` won't be used by the compiler inappropriately. - `ghcversion.h` is only used once outside the RTS, which is `compiler/cbits/genSym.c`. Except we *do* mean the RTS GHC is built against there, so it's better if we always get get the installed version. - `ghcplatform.h` alone is used extensively outside the RTS, but since we no longer have a target platform it is perfectly safe/correct to get the info from the previous RTS. All 3 are exported from the RTS currently and in the bootstrap window. This commit just swaps directories around, such that the new headers may continue to be used in stage 0 despite the reasoning above, but the idea is that we can subsequently make more interesting changes doubling down on the reasoning above. In particular, in !6803 we'll start "morally" moving `ghcautonconf.h` over, introducing an RTS configure script and temporary header of its `AC_DEFINE`s until the top-level configure script doesn't define any more. Progress towards #17191 - - - - - f5471c0b by John Ericson at 2021-10-31T09:05:16-04:00 Modularize autoconf platform detection This will allow better reuse of it, such as in the upcoming RTS configure script. Progress towards #17191 - - - - - 6b38c8a6 by Ben Gamari at 2021-10-31T09:05:52-04:00 ghc: Bump Cabal-Version to 1.22 This is necessary to use reexported-modules - - - - - 6544446d by Ben Gamari at 2021-10-31T09:05:52-04:00 configure: Hide error output from --target check - - - - - 7445bd71 by Andreas Klebinger at 2021-11-01T12:13:45+00:00 Update comment in Lint.hs mkWwArgs has been renamed to mkWorkerArgs. - - - - - f1a782dd by Vladislav Zavialov at 2021-11-02T01:36:32-04:00 HsToken for let/in (#19623) One more step towards the new design of EPA. - - - - - 37a37139 by John Ericson at 2021-11-02T01:37:08-04:00 Separate some AC_SUBST / AC_DEFINE Eventually, the RTS configure alone will need the vast majority of AC_DEFINE, and the top-level configure will need the most AC_SUBST. By removing the "side effects" of the macros like this we make them more reusable so they can be shared between the two configures without doing too much. - - - - - 2f69d102 by John Ericson at 2021-11-02T01:37:43-04:00 Remove `includes_GHCCONSTANTS` from make build system It is dead code. - - - - - da1a8e29 by John Ericson at 2021-11-02T01:37:43-04:00 Treat generated RTS headers in a more consistent manner We can depend on all of them at once the same way. - - - - - a7e1be3d by Ryan Scott at 2021-11-02T01:38:53-04:00 Fix #20590 with another application of mkHsContextMaybe We were always converting empty GADT contexts to `Just []` in `GHC.ThToHs`, which caused the pretty-printer to always print them as `() => ...`. This is easily fixed by using the `mkHsContextMaybe` function when converting GADT contexts so that empty contexts are turned to `Nothing`. This is in the same tradition established in commit 4c87a3d1d14f9e28c8aa0f6062e9c4201f469ad7. In the process of fixing this, I discovered that the `Cxt` argument to `mkHsContextMaybe` is completely unnecessary, as we can just as well check if the `LHsContext GhcPs` argument is empty. Fixes #20590. - - - - - 39eed84c by Alan Zimmerman at 2021-11-02T21:39:32+00:00 EPA: Get rid of bare SrcSpan's in the ParsedSource The ghc-exactPrint library has had to re-introduce the relatavise phase. This is needed if you change the length of an identifier and want the layout to be preserved afterwards. It is not possible to relatavise a bare SrcSpan, so introduce `SrcAnn NoEpAnns` for them instead. Updates haddock submodule. - - - - - 9f42a6dc by ARATA Mizuki at 2021-11-03T09:19:17-04:00 hadrian: Use $bindir instead of `dirname $0` in ghci wrapper `dirname $0` doesn't work when the wrapper is called via a symbolic link. Fix #20589 - - - - - bf6f96a6 by Vladislav Zavialov at 2021-11-03T16:35:50+03:00 Generalize the type of wrapLocSndMA - - - - - 1419fb16 by Matthew Pickering at 2021-11-04T00:36:09-04:00 ci: Don't run alpine job in fast-ci - - - - - 6020905a by Takenobu Tani at 2021-11-04T09:40:42+00:00 Correct load_load_barrier for risc-v This patch corrects the instruction for load_load_barrier(). Current load_load_barrier() incorrectly uses `fence w,r`. It means a store-load barrier. See also linux-kernel's smp_rmb() implementation: https://github.com/torvalds/linux/blob/v5.14/arch/riscv/include/asm/barrier.h#L27 - - - - - 086e288c by Richard Eisenberg at 2021-11-04T13:04:44-04:00 Tiny renamings and doc updates Close #20433 - - - - - f0b920d1 by CarrieMY at 2021-11-05T05:30:13-04:00 Fix deferOutOfScopeVariables for qualified #20472 - - - - - 59dfb005 by Simon Peyton Jones at 2021-11-05T05:30:48-04:00 Remove record field from Solo Ticket #20562 revealed that Solo, which is a wired-in TyCon, had a record field that wasn't being added to the type env. Why not? Because wired-in TyCons don't have record fields. It's not hard to change that, but it's tiresome for this one use-case, and it seems easier simply to make `getSolo` into a standalone function. On the way I refactored the handling of Solo slightly, to put it into wiredInTyCons (where it belongs) rather than only in knownKeyNames - - - - - be3750a5 by Matthew Pickering at 2021-11-05T10:12:16-04:00 Allow CApi FFI calls in GHCi At some point in the past this started working. I noticed this when working on multiple home units and couldn't load GHC's dependencies into the interpreter. Fixes #7388 - - - - - d96ce59d by John Ericson at 2021-11-05T10:12:52-04:00 make: Futher systematize handling of generated headers This will make it easier to add and remove generated headers, as we will do when we add a configure script for the RTS. - - - - - 3645abac by John Ericson at 2021-11-05T20:25:32-04:00 Avoid GHC_STAGE and other include bits We should strive to make our includes in terms of the RTS as much as possible. One place there that is not possible, the llvm version, we make a new tiny header Stage numbers are somewhat arbitrary, if we simple need a newer RTS, we should say so. - - - - - 4896a6a6 by Matthew Pickering at 2021-11-05T20:26:07-04:00 Fix boolean confusion with Opt_NoLlvmMangler flag I accidently got the two branches of the if expression the wrong way around when refactoring. Fixes #20567 - - - - - d74cc01e by Ziyang Liu at 2021-11-06T07:53:06-04:00 Export `withTcPlugins` and `withHoleFitPlugins` - - - - - ecd6d142 by Sylvain Henry at 2021-11-06T07:53:42-04:00 i386: fix codegen of 64-bit comparisons - - - - - e279ea64 by Sylvain Henry at 2021-11-06T07:53:42-04:00 Add missing Int64/Word64 constant-folding rules - - - - - 4c86df25 by Sylvain Henry at 2021-11-06T07:53:42-04:00 Fix Int64ToInt/Word64ToWord rules on 32-bit architectures When the input literal was larger than 32-bit it would crash in a compiler with assertion enabled because it was creating an out-of-bound word-sized literal (32-bit). - - - - - 646c3e21 by Sylvain Henry at 2021-11-06T07:53:42-04:00 CI: allow perf-nofib to fail - - - - - 20956e57 by Sylvain Henry at 2021-11-06T07:53:42-04:00 Remove target dependent CPP for Word64/Int64 (#11470) Primops types were dependent on the target word-size at *compiler* compilation time. It's an issue for multi-target as GHC may not have the correct primops types for the target. This patch fixes some primops types: if they take or return fixed 64-bit values they now always use `Int64#/Word64#`, even on 64-bit architectures (where they used `Int#/Word#` before). Users of these primops may now need to convert from Int64#/Word64# to Int#/Word# (a no-op at runtime). This is a stripped down version of !3658 which goes the all way of changing the underlying primitive types of Word64/Int64. This is left for future work. T12545 allocations increase ~4% on some CI platforms and decrease ~3% on AArch64. Metric Increase: T12545 Metric Decrease: T12545 - - - - - 2800eee2 by Sylvain Henry at 2021-11-06T07:53:42-04:00 Make Word64 use Word64# on every architecture - - - - - be9d7862 by Sylvain Henry at 2021-11-06T07:53:42-04:00 Fix Int64/Word64's Enum instance fusion Performance improvement: T15185(normal) run/alloc 51112.0 41032.0 -19.7% GOOD Metric Decrease: T15185 - - - - - 6f2d6a5d by Nikolay Yakimov at 2021-11-06T11:24:50-04:00 Add regression test for #20568 GHC produced broken executables with rebindable if and -fhpc if `ifThenElse` expected non-Bool condition until GHC 9.0. This adds a simple regression test. - - - - - 7045b783 by Vladislav Zavialov at 2021-11-06T11:25:25-04:00 Refactor HdkM using deriving via * No more need for InlineHdkM, mkHdkM * unHdkM is now just a record selector * Update comments - - - - - 0d8a883e by Andreas Klebinger at 2021-11-07T12:54:30-05:00 Don't undersaturate join points through eta-reduction. In #20599 I ran into an issue where the unfolding for a join point was eta-reduced removing the required lambdas. This patch adds guards that should prevent this from happening going forward. - - - - - 3d7e3d91 by Vladislav Zavialov at 2021-11-07T12:55:05-05:00 Print the Type kind qualified when ambiguous (#20627) The Type kind is printed unqualified: ghci> :set -XNoStarIsType ghci> :k (->) (->) :: Type -> Type -> Type This is the desired behavior unless the user has defined their own Type: ghci> data Type Then we want to resolve the ambiguity by qualification: ghci> :k (->) (->) :: GHC.Types.Type -> GHC.Types.Type -> GHC.Types.Type - - - - - 184f6bc6 by John Ericson at 2021-11-07T16:26:10-05:00 Factor out unregisterised and tables next to code m4 macros These will be useful for upcoming RTS configure script. - - - - - 56705da8 by Sebastian Graf at 2021-11-07T16:26:46-05:00 Pmc: Do inhabitation test for unlifted vars (#20631) Although I thought we were already set to handle unlifted datatypes correctly, it appears we weren't. #20631 showed that it's wrong to assume `vi_bot=IsNotBot` for `VarInfo`s of unlifted types from their inception if we don't follow up with an inhabitation test to see if there are any habitable constructors left. We can't trigger the test from `emptyVarInfo`, so now we instead fail early in `addBotCt` for variables of unlifted types. Fixed #20631. - - - - - 28334b47 by sheaf at 2021-11-08T13:40:05+01:00 Default kind vars in tyfams with -XNoPolyKinds We should still default kind variables in type families in the presence of -XNoPolyKinds, to avoid suggesting enabling -XPolyKinds just because the function arrow introduced kind variables, e.g. type family F (t :: Type) :: Type where F (a -> b) = b With -XNoPolyKinds, we should still default `r :: RuntimeRep` in `a :: TYPE r`. Fixes #20584 - - - - - 3f103b1a by John Ericson at 2021-11-08T19:35:12-05:00 Factor out GHC_ADJUSTORS_METHOD m4 macro - - - - - ba9fdc51 by John Ericson at 2021-11-08T19:35:12-05:00 Factor out FP_FIND_LIBFFI and use in RTS configure too - - - - - 2929850f by Sylvain Henry at 2021-11-09T10:02:06-05:00 RTS: open timerfd synchronously (#20618) - - - - - bc498fdf by Sylvain Henry at 2021-11-09T10:02:46-05:00 Bignum: expose backendName (#20495) - - - - - 79a26df1 by Sylvain Henry at 2021-11-09T10:02:46-05:00 Don't expose bignum backend in ghc --info (#20495) GHC is bignum backend agnostic and shouldn't report this information as in the future ghc-bignum will be reinstallable potentially with a different backend that GHC is unaware of. Moreover as #20495 shows the returned information may be wrong currently. - - - - - e485f4f2 by Andreas Klebinger at 2021-11-09T19:54:31-05:00 SpecConstr - Attach evaldUnfolding to known evaluated arguments. - - - - - 983a99f0 by Ryan Scott at 2021-11-09T19:55:07-05:00 deriving: infer DatatypeContexts from data constructors, not type constructor Previously, derived instances that use `deriving` clauses would infer `DatatypeContexts` by using `tyConStupidTheta`. But this sometimes causes redundant constraints to be included in the derived instance contexts, as the constraints that appear in the `tyConStupidTheta` may not actually appear in the types of the data constructors (i.e., the `dataConStupidTheta`s). For instance, in `data Show a => T a = MkT deriving Eq`, the type of `MkT` does not require `Show`, so the derived `Eq` instance should not require `Show` either. This patch makes it so with some small tweaks to `inferConstraintsStock`. Fixes #20501. - - - - - bdd7b2be by Ryan Scott at 2021-11-09T19:55:07-05:00 Flesh out Note [The stupid context] and reference it `Note [The stupid context]` in `GHC.Core.DataCon` talks about stupid contexts from `DatatypeContexts`, but prior to this commit, it was rather outdated. This commit spruces it up and references it from places where it is relevant. - - - - - 95563259 by Li-yao Xia at 2021-11-10T09:16:21-05:00 Fix rendering of Applicative law - - - - - 0f852244 by Viktor Dukhovni at 2021-11-10T09:16:58-05:00 Improve ZipList section of Traversable overview - Fix cut/paste error by adding missing `c` pattern in `Vec3` traversable instance. - Add a bit of contextual prose above the Vec2/Vec3 instance sample code. - - - - - c4cd13b8 by Richard Eisenberg at 2021-11-10T18:18:19-05:00 Fix Note [Function types] Close #19938. - - - - - dfb9913c by sheaf at 2021-11-10T18:18:59-05:00 Improvements to rank_polymorphism.rst - rename the function f4 to h1 for consistency with the naming convention - be more explicit about the difference between `Int -> (forall a. a -> a)` and `forall a. Int -> (a -> a)` - reorder the section to make it flow better Fixes #20585 - - - - - 1540f556 by sheaf at 2021-11-10T18:19:37-05:00 Clarify hs-boot file default method restrictions The user guide wrongly stated that default methods should not be included in hs-boot files. In fact, if the class is not left abstract (no methods, no superclass constraints, ...) then the defaults must be provided and match with those given in the .hs file. We add some tests for this, as there were no tests in the testsuite that gave rise to the "missing default methods" error. Fixes #20588 - - - - - 8c0aec38 by Sylvain Henry at 2021-11-10T18:20:17-05:00 Hadrian: fix building/registering of .dll libraries - - - - - 11c9a469 by Matthew Pickering at 2021-11-11T07:21:28-05:00 testsuite: Convert hole fit performance tests into proper perf tests Fixes #20621 - - - - - c2ed85cb by Matthew Pickering at 2021-11-11T07:22:03-05:00 driver: Cache the transitive dependency calculation in ModuleGraph Two reasons for this change: 1. Avoid computing the transitive dependencies when compiling each module, this can save a lot of repeated work. 2. More robust to forthcoming changes to support multiple home units. - - - - - 4230e4fb by Matthew Pickering at 2021-11-11T07:22:03-05:00 driver: Use shared transitive dependency calculation in hptModulesBelow This saves a lot of repeated work on big dependency graphs. ------------------------- Metric Decrease: MultiLayerModules T13719 ------------------------- - - - - - af653b5f by Matthew Bauer at 2021-11-11T07:22:39-05:00 Only pass -pie, -no-pie when linking Previously, these flags were passed when both compiling and linking code. However, `-pie` and `-no-pie` are link-time-only options. Usually, this does not cause issues, but when using Clang with `-Werror` set results in errors: clang: error: argument unused during compilation: '-nopie' [-Werror,-Wunused-command-line-argument] This is unused by Clang because this flag has no effect at compile time (it’s called `-nopie` internally by Clang but called `-no-pie` in GHC for compatibility with GCC). Just passing these flags at linking time resolves this. Additionally, update #15319 hack to look for `-pgml` instead. Because of the main change, the value of `-pgmc` does not matter when checking for the workaround of #15319. However, `-pgml` *does* still matter as not all `-pgml` values support `-no-pie`. To cover all potential values, we assume that no custom `-pgml` values support `-no-pie`. This means that we run the risk of not using `-no-pie` when it is otherwise necessary for in auto-hardened toolchains! This could be a problem at some point, but this workaround was already introduced in 8d008b71 and we might as well continue supporting it. Likewise, mark `-pgmc-supports-no-pie` as deprecated and create a new `-pgml-supports-no-pie`. - - - - - 7cc6ebdf by Sebastian Graf at 2021-11-11T07:23:14-05:00 Add regression test for #20598 Fixes #20598, which is mostly a duplicate of #18824 but for GHC 9.2. - - - - - 7b44c816 by Simon Jakobi at 2021-11-12T21:20:17-05:00 Turn GHC.Data.Graph.Base.Graph into a newtype - - - - - a57cc754 by John Ericson at 2021-11-12T21:20:52-05:00 Make: Do not generate ghc.* headers in stage0 GHC should get everything it needs from the RTS, which for stage0 is the "old" RTS that comes from the bootstrap compiler. - - - - - 265ead8a by Richard Eisenberg at 2021-11-12T21:21:27-05:00 Improve redundant-constraints warning Previously, we reported things wrong with f :: (Eq a, Ord a) => a -> Bool f x = x == x saying that Eq a was redundant. This is fixed now, along with some simplification in Note [Replacement vs keeping]. There's a tiny bit of extra complexity in setImplicationStatus, but it's explained in Note [Tracking redundant constraints]. Close #20602 - - - - - ca90ffa3 by Richard Eisenberg at 2021-11-12T21:21:27-05:00 Use local instances with least superclass depth See new Note [Use only the best local instance] in GHC.Tc.Solver.Interact. This commit also refactors the InstSC/OtherSC mechanism slightly. Close #20582. - - - - - dfc4093c by Vladislav Zavialov at 2021-11-12T21:22:03-05:00 Implement -Wforall-identifier (#20609) In accordance with GHC Proposal #281 "Visible forall in types of terms": For three releases before this change takes place, include a new warning -Wforall-identifier in -Wdefault. This warning will be triggered at definition sites (but not use sites) of forall as an identifier. Updates the haddock submodule. - - - - - 4143bd21 by Cheng Shao at 2021-11-12T21:22:39-05:00 hadrian: use /bin/sh in timeout wrapper /usr/bin/env doesn't work within a nix build. - - - - - 43cab5f7 by Simon Peyton Jones at 2021-11-12T21:23:15-05:00 Get the in-scope set right in simplArg This was a simple (but long standing) error in simplArg, revealed by #20639 - - - - - 578b8b48 by Ben Gamari at 2021-11-12T21:23:51-05:00 gitlab-ci: Allow draft MRs to fail linting jobs Addresses #20623 by allowing draft MRs to fail linting jobs. - - - - - 908e49fa by Ben Gamari at 2021-11-12T21:23:51-05:00 Fix it - - - - - 05166660 by Ben Gamari at 2021-11-12T21:23:51-05:00 Fix it - - - - - e41cffb0 by Ben Gamari at 2021-11-12T21:23:51-05:00 Fix it - - - - - cce3a025 by Ben Gamari at 2021-11-12T21:23:51-05:00 Fix it - - - - - 4499db7d by Ben Gamari at 2021-11-12T21:23:51-05:00 Fix it - - - - - dd1be88b by Travis Whitaker at 2021-11-12T21:24:29-05:00 mmapForLinkerMarkExecutable: do nothing when len = 0 - - - - - 4c6ace75 by John Ericson at 2021-11-12T21:25:04-05:00 Delete compiler/MachDeps.h This was accidentally added back in 28334b475a109bdeb8d53d58c48adb1690e2c9b4 after it is was no longer needed by the compiler proper in 20956e5784fe43781d156dd7ab02f0bff4ab41fb. - - - - - 490e8c75 by John Ericson at 2021-11-12T21:25:40-05:00 Generate ghcversion.h with the top-level configure This is, rather unintuitively, part of the goal of making the packages that make of the GHC distribution more freestanding. `ghcversion.h` is very simple, so we easily can move it out of the main build systems (make and Hadrian). By doing so, the RTS becomes less of a special case to those build systems as the header, already existing in the source tree, appears like any other. We could do this with the upcomming RTS configure, but it hardly matters because there is nothing platform-specific here, it is just versioning information like the other files the top-level configure can be responsible for. - - - - - bba156f3 by John Ericson at 2021-11-12T21:26:15-05:00 Remove bit about size_t in ghc-llvm-version.h This shouldn't be here. It wasn't causing a problem because this header was only used from Haskell, but still. - - - - - 0b1da2f1 by John Ericson at 2021-11-12T21:26:50-05:00 Make: Install RTS headers in `$libdir/rts/include` not `$libdir/include` Before we were violating the convention of every other package. This fixes that. It matches the changes made in d5de970dafd5876ef30601697576167f56b9c132 to the location of the files in the repo. - - - - - b040d0d4 by Sebastian Graf at 2021-11-12T21:27:26-05:00 Add regression test for #20663 - - - - - c6065292 by John Ericson at 2021-11-12T21:28:02-05:00 Make: Move remaining built RTS headers to ...build/include This allows us to clean up the rts include dirs in the package conf. - - - - - aa372972 by Ryan Scott at 2021-11-15T10:17:57-05:00 Refactoring: Consolidate some arguments with DerivInstTys Various functions in GHC.Tc.Deriv.* were passing around `TyCon`s and `[Type]`s that ultimately come from the same `DerivInstTys`. This patch moves the definition of `DerivInstTys` to `GHC.Tc.Deriv.Generate` so that all of these `TyCon` and `[Type]` arguments can be consolidated into a single `DerivInstTys`. Not only does this make the code easier to read (in my opinion), this will also be important in a subsequent commit where we need to add another field to `DerivInstTys` that will also be used from `GHC.Tc.Deriv.Generate` and friends. - - - - - 564a19af by Ryan Scott at 2021-11-15T10:17:57-05:00 Refactoring: Move DataConEnv to GHC.Core.DataCon `DataConEnv` will prove to be useful in another place besides `GHC.Core.Opt.SpecConstr` in a follow-up commit. - - - - - 3e5f0595 by Ryan Scott at 2021-11-15T10:17:57-05:00 Instantiate field types properly in stock-derived instances Previously, the `deriving` machinery was very loosey-goosey about how it used the types of data constructor fields when generating code. It would usually just consult `dataConOrigArgTys`, which returns the _uninstantiated_ field types of each data constructor. Usually, you can get away with this, but issues #20375 and #20387 revealed circumstances where this approach fails. Instead, when generated code for a stock-derived instance `C (T arg_1 ... arg_n)`, one must take care to instantiate the field types of each data constructor with `arg_1 ... arg_n`. The particulars of how this is accomplished is described in the new `Note [Instantiating field types in stock deriving]` in `GHC.Tc.Deriv.Generate`. Some highlights: * `DerivInstTys` now has a new `dit_dc_inst_arg_env :: DataConEnv [Type]` field that caches the instantiated field types of each data constructor. Whenever we need to consult the field types somewhere in `GHC.Tc.Deriv.*` we avoid using `dataConOrigArgTys` and instead look it up in `dit_dc_inst_arg_env`. * Because `DerivInstTys` now stores the instantiated field types of each constructor, some of the details of the `GHC.Tc.Deriv.Generics.mkBindsRep` function were able to be simplified. In particular, we no longer need to apply a substitution to instantiate the field types in a `Rep(1)` instance, as that is already done for us by `DerivInstTys`. We still need a substitution to implement the "wrinkle" section of `Note [Generating a correctly typed Rep instance]`, but the code is nevertheless much simpler than before. * The `tyConInstArgTys` function has been removed in favor of the new `GHC.Core.DataCon.dataConInstUnivs` function, which is really the proper tool for the job. `dataConInstUnivs` is much like `tyConInstArgTys` except that it takes a data constructor, not a type constructor, as an argument, and it adds extra universal type variables from that data constructor at the end of the returned list if need be. `dataConInstUnivs` takes care to instantiate the kinds of the universal type variables at the end, thereby avoiding a bug in `tyConInstArgTys` discovered in https://gitlab.haskell.org/ghc/ghc/-/issues/20387#note_377037. Fixes #20375. Fixes #20387. - - - - - 25d36c31 by John Ericson at 2021-11-15T10:18:32-05:00 Make: Get rid of GHC_INCLUDE_DIRS These dirs should not be included in all stages. Instead make the per-stage `BUILD_*_INCLUDE_DIR` "plural" to insert `rts/include` in the right place. - - - - - b679721a by John Ericson at 2021-11-15T10:18:32-05:00 Delete dead code knobs for building GHC itself As GHC has become target agnostic, we've left behind some now-useless logic in both build systems. - - - - - 3302f42a by Sylvain Henry at 2021-11-15T13:19:42-05:00 Fix windres invocation I've already fixed this 7 months ago in the comments of #16780 but it never got merged. Now we need this for #20657 too. - - - - - d9f54905 by Sylvain Henry at 2021-11-15T13:19:42-05:00 Hadrian: fix windows cross-build (#20657) Many small things to fix: * Hadrian: platform triple is "x86_64-w64-mingw32" and this wasn't recognized by Hadrian (note "w64" instead of "unknown") * Hadrian was using the build platform ("isWindowsHost") to detect the use of the Windows toolchain, which was wrong. We now use the "targetOs" setting. * Hadrian was doing the same thing for Darwin so we fixed both at once, even if cross-compilation to Darwin is unlikely to happen afaik (cf "osxHost" vs "osxTarget" changes) * Hadrian: libffi name was computed in two different places and one of them wasn't taking the different naming on Windows into account. * Hadrian was passing "-Irts/include" when building the stage1 compiler leading to the same error as in #18143 (which is using make). stage1's RTS is stage0's one so mustn't do this. * Hadrian: Windows linker doesn't seem to support "-zorigin" so we don't pass it (similarly to Darwin) * Hadrian: hsc2hs in cross-compilation mode uses a trick (taken from autoconf): it defines "static int test_array[SOME_EXPR]" where SOME_EXPR is a constant expression. However GCC reports an error because SOME_EXPR is supposedly not constant. This is fixed by using another method enabled with the `--via-asm` flag of hsc2hs. It has been fixed in `make` build system (5f6fcf7808b16d066ad0fb2068225b3f2e8363f7) but not in Hadrian. * Hadrian: some packages are specifically built only on Windows but they shouldn't be when building a cross-compiler (`touchy` and `ghci-wrapper`). We now correctly detect this case and disable these packages. * Base: we use `iNVALID_HANDLE_VALUE` in a few places. It fixed some hsc2hs issues before we switched to `--via-asm` (see above). I've kept these changes are they make the code nicer. * Base: `base`'s configure tries to detect if it is building for Windows but for some reason the `$host_alias` value is `x86_64-windows` in my case and it wasn't properly detected. * Base: libraries/base/include/winio_structs.h imported "Windows.h" with a leading uppercase. It doesn't work on case-sensitive systems when cross-compiling so we have to use "windows.h". * RTS: rts/win32/ThrIOManager.c was importin "rts\OSThreads.h" but this path isn't valid when cross-compiling. We replaced "\" with "/". * DeriveConstants: this tool derives the constants from the target RTS header files. However these header files define `StgAsyncIOResult` only when `mingw32_HOST_OS` is set hence it seems we have to set it explicitly. Note that deriveConstants is called more than once (why? there is only one target for now so it shouldn't) and in the second case this value is correctly defined (probably coming indirectly from the import of "rts/PosixSource.h"). A better fix would probably be to disable the unneeded first run of deriveconstants. - - - - - cc635da1 by Richard Eisenberg at 2021-11-15T13:20:18-05:00 Link to ghc-proposals repo from README A potential contributor said that they weren't aware of ghc-proposals. This might increase visibility. - - - - - a8e1a756 by Ben Gamari at 2021-11-16T03:12:34-05:00 gitlab-ci: Refactor toolchain provision This makes it easier to invoke ci.sh on Darwin by teaching it to manage the nix business. - - - - - 1f0014a8 by Ben Gamari at 2021-11-16T03:12:34-05:00 gitlab-ci: Fail if dynamic references are found in a static bindist Previously we called error, which just prints an error, rather than fail, which actually fails. - - - - - 85f2c0ba by Ben Gamari at 2021-11-16T03:12:34-05:00 gitlab-ci/darwin: Move SDK path discovery into toolchain.nix Reduce a bit of duplication and a manual step when running builds manually. - - - - - 3e94b5a7 by John Ericson at 2021-11-16T03:13:10-05:00 Make: Get rid of `BUILD_.*_INCLUDE_DIRS` First, we improve some of the rules around -I include dirs, and CPP opts. Then, we just specify the RTS's include dirs normally (locally per the package and in the package conf), and then everything should work normally. The primops.txt.pp rule needs no extra include dirs at all, as it no longer bakes in a target platfom. Reverts some of the extra stage arguments I added in 05419e55cab272ed39790695f448b311f22669f7, as they are no longer needed. - - - - - 083a7583 by Ben Gamari at 2021-11-17T05:10:27-05:00 Increase type sharing Fixes #20541 by making mkTyConApp do more sharing of types. In particular, replace * BoxedRep Lifted ==> LiftedRep * BoxedRep Unlifted ==> UnliftedRep * TupleRep '[] ==> ZeroBitRep * TYPE ZeroBitRep ==> ZeroBitType In each case, the thing on the right is a type synonym for the thing on the left, declared in ghc-prim:GHC.Types. See Note [Using synonyms to compress types] in GHC.Core.Type. The synonyms for ZeroBitRep and ZeroBitType are new, but absolutely in the same spirit as the other ones. (These synonyms are mainly for internal use, though the programmer can use them too.) I also renamed GHC.Core.Ty.Rep.isVoidTy to isZeroBitTy, to be compatible with the "zero-bit" nomenclature above. See discussion on !6806. There is a tricky wrinkle: see GHC.Core.Types Note [Care using synonyms to compress types] Compiler allocation decreases by up to 0.8%. - - - - - 20a4f251 by Ben Gamari at 2021-11-17T05:11:03-05:00 hadrian: Factor out --extra-*-dirs=... pattern We repeated this idiom quite a few times. Give it a name. - - - - - 4cec6cf2 by Ben Gamari at 2021-11-17T05:11:03-05:00 hadrian: Ensure that term.h is in include search path terminfo now requires term.h but previously neither build system offered any way to add the containing directory to the include search path. Fix this in Hadrian. Also adds libnuma includes to global include search path as it was inexplicably missing earlier. - - - - - 29086749 by Sebastian Graf at 2021-11-17T05:11:38-05:00 Pmc: Don't case split on wildcard matches (#20642) Since 8.10, when formatting a pattern match warning, we'd case split on a wildcard match such as ```hs foo :: [a] -> [a] foo [] = [] foo xs = ys where (_, ys@(_:_)) = splitAt 0 xs -- Pattern match(es) are non-exhaustive -- In a pattern binding: -- Patterns not matched: -- ([], []) -- ((_:_), []) ``` But that's quite verbose and distracts from which part of the pattern was actually the inexhaustive one. We'd prefer a wildcard for the first pair component here, like it used to be in GHC 8.8. On the other hand, case splitting is pretty handy for `-XEmptyCase` to know the different constructors we could've matched on: ```hs f :: Bool -> () f x = case x of {} -- Pattern match(es) are non-exhaustive -- In a pattern binding: -- Patterns not matched: -- False -- True ``` The solution is to communicate that we want a top-level case split to `generateInhabitingPatterns` for `-XEmptyCase`, which is exactly what this patch arranges. Details in `Note [Case split inhabiting patterns]`. Fixes #20642. - - - - - c591ab1f by Sebastian Graf at 2021-11-17T05:11:38-05:00 testsuite: Refactor pmcheck all.T - - - - - 33c0c83d by Andrew Pritchard at 2021-11-17T05:12:17-05:00 Fix Haddock markup on Data.Type.Ord.OrdCond. - - - - - 7bcd91f4 by Andrew Pritchard at 2021-11-17T05:12:17-05:00 Provide in-line kind signatures for Data.Type.Ord.Compare. Haddock doesn't know how to render SAKS, so the only current way to make the documentation show the kind is to write what it should say into the type family declaration. - - - - - 16d86b97 by ARATA Mizuki at 2021-11-17T05:12:56-05:00 bitReverse functions in GHC.Word are since base-4.14.0.0, not 4.12.0.0 They were added in 33173a51c77d9960d5009576ad9b67b646dfda3c, which constitutes GHC 8.10.1 / base-4.14.0.0 - - - - - 7850142c by Morrow at 2021-11-17T11:14:37+00:00 Improve handling of import statements in GHCi (#20473) Currently in GHCi, when given a line of user input we: 1. Attempt to parse and handle it as a statement 2. Otherwise, attempt to parse and handle a single import 3. Otherwise, check if there are imports present (and if so display an error message) 4. Otherwise, attempt to parse a module and only handle the declarations This patch simplifies the process to: Attempt to parse and handle it as a statement Otherwise, attempt to parse a module and handle the imports and declarations This means that multiple imports in a multiline are now accepted, and a multiline containing both imports and declarations is now accepted (as well as when separated by semicolons). - - - - - 09d44b4c by Zubin Duggal at 2021-11-18T01:37:36-05:00 hadrian: add threadedDebug RTS way to devel compilers - - - - - 5fa45db7 by Zubin Duggal at 2021-11-18T01:37:36-05:00 testsuite: disable some tests when we don't have dynamic libraries - - - - - f8c1c549 by Matthew Pickering at 2021-11-18T01:38:11-05:00 Revert "base: Use one-shot kqueue on macOS" This reverts commit 41117d71bb58e001f6a2b6a11c9314d5b70b9182 - - - - - f55ae180 by Simon Peyton Jones at 2021-11-18T14:44:45-05:00 Add one line of comments (c.f. !5706) Ticket #19815 suggested changing coToMCo to use isReflexiveCo rather than isReflCo. But perf results weren't encouraging. This patch just adds a comment to point to the data, such as it is. - - - - - 12d023d1 by Vladislav Zavialov at 2021-11-18T14:45:20-05:00 testsuite: check for FlexibleContexts in T17563 The purpose of testsuite/tests/typecheck/should_fail/T17563.hs is to make sure we do validity checking on quantified constraints. In particular, see the following functions in GHC.Tc.Validity: * check_quant_pred * check_pred_help * check_class_pred The original bug report used a~b constraints as an example of a constraint that requires validity checking. But with GHC Proposal #371, equality constraints no longer require GADTs or TypeFamilies; instead, they require TypeOperators, which are checked earlier in the pipeline, in the renamer. Rather than simply remove this test, we change the example to use another extension: FlexibleContexts. Since we decide whether a constraint requires this extension in check_class_pred, the regression test continues to exercise the relevant code path. - - - - - 78d4bca0 by Ben Gamari at 2021-11-18T22:27:20-05:00 ghc-cabal, make: Add support for building C++ object code Co-Authored By: Matthew Pickering <matthew at well-typed.com> - - - - - a8b4961b by Ben Gamari at 2021-11-18T22:27:20-05:00 Bump Cabal submodule - - - - - 59e8a900 by Ben Gamari at 2021-11-18T22:27:20-05:00 Bump text and parsec submodules Accommodates text-2.0. Metric Decrease: T15578 - - - - - 7f7d7888 by Ben Gamari at 2021-11-18T22:27:20-05:00 ghc-cabal: Use bootstrap compiler's text package This avoids the need to build `text` without Cabal, in turn avoiding the need to reproduce the workaround for #20010 contained therein. - - - - - 048f8d96 by Ben Gamari at 2021-11-18T22:27:20-05:00 gitlab-ci: Bump MACOSX_DEPLOYMENT_TARGET It appears that Darwin's toolchain includes system headers in the dependency makefiles it generates with `-M` with older `MACOSX_DEPLOYMENT_TARGETS`. To avoid this we have bumped the deployment target for x86-64/Darwin to 10.10. - - - - - 0acbbd20 by Ben Gamari at 2021-11-18T22:27:20-05:00 testsuite: Use libc++ rather than libstdc++ in objcpp-hi It appears that libstdc++ is no longer available in recent XCode distributions. Closes #16083. - - - - - aed98dda by John Ericson at 2021-11-18T22:27:55-05:00 Hadrian: bring up to date with latest make improvements Headers should be associated with the RTS, and subject to less hacks. The most subtle issue was that the package-grained dependencies on generated files were being `need`ed before calculating Haskell deps, but not before calculating C/C++ deps. - - - - - aabff109 by Ben Gamari at 2021-11-20T05:34:27-05:00 Bump deepseq submodule to 1.4.7.0-pre Addresses #20653. - - - - - 3d6b78db by Matthew Pickering at 2021-11-20T05:35:02-05:00 Remove unused module import syntax from .bkp mode .bkp mode had this unused feature where you could write module A and it would go looking for A.hs on the file system and use that rather than provide the definition inline. This isn't use anywhere in the testsuite and the code to find the module A looks dubious. Therefore to reduce .bkp complexity I propose to remove it. Fixes #20701 - - - - - bdeea37e by Sylvain Henry at 2021-11-20T05:35:42-05:00 More support for optional home-unit This is a preliminary refactoring for #14335 (supporting plugins in cross-compilers). In many places the home-unit must be optional because there won't be one available in the plugin environment (we won't be compiling anything in this environment). Hence we replace "HomeUnit" with "Maybe HomeUnit" in a few places and we avoid the use of "hsc_home_unit" (which is partial) in some few others. - - - - - 29e03071 by Ben Gamari at 2021-11-20T05:36:18-05:00 rts: Ensure that markCAFs marks object code Previously `markCAFs` would only evacuate CAFs' indirectees. This would allow reachable object code to be unloaded by the linker as `evacuate` may never be called on the CAF itself, despite it being reachable via the `{dyn,revertible}_caf_list`s. To fix this we teach `markCAFs` to explicit call `markObjectCode`, ensuring that the linker is aware of objects reachable via the CAF lists. Fixes #20649. - - - - - b2933ea9 by Ben Gamari at 2021-11-20T05:36:54-05:00 gitlab-ci: Set HOME to plausible but still non-existent location We have been seeing numerous CI failures on aarch64/Darwin of the form: CI_COMMIT_BRANCH: CI_PROJECT_PATH: ghc/ghc error: creating directory '/nonexistent': Read-only file system Clearly *something* is attempting to create `$HOME`. A bit of sleuthing by @int-e found that the culprit is likely `nix`, although it's not clear why. For now we avoid the issue by setting `HOME` to a fresh directory in the working tree. - - - - - bc7e9f03 by Zubin Duggal at 2021-11-20T17:39:25+00:00 Use 'NonEmpty' for the fields in an 'HsProjection' (#20389) T12545 is very inconsistently affected by this change for some reason. There is a decrease in allocations on most configurations, but an increase on validate-x86_64-linux-deb9-unreg-hadrian. Accepting it as it seems unrelated to this patch. Metric Decrease: T12545 Metric Increase: T12545 - - - - - 742d8b60 by sheaf at 2021-11-20T18:13:23-05:00 Include "not more specific" info in overlap msg When instances overlap, we now include additional information about why we weren't able to select an instance: perhaps one instance overlapped another but was not strictly more specific, so we aren't able to directly choose it. Fixes #20542 - - - - - f748988b by Simon Peyton Jones at 2021-11-22T11:53:02-05:00 Better wrapper activation calculation As #20709 showed, GHC could prioritise a wrapper over a SPEC rule, which is potentially very bad. This patch fixes that problem. The fix is is described in Note [Wrapper activation], especially item 4, 4a, and Conclusion. For now, it has a temporary hack (replicating what was there before to make sure that wrappers inline no earlier than phase 2. But it should be temporary; see #19001. - - - - - f0bac29b by Simon Peyton Jones at 2021-11-22T11:53:02-05:00 Make INLINE/NOINLINE pragmas a bgi less constraining We can inline a bit earlier than the previous pragmas said. I think they dated from an era in which the InitialPhase did no inlining. I don't think this patch will have much effect, but it's a bit cleaner. - - - - - 68a3665a by Sylvain Henry at 2021-11-22T11:53:47-05:00 Hadrian: bump stackage LTS to 18.18 (GHC 8.10.7) - - - - - 680ef2c8 by Andreas Klebinger at 2021-11-23T01:07:29-05:00 CmmSink: Be more aggressive in removing no-op assignments. No-op assignments like R1 = R1 are not only wasteful. They can also inhibit other optimizations like inlining assignments that read from R1. We now check for assignments being a no-op before and after we simplify the RHS in Cmm sink which should eliminate most of these no-ops. - - - - - 1ed2aa90 by Andreas Klebinger at 2021-11-23T01:07:29-05:00 Don't include types in test output - - - - - 3ab3631f by Krzysztof Gogolewski at 2021-11-23T01:08:05-05:00 Add a warning for GADT match + NoMonoLocalBinds (#20485) Previously, it was an error to pattern match on a GADT without GADTs or TypeFamilies. This is now allowed. Instead, we check the flag MonoLocalBinds; if it is not enabled, we issue a warning, controlled by -Wgadt-mono-local-binds. Also fixes #20485: pattern synonyms are now checked too. - - - - - 9dcb2ad1 by Ben Gamari at 2021-11-23T16:09:39+00:00 gitlab-ci: Bump DOCKER_REV - - - - - 16690374 by nineonine at 2021-11-23T22:32:51-08:00 Combine STG free variable traversals (#17978) Previously we would traverse the STG AST twice looking for free variables. * Once in `annTopBindingsDeps` which considers top level and imported ids free. Its output is used to put bindings in dependency order. The pass happens in STG pipeline. * Once in `annTopBindingsFreeVars` which only considers non-top level ids free. Its output is used by the code generator to compute offsets into closures. This happens in Cmm (CodeGen) pipeline. Now these two traversal operations are merged into one - `FVs.depSortWithAnnotStgPgm`. The pass happens right at the end of STG pipeline. Some type signatures had to be updated due to slight shifts of StgPass boundaries (for example, top-level CodeGen handler now directly works with CodeGen flavoured Stg AST instead of Vanilla). Due to changed order of bindings, a few debugger type reconstruction bugs have resurfaced again (see tests break018, break021) - work item #18004 tracks this investigation. authors: simonpj, nineonine - - - - - 91c0a657 by Matthew Pickering at 2021-11-25T01:03:17-05:00 Correct retypechecking in --make mode Note [Hydrating Modules] ~~~~~~~~~~~~~~~~~~~~~~~~ What is hydrating a module? * There are two versions of a module, the ModIface is the on-disk version and the ModDetails is a fleshed-out in-memory version. * We can **hydrate** a ModIface in order to obtain a ModDetails. Hydration happens in three different places * When an interface file is initially loaded from disk, it has to be hydrated. * When a module is finished compiling, we hydrate the ModIface in order to generate the version of ModDetails which exists in memory (see Note) * When dealing with boot files and module loops (see Note [Rehydrating Modules]) Note [Rehydrating Modules] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ If a module has a boot file then it is critical to rehydrate the modules on the path between the two. Suppose we have ("R" for "recursive"): ``` R.hs-boot: module R where data T g :: T -> T A.hs: module A( f, T, g ) where import {-# SOURCE #-} R data S = MkS T f :: T -> S = ...g... R.hs: module R where data T = T1 | T2 S g = ...f... ``` After compiling A.hs we'll have a TypeEnv in which the Id for `f` has a type type uses the AbstractTyCon T; and a TyCon for `S` that also mentions that same AbstractTyCon. (Abstract because it came from R.hs-boot; we know nothing about it.) When compiling R.hs, we build a TyCon for `T`. But that TyCon mentions `S`, and it currently has an AbstractTyCon for `T` inside it. But we want to build a fully cyclic structure, in which `S` refers to `T` and `T` refers to `S`. Solution: **rehydration**. *Before compiling `R.hs`*, rehydrate all the ModIfaces below it that depend on R.hs-boot. To rehydrate a ModIface, call `typecheckIface` to convert it to a ModDetails. It's just a de-serialisation step, no type inference, just lookups. Now `S` will be bound to a thunk that, when forced, will "see" the final binding for `T`; see [Tying the knot](https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/tying-the-knot). But note that this must be done *before* compiling R.hs. When compiling R.hs, the knot-tying stuff above will ensure that `f`'s unfolding mentions the `LocalId` for `g`. But when we finish R, we carefully ensure that all those `LocalIds` are turned into completed `GlobalIds`, replete with unfoldings etc. Alas, that will not apply to the occurrences of `g` in `f`'s unfolding. And if we leave matters like that, they will stay that way, and *all* subsequent modules that import A will see a crippled unfolding for `f`. Solution: rehydrate both R and A's ModIface together, right after completing R.hs. We only need rehydrate modules that are * Below R.hs * Above R.hs-boot There might be many unrelated modules (in the home package) that don't need to be rehydrated. This dark corner is the subject of #14092. Suppose we add to our example ``` X.hs module X where import A data XT = MkX T fx = ...g... ``` If in `--make` we compile R.hs-boot, then A.hs, then X.hs, we'll get a `ModDetails` for `X` that has an AbstractTyCon for `T` in the the argument type of `MkX`. So: * Either we should delay compiling X until after R has beeen compiled. * Or we should rehydrate X after compiling R -- because it transitively depends on R.hs-boot. Ticket #20200 has exposed some issues to do with the knot-tying logic in GHC.Make, in `--make` mode. this particular issue starts [here](https://gitlab.haskell.org/ghc/ghc/-/issues/20200#note_385758). The wiki page [Tying the knot](https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/tying-the-knot) is helpful. Also closely related are * #14092 * #14103 Fixes tickets #20200 #20561 - - - - - f0c5d8d3 by Matthew Pickering at 2021-11-25T01:03:17-05:00 Make T14075 more robust - - - - - 6907e9fa by Matthew Pickering at 2021-11-25T01:03:17-05:00 Revert "Convert lookupIdSubst panic back to a warning (#20200)" This reverts commit df1d808f26544cbb77d85773d672137c65fd3cc7. - - - - - baa8ffee by Greg Steuck at 2021-11-25T01:03:54-05:00 Use getExecutablePath in getBaseDir on OpenBSD While OpenBSD doesn't have a general mechanism for determining the path of the executing program image, it is reasonable to rely on argv[0] which happens as a fallback in getExecutablePath. With this change on top of T18173 we can get a bit close to fixing #18173. - - - - - e3c59191 by Christiaan Baaij at 2021-11-25T01:04:32-05:00 Ensure new Ct/evidence invariant The `ctev_pred` field of a `CtEvidence` is a just a cache for the type of the evidence. More precisely: * For Givens, `ctev_pred` = `varType ctev_evar` * For Wanteds, `ctev_pred` = `evDestType ctev_dest` This new invariant is needed because evidence can become part of a type, via `Castty ty kco`. - - - - - 3639ad8f by Christiaan Baaij at 2021-11-25T01:04:32-05:00 Compare types of recursive let-bindings in alpha-equivalence This commit fixes #20641 by checking the types of recursive let-bindings when performing alpha-equality. The `Eq (DeBruijn CoreExpr)` instance now also compares `BreakPoint`s similarly to `GHC.Core.Utils.eqTickish`, taking bound variables into account. In addition, the `Eq (DeBruijn Type)` instance now correctly compares the kinds of the types when one of them contains a Cast: the instance is modeled after `nonDetCmpTypeX`. - - - - - 7c65687e by CarrieMY at 2021-11-25T01:05:11-05:00 Enable UnboxedTuples in `genInst`, Fixes #20524 - - - - - e33412d0 by Krzysztof Gogolewski at 2021-11-25T01:05:46-05:00 Misc cleanup * Remove `getTag_RDR` (unused), `tidyKind` and `tidyOpenKind` (already available as `tidyType` and `tidyOpenType`) * Remove Note [Explicit Case Statement for Specificity]. Since 0a709dd9876e40 we require GHC 8.10 for bootstrapping. * Change the warning to `cmpAltCon` to a panic. This shouldn't happen. If it ever does, the code was wrong anyway: it shouldn't always return `LT`, but rather `LT` in one case and `GT` in the other case. * Rename `verifyLinearConstructors` to `verifyLinearFields` * Fix `Note [Local record selectors]` which was not referenced * Remove vestiges of `type +v` * Minor fixes to StaticPointers documentation, part of #15603 - - - - - bb71f7f1 by Greg Steuck at 2021-11-25T01:06:25-05:00 Reorder `sed` arguments to work with BSD sed The order was swapped in 490e8c750ea23ce8e2b7309e0d514b7d27f231bb causing the build on OpenBSD to fail with: `sed: 1: "mk/config.h": invalid command code m` - - - - - c18a51f0 by John Ericson at 2021-11-25T01:06:25-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - d530c46c by sheaf at 2021-11-25T01:07:04-05:00 Add Data.Bits changes to base 4.16 changelog Several additions since 4.15 had not been recorded in the changelog: - newtypes And, Ior, Xor and Iff, - oneBits - symbolic synonyms `.^.`, `.>>.`, `!>>.`, `.<<.` and `!<<.`. Fixes #20608. - - - - - 4d34bf15 by Matthew Pickering at 2021-11-25T01:07:40-05:00 Don't use implicit lifting when deriving Lift It isn't much more complicated to be more precise when deriving Lift so we now generate ``` data Foo = Foo Int Bool instance Lift Foo where lift (Foo a b) = [| Foo $(lift a) $(lift b) |] liftTyped (Foo a b) = [|| Foo $$(lift a) $$(lift b) |] ``` This fixes #20688 which complained about using implicit lifting in the derived code. - - - - - 8961d632 by Greg Steuck at 2021-11-25T01:08:18-05:00 Disable warnings for unused goto labels Clang on OpenBSD aborts compilation with this diagnostics: ``` % "inplace/bin/ghc-stage1" -optc-Wno-error=unused-label -optc-Wall -optc-Werror -optc-Wall -optc-Wextra -optc-Wstrict-prototypes -optc-Wmissing-prototypes -optc-Wmissing-declarations -optc-Winline -optc-Wpointer-arith -optc-Wmissing-noreturn -optc-Wnested-externs -optc-Wredundant-decls -optc-Wno-aggregate-return -optc-fno-strict-aliasing -optc-fno-common -optc-Irts/dist-install/build/./autogen -optc-Irts/include/../dist-install/build/include -optc-Irts/include/. -optc-Irts/. -optc-DCOMPILING_RTS -optc-DFS_NAMESPACE=rts -optc-Wno-unknown-pragmas -optc-O2 -optc-fomit-frame-pointer -optc-g -optc-DRtsWay=\"rts_v\" -static -O0 -H64m -Wall -fllvm-fill-undef-with-garbage -Werror -this-unit-id rts -dcmm-lint -package-env - -i -irts -irts/dist-install/build -Irts/dist-install/build -irts/dist-install/build/./autogen -Irts/dist-install/build/./autogen -Irts/include/../dist-install/build/include -Irts/include/. -Irts/. -optP-DCOMPILING_RTS -optP-DFS_NAMESPACE=rts -O2 -Wcpp-undef -Wnoncanonical-monad-instances -c rts/linker/Elf.c -o rts/dist-install/build/linker/Elf.o rts/linker/Elf.c:2169:1: error: error: unused label 'dl_iterate_phdr_fail' [-Werror,-Wunused-label] | 2169 | dl_iterate_phdr_fail: | ^ dl_iterate_phdr_fail: ^~~~~~~~~~~~~~~~~~~~~ rts/linker/Elf.c:2172:1: error: error: unused label 'dlinfo_fail' [-Werror,-Wunused-label] | 2172 | dlinfo_fail: | ^ dlinfo_fail: ^~~~~~~~~~~~ 2 errors generated. ``` - - - - - 5428b8c6 by Zubin Duggal at 2021-11-25T01:08:54-05:00 testsuite: debounce title updates - - - - - 96b3899e by Ben Gamari at 2021-11-25T01:09:29-05:00 gitlab-ci: Add release jobs for Darwin targets As noted in #20707, the validate jobs which we previously used lacked profiling support. Also clean up some variable definitions. Fixes #20707. - - - - - 52cdc2fe by Pepe Iborra at 2021-11-25T05:00:43-05:00 Monoid instance for InstalledModuleEnv - - - - - 47f36440 by Pepe Iborra at 2021-11-25T05:00:43-05:00 Drop instance Semigroup ModuleEnv There is more than one possible Semigroup and it is not needed since plusModuleEnv can be used directly - - - - - b742475a by Pepe Iborra at 2021-11-25T05:00:43-05:00 drop instance Semigroup InstalledModuleEnv Instead, introduce plusInstalledModuleEnv - - - - - b24e8d91 by Roland Senn at 2021-11-25T05:01:21-05:00 GHCi Debugger - Improve RTTI When processing the heap, use also `APClosures` to create additional type constraints. This adds more equations and therefore improves the unification process to infer the correct type of values at breakpoints. (Fix the `incr` part of #19559) - - - - - cf5279ed by Gergo ERDI at 2021-11-25T05:01:59-05:00 Use `simplify` in non-optimizing build pipeline (#20500) - - - - - c9cead1f by Gergo ERDI at 2021-11-25T05:01:59-05:00 Add specific optimization flag for fast PAP calls (#6084, #20500) - - - - - be0a9470 by Gergo ERDI at 2021-11-25T05:01:59-05:00 Add specific optimization flag for Cmm control flow analysis (#20500) - - - - - b52a9a3f by Gergo ERDI at 2021-11-25T05:01:59-05:00 Add `llvmOptLevel` to `DynFlags` (#20500) - - - - - f27a63fe by sheaf at 2021-11-25T05:02:39-05:00 Allow boring class declarations in hs-boot files There are two different ways of declaring a class in an hs-boot file: - a full declaration, where everything is written as it is in the .hs file, - an abstract declaration, where class methods and superclasses are left out. However, a declaration with no methods and a trivial superclass, such as: class () => C a was erroneously considered to be an abstract declaration, because the superclass is trivial. This is remedied by a one line fix in GHC.Tc.TyCl.tcClassDecl1. This patch also further clarifies the documentation around class declarations in hs-boot files. Fixes #20661, #20588. - - - - - cafb1f99 by Ben Gamari at 2021-11-25T05:03:15-05:00 compiler: Mark GHC.Prelude as Haddock no-home This significantly improves Haddock documentation generated by nix. - - - - - bd92c9b2 by Sebastian Graf at 2021-11-25T05:03:51-05:00 hadrian: Add `collect_stats` flavour transformer This is useful for later consumption with https://gitlab.haskell.org/bgamari/ghc-utils/-/blob/master/ghc_timings.py - - - - - 774fc4d6 by Ilias Tsitsimpis at 2021-11-25T08:34:54-05:00 Link against libatomic for 64-bit atomic operations Some platforms (e.g., armel) require linking against libatomic for 64-bit atomic operations. Fixes #20549 - - - - - 20101d9c by Greg Steuck at 2021-11-25T08:35:31-05:00 Permit multiple values in config_args for validate The whitespace expansion should be permitted to pass multiple arguments to configure. - - - - - e2c48b98 by Greg Steuck at 2021-11-25T08:36:09-05:00 Kill a use of %n format specifier This format has been used as a security exploit vector for decades now. Some operating systems (OpenBSD, Android, MSVC). It is targeted for removal in C2X standard: http://www.open-std.org/jtc1/sc22/wg14/www/docs/n2834.htm This requires extending the debug message function to return the number of bytes written (like printf(3)), to permit %n format specifier in one in one invocation of statsPrintf() in report_summary(). Implemented by Matthias Kilian (kili<AT>outback.escape.de) - - - - - ff0c45f3 by Bodigrim at 2021-11-26T16:01:09-05:00 Rename Data.ByteArray to Data.Array.ByteArray + add Trustworthy - - - - - 9907d540 by Bodigrim at 2021-11-26T16:01:09-05:00 Rename Data.Array.ByteArray -> Data.Array.Byte - - - - - 0c8e1b4d by Kai Prott at 2021-11-26T16:01:47-05:00 Improve error message for mis-typed plugins #20671 Previously, when a plugin could not be loaded because it was incorrectly typed, the error message only printed the expected but not the actual type. This commit augments the error message such that both types are printed and the corresponding module is printed as well. - - - - - 51bcb986 by Kai Prott at 2021-11-26T16:01:47-05:00 Remove duplicate import - - - - - 1830eea7 by Kai Prott at 2021-11-26T16:01:47-05:00 Simplify printQualification - - - - - 69e62032 by Kai Prott at 2021-11-26T16:01:47-05:00 Fix plugin type to GHC.Plugins.Plugin - - - - - 0a6776a3 by Kai Prott at 2021-11-26T16:01:47-05:00 Adapt plugin test case - - - - - 7e18b304 by Kai Prott at 2021-11-26T16:01:47-05:00 Reflect type change in the haddock comment - - - - - 02372be1 by Matthew Pickering at 2021-11-26T16:02:23-05:00 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 - - - - - 13ef345c by John Ericson at 2021-11-27T19:41:11+00:00 Factor our `FP_CAPITALIZE_YES_NO` This deduplicates converting from yes/no to YES/NO in the configure scripts while also making it safer. - - - - - 88481c94 by John Ericson at 2021-11-27T19:46:16+00:00 Fix top-level configure script so --disable-foo works - - - - - f67060c6 by John Ericson at 2021-11-27T19:47:09+00:00 Make ambient MinGW support a proper settings Get rid of `USE_INPLACE_MINGW_TOOLCHAIN` and use a settings file entry instead. The CPP setting was originally introduced in f065b6b012. - - - - - 1dc0d7af by Ben Gamari at 2021-11-29T11:02:43-05:00 linker: Introduce linker_verbose debug output This splits the -Dl RTS debug output into two distinct flags: * `+RTS -Dl` shows errors and debug output which scales with at most O(# objects) * `+RTS -DL` shows debug output which scales with O(# symbols)t - - - - - 7ea665bf by Krzysztof Gogolewski at 2021-11-29T11:03:19-05:00 TTG: replace Void/NoExtCon with DataConCantHappen There were two ways to indicate that a TTG constructor is unused in a phase: `NoExtCon` and `Void`. This unifies the code, and uses the name 'DataConCantHappen', following the discussion at MR 7041. Updates haddock submodule - - - - - 14e9cab6 by Sylvain Henry at 2021-11-29T11:04:03-05:00 Use Monoid in hptSomeThingsBelowUs It seems to have a moderate but good impact on perf tests in CI. In particular: MultiLayerModules(normal) ghc/alloc 3125771138.7 3065532240.0 -1.9% So it's likely that huge projects will benefit from this. - - - - - 22bbf449 by Anton-Latukha at 2021-11-29T20:03:52+00:00 docs/users_guide/bugs.rst: Rewording It is either "slightly" || "significantly". If it is "bogus" - then no quotes around "optimization" & overall using word "bogus" or use quotes in that way in documentation is... Instead, something like "hack" or "heuristic" can be used there. - - - - - 9345bfed by Mitchell Rosen at 2021-11-30T01:32:22-05:00 Fix caluclation of nonmoving GC elapsed time Fixes #20751 - - - - - c7613493 by PHO at 2021-12-01T03:07:32-05:00 rts/ProfHeap.c: Use setlocale() on platforms where uselocale() is not available Not all platforms have per-thread locales. NetBSD doesn't have uselocale() in particular. Using setlocale() is of course not a safe thing to do, but it would be better than no GHC at all. - - - - - 4acfa0db by Ben Gamari at 2021-12-01T03:08:07-05:00 rts: Refactor SRT representation selection The goal here is to make the SRT selection logic a bit clearer and allow configurations which we currently don't support (e.g. using a full word in the info table even when TNTC is used). - - - - - 87bd9a67 by Ben Gamari at 2021-12-01T03:08:07-05:00 gitlab-ci: Introduce no_tntc job A manual job for testing the non-tables-next-to-code configuration. - - - - - 7acb945d by Carrie Xu at 2021-12-01T03:08:46-05:00 Dump non-module specific info to file #20316 - Change the dumpPrefix to FilePath, and default to non-module - Add dot to seperate dump-file-prefix and suffix - Modify user guide to introduce how dump files are named - This commit does not affect Ghci dump file naming. See also #17500 - - - - - 7bdca2ba by Ben Gamari at 2021-12-01T03:09:21-05:00 rts/RtsSymbols: Provide a proper prototype for environ Previously we relied on Sym_NeedsProto, but this gave the symbol a type which conflicts with the definition that may be provided by unistd.h. Fixes #20577. - - - - - 91d1a773 by Ben Gamari at 2021-12-01T03:09:21-05:00 hadrian: Don't pass empty paths via -I Previously we could in some cases add empty paths to `cc`'s include file search path. See #20578. - - - - - d8d57729 by Ben Gamari at 2021-12-01T03:09:21-05:00 ghc-cabal: Manually specify -XHaskell2010 Otherwise we end up with issues like #19631 when bootstrapping using GHC 9.2 and above. Fixes #19631. - - - - - 1c0c140a by Ben Gamari at 2021-12-01T03:09:21-05:00 ghc-compact: Update cabal file Improve documentation, bump bounds and cabal-version. - - - - - 322b6b45 by Ben Gamari at 2021-12-01T03:09:21-05:00 hadrian: Document fully_static flavour transformer - - - - - 4c434c9e by Ben Gamari at 2021-12-01T03:09:21-05:00 user-guide: Fix :since: of -XCApiFFI Closes #20504. - - - - - 0833ad55 by Matthew Pickering at 2021-12-01T03:09:58-05:00 Add failing test for #20674 - - - - - c2cb5e9a by Ben Gamari at 2021-12-01T03:10:34-05:00 testsuite: Print geometric mean of stat metrics As suggested in #20733. - - - - - 59b27945 by Ben Gamari at 2021-12-01T03:11:09-05:00 users-guide: Describe requirements of DWARF unwinding As requested in #20702 - - - - - c2f6cbef by Matthew Pickering at 2021-12-01T03:11:45-05:00 Fix several quoting issues in testsuite This fixes the ./validate script on my machine. I also took the step to add some linters which would catch problems like these in future. Fixes #20506 - - - - - bffd4074 by John Ericson at 2021-12-01T03:12:21-05:00 rts.cabal.in: Move `extra-source-files` so it is valid - - - - - 86c14db5 by John Ericson at 2021-12-01T03:12:21-05:00 Switch RTS cabal file / package conf to use Rts.h not Stg.h When we give cabal a configure script, it seems to begin checking whether or not Stg.h is valid, and then gets tripped up on all the register stuff which evidentally requires obscure command line flags to go. We can side-step this by making the test header Rts.h instead, which is more normal. I was a bit sketched out making this change, as I don't know why the Cabal library would suddenly beging checking the header. But I did confirm even without my RTS configure script the header doesn't compile stand-alone, and also the Stg.h is a probably-arbitrary choice since it dates all the way back to 2002 in 2cc5b907318f97e19b28b2ad8ed9ff8c1f401dcc. - - - - - defd8d54 by John Ericson at 2021-12-01T03:12:21-05:00 Avoid raw `echo` in `FPTOOLS_SET_PLATFORM_VARS` This ensures quiet configuring works. - - - - - b53f1227 by John Ericson at 2021-12-01T03:12:21-05:00 Factor our `$dir_$distdir_PKGDATA` make variable This makes a few things cleaner. - - - - - f124f2a0 by Ben Gamari at 2021-12-01T03:12:56-05:00 rts: Annotate benign race in pthread ticker's exit test Previously TSAN would report spurious data races due to the unsynchronized access of `exited`. I would have thought that using a relaxed load on `exited` would be enough to convince TSAN that the race was intentional, but apparently not. Closes #20690. - - - - - d3c7f9be by Viktor Dukhovni at 2021-12-01T03:13:34-05:00 Use POSIX shell syntax to redirect stdout/err FreeBSD (and likely NetBSD) /bin/sh does not support '>& word' to redirect stdout + stderr. (Also the preferred syntax in bash would be '&> word' to avoid surprises when `word` is "-" or a number). Resolves: #20760 - - - - - 1724ac37 by Ben Gamari at 2021-12-02T18:13:30-05:00 nativeGen/x86: Don't encode large shift offsets Handle the case of a shift larger than the width of the shifted value. This is necessary since x86 applies a mask of 0x1f to the shift amount, meaning that, e.g., `shr 47, $eax` will actually shift by 47 & 0x1f == 15. See #20626. (cherry picked from commit 31370f1afe1e2f071b3569fb5ed4a115096127ca) - - - - - 5b950a7f by Ben Gamari at 2021-12-02T18:13:30-05:00 cmm: narrow when folding signed quotients Previously the constant-folding behavior for MO_S_Quot and MO_S_Rem failed to narrow its arguments, meaning that a program like: %zx64(%quot(%lobits8(0x00e1::bits16), 3::bits8)) would be miscompiled. Specifically, this program should reduce as %lobits8(0x00e1::bits16) == -31 %quot(%lobits8(0x00e1::bits16), 3::bits8) == -10 %zx64(%quot(%lobits8(0x00e1::bits16), 3::bits8)) == 246 However, with this bug the `%lobits8(0x00e1::bits16)` would instead be treated as `+31`, resulting in the incorrect result of `75`. (cherry picked from commit 94e197e3dbb9a48991eb90a03b51ea13d39ba4cc) - - - - - 78b78ac4 by Ben Gamari at 2021-12-02T18:13:30-05:00 ncg/aarch64: Don't sign extend loads Previously we would emit the sign-extending LDS[HB] instructions for sub-word loads. However, this is wrong, as noted in #20638. - - - - - 35bbc251 by Ben Gamari at 2021-12-02T18:13:30-05:00 cmm: Disallow shifts larger than shiftee Previously primops.txt.pp stipulated that the word-size shift primops were only defined for shift offsets in [0, word_size). However, there was no further guidance for the definition of Cmm's sub-word size shift MachOps. Here we fix this by explicitly disallowing (checked in many cases by CmmLint) shift operations where the shift offset is larger than the shiftee. This is consistent with LLVM's shift operations, avoiding the miscompilation noted in #20637. - - - - - 2f6565cf by Ben Gamari at 2021-12-02T18:13:30-05:00 testsuite: Add testcases for various machop issues There were found by the test-primops testsuite. - - - - - 7094f4fa by Ben Gamari at 2021-12-02T18:13:30-05:00 nativeGen/aarch64: Don't rely on register width to determine amode We might be loading, e.g., a 16- or 8-bit value, in which case the register width is not reflective of the loaded element size. - - - - - 9c65197e by Ben Gamari at 2021-12-02T18:13:30-05:00 cmm/opt: Fold away shifts larger than shiftee width This is necessary for lint-correctness since we no longer allow such shifts in Cmm. - - - - - adc7f108 by Ben Gamari at 2021-12-02T18:13:30-05:00 nativeGen/aarch64: Fix handling of subword values Here we rework the handling of sub-word operations in the AArch64 backend, fixing a number of bugs and inconsistencies. In short, we now impose the invariant that all subword values are represented in registers in zero-extended form. Signed arithmetic operations are then responsible for sign-extending as necessary. Possible future work: * Use `CMP`s extended register form to avoid burning an instruction in sign-extending the second operand. * Track sign-extension state of registers to elide redundant sign extensions in blocks with frequent sub-word signed arithmetic. - - - - - e19e9e71 by Ben Gamari at 2021-12-02T18:13:31-05:00 CmmToC: Fix width of shift operations Under C's implicit widening rules, the result of an operation like (a >> b) where a::Word8 and b::Word will have type Word, yet we want Word. - - - - - ebaf7333 by Ben Gamari at 2021-12-02T18:13:31-05:00 CmmToC: Zero-extend sub-word size results As noted in Note [Zero-extending sub-word signed results] we must explicitly zero-extend the results of sub-word-sized signed operations. - - - - - 0aeaa8f3 by Ben Gamari at 2021-12-02T18:13:31-05:00 CmmToC: Always cast arguments as unsigned As noted in Note [When in doubt, cast arguments as unsigned], we must ensure that arguments have the correct signedness since some operations (e.g. `%`) have different semantics depending upon signedness. - - - - - e98dad1b by Ben Gamari at 2021-12-02T18:13:31-05:00 CmmToC: Cast possibly-signed results as unsigned C11 rule 6.3.1.1 dictates that all small integers used in expressions be implicitly converted to `signed int`. However, Cmm semantics require that the width of the operands be preserved with zero-extension semantics. For this reason we must recast sub-word arithmetic results as unsigned. - - - - - 44c08863 by Ben Gamari at 2021-12-02T18:13:31-05:00 testsuite: Specify expected word-size of machop tests These generally expect a particular word size. - - - - - fab2579e by Ben Gamari at 2021-12-02T18:14:06-05:00 hadrian: Don't rely on realpath in bindist Makefile As noted in #19963, `realpath` is not specified by POSIX and therefore cannot be assumed to be available. Here we provide a POSIX shell implementation of `realpath`, due to Julian Ospald and others. Closes #19963. - - - - - 99eb54bd by Kamil Dworakowski at 2021-12-02T21:45:10-05:00 Make openFile more tolerant of async excs (#18832) - - - - - 0e274c39 by nineonine at 2021-12-02T21:45:49-05:00 Require all dirty_MUT_VAR callers to do explicit stg_MUT_VAR_CLEAN_info comparison (#20088) - - - - - 81082cf4 by Matthew Pickering at 2021-12-03T10:12:04-05:00 Revert "Data.List specialization to []" This reverts commit bddecda1a4c96da21e3f5211743ce5e4c78793a2. This implements the first step in the plan formulated in #20025 to improve the communication and migration strategy for the proposed changes to Data.List. Requires changing the haddock submodule to update the test output. - - - - - a9e035a4 by sheaf at 2021-12-03T10:12:42-05:00 Test-suite: fix geometric mean of empty list The geometric mean computation panicked when it was given an empty list, which happens when there are no baselines. Instead, we should simply return 1. - - - - - d72720f9 by Matthew Pickering at 2021-12-06T16:27:35+00:00 Add section to the user guide about OS memory usage - - - - - 0fe45d43 by Viktor Dukhovni at 2021-12-07T06:27:12-05:00 List-monomorphic `foldr'` While a *strict* (i.e. constant space) right-fold on lists is not possible, the default `foldr'` is optimised for structures like `Seq`, that support efficient access to the right-most elements. The original default implementation seems to have a better constant factor for lists, so we add a monomorphic implementation in GHC.List. Should this be re-exported from `Data.List`? That would be a user-visible change if both `Data.Foldable` and `Data.List` are imported unqualified... - - - - - 7d2283b9 by Ben Gamari at 2021-12-07T06:27:47-05:00 compiler: Eliminate accidental loop in GHC.SysTools.BaseDir As noted in #20757, `GHC.SysTools.BaseDir.findToolDir` previously contained an loop, which would be triggered in the case that the search failed. Closes #20757. - - - - - 8044e232 by Viktor Dukhovni at 2021-12-07T06:28:23-05:00 More specific documentation of foldr' caveats - - - - - d932e2d6 by Viktor Dukhovni at 2021-12-07T06:28:23-05:00 Use italic big-O notation in Data.Foldable - - - - - 57c9c0a2 by Viktor Dukhovni at 2021-12-07T06:28:23-05:00 Fix user-guide typo - - - - - 324772bb by Ben Gamari at 2021-12-07T06:28:59-05:00 rts/Linker: Ensure that mmap_32bit_base is updated after mapping The amount of duplicated code in `mmapForLinker` hid the fact that some codepaths would fail to update `mmap_32bit_base` (specifically, on platforms like OpenBSD where `MAP_32BIT` is not supported). Refactor the function to make the implementation more obviously correct. Closes #20734. - - - - - 5dbdf878 by Ben Gamari at 2021-12-07T06:28:59-05:00 rts: +RTS -DL should imply +RTS -Dl Otherwise the user may be surprised by the missing context provided by the latter. - - - - - 7eb56064 by sheaf at 2021-12-07T06:29:38-05:00 More permissive parsing of higher-rank type IPs The parser now accepts implicit parameters with higher-rank types, such as `foo :: (?ip :: forall a. a -> a) => ...` Before this patch, we instead insisted on parentheses like so: `foo :: (?ip :: (forall a. a -> a)) => ...` The rest of the logic surrounding implicit parameters is unchanged; in particular, even with ImpredicativeTypes, this idiom is not likely to be very useful. Fixes #20654 - - - - - 427f9c12 by sheaf at 2021-12-07T13:32:55-05:00 Re-export GHC.Types from GHC.Exts Several times in the past, it has happened that things from GHC.Types were not re-exported from GHC.Exts, forcing users to import either GHC.Types or GHC.Prim, which are subject to internal change without notice. We now re-export GHC.Types from GHC.Exts, which should avoid this happening again in the future. In particular, we now re-export `Multiplicity` and `MultMul`, which we didn't before. Fixes #20695 - - - - - 483bd04d by Sebastian Graf at 2021-12-07T13:33:31-05:00 Explicit Data.List import list in check-ppr (#20789) `check-ppr` features an import of Data.List without an import list. After 81082cf4, this breaks the local validate flavour because of the compat warning and `-Werror`. So fix that. Fixes #20789. - - - - - cc2bf8e9 by Norman Ramsey at 2021-12-07T17:34:51-05:00 generalize GHC.Cmm.Dataflow to work over any node type See #20725. The commit includes source-code changes and a test case. - - - - - 4c6985cc by Sylvain Henry at 2021-12-07T17:35:30-05:00 Perf: remove an indirection when fetching the unique mask Slight decrease but still noticeable on CI: Baseline Test Metric value New value Change ----------------------------------------------------------------------------- ManyAlternatives(normal) ghc/alloc 747607676.0 747458936.0 -0.0% ManyConstructors(normal) ghc/alloc 4003722296.0 4003530032.0 -0.0% MultiLayerModules(normal) ghc/alloc 3064539560.0 3063984552.0 -0.0% MultiLayerModulesRecomp(normal) ghc/alloc 894700016.0 894700624.0 +0.0% PmSeriesG(normal) ghc/alloc 48410952.0 48262496.0 -0.3% PmSeriesS(normal) ghc/alloc 61561848.0 61415768.0 -0.2% PmSeriesT(normal) ghc/alloc 90975784.0 90829360.0 -0.2% PmSeriesV(normal) ghc/alloc 60405424.0 60259008.0 -0.2% T10421(normal) ghc/alloc 113275928.0 113137168.0 -0.1% T10421a(normal) ghc/alloc 79195676.0 79050112.0 -0.2% T10547(normal) ghc/alloc 28720176.0 28710008.0 -0.0% T10858(normal) ghc/alloc 180992412.0 180857400.0 -0.1% T11195(normal) ghc/alloc 283452220.0 283293832.0 -0.1% T11276(normal) ghc/alloc 137882128.0 137745840.0 -0.1% T11303b(normal) ghc/alloc 44453956.0 44309184.0 -0.3% T11374(normal) ghc/alloc 248118668.0 247979880.0 -0.1% T11545(normal) ghc/alloc 971994728.0 971852696.0 -0.0% T11822(normal) ghc/alloc 131544864.0 131399024.0 -0.1% T12150(optasm) ghc/alloc 79336468.0 79191888.0 -0.2% T12227(normal) ghc/alloc 495064180.0 494943040.0 -0.0% T12234(optasm) ghc/alloc 57198468.0 57053568.0 -0.3% T12425(optasm) ghc/alloc 90928696.0 90793440.0 -0.1% T12545(normal) ghc/alloc 1695417772.0 1695275744.0 -0.0% T12707(normal) ghc/alloc 956258984.0 956138864.0 -0.0% T13035(normal) ghc/alloc 102279484.0 102132616.0 -0.1% T13056(optasm) ghc/alloc 367196556.0 367066408.0 -0.0% T13253(normal) ghc/alloc 334365844.0 334255264.0 -0.0% T13253-spj(normal) ghc/alloc 125474884.0 125328672.0 -0.1% T13379(normal) ghc/alloc 359185604.0 359036960.0 -0.0% T13701(normal) ghc/alloc 2403026480.0 2402677464.0 -0.0% T13719(normal) ghc/alloc 4192234752.0 4192039448.0 -0.0% T14052(ghci) ghc/alloc 2745868552.0 2747706176.0 +0.1% T14052Type(ghci) ghc/alloc 7335937964.0 7336283280.0 +0.0% T14683(normal) ghc/alloc 2992557736.0 2992436872.0 -0.0% T14697(normal) ghc/alloc 363391248.0 363222920.0 -0.0% T15164(normal) ghc/alloc 1292578008.0 1292434240.0 -0.0% T15304(normal) ghc/alloc 1279603472.0 1279465944.0 -0.0% T15630(normal) ghc/alloc 161707776.0 161602632.0 -0.1% T16190(normal) ghc/alloc 276904644.0 276555264.0 -0.1% T16577(normal) ghc/alloc 7573033016.0 7572982752.0 -0.0% T16875(normal) ghc/alloc 34937980.0 34796592.0 -0.4% T17096(normal) ghc/alloc 287436348.0 287299368.0 -0.0% T17516(normal) ghc/alloc 1714727484.0 1714617664.0 -0.0% T17836(normal) ghc/alloc 1091095748.0 1090958168.0 -0.0% T17836b(normal) ghc/alloc 52467912.0 52321296.0 -0.3% T17977(normal) ghc/alloc 44971660.0 44826480.0 -0.3% T17977b(normal) ghc/alloc 40941128.0 40793160.0 -0.4% T18140(normal) ghc/alloc 82363124.0 82213056.0 -0.2% T18223(normal) ghc/alloc 1168448128.0 1168333624.0 -0.0% T18282(normal) ghc/alloc 131577844.0 131440400.0 -0.1% T18304(normal) ghc/alloc 86988664.0 86844432.0 -0.2% T18478(normal) ghc/alloc 742992400.0 742871136.0 -0.0% T18698a(normal) ghc/alloc 337654412.0 337526792.0 -0.0% T18698b(normal) ghc/alloc 398840772.0 398716472.0 -0.0% T18923(normal) ghc/alloc 68964992.0 68818768.0 -0.2% T1969(normal) ghc/alloc 764285884.0 764156168.0 -0.0% T19695(normal) ghc/alloc 1395577984.0 1395552552.0 -0.0% T20049(normal) ghc/alloc 89159032.0 89012952.0 -0.2% T3064(normal) ghc/alloc 191194856.0 191051816.0 -0.1% T3294(normal) ghc/alloc 1604762016.0 1604656488.0 -0.0% T4801(normal) ghc/alloc 296829368.0 296687824.0 -0.0% T5030(normal) ghc/alloc 364720540.0 364580152.0 -0.0% T5321FD(normal) ghc/alloc 271090004.0 270950824.0 -0.1% T5321Fun(normal) ghc/alloc 301244320.0 301102960.0 -0.0% T5631(normal) ghc/alloc 576154548.0 576022904.0 -0.0% T5642(normal) ghc/alloc 471105876.0 470967552.0 -0.0% T5837(normal) ghc/alloc 36328620.0 36186720.0 -0.4% T6048(optasm) ghc/alloc 103125988.0 102981024.0 -0.1% T783(normal) ghc/alloc 386945556.0 386795984.0 -0.0% T9020(optasm) ghc/alloc 247835012.0 247696704.0 -0.1% T9198(normal) ghc/alloc 47556208.0 47413784.0 -0.3% T9233(normal) ghc/alloc 682210596.0 682069960.0 -0.0% T9630(normal) ghc/alloc 1429689648.0 1429581168.0 -0.0% T9675(optasm) ghc/alloc 431092812.0 430943192.0 -0.0% T9872a(normal) ghc/alloc 1705052592.0 1705042064.0 -0.0% T9872b(normal) ghc/alloc 2180406760.0 2180395784.0 -0.0% T9872c(normal) ghc/alloc 1760508464.0 1760497936.0 -0.0% T9872d(normal) ghc/alloc 501517968.0 501309464.0 -0.0% T9961(normal) ghc/alloc 354037204.0 353891576.0 -0.0% TcPlugin_RewritePerf(normal) ghc/alloc 2381708520.0 2381550824.0 -0.0% WWRec(normal) ghc/alloc 589553520.0 589407216.0 -0.0% hard_hole_fits(normal) ghc/alloc 492122188.0 492470648.0 +0.1% hie002(normal) ghc/alloc 9336434800.0 9336443496.0 +0.0% parsing001(normal) ghc/alloc 537680944.0 537659824.0 -0.0% geo. mean -0.1% - - - - - aafa5079 by Bodigrim at 2021-12-09T04:26:35-05:00 Bump bytestring submodule to 0.11.2.0 Both tests import `Data.ByteString`, so the change in allocations is more or less expected. Metric Increase: T19695 T9630 - - - - - 803eefb1 by Matthew Pickering at 2021-12-09T04:27:11-05:00 package imports: Take into account package visibility when renaming In 806e49ae the package imports refactoring code was modified to rename package imports. There was a small oversight which meant the code didn't account for module visibility. This patch fixes that oversight. In general the "lookupPackageName" function is unsafe to use as it doesn't account for package visiblity/thinning/renaming etc, there is just one use in the compiler which would be good to audit. Fixes #20779 - - - - - 52bbea0f by Viktor Dukhovni at 2021-12-09T04:27:48-05:00 Fix typo and outdated link in Data.Foldable Amazing nobody had reported the "Foldabla" typo. :-( The Traversable docs got overhauled, leaving a stale link in Foldable to a section that got replaced. Gave the new section an anchor and updated the link. - - - - - a722859f by Viktor Dukhovni at 2021-12-09T04:27:48-05:00 A few more typos - - - - - d6177cb5 by Viktor Dukhovni at 2021-12-09T04:27:48-05:00 Drop O(n^2) warning on concat - - - - - 9f988525 by David Feuer at 2021-12-09T13:49:47+00:00 Improve mtimesDefault * Make 'mtimesDefault' use 'stimes' for the underlying monoid rather than the default 'stimes'. * Explain in the documentation why one might use `mtimesDefault`. - - - - - 2fca50d4 by Gergo ERDI at 2021-12-09T22:14:24-05:00 Use same optimization pipeline regardless of `optLevel` (#20500) - - - - - 6d031922 by Gergo ERDI at 2021-12-09T22:14:24-05:00 Add `Opt_CoreConstantFolding` to turn on constant folding (#20500) Previously, `-O1` and `-O2`, by way of their effect on the compilation pipeline, they implicitly turned on constant folding - - - - - b6f7d145 by Gergo ERDI at 2021-12-09T22:14:24-05:00 Remove `optLevel` from `DynFlags` (closes #20500) - - - - - 724df9c3 by Ryan Scott at 2021-12-09T22:15:00-05:00 Hadrian: Allow building with GHC 9.2 A separate issue is the fact that many of `hadrian`'s modules produce `-Wincomplete-uni-patterns` warnings under 9.2, but that is probably best left to a separate patch. - - - - - 80a25502 by Matthew Pickering at 2021-12-09T22:15:35-05:00 Use file hash cache when hashing object file dependencies This fixes the immediate problem that we hash the same file multiple different times which causes quite a noticeably performance regression. In the future we can probably do better than this by storing the implementation hash in the interface file rather than dependending on hashing the object file. Related to #20604 which notes some inefficiencies with the current recompilation logic. Closes #20790 ------------------------- Metric Decrease: T14052Type ------------------------- - - - - - f573cb16 by nineonine at 2021-12-10T06:16:41-05:00 rts: use allocation helpers from RtsUtils Just a tiny cleanup inspired by the following comment: https://gitlab.haskell.org/ghc/ghc/-/issues/19437#note_334271 I was just getting familiar with rts code base so I thought might as well do this. - - - - - 16eab39b by Matthew Pickering at 2021-12-10T06:17:16-05:00 Remove confusing haddock quotes in 'readInt' documentation As pointed out in #20776, placing quotes in this way linked to the 'Integral' type class which is nothing to do with 'readInt', the text should rather just be "integral", to suggest that the argument must be an integer. Closes #20776 - - - - - b4a55419 by Ben Gamari at 2021-12-10T06:17:52-05:00 docs: Drop old release notes Closes #20786 - - - - - 8d1f30e7 by Jakob Brünker at 2021-12-11T00:55:48-05:00 Add PromotedInfixT/PromotedUInfixT to TH Previously, it was not possible to refer to a data constructor using InfixT with a dynamically bound name (i.e. a name with NameFlavour `NameS` or `NameQ`) if a type constructor of the same name exists. This commit adds promoted counterparts to InfixT and UInfixT, analogously to how PromotedT is the promoted counterpart to ConT. Closes #20773 - - - - - 785859fa by Bodigrim at 2021-12-11T00:56:26-05:00 Bump text submodule to 2.0-rc2 - - - - - 352284de by Sylvain Henry at 2021-12-11T00:57:05-05:00 Perf: remove allocation in writeBlocks and fix comment (#14309) - - - - - 40a44f68 by Douglas Wilson at 2021-12-12T09:09:30-05:00 rts: correct stats when running with +RTS -qn1 Despite the documented care having been taken, several bugs are fixed here. When run with -qn1, when a SYNC_GC_PAR is requested we will have n_gc_threads == n_capabilities && n_gc_idle_threads == (n_gc_threads - 1) In this case we now: * Don't increment par_collections * Don't increment par_balanced_copied * Don't emit debug traces for idle threads * Take the fast path in scavenge_until_all_done, wakeup_gc_threads, and shutdown_gc_threads. Some ASSERTs have also been tightened. Fixes #19685 - - - - - 6b2947d2 by Matthew Pickering at 2021-12-12T09:10:06-05:00 iserv: Remove network dependent parts of libiserv As noted in #20794 the parts of libiserv and iserv-proxy depend on network, therefore are never built nor tested during CI. Due to this iserv-proxy had bitrotted due to the bound on bytestring being out of date. Given we don't test this code it seems undesirable to distribute it. Therefore, it's removed and an external maintainer can be responsible for testing it (via head.hackage if desired). Fixes #20794 - - - - - f04d1a49 by Ben Gamari at 2021-12-12T09:10:41-05:00 gitlab-ci: Bump fedora jobs to use Fedora 33 Annoyingly, this will require downstream changes in head.hackage, which depends upon the artifact produced by this job. Prompted by !6462. - - - - - 93783e6a by Andrey Mokhov at 2021-12-12T09:11:20-05:00 Drop --configure from Hadrian docs - - - - - 31bf380f by Oleg Grenrus at 2021-12-12T12:52:18-05:00 Use HasCallStack and error in GHC.List and .NonEmpty In addition to providing stack traces, the scary HasCallStack will hopefully make people think whether they want to use these functions, i.e. act as a documentation hint that something weird might happen. A single metric increased, which doesn't visibly use any method with `HasCallStack`. ------------------------- Metric Decrease: T9630 Metric Decrease: T19695 T9630 ------------------------- - - - - - 401ddd53 by Greg Steuck at 2021-12-12T12:52:56-05:00 Respect W^X in Linker.c:preloadObjectFile on OpenBSD This fixes -fexternal-interpreter for ghci. Fixes #20814. - - - - - c43ee6b8 by Andreas Klebinger at 2021-12-14T19:24:20+01:00 GHC.Utils.Misc.only: Add doc string. This function expects a singleton list as argument but only checks this in debug builds. I've added a docstring saying so. Fixes #20797 - - - - - 9ff54ea8 by Vaibhav Sagar at 2021-12-14T20:50:08-05:00 Data.Functor.Classes: fix Ord1 instance for Down - - - - - 8a2de3c2 by Tamar Christina at 2021-12-14T20:50:47-05:00 rts: update xxhash used by the linker's hashmap - - - - - 1c8d609a by alirezaghey at 2021-12-14T20:51:25-05:00 fix ambiguity in `const` documentation fixes #20412 - - - - - a5d8d47f by Joachim Breitner at 2021-12-14T20:52:00-05:00 Ghci environment: Do not remove shadowed ids Names defined earier but shadowed need to be kept around, e.g. for type signatures: ``` ghci> data T = T ghci> let t = T ghci> data T = T ghci> :t t t :: Ghci1.T ``` and indeed they can be used: ``` ghci> let t2 = Ghci1.T :: Ghci1.T ghci> :t t2 t2 :: Ghci1.T ``` However, previously this did not happen for ids (non-types), although they are still around under the qualified name internally: ``` ghci> let t = "other t" ghci> t' <interactive>:8:1: error: • Variable not in scope: t' • Perhaps you meant one of these: ‘Ghci2.t’ (imported from Ghci2), ‘t’ (line 7), ‘t2’ (line 5) ghci> Ghci2.t <interactive>:9:1: error: • GHC internal error: ‘Ghci2.t’ is not in scope during type checking, but it passed the renamer tcl_env of environment: [] • In the expression: Ghci2.t In an equation for ‘it’: it = Ghci2.t ``` This fixes the problem by simply removing the code that tries to remove shadowed ids from the environment. Now you can refer to shadowed ids using `Ghci2.t`, just like you can do for data and type constructors. This simplifies the code, makes terms and types more similar, and also fixes #20455. Now all names ever defined in GHCi are in `ic_tythings`, which is printed by `:show bindings`. But for that commands, it seems to be more ergonomic to only list those bindings that are not shadowed. Or, even if it is not more ergonomic, it’s the current behavour. So let's restore that by filtering in `icInScopeTTs`. Of course a single `TyThing` can be associated with many names. We keep it it in the bindings if _any_ of its names are still visible unqualifiedly. It's a judgement call. This commit also turns a rather old comment into a test files. The comment is is rather stale and things are better explained elsewhere. Fixes #925. Two test cases are regressing: T14052(ghci) ghc/alloc 2749444288.0 12192109912.0 +343.4% BAD T14052Type(ghci) ghc/alloc 7365784616.0 10767078344.0 +46.2% BAD This is not unexpected; the `ic_tythings list grows` a lot more if we don’t remove shadowed Ids. I tried to alleviate it a bit with earlier MRs, but couldn’t make up for it completely. Metric Increase: T14052 T14052Type - - - - - 7c2609d8 by Cheng Shao at 2021-12-14T20:52:37-05:00 base: fix clockid_t usage when it's a pointer type in C Closes #20607. - - - - - 55cb2aa7 by MichaWiedenmann1 at 2021-12-14T20:53:16-05:00 Fixes typo in documentation of the Semigroup instance of Equivalence - - - - - 82c39f4d by Ben Gamari at 2021-12-14T20:53:51-05:00 users-guide: Fix documentation for -shared flag This flag was previously called `--mk-dll`. It was renamed to `-shared` in b562cbe381d54e08dcafa11339e9a82e781ad557 but the documentation wasn't updated to match. - - - - - 4f654071 by Ben Gamari at 2021-12-14T20:53:51-05:00 compiler: Drop `Maybe ModLocation` from T_MergeForeign This field was entirely unused. - - - - - 71ecb55b by Ben Gamari at 2021-12-14T20:53:51-05:00 compiler: Use withFile instead of bracket A minor refactoring noticed by hlint. - - - - - 5686f47b by Ben Gamari at 2021-12-14T20:53:51-05:00 ghc-bin: Add --merge-objs mode This adds a new mode, `--merge-objs`, which can be used to produce merged GHCi library objects. As future work we will rip out the object-merging logic in Hadrian and Cabal and instead use this mode. Closes #20712. - - - - - 0198bb11 by Ben Gamari at 2021-12-14T20:54:27-05:00 libiserv: Rename Lib module to IServ As proposed in #20546. - - - - - ecaec722 by doyougnu at 2021-12-14T20:55:06-05:00 CmmToLlvm: Remove DynFlags, add LlvmCgConfig CodeOutput: LCGConfig, add handshake initLCGConfig Add two modules: GHC.CmmToLlvm.Config -- to hold the Llvm code gen config GHC.Driver.Config.CmmToLlvm -- for initialization, other utils CmmToLlvm: remove HasDynFlags, add LlvmConfig CmmToLlvm: add lcgContext to LCGConfig CmmToLlvm.Base: DynFlags --> LCGConfig Llvm: absorb LlvmOpts into LCGConfig CmmToLlvm.Ppr: swap DynFlags --> LCGConfig CmmToLlvm.CodeGen: swap DynFlags --> LCGConfig CmmToLlvm.CodeGen: swap DynFlags --> LCGConfig CmmToLlvm.Data: swap LlvmOpts --> LCGConfig CmmToLlvm: swap DynFlags --> LCGConfig CmmToLlvm: move LlvmVersion to CmmToLlvm.Config Additionally: - refactor Config and initConfig to hold LlvmVersion - push IO needed to get LlvmVersion to boundary between Cmm and LLvm code generation - remove redundant imports, this is much cleaner! CmmToLlvm.Config: store platformMisc_llvmTarget instead of all of platformMisc - - - - - 6b0fb9a0 by doyougnu at 2021-12-14T20:55:06-05:00 SysTools.Tasks Llvm.Types: remove redundant import Llvm.Types: remove redundant import SysTools.Tasks: remove redundant import - namely CmmToLlvm.Base - - - - - 80016022 by doyougnu at 2021-12-14T20:55:06-05:00 LLVM.CodeGen: use fast-string literals That is remove factorization of common strings and string building code for the LLVM code gen ops. Replace these with string literals to obey the FastString rewrite rule in GHC.Data.FastString and compute the string length at compile time - - - - - bc663f87 by doyougnu at 2021-12-14T20:55:06-05:00 CmmToLlvm.Config: strictify LlvmConfig field - - - - - 70f0aafe by doyougnu at 2021-12-14T20:55:06-05:00 CmmToLlvm: rename LCGConfig -> LlvmCgConfig CmmToLlvm: renamce lcgPlatform -> llvmCgPlatform CmmToLlvm: rename lcgContext -> llvmCgContext CmmToLlvm: rename lcgFillUndefWithGarbage CmmToLlvm: rename lcgSplitSections CmmToLlvm: lcgBmiVersion -> llvmCgBmiVersion CmmToLlvm: lcgLlvmVersion -> llvmCgLlvmVersion CmmToLlvm: lcgDoWarn -> llvmCgDoWarn CmmToLlvm: lcgLlvmConfig -> llvmCgLlvmConfig CmmToLlvm: llvmCgPlatformMisc --> llvmCgLlvmTarget - - - - - 34abbd81 by Greg Steuck at 2021-12-14T20:55:43-05:00 Add OpenBSD to llvm-targets This improves some tests that previously failed with: ghc: panic! (the 'impossible' happened) GHC version 9.3.20211211: Failed to lookup LLVM data layout Target: x86_64-unknown-openbsd Added the new generated lines to `llvm-targets` on an openbsd 7.0-current with clang 11.1.0. - - - - - 45bd6308 by Joachim Breitner at 2021-12-14T20:56:18-05:00 Test case from #19313 - - - - - f5a0b408 by Andrei Barbu at 2021-12-15T16:33:17-05:00 Plugin load order should follow the commandline order (fixes #17884) In the past the order was reversed because flags are consed onto a list. No particular behavior was documented. We now reverse the flags and document the behavior. - - - - - d13b9f20 by Cheng Shao at 2021-12-15T16:33:54-05:00 base: use `CUIntPtr` instead of `Ptr ()` as the autoconf detected Haskell type for C pointers When autoconf detects a C pointer type, we used to specify `Ptr ()` as the Haskell type. This doesn't work in some cases, e.g. in `wasi-libc`, `clockid_t` is a pointer type, but we expected `CClockId` to be an integral type, and `Ptr ()` lacks various integral type instances. - - - - - 89c1ffd6 by Cheng Shao at 2021-12-15T16:33:54-05:00 base: fix autoconf detection of C pointer types We used to attempt compiling `foo_t val; *val;` to determine if `foo_t` is a pointer type in C. This doesn't work if `foo_t` points to an incomplete type, and autoconf will detect `foo_t` as a floating point type in that case. Now we use `memset(val, 0, 0)` instead, and it works for incomplete types as well. - - - - - 6cea7311 by Cheng Shao at 2021-12-15T16:33:54-05:00 Add a note to base changelog - - - - - 3c3e5c03 by Ben Gamari at 2021-12-17T21:20:57-05:00 Regression test for renamer/typechecker performance (#20261) We use the parser generated by stack to ensure reproducibility - - - - - 5d5620bc by Krzysztof Gogolewski at 2021-12-17T21:21:32-05:00 Change isUnliftedTyCon to marshalablePrimTyCon (#20401) isUnliftedTyCon was used in three places: Ticky, Template Haskell and FFI checks. It was straightforward to remove it from Ticky and Template Haskell. It is now used in FFI only and renamed to marshalablePrimTyCon. Previously, it was fetching information from a field in PrimTyCon called is_unlifted. Instead, I've changed the code to compute liftedness based on the kind. isFFITy and legalFFITyCon are removed. They were only referred from an old comment that I removed. There were three functions to define a PrimTyCon, but the only difference was that they were setting is_unlifted to True or False. Everything is now done in mkPrimTyCon. I also added missing integer types in Ticky.hs, I think it was an oversight. Fixes #20401 - - - - - 9d77976d by Matthew Pickering at 2021-12-17T21:22:08-05:00 testsuite: Format metric results with comma separator As noted in #20763 the way the stats were printed was quite hard for a human to compare. Therefore we now insert the comma separator so that they are easier to compare at a glance. Before: ``` Baseline Test Metric value New value Change ----------------------------------------------------------------------------- Conversions(normal) run/alloc 107088.0 107088.0 +0.0% DeriveNull(normal) run/alloc 112050656.0 112050656.0 +0.0% InlineArrayAlloc(normal) run/alloc 1600040712.0 1600040712.0 +0.0% InlineByteArrayAlloc(normal) run/alloc 1440040712.0 1440040712.0 +0.0% InlineCloneArrayAlloc(normal) run/alloc 1600040872.0 1600040872.0 +0.0% MethSharing(normal) run/alloc 480097864.0 480097864.0 +0.0% T10359(normal) run/alloc 354344.0 354344.0 +0.0% ``` After ``` Baseline Test Metric value New value Change ---------------------------------------------------------------------------------- Conversions(normal) run/alloc 107,088 107,088 +0.0% DeriveNull(normal) run/alloc 112,050,656 112,050,656 +0.0% InlineArrayAlloc(normal) run/alloc 1,600,040,712 1,600,040,712 +0.0% InlineByteArrayAlloc(normal) run/alloc 1,440,040,712 1,440,040,712 +0.0% InlineCloneArrayAlloc(normal) run/alloc 1,600,040,872 1,600,040,872 +0.0% MethSharing(normal) run/alloc 480,097,864 480,097,864 +0.0% T10359(normal) run/alloc 354,344 354,344 +0.0% ``` Closes #20763 - - - - - 3f31bfe8 by Sylvain Henry at 2021-12-17T21:22:48-05:00 Perf: inline exprIsCheapX Allow specialization for the ok_app predicate. Perf improvements: Baseline Test Metric value New value Change ----------------------------------------------------------------------------- ManyAlternatives(normal) ghc/alloc 747317244.0 746444024.0 -0.1% ManyConstructors(normal) ghc/alloc 4005046448.0 4001548792.0 -0.1% MultiLayerModules(normal) ghc/alloc 3063361000.0 3063178472.0 -0.0% MultiLayerModulesRecomp(normal) ghc/alloc 894208428.0 894252496.0 +0.0% PmSeriesG(normal) ghc/alloc 48021692.0 47901592.0 -0.3% PmSeriesS(normal) ghc/alloc 61322504.0 61149008.0 -0.3% PmSeriesT(normal) ghc/alloc 90879364.0 90609048.0 -0.3% PmSeriesV(normal) ghc/alloc 60155376.0 59983632.0 -0.3% T10421(normal) ghc/alloc 112820720.0 112517208.0 -0.3% T10421a(normal) ghc/alloc 78783696.0 78557896.0 -0.3% T10547(normal) ghc/alloc 28331984.0 28354160.0 +0.1% T10858(normal) ghc/alloc 180715296.0 180226720.0 -0.3% T11195(normal) ghc/alloc 284139184.0 283981048.0 -0.1% T11276(normal) ghc/alloc 137830804.0 137688912.0 -0.1% T11303b(normal) ghc/alloc 44080856.0 43956152.0 -0.3% T11374(normal) ghc/alloc 249319644.0 249059288.0 -0.1% T11545(normal) ghc/alloc 971507488.0 971146136.0 -0.0% T11822(normal) ghc/alloc 131410208.0 131269664.0 -0.1% T12150(optasm) ghc/alloc 78866860.0 78762296.0 -0.1% T12227(normal) ghc/alloc 494467900.0 494138112.0 -0.1% T12234(optasm) ghc/alloc 56781044.0 56588256.0 -0.3% T12425(optasm) ghc/alloc 90462264.0 90240272.0 -0.2% T12545(normal) ghc/alloc 1694316588.0 1694128448.0 -0.0% T12707(normal) ghc/alloc 955665168.0 955005336.0 -0.1% T13035(normal) ghc/alloc 101875160.0 101713312.0 -0.2% T13056(optasm) ghc/alloc 366370168.0 365347632.0 -0.3% T13253(normal) ghc/alloc 333741472.0 332612920.0 -0.3% T13253-spj(normal) ghc/alloc 124947560.0 124427552.0 -0.4% T13379(normal) ghc/alloc 358997996.0 358879840.0 -0.0% T13701(normal) ghc/alloc 2400391456.0 2399956840.0 -0.0% T13719(normal) ghc/alloc 4193179228.0 4192476392.0 -0.0% T14052(ghci) ghc/alloc 2734741552.0 2735731808.0 +0.0% T14052Type(ghci) ghc/alloc 7323235724.0 7323042264.0 -0.0% T14683(normal) ghc/alloc 2990457260.0 2988899144.0 -0.1% T14697(normal) ghc/alloc 363606476.0 363452952.0 -0.0% T15164(normal) ghc/alloc 1291321780.0 1289491968.0 -0.1% T15304(normal) ghc/alloc 1277838020.0 1276208304.0 -0.1% T15630(normal) ghc/alloc 161074632.0 160388136.0 -0.4% T16190(normal) ghc/alloc 276567192.0 276235216.0 -0.1% T16577(normal) ghc/alloc 7564318656.0 7535598656.0 -0.4% T16875(normal) ghc/alloc 34867720.0 34752440.0 -0.3% T17096(normal) ghc/alloc 288477360.0 288156960.0 -0.1% T17516(normal) ghc/alloc 1712777224.0 1704655496.0 -0.5% T17836(normal) ghc/alloc 1092127336.0 1091709880.0 -0.0% T17836b(normal) ghc/alloc 52083516.0 51954056.0 -0.2% T17977(normal) ghc/alloc 44552228.0 44425448.0 -0.3% T17977b(normal) ghc/alloc 40540252.0 40416856.0 -0.3% T18140(normal) ghc/alloc 81908200.0 81678928.0 -0.3% T18223(normal) ghc/alloc 1166459176.0 1164418104.0 -0.2% T18282(normal) ghc/alloc 131123648.0 130740432.0 -0.3% T18304(normal) ghc/alloc 86486796.0 86223088.0 -0.3% T18478(normal) ghc/alloc 746029440.0 745619968.0 -0.1% T18698a(normal) ghc/alloc 337037580.0 336533824.0 -0.1% T18698b(normal) ghc/alloc 398324600.0 397696400.0 -0.2% T18923(normal) ghc/alloc 68496432.0 68286264.0 -0.3% T1969(normal) ghc/alloc 760424696.0 759641664.0 -0.1% T19695(normal) ghc/alloc 1421672472.0 1413682104.0 -0.6% T20049(normal) ghc/alloc 88601524.0 88336560.0 -0.3% T3064(normal) ghc/alloc 190808832.0 190659328.0 -0.1% T3294(normal) ghc/alloc 1604483120.0 1604339080.0 -0.0% T4801(normal) ghc/alloc 296501624.0 296388448.0 -0.0% T5030(normal) ghc/alloc 364336308.0 364206240.0 -0.0% T5321FD(normal) ghc/alloc 270688492.0 270386832.0 -0.1% T5321Fun(normal) ghc/alloc 300860396.0 300559200.0 -0.1% T5631(normal) ghc/alloc 575822760.0 575579160.0 -0.0% T5642(normal) ghc/alloc 470243356.0 468988784.0 -0.3% T5837(normal) ghc/alloc 35936468.0 35821360.0 -0.3% T6048(optasm) ghc/alloc 102587024.0 102222000.0 -0.4% T783(normal) ghc/alloc 386539204.0 386003344.0 -0.1% T9020(optasm) ghc/alloc 247435312.0 247324184.0 -0.0% T9198(normal) ghc/alloc 47170036.0 47054840.0 -0.2% T9233(normal) ghc/alloc 677186820.0 676550032.0 -0.1% T9630(normal) ghc/alloc 1456411516.0 1451045736.0 -0.4% T9675(optasm) ghc/alloc 427190224.0 426812568.0 -0.1% T9872a(normal) ghc/alloc 1704660040.0 1704681856.0 +0.0% T9872b(normal) ghc/alloc 2180109488.0 2180130856.0 +0.0% T9872c(normal) ghc/alloc 1760209640.0 1760231456.0 +0.0% T9872d(normal) ghc/alloc 501126052.0 500973488.0 -0.0% T9961(normal) ghc/alloc 353244688.0 353063104.0 -0.1% TcPlugin_RewritePerf(normal) ghc/alloc 2387276808.0 2387254168.0 -0.0% WWRec(normal) ghc/alloc 588651140.0 587684704.0 -0.2% hard_hole_fits(normal) ghc/alloc 492063812.0 491798360.0 -0.1% hie002(normal) ghc/alloc 9334355960.0 9334396872.0 +0.0% parsing001(normal) ghc/alloc 537410584.0 537421736.0 +0.0% geo. mean -0.2% - - - - - e04878b0 by Matthew Pickering at 2021-12-17T21:23:23-05:00 ci: Use correct metrics baseline It turns out there was already a function in the CI script to correctly set the baseline for performance tests but it was just never called. I now call it during the initialisation to set the correct baseline. I also made the make testsuite driver take into account the PERF_BASELINE_COMMIT environment variable Fixes #20811 - - - - - 1327c176 by Matthew Pickering at 2021-12-17T21:23:58-05:00 Add regression test for T20189 Closes #20189 - - - - - fc9b1755 by Matthew Pickering at 2021-12-17T21:24:33-05:00 Fix documentation formatting in Language.Haskell.TH.CodeDo Fixes #20543 - - - - - abef93f3 by Matthew Pickering at 2021-12-17T21:24:33-05:00 Expand documentation for MulArrowT constructor Fixes #20812 - - - - - 94c3ff66 by Cheng Shao at 2021-12-17T21:25:09-05:00 Binary: make withBinBuffer safe With this patch, withBinBuffer will construct a ByteString that properly captures the reference to the BinHandle internal MutableByteArray#, making it safe to convert a BinHandle to ByteString and use that ByteString outside the continuation. - - - - - a3552934 by Sebastian Graf at 2021-12-17T21:25:45-05:00 Demand: `Eq DmdType` modulo `defaultFvDmd` (#20827) Fixes #20827 by filtering out any default free variable demands (as per `defaultFvDmd`) prior to comparing the assocs of the `DmdEnv`. The details are in `Note [Demand type Equality]`. - - - - - 9529d859 by Sylvain Henry at 2021-12-17T21:26:24-05:00 Perf: avoid using (replicateM . length) when possible Extracted from !6622 - - - - - 887d8b4c by Matthew Pickering at 2021-12-17T21:26:59-05:00 testsuite: Ensure that -dcore-lint is not set for compiler performance tests This place ensures that the default -dcore-lint option is disabled by default when collect_compiler_stats is used but you can still pass -dcore-lint as an additional option (see T1969 which tests core lint performance). Fixes #20830 ------------------------- Metric Decrease: PmSeriesS PmSeriesT PmSeriesV T10858 T11195 T11276 T11374 T11822 T14052 T14052Type T17096 T17836 T17836b T18478 T18698a T18698b ------------------------- - - - - - 5ff47ff5 by Ben Gamari at 2021-12-21T01:46:00-05:00 codeGen: Introduce flag to bounds-check array accesses Here we introduce code generator support for instrument array primops with bounds checking, enabled with the `-fcheck-prim-bounds` flag. Introduced to debug #20769. - - - - - d47bb109 by Ben Gamari at 2021-12-21T01:46:00-05:00 rts: Add optional bounds checking in out-of-line primops - - - - - 8ea79a16 by Ben Gamari at 2021-12-21T01:46:00-05:00 Rename -fcatch-bottoms to -fcatch-nonexhaustive-cases As noted in #20601, the previous name was rather misleading. - - - - - 00b55bfc by Ben Gamari at 2021-12-21T01:46:00-05:00 Introduce -dlint flag As suggested in #20601, this is a short-hand for enabling the usual GHC-internal sanity checks one typically leans on when debugging runtime crashes. - - - - - 9728d6c2 by Sylvain Henry at 2021-12-21T01:46:39-05:00 Give plugins a better interface (#17957) Plugins were directly fetched from HscEnv (hsc_static_plugins and hsc_plugins). The tight coupling of plugins and of HscEnv is undesirable and it's better to store them in a new Plugins datatype and to use it in the plugins' API (e.g. withPlugins, mapPlugins...). In the process, the interactive context (used by GHCi) got proper support for different static plugins than those used for loaded modules. Bump haddock submodule - - - - - 9bc5ab64 by Greg Steuck at 2021-12-21T01:47:17-05:00 Use libc++ instead of libstdc++ on openbsd in addition to freebsd This is not entirely accurate because some openbsd architectures use gcc. Yet we don't have ghc ported to them and thus the approximation is good enough. Fixes ghcilink006 test - - - - - f92c9c0d by Greg Steuck at 2021-12-21T01:47:55-05:00 Only use -ldl conditionally to fix T3807 OpenBSD doesn't have this library and so the linker complains: ld.lld: error: unable to find library -ldl - - - - - ff657a81 by Greg Steuck at 2021-12-21T01:48:32-05:00 Mark `linkwhole` test as expected broken on OpenBSD per #20841 - - - - - 1a596d06 by doyougnu at 2021-12-22T00:12:27-05:00 Cmm: DynFlags to CmmConfig refactor add files GHC.Cmm.Config, GHC.Driver.Config.Cmm Cmm: DynFlag references --> CmmConfig Cmm.Pipeline: reorder imports, add handshake Cmm: DynFlag references --> CmmConfig Cmm.Pipeline: DynFlag references --> CmmConfig Cmm.LayoutStack: DynFlag references -> CmmConfig Cmm.Info.Build: DynFlag references -> CmmConfig Cmm.Config: use profile to retrieve platform Cmm.CLabel: unpack NCGConfig in labelDynamic Cmm.Config: reduce CmmConfig surface area Cmm.Config: add cmmDoCmmSwitchPlans field Cmm.Config: correct cmmDoCmmSwitchPlans flag The original implementation dispatches work in cmmImplementSwitchPlans in an `otherwise` branch, hence we must add a not to correctly dispatch Cmm.Config: add cmmSplitProcPoints simplify Config remove cmmBackend, and cmmPosInd Cmm.CmmToAsm: move ncgLabelDynamic to CmmToAsm Cmm.CLabel: remove cmmLabelDynamic function Cmm.Config: rename cmmOptDoLinting -> cmmDoLinting testsuite: update CountDepsAst CountDepsParser - - - - - d7cc8f19 by Matthew Pickering at 2021-12-22T00:13:02-05:00 ci: Fix master CI I made a mistake in the bash script so there were errors about "$CI_MERGE_REQUEST_DIFF_BASE_SHA" not existing. - - - - - 09b6cb45 by Alan Zimmerman at 2021-12-22T00:13:38-05:00 Fix panic trying to -ddump-parsed-ast for implicit fixity A declaration such as infixr ++++ is supplied with an implicit fixity of 9 in the parser, but uses an invalid SrcSpan to capture this. Use of this span triggers a panic. Fix the problem by not recording an exact print annotation for the non-existent fixity source. Closes #20846 - - - - - 3ed90911 by Matthew Pickering at 2021-12-22T14:47:40-05:00 testsuite: Remove reqlib modifier The reqlib modifer was supposed to indicate that a test needed a certain library in order to work. If the library happened to be installed then the test would run as normal. However, CI has never run these tests as the packages have not been installed and we don't want out tests to depend on things which might get externally broken by updating the compiler. The new strategy is to run these tests in head.hackage, where the tests have been cabalised as well as possible. Some tests couldn't be transferred into the normal style testsuite but it's better than never running any of the reqlib tests. https://gitlab.haskell.org/ghc/head.hackage/-/merge_requests/169 A few submodules also had reqlib tests and have been updated to remove it. Closes #16264 #20032 #17764 #16561 - - - - - ac3e8c52 by Matthew Pickering at 2021-12-22T14:48:16-05:00 perf ci: Start searching form the performance baseline If you specify PERF_BASELINE_COMMIT then this can fail if the specific commit you selected didn't have perf test metrics. (This can happen in CI for example if a build fails on master). Therefore instead of just reporting all tests as new, we start searching downwards from this point to try and find a good commit to report numbers from. - - - - - 9552781a by Matthew Pickering at 2021-12-22T14:48:51-05:00 Mark T16525b as fragile on windows See ticket #20852 - - - - - 13a6d85a by Andreas Klebinger at 2021-12-23T10:55:36-05:00 Make callerCC profiling mode represent entry counter flag. Fixes #20854 - - - - - 80daefce by Matthew Pickering at 2021-12-23T10:56:11-05:00 Properly filter for module visibility in resolvePackageImport This completes the fix for #20779 / !7123. Beforehand, the program worked by accident because the two versions of the library happened to be ordered properly (due to how the hashes were computed). In the real world I observed them being the other way around which meant the final lookup failed because we weren't filtering for visibility. I modified the test so that it failed (and it's fixed by this patch). - - - - - e6191d39 by Krzysztof Gogolewski at 2021-12-25T18:26:44+01:00 Fix typos - - - - - 3219610e by Greg Steuck at 2021-12-26T22:12:43-05:00 Use POSIX-compliant egrep expression to fix T8832 on OpenBSD - - - - - fd42ab5f by Matthew Pickering at 2021-12-28T09:47:53+00:00 Multiple Home Units Multiple home units allows you to load different packages which may depend on each other into one GHC session. This will allow both GHCi and HLS to support multi component projects more naturally. Public Interface ~~~~~~~~~~~~~~~~ In order to specify multiple units, the -unit @⟨filename⟩ flag is given multiple times with a response file containing the arguments for each unit. The response file contains a newline separated list of arguments. ``` ghc -unit @unitLibCore -unit @unitLib ``` where the `unitLibCore` response file contains the normal arguments that cabal would pass to `--make` mode. ``` -this-unit-id lib-core-0.1.0.0 -i -isrc LibCore.Utils LibCore.Types ``` The response file for lib, can specify a dependency on lib-core, so then modules in lib can use modules from lib-core. ``` -this-unit-id lib-0.1.0.0 -package-id lib-core-0.1.0.0 -i -isrc Lib.Parse Lib.Render ``` Then when the compiler starts in --make mode it will compile both units lib and lib-core. There is also very basic support for multiple home units in GHCi, at the moment you can start a GHCi session with multiple units but only the :reload is supported. Most commands in GHCi assume a single home unit, and so it is additional work to work out how to modify the interface to support multiple loaded home units. Options used when working with Multiple Home Units There are a few extra flags which have been introduced specifically for working with multiple home units. The flags allow a home unit to pretend it’s more like an installed package, for example, specifying the package name, module visibility and reexported modules. -working-dir ⟨dir⟩ It is common to assume that a package is compiled in the directory where its cabal file resides. Thus, all paths used in the compiler are assumed to be relative to this directory. When there are multiple home units the compiler is often not operating in the standard directory and instead where the cabal.project file is located. In this case the -working-dir option can be passed which specifies the path from the current directory to the directory the unit assumes to be it’s root, normally the directory which contains the cabal file. When the flag is passed, any relative paths used by the compiler are offset by the working directory. Notably this includes -i and -I⟨dir⟩ flags. -this-package-name ⟨name⟩ This flag papers over the awkward interaction of the PackageImports and multiple home units. When using PackageImports you can specify the name of the package in an import to disambiguate between modules which appear in multiple packages with the same name. This flag allows a home unit to be given a package name so that you can also disambiguate between multiple home units which provide modules with the same name. -hidden-module ⟨module name⟩ This flag can be supplied multiple times in order to specify which modules in a home unit should not be visible outside of the unit it belongs to. The main use of this flag is to be able to recreate the difference between an exposed and hidden module for installed packages. -reexported-module ⟨module name⟩ This flag can be supplied multiple times in order to specify which modules are not defined in a unit but should be reexported. The effect is that other units will see this module as if it was defined in this unit. The use of this flag is to be able to replicate the reexported modules feature of packages with multiple home units. Offsetting Paths in Template Haskell splices ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When using Template Haskell to embed files into your program, traditionally the paths have been interpreted relative to the directory where the .cabal file resides. This causes problems for multiple home units as we are compiling many different libraries at once which have .cabal files in different directories. For this purpose we have introduced a way to query the value of the -working-dir flag to the Template Haskell API. By using this function we can implement a makeRelativeToProject function which offsets a path which is relative to the original project root by the value of -working-dir. ``` import Language.Haskell.TH.Syntax ( makeRelativeToProject ) foo = $(makeRelativeToProject "./relative/path" >>= embedFile) ``` > If you write a relative path in a Template Haskell splice you should use the makeRelativeToProject function so that your library works correctly with multiple home units. A similar function already exists in the file-embed library. The function in template-haskell implements this function in a more robust manner by honouring the -working-dir flag rather than searching the file system. Closure Property for Home Units ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ For tools or libraries using the API there is one very important closure property which must be adhered to: > Any dependency which is not a home unit must not (transitively) depend on a home unit. For example, if you have three packages p, q and r, then if p depends on q which depends on r then it is illegal to load both p and r as home units but not q, because q is a dependency of the home unit p which depends on another home unit r. If you are using GHC by the command line then this property is checked, but if you are using the API then you need to check this property yourself. If you get it wrong you will probably get some very confusing errors about overlapping instances. Limitations of Multiple Home Units ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ There are a few limitations of the initial implementation which will be smoothed out on user demand. * Package thinning/renaming syntax is not supported * More complicated reexports/renaming are not yet supported. * It’s more common to run into existing linker bugs when loading a large number of packages in a session (for example #20674, #20689) * Backpack is not yet supported when using multiple home units. * Dependency chasing can be quite slow with a large number of modules and packages. * Loading wired-in packages as home units is currently not supported (this only really affects GHC developers attempting to load template-haskell). * Barely any normal GHCi features are supported, it would be good to support enough for ghcid to work correctly. Despite these limitations, the implementation works already for nearly all packages. It has been testing on large dependency closures, including the whole of head.hackage which is a total of 4784 modules from 452 packages. Internal Changes ~~~~~~~~~~~~~~~~ * The biggest change is that the HomePackageTable is replaced with the HomeUnitGraph. The HomeUnitGraph is a map from UnitId to HomeUnitEnv, which contains information specific to each home unit. * The HomeUnitEnv contains: - A unit state, each home unit can have different package db flags - A set of dynflags, each home unit can have different flags - A HomePackageTable * LinkNode: A new node type is added to the ModuleGraph, this is used to place the linking step into the build plan so linking can proceed in parralel with other packages being built. * New invariant: Dependencies of a ModuleGraphNode can be completely determined by looking at the value of the node. In order to achieve this, downsweep now performs a more complete job of downsweeping and then the dependenices are recorded forever in the node rather than being computed again from the ModSummary. * Some transitive module calculations are rewritten to use the ModuleGraph which is more efficient. * There is always an active home unit, which simplifies modifying a lot of the existing API code which is unit agnostic (for example, in the driver). The road may be bumpy for a little while after this change but the basics are well-tested. One small metric increase, which we accept and also submodule update to haddock which removes ExtendedModSummary. Closes #10827 ------------------------- Metric Increase: MultiLayerModules ------------------------- Co-authored-by: Fendor <power.walross at gmail.com> - - - - - 72824c63 by Richard Eisenberg at 2021-12-28T10:09:28-05:00 Skip computing superclass origins for equalities This yields a small, but measurable, performance improvement. - - - - - 8b6aafb2 by Matthew Pickering at 2021-12-29T14:09:47-05:00 Cabal: Update submodule Closes #20874 - - - - - 44a5507f by Peter Trommler at 2021-12-29T14:10:22-05:00 RTS: Fix CloneStack.c when no table next to code Function `lookupIPE` does not modify its argument. Reflect this in the type. Module `CloneStack.c` relies on this for RTS without tables next to code. Fixes #20879 - - - - - 246d2782 by sheaf at 2022-01-02T04:20:09-05:00 User's guide: newtype decls can use GADTSyntax The user's guide failed to explicitly mention that GADTSyntax can be used to declare newtypes, so we add an example and a couple of explanations. Also explains that `-XGADTs` generalises `-XExistentialQuantification`. Fixes #20848 and #20865. - - - - - f212cece by Hécate Moonlight at 2022-01-02T04:20:47-05:00 Add a source-repository stanza to rts/rts.cabal - - - - - d9e49195 by Greg Steuck at 2022-01-03T05:18:24+00:00 Replace `seq` with POSIX-standard printf(1) in ManyAlternatives test The test now passes on OpenBSD instead of generating broken source which was rejected by GHC with ManyAlternatives.hs:5:1: error: The type signature for ‘f’ lacks an accompanying binding - - - - - 80e416ae by Greg Steuck at 2022-01-03T05:18:24+00:00 Replace `seq` with POSIX-standard in PmSeriesG test - - - - - 8fa52f5c by Eric Lindblad at 2022-01-03T16:48:51-05:00 fix typo - - - - - a49f5889 by Roland Senn at 2022-01-03T16:49:29-05:00 Add regressiontest for #18045 Issue #18045 got fixed by !6971. - - - - - 7f10686e by sheaf at 2022-01-03T16:50:07-05:00 Add test for #20894 - - - - - 5111028e by sheaf at 2022-01-04T19:56:13-05:00 Check quoted TH names are in the correct namespace When quoting (using a TH single or double quote) a built-in name such as the list constructor (:), we didn't always check that the resulting 'Name' was in the correct namespace. This patch adds a check in GHC.Rename.Splice to ensure we get a Name that is in the term-level/type-level namespace, when using a single/double tick, respectively. Fixes #20884. - - - - - 1de94daa by George Thomas at 2022-01-04T19:56:51-05:00 Fix Haddock parse error in GHC.Exts.Heap.FFIClosures.hs - - - - - e59bd46a by nineonine at 2022-01-05T18:07:18+00:00 Add regression test (#13997) - - - - - c080b443 by Sylvain Henry at 2022-01-06T02:24:54-05:00 Perf: use SmallArray for primops' Ids cache (#20857) SmallArray doesn't perform bounds check (faster). Make primop tags start at 0 to avoid index arithmetic. - - - - - ec26c38b by Sylvain Henry at 2022-01-06T02:24:54-05:00 Use primOpIds cache more often (#20857) Use primOpId instead of mkPrimOpId in a few places to benefit from Id caching. I had to mess a little bit with the module hierarchy to fix cycles and to avoid adding too many new dependencies to count-deps tests. - - - - - f7fc62e2 by Greg Steuck at 2022-01-06T07:56:22-05:00 Disable T2615 on OpenBSD, close #20869 - - - - - 978ea35e by Greg Steuck at 2022-01-06T07:57:00-05:00 Change ulimit -n in openFile008 back to 1024 The test only wants 1000 descriptors, so changing the limit to double that *in the context of just this test* makes no sense. This is a manual revert of 8f7194fae23bdc6db72fc5784933f50310ce51f9. The justification given in the description doesn't instill confidence. As of HEAD, the test fails on OpenBSD where ulimit -n is hard-limited to 1024. The test suite attempts to change it to 2048, which fails. The test proceeds with the unchanged default of 512 and naturally the test program fails due to the low ulimit. The fixed test now passes. - - - - - 7b783c9d by Matthew Pickering at 2022-01-07T18:25:06-05:00 Thoughtful forcing in CoreUnfolding We noticed that the structure of CoreUnfolding could leave double the amount of CoreExprs which were retained in the situation where the template but not all the predicates were forced. This observation was then confirmed using ghc-debug: ``` (["ghc:GHC.Core:App","ghc-prim:GHC.Types:True","THUNK_1_0","THUNK_1_0","THUNK_1_0"],Count 237) (["ghc:GHC.Core:App","ghc-prim:GHC.Types:True","THUNK_1_0","THUNK_1_0","ghc-prim:GHC.Types:True"],Count 1) (["ghc:GHC.Core:Case","ghc-prim:GHC.Types:True","THUNK_1_0","THUNK_1_0","THUNK_1_0"],Count 12) (["ghc:GHC.Core:Cast","ghc-prim:GHC.Types:True","THUNK_1_0","THUNK_1_0","BLACKHOLE"],Count 1) (["ghc:GHC.Core:Cast","ghc-prim:GHC.Types:True","THUNK_1_0","THUNK_1_0","THUNK_1_0"],Count 78) (["ghc:GHC.Core:Cast","ghc-prim:GHC.Types:True","THUNK_1_0","ghc-prim:GHC.Types:False","THUNK_1_0"],Count 1) (["ghc:GHC.Core:Cast","ghc-prim:GHC.Types:True","ghc-prim:GHC.Types:False","THUNK_1_0","THUNK_1_0"],Count 3) (["ghc:GHC.Core:Cast","ghc-prim:GHC.Types:True","ghc-prim:GHC.Types:True","THUNK_1_0","THUNK_1_0"],Count 1) (["ghc:GHC.Core:Lam","ghc-prim:GHC.Types:True","THUNK_1_0","THUNK_1_0","BLACKHOLE"],Count 31) (["ghc:GHC.Core:Lam","ghc-prim:GHC.Types:True","THUNK_1_0","THUNK_1_0","THUNK_1_0"],Count 4307) (["ghc:GHC.Core:Lam","ghc-prim:GHC.Types:True","THUNK_1_0","THUNK_1_0","ghc-prim:GHC.Types:True"],Count 6) (["ghc:GHC.Core:Let","ghc-prim:GHC.Types:True","THUNK_1_0","THUNK_1_0","THUNK_1_0"],Count 29) (["ghc:GHC.Core:Lit","ghc-prim:GHC.Types:True","THUNK_1_0","THUNK_1_0","ghc-prim:GHC.Types:True"],Count 1) (["ghc:GHC.Core:Tick","ghc-prim:GHC.Types:True","THUNK_1_0","THUNK_1_0","THUNK_1_0"],Count 36) (["ghc:GHC.Core:Var","ghc-prim:GHC.Types:True","THUNK_1_0","THUNK_1_0","THUNK_1_0"],Count 1) (["ghc:GHC.Core:Var","ghc-prim:GHC.Types:True","ghc-prim:GHC.Types:False","THUNK_1_0","THUNK_1_0"],Count 6) (["ghc:GHC.Core:Var","ghc-prim:GHC.Types:True","ghc-prim:GHC.Types:False","ghc-prim:GHC.Types:True","THUNK_1_0"],Count 2) ``` Where we can see that the first argument is forced but there are still thunks remaining which retain the old expr. For my test case (a very big module, peak of 3 000 000 core terms) this reduced peak memory usage by 1G (12G -> 11G). Fixes #20905 - - - - - f583eb8e by Joachim Breitner at 2022-01-07T18:25:41-05:00 Remove dangling references to Note [Type-checking overloaded labels] that note was removed in 4196969c53c55191e644d9eb258c14c2bc8467da - - - - - 2b6c2179 by Matthew Pickering at 2022-01-11T19:37:45-05:00 hadrian: Add bootstrap scripts for building without cabal-install These scripts are originally from the cabal-install repo with a few small tweaks. This utility allows you to build hadrian without cabal-install, which can be useful for packagers. If you are a developer then build hadrian using cabal-install. If you want to bootstrap with ghc-8.10.5 then run the ./bootstrap script with the `plan-bootstrap-8.10.5.json` file. bootstrap.py -d plan-bootstrap-8.10.5.json -w /path/to-ghc The result of the bootstrap script will be a hadrian binary in `_build/bin/hadrian`. There is a script (using nix) which can be used to generate the bootstrap plans for the range of supported GHC versions using nix. generate_bootstrap_plans Otherwise you can run the commands in ./generate_bootstrap_plans directly. Fixes #17103 - - - - - a8fb4251 by Zubin Duggal at 2022-01-11T19:37:45-05:00 hadrian: allow offline bootstrapping This patch adds the ability to fetch and store dependencies needed for boostrapping hadrian. By default the script will download the dependencies from the network but some package managers disallow network access so there are also options to build given a supplied tarball. The -s option allos you to provide the tarball bootstrap.py -d plan-bootstrap-8.10.5.json -w /path/to-ghc -s sources-tarball.tar.gz Which dependencies you need can be queried using the `list-sources` option. bootstrap.py list-sources -d plan-bootstrap-8.10.5.json This produces `fetch_plan.json` which tells you where to get each source from. You can instruct the script to create the tarball using the `fetch` option. bootstrap.py fetch -d plan-bootstrap-8.10.5.json -o sources-tarball.tar.gz Together these commands mean you can build GHC without needing cabal-install. Fixes #17103 - - - - - 02cf4bc6 by Zubin Duggal at 2022-01-11T19:37:45-05:00 hadrian: Fully implement source distributions (#19317) We use `git ls-files` to get the list of files to include in the source distribution. Also implements the `-testsuite` and `-extra-tarballs` distributions. - - - - - 85473a09 by Zubin Duggal at 2022-01-11T19:37:45-05:00 ci: test bootstrapping and use hadrian for source dists - - - - - 759f3421 by Matthew Pickering at 2022-01-11T19:38:21-05:00 ci: Nightly, run one head.hackage job with core-lint and one without This fixes serious skew in the performance numbers because the packages were build with core-lint. Fixes #20826 - - - - - 6737c8e1 by Ben Gamari at 2022-01-11T19:38:56-05:00 rts: Depend explicitly on libc As noted in #19029, currently `ghc-prim` explicitly lists `libc` in `extra-libraries`, resulting in incorrect link ordering with the `extra-libraries: pthread` in `libHSrts`. Fix this by adding an explicit dependency on `libc` to `libHSrts`. Closes #19029. - - - - - 247cd336 by Ben Gamari at 2022-01-11T19:39:32-05:00 rts: Only declare environ when necessary Previously we would unconditionally provide a declaration for `environ`, even if `<unistd.h>` already provided one. This would result in `-Werror` builds failing on some platforms. Also `#include <unistd.h>` to ensure that the declaration is visible. Fixes #20861. - - - - - b65e7274 by Greg Steuck at 2022-01-11T19:40:10-05:00 Skip T18623 on OpenBSD The bug it regresses didn't happen on this OS (no RLIMIT_AS) and the regression doesn't work (ulimit: -v: unknown option) - - - - - c6300cb3 by Greg Steuck at 2022-01-11T19:40:50-05:00 Skip T16180 on OpenBSD due to bug #14012 - - - - - addf8e54 by sheaf at 2022-01-11T19:41:28-05:00 Kind TyCons: require KindSignatures, not DataKinds Uses of a TyCon in a kind signature required users to enable DataKinds, which didn't make much sense, e.g. in type U = Type type MyMaybe (a :: U) = MyNothing | MyJust a Now the DataKinds error is restricted to data constructors; the use of kind-level type constructors is instead gated behind -XKindSignatures. This patch also adds a convenience pattern synonym for patching on both a TyCon or a TcTyCon stored in a TcTyThing, used in tcTyVar and tc_infer_id. fixes #20873 - - - - - 34d8bc24 by sheaf at 2022-01-11T19:42:07-05:00 Fix parsing & printing of unboxed sums The pretty-printing of partially applied unboxed sums was incorrect, as we incorrectly dropped the first half of the arguments, even for a partial application such as (# | #) @IntRep @DoubleRep Int# which lead to the nonsensical (# DoubleRep | Int# #). This patch also allows users to write unboxed sum type constructors such as (# | #) :: TYPE r1 -> TYPE r2 -> TYPE (SumRep '[r1,r2]). Fixes #20858 and #20859. - - - - - 49731fed by sheaf at 2022-01-11T19:42:46-05:00 TcPlugins: `newWanted` uses the provided `CtLoc` The `GHC.Tc.Plugin.newWanted` function takes a `CtLoc` as an argument, but it used to discard the location information, keeping only the `CtOrigin`. It would then retrieve the source location from the `TcM` environment using `getCtLocM`. This patch changes this so that `GHC.Tc.Plugin.newWanted` passes on the full `CtLoc`. This means that authors of type-checking plugins no longer need to manually set the `CtLoc` environment in the `TcM` monad if they want to create a new Wanted constraint with the given `CtLoc` (in particular, for setting the `SrcSpan` of an emitted constraint). This makes the `newWanted` function consistent with `newGiven`, which always used the full `CtLoc` instead of using the environment. Fixes #20895 - - - - - 23d215fc by Krzysztof Gogolewski at 2022-01-11T19:43:22-05:00 warnPprTrace: pass separately the reason This makes it more similar to pprTrace, pprPanic etc. - - - - - 833216a3 by Matthew Pickering at 2022-01-11T19:43:57-05:00 Use interactive flags when printing expressions in GHCi The documentation states that the interactive flags should be use for any interactive expressions. The interactive flags are used when typechecking these expressions but not when printing. The session flags (modified by :set) are only used when loading a module. Fixes #20909 - - - - - 19b13698 by Matthew Pickering at 2022-01-11T19:43:57-05:00 Enable :seti in a multi component repl Part of #20889 - - - - - 7ca43a3f by Matthew Pickering at 2022-01-11T19:44:33-05:00 Change assertions in Stats.c to warnings (and introduce WARN macro) ASSERT should be used in situations where something very bad will happen later on if a certain invariant doesn't hold. The idea is that IF we catch the assertion earlier then it will be easier to work out what's going on at that point rather than at some indeterminate point in the future of the program. The assertions in Stats.c do not obey this philsophy and it is quite annoying if you are running a debug build (or a ticky compiler) and one of these assertions fails right at the end of your program, before the ticky report is printed out so you don't get any profiling information. Given that nothing terrible happens if these assertions are not true, or at least the terrible thing will happen in very close proximity to the assertion failure, these assertions use the new WARN macro which prints the assertion failure to stdout but does not exit the program. Of course, it would be better to fix these metrics to not trigger the assertion in the first place but if they did fail again in the future it is frustrating to be bamboozled in this manner. Fixes #20899 - - - - - e505dbd3 by Greg Steuck at 2022-01-11T19:45:11-05:00 Remove from error the parenthesized amount of memory requested Diagnostics for outofmem test on OpenBSD includes the amount of memory that it failed to allocate. This seems like an irrelevant detail that could change over time and isn't required for determining if test passed. Typical elided text is '(requested 2148532224 bytes)' - - - - - 7911aaa9 by Greg Steuck at 2022-01-11T19:45:50-05:00 Feed /dev/null into cgrun025 The test currently times out waiting for end of stdin in getContents. The expected output indicates that nothing should come for the test to pass as written. It is unclear how the test was supposed to pass, but this looks like a sufficient hack to make it work. - - - - - ed39d15c by Greg Steuck at 2022-01-11T19:46:28-05:00 Disable keep-cafs{,-fail} tests on OpenBSD They are likely broken for the same reason as FreeBSD where the tests are already disabled. - - - - - 35bea01b by Peter Trommler at 2022-01-11T19:47:04-05:00 RTS: Remove unused file xxhash.c - - - - - c2099059 by Matthew Pickering at 2022-01-11T19:47:39-05:00 RTTI: Substitute the [rk] skolems into kinds (Fixes #10616 and #10617) Co-authored-by: Roland Senn <rsx at bluewin.ch> - - - - - 92f3e6e4 by Matthew Pickering at 2022-01-11T19:48:15-05:00 docs: MonadComprehension desugar using Alternative rather than MonadPlus Fixes #20928 - - - - - 7b0c9384 by Sylvain Henry at 2022-01-12T23:25:49-05:00 Abstract BangOpts Avoid requiring to pass DynFlags to mkDataConRep/buildDataCon. When we load an interface file, these functions don't use the flags. This is preliminary work to decouple the loader from the type-checker for #14335. - - - - - a31ace56 by Sylvain Henry at 2022-01-12T23:25:49-05:00 Untangled GHC.Types.Id.Make from the driver - - - - - 81a8f7a7 by Zubin Duggal at 2022-01-12T23:26:24-05:00 testsuite: Fix import on python 3.10 - - - - - 66831b94 by Ben Gamari at 2022-01-13T14:50:13-05:00 hadrian: Include bash completion script in bindist See #20802. - - - - - be33d61a by Sebastian Graf at 2022-01-13T14:50:49-05:00 release notes: Changes to CPR analysis - - - - - c2a6c3eb by Sebastian Graf at 2022-01-13T14:50:49-05:00 release notes: Changes to Demand analysis - - - - - 9ccc445a by Eric Lindblad at 2022-01-14T10:35:46-05:00 add NUMJOBS - - - - - 564b89ae by Eric Lindblad at 2022-01-14T10:35:46-05:00 Revert "add NUMJOBS" This reverts commit c0b854e929f82c680530e944e12fad24f9e14f8e - - - - - 2dfc268c by Eric Lindblad at 2022-01-14T10:35:46-05:00 update URLs - - - - - 1aace894 by Eric Lindblad at 2022-01-14T10:35:46-05:00 reinsert target - - - - - 52a4f5ab by Andreas Klebinger at 2022-01-14T10:36:21-05:00 Add test for #20938. - - - - - e2b60be8 by Ben Gamari at 2022-01-15T03:41:16-05:00 rts: Consolidate RtsSymbols from libc Previously (9ebda74ec5331911881d734b21fbb31c00a0a22f) `environ` was added to `RtsSymbols` to ensure that environment was correctly propagated when statically linking. However, this introduced #20577 since platforms are inconsistent in whether they provide a prototype for `environ`. I fixed this by providing a prototype but while doing so dropped symbol-table entry, presumably thinking that it was redundant due to the entry in the mingw-specific table. Here I reintroduce the symbol table entry for `environ` and move libc symbols shared by Windows and Linux into a new macro, `RTS_LIBC_SYMBOLS`, avoiding this potential confusion. - - - - - 0dc72395 by Tamar Christina at 2022-01-15T03:41:55-05:00 winio: fix heap corruption and various leaks. - - - - - 4031ef62 by Eric Lindblad at 2022-01-15T20:11:55+00:00 wikipedia link - - - - - a13aff98 by Eric Lindblad at 2022-01-17T08:25:51-05:00 ms link - - - - - f161e890 by sheaf at 2022-01-17T14:52:50+00:00 Use diagnostic infrastructure in GHC.Tc.Errors - - - - - 18c797b8 by Jens Petersen at 2022-01-18T16:12:14-05:00 hadrian BinaryDist: version ghc in ghciScriptWrapper like we do for the non-Hadrian wrapper script. Otherwise if $bindir/ghc is a different ghc version then versioned ghci will incorrectly run the other ghc version instead. (Normally this would only happen if there are parallel ghc versions installed in bindir.) All the other wrapper scripts already have versioned executablename - - - - - 310424d0 by Matthew Pickering at 2022-01-18T16:12:50-05:00 Correct type of static forms in hsExprType The simplest way to do this seemed to be to persist the whole type in the extension field from the typechecker so that the few relevant places * Desugaring can work out the return type by splitting this type rather than calling `dsExpr` (slightly more efficient). * hsExprType can just return the correct type. * Zonking has to now zonk the type as well The other option we considered was wiring in StaticPtr but that is actually quite tricky because StaticPtr refers to StaticPtrInfo which has field selectors (which we can't easily wire in). Fixes #20150 - - - - - 7ec783de by Matthew Pickering at 2022-01-18T16:12:50-05:00 Add test for using type families with static pointers Issue was reported on #13306 - - - - - 2d205154 by Sebastian Graf at 2022-01-18T16:13:25-05:00 Stricten the Strict State monad I found it weird that most of the combinators weren't actually strict. Making `pure` strict in the state should hopefully give Nested CPR an easier time to unbox the nested state. - - - - - 5a6efd21 by Ben Gamari at 2022-01-18T16:14:01-05:00 rts/winio: Fix #18382 Here we refactor WinIO's IO completion scheme, squashing a memory leak and fixing #18382. To fix #18382 we drop the special thread status introduced for IoPort blocking, BlockedOnIoCompletion, as well as drop the non-threaded RTS's special dead-lock detection logic (which is redundant to the GC's deadlock detection logic), as proposed in #20947. Previously WinIO relied on foreign import ccall "wrapper" to create an adjustor thunk which can be attached to the OVERLAPPED structure passed to the operating system. It would then use foreign import ccall "dynamic" to back out the original continuation from the adjustor. This roundtrip is significantly more expensive than the alternative, using a StablePtr. Furthermore, the implementation let the adjustor leak, meaning that every IO request would leak a page of memory. Fixes T18382. - - - - - 01254ceb by Matthew Pickering at 2022-01-18T16:14:37-05:00 Add note about heap invariant Closed #20904 - - - - - 21510698 by Sergey Vinokurov at 2022-01-18T16:15:12-05:00 Improve detection of lld linker Newer lld versions may include vendor info in --version output and thus the version string may not start with ‘LLD’. Fixes #20907 - - - - - 95e7964b by Peter Trommler at 2022-01-18T20:46:08-05:00 Fix T20638 on big-endian architectures The test reads a 16 bit value from an array of 8 bit values. Naturally, that leads to different values read on big-endian architectures than on little-endian. In this case the value read is 0x8081 on big-endian and 0x8180 on little endian. This patch changes the argument of the `and` machop to mask bit 7 which is the only bit different. The test still checks that bit 15 is zero, which was the original issue in #20638. Fixes #20906. - - - - - fd0019a0 by Eric Lindblad at 2022-01-18T20:46:48-05:00 ms and gh links - - - - - 85dc61ee by Zubin Duggal at 2022-01-18T20:47:23-05:00 ci: Fix subtlety with not taking effect because of time_it (#20898) - - - - - 592e4113 by Anselm Schüler at 2022-01-19T13:31:49-05:00 Note that ImpredicativeTypes doesn’t allow polymorphic instances See #20939 - - - - - 3b009e1a by Ben Gamari at 2022-01-19T13:32:25-05:00 base: Add CTYPE pragmas to all foreign types Fixes #15531 by ensuring that we know the corresponding C type for all marshalling wrappers. Closes #15531. - - - - - 516eeb9e by Robert Hensing at 2022-01-24T21:28:24-05:00 Add -fcompact-unwind This gives users the choice to enable __compact_unwind sections when linking. These were previously hardcoded to be removed. This can be used to solved the problem "C++ does not catch exceptions when used with Haskell-main and linked by ghc", https://gitlab.haskell.org/ghc/ghc/-/issues/11829 It does not change the default behavior, because I can not estimate the impact this would have. When Apple first introduced the compact unwind ABI, a number of open source projects have taken the easy route of disabling it, avoiding errors or even just warnings shortly after its introduction. Since then, about a decade has passed, so it seems quite possible that Apple itself, and presumably many programs with it, have successfully switched to the new format, to the point where the old __eh_frame section support is in disrepair. Perhaps we should get along with the program, but for now we can test the waters with this flag, and use it to fix packages that need it. - - - - - 5262b1e5 by Robert Hensing at 2022-01-24T21:28:24-05:00 Add test case for C++ exception handling - - - - - a5c94092 by Sebastian Graf at 2022-01-24T21:29:00-05:00 Write Note [Strict State monad] to explain what G.U.M.State.Strict does As requested by Simon after review of !7342. I also took liberty to define the `Functor` instance by hand, as the derived one subverts the invariants maintained by the pattern synonym (as already stated in `Note [The one-shot state monad trick]`). - - - - - 9b0d56d3 by Eric Lindblad at 2022-01-24T21:29:38-05:00 links - - - - - 4eac8e72 by Ben Gamari at 2022-01-24T21:30:13-05:00 ghc-heap: Drop mention of BlockedOnIOCompletion Fixes bootstrap with GHC 9.0 after 5a6efd218734dbb5c1350531680cd3f4177690f1 - - - - - 7d7b9a01 by Ryan Scott at 2022-01-24T21:30:49-05:00 Hadrian: update the index-state to allow building with GHC 9.0.2 Fixes #20984. - - - - - aa50e118 by Peter Trommler at 2022-01-24T21:31:25-05:00 testsuite: Mark test that require RTS linker - - - - - 871ce2a3 by Matthew Pickering at 2022-01-25T17:27:30-05:00 ci: Move (most) deb9 jobs to deb10 deb9 is now end-of-life so we are dropping support for producing bindists. - - - - - 9d478d51 by Ryan Scott at 2022-01-25T17:28:06-05:00 DeriveGeneric: look up datacon fixities using getDataConFixityFun Previously, `DeriveGeneric` would look up the fixity of a data constructor using `getFixityEnv`, but this is subtly incorrect for data constructors defined in external modules. This sort of situation can happen with `StandaloneDeriving`, as noticed in #20994. In fact, the same bug has occurred in the past in #9830, and while that bug was fixed for `deriving Read` and `deriving Show`, the fix was never extended to `DeriveGeneric` due to an oversight. This patch corrects that oversight. Fixes #20994. - - - - - 112e9e9e by Zubin Duggal at 2022-01-25T17:28:41-05:00 Fix Werror on alpine - - - - - 781323a3 by Matthew Pickering at 2022-01-25T17:29:17-05:00 Widen T12545 acceptance window This test has been the scourge of contributors for a long time. It has caused many failed CI runs and wasted hours debugging a test which barely does anything. The fact is does nothing is the reason for the flakiness and it's very sensitive to small changes in initialisation costs, in particular adding wired-in things can cause this test to fluctuate quite a bit. Therefore we admit defeat and just bump the threshold up to 10% to catch very large regressions but otherwise don't care what this test does. Fixes #19414 - - - - - e471a680 by sheaf at 2022-01-26T12:01:45-05:00 Levity-polymorphic arrays and mutable variables This patch makes the following types levity-polymorphic in their last argument: - Array# a, SmallArray# a, Weak# b, StablePtr# a, StableName# a - MutableArray# s a, SmallMutableArray# s a, MutVar# s a, TVar# s a, MVar# s a, IOPort# s a The corresponding primops are also made levity-polymorphic, e.g. `newArray#`, `readArray#`, `writeMutVar#`, `writeIOPort#`, etc. Additionally, exception handling functions such as `catch#`, `raise#`, `maskAsyncExceptions#`,... are made levity/representation-polymorphic. Now that Array# and MutableArray# also work with unlifted types, we can simply re-define ArrayArray# and MutableArrayArray# in terms of them. This means that ArrayArray# and MutableArrayArray# are no longer primitive types, but simply unlifted newtypes around Array# and MutableArrayArray#. This completes the implementation of the Pointer Rep proposal https://github.com/ghc-proposals/ghc-proposals/pull/203 Fixes #20911 ------------------------- Metric Increase: T12545 ------------------------- ------------------------- Metric Decrease: T12545 ------------------------- - - - - - 6e94ba54 by Andreas Klebinger at 2022-01-26T12:02:21-05:00 CorePrep: Don't try to wrap partial applications of primops in profiling ticks. This fixes #20938. - - - - - b55d7db3 by sheaf at 2022-01-26T12:03:01-05:00 Ensure that order of instances doesn't matter The insert_overlapping used in lookupInstEnv used to return different results depending on the order in which instances were processed. The problem was that we could end up discarding an overlapping instance in favour of a more specific non-overlapping instance. This is a problem because, even though we won't choose the less-specific instance for matching, it is still useful for pruning away other instances, because it has the overlapping flag set while the new instance doesn't. In insert_overlapping, we now keep a list of "guard" instances, which are instances which are less-specific that one that matches (and hence which we will discard in the end), but want to keep around solely for the purpose of eliminating other instances. Fixes #20946 - - - - - 61f62062 by sheaf at 2022-01-26T12:03:40-05:00 Remove redundant SOURCE import in FitTypes Fixes #20995 - - - - - e8405829 by sheaf at 2022-01-26T12:04:15-05:00 Fix haddock markup in GHC.Tc.Errors.Types - - - - - 590a2918 by Simon Peyton Jones at 2022-01-26T19:45:22-05:00 Make RULE matching insensitive to eta-expansion This patch fixes #19790 by making the rule matcher do on-the-fly eta reduction. See Note [Eta reduction the target] in GHC.Core.Rules I found I also had to careful about casts when matching; see Note [Casts in the target] and Note [Casts in the template] Lots more comments and Notes in the rule matcher - - - - - c61ac4d8 by Matthew Pickering at 2022-01-26T19:45:58-05:00 alwaysRerun generation of ghcconfig This file needs to match exactly what is passed as the testCompiler. Before this change the settings for the first compiler to be tested woudl be stored and not regenerated if --test-compiler changed. - - - - - b5132f86 by Matthew Pickering at 2022-01-26T19:45:58-05:00 Pass config.stage argument to testsuite - - - - - 83d3ad31 by Zubin Duggal at 2022-01-26T19:45:58-05:00 hadrian: Allow testing of the stage1 compiler (#20755) - - - - - a5924b38 by Joachim Breitner at 2022-01-26T19:46:34-05:00 Simplifier: Do the right thing if doFloatFromRhs = False If `doFloatFromRhs` is `False` then the result from `prepareBinding` should not be used. Previously it was in ways that are silly (but not completly wrong, as the simplifier would clean that up again, so no test case). This was spotted by Simon during a phone call. Fixes #20976 - - - - - ce488c2b by Simon Peyton Jones at 2022-01-26T19:47:09-05:00 Better occurrence analysis with casts This patch addresses #20988 by refactoring the way the occurrence analyser deals with lambdas. Previously it used collectBinders to split off a group of binders, and deal with them together. Now I deal with them one at a time in occAnalLam, which allows me to skip casts easily. See Note [Occurrence analysis for lambda binders] about "lambda-groups" This avoidance of splitting out a list of binders has some good consequences. Less code, more efficient, and I think, more clear. The Simplifier needed a similar change, now that lambda-groups can inlude casts. It turned out that I could simplify the code here too, in particular elminating the sm_bndrs field of StrictBind. Simpler, more efficient. Compile-time metrics improve slightly; here are the ones that are +/- 0.5% or greater: Baseline Test Metric value New value Change -------------------------------------------------------------------- T11303b(normal) ghc/alloc 40,736,702 40,543,992 -0.5% T12425(optasm) ghc/alloc 90,443,459 90,034,104 -0.5% T14683(normal) ghc/alloc 2,991,496,696 2,956,277,288 -1.2% T16875(normal) ghc/alloc 34,937,866 34,739,328 -0.6% T17977b(normal) ghc/alloc 37,908,550 37,709,096 -0.5% T20261(normal) ghc/alloc 621,154,237 618,312,480 -0.5% T3064(normal) ghc/alloc 190,832,320 189,952,312 -0.5% T3294(normal) ghc/alloc 1,604,674,178 1,604,608,264 -0.0% T5321FD(normal) ghc/alloc 270,540,489 251,888,480 -6.9% GOOD T5321Fun(normal) ghc/alloc 300,707,814 281,856,200 -6.3% GOOD WWRec(normal) ghc/alloc 588,460,916 585,536,400 -0.5% geo. mean -0.3% Metric Decrease: T5321FD T5321Fun - - - - - 4007905d by Roland Senn at 2022-01-26T19:47:47-05:00 Cleanup tests in directory ghci.debugger. Fixes #21009 * Remove wrong comment about panic in `break003.script`. * Improve test `break008`. * Add test `break028` to `all.T` * Fix wrong comments in `print019.script`, `print026.script` and `result001.script`. * Remove wrong comments from `print024.script` and `print031.script`. * Replace old module name with current name in `print035.script`. - - - - - 3577defb by Matthew Pickering at 2022-01-26T19:48:22-05:00 ci: Move source-tarball and test-bootstrap into full-build - - - - - 6e09b3cf by Matthew Pickering at 2022-01-27T02:39:35-05:00 ci: Add ENABLE_NUMA flag to explicitly turn on libnuma dependency In recent releases a libnuma dependency has snuck into our bindists because the images have started to contain libnuma. We now explicitly pass `--disable-numa` to configure unless explicitly told not to by using the `ENABLE_NUMA` environment variable. So this is tested, there is one random validate job which builds with --enable-numa so that the code in the RTS is still built. Fixes #20957 and #15444 - - - - - f4ce4186 by Simon Peyton Jones at 2022-01-27T02:40:11-05:00 Improve partial signatures As #20921 showed, with partial signatures, it is helpful to use the same algorithm (namely findInferredDiff) for * picking the constraints to retain for the /group/ in Solver.decideQuantification * picking the contraints to retain for the /individual function/ in Bind.chooseInferredQuantifiers This is still regrettably declicate, but it's a step forward. - - - - - 0573aeab by Simon Peyton Jones at 2022-01-27T02:40:11-05:00 Add an Outputable instance for RecTcChecker - - - - - f0adea14 by Ryan Scott at 2022-01-27T02:40:47-05:00 Expand type synonyms in markNominal `markNominal` is repsonsible for setting the roles of type variables that appear underneath an `AppTy` to be nominal. However, `markNominal` previously did not expand type synonyms, so in a data type like this: ```hs data M f a = MkM (f (T a)) type T a = Int ``` The `a` in `M f a` would be marked nominal, even though `T a` would simply expand to `Int`. The fix is simple: call `coreView` as appropriate in `markNominal`. This is much like the fix for #14101, but in a different spot. Fixes #20999. - - - - - 18df4013 by Simon Peyton Jones at 2022-01-27T08:22:30-05:00 Define and use restoreLclEnv This fixes #20981. See Note [restoreLclEnv vs setLclEnv] in GHC.Tc.Utils.Monad. I also use updLclEnv rather than get/set when I can, because it's then much clearer that it's an update rather than an entirely new TcLclEnv coming from who-knows-where. - - - - - 31088dd3 by David Feuer at 2022-01-27T08:23:05-05:00 Add test supplied in T20996 which uses data family result kind polymorphism David (@treeowl) writes: > Following @kcsongor, I've used ridiculous data family result kind > polymorphism in `linear-generics`, and am currently working on getting > it into `staged-gg`. If it should be removed, I'd appreciate a heads up, > and I imagine Csongor would too. > > What do I need by ridiculous polymorphic result kinds? Currently, data > families are allowed to have result kinds that end in `Type` (or maybe > `TYPE r`? I'm not sure), but not in concrete data kinds. However, they > *are* allowed to have polymorphic result kinds. This leads to things I > think most of us find at least quite *weird*. For example, I can write > > ```haskell > data family Silly :: k > data SBool :: Bool -> Type where > SFalse :: SBool False > STrue :: SBool True > SSSilly :: SBool Silly > type KnownBool b where > kb :: SBool b > instance KnownBool False where kb = SFalse > instance KnownBool True where kb = STrue > instance KnownBool Silly where kb = Silly > ``` > > Basically, every kind now has potentially infinitely many "legit" inhabitants. > > As horrible as that is, it's rather useful for GHC's current native > generics system. It's possible to use these absurdly polymorphic result > kinds to probe the structure of generic representations in a relatively > pleasant manner. It's a sort of "formal type application" reminiscent of > the notion of a formal power series (see the test case below). I suspect > a system more like `kind-generics` wouldn't need this extra probing > power, but nothing like that is natively available as yet. > > If the ridiculous result kind polymorphism is banished, we'll still be > able to do what we need as long as we have stuck type families. It's > just rather less ergonomical: a stuck type family has to be used with a > concrete marker type argument. Closes #20996 Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 8fd2ac25 by Andreas Abel at 2022-01-27T18:34:54-05:00 Whitespace only - - - - - 7a854743 by Andreas Abel at 2022-01-27T18:34:54-05:00 Ctd. #18087: complete :since: info for all warnings in users guide Some warnings have been there "forever" and I could not trace back the exact genesis, so I wrote "since at least 5.04". The flag `helpful-errors` could have been added in 7.2 already. I wrote 7.4 since I have no 7.2 available and it is not recognized by 7.0. - - - - - f75411e8 by Andreas Abel at 2022-01-27T18:34:54-05:00 Re #18087 user's guide: add a note that -Wxxx used to be -fwarn-xxx The warning option syntax -W was introduced in GHC 8. The note should clarify what e.g. "since 7.6" means in connection with "-Wxxx": That "-fwarn-xxx" was introduced in 7.6.1. [ci skip] - - - - - 3cae7fde by Peter Trommler at 2022-01-27T18:35:30-05:00 testsuite: Fix AtomicPrimops test on big endian - - - - - 6cc6080c by Ben Gamari at 2022-01-27T18:36:05-05:00 users-guide: Document GHC_CHARENC environment variable As noted in #20963, this was introduced in 1b56c40578374a15b4a2593895710c68b0e2a717 but was no documentation was added at that point. Closes #20963. - - - - - ee21e2de by Ben Gamari at 2022-01-27T18:36:41-05:00 rts: Clean up RTS flags usage message Align flag descriptions and acknowledge that some flags may not be available unless the user linked with `-rtsopts` (as noted in #20961). Fixes #20961. - - - - - 7f8ce19e by Simon Peyton Jones at 2022-01-27T18:37:17-05:00 Fix getHasGivenEqs The second component is supposed to be "insoluble equalities arising from givens". But we were getting wanteds too; and that led to an outright duplication of constraints. It's not harmful, but it's not right either. I came across this when debugging something else. Easily fixed. - - - - - f9ef2d26 by Simon Peyton Jones at 2022-01-27T18:37:17-05:00 Set the TcLclEnv when solving a ForAll constraint Fix a simple omission in GHC.Tc.Solver.Canonical.solveForAll, where we ended up with the wrong TcLclEnv captured in an implication. Result: unhelpful error message (#21006) - - - - - bc6ba8ef by Sylvain Henry at 2022-01-28T12:14:41-05:00 Make most shifts branchless - - - - - 62a6d037 by Simon Peyton Jones at 2022-01-28T12:15:17-05:00 Improve boxity in deferAfterPreciseException As #20746 showed, the demand analyser behaved badly in a key I/O library (`GHC.IO.Handle.Text`), by unnessarily boxing and reboxing. This patch adjusts the subtle function deferAfterPreciseException; it's quite easy, just a bit subtle. See the new Note [deferAfterPreciseException] And this MR deals only with Problem 2 in #20746. Problem 1 is still open. - - - - - 42c47cd6 by Ben Gamari at 2022-01-29T02:40:45-05:00 rts/trace: Shrink tracing flags - - - - - cee66e71 by Ben Gamari at 2022-01-29T02:40:45-05:00 rts/EventLog: Mark various internal globals as static - - - - - 6b0cea29 by Ben Gamari at 2022-01-29T02:40:45-05:00 Propagate PythonCmd to make build system - - - - - 2e29edb7 by Ben Gamari at 2022-01-29T02:40:45-05:00 rts: Refactor event types Previously we would build the eventTypes array at runtime during RTS initialization. However, this is completely unnecessary; it is completely static data. - - - - - bb15c347 by Ben Gamari at 2022-01-29T02:40:45-05:00 rts/eventlog: Ensure that flushCount is initialized - - - - - 268efcc9 by Matthew Pickering at 2022-01-29T02:41:21-05:00 Rework the handling of SkolemInfo The main purpose of this patch is to attach a SkolemInfo directly to each SkolemTv. This fixes the large number of bugs which have accumulated over the years where we failed to report errors due to having "no skolem info" for particular type variables. Now the origin of each type varible is stored on the type variable we can always report accurately where it cames from. Fixes #20969 #20732 #20680 #19482 #20232 #19752 #10946 #19760 #20063 #13499 #14040 The main changes of this patch are: * SkolemTv now contains a SkolemInfo field which tells us how the SkolemTv was created. Used when reporting errors. * Enforce invariants relating the SkolemInfoAnon and level of an implication (ic_info, ic_tclvl) to the SkolemInfo and level of the type variables in ic_skols. * All ic_skols are TcTyVars -- Check is currently disabled * All ic_skols are SkolemTv * The tv_lvl of the ic_skols agrees with the ic_tclvl * The ic_info agrees with the SkolInfo of the implication. These invariants are checked by a debug compiler by checkImplicationInvariants. * Completely refactor kcCheckDeclHeader_sig which kept doing my head in. Plus, it wasn't right because it wasn't skolemising the binders as it decomposed the kind signature. The new story is described in Note [kcCheckDeclHeader_sig]. The code is considerably shorter than before (roughly 240 lines turns into 150 lines). It still has the same awkward complexity around computing arity as before, but that is a language design issue. See Note [Arity inference in kcCheckDeclHeader_sig] * I added new type synonyms MonoTcTyCon and PolyTcTyCon, and used them to be clear which TcTyCons have "finished" kinds etc, and which are monomorphic. See Note [TcTyCon, MonoTcTyCon, and PolyTcTyCon] * I renamed etaExpandAlgTyCon to splitTyConKind, becuase that's a better name, and it is very useful in kcCheckDeclHeader_sig, where eta-expansion isn't an issue. * Kill off the nasty `ClassScopedTvEnv` entirely. Co-authored-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 0a1d0944 by Ben Gamari at 2022-01-29T14:52:55-05:00 Drop SPARC NCG - - - - - 313afb3d by Ben Gamari at 2022-01-29T14:52:56-05:00 A few comment cleanups - - - - - d85a527f by Ben Gamari at 2022-01-29T14:52:56-05:00 Rip out SPARC register support - - - - - c6bede69 by Ben Gamari at 2022-01-29T14:52:56-05:00 rts: Rip out SPARC support - - - - - a67c2471 by Ben Gamari at 2022-01-29T14:52:56-05:00 Rip out remaining SPARC support - - - - - 5771b690 by Ben Gamari at 2022-01-29T14:52:56-05:00 CmmToAsm: Drop RegPair SPARC was its last and only user. - - - - - 512ed3f1 by Ben Gamari at 2022-01-29T14:52:56-05:00 CmmToAsm: Make RealReg a newtype Now that RegPair is gone we no longer need to pay for the additional box. - - - - - 88fea6aa by Ben Gamari at 2022-01-29T14:52:56-05:00 rts: Drop redundant #include <Arena.h> - - - - - ea2a4034 by Ben Gamari at 2022-01-29T14:52:56-05:00 CmmToAsm: Drop ncgExpandTop This was only needed for SPARC's synthetic instructions. - - - - - 88fce740 by Ben Gamari at 2022-01-29T14:54:04-05:00 rel-notes: Note dropping of SPARC support - - - - - eb956cf1 by Ben Gamari at 2022-01-30T06:27:19-05:00 testsuite: Force-enable caret diagnostics in T17786 Otherwise GHC realizes that it's not attached to a proper tty and will disable caret diagnostics. - - - - - d07799ab by Ben Gamari at 2022-01-30T06:27:19-05:00 testsuite: Make T7275 more robust against CCid changes The cost-center numbers are somewhat unstable; normalise them out. - - - - - c76c8050 by Ben Gamari at 2022-01-30T06:27:19-05:00 rts: Don't allocate closurePtrs# pointers on C stack Previously `closurePtrs#` would allocate an aray of the size of the closure being decoded on the C stack. This was ripe for overflowing the C stack overflow. This resulted in `T12492` failing on Windows. - - - - - 3af95f7a by Ben Gamari at 2022-01-30T06:27:19-05:00 testsuite/T4029: Don't depend on echo On Windows the `cmd.exe` shell may be used to execute the command, which will print `ECHO is on.` instead of a newline if you give it no argument. Avoid this by rather using `printf`. - - - - - 3531c478 by Ben Gamari at 2022-01-30T06:27:19-05:00 Use PATH_FMT instead of %s to format `pathchar *` A few %s occurrences have snuck in over the past months. - - - - - ee5c4f9d by Zubin Duggal at 2022-01-31T16:51:55+05:30 Improve migration strategy for the XDG compliance change to the GHC application directory. We want to always use the old path (~/.ghc/..) if it exists. But we never want to create the old path. This ensures that the migration can eventually be completed once older GHC versions are no longer in circulation. Fixes #20684, #20669, #20660 - - - - - 60a54a8f by doyougnu at 2022-01-31T18:46:11-05:00 StgToCmm: decouple DynFlags, add StgToCmmConfig StgToCmm: add Config, remove CgInfoDownwards StgToCmm: runC api change to take StgToCmmConfig StgToCmm: CgInfoDownad -> StgToCmmConfig StgToCmm.Monad: update getters/setters/withers StgToCmm: remove CallOpts in StgToCmm.Closure StgToCmm: remove dynflag references StgToCmm: PtrOpts removed StgToCmm: add TMap to config, Prof - dynflags StgToCmm: add omit yields to config StgToCmm.ExtCode: remove redundant import StgToCmm.Heap: remove references to dynflags StgToCmm: codeGen api change, DynFlags -> Config StgToCmm: remove dynflags in Env and StgToCmm StgToCmm.DataCon: remove dynflags references StgToCmm: remove dynflag references in DataCon StgToCmm: add backend avx flags to config StgToCmm.Prim: remove dynflag references StgToCmm.Expr: remove dynflag references StgToCmm.Bind: remove references to dynflags StgToCmm: move DoAlignSanitisation to Cmm.Type StgToCmm: remove PtrOpts in Cmm.Parser.y DynFlags: update ipInitCode api StgToCmm: Config Module is single source of truth StgToCmm: Lazy config breaks IORef deadlock testsuite: bump countdeps threshold StgToCmm.Config: strictify fields except UpdFrame Strictifying UpdFrameOffset causes the RTS build with stage1 to deadlock. Additionally, before the deadlock performance of the RTS is noticeably slower. StgToCmm.Config: add field descriptions StgToCmm: revert strictify on Module in config testsuite: update CountDeps tests StgToCmm: update comment, fix exports Specifically update comment about loopification passed into dynflags then stored into stgToCmmConfig. And remove getDynFlags from Monad.hs exports Types.Name: add pprFullName function StgToCmm.Ticky: use pprFullname, fixup ExtCode imports Cmm.Info: revert cmmGetClosureType removal StgToCmm.Bind: use pprFullName, Config update comments StgToCmm: update closureDescription api StgToCmm: SAT altHeapCheck StgToCmm: default render for Info table, ticky Use default rendering contexts for info table and ticky ticky, which should be independent of command line input. testsuite: bump count deps pprFullName: flag for ticky vs normal style output convertInfoProvMap: remove unused parameter StgToCmm.Config: add backend flags to config StgToCmm.Config: remove Backend from Config StgToCmm.Prim: refactor Backend call sites StgToCmm.Prim: remove redundant imports StgToCmm.Config: refactor vec compatibility check StgToCmm.Config: add allowQuotRem2 flag StgToCmm.Ticky: print internal names with parens StgToCmm.Bind: dispatch ppr based on externality StgToCmm: Add pprTickyname, Fix ticky naming Accidently removed the ctx for ticky SDoc output. The only relevant flag is sdocPprDebug which was accidental set to False due to using defaultSDocContext without altering the flag. StgToCmm: remove stateful fields in config fixup: config: remove redundant imports StgToCmm: move Sequel type to its own module StgToCmm: proliferate getCallMethod updated api StgToCmm.Monad: add FCodeState to Monad Api StgToCmm: add second reader monad to FCode fixup: Prim.hs: missed a merge conflict fixup: Match countDeps tests to HEAD StgToCmm.Monad: withState -> withCgState To disambiguate it from mtl withState. This withState shouldn't be returning the new state as a value. However, fixing this means tackling the knot tying in CgState and so is very difficult since it changes when the thunk of the knot is forced which either leads to deadlock or to compiler panic. - - - - - 58eccdbc by Ben Gamari at 2022-01-31T18:46:47-05:00 codeGen: Fix two buglets in -fbounds-check logic @Bodigrim noticed that the `compareByteArray#` bounds-checking logic had flipped arguments and an off-by-one. For the sake of clarity I also refactored occurrences of `cmmOffset` to rather use `cmmOffsetB`. I suspect the former should be retired. - - - - - 584f03fa by Simon Peyton Jones at 2022-01-31T18:47:23-05:00 Make typechecker trace less strict Fixes #21011 - - - - - 60ac7300 by Elton at 2022-02-01T12:28:49-05:00 Use braces in TH case pprint (fixes #20893) This patch ensures that the pretty printer formats `case` statements using braces (instead of layout) to remain consistent with the formatting of other statements (like `do`) - - - - - fdda93b0 by Elton at 2022-02-01T12:28:49-05:00 Use braces in TH LambdaCase and where clauses This patch ensures that the pretty printer formats LambdaCase and where clauses using braces (instead of layout) to remain consistent with the formatting of other statements (like `do` and `case`) - - - - - 06185102 by Ben Gamari at 2022-02-01T12:29:26-05:00 Consistently upper-case "Note [" This was achieved with git ls-tree --name-only HEAD -r | xargs sed -i -e 's/note \[/Note \[/g' - - - - - 88fba8a4 by Ben Gamari at 2022-02-01T12:29:26-05:00 Fix a few Note inconsistencies - - - - - 05548a22 by Douglas Wilson at 2022-02-02T19:26:06-05:00 rts: Address failures to inline - - - - - 074945de by Simon Peyton Jones at 2022-02-02T19:26:41-05:00 Two small improvements in the Simplifier As #20941 describes, this patch implements a couple of small fixes to the Simplifier. They make a difference principally with -O0, so few people will notice. But with -O0 they can reduce the number of Simplifer iterations. * In occurrence analysis we avoid making x = (a,b) into a loop breaker because we want to be able to inline x, or (more likely) do case-elimination. But HEAD does not treat x = let y = blah in (a,b) in the same way. We should though, because we are going to float that y=blah out of the x-binding. A one-line fix in OccurAnal. * The crucial function exprIsConApp_maybe uses getUnfoldingInRuleMatch (rightly) but the latter was deeply strange. In HEAD, if rule-rewriting was off (-O0) we only looked inside stable unfoldings. Very stupid. The patch simplifies. * I also noticed that in simplStableUnfolding we were failing to delete the DFun binders from the usage. So I added that. Practically zero perf change across the board, except that we get more compiler allocation in T3064 (which is compiled with -O0). There's a good reason: we get better code. But there are lots of other small compiler allocation decreases: Metrics: compile_time/bytes allocated --------------------- Baseline Test Metric value New value Change ----------------------------------------------------------------- PmSeriesG(normal) ghc/alloc 44,260,817 44,184,920 -0.2% PmSeriesS(normal) ghc/alloc 52,967,392 52,891,632 -0.1% PmSeriesT(normal) ghc/alloc 75,498,220 75,421,968 -0.1% PmSeriesV(normal) ghc/alloc 52,341,849 52,265,768 -0.1% T10421(normal) ghc/alloc 109,702,291 109,626,024 -0.1% T10421a(normal) ghc/alloc 76,888,308 76,809,896 -0.1% T10858(normal) ghc/alloc 125,149,038 125,073,648 -0.1% T11276(normal) ghc/alloc 94,159,364 94,081,640 -0.1% T11303b(normal) ghc/alloc 40,230,059 40,154,368 -0.2% T11822(normal) ghc/alloc 107,424,540 107,346,088 -0.1% T12150(optasm) ghc/alloc 76,486,339 76,426,152 -0.1% T12234(optasm) ghc/alloc 55,585,046 55,507,352 -0.1% T12425(optasm) ghc/alloc 88,343,288 88,265,312 -0.1% T13035(normal) ghc/alloc 98,919,768 98,845,600 -0.1% T13253-spj(normal) ghc/alloc 121,002,153 120,851,040 -0.1% T16190(normal) ghc/alloc 290,313,131 290,074,152 -0.1% T16875(normal) ghc/alloc 34,756,121 34,681,440 -0.2% T17836b(normal) ghc/alloc 45,198,100 45,120,288 -0.2% T17977(normal) ghc/alloc 39,479,952 39,404,112 -0.2% T17977b(normal) ghc/alloc 37,213,035 37,137,728 -0.2% T18140(normal) ghc/alloc 79,430,588 79,350,680 -0.1% T18282(normal) ghc/alloc 128,303,182 128,225,384 -0.1% T18304(normal) ghc/alloc 84,904,713 84,831,952 -0.1% T18923(normal) ghc/alloc 66,817,241 66,731,984 -0.1% T20049(normal) ghc/alloc 86,188,024 86,107,920 -0.1% T5837(normal) ghc/alloc 35,540,598 35,464,568 -0.2% T6048(optasm) ghc/alloc 99,812,171 99,736,032 -0.1% T9198(normal) ghc/alloc 46,380,270 46,304,984 -0.2% geo. mean -0.0% Metric Increase: T3064 - - - - - d2cce453 by Morrow at 2022-02-02T19:27:21-05:00 Fix @since annotation on Nat - - - - - 6438fed9 by Simon Peyton Jones at 2022-02-02T19:27:56-05:00 Refactor the escaping kind check for data constructors As #20929 pointed out, we were in-elegantly checking for escaping kinds in `checkValidType`, even though that check was guaranteed to succeed for type signatures -- it's part of kind-checking a type. But for /data constructors/ we kind-check the pieces separately, so we still need the check. This MR is a pure refactor, moving the test from `checkValidType` to `checkValidDataCon`. No new tests; external behaviour doesn't change. - - - - - fb05e5ac by Andreas Klebinger at 2022-02-02T19:28:31-05:00 Replace sndOfTriple with sndOf3 I also cleaned up the imports slightly while I was at it. - - - - - fbc77d3a by Matthew Pickering at 2022-02-02T19:29:07-05:00 testsuite: Honour PERF_BASELINE_COMMIT when computing allowed metric changes We now get all the commits between the PERF_BASELINE_COMMIT and HEAD and check any of them for metric changes. Fixes #20882 - - - - - 0a82ae0d by Simon Peyton Jones at 2022-02-02T23:49:58-05:00 More accurate unboxing This patch implements a fix for #20817. It ensures that * The final strictness signature for a function accurately reflects the unboxing done by the wrapper See Note [Finalising boxity for demand signatures] and Note [Finalising boxity for let-bound Ids] * A much better "layer-at-a-time" implementation of the budget for how many worker arguments we can have See Note [Worker argument budget] Generally this leads to a bit more worker/wrapper generation, because instead of aborting entirely if the budget is exceeded (and then lying about boxity), we unbox a bit. Binary sizes in increase slightly (around 1.8%) because of the increase in worker/wrapper generation. The big effects are to GHC.Ix, GHC.Show, GHC.IO.Handle.Internals. If we did a better job of dropping dead code, this effect might go away. Some nofib perf improvements: Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- VSD +1.8% -0.5% 0.017 0.017 0.0% awards +1.8% -0.1% +2.3% +2.3% 0.0% banner +1.7% -0.2% +0.3% +0.3% 0.0% bspt +1.8% -0.1% +3.1% +3.1% 0.0% eliza +1.8% -0.1% +1.2% +1.2% 0.0% expert +1.7% -0.1% +9.6% +9.6% 0.0% fannkuch-redux +1.8% -0.4% -9.3% -9.3% 0.0% kahan +1.8% -0.1% +22.7% +22.7% 0.0% maillist +1.8% -0.9% +21.2% +21.6% 0.0% nucleic2 +1.7% -5.1% +7.5% +7.6% 0.0% pretty +1.8% -0.2% 0.000 0.000 0.0% reverse-complem +1.8% -2.5% +12.2% +12.2% 0.0% rfib +1.8% -0.2% +2.5% +2.5% 0.0% scc +1.8% -0.4% 0.000 0.000 0.0% simple +1.7% -1.3% +17.0% +17.0% +7.4% spectral-norm +1.8% -0.1% +6.8% +6.7% 0.0% sphere +1.7% -2.0% +13.3% +13.3% 0.0% tak +1.8% -0.2% +3.3% +3.3% 0.0% x2n1 +1.8% -0.4% +8.1% +8.1% 0.0% -------------------------------------------------------------------------------- Min +1.1% -5.1% -23.6% -23.6% 0.0% Max +1.8% +0.0% +36.2% +36.2% +7.4% Geometric Mean +1.7% -0.1% +6.8% +6.8% +0.1% Compiler allocations in CI have a geometric mean of +0.1%; many small decreases but there are three bigger increases (7%), all because we do more worker/wrapper than before, so there is simply more code to compile. That's OK. Perf benchmarks in perf/should_run improve in allocation by a geo mean of -0.2%, which is good. None get worse. T12996 improves by -5.8% Metric Decrease: T12996 Metric Increase: T18282 T18923 T9630 - - - - - d1ef6288 by Peter Trommler at 2022-02-02T23:50:34-05:00 Cmm: fix equality of expressions Compare expressions and types when comparing `CmmLoad`s. Fixes #21016 - - - - - e59446c6 by Peter Trommler at 2022-02-02T23:50:34-05:00 Check type first then expression - - - - - b0e1ef4a by Matthew Pickering at 2022-02-03T14:44:17-05:00 Add failing test for #20791 The test produces different output on static vs dynamic GHC builds. - - - - - cae1fb17 by Matthew Pickering at 2022-02-03T14:44:17-05:00 Frontend01 passes with static GHC - - - - - e343526b by Matthew Pickering at 2022-02-03T14:44:17-05:00 Don't initialise plugins when there are no pipelines to run - - - - - abac45fc by Matthew Pickering at 2022-02-03T14:44:17-05:00 Mark prog003 as expected_broken on static way #20704 - - - - - 13300dfd by Matthew Pickering at 2022-02-03T14:44:17-05:00 Filter out -rtsopts in T16219 to make static/dynamic ways agree - - - - - d89439f2 by Matthew Pickering at 2022-02-03T14:44:17-05:00 T13168: Filter out rtsopts for consistency between dynamic and static ways - - - - - 00180cdf by Matthew Pickering at 2022-02-03T14:44:17-05:00 Accept new output for T14335 test This test was previously not run due to #20960 - - - - - 1accdcff by Matthew Pickering at 2022-02-03T14:44:17-05:00 Add flushes to plugin tests which print to stdout Due to #20791 you need to explicitly flush as otherwise the output from these tests doesn't make it to stdout. - - - - - d820f2e8 by Matthew Pickering at 2022-02-03T14:44:17-05:00 Remove ghc_plugin_way Using ghc_plugin_way had the unintended effect of meaning certain tests weren't run at all when ghc_dynamic=true, if you delete this modifier then the tests work in both the static and dynamic cases. - - - - - aa5ef340 by Matthew Pickering at 2022-02-03T14:44:17-05:00 Unbreak T13168 on windows Fixes #14276 - - - - - 84ab0153 by Matthew Pickering at 2022-02-03T14:44:53-05:00 Rewrite CallerCC parser using ReadP This allows us to remove the dependency on parsec and hence transitively on text. Also added some simple unit tests for the parser and fixed two small issues in the documentation. Fixes #21033 - - - - - 4e6780bb by Matthew Pickering at 2022-02-03T14:45:28-05:00 ci: Add debian 11 jobs (validate/release/nightly) Fixes #21002 - - - - - eddaa591 by Ben Gamari at 2022-02-04T10:01:59-05:00 compiler: Introduce and use RoughMap for instance environments Here we introduce a new data structure, RoughMap, inspired by the previous `RoughTc` matching mechanism for checking instance matches. This allows [Fam]InstEnv to be implemented as a trie indexed by these RoughTc signatures, reducing the complexity of instance lookup and FamInstEnv merging (done during the family instance conflict test) from O(n) to O(log n). The critical performance improvement currently realised by this patch is in instance matching. In particular the RoughMap mechanism allows us to discount many potential instances which will never match for constraints involving type variables (see Note [Matching a RoughMap]). In realistic code bases matchInstEnv was accounting for 50% of typechecker time due to redundant work checking instances when simplifying instance contexts when deriving instances. With this patch the cost is significantly reduced. The larger constants in InstEnv creation do mean that a few small tests regress in allocations slightly. However, the runtime of T19703 is reduced by a factor of 4. Moreover, the compilation time of the Cabal library is slightly improved. A couple of test cases are included which demonstrate significant improvements in compile time with this patch. This unfortunately does not fix the testcase provided in #19703 but does fix #20933 ------------------------- Metric Decrease: T12425 Metric Increase: T13719 T9872a T9872d hard_hole_fits ------------------------- Co-authored-by: Matthew Pickering <matthewtpickering at gmail.com> - - - - - 62d670eb by Matthew Pickering at 2022-02-04T10:02:35-05:00 testsuite: Run testsuite dependency calculation before GHC is built The main motivation for this patch is to allow tests to be added to the testsuite which test things about the source tree without needing to build GHC. In particular the notes linter can easily start failing and by integrating it into the testsuite the process of observing these changes is caught by normal validation procedures rather than having to run the linter specially. With this patch I can run ``` ./hadrian/build test --flavour=devel2 --only="uniques" ``` In a clean tree to run the checkUniques linter without having to build GHC. Fixes #21029 - - - - - 4bd52410 by Hécate Moonlight at 2022-02-04T16:14:10-05:00 Add the Ix class to Foreign C integral types Related CLC proposal is here: https://github.com/haskell/core-libraries-committee/issues/30 - - - - - de6d7692 by Ben Gamari at 2022-02-04T16:14:47-05:00 Drop dead code - - - - - b79206f1 by Ben Gamari at 2022-02-04T16:14:47-05:00 Add comments - - - - - 58d7faac by Ben Gamari at 2022-02-04T16:14:47-05:00 cmm: Introduce cmmLoadBWord and cmmLoadGCWord - - - - - 7217156c by Ben Gamari at 2022-02-04T16:14:47-05:00 Introduce alignment in CmmLoad - - - - - 99ea5f2c by Ben Gamari at 2022-02-04T16:14:47-05:00 Introduce alignment to CmmStore - - - - - 606b59a5 by Ben Gamari at 2022-02-04T16:14:47-05:00 Fix array primop alignment - - - - - 1cf9616a by Ben Gamari at 2022-02-04T16:14:47-05:00 llvmGen: Handle unaligned loads/stores This allows us to produce valid code for indexWord8ArrayAs*# on platforms that lack unaligned memory access. - - - - - 8c18feba by Ben Gamari at 2022-02-04T16:14:47-05:00 primops: Fix documentation of setByteArray# Previously the documentation was subtly incorrect regarding the bounds of the operation. Fix this and add a test asserting that a zero-length operation is in fact a no-op. - - - - - 88480e55 by nineonine at 2022-02-04T20:35:45-05:00 Fix unsound behavior of unlifted datatypes in ghci (#20194) Previously, directly calling a function that pattern matches on an unlifted data type which has at least two constructors in GHCi resulted in a segfault. This happened due to unaccounted return frame info table pointer. The fix is to pop the above mentioned frame info table pointer when unlifted things are returned. See Note [Popping return frame for unlifted things] authors: bgamari, nineonine - - - - - a5c7068c by Simon Peyton Jones at 2022-02-04T20:36:20-05:00 Add Outputable instance for Messages c.f. #20980 - - - - - bf495f72 by Simon Peyton Jones at 2022-02-04T20:36:20-05:00 Add a missing restoreLclEnv The commit commit 18df4013f6eaee0e1de8ebd533f7e96c4ee0ff04 Date: Sat Jan 22 01:12:30 2022 +0000 Define and use restoreLclEnv omitted to change one setLclEnv to restoreLclEnv, namely the one in GHC.Tc.Errors.warnRedundantConstraints. This new commit fixes the omission. - - - - - 6af8e71e by Simon Peyton Jones at 2022-02-04T20:36:20-05:00 Improve errors for non-existent labels This patch fixes #17469, by improving matters when you use non-existent field names in a record construction: data T = MkT { x :: Int } f v = MkT { y = 3 } The check is now made in the renamer, in GHC.Rename.Env.lookupRecFieldOcc. That in turn led to a spurious error in T9975a, which is fixed by making GHC.Rename.Names.extendGlobalRdrEnvRn fail fast if it finds duplicate bindings. See Note [Fail fast on duplicate definitions] in that module for more details. This patch was originated and worked on by Alex D (@nineonine) - - - - - 299acff0 by nineonine at 2022-02-05T19:21:49-05:00 Exit with failure when -e fails (fixes #18411 #9916 #17560) - - - - - 549292eb by Matthew Pickering at 2022-02-05T19:22:25-05:00 Make implication tidying agree with Note [Tidying multiple names at once] Note [Tidying multiple names at once] indicates that if multiple variables have the same name then we shouldn't prioritise one of them and instead rename them all to a1, a2, a3... etc This patch implements that change, some error message changes as expected. Closes #20932 - - - - - 2e9248b7 by Ben Gamari at 2022-02-06T01:43:56-05:00 rts/m32: Accept any address within 4GB of program text Previously m32 would assume that the program image was located near the start of the address space and therefore assume that it wanted pages in the bottom 4GB of address space. Instead we now check whether they are within 4GB of whereever the program is loaded. This is necessary on Windows, which now tends to place the image in high memory. The eventual goal is to use m32 to allocate memory for linker sections on Windows. - - - - - 86589b89 by GHC GitLab CI at 2022-02-06T01:43:56-05:00 rts: Generalize mmapForLinkerMarkExecutable Renamed to mprotectForLinker and allowed setting of arbitrary protection modes. - - - - - 88ef270a by GHC GitLab CI at 2022-02-06T01:43:56-05:00 rts/m32: Add consistency-checking infrastructure This adds logic, enabled in the `-debug` RTS for checking the internal consistency of the m32 allocator. This area has always made me a bit nervous so this should help me sleep better at night in exchange for very little overhead. - - - - - 2d6f0b17 by Ben Gamari at 2022-02-06T01:43:56-05:00 rts/m32: Free large objects back to the free page pool Not entirely convinced that this is worth doing. - - - - - e96f50be by GHC GitLab CI at 2022-02-06T01:43:56-05:00 rts/m32: Increase size of free page pool to 256 pages - - - - - fc083b48 by Ben Gamari at 2022-02-06T01:43:56-05:00 rts: Dump memory map on memory mapping failures Fixes #20992. - - - - - 633296bc by Ben Gamari at 2022-02-06T01:43:56-05:00 Fix macro redefinition warnings for PRINTF * Move `PRINTF` macro from `Stats.h` to `Stats.c` as it's only needed in the latter. * Undefine `PRINTF` at the end of `Messages.h` to avoid leaking it. - - - - - 37d435d2 by John Ericson at 2022-02-06T01:44:32-05:00 Purge DynFlags from GHC.Stg Also derive some more instances. GHC doesn't need them, but downstream consumers may need to e.g. put stuff in maps. - - - - - 886baa34 by Peter Trommler at 2022-02-06T10:58:18+01:00 RTS: Fix cabal specification In 35bea01b xxhash.c was removed. Remove the extra-source-files stanza referring to it. - - - - - 27581d77 by Alex D at 2022-02-06T20:50:44-05:00 hadrian: remove redundant import - - - - - 4ff19981 by John Ericson at 2022-02-07T11:04:43-05:00 GHC.HsToCore.Coverage: No more HscEnv, less DynFlags Progress towards #20730 - - - - - b09389a6 by John Ericson at 2022-02-07T11:04:43-05:00 Create `CoverageConfig` As requested by @mpickering to collect the information we project from `HscEnv` - - - - - ff867c46 by Greg Steuck at 2022-02-07T11:05:24-05:00 Avoid using removed utils/checkUniques in validate Asked the question: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/7460/diffs#4061f4d17546e239dd10d78c6b48668c2a288e02_1_0 - - - - - a9355e84 by sheaf at 2022-02-08T05:27:25-05:00 Allow HasField in quantified constraints We perform validity checking on user-written HasField instances, for example to disallow: data Foo a = Foo { fld :: Int } instance HasField "fld" (Foo a) Bool However, these checks were also being made on quantified constraints, e.g. data Bar where Bar :: (forall a. HasField s (Foo a) Int) => Proxy s -> Bar This patch simply skips validity checking for quantified constraints, in line with what we already do for equality constraints such as Coercible. Fixes #20989 - - - - - 6d77d3d8 by sheaf at 2022-02-08T05:28:05-05:00 Relax TyEq:N: allow out-of-scope newtype DataCon The 'bad_newtype' assertion in GHC.Tc.Solver.Canonical.canEqCanLHSFinish failed to account for the possibility that the newtype constructor might not be in scope, in which case we don't provide any guarantees about canonicalising away a newtype on the RHS of a representational equality. Fixes #21010 - - - - - a893d2f3 by Matthew Pickering at 2022-02-08T05:28:42-05:00 Remove linter dependency on lint-submods - - - - - 457a5b9c by Ben Gamari at 2022-02-08T05:28:42-05:00 notes-util: initial commit - - - - - 1a943859 by Ben Gamari at 2022-02-08T05:28:42-05:00 gitlab-ci: Add lint-notes job - - - - - bc5cbce6 by Matthew Pickering at 2022-02-08T05:28:42-05:00 Add notes linter to testsuite - - - - - 38c6e301 by Matthew Pickering at 2022-02-08T05:28:42-05:00 Fix some notes - - - - - c3aac0f8 by Matthew Pickering at 2022-02-08T05:28:42-05:00 Add suggestion mode to notes-util - - - - - 5dd29aea by Cale Gibbard at 2022-02-08T05:29:18-05:00 `hscSimpleIface` drop fingerprint param and ret `hscSimpleIface` does not depend on or modify the `Maybe Fingerprint` it is given, only passes it through, so get rid of the extraneous passing. Perhaps the intent was that there would be an iface fingerprint check of some sort? but this was never done. If/when we we want to do that, we can add it back then. - - - - - 4bcbd731 by Cale Gibbard at 2022-02-08T05:29:54-05:00 Document `hscIncrementalFrontend` and flip bool - - - - - b713db1e by John Ericson at 2022-02-08T05:30:29-05:00 StgToCmm: Get rid of GHC.Driver.Session imports `DynFlags` is gone, but let's move a few trivial things around to get rid of its module too. - - - - - f115c382 by Gleb Popov at 2022-02-08T05:31:05-05:00 Fix build on recent FreeBSD. Recent FreeBSD versions gained the sched_getaffinity function, which made two mutually exclusive #ifdef blocks to be enabled. - - - - - 3320ab40 by Ben Gamari at 2022-02-08T10:42:04-05:00 rts/MemoryMap: Use mach_-prefixed type names There appears to be some inconsistency in system-call type naming across Darwin toolchains. Specifically: * the `address` argument to `mach_vm_region` apparently wants to be a `mach_vm_address_t *`, not a `vm_address_t *` * the `vmsize` argument to `mach_vm_region` wants to be a `mach_vm_size_t`, not a `vm_size_t` - - - - - b33f0cfa by Richard Eisenberg at 2022-02-08T10:42:41-05:00 Document that reifyRoles includes kind parameters Close #21056 - - - - - bd493ed6 by PHO at 2022-02-08T10:43:19-05:00 Don't try to build stage1 with -eventlog if stage0 doesn't provide it Like -threaded, stage0 isn't guaranteed to have an event-logging RTS. - - - - - 03c2de0f by Matthew Pickering at 2022-02-09T03:56:22-05:00 testsuite: Use absolute paths for config.libdir Fixes #21052 - - - - - ef294525 by Matthew Pickering at 2022-02-09T03:56:22-05:00 testsuite: Clean up old/redundant predicates - - - - - a39ed908 by Matthew Pickering at 2022-02-09T03:56:22-05:00 testsuite: Add missing dependency on ghcconfig - - - - - a172be07 by PHO at 2022-02-09T03:56:59-05:00 Implement System.Environment.getExecutablePath for NetBSD and also use it from GHC.BaseDir.getBaseDir - - - - - 62fa126d by PHO at 2022-02-09T03:57:37-05:00 Fix a portability issue in m4/find_llvm_prog.m4 `test A == B' is a Bash extension, which doesn't work on platforms where /bin/sh is not Bash. - - - - - fd9981e3 by Ryan Scott at 2022-02-09T03:58:13-05:00 Look through untyped TH splices in tcInferAppHead_maybe Previously, surrounding a head expression with a TH splice would defeat `tcInferAppHead_maybe`, preventing some expressions from typechecking that used to typecheck in previous GHC versions (see #21038 for examples). This is simple enough to fix: just look through `HsSpliceE`s in `tcInferAppHead_maybe`. I've added some additional prose to `Note [Application chains and heads]` in `GHC.Tc.Gen.App` to accompany this change. Fixes #21038. - - - - - 00975981 by sheaf at 2022-02-09T03:58:53-05:00 Add test for #21037 This program was rejected by GHC 9.2, but is accepted on newer versions of GHC. This patch adds a regression test. Closes #21037 - - - - - fad0b2b0 by Ben Gamari at 2022-02-09T08:29:46-05:00 Rename -merge-objs flag to --merge-objs For consistency with --make and friends. - - - - - 1dbe5b2a by Matthew Pickering at 2022-02-09T08:30:22-05:00 driver: Filter out our own boot module in hptSomeThingsBelow hptSomeThingsBelow would return a list of modules which contain the .hs-boot file for a particular module. This caused some problems because we would try and find the module in the HPT (but it's not there when we're compiling the module itself). Fixes #21058 - - - - - 2b1cced1 by Sylvain Henry at 2022-02-09T20:42:23-05:00 NCG: minor code factorization - - - - - e01ffec2 by Sylvain Henry at 2022-02-09T20:42:23-05:00 ByteCode: avoid out-of-bound read Cf https://gitlab.haskell.org/ghc/ghc/-/issues/18431#note_287139 - - - - - 53c26e79 by Ziyang Liu at 2022-02-09T20:43:02-05:00 Include ru_name in toHsRule message See #18147 - - - - - 3df06922 by Ben Gamari at 2022-02-09T20:43:39-05:00 rts: Rename MemoryMap.[ch] -> ReportMemoryMap.[ch] - - - - - e219ac82 by Ben Gamari at 2022-02-09T20:43:39-05:00 rts: Move mmapForLinker and friends to linker/MMap.c They are not particularly related to linking. - - - - - 30e205ca by Ben Gamari at 2022-02-09T20:43:39-05:00 rts/linker: Drop dead IA64 code - - - - - 4d3a306d by Ben Gamari at 2022-02-09T20:43:39-05:00 rts/linker/MMap: Use MemoryAccess in mmapForLinker - - - - - 1db4f1fe by Ben Gamari at 2022-02-09T20:43:39-05:00 linker: Don't use MAP_FIXED As noted in #21057, we really shouldn't be using MAP_FIXED. I would much rather have the process crash with a "failed to map" error than randomly overwrite existing mappings. Closes #21057. - - - - - 1eeae25c by Ben Gamari at 2022-02-09T20:43:39-05:00 rts/mmap: Refactor mmapForLinker Here we try to separate the policy decisions of where to place mappings from the mechanism of creating the mappings. This makes things significantly easier to follow. - - - - - ac2d18a7 by sheaf at 2022-02-09T20:44:18-05:00 Add some perf tests for coercions This patch adds some performance tests for programs that create large coercions. This is useful because the existing test coverage is not very representative of real-world situations. In particular, this adds a test involving an extensible records library, a common pain-point for users. - - - - - 48f25715 by Andreas Klebinger at 2022-02-10T04:35:35-05:00 Add late cost centre support This allows cost centres to be inserted after the core optimization pipeline has run. - - - - - 0ff70427 by Andreas Klebinger at 2022-02-10T04:36:11-05:00 Docs:Mention that safe calls don't keep their arguments alive. - - - - - 1d3ed168 by Ben Gamari at 2022-02-10T04:36:46-05:00 PEi386: Drop Windows Vista fallback in addLibrarySearchPath We no longer support Windows Vista. - - - - - 2a6f2681 by Ben Gamari at 2022-02-10T04:36:46-05:00 linker/PEi386: Make addLibrarySearchPath long-path aware Previously `addLibrarySearchPath` failed to normalise the added path to UNC form before passing it to `AddDllDirectory`. Consequently, the call was subject to the MAX_PATH restriction, leading to the failure of `test-defaulting-plugin-fail`, among others. Happily, this also nicely simplifies the implementation. Closes #21059. - - - - - 2a47ee9c by Daniel Gröber at 2022-02-10T19:18:58-05:00 ghc-boot: Simplify writePackageDb permissions handling Commit ef8a3fbf1 ("ghc-boot: Fix metadata handling of writeFileAtomic") introduced a somewhat over-engineered fix for #14017 by trying to preserve the current permissions if the target file already exists. The problem in the issue is simply that the package db cache file should be world readable but isn't if umask is too restrictive. In fact the previous fix only handles part of this problem. If the file isn't already there in a readable configuration it wont make it so which isn't really ideal either. Rather than all that we now simply always force all the read access bits to allow access while leaving the owner at the system default as it's just not our business to mess with it. - - - - - a1d97968 by Ben Gamari at 2022-02-10T19:19:34-05:00 Bump Cabal submodule Adapts GHC to the factoring-out of `Cabal-syntax`. Fixes #20991. Metric Decrease: haddock.Cabal - - - - - 89cf8caa by Morrow at 2022-02-10T19:20:13-05:00 Add metadata to integer-gmp.cabal - - - - - c995b7e7 by Matthew Pickering at 2022-02-10T19:20:48-05:00 eventlog: Fix event type of EVENT_IPE This leads to corrupted eventlogs because the size of EVENT_IPE is completely wrong. Fixes a bug introduced in 2e29edb7421c21902b47d130d45f60d3f584a0de - - - - - 59ba8fb3 by Matthew Pickering at 2022-02-10T19:20:48-05:00 eventlog: Fix event type of MEM_RETURN This leads to corrupted eventlogs because the size of EVENT_MEM_RETURN is completely wrong. Fixes a bug introduced in 2e29edb7421c21902b47d130d45f60d3f584a0de - - - - - 19413d09 by Matthew Pickering at 2022-02-10T19:20:48-05:00 eventlog: Delete misleading comment in gen_event_types.py Not all events start with CapNo and there's not logic I could see which adds this to the length. - - - - - e06f49c0 by Matthew Pickering at 2022-02-10T19:20:48-05:00 eventlog: Fix size of TICKY_COUNTER_BEGIN_SAMPLE - - - - - 2f99255b by Matthew Pickering at 2022-02-10T19:21:24-05:00 Fix copy-pasto in prof-late-ccs docs - - - - - 19deb002 by Matthew Pickering at 2022-02-10T19:21:59-05:00 Refine tcSemigroupWarnings to work in ghc-prim ghc-prim doesn't depend on base so can't have any Monoid or Semigroup instances. However, attempting to load these definitions ran into issues when the interface for `GHC.Base` did exist as that would try and load the interface for `GHC.Types` (which is the module we are trying to compile and has no interface). The fix is to just not do this check when we are compiling a module in ghc-prim. Fixes #21069 - - - - - 34dec6b7 by sheaf at 2022-02-11T17:55:34-05:00 Decrease the size of the LargeRecord test This test was taking too long to run, so this patch makes it smaller. ------------------------- Metric Decrease: LargeRecord ------------------------- - - - - - 9cab90d9 by Matthew Pickering at 2022-02-11T22:27:19-05:00 Make sure all platforms have a release job The release bindists are currently a mixture of validate and release builds. This is bad because the validate builds don't have profiling libraries. The fix is to make sure there is a release job for each platform we want to produce a release for.t Fixes #21066 - - - - - 4bce3575 by Matthew Pickering at 2022-02-11T22:27:54-05:00 testsuite: Make sure all tests trigger ghc rebuild I made a mistake when implementing #21029 which meant that certain tests didn't trigger a GHC recompilation. By adding the `test:ghc` target to the default settings all tests will now depend on this target unless explicitly opting out via the no_deps modifier. - - - - - 90a26f8b by Sylvain Henry at 2022-02-11T22:28:34-05:00 Fix documentation about Word64Rep/Int64Rep (#16964) - - - - - 0e93023e by Andreas Klebinger at 2022-02-12T13:59:41+00:00 Tag inference work. This does three major things: * Enforce the invariant that all strict fields must contain tagged pointers. * Try to predict the tag on bindings in order to omit tag checks. * Allows functions to pass arguments unlifted (call-by-value). The former is "simply" achieved by wrapping any constructor allocations with a case which will evaluate the respective strict bindings. The prediction is done by a new data flow analysis based on the STG representation of a program. This also helps us to avoid generating redudant cases for the above invariant. StrictWorkers are created by W/W directly and SpecConstr indirectly. See the Note [Strict Worker Ids] Other minor changes: * Add StgUtil module containing a few functions needed by, but not specific to the tag analysis. ------------------------- Metric Decrease: T12545 T18698b T18140 T18923 LargeRecord Metric Increase: LargeRecord ManyAlternatives ManyConstructors T10421 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T15164 T18282 T18304 T18698a T1969 T20049 T3294 T4801 T5321FD T5321Fun T783 T9233 T9675 T9961 T19695 WWRec ------------------------- - - - - - 744f8a11 by Greg Steuck at 2022-02-12T17:13:55-05:00 Only check the exit code in derefnull & divbyzero tests on OpenBSD - - - - - eeead9fc by Ben Gamari at 2022-02-13T03:26:14-05:00 rts/Adjustor: Ensure that allocateExecPage succeeded Previously we failed to handle the case that `allocateExecPage` failed. - - - - - afdfaff0 by Ben Gamari at 2022-02-13T03:26:14-05:00 rts: Drop DEC Alpha adjustor implementation The last Alpha chip was produced in 2004. - - - - - 191dfd2d by Ben Gamari at 2022-02-13T03:26:14-05:00 rts/adjustor: Split Windows path out of NativeAmd64 - - - - - be591e27 by Ben Gamari at 2022-02-13T03:26:14-05:00 rts: Initial commit of AdjustorPool - - - - - d6d48b16 by Ben Gamari at 2022-02-13T03:26:14-05:00 Introduce initAdjustors - - - - - eab37902 by Ben Gamari at 2022-02-13T03:26:14-05:00 adjustors/NativeAmd64: Use AdjustorPool - - - - - 974e73af by Ben Gamari at 2022-02-13T03:26:14-05:00 adjustors/NativeAmd64Mingw: Use AdjustorPool - - - - - 95fab83f by Ben Gamari at 2022-02-13T03:26:14-05:00 configure: Fix result reporting of adjustors method check - - - - - ef5cf55d by nikshalark at 2022-02-13T03:26:16-05:00 (#21044) Documented arithmetic functions in base. Didn't get it right the ninth time. Now everything's formatted correctly. - - - - - acb482cc by Takenobu Tani at 2022-02-16T05:27:17-05:00 Relax load_load_barrier for aarch64 This patch relaxes the instruction for load_load_barrier(). Current load_load_barrier() implements full-barrier with `dmb sy`. It's too strong to order load-load instructions. We can relax it by using `dmb ld`. If current load_load_barrier() is used for full-barriers (load/store - load/store barrier), this patch is not suitable. See also linux-kernel's smp_rmb() implementation: https://github.com/torvalds/linux/blob/v5.14/arch/arm64/include/asm/barrier.h#L90 Hopefully, it's better to use `dmb ishld` rather than `dmb ld` to improve performance. However, I can't validate effects on a real many-core Arm machine. - - - - - 84eaa26f by Oleg Grenrus at 2022-02-16T05:27:56-05:00 Add test for #20562 - - - - - 2c28620d by Adam Sandberg Ericsson at 2022-02-16T05:28:32-05:00 rts: remove struct StgRetry, it is never used - - - - - 74bf9bb5 by Adam Sandberg Ericsson at 2022-02-16T05:28:32-05:00 rts: document some closure types - - - - - 316312ec by nineonine at 2022-02-16T05:29:08-05:00 ghci: fix -ddump-stg-cg (#21052) The pre-codegen Stg AST dump was not available in ghci because it was performed in 'doCodeGen'. This was now moved to 'coreToStg' area. - - - - - a6411d74 by Adam Sandberg Ericsson at 2022-02-16T05:29:43-05:00 docs: mention -fprof-late-ccs in the release notes And note which compiler version it was added in. - - - - - 4127e86d by Adam Sandberg Ericsson at 2022-02-16T05:29:43-05:00 docs: fix release notes formatting - - - - - 4e6c8019 by Matthew Pickering at 2022-02-17T05:25:28-05:00 Always define __GLASGOW_HASKELL_PATCHLEVEL1/2__ macros As #21076 reports if you are using `-Wcpp-undef` then you get warnings when using the `MIN_VERSION_GLASGOW_HASKELL` macro because __GLASGOW_HASKELL_PATCHLEVEL2__ is very rarely explicitliy set (as version numbers are not 4 components long). This macro was introduced in 3549c952b535803270872adaf87262f2df0295a4 and it seems the bug has existed ever since. Fixes #21076 - - - - - 67dd5724 by Ben Gamari at 2022-02-17T05:26:03-05:00 rts/AdjustorPool: Silence unused function warning bitmap_get is only used in the DEBUG RTS configuration. Fixes #21079. - - - - - 4b04f7e1 by Zubin Duggal at 2022-02-20T13:56:15-05:00 Track object file dependencies for TH accurately (#20604) `hscCompileCoreExprHook` is changed to return a list of `Module`s required by a splice. These modules are accumulated in the TcGblEnv (tcg_th_needed_mods). Dependencies on the object files of these modules are recording in the interface. The data structures in `LoaderState` are replaced with more efficient versions to keep track of all the information required. The MultiLayerModulesTH_Make allocations increase slightly but runtime is faster. Fixes #20604 ------------------------- Metric Increase: MultiLayerModulesTH_Make ------------------------- - - - - - 92ab3ff2 by sheaf at 2022-02-20T13:56:55-05:00 Use diagnostics for "missing signature" errors This patch makes the "missing signature" errors from "GHC.Rename.Names" use the diagnostic infrastructure. This encompasses missing type signatures for top-level bindings and pattern synonyms, as well as missing kind signatures for type constructors. This patch also renames TcReportMsg to TcSolverReportMsg, and adds a few convenience functions to compute whether such a TcSolverReportMsg is an expected/actual message. - - - - - 845284a5 by sheaf at 2022-02-20T13:57:34-05:00 Generically: remove redundant Semigroup constraint This patch removes a redundant Semigroup constraint on the Monoid instance for Generically. This constraint can cause trouble when one wants to derive a Monoid instance via Generically through a type that doesn't itself have a Semigroup instance, for example: data Point2D a = Point2D !a !a newtype Vector2D a = Vector2D { tip :: Point2D a } deriving ( Semigroup, Monoid ) via Generically ( Point2D ( Sum a ) ) In this case, we should not require there to be an instance Semigroup ( Point2D ( Sum a ) ) as all we need is an instance for the generic representation of Point2D ( Sum a ), i.e. Semigroup ( Rep ( Point2D ( Sum a) ) () ). - - - - - 6b468f7f by Ben Gamari at 2022-02-20T13:58:10-05:00 Bump time submodule to 1.12.1 - - - - - 2f0ceecc by Zubin Duggal at 2022-02-20T19:06:19+00:00 hadrian: detect if 'main' is not a haskell file and add it to appropriate list of sources - - - - - 7ce1b694 by Zubin Duggal at 2022-02-21T11:18:58+00:00 Reinstallable GHC This patch allows ghc and its dependencies to be built using a normal invocation of cabal-install. Each componenent which relied on generated files or additional configuration now has a Setup.hs file. There are also various fixes to the cabal files to satisfy cabal-install. There is a new hadrian command which will build a stage2 compiler and then a stage3 compiler by using cabal. ``` ./hadrian/build build-cabal ``` There is also a new CI job which tests running this command. For the 9.4 release we will upload all the dependent executables to hackage and then end users will be free to build GHC and GHC executables via cabal. There are still some unresolved questions about how to ensure soundness when loading plugins into a reinstalled GHC (#20742) which will be tighted up in due course. Fixes #19896 - - - - - 78fbc3a3 by Matthew Pickering at 2022-02-21T15:14:28-05:00 hadrian: Enable late-ccs when building profiled_ghc - - - - - 2b890c89 by Matthew Pickering at 2022-02-22T15:59:33-05:00 testsuite: Don't print names of all fragile tests on all runs This information about fragile tests is pretty useless but annoying on CI where you have to scroll up a long way to see the actual issues. - - - - - 0b36801f by sheaf at 2022-02-22T16:00:14-05:00 Forbid standalone instances for built-in classes `check_special_inst_head` includes logic that disallows hand-written instances for built-in classes such as Typeable, KnownNat and KnownSymbol. However, it also allowed standalone deriving declarations. This was because we do want to allow standalone deriving instances with Typeable as they are harmless, but we certainly don't want to allow instances for e.g. KnownNat. This patch ensures that we don't allow derived instances for KnownNat, KnownSymbol (and also KnownChar, which was previously omitted entirely). Fixes #21087 - - - - - ace66dec by Krzysztof Gogolewski at 2022-02-22T16:30:59-05:00 Remove -Wunticked-promoted-constructors from -Wall Update manual; explain ticks as optional disambiguation rather than the preferred default. This is a part of #20531. - - - - - 558c7d55 by Hugo at 2022-02-22T16:31:01-05:00 docs: fix error in annotation guide code snippet - - - - - a599abba by Richard Eisenberg at 2022-02-23T08:16:07-05:00 Kill derived constraints Co-authored by: Sam Derbyshire Previously, GHC had three flavours of constraint: Wanted, Given, and Derived. This removes Derived constraints. Though serving a number of purposes, the most important role of Derived constraints was to enable better error messages. This job has been taken over by the new RewriterSets, as explained in Note [Wanteds rewrite wanteds] in GHC.Tc.Types.Constraint. Other knock-on effects: - Various new Notes as I learned about under-described bits of GHC - A reshuffling around the AST for implicit-parameter bindings, with better integration with TTG. - Various improvements around fundeps. These were caused by the fact that, previously, fundep constraints were all Derived, and Derived constraints would get dropped. Thus, an unsolved Derived didn't stop compilation. Without Derived, this is no longer possible, and so we have to be considerably more careful around fundeps. - A nice little refactoring in GHC.Tc.Errors to center the work on a new datatype called ErrorItem. Constraints are converted into ErrorItems at the start of processing, and this allows for a little preprocessing before the main classification. - This commit also cleans up the behavior in generalisation around functional dependencies. Now, if a variable is determined by functional dependencies, it will not be quantified. This change is user facing, but it should trim down GHC's strange behavior around fundeps. - Previously, reportWanteds did quite a bit of work, even on an empty WantedConstraints. This commit adds a fast path. - Now, GHC will unconditionally re-simplify constraints during quantification. See Note [Unconditionally resimplify constraints when quantifying], in GHC.Tc.Solver. Close #18398. Close #18406. Solve the fundep-related non-confluence in #18851. Close #19131. Close #19137. Close #20922. Close #20668. Close #19665. ------------------------- Metric Decrease: LargeRecord T9872b T9872b_defer T9872d TcPlugin_RewritePerf ------------------------- - - - - - 2ed22ba1 by Matthew Pickering at 2022-02-23T08:16:43-05:00 Introduce predicate for when to enable source notes (needSourceNotes) There were situations where we were using debugLevel == 0 as a proxy for whether to retain source notes but -finfo-table-map also enables and needs source notes so we should act consistently in both cases. Ticket #20847 - - - - - 37deb893 by Matthew Pickering at 2022-02-23T08:16:43-05:00 Use SrcSpan from the binder as initial source estimate There are some situations where we end up with no source notes in useful positions in an expression. In this case we currently fail to provide any source information about where an expression came from. This patch improves the initial estimate by using the position from the top-binder as the guess for the location of the whole inner expression. It provides quite a course estimate but it's better than nothing. Ticket #20847 - - - - - 59b7f764 by Cheng Shao at 2022-02-23T08:17:24-05:00 Don't emit foreign exports initialiser code for empty CAF list - - - - - c7f32f76 by John Ericson at 2022-02-23T13:58:36-05:00 Prepare rechecking logic for new type in a few ways Combine `MustCompile and `NeedsCompile` into a single case. `CompileReason` is put inside to destinguish the two. This makes a number of things easier. `Semigroup RecompileRequired` is no longer used, to make sure we skip doing work where possible. `recompThen` is very similar, but helps remember. `checkList` is rewritten with `recompThen`. - - - - - e60d8df8 by John Ericson at 2022-02-23T13:58:36-05:00 Introduce `MaybeValidated` type to remove invalid states The old return type `(RecompRequired, Maybe _)`, was confusing because it was inhabited by values like `(UpToDate, Nothing)` that made no sense. The new type ensures: - you must provide a value if it is up to date. - you must provide a reason if you don't provide a value. it is used as the return value of: - `checkOldIface` - `checkByteCode` - `checkObjects` - - - - - f07b13e3 by Sylvain Henry at 2022-02-23T13:59:23-05:00 NCG: refactor X86 codegen Preliminary work done to make working on #5444 easier. Mostly make make control-flow easier to follow: * renamed genCCall into genForeignCall * split genForeignCall into the part dispatching on PrimTarget (genPrim) and the one really generating code for a C call (cf ForeignTarget and genCCall) * made genPrim/genSimplePrim only dispatch on MachOp: each MachOp now has its own code generation function. * out-of-line primops are not handled in a partial `outOfLineCmmOp` anymore but in the code generation functions directly. Helper functions have been introduced (e.g. genLibCCall) for code sharing. * the latter two bullets make code generated for primops that are only sometimes out-of-line (e.g. Pdep or Memcpy) and the logic to select between inline/out-of-line much more localized * avoided passing is32bit as an argument as we can easily get it from NatM state when we really need it * changed genCCall type to avoid it being partial (it can't handle PrimTarget) * globally removed 12 calls to `panic` thanks to better control flow and types ("parse, don't validate" ftw!). - - - - - 6fa7591e by Sylvain Henry at 2022-02-23T13:59:23-05:00 NCG: refactor the way registers are handled * add getLocalRegReg to avoid allocating a CmmLocal just to call getRegisterReg * 64-bit registers: in the general case we must always use the virtual higher part of the register, so we might as well always return it with the lower part. The only exception is to implement 64-bit to 32-bit conversions. We now have to explicitly discard the higher part when matching on Reg64/RegCode64 datatypes instead of explicitly fetching the higher part from the lower part: much safer default. - - - - - bc8de322 by Sylvain Henry at 2022-02-23T13:59:23-05:00 NCG: inline some 64-bit primops on x86/32-bit (#5444) Several 64-bit operation were implemented with FFI calls on 32-bit architectures but we can easily implement them with inline assembly code. Also remove unused hs_int64ToWord64 and hs_word64ToInt64 C functions. - - - - - 7b7c6b95 by Matthew Pickering at 2022-02-23T14:00:00-05:00 Simplify/correct implementation of getModuleInfo - - - - - 6215b04c by Matthew Pickering at 2022-02-23T14:00:00-05:00 Remove mg_boot field from ModuleGraph It was unused in the compiler so I have removed it to streamline ModuleGraph. - - - - - 818ff2ef by Matthew Pickering at 2022-02-23T14:00:01-05:00 driver: Remove needsTemplateHaskellOrQQ from ModuleGraph The idea of the needsTemplateHaskellOrQQ query is to check if any of the modules in a module graph need Template Haskell then enable -dynamic-too if necessary. This is quite imprecise though as it will enable -dynamic-too for all modules in the module graph even if only one module uses template haskell, with multiple home units, this is obviously even worse. With -fno-code we already have similar logic to enable code generation just for the modules which are dependeded on my TemplateHaskell modules so we use the same code path to decide whether to enable -dynamic-too rather than using this big hammer. This is part of the larger overall goal of moving as much statically known configuration into the downsweep as possible in order to have fully decided the build plan and all the options before starting to build anything. I also included a fix to #21095, a long standing bug with with the logic which is supposed to enable the external interpreter if we don't have the internal interpreter. Fixes #20696 #21095 - - - - - b6670af6 by Matthew Pickering at 2022-02-23T14:00:40-05:00 testsuite: Normalise output of ghci011 and T7627 The outputs of these tests vary on the order interface files are loaded so we normalise the output to correct for these inconsequential differences. Fixes #21121 - - - - - 9ed3bc6e by Peter Trommler at 2022-02-23T14:01:16-05:00 testsuite: Fix ipeMap test Pointers to closures must be untagged before use. Produce closures of different types so we get different info tables. Fixes #21112 - - - - - 7d426148 by Ziyang Liu at 2022-02-24T04:53:34-05:00 Allow `return` in more cases in ApplicativeDo The doc says that the last statement of an ado-block can be one of `return E`, `return $ E`, `pure E` and `pure $ E`. But `return` is not accepted in a few cases such as: ```haskell -- The ado-block only has one statement x :: F () x = do return () -- The ado-block only has let-statements besides the `return` y :: F () y = do let a = True return () ``` These currently require `Monad` instances. This MR fixes it. Normally `return` is accepted as the last statement because it is stripped in constructing an `ApplicativeStmt`, but this cannot be done in the above cases, so instead we replace `return` by `pure`. A similar but different issue (when the ado-block contains `BindStmt` or `BodyStmt`, the second last statement cannot be `LetStmt`, even if the last statement uses `pure`) is fixed in !6786. - - - - - a5ea7867 by John Ericson at 2022-02-24T20:23:49-05:00 Clarify laws of TestEquality It is unclear what `TestEquality` is for. There are 3 possible choices. Assuming ```haskell data Tag a where TagInt1 :: Tag Int TagInt2 :: Tag Int ``` Weakest -- type param equality semi-decidable --------------------------------------------- `Just Refl` merely means the type params are equal, the values being compared might not be. `Nothing` means the type params may or may not be not equal. ```haskell instance TestEquality Tag where testEquality TagInt1 TagInt1 = Nothing -- oopsie is allowed testEquality TagInt1 TagInt2 = Just Refl testEquality TagInt2 TagInt1 = Just Refl testEquality TagInt2 TagInt2 = Just Refl ``` This option is better demonstrated with a different type: ```haskell data Tag' a where TagInt1 :: Tag Int TagInt2 :: Tag a ``` ```haskell instance TestEquality Tag' where testEquality TagInt1 TagInt1 = Just Refl testEquality TagInt1 TagInt2 = Nothing -- can't be sure testEquality TagInt2 TagInt1 = Nothing -- can't be sure testEquality TagInt2 TagInt2 = Nothing -- can't be sure ``` Weaker -- type param equality decidable --------------------------------------- `Just Refl` merely means the type params are equal, the values being compared might not be. `Nothing` means the type params are not equal. ```haskell instance TestEquality Tag where testEquality TagInt1 TagInt1 = Just Refl testEquality TagInt1 TagInt2 = Just Refl testEquality TagInt2 TagInt1 = Just Refl testEquality TagInt2 TagInt2 = Just Refl ``` Strong -- Like `Eq` ------------------- `Just Refl` means the type params are equal, and the values are equal according to `Eq`. ```haskell instance TestEquality Tag where testEquality TagInt1 TagInt1 = Just Refl testEquality TagInt2 TagInt2 = Just Refl testEquality _ _ = Nothing ``` Strongest -- unique value concrete type --------------------------------------- `Just Refl` means the type params are equal, and the values are equal, and the class assume if the type params are equal the values must also be equal. In other words, the type is a singleton type when the type parameter is a closed term. ```haskell -- instance TestEquality -- invalid instance because two variants for `Int` ``` ------ The discussion in https://github.com/haskell/core-libraries-committee/issues/21 has decided on the "Weaker" option (confusingly formerly called the "Weakest" option). So that is what is implemented. - - - - - 06c18990 by Zubin Duggal at 2022-02-24T20:24:25-05:00 TH: fix pretty printing of GADTs with multiple constuctors (#20842) - - - - - 6555b68c by Matthew Pickering at 2022-02-24T20:25:06-05:00 Move linters into the tree This MR moves the GHC linters into the tree, so that they can be run directly using Hadrian. * Query all files tracked by Git instead of using changed files, so that we can run the exact same linting step locally and in a merge request. * Only check that the changelogs don't contain TBA when RELEASE=YES. * Add hadrian/lint script, which runs all the linting steps. * Ensure the hlint job exits with a failure if hlint is not installed (otherwise we were ignoring the failure). Given that hlint doesn't seem to be available in CI at the moment, I've temporarily allowed failure in the hlint job. * Run all linting tests in CI using hadrian. - - - - - b99646ed by Matthew Pickering at 2022-02-24T20:25:06-05:00 Add rule for generating HsBaseConfig.h If you are running the `lint:{base/compiler}` command locally then this improves the responsiveness because we don't re-run configure everytime if the header file already exists. - - - - - d0deaaf4 by Matthew Pickering at 2022-02-24T20:25:06-05:00 Suggestions due to hlint It turns out this job hasn't been running for quite a while (perhaps ever) so there are quite a few failures when running the linter locally. - - - - - 70bafefb by nineonine at 2022-02-24T20:25:42-05:00 ghci: show helpful error message when loading module with SIMD vector operations (#20214) Previously, when trying to load module with SIMD vector operations, ghci would panic in 'GHC.StgToByteCode.findPushSeq'. Now, a more helpful message is displayed. - - - - - 8ed3d5fd by Matthew Pickering at 2022-02-25T10:24:12+00:00 Remove test-bootstrap and cabal-reinstall jobs from fast-ci [skip ci] - - - - - 8387dfbe by Mario Blažević at 2022-02-25T21:09:41-05:00 template-haskell: Fix two prettyprinter issues Fix two issues regarding printing numeric literals. Fixing #20454. - - - - - 4ad8ce0b by sheaf at 2022-02-25T21:10:22-05:00 GHCi: don't normalise partially instantiated types This patch skips performing type normalisation when we haven't fully instantiated the type. That is, in tcRnExpr (used only for :type in GHCi), skip normalisation if the result type responds True to isSigmaTy. Fixes #20974 - - - - - f35aca4d by Ben Gamari at 2022-02-25T21:10:57-05:00 rts/adjustor: Always place adjustor templates in data section @nrnrnr points out that on his machine ld.lld rejects text relocations. Generalize the Darwin text-relocation avoidance logic to account for this. - - - - - cddb040a by Andreas Klebinger at 2022-02-25T21:11:33-05:00 Ticky: Gate tag-inference dummy ticky-counters behind a flag. Tag inference included a way to collect stats about avoided tag-checks. This was dony by emitting "dummy" ticky entries with counts corresponding to predicted/unpredicated tag checks. This behaviour for ticky is now gated behind -fticky-tag-checks. I also documented ticky-LNE in the process. - - - - - 948bf2d0 by Ben Gamari at 2022-02-25T21:12:09-05:00 Fix comment reference to T4818 - - - - - 9c3edeb8 by Ben Gamari at 2022-02-25T21:12:09-05:00 simplCore: Correctly extend in-scope set in rule matching Note [Matching lets] in GHC.Core.Rules claims the following: > We use GHC.Core.Subst.substBind to freshen the binding, using an > in-scope set that is the original in-scope variables plus the > rs_bndrs (currently floated let-bindings). However, previously the implementation didn't actually do extend the in-scope set with rs_bndrs. This appears to be a regression which was introduced by 4ff4d434e9a90623afce00b43e2a5a1ccbdb4c05. Moreover, the originally reasoning was subtly wrong: we must rather use the in-scope set from rv_lcl, extended with rs_bndrs, not that of `rv_fltR` Fixes #21122. - - - - - 7f9f49c3 by sheaf at 2022-02-25T21:12:47-05:00 Derive some stock instances for OverridingBool This patch adds some derived instances to `GHC.Data.Bool.OverridingBool`. It also changes the order of the constructors, so that the derived `Ord` instance matches the behaviour for `Maybe Bool`. Fixes #20326 - - - - - 140438a8 by nineonine at 2022-02-25T21:13:23-05:00 Add test for #19271 - - - - - ac9f4606 by sheaf at 2022-02-25T21:14:04-05:00 Allow qualified names in COMPLETE pragmas The parser didn't allow qualified constructor names to appear in COMPLETE pragmas. This patch fixes that. Fixes #20551 - - - - - 677c6c91 by Sylvain Henry at 2022-02-25T21:14:44-05:00 Testsuite: remove arch conditional in T8832 Taken from !3658 - - - - - ad04953b by Sylvain Henry at 2022-02-25T21:15:23-05:00 Allow hscGenHardCode to not return CgInfos This is a minor change in preparation for the JS backend: CgInfos aren't mandatory and the JS backend won't return them. - - - - - 929c280f by Sylvain Henry at 2022-02-25T21:15:24-05:00 Derive Enum instances for CCallConv and Safety This is used by the JS backend for serialization. - - - - - 75e4e090 by Sebastian Graf at 2022-02-25T21:15:59-05:00 base: Improve documentation of `throwIO` (#19854) Now it takes a better account of precise vs. imprecise exception semantics. Fixes #19854. - - - - - 61a203ba by Matthew Pickering at 2022-02-26T02:06:51-05:00 Make typechecking unfoldings from interfaces lazier The old logic was unecessarily strict in loading unfoldings because when reading the unfolding we would case on the result of attempting to load the template before commiting to which type of unfolding we were producing. Hence trying to inspect any of the information about an unfolding would force the template to be loaded. This also removes a potentially hard to discover bug where if the template failed to be typechecked for some reason then we would just not return an unfolding. Instead we now panic so these bad situations which should never arise can be identified. - - - - - 2be74460 by Matthew Pickering at 2022-02-26T02:06:51-05:00 Use a more up-to-date snapshot of the current rules in the simplifier As the prescient (now deleted) note warns in simplifyPgmIO we have to be a bit careful about when we gather rules from the EPS so that we get the rules for imported bindings. ``` -- Get any new rules, and extend the rule base -- See Note [Overall plumbing for rules] in GHC.Core.Rules -- We need to do this regularly, because simplification can -- poke on IdInfo thunks, which in turn brings in new rules -- behind the scenes. Otherwise there's a danger we'll simply -- miss the rules for Ids hidden inside imported inlinings ``` Given the previous commit, the loading of unfoldings is now even more delayed so we need to be more careful to read the EPS rule base closer to the point where we decide to try rules. Without this fix GHC performance regressed by a noticeably amount because the `zip` rule was not brought into scope eagerly enough which led to a further series of unfortunate events in the simplifer which tipped `substTyWithCoVars` over the edge of the size threshold, stopped it being inlined and increased allocations by 10% in some cases. Furthermore, this change is noticeably in the testsuite as it changes T19790 so that the `length` rules from GHC.List fires earlier. ------------------------- Metric Increase: T9961 ------------------------- - - - - - b8046195 by Matthew Pickering at 2022-02-26T02:06:52-05:00 Improve efficiency of extending a RuleEnv with a new RuleBase Essentially we apply the identity: > lookupNameEnv n (plusNameEnv_C (++) rb1 rb2) > = lookupNameEnv n rb1 ++ lookupNameEnv n rb2 The latter being more efficient as we don't construct an intermediate map. This is now quite important as each time we try and apply rules we need to combine the current EPS RuleBase with the HPT and ModGuts rule bases. - - - - - 033e9f0f by sheaf at 2022-02-26T02:07:30-05:00 Error on anon wildcards in tcAnonWildCardOcc The code in tcAnonWildCardOcc assumed that it could never encounter anonymous wildcards in illegal positions, because the renamer would have ruled them out. However, it's possible to sneak past the checks in the renamer by using Template Haskell. It isn't possible to simply pass on additional information when renaming Template Haskell brackets, because we don't know in advance in what context the bracket will be spliced in (see test case T15433b). So we accept that we might encounter these bogus wildcards in the typechecker and throw the appropriate error. This patch also migrates the error messages for illegal wildcards in types to use the diagnostic infrastructure. Fixes #15433 - - - - - 32d8fe3a by sheaf at 2022-02-26T14:15:33+01:00 Core Lint: ensure primops can be eta-expanded This patch adds a check to Core Lint, checkCanEtaExpand, which ensures that primops and other wired-in functions with no binding such as unsafeCoerce#, oneShot, rightSection... can always be eta-expanded, by checking that the remaining argument types have a fixed RuntimeRep. Two subtleties came up: - the notion of arity in Core looks through newtypes, so we may need to unwrap newtypes in this check, - we want to avoid calling hasNoBinding on something whose unfolding we are in the process of linting, as this would cause a loop; to avoid this we add some information to the Core Lint environment that holds this information. Fixes #20480 - - - - - 0a80b436 by Peter Trommler at 2022-02-26T17:21:59-05:00 testsuite: Require LLVM for T15155l - - - - - 38cb920e by Oleg Grenrus at 2022-02-28T07:14:04-05:00 Add Monoid a => Monoid (STM a) instance - - - - - d734ef8f by Hécate Moonlight at 2022-02-28T07:14:42-05:00 Make modules in base stable. fix #18963 - - - - - fbf005e9 by Sven Tennie at 2022-02-28T19:16:01-05:00 Fix some hlint issues in ghc-heap This does not fix all hlint issues as the criticised index and length expressions seem to be fine in context. - - - - - adfddf7d by Matthew Pickering at 2022-02-28T19:16:36-05:00 hadrian: Suggest to the user to run ./configure if missing a setting If a setting is missing from the configuration file it's likely the user needs to reconfigure. Fixes #20476 - - - - - 4f0208e5 by Andreas Klebinger at 2022-02-28T19:17:12-05:00 CLabel cleanup: Remove these smart constructors for these reasons: * mkLocalClosureTableLabel : Does the same as the non-local variant. * mkLocalClosureLabel : Does the same as the non-local variant. * mkLocalInfoTableLabel : Decide if we make a local label based on the name and just use mkInfoTableLabel everywhere. - - - - - 065419af by Matthew Pickering at 2022-02-28T19:17:47-05:00 linking: Don't pass --hash-size and --reduce-memory-overhead to ld These flags were added to help with the high linking cost of the old split-objs mode. Now we are using split-sections these flags appear to make no difference to memory usage or time taken to link. I tested various configurations linking together the ghc library with -split-sections enabled. | linker | time (s) | | ------ | ------ | | gold | 0.95 | | ld | 1.6 | | ld (hash-size = 31, reduce-memory-overheads) | 1.6 | | ldd | 0.47 | Fixes #20967 - - - - - 3e65ef05 by Teo Camarasu at 2022-02-28T19:18:27-05:00 template-haskell: fix typo in docstring for Overlap - - - - - 80f9133e by Teo Camarasu at 2022-02-28T19:18:27-05:00 template-haskell: fix docstring for Bytes It seems like a commented out section of code was accidentally included in the docstring for a field. - - - - - 54774268 by Matthew Pickering at 2022-03-01T16:23:10-05:00 Fix longstanding issue with moduleGraphNodes - no hs-boot files case In the case when we tell moduleGraphNodes to drop hs-boot files the idea is to collapse hs-boot files into their hs file nodes. In the old code * nodeDependencies changed edges from IsBoot to NonBoot * moduleGraphNodes just dropped boot file nodes The net result is that any dependencies of the hs-boot files themselves were dropped. The correct thing to do is * nodeDependencies changes edges from IsBoot to NonBoot * moduleGraphNodes merges dependencies of IsBoot and NonBoot nodes. The result is a properly quotiented dependency graph which contains no hs-boot files nor hs-boot file edges. Why this didn't cause endless issues when compiling with boot files, we will never know. - - - - - c84dc506 by Matthew Pickering at 2022-03-01T16:23:10-05:00 driver: Properly add an edge between a .hs and its hs-boot file As noted in #21071 we were missing adding this edge so there were situations where the .hs file would get compiled before the .hs-boot file which leads to issues with -j. I fixed this properly by adding the edge in downsweep so the definition of nodeDependencies can be simplified to avoid adding this dummy edge in. There are plenty of tests which seem to have these redundant boot files anyway so no new test. #21094 tracks the more general issue of identifying redundant hs-boot and SOURCE imports. - - - - - 7aeb6d29 by sheaf at 2022-03-01T16:23:51-05:00 Core Lint: collect args through floatable ticks We were not looking through floatable ticks when collecting arguments in Core Lint, which caused `checkCanEtaExpand` to fail on something like: ```haskell reallyUnsafePtrEquality = \ @a -> (src<loc> reallyUnsafePtrEquality#) @Lifted @a @Lifted @a ``` We fix this by using `collectArgsTicks tickishFloatable` instead of `collectArgs`, to be consistent with the behaviour of eta expansion outlined in Note [Eta expansion and source notes] in GHC.Core.Opt.Arity. Fixes #21152. - - - - - 75caafaa by Matthew Pickering at 2022-03-02T01:14:59-05:00 Ticky profiling improvements. This adds a number of changes to ticky-ticky profiling. When an executable is profiled with IPE profiling it's now possible to associate id-related ticky counters to their source location. This works by emitting the info table address as part of the counter which can be looked up in the IPE table. Add a `-ticky-ap-thunk` flag. This flag prevents the use of some standard thunks which are precompiled into the RTS. This means reduced cache locality and increased code size. But it allows better attribution of execution cost to specific source locations instead of simple attributing it to the standard thunk. ticky-ticky now uses the `arg` field to emit additional information about counters in json format. When ticky-ticky is used in combination with the eventlog eventlog2html can be used to generate a html table from the eventlog similar to the old text output for ticky-ticky. - - - - - aeea6bd5 by doyougnu at 2022-03-02T01:15:39-05:00 StgToCmm.cgTopBinding: no isNCG, use binBlobThresh This is a one line change. It is a fixup from MR!7325, was pointed out in review of MR!7442, specifically: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/7442#note_406581 The change removes isNCG check from cgTopBinding. Instead it changes the type of binBlobThresh in DynFlags from Word to Maybe Word, where a Just 0 or a Nothing indicates an infinite threshold and thus the disable CmmFileEmbed case in the original check. This improves the cohesion of the module because more NCG related Backend stuff is moved into, and checked in, StgToCmm.Config. Note, that the meaning of a Just 0 or a Nothing in binBlobThresh is indicated in a comment next to its field in GHC.StgToCmm.Config. DynFlags: binBlobThresh: Word -> Maybe Word StgToCmm.Config: binBlobThesh add not ncg check DynFlags.binBlob: move Just 0 check to dflags init StgToCmm.binBlob: only check isNCG, Just 0 check to dflags StgToCmm.Config: strictify binBlobThresh - - - - - b27b2af3 by sheaf at 2022-03-02T14:08:36-05:00 Introduce ConcreteTv metavariables This patch introduces a new kind of metavariable, by adding the constructor `ConcreteTv` to `MetaInfo`. A metavariable with `ConcreteTv` `MetaInfo`, henceforth a concrete metavariable, can only be unified with a type that is concrete (that is, a type that answers `True` to `GHC.Core.Type.isConcrete`). This solves the problem of dangling metavariables in `Concrete#` constraints: instead of emitting `Concrete# ty`, which contains a secret existential metavariable, we simply emit a primitive equality constraint `ty ~# concrete_tv` where `concrete_tv` is a fresh concrete metavariable. This means we can avoid all the complexity of canonicalising `Concrete#` constraints, as we can just re-use the existing machinery for `~#`. To finish things up, this patch then removes the `Concrete#` special predicate, and instead introduces the special predicate `IsRefl#` which enforces that a coercion is reflexive. Such a constraint is needed because the canonicaliser is quite happy to rewrite an equality constraint such as `ty ~# concrete_tv`, but such a rewriting is not handled by the rest of the compiler currently, as we need to make use of the resulting coercion, as outlined in the FixedRuntimeRep plan. The big upside of this approach (on top of simplifying the code) is that we can now selectively implement PHASE 2 of FixedRuntimeRep, by changing individual calls of `hasFixedRuntimeRep_MustBeRefl` to `hasFixedRuntimeRep` and making use of the obtained coercion. - - - - - 81b7c436 by Matthew Pickering at 2022-03-02T14:09:13-05:00 Make -dannot-lint not panic on let bound type variables After certain simplifier passes we end up with let bound type variables which are immediately inlined in the next pass. The core diff utility implemented by -dannot-lint failed to take these into account and paniced. Progress towards #20965 - - - - - f596c91a by sheaf at 2022-03-02T14:09:51-05:00 Improve out-of-order inferred type variables Don't instantiate type variables for :type in `GHC.Tc.Gen.App.tcInstFun`, to avoid inconsistently instantianting `r1` but not `r2` in the type forall {r1} (a :: TYPE r1) {r2} (b :: TYPE r2). ... This fixes #21088. This patch also changes the primop pretty-printer to ensure that we put all the inferred type variables first. For example, the type of reallyUnsafePtrEquality# is now forall {l :: Levity} {k :: Levity} (a :: TYPE (BoxedRep l)) (b :: TYPE (BoxedRep k)). a -> b -> Int# This means we avoid running into issue #21088 entirely with the types of primops. Users can still write a type signature where the inferred type variables don't come first, however. This change to primops had a knock-on consequence, revealing that we were sometimes performing eta reduction on keepAlive#. This patch updates tryEtaReduce to avoid eta reducing functions with no binding, bringing it in line with tryEtaReducePrep, and thus fixing #21090. - - - - - 1617fed3 by Richard Eisenberg at 2022-03-02T14:10:28-05:00 Make inert_cycle_breakers into a stack. Close #20231. - - - - - c8652a0a by Richard Eisenberg at 2022-03-02T14:11:03-05:00 Make Constraint not *apart* from Type. More details in Note [coreView vs tcView] Close #21092. - - - - - 91a10cb0 by doyougnu at 2022-03-02T14:11:43-05:00 GenStgAlt 3-tuple synonym --> Record type This commit alters GenStgAlt from a type synonym to a Record with field accessors. In pursuit of #21078, this is not a required change but cleans up several areas for nicer code in the upcoming js-backend, and in GHC itself. GenStgAlt: 3-tuple -> record Stg.Utils: GenStgAlt 3-tuple -> record Stg.Stats: StgAlt 3-tuple --> record Stg.InferTags.Rewrite: StgAlt 3-tuple -> record Stg.FVs: GenStgAlt 3-tuple -> record Stg.CSE: GenStgAlt 3-tuple -> record Stg.InferTags: GenStgAlt 3-tuple --> record Stg.Debug: GenStgAlt 3-tuple --> record Stg.Lift.Analysis: GenStgAlt 3-tuple --> record Stg.Lift: GenStgAlt 3-tuple --> record ByteCode.Instr: GenStgAlt 3-tuple --> record Stg.Syntax: add GenStgAlt helper functions Stg.Unarise: GenStgAlt 3-tuple --> record Stg.BcPrep: GenStgAlt 3-tuple --> record CoreToStg: GenStgAlt 3-tuple --> record StgToCmm.Expr: GenStgAlt 3-tuple --> record StgToCmm.Bind: GenStgAlt 3-tuple --> record StgToByteCode: GenStgAlt 3-tuple --> record Stg.Lint: GenStgAlt 3-tuple --> record Stg.Syntax: strictify GenStgAlt GenStgAlt: add haddock, some cleanup fixup: remove calls to pure, single ViewPattern StgToByteCode: use case over viewpatterns - - - - - 73864f00 by Matthew Pickering at 2022-03-02T14:12:19-05:00 base: Remove default method from bitraversable The default instance leads to an infinite loop. bisequenceA is defined in terms of bisquence which is defined in terms of bitraverse. ``` bitraverse f g = (defn of bitraverse) bisequenceA . bimap f g = (defn of bisequenceA) bitraverse id id . bimap f g = (defn of bitraverse) ... ``` Any instances defined without an explicitly implementation are currently broken, therefore removing it will alert users to an issue in their code. CLC issue: https://github.com/haskell/core-libraries-committee/issues/47 Fixes #20329 #18901 - - - - - 9579bf35 by Matthew Pickering at 2022-03-02T14:12:54-05:00 ci: Add check to CI to ensure compiler uses correct BIGNUM_BACKEND - - - - - c48a7c3a by Sylvain Henry at 2022-03-03T07:37:12-05:00 Use Word64# primops in Word64 Num instance Taken froù!3658 - - - - - ce65d0cc by Matthew Pickering at 2022-03-03T07:37:48-05:00 hadrian: Correctly set whether we have a debug compiler when running tests For example, running the `slow-validate` flavour would incorrectly run the T16135 test which would fail with an assertion error, despite the fact that is should be skipped when we have a debug compiler. - - - - - e0c3e757 by Matthew Pickering at 2022-03-03T13:48:41-05:00 docs: Add note to unsafeCoerce function that you might want to use coerce [skip ci] Fixes #15429 - - - - - 559d4cf3 by Matthew Pickering at 2022-03-03T13:49:17-05:00 docs: Add note to RULES documentation about locally bound variables [skip ci] Fixes #20100 - - - - - c534b3dd by Matthew Pickering at 2022-03-03T13:49:53-05:00 Replace ad-hoc CPP with constant from GHC.Utils.Constant Fixes #21154 - - - - - de56cc7e by Krzysztof Gogolewski at 2022-03-04T12:44:26-05:00 Update documentation of LiberalTypeSynonyms We no longer require LiberalTypeSynonyms to use 'forall' or an unboxed tuple in a synonym. I also removed that kind checking before expanding synonyms "could be changed". This was true when type synonyms were thought of macros, but with the extensions such as SAKS or matchability I don't see it changing. - - - - - c0a39259 by Simon Jakobi at 2022-03-04T12:45:01-05:00 base: Mark GHC.Bits not-home for haddock Most (all) of the exports are re-exported from the preferable Data.Bits. - - - - - 3570eda5 by Sylvain Henry at 2022-03-04T12:45:42-05:00 Fix comments about Int64/Word64 primops - - - - - 6f84ee33 by Artem Pelenitsyn at 2022-03-05T01:06:47-05:00 remove MonadFail instances of ST CLC proposal: https://github.com/haskell/core-libraries-committee/issues/33 The instances had `fail` implemented in terms of `error`, whereas the idea of the `MonadFail` class is that the `fail` method should be implemented in terms of the monad itself. - - - - - 584cd5ae by sheaf at 2022-03-05T01:07:25-05:00 Don't allow Float#/Double# literal patterns This patch does the following two things: 1. Fix the check in Core Lint to properly throw an error when it comes across Float#/Double# literal patterns. The check was incorrect before, because it expected the type to be Float/Double instead of Float#/Double#. 2. Add an error in the parser when the user writes a floating-point literal pattern such as `case x of { 2.0## -> ... }`. Fixes #21115 - - - - - 706deee0 by Greg Steuck at 2022-03-05T17:44:10-08:00 Make T20214 terminate promptly be setting input to /dev/null It was hanging and timing out on OpenBSD before. - - - - - 14e90098 by Simon Peyton Jones at 2022-03-07T14:05:41-05:00 Always generalise top-level bindings Fix #21023 by always generalising top-level binding; change the documentation of -XMonoLocalBinds to match. - - - - - c9c31c3c by Matthew Pickering at 2022-03-07T14:06:16-05:00 hadrian: Add little flavour transformer to build stage2 with assertions This can be useful to build a `perf+assertions` build or even better `default+no_profiled_libs+omit_pragmas+assertions`. - - - - - 89c14a6c by Matthew Pickering at 2022-03-07T14:06:16-05:00 ci: Convert all deb10 make jobs into hadrian jobs This is the first step in converting all the CI configs to use hadrian rather than make. (#21129) The metrics increase due to hadrian using --hyperlinked-source for haddock builds. (See #21156) ------------------------- Metric Increase: haddock.Cabal haddock.base haddock.compiler ------------------------- - - - - - 7bfae2ee by Matthew Pickering at 2022-03-07T14:06:16-05:00 Replace use of BIN_DIST_PREP_TAR_COMP with BIN_DIST_NAME And adds a check to make sure we are not accidently settings BIN_DIST_PREP_TAR_COMP when using hadrian. - - - - - 5b35ca58 by Matthew Pickering at 2022-03-07T14:06:16-05:00 Fix gen_contents_index logic for hadrian bindist - - - - - 273bc133 by Krzysztof Gogolewski at 2022-03-07T14:06:52-05:00 Fix reporting constraints in pprTcSolverReportMsg 'no_instance_msg' and 'no_deduce_msg' were omitting the first wanted. - - - - - 5874a30a by Simon Jakobi at 2022-03-07T14:07:28-05:00 Improve setBit for Natural Previously the default definition was used, which involved allocating intermediate Natural values. Fixes #21173. - - - - - 7a02aeb8 by Matthew Pickering at 2022-03-07T14:08:03-05:00 Remove leftover trace in testsuite - - - - - 6ce6c250 by Andreas Klebinger at 2022-03-07T23:48:56-05:00 Expand and improve the Note [Strict Worker Ids]. I've added an explicit mention of the invariants surrounding those. As well as adding more direct cross references to the Strict Field Invariant. - - - - - d0f892fe by Ryan Scott at 2022-03-07T23:49:32-05:00 Delete GenericKind_ in favor of GenericKind_DC When deriving a `Generic1` instance, we need to know what the last type variable of a data type is. Previously, there were two mechanisms to determine this information: * `GenericKind_`, where `Gen1_` stored the last type variable of a data type constructor (i.e., the `tyConTyVars`). * `GenericKind_DC`, where `Gen1_DC` stored the last universally quantified type variable in a data constructor (i.e., the `dataConUnivTyVars`). These had different use cases, as `GenericKind_` was used for generating `Rep(1)` instances, while `GenericKind_DC` was used for generating `from(1)` and `to(1)` implementations. This was already a bit confusing, but things went from confusing to outright wrong after !6976. This is because after !6976, the `deriving` machinery stopped using `tyConTyVars` in favor of `dataConUnivTyVars`. Well, everywhere with the sole exception of `GenericKind_`, which still continued to use `tyConTyVars`. This lead to disaster when deriving a `Generic1` instance for a GADT family instance, as the `tyConTyVars` do not match the `dataConUnivTyVars`. (See #21185.) The fix is to stop using `GenericKind_` and replace it with `GenericKind_DC`. For the most part, this proves relatively straightforward. Some highlights: * The `forgetArgVar` function was deleted entirely, as it no longer proved necessary after `GenericKind_`'s demise. * The substitution that maps from the last type variable to `Any` (see `Note [Generating a correctly typed Rep instance]`) had to be moved from `tc_mkRepTy` to `tc_mkRepFamInsts`, as `tc_mkRepTy` no longer has access to the last type variable. Fixes #21185. - - - - - a60ddffd by Matthew Pickering at 2022-03-08T22:51:37+00:00 Move bootstrap and cabal-reinstall test jobs to nightly CI is creaking under the pressure of too many jobs so attempt to reduce the strain by removing a couple of jobs. - - - - - 7abe3288 by Matthew Pickering at 2022-03-09T10:24:15+00:00 Add 10 minute timeout to linters job - - - - - 3cf75ede by Matthew Pickering at 2022-03-09T10:24:16+00:00 Revert "hadrian: Correctly set whether we have a debug compiler when running tests" Needing the arguments for "GHC/Utils/Constant.hs" implies a dependency on the previous stage compiler. Whilst we work out how to get around this I will just revert this commit (as it only affects running the testsuite in debug way). This reverts commit ce65d0cceda4a028f30deafa3c39d40a250acc6a. - - - - - 18b9ba56 by Matthew Pickering at 2022-03-09T11:07:23+00:00 ci: Fix save_cache function Each interation of saving the cache would copy the whole `cabal` store into a subfolder in the CACHE_DIR rather than copying the contents of the cabal store into the cache dir. This resulted in a cache which looked like: ``` /builds/ghc/ghc/cabal-cache/cabal/cabal/cabal/cabal/cabal/cabal/cabal/cabal/cabal/cabal/ ``` So it would get one layer deeper every CI run and take longer and longer to compress. - - - - - bc684dfb by Ben Gamari at 2022-03-10T03:20:07-05:00 mr-template: Mention timeframe for review - - - - - 7f5f4ede by Vladislav Zavialov at 2022-03-10T03:20:43-05:00 Bump submodules: containers, exceptions GHC Proposal #371 requires TypeOperators to use type equality a~b. This submodule update pulls in the appropriate forward-compatibility changes in 'libraries/containers' and 'libraries/exceptions' - - - - - 8532b8a9 by Matthew Pickering at 2022-03-10T03:20:43-05:00 Add an inline pragma to lookupVarEnv The containers bump reduced the size of the Data.IntMap.Internal.lookup function so that it no longer experienced W/W. This means that the size of lookupVarEnv increased over the inlining threshold and it wasn't inlined into the hot code path in substTyVar. See containers#821, #21159 and !7638 for some more explanation. ------------------------- Metric Decrease: LargeRecord T12227 T13386 T15703 T18223 T5030 T8095 T9872a T9872b T9872c TcPlugin_RewritePerf ------------------------- - - - - - 844cf1e1 by Matthew Pickering at 2022-03-10T03:20:43-05:00 Normalise output of T10970 test The output of this test changes each time the containers submodule version updates. It's easier to apply the version normaliser so that the test checks that there is a version number, but not which one it is. - - - - - 24b6af26 by Ryan Scott at 2022-03-11T19:56:28-05:00 Refactor tcDeriving to generate tyfam insts before any bindings Previously, there was an awful hack in `genInst` (now called `genInstBinds` after this patch) where we had to return a continutation rather than directly returning the bindings for a derived instance. This was done for staging purposes, as we had to first infer the instance contexts for derived instances and then feed these contexts into the continuations to ensure the generated instance bindings had accurate instance contexts. `Note [Staging of tcDeriving]` in `GHC.Tc.Deriving` described this confusing state of affairs. The root cause of this confusing design was the fact that `genInst` was trying to generate instance bindings and associated type family instances for derived instances simultaneously. This really isn't possible, however: as `Note [Staging of tcDeriving]` explains, one needs to have access to the associated type family instances before one can properly infer the instance contexts for derived instances. The use of continuation-returning style was an attempt to circumvent this dependency, but it did so in an awkward way. This patch detangles this awkwardness by splitting up `genInst` into two functions: `genFamInsts` (for associated type family instances) and `genInstBinds` (for instance bindings). Now, the `tcDeriving` function calls `genFamInsts` and brings all the family instances into scope before calling `genInstBinds`. This removes the need for the awkward continuation-returning style seen in the previous version of `genInst`, making the code easier to understand. There are some knock-on changes as well: 1. `hasStockDeriving` now needs to return two separate functions: one that describes how to generate family instances for a stock-derived instance, and another that describes how to generate the instance bindings. I factored out this pattern into a new `StockGenFns` data type. 2. While documenting `StockGenFns`, I realized that there was some inconsistency regarding which `StockGenFns` functions needed which arguments. In particular, the function in `GHC.Tc.Deriv.Generics` which generates `Rep(1)` instances did not take a `SrcSpan` like other `gen_*` functions did, and it included an extra `[Type]` argument that was entirely redundant. As a consequence, I refactored the code in `GHC.Tc.Deriv.Generics` to more closely resemble other `gen_*` functions. A happy result of all this is that all `StockGenFns` functions now take exactly the same arguments, which makes everything more uniform. This is purely a refactoring that should not have any effect on user-observable behavior. The new design paves the way for an eventual fix for #20719. - - - - - 62caaa9b by Ben Gamari at 2022-03-11T19:57:03-05:00 gitlab-ci: Use the linters image in hlint job As the `hlint` executable is only available in the linters image. Fixes #21146. - - - - - 4abd7eb0 by Matthew Pickering at 2022-03-11T19:57:38-05:00 Remove partOfGhci check in the loader This special logic has been part of GHC ever since template haskell was introduced in 9af77fa423926fbda946b31e174173d0ec5ebac8. It's hard to believe in any case that this special logic pays its way at all. Given * The list is out-of-date, which has potential to lead to miscompilation when using "editline", which was removed in 2010 (46aed8a4). * The performance benefit seems negligable as each load only happens once anyway and packages specified by package flags are preloaded into the linker state at the start of compilation. Therefore we just remove this logic. Fixes #19791 - - - - - c40cbaa2 by Andreas Klebinger at 2022-03-11T19:58:14-05:00 Improve -dtag-inference-checks checks. FUN closures don't get tagged when evaluated. So no point in checking their tags. - - - - - ab00d23b by Simon Jakobi at 2022-03-11T19:58:49-05:00 Improve clearBit and complementBit for Natural Also optimize bigNatComplementBit#. Fixes #21175, #21181, #21194. - - - - - a6d8facb by Sebastian Graf at 2022-03-11T19:59:24-05:00 gitignore all (build) directories headed by _ - - - - - 524795fe by Sebastian Graf at 2022-03-11T19:59:24-05:00 Demand: Document why we need three additional equations of multSubDmd - - - - - 6bdcd557 by Cheng Shao at 2022-03-11T20:00:01-05:00 CmmToC: make 64-bit word splitting for 32-bit targets respect target endianness This used to been broken for little-endian targets. - - - - - 9e67c69e by Cheng Shao at 2022-03-11T20:00:01-05:00 CmmToC: fix Double# literal payload for 32-bit targets Contrary to the legacy comment, the splitting didn't happen and we ended up with a single StgWord64 literal in the output code! Let's just do the splitting here. - - - - - 1eee2e28 by Cheng Shao at 2022-03-11T20:00:01-05:00 CmmToC: use __builtin versions of memcpyish functions to fix type mismatch Our memcpyish primop's type signatures doesn't match the C type signatures. It's not a problem for typical archs, since their C ABI permits dropping the result, but it doesn't work for wasm. The previous logic would cast the memcpyish function pointer to an incorrect type and perform an indirect call, which results in a runtime trap on wasm. The most straightforward fix is: don't emit EFF_ for memcpyish functions. Since we don't want to include extra headers in .hc to bring in their prototypes, we can just use the __builtin versions. - - - - - 9d8d4837 by Cheng Shao at 2022-03-11T20:00:01-05:00 CmmToC: emit __builtin_unreachable() when CmmSwitch doesn't contain fallback case Otherwise the C compiler may complain "warning: non-void function does not return a value in all control paths [-Wreturn-type]". - - - - - 27da5540 by Cheng Shao at 2022-03-11T20:00:01-05:00 CmmToC: make floatToWord32/doubleToWord64 faster Use castFloatToWord32/castDoubleToWord64 in base to perform the reinterpret cast. - - - - - c98e8332 by Cheng Shao at 2022-03-11T20:00:01-05:00 CmmToC: fix -Wunused-value warning in ASSIGN_BaseReg When ASSIGN_BaseReg is a no-op, we shouldn't generate any C code, otherwise C compiler complains a bunch of -Wunused-value warnings when doing unregisterised codegen. - - - - - 5932247c by Ben Gamari at 2022-03-11T20:00:36-05:00 users guide: Eliminate spurious \spxentry mentions We were failing to pass the style file to `makeindex`, as is done by the mklatex configuration generated by Sphinx. Fixes #20913. - - - - - e40cf4ef by Simon Jakobi at 2022-03-11T20:01:11-05:00 ghc-bignum: Tweak integerOr The result of ORing two BigNats is always greater or equal to the larger of the two. Therefore it is safe to skip the magnitude checks of integerFromBigNat#. - - - - - cf081476 by Vladislav Zavialov at 2022-03-12T07:02:40-05:00 checkUnboxedLitPat: use non-fatal addError This enables GHC to report more parse errors in a single pass. - - - - - 7fe07143 by Andreas Klebinger at 2022-03-12T07:03:16-05:00 Rename -fprof-late-ccs to -fprof-late - - - - - 88a94541 by Sylvain Henry at 2022-03-12T07:03:56-05:00 Hadrian: avoid useless allocations in trackArgument Cf ticky report before the change: Entries Alloc Alloc'd Non-void Arguments STG Name -------------------------------------------------------------------------------- 696987 29044128 0 1 L main:Target.trackArgument_go5{v r24kY} (fun) - - - - - 2509d676 by Sylvain Henry at 2022-03-12T07:04:36-05:00 Hadrian: avoid allocating in stageString (#19209) - - - - - c062fac0 by Sylvain Henry at 2022-03-12T07:04:36-05:00 Hadrian: remove useless imports Added for no reason in 7ce1b694f7be7fbf6e2d7b7eb0639e61fbe358c6 - - - - - c82fb934 by Sylvain Henry at 2022-03-12T07:05:16-05:00 Hadrian: avoid allocations in WayUnit's Read instance (#19209) - - - - - ed04aed2 by Sylvain Henry at 2022-03-12T07:05:16-05:00 Hadrian: use IntSet Binary instance for Way (#19209) - - - - - ad835531 by Simon Peyton Jones at 2022-03-13T18:12:12-04:00 Fix bug in weak loop-breakers in OccurAnal Note [Weak loop breakers] explains why we need to track variables free in RHS of rules. But we need to do this for /inactive/ rules as well as active ones, unlike the rhs_fv_env stuff. So we now have two fields in node Details, one for free vars of active rules, and one for free vars of all rules. This was shown up by #20820, which is now fixed. - - - - - 76b94b72 by Sebastian Graf at 2022-03-13T18:12:48-04:00 Worker/wrapper: Preserve float barriers (#21150) Issue #21150 shows that worker/wrapper allocated a worker function for a function with multiple calls that said "called at most once" when the first argument was absent. That's bad! This patch makes it so that WW preserves at least one non-one-shot value lambda (see `Note [Preserving float barriers]`) by passing around `void#` in place of absent arguments. Fixes #21150. Since the fix is pretty similar to `Note [Protecting the last value argument]`, I put the logic in `mkWorkerArgs`. There I realised (#21204) that `-ffun-to-thunk` is basically useless with `-ffull-laziness`, so I deprecated the flag, simplified and split into `needsVoidWorkerArg`/`addVoidWorkerArg`. SpecConstr is another client of that API. Fixes #21204. Metric Decrease: T14683 - - - - - 97db789e by romes at 2022-03-14T11:36:39-04:00 Fix up Note [Bind free vars] Move GHC-specific comments from Language.Haskell.Syntax.Binds to GHC.Hs.Binds It looks like the Note was deleted but there were actually two copies of it. L.H.S.B no longer references it, and GHC.Hs.Binds keeps an updated copy. (See #19252) There are other duplicated notes -- they will be fixed in the next commit - - - - - 135888dd by romes at 2022-03-14T11:36:39-04:00 TTG Pull AbsBinds and ABExport out of the main AST AbsBinds and ABExport both depended on the typechecker, and were thus removed from the main AST Expr. CollectPass now has a new function `collectXXHsBindsLR` used for the new HsBinds extension point Bumped haddock submodule to work with AST changes. The removed Notes from Language.Haskell.Syntax.Binds were duplicated (and not referenced) and the copies in GHC.Hs.Binds are kept (and referenced there). (See #19252) - - - - - 106413f0 by sheaf at 2022-03-14T11:37:21-04:00 Add two coercion optimisation perf tests - - - - - 8eadea67 by sheaf at 2022-03-14T15:08:24-04:00 Fix isLiftedType_maybe and handle fallout As #20837 pointed out, `isLiftedType_maybe` returned `Just False` in many situations where it should return `Nothing`, because it didn't take into account type families or type variables. In this patch, we fix this issue. We rename `isLiftedType_maybe` to `typeLevity_maybe`, which now returns a `Levity` instead of a boolean. We now return `Nothing` for types with kinds of the form `TYPE (F a1 ... an)` for a type family `F`, as well as `TYPE (BoxedRep l)` where `l` is a type variable. This fix caused several other problems, as other parts of the compiler were relying on `isLiftedType_maybe` returning a `Just` value, and were now panicking after the above fix. There were two main situations in which panics occurred: 1. Issues involving the let/app invariant. To uphold that invariant, we need to know whether something is lifted or not. If we get an answer of `Nothing` from `isLiftedType_maybe`, then we don't know what to do. As this invariant isn't particularly invariant, we can change the affected functions to not panic, e.g. by behaving the same in the `Just False` case and in the `Nothing` case (meaning: no observable change in behaviour compared to before). 2. Typechecking of data (/newtype) constructor patterns. Some programs involving patterns with unknown representations were accepted, such as T20363. Now that we are stricter, this caused further issues, culminating in Core Lint errors. However, the behaviour was incorrect the whole time; the incorrectness only being revealed by this change, not triggered by it. This patch fixes this by overhauling where the representation polymorphism involving pattern matching are done. Instead of doing it in `tcMatches`, we instead ensure that the `matchExpected` functions such as `matchExpectedFunTys`, `matchActualFunTySigma`, `matchActualFunTysRho` allow return argument pattern types which have a fixed RuntimeRep (as defined in Note [Fixed RuntimeRep]). This ensures that the pattern matching code only ever handles types with a known runtime representation. One exception was that patterns with an unknown representation type could sneak in via `tcConPat`, which points to a missing representation-polymorphism check, which this patch now adds. This means that we now reject the program in #20363, at least until we implement PHASE 2 of FixedRuntimeRep (allowing type families in RuntimeRep positions). The aforementioned refactoring, in which checks have been moved to `matchExpected` functions, is a first step in implementing PHASE 2 for patterns. Fixes #20837 - - - - - 8ff32124 by Sebastian Graf at 2022-03-14T15:09:01-04:00 DmdAnal: Don't unbox recursive data types (#11545) As `Note [Demand analysis for recursive data constructors]` describes, we now refrain from unboxing recursive data type arguments, for two reasons: 1. Relating to run/alloc perf: Similar to `Note [CPR for recursive data constructors]`, it seldomly improves run/alloc performance if we just unbox a finite number of layers of a potentially huge data structure. 2. Relating to ghc/alloc perf: Inductive definitions on single-product recursive data types like the one in T11545 will (diverge, and) have very deep demand signatures before any other abortion mechanism in Demand analysis is triggered. That leads to great and unnecessary churn on Demand analysis when ultimately we will never make use of any nested strictness information anyway. Conclusion: Discard nested demand and boxity information on such recursive types with the help of `Note [Detecting recursive data constructors]`. I also implemented `GHC.Types.Unique.MemoFun.memoiseUniqueFun` in order to avoid the overhead of repeated calls to `GHC.Core.Opt.WorkWrap.Utils.isRecDataCon`. It's nice and simple and guards against some smaller regressions in T9233 and T16577. ghc/alloc performance-wise, this patch is a very clear win: Test Metric value New value Change --------------------------------------------------------------------------------------- LargeRecord(normal) ghc/alloc 6,141,071,720 6,099,871,216 -0.7% MultiLayerModulesTH_OneShot(normal) ghc/alloc 2,740,973,040 2,705,146,640 -1.3% T11545(normal) ghc/alloc 945,475,492 85,768,928 -90.9% GOOD T13056(optasm) ghc/alloc 370,245,880 326,980,632 -11.7% GOOD T18304(normal) ghc/alloc 90,933,944 76,998,064 -15.3% GOOD T9872a(normal) ghc/alloc 1,800,576,840 1,792,348,760 -0.5% T9872b(normal) ghc/alloc 2,086,492,432 2,073,991,848 -0.6% T9872c(normal) ghc/alloc 1,750,491,240 1,737,797,832 -0.7% TcPlugin_RewritePerf(normal) ghc/alloc 2,286,813,400 2,270,957,896 -0.7% geo. mean -2.9% No noteworthy change in run/alloc either. NoFib results show slight wins, too: -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- constraints -1.9% -1.4% fasta -3.6% -2.7% reverse-complem -0.3% -0.9% treejoin -0.0% -0.3% -------------------------------------------------------------------------------- Min -3.6% -2.7% Max +0.1% +0.1% Geometric Mean -0.1% -0.1% Metric Decrease: T11545 T13056 T18304 - - - - - ab618309 by Vladislav Zavialov at 2022-03-15T18:34:38+03:00 Export (~) from Data.Type.Equality (#18862) * Users can define their own (~) type operator * Haddock can display documentation for the built-in (~) * New transitional warnings implemented: -Wtype-equality-out-of-scope -Wtype-equality-requires-operators Updates the haddock submodule. - - - - - 577135bf by Aaron Allen at 2022-03-16T02:27:48-04:00 Convert Diagnostics in GHC.Tc.Gen.Foreign Converts all uses of 'TcRnUnknownMessage' to proper diagnostics. - - - - - c1fed9da by Aaron Allen at 2022-03-16T02:27:48-04:00 Suggest FFI extensions as hints (#20116) - Use extension suggestion hints instead of suggesting extensions in the error message body for several FFI errors. - Adds a test case for `TcRnForeignImportPrimExtNotSet` - - - - - a33d1045 by Zubin Duggal at 2022-03-16T02:28:24-04:00 TH: allow negative patterns in quotes (#20711) We still don't allow negative overloaded patterns. Earler all negative patterns were treated as negative overloaded patterns. Now, we expliclty check the extension field to see if the pattern is actually a negative overloaded pattern - - - - - 1575c4a5 by Sebastian Graf at 2022-03-16T02:29:03-04:00 Demand: Let `Boxed` win in `lubBoxity` (#21119) Previously, we let `Unboxed` win in `lubBoxity`, which is unsoundly optimistic in terms ob Boxity analysis. "Unsoundly" in the sense that we sometimes unbox parameters that we better shouldn't unbox. Examples are #18907 and T19871.absent. Until now, we thought that this hack pulled its weight becuase it worked around some shortcomings of the phase separation between Boxity analysis and CPR analysis. But it is a gross hack which caused regressions itself that needed all kinds of fixes and workarounds. See for example #20767. It became impossible to work with in !7599, so I want to remove it. For example, at the moment, `lubDmd B dmd` will not unbox `dmd`, but `lubDmd A dmd` will. Given that `B` is supposed to be the bottom element of the lattice, it's hardly justifiable to get a better demand when `lub`bing with `A`. The consequence of letting `Boxed` win in `lubBoxity` is that we *would* regress #2387, #16040 and parts of #5075 and T19871.sumIO, until Boxity and CPR are able to communicate better. Fortunately, that is not the case since I could tweak the other source of optimism in Boxity analysis that is described in `Note [Unboxed demand on function bodies returning small products]` so that we *recursively* assume unboxed demands on function bodies returning small products. See the updated Note. `Note [Boxity for bottoming functions]` describes why we need bottoming functions to have signatures that say that they deeply unbox their arguments. In so doing, I had to tweak `finaliseArgBoxities` so that it will never unbox recursive data constructors. This is in line with our handling of them in CPR. I updated `Note [Which types are unboxed?]` to reflect that. In turn we fix #21119, #20767, #18907, T19871.absent and get a much simpler implementation (at least to think about). We can also drop the very ad-hoc definition of `deferAfterPreciseException` and its Note in favor of the simple, intuitive definition we used to have. Metric Decrease: T16875 T18223 T18698a T18698b hard_hole_fits Metric Increase: LargeRecord MultiComponentModulesRecomp T15703 T8095 T9872d Out of all the regresions, only the one in T9872d doesn't vanish in a perf build, where the compiler is bootstrapped with -O2 and thus SpecConstr. Reason for regressions: * T9872d is due to `ty_co_subst` taking its `LiftingContext` boxed. That is because the context is passed to a function argument, for example in `liftCoSubstTyVarBndrUsing`. * In T15703, LargeRecord and T8095, we get a bit more allocations in `expand_syn` and `piResultTys`, because a `TCvSubst` isn't unboxed. In both cases that guards against reboxing in some code paths. * The same is true for MultiComponentModulesRecomp, where we get less unboxing in `GHC.Unit.Finder.$wfindInstalledHomeModule`. In a perf build, allocations actually *improve* by over 4%! Results on NoFib: -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- awards -0.4% +0.3% cacheprof -0.3% +2.4% fft -1.5% -5.1% fibheaps +1.2% +0.8% fluid -0.3% -0.1% ida +0.4% +0.9% k-nucleotide +0.4% -0.1% last-piece +10.5% +13.9% lift -4.4% +3.5% mandel2 -99.7% -99.8% mate -0.4% +3.6% parser -1.0% +0.1% puzzle -11.6% +6.5% reverse-complem -3.0% +2.0% scs -0.5% +0.1% sphere -0.4% -0.2% wave4main -8.2% -0.3% -------------------------------------------------------------------------------- Summary excludes mandel2 because of excessive bias Min -11.6% -5.1% Max +10.5% +13.9% Geometric Mean -0.2% +0.3% -------------------------------------------------------------------------------- Not bad for a bug fix. The regression in `last-piece` could become a win if SpecConstr would work on non-recursive functions. The regression in `fibheaps` is due to `Note [Reboxed crud for bottoming calls]`, e.g., #21128. - - - - - bb779b90 by sheaf at 2022-03-16T02:29:42-04:00 Add a regression test for #21130 This problem was due to a bug in cloneWanted, which was incorrectly creating a coercion hole to hold an evidence variable. This bug was introduced by 8bb52d91 and fixed in 81740ce8. Fixes #21130 - - - - - 0f0e2394 by Tamar Christina at 2022-03-17T10:16:37-04:00 linker: Initial Windows C++ exception unwinding support - - - - - 36d20d4d by Tamar Christina at 2022-03-17T10:16:37-04:00 linker: Fix ADDR32NB relocations on Windows - - - - - 8a516527 by Tamar Christina at 2022-03-17T10:16:37-04:00 testsuite: properly escape string paths - - - - - 1a0dd008 by sheaf at 2022-03-17T10:17:13-04:00 Hadrian: account for change in late-ccs flag The late cost centre flag was renamed from -fprof-late-ccs to -fprof-late in 7fe07143, but this change hadn't been propagated to Hadrian. - - - - - 8561c1af by romes at 2022-03-18T05:10:58-04:00 TTG: Refactor HsBracket - - - - - 19163397 by romes at 2022-03-18T05:10:58-04:00 Type-checking untyped brackets When HsExpr GhcTc, the HsBracket constructor should hold a HsBracket GhcRn, rather than an HsBracket GhcTc. We make use of the HsBracket p extension constructor (XBracket (XXBracket p)) to hold an HsBracket GhcRn when the pass is GhcTc See !4782 https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4782 - - - - - 310890a5 by romes at 2022-03-18T05:10:58-04:00 Separate constructors for typed and untyped brackets Split HsBracket into HsTypedBracket and HsUntypedBracket. Unfortunately, we still cannot get rid of instance XXTypedBracket GhcTc = HsTypedBracket GhcRn despite no longer requiring it for typechecking, but rather because the TH desugarer works on GhcRn rather than GhcTc (See GHC.HsToCore.Quote) - - - - - 4a2567f5 by romes at 2022-03-18T05:10:58-04:00 TTG: Refactor bracket for desugaring during tc When desugaring a bracket we want to desugar /renamed/ rather than /typechecked/ code; So in (HsExpr GhcTc) tree, we must have a (HsExpr GhcRn) for the quotation itself. This commit reworks the TTG refactor on typed and untyped brackets by storing the /renamed/ code in the bracket field extension rather than in the constructor extension in `HsQuote` (previously called `HsUntypedBracket`) See Note [The life cycle of a TH quotation] and https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4782 - - - - - b056adc8 by romes at 2022-03-18T05:10:58-04:00 TTG: Make HsQuote GhcTc isomorphic to NoExtField An untyped bracket `HsQuote p` can never be constructed with `p ~ GhcTc`. This is because we don't typecheck `HsQuote` at all. That's OK, because we also never use `HsQuote GhcTc`. To enforce this at the type level we make `HsQuote GhcTc` isomorphic to `NoExtField` and impossible to construct otherwise, by using TTG field extensions to make all constructors, except for `XQuote` (which takes `NoExtField`), unconstructable, with `DataConCantHappen` This is explained more in detail in Note [The life cycle of a TH quotation] Related discussion: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4782 - - - - - ac3b2e7d by romes at 2022-03-18T05:10:58-04:00 TTG: TH brackets finishing touches Rewrite the critical notes and fix outdated ones, use `HsQuote GhcRn` (in `HsBracketTc`) for desugaring regardless of the bracket being typed or untyped, remove unused `EpAnn` from `Hs*Bracket GhcRn`, zonkExpr factor out common brackets code, ppr_expr factor out common brackets code, and fix tests, to finish MR https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4782. ------------------------- Metric Decrease: hard_hole_fits ------------------------- - - - - - d147428a by Ben Gamari at 2022-03-18T05:11:35-04:00 codeGen: Fix signedness of jump table indexing Previously while constructing the jump table index we would zero-extend the discriminant before subtracting the start of the jump-table. This goes subtly wrong in the case of a sub-word, signed discriminant, as described in the included Note. Fix this in both the PPC and X86 NCGs. Fixes #21186. - - - - - 435a3d5d by Ben Gamari at 2022-03-18T05:11:35-04:00 testsuite: Add test for #21186 - - - - - e9d8de93 by Zubin Duggal at 2022-03-19T07:35:49-04:00 TH: Fix pretty printing of newtypes with operators and GADT syntax (#20868) The pretty printer for regular data types already accounted for these, and had some duplication with the newtype pretty printer. Factoring the logic out into a common function and using it for both newtypes and data declarations is enough to fix the bug. - - - - - 244da9eb by sheaf at 2022-03-19T07:36:24-04:00 List GHC.Event.Internal in base.cabal on Windows GHC.Event.Internal was not listed in base.cabal on Windows. This caused undefined reference errors. This patch adds it back, by moving it out of the OS-specific logic in base.cabal. Fixes #21245. - - - - - d1c03719 by Andreas Klebinger at 2022-03-19T07:37:00-04:00 Compact regions: Maintain tags properly Fixes #21251 - - - - - d45bb701 by romes at 2022-03-19T07:37:36-04:00 Remove dead code HsDoRn - - - - - c842611f by nineonine at 2022-03-20T21:16:06-04:00 Revamp derived Eq instance code generation (#17240) This patch improves code generation for derived Eq instances. The idea is to use 'dataToTag' to evaluate both arguments. This allows to 'short-circuit' when tags do not match. Unfortunately, inner evals are still present when we branch on tags. This is due to the way 'dataToTag#' primop evaluates its argument in the code generator. #21207 was created to explore further optimizations. Metric Decrease: LargeRecord - - - - - 52ffd38c by Sylvain Henry at 2022-03-20T21:16:46-04:00 Avoid some SOURCE imports - - - - - 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. - - - - - 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 - - - - - 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. - - - - - 08c0822c by doyougnu at 2023-02-15T00:16:39-05:00 docs: release notes, user guide: add js backend Follow up from #21078 - - - - - 79d8fd65 by Bryan Richter at 2023-02-15T00:17:15-05:00 Allow failure in nightly-x86_64-linux-deb10-no_tntc-validate See #22343 - - - - - 9ca51f9e by Cheng Shao at 2023-02-15T00:17:53-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. - - - - - 26df73fb by Oleg Grenrus at 2023-02-15T22:20:57-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 - - - - - 631c6c72 by Cheng Shao at 2023-02-16T06:43:09-05:00 docs: add a section for the wasm backend Fixes #22658 - - - - - 1878e0bd by Bryan Richter at 2023-02-16T06:43:47-05:00 tests: Mark T12903 fragile everywhere See #21184 - - - - - b9420eac by Bryan Richter at 2023-02-16T06:43:47-05:00 Mark all T5435 variants as fragile See #22970. - - - - - df3d94bd by Sylvain Henry at 2023-02-16T06:44:33-05:00 Testsuite: mark T13167 as fragile for JS (#22921) - - - - - 324e925b by Sylvain Henry at 2023-02-16T06:45:15-05:00 JS: disable debugging info for heap objects - - - - - 518af814 by Josh Meredith at 2023-02-16T10:16:32-05:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 34cd308e by Ben Gamari at 2023-02-16T10:17:08-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 12965aba by Simon Peyton Jones at 2023-02-16T10:17:46-05: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 - - - - - 5b038888 by Bodigrim at 2023-02-16T10:18:24-05:00 Documentation: add an example of SPEC usage - - - - - 681e0e8c by sheaf at 2023-02-16T14:09:56-05:00 No default finalizer exception handler Commit cfc8e2e2 introduced a mechanism for handling of exceptions that occur during Handle finalization, and 372cf730 set the default handler to print out the error to stderr. However, #21680 pointed out we might not want to set this by default, as it might pollute users' terminals with unwanted information. So, for the time being, the default handler discards the exception. Fixes #21680 - - - - - b3ac17ad by Matthew Pickering at 2023-02-16T14:10:31-05: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 ------------------------- - - - - - 8988eeef by sheaf at 2023-02-16T20:32:27-05:00 Expand synonyms in RoughMap We were failing to expand type synonyms in the function GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the RoughMap infrastructure crucially relies on type synonym expansion to work. This patch adds the missing type-synonym expansion. Fixes #22985 - - - - - 3dd50e2f by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Add test artifact Add the released testsuite tarball to the generated ghcup metadata. - - - - - c6a967d9 by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Use Ubuntu and Rocky bindists Prefer to use the Ubuntu 20.04 and 18.04 binary distributions on Ubuntu and Linux Mint. Prefer to use the Rocky 8 binary distribution on unknown distributions. - - - - - be0b7209 by Matthew Pickering at 2023-02-17T09:37:16+00:00 Add INLINABLE pragmas to `generic*` functions in Data.OldList These functions are * recursive * overloaded So it's important to add an `INLINABLE` pragma to each so that they can be specialised at the use site when the specific numeric type is known. Adding these pragmas improves the LazyText replicate benchmark (see https://gitlab.haskell.org/ghc/ghc/-/issues/22886#note_481020) https://github.com/haskell/core-libraries-committee/issues/129 - - - - - a203ad85 by Sylvain Henry at 2023-02-17T15:59:16-05:00 Merge libiserv with ghci `libiserv` serves no purpose. As it depends on `ghci` and doesn't have more dependencies than the `ghci` package, its code could live in the `ghci` package too. This commit also moves most of the code from the `iserv` program into the `ghci` package as well so that it can be reused. This is especially useful for the implementation of TH for the JS backend (#22261, !9779). - - - - - 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01: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 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-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. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-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. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-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. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 7192ef91 by Simon Peyton Jones at 2023-02-28T18:54:59-05:00 Take more care with unlifted bindings in the specialiser As #22998 showed, we were floating an unlifted binding to top level, which breaks a Core invariant. The fix is easy, albeit a little bit conservative. See Note [Care with unlifted bindings] in GHC.Core.Opt.Specialise - - - - - bb500e2a by Simon Peyton Jones at 2023-02-28T18:55:35-05:00 Account for TYPE vs CONSTRAINT in mkSelCo As #23018 showed, in mkRuntimeRepCo we need to account for coercions between TYPE and COERCION. See Note [mkRuntimeRepCo] in GHC.Core.Coercion. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-05:00 hadrian: Add dependency from lib/settings to mk/config.mk In 81975ef375de07a0ea5a69596b2077d7f5959182 we attempted to fix #20253 by adding logic to the bindist Makefile to regenerate the `settings` file from information gleaned by the bindist `configure` script. However, this fix had no effect as `lib/settings` is shipped in the binary distribution (to allow in-place use of the binary distribution). As `lib/settings` already existed and its rule declared no dependencies, `make` would fail to use the added rule to regenerate it. Fix this by explicitly declaring a dependency from `lib/settings` on `mk/config.mk`. Fixes #22982. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-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. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-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. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00: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. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 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: ...lots of lines omitted... 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. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04: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. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04: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> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+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. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 3ecd93e8 by Vladislav Zavialov at 2023-06-16T18:30:16+02:00 Deprecate and disable CUSKs - - - - - a234345c by Vladislav Zavialov at 2023-06-16T18:30:16+02:00 Update test: ClosedFam2TH - - - - - 8b6c420a by Vladislav Zavialov at 2023-06-16T18:30:16+02:00 Update test: ClosedFam3 - - - - - 1d5c76a1 by Vladislav Zavialov at 2023-06-16T18:30:16+02:00 Update test: Dep2 - - - - - 74ef571a by Vladislav Zavialov at 2023-06-16T18:30:16+02:00 Update test: DkNameRes - - - - - e01625e2 by Vladislav Zavialov at 2023-06-16T18:30:17+02:00 Update test: DumpParsedAst - - - - - fbe7b4eb by Vladislav Zavialov at 2023-06-16T18:30:17+02:00 Update test: DumpRenamedAst - - - - - a978085a by Vladislav Zavialov at 2023-06-16T18:30:17+02:00 Update test: DumpTypecheckedAst - - - - - e81a1c51 by Vladislav Zavialov at 2023-06-16T18:30:17+02:00 Update test: KindEqualities2 - - - - - 0bacf89e by Vladislav Zavialov at 2023-06-16T18:30:17+02:00 Update test: LevPolyBounded - - - - - df548617 by Vladislav Zavialov at 2023-06-16T18:30:17+02:00 Update test: RaeBlogPost - - - - - 19339880 by Vladislav Zavialov at 2023-06-16T18:30:17+02:00 Update test: RaeJobTalk - - - - - c4e9bf64 by Vladislav Zavialov at 2023-06-16T18:30:17+02:00 Update test: SplitWD - - - - - a5848086 by Vladislav Zavialov at 2023-06-16T18:30:17+02:00 Update test: T10670a - - - - - c3ee9b4f by Vladislav Zavialov at 2023-06-16T18:30:17+02:00 Update test: T10997_1a - - - - - 68934791 by Vladislav Zavialov at 2023-06-16T18:30:17+02:00 Update test: T11362 - - - - - 82433fe9 by Vladislav Zavialov at 2023-06-16T18:30:17+02:00 Update test: T11480a - - - - - 6546ac2d by Vladislav Zavialov at 2023-06-16T18:30:17+02:00 Update test: T11480b - - - - - 762833e9 by Vladislav Zavialov at 2023-06-16T18:30:17+02:00 Update test: T11520 - - - - - e997409c by Vladislav Zavialov at 2023-06-16T18:30:17+02:00 Update test: T11523 - - - - - cd4930f7 by Vladislav Zavialov at 2023-06-16T18:30:17+02:00 Update test: T11524 - - - - - 4f59915a by Vladislav Zavialov at 2023-06-16T18:30:17+02:00 Update test: T11711 - - - - - 9187fa9b by Vladislav Zavialov at 2023-06-16T18:30:17+02:00 Update test: T11811 - - - - - de21777f by Vladislav Zavialov at 2023-06-16T18:30:17+02:00 Update test: T12045TH1 - - - - - f8cb20e6 by Vladislav Zavialov at 2023-06-16T18:30:17+02:00 Update test: T12045TH1 - - - - - 06f07595 by Vladislav Zavialov at 2023-06-16T18:30:17+02:00 Update test: T12045TH2 - - - - - 782acd78 by Vladislav Zavialov at 2023-06-16T18:30:17+02:00 Update test: T12055 - - - - - 23327a9a by Vladislav Zavialov at 2023-06-16T18:30:17+02:00 Update test: T12055a - - - - - 4cb222f8 by Vladislav Zavialov at 2023-06-16T18:30:17+02:00 Update test: T12442 - - - - - 93adb421 by Vladislav Zavialov at 2023-06-16T18:30:17+02:00 Update test: T12646 - - - - - d5948676 by Vladislav Zavialov at 2023-06-16T18:30:17+02:00 Update test: T12698 - - - - - 0f049809 by Vladislav Zavialov at 2023-06-16T18:30:17+02:00 Update test: T12785b - - - - - 83366a44 by Vladislav Zavialov at 2023-06-16T18:30:17+02:00 Update test: T12698 - - - - - d4ccb9c2 by Vladislav Zavialov at 2023-06-16T18:30:17+02:00 Update test: T12919 - - - - - f464558e by Vladislav Zavialov at 2023-06-16T18:30:17+02:00 Update test: T13333 - - - - - 3ccba916 by Vladislav Zavialov at 2023-06-16T18:30:17+02:00 Update test: T13601 - - - - - 7c406fcc by Vladislav Zavialov at 2023-06-16T18:31:25+02:00 Update test: T13780c - - - - - a59ef1ec by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T13822 - - - - - 22f8d89a by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T13879 - - - - - cd0c7c89 by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T14066a - - - - - e6d3ad57 by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T14246 - - - - - f2e521cb by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T14253 - - - - - 3f9a0302 by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T14270 - - - - - ed232651 by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T14270a - - - - - 617651e8 by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T14366 - - - - - fc79b8df by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T14450 - - - - - c7d138eb by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T14451 - - - - - 224011df by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T14507 - - - - - 62eadc57 by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T14554 - - - - - a1d22b34 by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T14556 - - - - - fee21fda by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T14749 - - - - - 76f16ae0 by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T14904a - - - - - 650f8b15 by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T15079 - - - - - 166c65c5 by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T15122 - - - - - d0cc3748 by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T15243 - - - - - 2677f4e8 by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T15352 - - - - - 9a9d66ba by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T15380 - - - - - 103e9c40 by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T15552 - - - - - afdb0524 by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T15694 - - - - - 5b16d5fe by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T15695 - - - - - 720c6180 by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T15787 - - - - - 566fd559 by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T16244 - - - - - e1cbd20e by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T16245 - - - - - e13c9225 by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T16245a - - - - - 4083dde7 by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T16255 - - - - - 2ce978c6 by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T16326_Compile1 - - - - - 787a1616 by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T16356_Compile1 - - - - - 1869333b by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T16979b - - - - - 039b8cbd by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T17008b - - - - - 1167980b by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T17841 - - - - - c556a34f by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T18308 - - - - - 8d5e19b4 by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T19564d - - - - - bd1d8881 by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T20916 - - - - - 83315b10 by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T22560d - - - - - 892aeba7 by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T6018 - - - - - ecc24f88 by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T6137 - - - - - 4fa323a7 by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T7053 - - - - - deddd61a by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T7053a - - - - - 8e0e9b99 by Vladislav Zavialov at 2023-06-16T18:31:27+02:00 Update test: T7224 - - - - - 9e522970 by Vladislav Zavialov at 2023-06-16T18:31:28+02:00 Update test: T7503a - - - - - 8f3373d8 by Vladislav Zavialov at 2023-06-16T18:31:28+02:00 Update test: T7939 - - - - - 736a1f5e by Vladislav Zavialov at 2023-06-16T18:31:28+02:00 Update test: T9151 - - - - - 8b417fb4 by Vladislav Zavialov at 2023-06-16T18:31:28+02:00 Update test: T9200 - - - - - 214c15d8 by Vladislav Zavialov at 2023-06-16T18:31:28+02:00 Update test: T9201 - - - - - 56ea66ae by Vladislav Zavialov at 2023-06-16T18:31:28+02:00 Update test: TypeLevelVec - - - - - 726aaccf by Vladislav Zavialov at 2023-06-16T18:31:28+02:00 Update test: dynamic-paper - - - - - c79ae43b by Vladislav Zavialov at 2023-06-16T18:31:28+02:00 Update test: mkGADTVars - - - - - 88506e7c by Vladislav Zavialov at 2023-06-16T18:31:28+02:00 Update test: tcfail225 - - - - - 20 changed files: - − .appveyor.sh - + .editorconfig - .ghcid - + .git-ignore-revs - .gitattributes - .gitignore - .gitlab-ci.yml - + .gitlab/ci.sh - + .gitlab/common.sh - − .gitlab/darwin-init.sh - + .gitlab/darwin/nix/sources.json - + .gitlab/darwin/nix/sources.nix - + .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/issue_templates/feature_request.md The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8a85b4b0cc7643637d3b32a72a9775664d1ebdec...88506e7c294a5720b623778d4a9491a34e68e062 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8a85b4b0cc7643637d3b32a72a9775664d1ebdec...88506e7c294a5720b623778d4a9491a34e68e062 You're receiving 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 Jun 16 18:15:21 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Fri, 16 Jun 2023 14:15:21 -0400 Subject: [Git][ghc/ghc][wip/forall-vis-coercions] Equality of forall-types is visiblity aware Message-ID: <648ca6b9981f7_27146629a31b4911d8@gitlab.mail> Vladislav Zavialov pushed to branch wip/forall-vis-coercions at Glasgow Haskell Compiler / GHC Commits: bc25bdc6 by Matthew Craven at 2023-06-16T20:14:54+02:00 Equality of forall-types is visiblity aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [Forall coercions] in GHC.Core.TyCo.Rep - - - - - 30 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Iface/Rename.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Solver/Equality.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Types/Var.hs - testsuite/tests/cpranal/should_compile/T18174.stderr - testsuite/tests/cpranal/should_compile/T18401.stderr - testsuite/tests/pmcheck/should_compile/T11195.hs - testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr - testsuite/tests/simplCore/should_compile/T8331.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bc25bdc6b3224efd2f67005ed62f584324406da0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bc25bdc6b3224efd2f67005ed62f584324406da0 You're receiving 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 Jun 16 18:39:10 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Fri, 16 Jun 2023 14:39:10 -0400 Subject: [Git][ghc/ghc][wip/expand-do] - addStmtCtxt to add the right statement context in the error contexts Message-ID: <648cac4eedaf3_2714662632980985cf@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 29e94981 by Apoorv Ingle at 2023-06-16T13:38:03-05:00 - addStmtCtxt to add the right statement context in the error contexts - expansion stmt to span over bind/>>= application and pattern rather than only the arguments - - - - - 6 changed files: - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Types/Origin.hs Changes: ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -865,8 +865,7 @@ warnUnusedBindValue fun arg@(L loc _) arg_ty , text "arg" <+> ppr arg , text "arg_loc" <+> ppr loc ]) - when (isGeneratedSrcSpan l || isNoSrcSpan l -- it is compiler generated (>>) - ) $ + when (isGeneratedSrcSpan l) $ -- it is compiler generated (>>) putSrcSpanDs (locA loc) $ warnDiscardedDoBindings arg arg_ty where -- Retrieve the location info and the head of the application ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -344,7 +344,8 @@ tcApp rn_expr exp_res_ty ; app_res_rho <- if do_ql then quickLookResultType delta app_res_rho exp_res_ty else return app_res_rho - ; traceTc "tcApp1" empty + ; traceTc "tcApp1" (vcat [ text "tc_fun" <+> ppr tc_fun + , text "fun_sigma" <+> ppr fun_sigma ]) -- Unify with expected type from the context -- See Note [Unify with expected type before typechecking arguments] -- @@ -353,11 +354,13 @@ tcApp rn_expr exp_res_ty -- the source program; it was added by the renamer. See -- Note [Handling overloaded and rebindable constructs] in GHC.Rename.Expr ; let perhaps_add_res_ty_ctxt thing_inside - | insideExpansion fun_ctxt - = addHeadCtxt' fun_ctxt thing_inside + | insideExpansion fun_ctxt || isGeneratedSrcSpan (appCtxtLoc fun_ctxt) + = do traceTc "insideExpansion" (vcat [ppr rn_fun, ppr fun_ctxt]) + addHeadCtxt fun_ctxt thing_inside | otherwise - = addFunResCtxt rn_fun rn_args app_res_rho exp_res_ty $ - thing_inside + = do traceTc "no expansion" (ppr rn_fun) + addFunResCtxt rn_fun rn_args app_res_rho exp_res_ty $ + thing_inside -- Match up app_res_rho: the result type of rn_expr -- with exp_res_ty: the expected result type @@ -531,7 +534,8 @@ tcInstFun :: Bool -- True <=> Do quick-look -- modification in Fig 5, of the QL paper: -- "A quick look at impredicativity" (ICFP'20). tcInstFun do_ql inst_final (rn_fun, fun_ctxt) fun_sigma rn_args - = do { traceTc "tcInstFun" (vcat [ ppr rn_fun, ppr fun_sigma + = do { traceTc "tcInstFun" (vcat [ ppr rn_fun, ppr fun_sigma, ppr fun_orig + , text "fun_ctxt" <+> ppr fun_ctxt , text "args:" <+> ppr rn_args , text "do_ql" <+> ppr do_ql ]) ; go emptyVarSet [] [] fun_sigma rn_args } @@ -593,7 +597,7 @@ tcInstFun do_ql inst_final (rn_fun, fun_ctxt) fun_sigma rn_args -- 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 $ + = do { (inst_tvs, wrap, fun_rho) <- addHeadCtxt fun_ctxt $ instantiateSigma fun_orig tvs theta body2 -- addHeadCtxt: important for the class constraints -- that may be emitted from instantiating fun_sigma @@ -695,18 +699,35 @@ addArgCtxt :: AppCtxt -> LHsExpr GhcRn --- See Note [Rebindable syntax and HsExpansion] in GHC.Hs.Expr addArgCtxt ctxt (L arg_loc arg) thing_inside = do { in_generated_code <- inGeneratedCode + ; let in_src_ctxt = isGoodSrcSpan (appCtxtLoc ctxt) + ; traceTc "addArgCtxt" (vcat [ text "ctxt" <+> ppr ctxt + , text "arg" <+> ppr arg + , text "arg_loc" <+> ppr arg_loc + , text "is src ctxt" <+> ppr in_src_ctxt + , text "is generated code" <+> ppr in_generated_code + , text "is then" <+> ppr (is_then_fun (appCtxtExpr ctxt)) ]) ; case ctxt of - VACall fun arg_no _ | not in_generated_code + VACall fun _ _ | not in_src_ctxt + , is_then_fun fun || is_bind_fun fun + -> thing_inside -- do not do anything in case of expanded (>>) + -- TODO: this behaviour is not quite right + -- user written (>>)/(>>=) are infix and then 'expanded' to be prefix + VACall fun arg_no _ | not in_generated_code || not (is_then_fun fun || is_bind_fun fun) -> setSrcSpanA arg_loc $ addErrCtxt (funAppCtxt fun arg arg_no) $ thing_inside - VAExpansion _ _ | XExpr (PopSrcSpan (L loc (XExpr (ExpandedStmt (HsExpanded stmt _))))) <- arg - -> setSrcSpanA loc $ - addErrCtxt (pprStmtInCtxt @Renamed @Renamed @Renamed (HsDoStmt (DoExpr Nothing)) (unLoc stmt)) $ - thing_inside _ -> setSrcSpanA arg_loc $ addExprCtxt arg $ -- Auto-suppressed if arg_loc is generated thing_inside } + where + is_then_fun :: HsExpr GhcRn -> Bool + is_then_fun (HsVar _ (L _ f)) = f `hasKey` thenMClassOpKey + is_then_fun _ = False + + is_bind_fun :: HsExpr GhcRn -> Bool + is_bind_fun (HsVar _ (L _ f)) = f `hasKey` bindMClassOpKey + is_bind_fun _ = False + {- ********************************************************************* * * ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -209,16 +209,17 @@ tcExpr e@(ExprWithTySig {}) res_ty = tcApp e res_ty tcExpr e@(HsRecSel {}) res_ty = tcApp e res_ty tcExpr e@(XExpr (ExpandedExpr {})) res_ty = tcApp e res_ty -tcExpr (XExpr (PopSrcSpan e)) res_ty - = do popErrCtxt $ tcExpr (unLoc e) res_ty -- needs to do more intelligent popping +tcExpr (XExpr (PopSrcSpan (L _ e))) res_ty + = do traceTc "tcExpr" (text "PopSrcSpan") + popErrCtxt $ tcExpr e res_ty -tcExpr (XExpr (ExpandedStmt (HsExpanded stmt expr))) res_ty +tcExpr (XExpr (ExpandedStmt (HsExpanded stmt@(L loc _) (L _ e)))) res_ty = do { traceTc "tcDoStmts" (vcat [ text "stmt:" <+> ppr stmt - , text "expr:" <+> ppr expr + , text "expr:" <+> ppr e , text "res_ty:" <+> ppr res_ty ]) - ; addErrCtxt (pprStmtInCtxt @Renamed @Renamed @Renamed (HsDoStmt (DoExpr Nothing)) (unLoc stmt)) $ - tcExpr (unLoc expr) res_ty + ; setSrcSpanA loc $ + addStmtCtxt stmt $ tcExpr e res_ty } @@ -428,21 +429,21 @@ tcExpr (HsMultiIf _ alts) res_ty where match_ctxt = MC { mc_what = IfAlt, mc_body = tcBody } tcExpr hsDo@(HsDo _ doFlav@(DoExpr{}) (L _ stmts)) res_ty - = do { expand_expr <- expandDoStmts doFlav stmts + = do { expanded_expr <- expandDoStmts doFlav stmts -- Do expansion on the fly - ; let expanded_do_expr = mkExpandedExpr hsDo (unLoc expand_expr) + ; let expanded_do_expr = mkExpandedExpr hsDo (unLoc expanded_expr) ; traceTc "tcDoStmts " (vcat [ text "hsDo:" <+> ppr hsDo - , text "expr:" <+> ppr expand_expr + , text "expr:" <+> ppr expanded_expr ]) ; tcExpr expanded_do_expr res_ty } tcExpr hsDo@(HsDo _ doFlav@(MDoExpr{}) (L _ stmts)) res_ty - = do { expand_expr <- expandDoStmts doFlav stmts + = do { expanded_expr <- expandDoStmts doFlav stmts -- Do expansion on the fly - ; let expanded_do_expr = mkExpandedExpr hsDo (unLoc expand_expr) + ; let expanded_do_expr = mkExpandedExpr hsDo (unLoc expanded_expr) ; traceTc "tcDoStmts " (vcat [ text "hsDo:" <+> ppr hsDo - , text "expr:" <+> ppr expand_expr + , text "expr:" <+> ppr expanded_expr ]) ; tcExpr expanded_do_expr res_ty } ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -18,7 +18,7 @@ module GHC.Tc.Gen.Head ( HsExprArg(..), EValArg(..), TcPass(..) - , AppCtxt(..), appCtxtLoc, insideExpansion + , AppCtxt(..), appCtxtLoc, appCtxtExpr, insideExpansion , splitHsApps, rebuildHsApps , addArgWrap, isHsValArg , countLeadingValArgs, isVisibleArg, pprHsExprArgTc @@ -30,7 +30,7 @@ module GHC.Tc.Gen.Head , tyConOf, tyConOfET, fieldNotInType , nonBidirectionalErr - , addHeadCtxt, addHeadCtxt', addExprCtxt, addFunResCtxt ) where + , addHeadCtxt, addExprCtxt, addStmtCtxt, addFunResCtxt ) where import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcExpr, tcCheckMonoExprNC, tcCheckPolyExprNC ) @@ -245,6 +245,10 @@ appCtxtLoc :: AppCtxt -> SrcSpan appCtxtLoc (VAExpansion _ l) = l appCtxtLoc (VACall _ _ l) = l +appCtxtExpr :: AppCtxt -> HsExpr GhcRn +appCtxtExpr (VAExpansion e _) = e +appCtxtExpr (VACall e _ _) = e + insideExpansion :: AppCtxt -> Bool insideExpansion (VAExpansion {}) = True insideExpansion (VACall {}) = False @@ -766,7 +770,7 @@ tcInferAppHead :: (HsExpr GhcRn, AppCtxt) -- -- See Note [tcApp: typechecking applications] in GHC.Tc.Gen.App tcInferAppHead (fun,ctxt) args - = addHeadCtxt' ctxt $ + = addHeadCtxt ctxt $ do { mb_tc_fun <- tcInferAppHead_maybe fun args ; case mb_tc_fun of Just (fun', fun_sigma) -> return (fun', fun_sigma) @@ -785,35 +789,21 @@ tcInferAppHead_maybe fun args HsOverLit _ lit -> Just <$> tcInferOverLit lit HsUntypedSplice (HsUntypedSpliceTop _ e) _ -> tcInferAppHead_maybe e args - XExpr (PopSrcSpan e) -> tcInferAppHead_maybe (unLoc e) args - XExpr (ExpandedStmt (HsExpanded _ e)) -> tcInferAppHead_maybe (unLoc e) args + -- XExpr (PopSrcSpan e) -> tcInferAppHead_maybe (unLoc e) args + -- XExpr (ExpandedStmt (HsExpanded _ e)) -> tcInferAppHead_maybe (unLoc e) args _ -> return Nothing addHeadCtxt :: AppCtxt -> TcM a -> TcM a addHeadCtxt fun_ctxt thing_inside | not (isGoodSrcSpan fun_loc) -- noSrcSpan => no arguments - = thing_inside -- => context is already set + = do traceTc "addHeadCtxt not good" (ppr fun_ctxt) + thing_inside -- => context is already set | otherwise = setSrcSpan fun_loc $ - case fun_ctxt of - VAExpansion orig _ -> addExprCtxt orig thing_inside - VACall {} -> thing_inside - where - fun_loc = appCtxtLoc fun_ctxt - -addHeadCtxt' :: AppCtxt -> TcM a -> TcM a -addHeadCtxt' fun_ctxt thing_inside - | VAExpansion (HsDo _ doFlav (L _ (L loc stmt: _))) _ <- fun_ctxt -- the context is a do block, but set it as the first statement to obtain a more precise location of the error. - = do setSrcSpan (locA loc) $ - addErrCtxt (pprStmtInCtxt @Renamed @Renamed @Renamed (HsDoStmt doFlav) stmt) $ - thing_inside - | not (isGoodSrcSpan fun_loc) -- noSrcSpan => no arguments - = thing_inside -- => context is already set - | otherwise - = setSrcSpan fun_loc $ - case fun_ctxt of - VAExpansion orig _ -> addExprCtxt orig thing_inside - VACall {} -> thing_inside + do traceTc "addHeadCtxt okay" (ppr fun_ctxt) + case fun_ctxt of + VAExpansion orig _ -> addExprCtxt orig thing_inside + VACall {} -> thing_inside where fun_loc = appCtxtLoc fun_ctxt @@ -1483,11 +1473,15 @@ mis-match in the number of value arguments. * * ********************************************************************* -} +addStmtCtxt :: ExprLStmt GhcRn -> TcRn a -> TcRn a +addStmtCtxt stmt thing_inside + = addErrCtxt ({-text "tcDoStmts" <+> -} + pprStmtInCtxt @Renamed @Renamed @Renamed (HsDoStmt (DoExpr Nothing)) (unLoc stmt)) thing_inside + addExprCtxt :: HsExpr GhcRn -> TcRn a -> TcRn a addExprCtxt e thing_inside = case e of HsUnboundVar {} -> thing_inside - XExpr (ExpandedStmt _) -> thing_inside _ -> addErrCtxt (exprCtxt e) thing_inside -- The HsUnboundVar special case addresses situations like -- f x = _ ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1194,7 +1194,11 @@ genPopSrcSpanExpr = wrapGenSpan . mkPopSrcSpanExpr -- mkExpandedStmtLExpr a b = noLocA $ mkExpandedStmt a b expandDoStmts :: HsDoFlavour -> [ExprLStmt GhcRn] -> TcM (LHsExpr GhcRn) -expandDoStmts = expand_do_stmts +expandDoStmts doFlav stmts = do expanded_expr <- expand_do_stmts doFlav stmts + case expanded_expr of + L _ (XExpr (PopSrcSpan (L loc e))) -> return $ L loc e + _ -> return expanded_expr + -- | Expand the Do statments so that it works fine with Quicklook -- See Note[Rebindable Do and Expanding Statements] @@ -1213,12 +1217,12 @@ expand_do_stmts _ (stmt@(L _ (ParStmt {})):_) = -- See See Note [Monad Comprehensions] pprPanic "expand_do_stmts: ParStmt" $ ppr stmt -expand_do_stmts _ [stmt@(L loc (LastStmt _ body _ ret_expr))] +expand_do_stmts _ [stmt@(L _ (LastStmt _ body _ ret_expr))] -- last statement of a list comprehension, needs to explicitly return it -- See `checkLastStmt` and `Syntax.Expr.StmtLR.LastStmt` | NoSyntaxExprRn <- ret_expr -- Last statement is just body if we are not in ListComp context. See Syntax.Expr.LastStmt - = return $ L loc (mkExpandedStmt stmt body) + = return $ wrapGenSpan (mkExpandedStmt stmt body) | SyntaxExprRn ret <- ret_expr -- @@ -1228,14 +1232,14 @@ expand_do_stmts _ [stmt@(L loc (LastStmt _ body _ ret_expr))] = return $ wrapGenSpan (mkExpandedStmt stmt (genHsApp (wrapGenSpan ret) body)) -expand_do_stmts do_or_lc ((L _ (LetStmt _ bs)) : lstmts) = +expand_do_stmts do_or_lc (stmt@(L _ (LetStmt _ bs)) : lstmts) = -- stmts ~~> stmts' -- ------------------------------------------------ -- let x = e ; stmts ~~> let x = e in stmts' do expand_stmts <- expand_do_stmts do_or_lc lstmts - return $ genPopSrcSpanExpr (genHsLet bs expand_stmts) + return $ wrapGenSpan (mkExpandedStmt stmt (genHsLet bs $ genPopSrcSpanExpr expand_stmts)) -expand_do_stmts do_or_lc (stmt@(L loc (BindStmt xbsrn pat e)): lstmts) +expand_do_stmts do_or_lc (stmt@(L _ (BindStmt xbsrn pat e)): lstmts) | SyntaxExprRn bind_op <- xbsrn_bindOp xbsrn , fail_op <- xbsrn_failOp xbsrn = -- the pattern binding pat can fail @@ -1247,22 +1251,25 @@ expand_do_stmts do_or_lc (stmt@(L loc (BindStmt xbsrn pat e)): lstmts) do expand_stmts <- expand_do_stmts do_or_lc lstmts expr@(L l _) <- mk_failable_lexpr_tcm pat expand_stmts fail_op traceTc "expand_do_stmts" (vcat [ text "loc ex stmts" <+> ppr l]) - return $ (foldl genHsApp (wrapGenSpan bind_op) -- (>>=) - [ L loc (mkPopSrcSpanExpr $ L loc (mkExpandedStmt stmt e)) - , expr - ]) + return $ wrapGenSpan (mkPopSrcSpanExpr $ wrapGenSpan (mkExpandedStmt stmt ( + (wrapGenSpan bind_op) `genHsApp` e)) -- (>>=) + `genHsApp` + expr + ) | otherwise = pprPanic "expand do: shouldn't happen" (text "stmt" <+> ppr stmt) -expand_do_stmts do_or_lc (stmt@(L loc (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) = +expand_do_stmts do_or_lc (stmt@(L _ (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) = -- See Note [BodyStmt] -- stmts ~~> stmts' -- ---------------------------------------------- -- e ; stmts ~~> (>>) e stmts' do expand_stmts@(L l _) <- expand_do_stmts do_or_lc lstmts traceTc "expand_do_stmts" (vcat [ text "loc ex stmts" <+> ppr l]) - return $ (foldl genHsApp (wrapGenSpan f) -- (>>) - [ L loc (mkPopSrcSpanExpr $ L loc (mkExpandedStmt stmt e)) -- e - , expand_stmts ]) -- stmts' + return $ wrapGenSpan (mkPopSrcSpanExpr $ wrapGenSpan (mkExpandedStmt stmt ( + (wrapGenSpan f) -- (>>) + `genHsApp` e)) + `genHsApp` + expand_stmts) -- stmts' expand_do_stmts do_or_lc ((L do_loc (RecStmt { recS_stmts = L stmts_loc rec_stmts @@ -1287,7 +1294,7 @@ expand_do_stmts do_or_lc return $ mkHsApps (wrapGenSpan bind_fun) -- (>>=) [ (wrapGenSpan mfix_fun) `mkHsApp` mfix_expr -- (mfix (do block)) , genHsLamDoExp [ mkBigLHsVarPatTup all_ids ] -- (\ x -> - (genPopSrcSpanExpr expand_stmts) -- stmts') + ({-genPopSrcSpanExpr-} expand_stmts) -- stmts') ] where local_only_ids = local_ids \\ later_ids -- get unique local rec ids; ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -727,8 +727,8 @@ exprCtOrigin (HsUntypedSplice {}) = Shouldn'tHappenOrigin "TH untyped splice" exprCtOrigin (HsProc {}) = Shouldn'tHappenOrigin "proc" exprCtOrigin (HsStatic {}) = Shouldn'tHappenOrigin "static expression" exprCtOrigin (XExpr (ExpandedExpr (HsExpanded a _))) = exprCtOrigin a -exprCtOrigin (XExpr (ExpandedStmt _)) = DoOrigin -exprCtOrigin (XExpr (PopSrcSpan (L _ a))) = exprCtOrigin a +exprCtOrigin (XExpr (ExpandedStmt {})) = DoOrigin +exprCtOrigin (XExpr (PopSrcSpan {})) = Shouldn'tHappenOrigin "PopSrcSpan" -- | Extract a suitable CtOrigin from a MatchGroup matchesCtOrigin :: MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/29e949819f36a7a46daaecb61d56fe4f672f33da -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/29e949819f36a7a46daaecb61d56fe4f672f33da You're receiving 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 Jun 17 03:08:13 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 16 Jun 2023 23:08:13 -0400 Subject: [Git][ghc/ghc][master] 4 commits: Update documentation for `<**>` Message-ID: <648d239da02ae_27146631783bc131610@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 1 changed file: - libraries/base/GHC/Base.hs Changes: ===================================== libraries/base/GHC/Base.hs ===================================== @@ -806,11 +806,21 @@ class Functor f => Applicative f where (<*) :: f a -> f b -> f a (<*) = liftA2 const --- | A variant of '<*>' with the arguments reversed. +-- | A variant of '<*>' with the types of the arguments reversed. It differs from +-- @`flip` `(<*>)`@ in that the effects are resolved in the order the arguments are +-- presented. -- +-- ==== __Examples__ +-- >>> (<**>) (print 1) (id <$ print 2) +-- 1 +-- 2 +-- +-- >>> flip (<*>) (print 1) (id <$ print 2) +-- 2 +-- 1 + (<**>) :: Applicative f => f a -> f (a -> b) -> f b (<**>) = liftA2 (\a f -> f a) --- Don't use $ here, see the note at the top of the page -- | Lift a function to actions. -- Equivalent to Functor's `fmap` but implemented using only `Applicative`'s methods: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0baf9e7cfa5d0e76998c2a528693736a6317cf4c...7af99a0d2aac4a6caca73d7470c94881651457a2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0baf9e7cfa5d0e76998c2a528693736a6317cf4c...7af99a0d2aac4a6caca73d7470c94881651457a2 You're receiving 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 Jun 17 03:08:51 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 16 Jun 2023 23:08:51 -0400 Subject: [Git][ghc/ghc][master] Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) Message-ID: <648d23c3bfc5a_271466101bbd1c135544@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 15 changed files: - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - docs/users_guide/9.8.1-notes.rst - testsuite/tests/indexed-types/should_compile/T14131.hs - testsuite/tests/indexed-types/should_compile/T15852.hs - testsuite/tests/indexed-types/should_compile/T15852.stderr - testsuite/tests/indexed-types/should_fail/T14230.hs - testsuite/tests/indexed-types/should_fail/T7938.hs - testsuite/tests/indexed-types/should_fail/T7938.stderr - + testsuite/tests/rename/should_compile/T23512b.hs - testsuite/tests/rename/should_compile/all.T - + testsuite/tests/rename/should_fail/T23512a.hs - + testsuite/tests/rename/should_fail/T23512a.stderr - testsuite/tests/rename/should_fail/all.T - testsuite/tests/typecheck/should_fail/T15797.hs Changes: ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -1799,8 +1799,7 @@ one exists: a free variable 'a', which we implicitly quantify over. That is why we can also use it to the left of the double colon: 'Left a -The logic resides in extractHsTyRdrTyVarsKindVars. We use it both for type -synonyms and type family instances. +The logic resides in extractHsTyRdrTyVarsKindVars. This was a stopgap solution until we could explicitly bind invisible type/kind variables: ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -634,14 +634,10 @@ rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds rnFamEqn :: HsDocContext -> AssocTyFamInfo - -> FreeKiTyVars - -- ^ Additional kind variables to implicitly bind if there is no - -- explicit forall. (See the comments on @all_imp_vars@ below for a - -- more detailed explanation.) -> FamEqn GhcPs rhs -> (HsDocContext -> rhs -> RnM (rhs', FreeVars)) -> RnM (FamEqn GhcRn rhs', FreeVars) -rnFamEqn doc atfi extra_kvars +rnFamEqn doc atfi (FamEqn { feqn_tycon = tycon , feqn_bndrs = outer_bndrs , feqn_pats = pats @@ -652,19 +648,8 @@ rnFamEqn doc atfi extra_kvars -- all_imp_vars represent the implicitly bound type variables. This is -- empty if we have an explicit `forall` (see -- Note [forall-or-nothing rule] in GHC.Hs.Type), which means - -- ignoring: - -- - -- - pat_kity_vars, the free variables mentioned in the type patterns - -- on the LHS of the equation, and - -- - extra_kvars, which is one of the following: - -- * For type family instances, extra_kvars are the free kind - -- variables mentioned in an outermost kind signature on the RHS - -- of the equation. - -- (See Note [Implicit quantification in type synonyms] in - -- GHC.Rename.HsType.) - -- * For data family instances, extra_kvars are the free kind - -- variables mentioned in the explicit return kind, if one is - -- provided. (e.g., the `k` in `data instance T :: k -> Type`). + -- ignoring pat_kity_vars, the free variables mentioned in the type patterns + -- on the LHS of the equation -- -- Some examples: -- @@ -678,8 +663,6 @@ rnFamEqn doc atfi extra_kvars -- type family G :: Maybe a -- type instance forall a. G = (Nothing :: Maybe a) -- -- all_imp_vars = [] - -- type instance G = (Nothing :: Maybe a) - -- -- all_imp_vars = [a] -- -- data family H :: k -> Type -- data instance forall k. H :: k -> Type where ... @@ -690,7 +673,7 @@ rnFamEqn doc atfi extra_kvars -- -- For associated type family instances, exclude the type variables -- bound by the instance head with filterInScopeM (#19649). - ; all_imp_vars <- filterInScopeM $ pat_kity_vars ++ extra_kvars + ; all_imp_vars <- filterInScopeM $ pat_kity_vars ; bindHsOuterTyVarBndrs doc mb_cls all_imp_vars outer_bndrs $ \rn_outer_bndrs -> do { (pats', pat_fvs) <- rnLHsTypeArgs (FamPatCtx tycon) pats @@ -727,21 +710,12 @@ rnFamEqn doc atfi extra_kvars -- associated family instance but not bound on the LHS, then reject -- that type variable as being out of scope. -- See Note [Renaming associated types]. - -- Per that Note, the LHS type variables consist of: - -- - -- - The variables mentioned in the instance's type patterns - -- (pat_fvs), and - -- - -- - The variables mentioned in an outermost kind signature on the - -- RHS. This is a subset of `rhs_fvs`. To compute it, we look up - -- each RdrName in `extra_kvars` to find its corresponding Name in - -- the LocalRdrEnv. - ; extra_kvar_nms <- mapMaybeM (lookupLocalOccRn_maybe . unLoc) extra_kvars - ; let lhs_bound_vars = pat_fvs `extendNameSetList` extra_kvar_nms - improperly_scoped cls_tkv = + -- Per that Note, the LHS type variables consist of the variables + -- mentioned in the instance's type patterns (pat_fvs) + ; let improperly_scoped cls_tkv = cls_tkv `elemNameSet` rhs_fvs -- Mentioned on the RHS... - && not (cls_tkv `elemNameSet` lhs_bound_vars) + && not (cls_tkv `elemNameSet` pat_fvs) -- ...but not bound on the LHS. bad_tvs = filter improperly_scoped inst_head_tvs ; unless (null bad_tvs) (addErr (TcRnBadAssocRhs bad_tvs)) @@ -786,7 +760,7 @@ rnFamEqn doc atfi extra_kvars -- -- type instance F a b c = Either a b -- ^^^^^ - lhs_loc = case map lhsTypeArgSrcSpan pats ++ map getLocA extra_kvars of + lhs_loc = case map lhsTypeArgSrcSpan pats of [] -> panic "rnFamEqn.lhs_loc" [loc] -> loc (loc:locs) -> loc `combineSrcSpans` last locs @@ -845,10 +819,9 @@ data ClosedTyFamInfo rnTyFamInstEqn :: AssocTyFamInfo -> TyFamInstEqn GhcPs -> RnM (TyFamInstEqn GhcRn, FreeVars) -rnTyFamInstEqn atfi eqn@(FamEqn { feqn_tycon = tycon, feqn_rhs = rhs }) - = rnFamEqn (TySynCtx tycon) atfi extra_kvs eqn rnTySyn - where - extra_kvs = extractHsTyRdrTyVarsKindVars rhs +rnTyFamInstEqn atfi eqn@(FamEqn { feqn_tycon = tycon }) + = rnFamEqn (TySynCtx tycon) atfi eqn rnTySyn + rnTyFamDefltDecl :: Name -> TyFamDefltDecl GhcPs @@ -859,11 +832,9 @@ rnDataFamInstDecl :: AssocTyFamInfo -> DataFamInstDecl GhcPs -> RnM (DataFamInstDecl GhcRn, FreeVars) rnDataFamInstDecl atfi (DataFamInstDecl { dfid_eqn = - eqn@(FamEqn { feqn_tycon = tycon - , feqn_rhs = rhs })}) - = do { let extra_kvs = extractDataDefnKindVars rhs - ; (eqn', fvs) <- - rnFamEqn (TyDataCtx tycon) atfi extra_kvs eqn rnDataDefn + eqn@(FamEqn { feqn_tycon = tycon })}) + = do { (eqn', fvs) <- + rnFamEqn (TyDataCtx tycon) atfi eqn rnDataDefn ; return (DataFamInstDecl { dfid_eqn = eqn' }, fvs) } -- Renaming of the associated types in instances. @@ -949,10 +920,7 @@ a class, we must check that all of the type variables mentioned on the RHS are properly scoped. Specifically, the rule is this: Every variable mentioned on the RHS of a type instance declaration - (whether associated or not) must be either - * Mentioned on the LHS, or - * Mentioned in an outermost kind signature on the RHS - (see Note [Implicit quantification in type synonyms]) + (whether associated or not) must be mentioned on the LHS Here is a simple example of something we should reject: @@ -962,8 +930,7 @@ Here is a simple example of something we should reject: type F Int x = z Here, `z` is mentioned on the RHS of the associated instance without being -mentioned on the LHS, nor is `z` mentioned in an outermost kind signature. The -renamer will reject `z` as being out of scope without much fuss. +mentioned on the LHS. The renamer will reject `z` as being out of scope without much fuss. Things get slightly trickier when the instance header itself binds type variables. Consider this example (adapted from #5515): @@ -1055,10 +1022,8 @@ Some additional wrinkles: Note that the `o` in the `Codomain 'KProxy` instance should be considered improperly scoped. It does not meet the criteria for being explicitly - quantified, as it is not mentioned by name on the LHS, nor does it meet the - criteria for being implicitly quantified, as it is used in a RHS kind - signature that is not outermost (see Note [Implicit quantification in type - synonyms]). However, `o` /is/ bound by the instance header, so if this + quantified, as it is not mentioned by name on the LHS. + However, `o` /is/ bound by the instance header, so if this program is not rejected by the renamer, the typechecker would treat it as though you had written this: @@ -1070,6 +1035,12 @@ Some additional wrinkles: If the user really wants the latter, it is simple enough to communicate their intent by mentioning `o` on the LHS by name. +* Historical note: Previously we had to add type variables from the outermost + kind signature on the RHS to the scope of associated type family instance, + i.e. GHC did implicit quantification over them. But now that we implement + GHC Proposal #425 "Invisible binders in type declarations" + we don't need to do this anymore. + Note [Type family equations and occurrences] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In most data/type family equations, the type family name used in the equation ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -19,6 +19,22 @@ Language This feature is guarded behind :extension:`TypeAbstractions`. +- In accordance with GHC proposal `#425 + `_ + GHC no longer implicitly quantifies over type variables that appear only in the RHS of type and + data family instances. This code will no longer work: :: + + type family F1 a :: k + type instance F1 Int = Any :: j -> j + + Instead you should write:: + + type instance F1 @(j -> j) Int = Any :: j -> j + + Or:: + + type instance forall j . F1 Int = Any :: j -> j + Compiler ~~~~~~~~ ===================================== testsuite/tests/indexed-types/should_compile/T14131.hs ===================================== @@ -9,21 +9,21 @@ import Data.Kind import Data.Proxy data family Nat :: k -> k -> Type -newtype instance Nat :: (k -> Type) -> (k -> Type) -> Type where +newtype instance Nat :: forall k . (k -> Type) -> (k -> Type) -> Type where Nat :: (forall xx. f xx -> g xx) -> Nat f g type family F :: Maybe a -type instance F = (Nothing :: Maybe a) +type instance F @a = (Nothing :: Maybe a) class C k where data CD :: k -> k -> Type type CT :: k instance C (Maybe a) where - data CD :: Maybe a -> Maybe a -> Type where + data CD @(Maybe a) :: Maybe a -> Maybe a -> Type where CD :: forall a (m :: Maybe a) (n :: Maybe a). Proxy m -> Proxy n -> CD m n - type CT = (Nothing :: Maybe a) + type CT @(Maybe a) = (Nothing :: Maybe a) class Z k where type ZT :: Maybe k - type ZT = (Nothing :: Maybe k) + type ZT @k = (Nothing :: Maybe k) ===================================== testsuite/tests/indexed-types/should_compile/T15852.hs ===================================== @@ -7,4 +7,4 @@ import Data.Kind import Data.Proxy data family DF a (b :: k) -data instance DF (Proxy c) :: Proxy j -> Type +data instance DF @(Proxy j) (Proxy c) :: Proxy j -> Type ===================================== testsuite/tests/indexed-types/should_compile/T15852.stderr ===================================== @@ -3,10 +3,10 @@ TYPE CONSTRUCTORS roles nominal nominal nominal COERCION AXIOMS axiom T15852.D:R:DFProxyProxy0 :: - forall k1 k2 (c :: k1) (j :: k2). - DF (Proxy c) = T15852.R:DFProxyProxy k1 k2 c j + forall k1 k2 (j :: k1) (c :: k2). + DF (Proxy c) = T15852.R:DFProxyProxy k1 k2 j c FAMILY INSTANCES - data instance forall {k1} {k2} {c :: k1} {j :: k2}. + data instance forall {k1} {k2} {j :: k1} {c :: k2}. DF (Proxy c) -- Defined at T15852.hs:10:15 Dependent modules: [] -Dependent packages: [base-4.17.0.0] +Dependent packages: [base-4.18.0.0] ===================================== testsuite/tests/indexed-types/should_fail/T14230.hs ===================================== @@ -8,4 +8,4 @@ class C k where data CD :: k -> k -> * instance C (Maybe a) where - data CD :: (k -> *) -> (k -> *) -> * + data forall k . CD :: (k -> *) -> (k -> *) -> * ===================================== testsuite/tests/indexed-types/should_fail/T7938.hs ===================================== @@ -9,4 +9,4 @@ class Foo (a :: k1) (b :: k2) where type Bar a instance Foo (a :: k1) (b :: k2) where - type Bar a = (KP :: KProxy k2) + type forall k2 . Bar a = (KP :: KProxy k2) ===================================== testsuite/tests/indexed-types/should_fail/T7938.stderr ===================================== @@ -1,5 +1,5 @@ -T7938.hs:12:17: error: [GHC-83865] +T7938.hs:12:29: error: [GHC-83865] • Expected a type, but ‘KP :: KProxy k2’ has kind ‘KProxy k2’ • In the type ‘(KP :: KProxy k2)’ In the type instance declaration for ‘Bar’ ===================================== testsuite/tests/rename/should_compile/T23512b.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies, TypeAbstractions #-} +module T23512b where +import GHC.Types + +type family F2 a :: k +type instance F2 @(j -> j) Int = Any :: j -> j + +type family F3 a :: k +type instance forall j. F3 Int = Any :: j -> j ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -213,3 +213,4 @@ test('T23240', [req_th, extra_files(['T23240_aux.hs'])], multimod_compile, ['T23 test('T23318', normal, compile, ['-Wduplicate-exports']) test('T23434', normal, compile, ['']) test('T23510b', normal, compile, ['']) +test('T23512b', normal, compile, ['']) ===================================== testsuite/tests/rename/should_fail/T23512a.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies #-} +module T23512a where +import GHC.Types + +type family F1 a :: k +type instance F1 Int = Any :: j -> j + +data family D :: k -> Type +data instance D :: k -> Type ===================================== testsuite/tests/rename/should_fail/T23512a.stderr ===================================== @@ -0,0 +1,6 @@ + +T23512a.hs:6:31: error: [GHC-76037] Not in scope: type variable ‘j’ + +T23512a.hs:6:36: error: [GHC-76037] Not in scope: type variable ‘j’ + +T23512a.hs:9:20: error: [GHC-76037] Not in scope: type variable ‘k’ ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -203,3 +203,4 @@ test('T23510a', normal, compile_fail, ['']) test('T16635a', normal, compile_fail, ['']) test('T16635b', normal, compile_fail, ['']) test('T16635c', normal, compile_fail, ['']) +test('T23512a', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/T15797.hs ===================================== @@ -13,7 +13,7 @@ import Data.Kind class Ríki (obj :: Type) where type Obj :: obj -> Constraint - type Obj = Bæ @k :: k -> Constraint + type forall k . Obj = Bæ @k :: k -> Constraint class Bæ (a :: k) instance Bæ @k (a :: k) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/800aad7ea83e6b56798a953511acbd336af3f253 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/800aad7ea83e6b56798a953511acbd336af3f253 You're receiving 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 Jun 17 08:13:18 2023 From: gitlab at gitlab.haskell.org (=?UTF-8?B?R2VyZ8WRIMOJcmRpIChAY2FjdHVzKQ==?=) Date: Sat, 17 Jun 2023 04:13:18 -0400 Subject: [Git][ghc/ghc][wip/issue-23516] Add `IfaceWarnings` to represent the `ModIface`-storable parts Message-ID: <648d6b1ec0ec6_27146610c450d0173074@gitlab.mail> Gergő Érdi pushed to branch wip/issue-23516 at Glasgow Haskell Compiler / GHC Commits: 17cde3fa by Gergő Érdi at 2023-06-17T16:12:55+08:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 8 changed files: - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Types/SourceText.hs - compiler/GHC/Unit/Module/ModIface.hs - compiler/GHC/Unit/Module/Warnings.hs Changes: ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -102,7 +102,6 @@ import GHC.Types.PkgQual import GHC.Unit.External import GHC.Unit.Module -import GHC.Unit.Module.Warnings import GHC.Unit.Module.ModIface import GHC.Unit.Module.Deps import GHC.Unit.State @@ -1206,16 +1205,6 @@ pprTrustInfo trust = text "trusted:" <+> ppr trust pprTrustPkg :: Bool -> SDoc pprTrustPkg tpkg = text "require own pkg trusted:" <+> ppr tpkg -instance Outputable (Warnings pass) where - ppr = pprWarns - -pprWarns :: Warnings pass -> SDoc -pprWarns NoWarnings = Outputable.empty -pprWarns (WarnAll txt) = text "Warn all" <+> ppr txt -pprWarns (WarnSome prs) = text "Warnings:" - <+> vcat (map pprWarning prs) - where pprWarning (name, txt) = ppr name <+> ppr txt - pprIfaceAnnotation :: IfaceAnnotation -> SDoc pprIfaceAnnotation (IfaceAnnotation { ifAnnotatedTarget = target, ifAnnotatedValue = serialized }) = ppr target <+> text "annotated by" <+> ppr serialized ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -66,6 +66,8 @@ import GHC.Types.SourceFile import GHC.Types.TyThing import GHC.Types.HpcInfo import GHC.Types.CompleteMatch +import GHC.Types.SourceText +import GHC.Types.SrcLoc ( unLoc ) import GHC.Utils.Outputable import GHC.Utils.Panic @@ -291,7 +293,7 @@ mkIface_ hsc_env -- The order of fixities returned from nonDetNameEnvElts is not -- deterministic, so we sort by OccName to canonicalize it. -- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM for more details. - warns = src_warns + warns = toIfaceWarnings src_warns iface_rules = map coreRuleToIfaceRule rules iface_insts = map instanceToIfaceInst $ fixSafeInstances safe_mode (instEnvElts insts) iface_fam_insts = map famInstToIfaceFamInst fam_insts @@ -393,6 +395,21 @@ ifaceRoughMatchTcs tcs = map do_rough tcs do_rough (RM_KnownTc n) = Just (toIfaceTyCon_name n) -------------------------- +toIfaceWarnings :: Warnings GhcRn -> IfaceWarnings +toIfaceWarnings NoWarnings = IfNoWarnings +toIfaceWarnings (WarnAll txt) = IfWarnAll (toIfaceWarningTxt txt) +toIfaceWarnings (WarnSome prs) = IfWarnSome [(occ, toIfaceWarningTxt txt) | (occ, txt) <- prs] + +toIfaceWarningTxt :: WarningTxt GhcRn -> IfaceWarningTxt +toIfaceWarningTxt (WarningTxt mb_cat src strs) = IfWarningTxt (unLoc <$> mb_cat) (unLoc src) (map (toIfaceStringLiteralWithNames . unLoc) strs) +toIfaceWarningTxt (DeprecatedTxt src strs) = IfDeprecatedTxt (unLoc src) (map (toIfaceStringLiteralWithNames . unLoc) strs) + +toIfaceStringLiteralWithNames :: WithHsDocIdentifiers StringLiteral GhcRn -> (IfaceStringLiteral, [IfExtName]) +toIfaceStringLiteralWithNames (WithHsDocIdentifiers src names) = (toIfaceStringLiteral src, map unLoc names) + +toIfaceStringLiteral :: StringLiteral -> IfaceStringLiteral +toIfaceStringLiteral (StringLiteral sl fs _) = IfStringLiteral sl fs + coreRuleToIfaceRule :: CoreRule -> IfaceRule -- A plugin that installs a BuiltinRule in a CoreDoPluginPass should -- ensure that there's another CoreDoPluginPass that removes the rule. ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -962,7 +962,7 @@ addFingerprints hsc_env iface0 eps <- hscEPS hsc_env let decls = mi_decls iface0 - warn_fn = mkIfaceWarnCache (mi_warns iface0) + warn_fn = mkIfaceWarnCache (fromIfaceWarnings $ mi_warns iface0) fix_fn = mkIfaceFixCache (mi_fixities iface0) -- The ABI of a declaration represents everything that is made ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -16,6 +16,7 @@ module GHC.Iface.Syntax ( IfaceBindingX(..), IfaceMaybeRhs(..), IfaceConAlt(..), IfaceIdInfo, IfaceIdDetails(..), IfaceUnfolding(..), IfGuidance(..), IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget, + IfaceWarnings(..), IfaceWarningTxt(..), IfaceStringLiteral(..), IfaceClsInst(..), IfaceFamInst(..), IfaceTickish(..), IfaceClassBody(..), IfaceBooleanFormula(..), IfaceBang(..), @@ -33,6 +34,7 @@ module GHC.Iface.Syntax ( ifaceDeclImplicitBndrs, visibleIfConDecls, ifaceDeclFingerprints, fromIfaceBooleanFormula, + fromIfaceWarnings, -- Free Names freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst, @@ -66,7 +68,9 @@ import GHC.Types.ForeignCall import GHC.Types.Annotations( AnnPayload, AnnTarget ) import GHC.Types.Basic import GHC.Unit.Module +import GHC.Unit.Module.Warnings import GHC.Types.SrcLoc +import GHC.Types.SourceText import GHC.Data.BooleanFormula ( BooleanFormula(..), pprBooleanFormula, isTrue ) import GHC.Types.Var( VarBndr(..), binderVar, tyVarSpecToBinders, visArgTypeLike ) import GHC.Core.TyCon ( Role (..), Injectivity(..), tyConBndrVisForAllTyFlag ) @@ -74,6 +78,8 @@ import GHC.Core.DataCon (SrcStrictness(..), SrcUnpackedness(..)) import GHC.Builtin.Types ( constraintKindTyConName ) import GHC.Stg.InferTags.TagSig import GHC.Parser.Annotation (noLocA) +import GHC.Hs.Extension ( GhcRn ) +import GHC.Hs.Doc ( WithHsDocIdentifiers(..) ) import GHC.Utils.Lexeme (isLexSym) import GHC.Utils.Fingerprint @@ -338,6 +344,18 @@ data IfaceRule ifRuleOrph :: IsOrphan -- Just like IfaceClsInst } +data IfaceWarnings + = IfNoWarnings + | IfWarnAll IfaceWarningTxt + | IfWarnSome [(OccName, IfaceWarningTxt)] + +data IfaceWarningTxt + = IfWarningTxt (Maybe WarningCategory) SourceText [(IfaceStringLiteral, [IfExtName])] + | IfDeprecatedTxt SourceText [(IfaceStringLiteral, [IfExtName])] + +data IfaceStringLiteral + = IfStringLiteral SourceText FastString + data IfaceAnnotation = IfaceAnnotation { ifAnnotatedTarget :: IfaceAnnTarget, @@ -564,6 +582,24 @@ ifaceDeclFingerprints hash decl unsafeDupablePerformIO . computeFingerprint (panic "ifaceDeclFingerprints") +fromIfaceWarnings :: IfaceWarnings -> Warnings GhcRn +fromIfaceWarnings = \case + IfNoWarnings -> NoWarnings + IfWarnAll txt -> WarnAll (fromIfaceWarningTxt txt) + IfWarnSome prs -> WarnSome [(occ, fromIfaceWarningTxt txt) | (occ, txt) <- prs] + +fromIfaceWarningTxt :: IfaceWarningTxt -> WarningTxt GhcRn +fromIfaceWarningTxt = \case + IfWarningTxt mb_cat src strs -> WarningTxt (noLoc <$> mb_cat) (noLoc src) (noLoc <$> map fromIfaceStringLiteralWithNames strs) + IfDeprecatedTxt src strs -> DeprecatedTxt (noLoc src) (noLoc <$> map fromIfaceStringLiteralWithNames strs) + +fromIfaceStringLiteralWithNames :: (IfaceStringLiteral, [IfExtName]) -> WithHsDocIdentifiers StringLiteral GhcRn +fromIfaceStringLiteralWithNames (str, names) = WithHsDocIdentifiers (fromIfaceStringLiteral str) (map noLoc names) + +fromIfaceStringLiteral :: IfaceStringLiteral -> StringLiteral +fromIfaceStringLiteral (IfStringLiteral st fs) = StringLiteral st fs Nothing + + {- ************************************************************************ * * @@ -715,6 +751,25 @@ pprAxBranch pp_tc idx (IfaceAxBranch { ifaxbTyVars = tvs text "--" <+> text "incompatible with:" <+> pprWithCommas (\incomp -> text "#" <> ppr incomp) incomps +instance Outputable IfaceWarnings where + ppr = \case + IfNoWarnings -> empty + IfWarnAll txt -> text "Warn all" <+> ppr txt + IfWarnSome prs -> text "Warnings:" <+> vcat [ppr name <+> ppr txt | (name, txt) <- prs] + +instance Outputable IfaceWarningTxt where + ppr = \case + IfWarningTxt _ _ ws -> pp_ws ws + IfDeprecatedTxt _ ds -> pp_ws ds + where + pp_ws [msg] = pp_with_name msg + pp_ws msgs = brackets $ vcat . punctuate comma . map pp_with_name $ msgs + + pp_with_name = ppr . fst + +instance Outputable IfaceStringLiteral where + ppr (IfStringLiteral st fs) = pprWithSourceText st (ftext fs) + instance Outputable IfaceAnnotation where ppr (IfaceAnnotation target value) = ppr target <+> colon <+> ppr value @@ -2265,6 +2320,28 @@ instance Binary IfaceRule where a8 <- get bh return (IfaceRule a1 a2 a3 a4 a5 a6 a7 a8) +instance Binary IfaceWarnings where + put_ bh = \case + IfNoWarnings -> putByte bh 0 + IfWarnAll txt -> putByte bh 1 *> put_ bh txt + IfWarnSome prs -> putByte bh 2 *> put_ bh prs + get bh = getByte bh >>= \case + 0 -> pure IfNoWarnings + 1 -> pure IfWarnAll <*> get bh + _ -> pure IfWarnSome <*> get bh + +instance Binary IfaceWarningTxt where + put_ bh = \case + IfWarningTxt a1 a2 a3 -> putByte bh 0 *> put_ bh a1 *> put_ bh a2 *> put_ bh a3 + IfDeprecatedTxt a1 a2 -> putByte bh 1 *> put_ bh a1 *> put_ bh a2 + get bh = getByte bh >>= \case + 0 -> pure IfWarningTxt <*> get bh <*> get bh <*> get bh + _ -> pure IfDeprecatedTxt <*> get bh <*> get bh + +instance Binary IfaceStringLiteral where + put_ bh (IfStringLiteral a1 a2) = put_ bh a1 *> put_ bh a2 + get bh = IfStringLiteral <$> get bh <*> get bh + instance Binary IfaceAnnotation where put_ bh (IfaceAnnotation a1 a2) = do put_ bh a1 @@ -2822,5 +2899,19 @@ instance NFData IfaceClsInst where rnf (IfaceClsInst f1 f2 f3 f4 f5) = f1 `seq` rnf f2 `seq` rnf f3 `seq` f4 `seq` f5 `seq` () +instance NFData IfaceWarnings where + rnf = \case + IfNoWarnings -> () + IfWarnAll txt -> rnf txt + IfWarnSome txts -> rnf txts + +instance NFData IfaceWarningTxt where + rnf = \case + IfWarningTxt f1 f2 f3 -> rnf f1 `seq` rnf f2 `seq` rnf f3 + IfDeprecatedTxt f1 f2 -> rnf f1 `seq` rnf f2 + +instance NFData IfaceStringLiteral where + rnf (IfStringLiteral f1 f2) = rnf f1 `seq` rnf f2 + instance NFData IfaceAnnotation where rnf (IfaceAnnotation f1 f2) = f1 `seq` f2 `seq` () ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -47,6 +47,7 @@ import GHC.Tc.Zonk.TcType ( tcInitTidyEnv ) import GHC.Hs import GHC.Iface.Load ( loadSrcInterface ) +import GHC.Iface.Syntax ( fromIfaceWarnings ) import GHC.Builtin.Names import GHC.Parser.PostProcess ( setRdrNameSpace ) import GHC.Core.Type @@ -422,7 +423,7 @@ rnImportDecl this_mod imports = calculateAvails home_unit other_home_units iface mod_safe' want_boot (ImportedByUser imv) -- Complain if we import a deprecated module - case mi_warns iface of + case fromIfaceWarnings (mi_warns iface) of WarnAll txt -> addDiagnostic (TcRnDeprecatedModule imp_mod_name txt) _ -> return () ===================================== compiler/GHC/Types/SourceText.hs ===================================== @@ -1,5 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RecordWildCards #-} -- | Source text -- @@ -39,6 +41,7 @@ import Data.Function (on) import Data.Data import GHC.Real ( Ratio(..) ) import GHC.Types.SrcLoc +import Control.DeepSeq {- Note [Pragma source text] @@ -107,6 +110,11 @@ instance Outputable SourceText where ppr (SourceText s) = text "SourceText" <+> ftext s ppr NoSourceText = text "NoSourceText" +instance NFData SourceText where + rnf = \case + SourceText s -> rnf s + NoSourceText -> () + instance Binary SourceText where put_ bh NoSourceText = putByte bh 0 put_ bh (SourceText s) = do @@ -315,12 +323,3 @@ instance Eq StringLiteral where instance Outputable StringLiteral where ppr sl = pprWithSourceText (sl_st sl) (ftext $ sl_fs sl) - -instance Binary StringLiteral where - put_ bh (StringLiteral st fs _) = do - put_ bh st - put_ bh fs - get bh = do - st <- get bh - fs <- get bh - return (StringLiteral st fs Nothing) ===================================== compiler/GHC/Unit/Module/ModIface.hs ===================================== @@ -185,7 +185,7 @@ data ModIface_ (phase :: ModIfacePhase) -- ^ Fixities -- NOT STRICT! we read this field lazily from the interface file - mi_warns :: (Warnings GhcRn), + mi_warns :: IfaceWarnings, -- ^ Warnings -- NOT STRICT! we read this field lazily from the interface file @@ -479,7 +479,7 @@ instance Binary ModIface where mi_finsts = hasFamInsts, mi_exp_hash = exp_hash, mi_orphan_hash = orphan_hash, - mi_warn_fn = mkIfaceWarnCache warns, + mi_warn_fn = mkIfaceWarnCache $ fromIfaceWarnings warns, mi_fix_fn = mkIfaceFixCache fixities, mi_hash_fn = mkIfaceHashCache decls }}) @@ -498,7 +498,7 @@ emptyPartialModIface mod mi_exports = [], mi_used_th = False, mi_fixities = [], - mi_warns = NoWarnings, + mi_warns = IfNoWarnings, mi_anns = [], mi_insts = [], mi_fam_insts = [], @@ -567,7 +567,7 @@ instance ( NFData (IfaceBackendExts (phase :: ModIfacePhase)) `seq` mi_exports `seq` rnf mi_used_th `seq` mi_fixities - `seq` mi_warns + `seq` rnf mi_warns `seq` rnf mi_anns `seq` rnf mi_decls `seq` rnf mi_extra_decls ===================================== compiler/GHC/Unit/Module/Warnings.hs ===================================== @@ -5,6 +5,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE LambdaCase #-} -- | Warnings for a module module GHC.Unit.Module.Warnings @@ -40,7 +41,6 @@ import GHC.Types.SrcLoc import GHC.Types.Unique import GHC.Types.Unique.Set import GHC.Hs.Doc -import GHC.Hs.Extension import GHC.Utils.Outputable import GHC.Utils.Binary @@ -51,6 +51,7 @@ import Language.Haskell.Syntax.Extension import Data.Data import Data.List (isPrefixOf) import GHC.Generics ( Generic ) +import Control.DeepSeq {- @@ -103,7 +104,7 @@ the possibility of them being infinite. -- See Note [Warning categories] newtype WarningCategory = WarningCategory FastString - deriving (Binary, Data, Eq, Outputable, Show, Uniquable) + deriving (Binary, Data, Eq, Outputable, Show, Uniquable, NFData) mkWarningCategory :: FastString -> WarningCategory mkWarningCategory = WarningCategory @@ -203,29 +204,6 @@ instance Outputable (WarningTxt pass) where NoSourceText -> pp_ws ds SourceText src -> ftext src <+> pp_ws ds <+> text "#-}" -instance Binary (WarningTxt GhcRn) where - put_ bh (WarningTxt c s w) = do - putByte bh 0 - put_ bh $ unLoc <$> c - put_ bh $ unLoc s - put_ bh $ unLoc <$> w - put_ bh (DeprecatedTxt s d) = do - putByte bh 1 - put_ bh $ unLoc s - put_ bh $ unLoc <$> d - - get bh = do - h <- getByte bh - case h of - 0 -> do c <- fmap noLoc <$> get bh - s <- noLoc <$> get bh - w <- fmap noLoc <$> get bh - return (WarningTxt c s w) - _ -> do s <- noLoc <$> get bh - d <- fmap noLoc <$> get bh - return (DeprecatedTxt s d) - - pp_ws :: [Located (WithHsDocIdentifiers StringLiteral pass)] -> SDoc pp_ws [l] = ppr $ unLoc l pp_ws ws @@ -271,24 +249,6 @@ data Warnings pass deriving instance Eq (IdP pass) => Eq (Warnings pass) -instance Binary (Warnings GhcRn) where - put_ bh NoWarnings = putByte bh 0 - put_ bh (WarnAll t) = do - putByte bh 1 - put_ bh t - put_ bh (WarnSome ts) = do - putByte bh 2 - put_ bh ts - - get bh = do - h <- getByte bh - case h of - 0 -> return NoWarnings - 1 -> do aa <- get bh - return (WarnAll aa) - _ -> do aa <- get bh - return (WarnSome aa) - -- | Constructs the cache for the 'mi_warn_fn' field of a 'ModIface' mkIfaceWarnCache :: Warnings p -> OccName -> Maybe (WarningTxt p) mkIfaceWarnCache NoWarnings = \_ -> Nothing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/17cde3fa130de77aa011f3a697927d6e8b71507f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/17cde3fa130de77aa011f3a697927d6e8b71507f You're receiving 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 Jun 17 10:52:37 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sat, 17 Jun 2023 06:52:37 -0400 Subject: [Git][ghc/ghc][wip/T23109] Further wibbles Message-ID: <648d90756f8e3_271466105ea4ec195058@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23109 at Glasgow Haskell Compiler / GHC Commits: e171d47b by Simon Peyton Jones at 2023-06-17T11:52:10+01:00 Further wibbles esp exprIsConLike - - - - - 6 changed files: - compiler/GHC/Core/Utils.hs - compiler/GHC/Types/Demand.hs - testsuite/tests/numeric/should_compile/T15547.stderr - testsuite/tests/simplCore/should_compile/T17366.stderr - testsuite/tests/simplCore/should_compile/T17966.stderr - testsuite/tests/stranal/sigs/T21888.stderr Changes: ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -1933,7 +1933,22 @@ exprIsHNF = exprIsHNFlike isDataConWorkId isEvaldUnfolding -- data constructors. Conlike arguments are considered interesting by the -- inliner. exprIsConLike :: CoreExpr -> Bool -- True => lambda, conlike, PAP -exprIsConLike = exprIsHNFlike isConLikeId isConLikeUnfolding +-- exprIsConLike = exprIsHNFlike isConLikeId isConLikeUnfolding +-- Trying: just a constructor application +exprIsConLike (Var v) = isConLikeId v +exprIsConLike (Lit l) = not (isLitRubbish l) +exprIsConLike (App f a) = exprIsTrivial a && exprIsConLike f +exprIsConLike (Lam b e) + | isRuntimeVar b = False + | otherwise = exprIsConLike e +exprIsConLike (Tick t e) + | tickishCounts t = False + | otherwise = exprIsConLike e +exprIsConLike (Cast e _) = exprIsConLike e +exprIsConLike (Let {}) = False +exprIsConLike (Case {}) = False +exprIsConLike (Type {}) = False +exprIsConLike (Coercion {}) = False -- | Returns true for values or value-like expressions. These are lambdas, -- constructors / CONLIKE functions (as determined by the function argument) ===================================== compiler/GHC/Types/Demand.hs ===================================== @@ -2334,20 +2334,25 @@ dmdTransformDataConSig str_marks sd = case viewProd arity body_sd of -- on the result into the indicated dictionary component (if saturated). -- See Note [Demand transformer for a dictionary selector]. dmdTransformDictSelSig :: DmdSig -> DmdTransformer --- NB: This currently doesn't handle newtype dictionaries. --- It should simply apply call_sd directly to the dictionary, I suppose. -dmdTransformDictSelSig (DmdSig (DmdType _ [_ :* prod])) call_sd +dmdTransformDictSelSig (DmdSig (DmdType _ [_ :* dict_dmd])) call_sd + -- NB: dict_dmd comes from the demand signature of the class-op + -- which is created in GHC.Types.Id.Make.mkDictSelId | (n, sd') <- peelCallDmd call_sd - , Prod _ sig_ds <- prod = multDmdType n $ - DmdType nopDmdEnv [C_11 :* mkProd Unboxed (map (enhance sd') sig_ds)] - | otherwise - = nopDmdType -- See Note [Demand transformer for a dictionary selector] + DmdType nopDmdEnv [enhance_dict_dmd sd' dict_dmd] where - enhance _ AbsDmd = AbsDmd - enhance _ BotDmd = BotDmd - enhance sd _dmd_var = C_11 :* sd -- This is the one! - -- C_11, because we multiply with n above + enhance_dict_dmd sd' dict_dmd + | Prod _ sig_ds <- dict_dmd + = C_11 :* mkProd Unboxed (map (enhance sd') sig_ds) + + | otherwise -- Newtype dictionary + = C_11 :* sd' -- Apply sd' to the dictionary + + enhance _ AbsDmd = AbsDmd + enhance _ BotDmd = BotDmd + enhance sd' _dmd_var = C_11 :* sd' -- This is the one! + -- C_11, because we multiply with n above + dmdTransformDictSelSig sig sd = pprPanic "dmdTransformDictSelSig: no args" (ppr sig $$ ppr sd) {- ===================================== testsuite/tests/numeric/should_compile/T15547.stderr ===================================== @@ -1,29 +1,29 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 36, types: 100, coercions: 56, joins: 0/0} + = {terms: 40, types: 122, coercions: 26, joins: 0/0} nat2Word# = \ @n $dKnownNat _ -> - naturalToWord# ($dKnownNat `cast` :: ...) + naturalToWord# ((natSing $dKnownNat) `cast` :: ...) foo = \ _ -> 18## fd = \ @n $dKnownNat _ -> - naturalToWord# ($dKnownNat `cast` :: ...) + naturalToWord# ((natSing $dKnownNat) `cast` :: ...) d = \ _ -> 3## fm = \ @n $dKnownNat _ -> - naturalToWord# ($dKnownNat `cast` :: ...) + naturalToWord# ((natSing $dKnownNat) `cast` :: ...) m = \ _ -> 9## fp = \ @n $dKnownNat _ -> - naturalToWord# ($dKnownNat `cast` :: ...) + naturalToWord# ((natSing $dKnownNat) `cast` :: ...) p = \ _ -> 512## ===================================== testsuite/tests/simplCore/should_compile/T17366.stderr ===================================== @@ -1,2 +1,4 @@ +Rule fired: Class op c (BUILTIN) +Rule fired: Class op c (BUILTIN) Rule fired: SPEC/T17366 f @Identity @_ (T17366) Rule fired: SPEC/T17366 f @(Tagged tag) @_ (T17366) ===================================== testsuite/tests/simplCore/should_compile/T17966.stderr ===================================== @@ -1,309 +1,298 @@ ==================== Specialise ==================== Result size of Specialise - = {terms: 166, types: 158, coercions: 24, joins: 0/0} + = {terms: 162, types: 155, coercions: 10, joins: 0/0} -- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0} -$dShow_sRN :: Show (Maybe Integer) +$dShow_sTQ :: Show (Maybe Integer) [LclId, - Unf=Unf{Src=, TopLvl=False, Value=False, ConLike=True, - WorkFree=False, Expandable=True, Guidance=IF_ARGS [] 20 0}] -$dShow_sRN = GHC.Show.$fShowMaybe @Integer GHC.Show.$fShowInteger + Unf=Unf{Src=, TopLvl=False, + Value=False, ConLike=True, WorkFree=False, Expandable=True, + Guidance=IF_ARGS [] 20 0}] +$dShow_sTQ = GHC.Show.$fShowMaybe @Integer GHC.Show.$fShowInteger -Rec { --- RHS size: {terms: 2, types: 1, coercions: 4, joins: 0/0} -$dC_sRM :: C Bool () -[LclId, - Unf=Unf{Src=, TopLvl=False, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 60}] -$dC_sRM - = ($cm_aHo @() GHC.Show.$fShow()) - `cast` (Sym (T17966.N:C[0] _N <()>_N) - :: (forall c. Show c => Bool -> () -> c -> String) ~R# C Bool ()) - --- RHS size: {terms: 30, types: 24, coercions: 0, joins: 0/0} -$s$cm_sRQ [InlPrag=[0]] - :: forall {c}. Show c => Bool -> () -> c -> [Char] -[LclId, Arity=4] -$s$cm_sRQ - = \ (@c_aHr) - ($dShow_aHs :: Show c_aHr) - (a_aBf :: Bool) - (b_aBg :: ()) - (c_aBh :: c_aHr) -> +-- RHS size: {terms: 28, types: 22, coercions: 0, joins: 0/0} +$s$cm_sTX [InlPrag=INLINABLE[0]] + :: Bool -> () -> Maybe Integer -> [Char] +[LclId, Arity=3] +$s$cm_sTX + = \ (a_aD5 :: Bool) (b_aD6 :: ()) (c_aD7 :: Maybe Integer) -> GHC.Base.augment @Char - (\ (@b_aQg) - (c_aQh [OS=OneShot] :: Char -> b_aQg -> b_aQg) - (n_aQi [OS=OneShot] :: b_aQg) -> + (\ (@b_aSj) + (c_aSk [OS=OneShot] :: Char -> b_aSj -> b_aSj) + (n_aSl [OS=OneShot] :: b_aSj) -> GHC.Base.foldr @Char - @b_aQg - c_aQh - n_aQi - (case a_aBf of { + @b_aSj + c_aSk + n_aSl + (case a_aD5 of { False -> GHC.Show.$fShowBool5; True -> GHC.Show.$fShowBool4 })) (GHC.Base.augment @Char - (\ (@b_aQg) - (c_aQh [OS=OneShot] :: Char -> b_aQg -> b_aQg) - (n_aQi [OS=OneShot] :: b_aQg) -> + (\ (@b_aSj) + (c_aSk [OS=OneShot] :: Char -> b_aSj -> b_aSj) + (n_aSl [OS=OneShot] :: b_aSj) -> GHC.Base.foldr - @Char @b_aQg c_aQh n_aQi (GHC.Show.$fShow()_$cshow b_aBg)) - (show @c_aHr $dShow_aHs c_aBh)) + @Char @b_aSj c_aSk n_aSl (GHC.Show.$fShowUnit_$cshow b_aD6)) + (GHC.Show.$fShowMaybe_$cshow + @Integer GHC.Show.$fShowInteger c_aD7)) -- RHS size: {terms: 33, types: 28, coercions: 0, joins: 0/0} -$cm_aHo [InlPrag=INLINABLE[0]] +$cm_aJa [InlPrag=INLINABLE[0]] :: forall b c. (Show b, Show c) => Bool -> b -> c -> String [LclId, Arity=5, - Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, + Unf=Unf{Src=StableUser, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [30 30 30 0 0] 140 0 - Tmpl= \ (@b_aHl) - ($dShow_aHm [Occ=Once1] :: Show b_aHl) - (@c_aHr) - ($dShow_aHs [Occ=Once1] :: Show c_aHr) - (a_aBf [Occ=Once1!] :: Bool) - (b_aBg [Occ=Once1] :: b_aHl) - (c_aBh [Occ=Once1] :: c_aHr) -> + Tmpl= \ (@b_aJ7) + ($dShow_aJ8 [Occ=Once1] :: Show b_aJ7) + (@c_aJd) + ($dShow_aJe [Occ=Once1] :: Show c_aJd) + (a_aD5 [Occ=Once1!] :: Bool) + (b_aD6 [Occ=Once1] :: b_aJ7) + (c_aD7 [Occ=Once1] :: c_aJd) -> ++ @Char - (case a_aBf of { + (case a_aD5 of { False -> GHC.Show.$fShowBool5; True -> GHC.Show.$fShowBool4 }) (++ @Char - (show @b_aHl $dShow_aHm b_aBg) - (show @c_aHr $dShow_aHs c_aBh))}, - RULES: "SPEC $cm @()" [0] - forall ($dShow_sRP :: Show ()). $cm_aHo @() $dShow_sRP = $s$cm_sRQ] -$cm_aHo - = \ (@b_aHl) - ($dShow_aHm :: Show b_aHl) - (@c_aHr) - ($dShow_aHs :: Show c_aHr) - (a_aBf :: Bool) - (b_aBg :: b_aHl) - (c_aBh :: c_aHr) -> + (show @b_aJ7 $dShow_aJ8 b_aD6) + (show @c_aJd $dShow_aJe c_aD7))}, + RULES: "SPEC $cm @() @(Maybe Integer)" [0] + forall ($dShow_sTS :: Show ()) + ($dShow_sTT :: Show (Maybe Integer)). + $cm_aJa @() $dShow_sTS @(Maybe Integer) $dShow_sTT + = $s$cm_sTX] +$cm_aJa + = \ (@b_aJ7) + ($dShow_aJ8 :: Show b_aJ7) + (@c_aJd) + ($dShow_aJe :: Show c_aJd) + (a_aD5 :: Bool) + (b_aD6 :: b_aJ7) + (c_aD7 :: c_aJd) -> GHC.Base.augment @Char - (\ (@b_aQg) - (c_aQh [OS=OneShot] :: Char -> b_aQg -> b_aQg) - (n_aQi [OS=OneShot] :: b_aQg) -> + (\ (@b_aSj) + (c_aSk [OS=OneShot] :: Char -> b_aSj -> b_aSj) + (n_aSl [OS=OneShot] :: b_aSj) -> GHC.Base.foldr @Char - @b_aQg - c_aQh - n_aQi - (case a_aBf of { + @b_aSj + c_aSk + n_aSl + (case a_aD5 of { False -> GHC.Show.$fShowBool5; True -> GHC.Show.$fShowBool4 })) (GHC.Base.augment @Char - (\ (@b_aQg) - (c_aQh [OS=OneShot] :: Char -> b_aQg -> b_aQg) - (n_aQi [OS=OneShot] :: b_aQg) -> + (\ (@b_aSj) + (c_aSk [OS=OneShot] :: Char -> b_aSj -> b_aSj) + (n_aSl [OS=OneShot] :: b_aSj) -> GHC.Base.foldr - @Char @b_aQg c_aQh n_aQi (show @b_aHl $dShow_aHm b_aBg)) - (show @c_aHr $dShow_aHs c_aBh)) -end Rec } + @Char @b_aSj c_aSk n_aSl (show @b_aJ7 $dShow_aJ8 b_aD6)) + (show @c_aJd $dShow_aJe c_aD7)) -- RHS size: {terms: 1, types: 0, coercions: 10, joins: 0/0} -T17966.$fCBoolb [InlPrag=INLINE (sat-args=0)] - :: forall b. Show b => C Bool b +T17966.$fCBoolb [InlPrag=CONLIKE] :: forall b. Show b => C Bool b [LclIdX[DFunId(nt)], Arity=5, - Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, - Guidance=ALWAYS_IF(arity=1,unsat_ok=False,boring_ok=True) - Tmpl= $cm_aHo - `cast` (forall (b :: <*>_N). - _R %<'Many>_N ->_R Sym (T17966.N:C[0] _N _N) - :: (forall {b} c. (Show b, Show c) => Bool -> b -> c -> String) - ~R# (forall {b}. Show b => C Bool b))}] + Unf=DFun: \ (@b_anK) (v_B1 :: Show b_anK) -> + T17966.C:C TYPE: Bool TYPE: b_anK $cm_aJa @b_anK v_B1] T17966.$fCBoolb - = $cm_aHo + = $cm_aJa `cast` (forall (b :: <*>_N). - _R %<'Many>_N ->_R Sym (T17966.N:C[0] _N _N) + _R %_N ->_R Sym (T17966.N:C[0] _N _N) :: (forall {b} c. (Show b, Show c) => Bool -> b -> c -> String) ~R# (forall {b}. Show b => C Bool b)) --- RHS size: {terms: 18, types: 15, coercions: 3, joins: 0/0} -$sf_sRO [InlPrag=[0]] :: Bool -> () -> Maybe Integer -> [Char] +-- RHS size: {terms: 2, types: 1, coercions: 0, joins: 0/0} +$dC_sTP :: C Bool () +[LclId, + Unf=Unf{Src=, TopLvl=False, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [] 20 60}] +$dC_sTP = T17966.$fCBoolb @() GHC.Show.$fShowUnit + +-- RHS size: {terms: 19, types: 16, coercions: 0, joins: 0/0} +$sf_sTR [InlPrag=INLINABLE[0]] + :: Bool -> () -> Maybe Integer -> [Char] [LclId, Arity=3] -$sf_sRO - = \ (a_aBl :: Bool) (b_aBm :: ()) (c_aBn :: Maybe Integer) -> +$sf_sTR + = \ (a_aDe :: Bool) (b_aDf :: ()) (c_aDg :: Maybe Integer) -> GHC.Base.build @Char - (\ (@b_aQz) - (c_aQA [OS=OneShot] :: Char -> b_aQz -> b_aQz) - (n_aQB [OS=OneShot] :: b_aQz) -> + (\ (@b_aSC) + (c_aSD [OS=OneShot] :: Char -> b_aSC -> b_aSC) + (n_aSE [OS=OneShot] :: b_aSC) -> GHC.Base.foldr @Char - @b_aQz - c_aQA - (GHC.CString.unpackFoldrCString# @b_aQz "!"# c_aQA n_aQB) - (($dC_sRM - `cast` (T17966.N:C[0] _N <()>_N - :: C Bool () ~R# (forall c. Show c => Bool -> () -> c -> String))) - @(Maybe Integer) $dShow_sRN a_aBl b_aBm c_aBn)) + @b_aSC + c_aSD + (GHC.CString.unpackFoldrCString# @b_aSC "!"# c_aSD n_aSE) + ($cm_aJa + @() + GHC.Show.$fShowUnit + @(Maybe Integer) + $dShow_sTQ + a_aDe + b_aDf + c_aDg)) --- RHS size: {terms: 23, types: 21, coercions: 3, joins: 0/0} +-- RHS size: {terms: 24, types: 23, coercions: 0, joins: 0/0} f [InlPrag=INLINABLE[0]] :: forall a b c. (C a b, Show c) => a -> b -> c -> String [LclIdX, Arity=5, - Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 0 0 0 0] 120 0 - Tmpl= \ (@a_aFi) - (@b_aFj) - (@c_aFk) - ($dC_aFl [Occ=Once1] :: C a_aFi b_aFj) - ($dShow_aFm [Occ=Once1] :: Show c_aFk) - (a_aBl [Occ=Once1] :: a_aFi) - (b_aBm [Occ=Once1] :: b_aFj) - (c_aBn [Occ=Once1] :: c_aFk) -> + Unf=Unf{Src=StableUser, TopLvl=True, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [30 0 0 0 0] 130 0 + Tmpl= \ (@a_aF9) + (@b_aFa) + (@c_aFb) + ($dC_aFc [Occ=Once1] :: C a_aF9 b_aFa) + ($dShow_aFd [Occ=Once1] :: Show c_aFb) + (a_aDe [Occ=Once1] :: a_aF9) + (b_aDf [Occ=Once1] :: b_aFa) + (c_aDg [Occ=Once1] :: c_aFb) -> ++ @Char - (($dC_aFl - `cast` (T17966.N:C[0] _N _N - :: C a_aFi b_aFj - ~R# (forall c. Show c => a_aFi -> b_aFj -> c -> String))) - @c_aFk $dShow_aFm a_aBl b_aBm c_aBn) + (m @a_aF9 @b_aFa $dC_aFc @c_aFb $dShow_aFd a_aDe b_aDf c_aDg) (GHC.CString.unpackCString# "!"#)}, RULES: "SPEC f @Bool @() @(Maybe Integer)" [0] - forall ($dC_sRM :: C Bool ()) ($dShow_sRN :: Show (Maybe Integer)). - f @Bool @() @(Maybe Integer) $dC_sRM $dShow_sRN - = $sf_sRO] -f = \ (@a_aFi) - (@b_aFj) - (@c_aFk) - ($dC_aFl :: C a_aFi b_aFj) - ($dShow_aFm :: Show c_aFk) - (a_aBl :: a_aFi) - (b_aBm :: b_aFj) - (c_aBn :: c_aFk) -> + forall ($dC_sTP :: C Bool ()) ($dShow_sTQ :: Show (Maybe Integer)). + f @Bool @() @(Maybe Integer) $dC_sTP $dShow_sTQ + = $sf_sTR] +f = \ (@a_aF9) + (@b_aFa) + (@c_aFb) + ($dC_aFc :: C a_aF9 b_aFa) + ($dShow_aFd :: Show c_aFb) + (a_aDe :: a_aF9) + (b_aDf :: b_aFa) + (c_aDg :: c_aFb) -> GHC.Base.build @Char - (\ (@b_aQz) - (c_aQA [OS=OneShot] :: Char -> b_aQz -> b_aQz) - (n_aQB [OS=OneShot] :: b_aQz) -> + (\ (@b_aSC) + (c_aSD [OS=OneShot] :: Char -> b_aSC -> b_aSC) + (n_aSE [OS=OneShot] :: b_aSC) -> GHC.Base.foldr @Char - @b_aQz - c_aQA - (GHC.CString.unpackFoldrCString# @b_aQz "!"# c_aQA n_aQB) - (($dC_aFl - `cast` (T17966.N:C[0] _N _N - :: C a_aFi b_aFj - ~R# (forall c. Show c => a_aFi -> b_aFj -> c -> String))) - @c_aFk $dShow_aFm a_aBl b_aBm c_aBn)) + @b_aSC + c_aSD + (GHC.CString.unpackFoldrCString# @b_aSC "!"# c_aSD n_aSE) + (m @a_aF9 @b_aFa $dC_aFc @c_aFb $dShow_aFd a_aDe b_aDf c_aDg)) -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -$trModule_sRG :: GHC.Prim.Addr# +$trModule_sTJ :: GHC.Prim.Addr# [LclId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] -$trModule_sRG = "main"# + Unf=Unf{Src=, TopLvl=False, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [] 20 0}] +$trModule_sTJ = "main"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -$trModule_sRH :: GHC.Types.TrName +$trModule_sTK :: GHC.Types.TrName [LclId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -$trModule_sRH = GHC.Types.TrNameS $trModule_sRG + Unf=Unf{Src=, TopLvl=False, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [] 10 10}] +$trModule_sTK = GHC.Types.TrNameS $trModule_sTJ -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -$trModule_sRI :: GHC.Prim.Addr# +$trModule_sTL :: GHC.Prim.Addr# [LclId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}] -$trModule_sRI = "T17966"# + Unf=Unf{Src=, TopLvl=False, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [] 30 0}] +$trModule_sTL = "T17966"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -$trModule_sRJ :: GHC.Types.TrName +$trModule_sTM :: GHC.Types.TrName [LclId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -$trModule_sRJ = GHC.Types.TrNameS $trModule_sRI + Unf=Unf{Src=, TopLvl=False, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [] 10 10}] +$trModule_sTM = GHC.Types.TrNameS $trModule_sTL -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} T17966.$trModule :: GHC.Types.Module [LclIdX, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -T17966.$trModule = GHC.Types.Module $trModule_sRH $trModule_sRJ - --- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} -$krep_aPr [InlPrag=[~]] :: GHC.Types.KindRep -[LclId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -$krep_aPr - = GHC.Types.KindRepTyConApp - GHC.Types.$tcConstraint (GHC.Types.[] @GHC.Types.KindRep) + Unf=Unf{Src=, TopLvl=False, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [] 10 10}] +T17966.$trModule = GHC.Types.Module $trModule_sTK $trModule_sTM -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep_aPq [InlPrag=[~]] :: GHC.Types.KindRep +$krep_aRp [InlPrag=[~]] :: GHC.Types.KindRep [LclId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -$krep_aPq = GHC.Types.KindRepFun GHC.Types.krep$* $krep_aPr + Unf=Unf{Src=, TopLvl=False, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [] 10 10}] +$krep_aRp + = GHC.Types.KindRepFun GHC.Types.krep$* GHC.Types.krep$Constraint -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -$krep_aPp [InlPrag=[~]] :: GHC.Types.KindRep +$krep_aRo [InlPrag=[~]] :: GHC.Types.KindRep [LclId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -$krep_aPp = GHC.Types.KindRepFun GHC.Types.krep$* $krep_aPq + Unf=Unf{Src=, TopLvl=False, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [] 10 10}] +$krep_aRo = GHC.Types.KindRepFun GHC.Types.krep$* $krep_aRp -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} -$tcC_sRK :: GHC.Prim.Addr# +$tcC_sTN :: GHC.Prim.Addr# [LclId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}] -$tcC_sRK = "C"# + Unf=Unf{Src=, TopLvl=False, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [] 20 0}] +$tcC_sTN = "C"# -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0} -$tcC_sRL :: GHC.Types.TrName +$tcC_sTO :: GHC.Types.TrName [LclId, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] -$tcC_sRL = GHC.Types.TrNameS $tcC_sRK + Unf=Unf{Src=, TopLvl=False, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [] 10 10}] +$tcC_sTO = GHC.Types.TrNameS $tcC_sTN -- RHS size: {terms: 7, types: 0, coercions: 0, joins: 0/0} T17966.$tcC :: GHC.Types.TyCon [LclIdX, - Unf=Unf{Src=, TopLvl=True, Value=True, ConLike=True, - WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}] + Unf=Unf{Src=, TopLvl=False, + Value=True, ConLike=True, WorkFree=True, Expandable=True, + Guidance=IF_ARGS [] 10 10}] T17966.$tcC = GHC.Types.TyCon 12503088876068780286#Word64 926716241154773768#Word64 T17966.$trModule - $tcC_sRL + $tcC_sTO 0# - $krep_aPp + $krep_aRo --- RHS size: {terms: 10, types: 7, coercions: 4, joins: 0/0} +-- RHS size: {terms: 10, types: 7, coercions: 0, joins: 0/0} x :: String [LclIdX, - Unf=Unf{Src=, TopLvl=True, Value=False, ConLike=False, - WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 120 0}] + Unf=Unf{Src=, TopLvl=False, + Value=False, ConLike=False, WorkFree=False, Expandable=False, + Guidance=IF_ARGS [] 120 0}] x = f @Bool @() @(Maybe Integer) - (($cm_aHo @() GHC.Show.$fShow()) - `cast` (Sym (T17966.N:C[0] _N <()>_N) - :: (forall c. Show c => Bool -> () -> c -> String) ~R# C Bool ())) + (T17966.$fCBoolb @() GHC.Show.$fShowUnit) (GHC.Show.$fShowMaybe @Integer GHC.Show.$fShowInteger) GHC.Types.True - GHC.Tuple.() + GHC.Tuple.Prim.() (GHC.Maybe.Just @Integer (GHC.Num.Integer.IS 42#)) ===================================== testsuite/tests/stranal/sigs/T21888.stderr ===================================== @@ -2,8 +2,8 @@ ==================== Strictness signatures ==================== Data.MemoTrie.$fHasTrieBool: <1!P(L,L)> Data.MemoTrie.$fHasTrieEither: <1C(1,L)><1C(1,L)><1!P(L,L)> -Data.MemoTrie.$fHasTrieInteger: <1!P(1!P(S,1!P(1!P(S,1L),1!P(S,1L))),1!P(S,1!P(1!P(S,1L),1!P(S,1L))))>b -Data.MemoTrie.$fHasTrieList: <1!P(L,L)> +Data.MemoTrie.$fHasTrieInteger: <1!P(L,L)> +Data.MemoTrie.$fHasTrieList: Data.MemoTrie.$fHasTrieTuple2: <1C(1,L)> Data.MemoTrie.$fHasTrieUnit: @@ -22,8 +22,8 @@ Data.MemoTrie.$fHasTrieUnit: ==================== Strictness signatures ==================== Data.MemoTrie.$fHasTrieBool: <1!P(L,L)> Data.MemoTrie.$fHasTrieEither: <1C(1,L)><1C(1,L)><1!P(L,L)> -Data.MemoTrie.$fHasTrieInteger: <1!P(1!P(B,1!P(1!P(B,1!P(L,L)),1!P(B,1!P(L,L)))),1!P(B,1!P(1!B,1!B)))>b -Data.MemoTrie.$fHasTrieList: <1!P(L,L)> +Data.MemoTrie.$fHasTrieInteger: <1!P(L,L)> +Data.MemoTrie.$fHasTrieList: Data.MemoTrie.$fHasTrieTuple2: <1C(1,L)> Data.MemoTrie.$fHasTrieUnit: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e171d47b9768563fb3166bee48f5c33322e9d0cf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e171d47b9768563fb3166bee48f5c33322e9d0cf You're receiving 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 Jun 17 13:56:07 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sat, 17 Jun 2023 09:56:07 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] Implement MO_FS_Conv and MO_SF_Conv (integer <-> float conversion) Message-ID: <648dbb778ba3e_27146610c47420219198@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: 7e3679b6 by Sven Tennie at 2023-06-17T15:54:55+02:00 Implement MO_FS_Conv and MO_SF_Conv (integer <-> float conversion) - - - - - 2 changed files: - compiler/GHC/CmmToAsm/RV64/CodeGen.hs - compiler/GHC/CmmToAsm/RV64/Ppr.hs Changes: ===================================== compiler/GHC/CmmToAsm/RV64/CodeGen.hs ===================================== @@ -611,8 +611,20 @@ getRegister' config plat expr MO_S_Neg w -> negate code w reg MO_F_Neg w -> return $ Any (floatFormat w) (\dst -> code `snocOL` NEG (OpReg w dst) (OpReg w reg)) - MO_SF_Conv from to -> return $ Any (floatFormat to) (\dst -> code `snocOL` SCVTF (OpReg to dst) (OpReg from reg)) -- (Signed ConVerT Float) - MO_FS_Conv from to -> return $ Any (intFormat to) (\dst -> code `snocOL` FCVTZS (OpReg to dst) (OpReg from reg)) -- (float convert (-> zero) signed) + -- TODO: Can this case happen? + MO_SF_Conv from to | from < W32 -> do + -- extend to the smallest available representation + (reg_x, code_x) <- signExtendReg from W32 reg + pure $ Any (floatFormat to) + (\dst -> code `appOL` code_x `snocOL` annExpr expr (SCVTF (OpReg to dst) (OpReg from reg_x))) -- (Signed ConVerT Float) + MO_SF_Conv from to -> pure $ Any (floatFormat to) (\dst -> code `snocOL` annExpr expr (SCVTF (OpReg to dst) (OpReg from reg))) -- (Signed ConVerT Float) + -- TODO: Can this case happen? + MO_FS_Conv from to | to < W32 -> pure $ Any (intFormat to) (\dst -> + code `snocOL` + -- W32 is the smallest width to convert to. Decrease width afterwards. + annExpr expr (FCVTZS (OpReg W32 dst) (OpReg from reg)) `appOL` + signExtendAdjustPrecission W32 to dst dst) -- (float convert (-> zero) signed) + MO_FS_Conv from to -> pure $ Any (intFormat to) (\dst -> code `snocOL` annExpr expr (FCVTZS (OpReg to dst) (OpReg from reg))) -- (float convert (-> zero) signed) -- TODO this is very slow. We effectively use store + load (byte, half, word, double) -- for this in memory. ===================================== compiler/GHC/CmmToAsm/RV64/Ppr.hs ===================================== @@ -654,8 +654,20 @@ pprInstr platform instr = case instr of -- 9. Floating Point Instructions -------------------------------------------- FCVT o1 o2 -> op2 (text "\tfcvt") o1 o2 - SCVTF o1 o2 -> op2 (text "\tscvtf") o1 o2 - FCVTZS o1 o2 -> op2 (text "\tfcvtzs") o1 o2 + SCVTF o1@(OpReg W32 _) o2@(OpReg W32 _) -> op2 (text "\tfcvt.s.w") o1 o2 + SCVTF o1@(OpReg W64 _) o2@(OpReg W32 _) -> op2 (text "\tfcvt.s.l") o1 o2 + SCVTF o1@(OpReg W32 _) o2@(OpReg W64 _) -> op2 (text "\tfcvt.d.w") o1 o2 + SCVTF o1@(OpReg W64 _) o2@(OpReg W64 _) -> op2 (text "\tfcvt.d.l") o1 o2 + SCVTF o1 o2 -> pprPanic "RV64.pprInstr - impossible integer to float conversion" $ + line (pprOp platform o1 <> text "->" <> pprOp platform o2) + + FCVTZS o1@(OpReg W32 _) o2@(OpReg W32 _) -> op2 (text "\fcvt.w.s") o1 o2 + FCVTZS o1@(OpReg W32 _) o2@(OpReg W64 _) -> op2 (text "\fcvt.l.s") o1 o2 + FCVTZS o1@(OpReg W64 _) o2@(OpReg W32 _) -> op2 (text "\fcvt.w.d") o1 o2 + FCVTZS o1@(OpReg W64 _) o2@(OpReg W64 _) -> op2 (text "\fcvt.l.d") o1 o2 + FCVTZS o1 o2 -> pprPanic "RV64.pprInstr - impossible float to integer conversion" $ + line (pprOp platform o1 <> text "->" <> pprOp platform o2) + FABS o1 o2 -> op2 (text "\tfabs") o1 o2 instr -> panic $ "RV64.pprInstr - Unknown instruction: " ++ (instrCon instr) where op2 op o1 o2 = line $ op <+> pprOp platform o1 <> comma <+> pprOp platform o2 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7e3679b661f4ffdda53e80982351cc315b3f8029 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7e3679b661f4ffdda53e80982351cc315b3f8029 You're receiving 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 Jun 17 14:27:42 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sat, 17 Jun 2023 10:27:42 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] Fix MO_U_Shr (UBFX does not exist in RISCV ISA) Message-ID: <648dc2def237a_27146610c450d02197c9@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: 299f1570 by Sven Tennie at 2023-06-17T16:26:49+02:00 Fix MO_U_Shr (UBFX does not exist in RISCV ISA) - - - - - 1 changed file: - compiler/GHC/CmmToAsm/RV64/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/RV64/CodeGen.hs ===================================== @@ -745,21 +745,18 @@ getRegister' config plat expr ) CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W8, 0 <= n, n < 8 -> do - (reg_x, _format_x, code_x) <- getSomeReg x - return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (UBFX (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)) (OpImm (ImmInteger (8-n))))) + (reg_x, format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> code_x `appOL` truncateReg (formatToWidth format_x) w reg_x `snocOL` annExpr expr (LSR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) + CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W16, 0 <= n, n < 16 -> do + (reg_x, format_x, code_x) <- getSomeReg x + return $ Any (intFormat w) (\dst -> code_x `appOL` truncateReg (formatToWidth format_x) w reg_x `snocOL` annExpr expr (LSR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) CmmMachOp (MO_U_Shr w) [x, y] | w == W8 || w == W16 -> do (reg_x, format_x, code_x) <- getSomeReg x (reg_y, _format_y, code_y) <- getSomeReg y - return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `appOL` truncateReg (formatToWidth format_x) w reg_x `snocOL` annExpr expr (ASR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) - - CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W16, 0 <= n, n < 16 -> do - (reg_x, _format_x, code_x) <- getSomeReg x - return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (UBFX (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)) (OpImm (ImmInteger (16-n))))) - + return $ Any (intFormat w) (\dst -> code_x `appOL` code_y `appOL` truncateReg (formatToWidth format_x) w reg_x `snocOL` annExpr expr (LSR (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y))) CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W32, 0 <= n, n < 32 -> do (reg_x, _format_x, code_x) <- getSomeReg x return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) - CmmMachOp (MO_U_Shr w) [x, (CmmLit (CmmInt n _))] | w == W64, 0 <= n, n < 64 -> do (reg_x, _format_x, code_x) <- getSomeReg x return $ Any (intFormat w) (\dst -> code_x `snocOL` annExpr expr (LSR (OpReg w dst) (OpReg w reg_x) (OpImm (ImmInteger n)))) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/299f1570fabbcd2b42496e8489c666994d137664 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/299f1570fabbcd2b42496e8489c666994d137664 You're receiving 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 Jun 18 04:30:33 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 18 Jun 2023 00:30:33 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: Update documentation for `<**>` Message-ID: <648e886970352_271466110a3f7825551a@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9b6d0547 by Sylvain Henry at 2023-06-18T00:30:20-04:00 JS: testsuite: use correct ticket numbers - - - - - 03df2716 by Sylvain Henry at 2023-06-18T00:30:20-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 3759b785 by Ryan Hendrickson at 2023-06-18T00:30:23-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - 25 changed files: - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/ThToHs.hs - docs/users_guide/9.8.1-notes.rst - libraries/base/GHC/Base.hs - libraries/stm - rts/js/environment.js - + rts/js/eventlog.js - rts/rts.cabal.in - testsuite/tests/cabal/t22333/all.T - testsuite/tests/indexed-types/should_compile/T14131.hs - testsuite/tests/indexed-types/should_compile/T15852.hs - testsuite/tests/indexed-types/should_compile/T15852.stderr - testsuite/tests/indexed-types/should_fail/T14230.hs - testsuite/tests/indexed-types/should_fail/T7938.hs - testsuite/tests/indexed-types/should_fail/T7938.stderr - + testsuite/tests/rename/should_compile/T23512b.hs - testsuite/tests/rename/should_compile/all.T - + testsuite/tests/rename/should_fail/T23512a.hs - + testsuite/tests/rename/should_fail/T23512a.stderr - testsuite/tests/rename/should_fail/all.T - testsuite/tests/safeHaskell/check/pkg01/all.T - + testsuite/tests/th/T23525.hs - testsuite/tests/th/all.T - testsuite/tests/typecheck/should_fail/T15797.hs Changes: ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -1799,8 +1799,7 @@ one exists: a free variable 'a', which we implicitly quantify over. That is why we can also use it to the left of the double colon: 'Left a -The logic resides in extractHsTyRdrTyVarsKindVars. We use it both for type -synonyms and type family instances. +The logic resides in extractHsTyRdrTyVarsKindVars. This was a stopgap solution until we could explicitly bind invisible type/kind variables: ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -634,14 +634,10 @@ rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds rnFamEqn :: HsDocContext -> AssocTyFamInfo - -> FreeKiTyVars - -- ^ Additional kind variables to implicitly bind if there is no - -- explicit forall. (See the comments on @all_imp_vars@ below for a - -- more detailed explanation.) -> FamEqn GhcPs rhs -> (HsDocContext -> rhs -> RnM (rhs', FreeVars)) -> RnM (FamEqn GhcRn rhs', FreeVars) -rnFamEqn doc atfi extra_kvars +rnFamEqn doc atfi (FamEqn { feqn_tycon = tycon , feqn_bndrs = outer_bndrs , feqn_pats = pats @@ -652,19 +648,8 @@ rnFamEqn doc atfi extra_kvars -- all_imp_vars represent the implicitly bound type variables. This is -- empty if we have an explicit `forall` (see -- Note [forall-or-nothing rule] in GHC.Hs.Type), which means - -- ignoring: - -- - -- - pat_kity_vars, the free variables mentioned in the type patterns - -- on the LHS of the equation, and - -- - extra_kvars, which is one of the following: - -- * For type family instances, extra_kvars are the free kind - -- variables mentioned in an outermost kind signature on the RHS - -- of the equation. - -- (See Note [Implicit quantification in type synonyms] in - -- GHC.Rename.HsType.) - -- * For data family instances, extra_kvars are the free kind - -- variables mentioned in the explicit return kind, if one is - -- provided. (e.g., the `k` in `data instance T :: k -> Type`). + -- ignoring pat_kity_vars, the free variables mentioned in the type patterns + -- on the LHS of the equation -- -- Some examples: -- @@ -678,8 +663,6 @@ rnFamEqn doc atfi extra_kvars -- type family G :: Maybe a -- type instance forall a. G = (Nothing :: Maybe a) -- -- all_imp_vars = [] - -- type instance G = (Nothing :: Maybe a) - -- -- all_imp_vars = [a] -- -- data family H :: k -> Type -- data instance forall k. H :: k -> Type where ... @@ -690,7 +673,7 @@ rnFamEqn doc atfi extra_kvars -- -- For associated type family instances, exclude the type variables -- bound by the instance head with filterInScopeM (#19649). - ; all_imp_vars <- filterInScopeM $ pat_kity_vars ++ extra_kvars + ; all_imp_vars <- filterInScopeM $ pat_kity_vars ; bindHsOuterTyVarBndrs doc mb_cls all_imp_vars outer_bndrs $ \rn_outer_bndrs -> do { (pats', pat_fvs) <- rnLHsTypeArgs (FamPatCtx tycon) pats @@ -727,21 +710,12 @@ rnFamEqn doc atfi extra_kvars -- associated family instance but not bound on the LHS, then reject -- that type variable as being out of scope. -- See Note [Renaming associated types]. - -- Per that Note, the LHS type variables consist of: - -- - -- - The variables mentioned in the instance's type patterns - -- (pat_fvs), and - -- - -- - The variables mentioned in an outermost kind signature on the - -- RHS. This is a subset of `rhs_fvs`. To compute it, we look up - -- each RdrName in `extra_kvars` to find its corresponding Name in - -- the LocalRdrEnv. - ; extra_kvar_nms <- mapMaybeM (lookupLocalOccRn_maybe . unLoc) extra_kvars - ; let lhs_bound_vars = pat_fvs `extendNameSetList` extra_kvar_nms - improperly_scoped cls_tkv = + -- Per that Note, the LHS type variables consist of the variables + -- mentioned in the instance's type patterns (pat_fvs) + ; let improperly_scoped cls_tkv = cls_tkv `elemNameSet` rhs_fvs -- Mentioned on the RHS... - && not (cls_tkv `elemNameSet` lhs_bound_vars) + && not (cls_tkv `elemNameSet` pat_fvs) -- ...but not bound on the LHS. bad_tvs = filter improperly_scoped inst_head_tvs ; unless (null bad_tvs) (addErr (TcRnBadAssocRhs bad_tvs)) @@ -786,7 +760,7 @@ rnFamEqn doc atfi extra_kvars -- -- type instance F a b c = Either a b -- ^^^^^ - lhs_loc = case map lhsTypeArgSrcSpan pats ++ map getLocA extra_kvars of + lhs_loc = case map lhsTypeArgSrcSpan pats of [] -> panic "rnFamEqn.lhs_loc" [loc] -> loc (loc:locs) -> loc `combineSrcSpans` last locs @@ -845,10 +819,9 @@ data ClosedTyFamInfo rnTyFamInstEqn :: AssocTyFamInfo -> TyFamInstEqn GhcPs -> RnM (TyFamInstEqn GhcRn, FreeVars) -rnTyFamInstEqn atfi eqn@(FamEqn { feqn_tycon = tycon, feqn_rhs = rhs }) - = rnFamEqn (TySynCtx tycon) atfi extra_kvs eqn rnTySyn - where - extra_kvs = extractHsTyRdrTyVarsKindVars rhs +rnTyFamInstEqn atfi eqn@(FamEqn { feqn_tycon = tycon }) + = rnFamEqn (TySynCtx tycon) atfi eqn rnTySyn + rnTyFamDefltDecl :: Name -> TyFamDefltDecl GhcPs @@ -859,11 +832,9 @@ rnDataFamInstDecl :: AssocTyFamInfo -> DataFamInstDecl GhcPs -> RnM (DataFamInstDecl GhcRn, FreeVars) rnDataFamInstDecl atfi (DataFamInstDecl { dfid_eqn = - eqn@(FamEqn { feqn_tycon = tycon - , feqn_rhs = rhs })}) - = do { let extra_kvs = extractDataDefnKindVars rhs - ; (eqn', fvs) <- - rnFamEqn (TyDataCtx tycon) atfi extra_kvs eqn rnDataDefn + eqn@(FamEqn { feqn_tycon = tycon })}) + = do { (eqn', fvs) <- + rnFamEqn (TyDataCtx tycon) atfi eqn rnDataDefn ; return (DataFamInstDecl { dfid_eqn = eqn' }, fvs) } -- Renaming of the associated types in instances. @@ -949,10 +920,7 @@ a class, we must check that all of the type variables mentioned on the RHS are properly scoped. Specifically, the rule is this: Every variable mentioned on the RHS of a type instance declaration - (whether associated or not) must be either - * Mentioned on the LHS, or - * Mentioned in an outermost kind signature on the RHS - (see Note [Implicit quantification in type synonyms]) + (whether associated or not) must be mentioned on the LHS Here is a simple example of something we should reject: @@ -962,8 +930,7 @@ Here is a simple example of something we should reject: type F Int x = z Here, `z` is mentioned on the RHS of the associated instance without being -mentioned on the LHS, nor is `z` mentioned in an outermost kind signature. The -renamer will reject `z` as being out of scope without much fuss. +mentioned on the LHS. The renamer will reject `z` as being out of scope without much fuss. Things get slightly trickier when the instance header itself binds type variables. Consider this example (adapted from #5515): @@ -1055,10 +1022,8 @@ Some additional wrinkles: Note that the `o` in the `Codomain 'KProxy` instance should be considered improperly scoped. It does not meet the criteria for being explicitly - quantified, as it is not mentioned by name on the LHS, nor does it meet the - criteria for being implicitly quantified, as it is used in a RHS kind - signature that is not outermost (see Note [Implicit quantification in type - synonyms]). However, `o` /is/ bound by the instance header, so if this + quantified, as it is not mentioned by name on the LHS. + However, `o` /is/ bound by the instance header, so if this program is not rejected by the renamer, the typechecker would treat it as though you had written this: @@ -1070,6 +1035,12 @@ Some additional wrinkles: If the user really wants the latter, it is simple enough to communicate their intent by mentioning `o` on the LHS by name. +* Historical note: Previously we had to add type variables from the outermost + kind signature on the RHS to the scope of associated type family instance, + i.e. GHC did implicit quantification over them. But now that we implement + GHC Proposal #425 "Invisible binders in type declarations" + we don't need to do this anymore. + Note [Type family equations and occurrences] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In most data/type family equations, the type family name used in the equation ===================================== compiler/GHC/ThToHs.hs ===================================== @@ -2177,9 +2177,11 @@ thRdrNameGuesses (TH.Name occ flavour) where -- guessed_ns are the name spaces guessed from looking at the TH name guessed_nss - | isLexCon (mkFastString occ_str) = [OccName.tcName, OccName.dataName] - | otherwise = [OccName.varName, OccName.tvName] + | isLexCon occ_txt = [OccName.tcName, OccName.dataName] + | isLexVarSym occ_txt = [OccName.tcName, OccName.varName] -- #23525 + | otherwise = [OccName.varName, OccName.tvName] occ_str = TH.occString occ + occ_txt = mkFastString occ_str -- The packing and unpacking is rather turgid :-( mk_occ :: OccName.NameSpace -> String -> OccName.OccName ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -19,6 +19,22 @@ Language This feature is guarded behind :extension:`TypeAbstractions`. +- In accordance with GHC proposal `#425 + `_ + GHC no longer implicitly quantifies over type variables that appear only in the RHS of type and + data family instances. This code will no longer work: :: + + type family F1 a :: k + type instance F1 Int = Any :: j -> j + + Instead you should write:: + + type instance F1 @(j -> j) Int = Any :: j -> j + + Or:: + + type instance forall j . F1 Int = Any :: j -> j + Compiler ~~~~~~~~ ===================================== libraries/base/GHC/Base.hs ===================================== @@ -806,11 +806,21 @@ class Functor f => Applicative f where (<*) :: f a -> f b -> f a (<*) = liftA2 const --- | A variant of '<*>' with the arguments reversed. +-- | A variant of '<*>' with the types of the arguments reversed. It differs from +-- @`flip` `(<*>)`@ in that the effects are resolved in the order the arguments are +-- presented. -- +-- ==== __Examples__ +-- >>> (<**>) (print 1) (id <$ print 2) +-- 1 +-- 2 +-- +-- >>> flip (<*>) (print 1) (id <$ print 2) +-- 2 +-- 1 + (<**>) :: Applicative f => f a -> f (a -> b) -> f b (<**>) = liftA2 (\a f -> f a) --- Don't use $ here, see the note at the top of the page -- | Lift a function to actions. -- Equivalent to Functor's `fmap` but implemented using only `Applicative`'s methods: ===================================== libraries/stm ===================================== @@ -1 +1 @@ -Subproject commit cfb7e775c5f6df281b7052b7b4e4a51dafda10d2 +Subproject commit 86172e75bd4f5c400b3a6f0cd3945bdb7c03bcdd ===================================== rts/js/environment.js ===================================== @@ -411,14 +411,6 @@ function h$gettimeofday(tv_v,tv_o,tz_v,tz_o) { return 0; } -function h$traceEvent(ev_v,ev_o) { - h$errorMsg(h$decodeUtf8z(ev_v, ev_o)); -} - -function h$traceMarker(ev_v,ev_o) { - h$errorMsg(h$decodeUtf8z(ev_v, ev_o)); -} - var h$__hscore_gettimeofday = h$gettimeofday; var h$myTimeZone = h$encodeUtf8("UTC"); ===================================== rts/js/eventlog.js ===================================== @@ -0,0 +1,18 @@ +// default eventlog writer: does nothing +var h$event_log_writer = (a,o) => {return;} + +// redirect the eventlog to stderr +function h$eventlogToStderr() { + h$event_log_writer = (a,o) => h$errorMsg(h$decodeUtf8z(a,o)); +} + +function h$traceEvent(ev_v,ev_o) { + h$event_log_writer(ev_v,ev_o); +} + +function h$traceMarker(ev_v,ev_o) { + h$event_log_writer(ev_v,ev_o); +} + +function h$flushEventlog(cap_a,cap_o) { +} ===================================== rts/rts.cabal.in ===================================== @@ -94,6 +94,7 @@ library js/debug.js js/enum.js js/environment.js + js/eventlog.js js/gc.js js/goog.js js/hscore.js ===================================== testsuite/tests/cabal/t22333/all.T ===================================== @@ -1,4 +1,4 @@ test('T22333', - [extra_files(['Setup.hs', 'my-exe', 'my-package-a', 'my-package-b' ]), js_broken(22573)], + [extra_files(['Setup.hs', 'my-exe', 'my-package-a', 'my-package-b' ]), js_broken(22349)], makefile_test, []) ===================================== testsuite/tests/indexed-types/should_compile/T14131.hs ===================================== @@ -9,21 +9,21 @@ import Data.Kind import Data.Proxy data family Nat :: k -> k -> Type -newtype instance Nat :: (k -> Type) -> (k -> Type) -> Type where +newtype instance Nat :: forall k . (k -> Type) -> (k -> Type) -> Type where Nat :: (forall xx. f xx -> g xx) -> Nat f g type family F :: Maybe a -type instance F = (Nothing :: Maybe a) +type instance F @a = (Nothing :: Maybe a) class C k where data CD :: k -> k -> Type type CT :: k instance C (Maybe a) where - data CD :: Maybe a -> Maybe a -> Type where + data CD @(Maybe a) :: Maybe a -> Maybe a -> Type where CD :: forall a (m :: Maybe a) (n :: Maybe a). Proxy m -> Proxy n -> CD m n - type CT = (Nothing :: Maybe a) + type CT @(Maybe a) = (Nothing :: Maybe a) class Z k where type ZT :: Maybe k - type ZT = (Nothing :: Maybe k) + type ZT @k = (Nothing :: Maybe k) ===================================== testsuite/tests/indexed-types/should_compile/T15852.hs ===================================== @@ -7,4 +7,4 @@ import Data.Kind import Data.Proxy data family DF a (b :: k) -data instance DF (Proxy c) :: Proxy j -> Type +data instance DF @(Proxy j) (Proxy c) :: Proxy j -> Type ===================================== testsuite/tests/indexed-types/should_compile/T15852.stderr ===================================== @@ -3,10 +3,10 @@ TYPE CONSTRUCTORS roles nominal nominal nominal COERCION AXIOMS axiom T15852.D:R:DFProxyProxy0 :: - forall k1 k2 (c :: k1) (j :: k2). - DF (Proxy c) = T15852.R:DFProxyProxy k1 k2 c j + forall k1 k2 (j :: k1) (c :: k2). + DF (Proxy c) = T15852.R:DFProxyProxy k1 k2 j c FAMILY INSTANCES - data instance forall {k1} {k2} {c :: k1} {j :: k2}. + data instance forall {k1} {k2} {j :: k1} {c :: k2}. DF (Proxy c) -- Defined at T15852.hs:10:15 Dependent modules: [] -Dependent packages: [base-4.17.0.0] +Dependent packages: [base-4.18.0.0] ===================================== testsuite/tests/indexed-types/should_fail/T14230.hs ===================================== @@ -8,4 +8,4 @@ class C k where data CD :: k -> k -> * instance C (Maybe a) where - data CD :: (k -> *) -> (k -> *) -> * + data forall k . CD :: (k -> *) -> (k -> *) -> * ===================================== testsuite/tests/indexed-types/should_fail/T7938.hs ===================================== @@ -9,4 +9,4 @@ class Foo (a :: k1) (b :: k2) where type Bar a instance Foo (a :: k1) (b :: k2) where - type Bar a = (KP :: KProxy k2) + type forall k2 . Bar a = (KP :: KProxy k2) ===================================== testsuite/tests/indexed-types/should_fail/T7938.stderr ===================================== @@ -1,5 +1,5 @@ -T7938.hs:12:17: error: [GHC-83865] +T7938.hs:12:29: error: [GHC-83865] • Expected a type, but ‘KP :: KProxy k2’ has kind ‘KProxy k2’ • In the type ‘(KP :: KProxy k2)’ In the type instance declaration for ‘Bar’ ===================================== testsuite/tests/rename/should_compile/T23512b.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies, TypeAbstractions #-} +module T23512b where +import GHC.Types + +type family F2 a :: k +type instance F2 @(j -> j) Int = Any :: j -> j + +type family F3 a :: k +type instance forall j. F3 Int = Any :: j -> j ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -213,3 +213,4 @@ test('T23240', [req_th, extra_files(['T23240_aux.hs'])], multimod_compile, ['T23 test('T23318', normal, compile, ['-Wduplicate-exports']) test('T23434', normal, compile, ['']) test('T23510b', normal, compile, ['']) +test('T23512b', normal, compile, ['']) ===================================== testsuite/tests/rename/should_fail/T23512a.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies #-} +module T23512a where +import GHC.Types + +type family F1 a :: k +type instance F1 Int = Any :: j -> j + +data family D :: k -> Type +data instance D :: k -> Type ===================================== testsuite/tests/rename/should_fail/T23512a.stderr ===================================== @@ -0,0 +1,6 @@ + +T23512a.hs:6:31: error: [GHC-76037] Not in scope: type variable ‘j’ + +T23512a.hs:6:36: error: [GHC-76037] Not in scope: type variable ‘j’ + +T23512a.hs:9:20: error: [GHC-76037] Not in scope: type variable ‘k’ ===================================== testsuite/tests/rename/should_fail/all.T ===================================== @@ -203,3 +203,4 @@ test('T23510a', normal, compile_fail, ['']) test('T16635a', normal, compile_fail, ['']) test('T16635b', normal, compile_fail, ['']) test('T16635c', normal, compile_fail, ['']) +test('T23512a', normal, compile_fail, ['']) ===================================== testsuite/tests/safeHaskell/check/pkg01/all.T ===================================== @@ -53,7 +53,7 @@ test('ImpSafe03', test('ImpSafe04', normalise_version('base'), compile_fail, ['-fpackage-trust -distrust base']) test('ImpSafeOnly01', - [js_broken(22350), + [js_broken(22349), req_host_target_ghc, extra_files(['M_SafePkg.hs', 'M_SafePkg2.hs', 'M_SafePkg3.hs', 'M_SafePkg4.hs', 'M_SafePkg5.hs', 'M_SafePkg6.hs', 'M_SafePkg7.hs', 'M_SafePkg8.hs', 'Setup.hs', 'p.cabal']), pre_cmd('$MAKE -s --no-print-directory mkPackageDatabase.ImpSafeOnly01 ' + make_args)], @@ -61,7 +61,7 @@ test('ImpSafeOnly01', ['-fpackage-trust -package-db pdb.ImpSafeOnly01/local.db -trust base']) test('ImpSafeOnly02', - [js_broken(22350), + [js_broken(22349), req_host_target_ghc, extra_files(['M_SafePkg.hs', 'M_SafePkg2.hs', 'M_SafePkg3.hs', 'M_SafePkg4.hs', 'M_SafePkg5.hs', 'M_SafePkg6.hs', 'M_SafePkg7.hs', 'M_SafePkg8.hs', 'Setup.hs', 'p.cabal']), pre_cmd('$MAKE -s --no-print-directory mkPackageDatabase.ImpSafeOnly02 ' + make_args)], @@ -70,7 +70,7 @@ test('ImpSafeOnly02', # Fail since we enable package trust (and still need safePkg01 trusted) test('ImpSafeOnly03', - [js_broken(22350), + [js_broken(22349), req_host_target_ghc, extra_files(['M_SafePkg.hs', 'M_SafePkg2.hs', 'M_SafePkg3.hs', 'M_SafePkg4.hs', 'M_SafePkg5.hs', 'M_SafePkg6.hs', 'M_SafePkg7.hs', 'M_SafePkg8.hs', 'Setup.hs', 'p.cabal']), pre_cmd('$MAKE -s --no-print-directory mkPackageDatabase.ImpSafeOnly03 ' + make_args)], @@ -79,7 +79,7 @@ test('ImpSafeOnly03', # Succeed since we don't enable package trust test('ImpSafeOnly04', - [js_broken(22350), + [js_broken(22349), req_host_target_ghc, extra_files(['M_SafePkg.hs', 'M_SafePkg2.hs', 'M_SafePkg3.hs', 'M_SafePkg4.hs', 'M_SafePkg5.hs', 'M_SafePkg6.hs', 'M_SafePkg7.hs', 'M_SafePkg8.hs', 'Setup.hs', 'p.cabal']), pre_cmd('$MAKE -s --no-print-directory mkPackageDatabase.ImpSafeOnly04 ' + make_args)], @@ -87,14 +87,14 @@ test('ImpSafeOnly04', # fail due to missing trust of safePkg01, next test succeeds. test('ImpSafeOnly05', - [js_broken(22350), + [js_broken(22349), req_host_target_ghc, extra_files(['M_SafePkg.hs', 'M_SafePkg2.hs', 'M_SafePkg3.hs', 'M_SafePkg4.hs', 'M_SafePkg5.hs', 'M_SafePkg6.hs', 'M_SafePkg7.hs', 'M_SafePkg8.hs', 'Setup.hs', 'p.cabal']), pre_cmd('$MAKE -s --no-print-directory mkPackageDatabase.ImpSafeOnly05 ' + make_args)], compile_fail, ['-fpackage-trust -package-db pdb.ImpSafeOnly05/local.db -trust base']) test('ImpSafeOnly06', - [js_broken(22350), + [js_broken(22349), req_host_target_ghc, extra_files(['M_SafePkg.hs', 'M_SafePkg2.hs', 'M_SafePkg3.hs', 'M_SafePkg4.hs', 'M_SafePkg5.hs', 'M_SafePkg6.hs', 'M_SafePkg7.hs', 'M_SafePkg8.hs', 'Setup.hs', 'p.cabal']), pre_cmd('$MAKE -s --no-print-directory mkPackageDatabase.ImpSafeOnly06 ' + make_args)], @@ -103,7 +103,7 @@ test('ImpSafeOnly06', # fail due to missing trust test('ImpSafeOnly07', - [js_broken(22350), + [js_broken(22349), req_host_target_ghc, extra_files(['M_SafePkg.hs', 'M_SafePkg2.hs', 'M_SafePkg3.hs', 'M_SafePkg4.hs', 'M_SafePkg5.hs', 'M_SafePkg6.hs', 'M_SafePkg7.hs', 'M_SafePkg8.hs', 'Setup.hs', 'p.cabal']), pre_cmd('$MAKE -s --no-print-directory mkPackageDatabase.ImpSafeOnly07 ' + make_args), @@ -111,7 +111,7 @@ test('ImpSafeOnly07', compile_fail, ['-fpackage-trust -package-db pdb.ImpSafeOnly07/local.db -trust safePkg01 -distrust bytestring']) test('ImpSafeOnly08', - [js_broken(22350), + [js_broken(22349), req_host_target_ghc, extra_files(['M_SafePkg.hs', 'M_SafePkg2.hs', 'M_SafePkg3.hs', 'M_SafePkg4.hs', 'M_SafePkg5.hs', 'M_SafePkg6.hs', 'M_SafePkg7.hs', 'M_SafePkg8.hs', 'Setup.hs', 'p.cabal']), pre_cmd('$MAKE -s --no-print-directory mkPackageDatabase.ImpSafeOnly08 ' + make_args), @@ -119,7 +119,7 @@ test('ImpSafeOnly08', compile_fail, ['-fpackage-trust -package-db pdb.ImpSafeOnly08/local.db -trust safePkg01']) test('ImpSafeOnly09', - [js_broken(22350), + [js_broken(22349), req_host_target_ghc, extra_files(['M_SafePkg.hs', 'M_SafePkg2.hs', 'M_SafePkg3.hs', 'M_SafePkg4.hs', 'M_SafePkg5.hs', 'M_SafePkg6.hs', 'M_SafePkg7.hs', 'M_SafePkg8.hs', 'Setup.hs', 'p.cabal']), pre_cmd('$MAKE -s --no-print-directory mkPackageDatabase.ImpSafeOnly09 ' + make_args), @@ -129,7 +129,7 @@ test('ImpSafeOnly09', # finally succeed test('ImpSafeOnly10', - [js_broken(22350), + [js_broken(22349), req_host_target_ghc, extra_files(['M_SafePkg.hs', 'M_SafePkg2.hs', 'M_SafePkg3.hs', 'M_SafePkg4.hs', 'M_SafePkg5.hs', 'M_SafePkg6.hs', 'M_SafePkg7.hs', 'M_SafePkg8.hs', 'Setup.hs', 'p.cabal']), pre_cmd('$MAKE -s --no-print-directory mkPackageDatabase.ImpSafeOnly10 ' + make_args)], ===================================== testsuite/tests/th/T23525.hs ===================================== @@ -0,0 +1,6 @@ +{-# LANGUAGE TemplateHaskell #-} +module T23525 where + +import Language.Haskell.TH + +$(sequence [withDecDoc "doc string" $ tySynD (mkName ">-:") [] [t| () |]]) ===================================== testsuite/tests/th/all.T ===================================== @@ -576,3 +576,4 @@ test('T21050', normal, compile_fail, ['']) test('T22559a', normal, compile_fail, ['']) test('T22559b', normal, compile_fail, ['']) test('T22559c', normal, compile_fail, ['']) +test('T23525', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/T15797.hs ===================================== @@ -13,7 +13,7 @@ import Data.Kind class Ríki (obj :: Type) where type Obj :: obj -> Constraint - type Obj = Bæ @k :: k -> Constraint + type forall k . Obj = Bæ @k :: k -> Constraint class Bæ (a :: k) instance Bæ @k (a :: k) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/68bff0a947e1133d359c0b7eded5970a75c20113...3759b78512cb8c0f2f567e39d30b78b69d232b65 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/68bff0a947e1133d359c0b7eded5970a75c20113...3759b78512cb8c0f2f567e39d30b78b69d232b65 You're receiving 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 Jun 18 06:50:50 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 18 Jun 2023 02:50:50 -0400 Subject: [Git][ghc/ghc][master] 2 commits: JS: testsuite: use correct ticket numbers Message-ID: <648ea94a9b12a_27146610c451c026459d@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 6 changed files: - libraries/stm - rts/js/environment.js - + rts/js/eventlog.js - rts/rts.cabal.in - testsuite/tests/cabal/t22333/all.T - testsuite/tests/safeHaskell/check/pkg01/all.T Changes: ===================================== libraries/stm ===================================== @@ -1 +1 @@ -Subproject commit cfb7e775c5f6df281b7052b7b4e4a51dafda10d2 +Subproject commit 86172e75bd4f5c400b3a6f0cd3945bdb7c03bcdd ===================================== rts/js/environment.js ===================================== @@ -411,14 +411,6 @@ function h$gettimeofday(tv_v,tv_o,tz_v,tz_o) { return 0; } -function h$traceEvent(ev_v,ev_o) { - h$errorMsg(h$decodeUtf8z(ev_v, ev_o)); -} - -function h$traceMarker(ev_v,ev_o) { - h$errorMsg(h$decodeUtf8z(ev_v, ev_o)); -} - var h$__hscore_gettimeofday = h$gettimeofday; var h$myTimeZone = h$encodeUtf8("UTC"); ===================================== rts/js/eventlog.js ===================================== @@ -0,0 +1,18 @@ +// default eventlog writer: does nothing +var h$event_log_writer = (a,o) => {return;} + +// redirect the eventlog to stderr +function h$eventlogToStderr() { + h$event_log_writer = (a,o) => h$errorMsg(h$decodeUtf8z(a,o)); +} + +function h$traceEvent(ev_v,ev_o) { + h$event_log_writer(ev_v,ev_o); +} + +function h$traceMarker(ev_v,ev_o) { + h$event_log_writer(ev_v,ev_o); +} + +function h$flushEventlog(cap_a,cap_o) { +} ===================================== rts/rts.cabal.in ===================================== @@ -94,6 +94,7 @@ library js/debug.js js/enum.js js/environment.js + js/eventlog.js js/gc.js js/goog.js js/hscore.js ===================================== testsuite/tests/cabal/t22333/all.T ===================================== @@ -1,4 +1,4 @@ test('T22333', - [extra_files(['Setup.hs', 'my-exe', 'my-package-a', 'my-package-b' ]), js_broken(22573)], + [extra_files(['Setup.hs', 'my-exe', 'my-package-a', 'my-package-b' ]), js_broken(22349)], makefile_test, []) ===================================== testsuite/tests/safeHaskell/check/pkg01/all.T ===================================== @@ -53,7 +53,7 @@ test('ImpSafe03', test('ImpSafe04', normalise_version('base'), compile_fail, ['-fpackage-trust -distrust base']) test('ImpSafeOnly01', - [js_broken(22350), + [js_broken(22349), req_host_target_ghc, extra_files(['M_SafePkg.hs', 'M_SafePkg2.hs', 'M_SafePkg3.hs', 'M_SafePkg4.hs', 'M_SafePkg5.hs', 'M_SafePkg6.hs', 'M_SafePkg7.hs', 'M_SafePkg8.hs', 'Setup.hs', 'p.cabal']), pre_cmd('$MAKE -s --no-print-directory mkPackageDatabase.ImpSafeOnly01 ' + make_args)], @@ -61,7 +61,7 @@ test('ImpSafeOnly01', ['-fpackage-trust -package-db pdb.ImpSafeOnly01/local.db -trust base']) test('ImpSafeOnly02', - [js_broken(22350), + [js_broken(22349), req_host_target_ghc, extra_files(['M_SafePkg.hs', 'M_SafePkg2.hs', 'M_SafePkg3.hs', 'M_SafePkg4.hs', 'M_SafePkg5.hs', 'M_SafePkg6.hs', 'M_SafePkg7.hs', 'M_SafePkg8.hs', 'Setup.hs', 'p.cabal']), pre_cmd('$MAKE -s --no-print-directory mkPackageDatabase.ImpSafeOnly02 ' + make_args)], @@ -70,7 +70,7 @@ test('ImpSafeOnly02', # Fail since we enable package trust (and still need safePkg01 trusted) test('ImpSafeOnly03', - [js_broken(22350), + [js_broken(22349), req_host_target_ghc, extra_files(['M_SafePkg.hs', 'M_SafePkg2.hs', 'M_SafePkg3.hs', 'M_SafePkg4.hs', 'M_SafePkg5.hs', 'M_SafePkg6.hs', 'M_SafePkg7.hs', 'M_SafePkg8.hs', 'Setup.hs', 'p.cabal']), pre_cmd('$MAKE -s --no-print-directory mkPackageDatabase.ImpSafeOnly03 ' + make_args)], @@ -79,7 +79,7 @@ test('ImpSafeOnly03', # Succeed since we don't enable package trust test('ImpSafeOnly04', - [js_broken(22350), + [js_broken(22349), req_host_target_ghc, extra_files(['M_SafePkg.hs', 'M_SafePkg2.hs', 'M_SafePkg3.hs', 'M_SafePkg4.hs', 'M_SafePkg5.hs', 'M_SafePkg6.hs', 'M_SafePkg7.hs', 'M_SafePkg8.hs', 'Setup.hs', 'p.cabal']), pre_cmd('$MAKE -s --no-print-directory mkPackageDatabase.ImpSafeOnly04 ' + make_args)], @@ -87,14 +87,14 @@ test('ImpSafeOnly04', # fail due to missing trust of safePkg01, next test succeeds. test('ImpSafeOnly05', - [js_broken(22350), + [js_broken(22349), req_host_target_ghc, extra_files(['M_SafePkg.hs', 'M_SafePkg2.hs', 'M_SafePkg3.hs', 'M_SafePkg4.hs', 'M_SafePkg5.hs', 'M_SafePkg6.hs', 'M_SafePkg7.hs', 'M_SafePkg8.hs', 'Setup.hs', 'p.cabal']), pre_cmd('$MAKE -s --no-print-directory mkPackageDatabase.ImpSafeOnly05 ' + make_args)], compile_fail, ['-fpackage-trust -package-db pdb.ImpSafeOnly05/local.db -trust base']) test('ImpSafeOnly06', - [js_broken(22350), + [js_broken(22349), req_host_target_ghc, extra_files(['M_SafePkg.hs', 'M_SafePkg2.hs', 'M_SafePkg3.hs', 'M_SafePkg4.hs', 'M_SafePkg5.hs', 'M_SafePkg6.hs', 'M_SafePkg7.hs', 'M_SafePkg8.hs', 'Setup.hs', 'p.cabal']), pre_cmd('$MAKE -s --no-print-directory mkPackageDatabase.ImpSafeOnly06 ' + make_args)], @@ -103,7 +103,7 @@ test('ImpSafeOnly06', # fail due to missing trust test('ImpSafeOnly07', - [js_broken(22350), + [js_broken(22349), req_host_target_ghc, extra_files(['M_SafePkg.hs', 'M_SafePkg2.hs', 'M_SafePkg3.hs', 'M_SafePkg4.hs', 'M_SafePkg5.hs', 'M_SafePkg6.hs', 'M_SafePkg7.hs', 'M_SafePkg8.hs', 'Setup.hs', 'p.cabal']), pre_cmd('$MAKE -s --no-print-directory mkPackageDatabase.ImpSafeOnly07 ' + make_args), @@ -111,7 +111,7 @@ test('ImpSafeOnly07', compile_fail, ['-fpackage-trust -package-db pdb.ImpSafeOnly07/local.db -trust safePkg01 -distrust bytestring']) test('ImpSafeOnly08', - [js_broken(22350), + [js_broken(22349), req_host_target_ghc, extra_files(['M_SafePkg.hs', 'M_SafePkg2.hs', 'M_SafePkg3.hs', 'M_SafePkg4.hs', 'M_SafePkg5.hs', 'M_SafePkg6.hs', 'M_SafePkg7.hs', 'M_SafePkg8.hs', 'Setup.hs', 'p.cabal']), pre_cmd('$MAKE -s --no-print-directory mkPackageDatabase.ImpSafeOnly08 ' + make_args), @@ -119,7 +119,7 @@ test('ImpSafeOnly08', compile_fail, ['-fpackage-trust -package-db pdb.ImpSafeOnly08/local.db -trust safePkg01']) test('ImpSafeOnly09', - [js_broken(22350), + [js_broken(22349), req_host_target_ghc, extra_files(['M_SafePkg.hs', 'M_SafePkg2.hs', 'M_SafePkg3.hs', 'M_SafePkg4.hs', 'M_SafePkg5.hs', 'M_SafePkg6.hs', 'M_SafePkg7.hs', 'M_SafePkg8.hs', 'Setup.hs', 'p.cabal']), pre_cmd('$MAKE -s --no-print-directory mkPackageDatabase.ImpSafeOnly09 ' + make_args), @@ -129,7 +129,7 @@ test('ImpSafeOnly09', # finally succeed test('ImpSafeOnly10', - [js_broken(22350), + [js_broken(22349), req_host_target_ghc, extra_files(['M_SafePkg.hs', 'M_SafePkg2.hs', 'M_SafePkg3.hs', 'M_SafePkg4.hs', 'M_SafePkg5.hs', 'M_SafePkg6.hs', 'M_SafePkg7.hs', 'M_SafePkg8.hs', 'Setup.hs', 'p.cabal']), pre_cmd('$MAKE -s --no-print-directory mkPackageDatabase.ImpSafeOnly10 ' + make_args)], View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/800aad7ea83e6b56798a953511acbd336af3f253...c3a1274c451795bc126234aedf02fbc21f8c4a79 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/800aad7ea83e6b56798a953511acbd336af3f253...c3a1274c451795bc126234aedf02fbc21f8c4a79 You're receiving 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 Jun 18 06:51:31 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Sun, 18 Jun 2023 02:51:31 -0400 Subject: [Git][ghc/ghc][master] Fix TH name lookup for symbolic tycons (#23525) Message-ID: <648ea97347564_271466110a3f78268053@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - 3 changed files: - compiler/GHC/ThToHs.hs - + testsuite/tests/th/T23525.hs - testsuite/tests/th/all.T Changes: ===================================== compiler/GHC/ThToHs.hs ===================================== @@ -2177,9 +2177,11 @@ thRdrNameGuesses (TH.Name occ flavour) where -- guessed_ns are the name spaces guessed from looking at the TH name guessed_nss - | isLexCon (mkFastString occ_str) = [OccName.tcName, OccName.dataName] - | otherwise = [OccName.varName, OccName.tvName] + | isLexCon occ_txt = [OccName.tcName, OccName.dataName] + | isLexVarSym occ_txt = [OccName.tcName, OccName.varName] -- #23525 + | otherwise = [OccName.varName, OccName.tvName] occ_str = TH.occString occ + occ_txt = mkFastString occ_str -- The packing and unpacking is rather turgid :-( mk_occ :: OccName.NameSpace -> String -> OccName.OccName ===================================== testsuite/tests/th/T23525.hs ===================================== @@ -0,0 +1,6 @@ +{-# LANGUAGE TemplateHaskell #-} +module T23525 where + +import Language.Haskell.TH + +$(sequence [withDecDoc "doc string" $ tySynD (mkName ">-:") [] [t| () |]]) ===================================== testsuite/tests/th/all.T ===================================== @@ -576,3 +576,4 @@ test('T21050', normal, compile_fail, ['']) test('T22559a', normal, compile_fail, ['']) test('T22559b', normal, compile_fail, ['']) test('T22559c', normal, compile_fail, ['']) +test('T23525', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/89bb8ad8b5fa56b83fe80dd6d7147ad81ae4e74d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/89bb8ad8b5fa56b83fe80dd6d7147ad81ae4e74d You're receiving 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 Jun 18 23:56:16 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 18 Jun 2023 19:56:16 -0400 Subject: [Git][ghc/ghc][wip/haddock-mem-fixes] 12 commits: JS: factorize SaneDouble into its own module Message-ID: <648f99a01bfa6_27146630abf9983724df@gitlab.mail> Ben Gamari pushed to branch wip/haddock-mem-fixes at Glasgow Haskell Compiler / GHC Commits: a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - bbdf8b89 by Finley McIlwaine at 2023-06-18T19:56:01-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Metric Decrease: haddock.base - - - - - 16323f4a by Finley McIlwaine at 2023-06-18T19:56:11-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 30 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/JS/Syntax.hs - compiler/GHC/JS/Unsat/Syntax.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/StgToJS/Types.hs - compiler/GHC/ThToHs.hs - + compiler/GHC/Types/SaneDouble.hs - compiler/ghc.cabal.in - docs/users_guide/9.8.1-notes.rst - libraries/base/GHC/Base.hs - libraries/stm - rts/js/environment.js - + rts/js/eventlog.js - rts/rts.cabal.in - testsuite/tests/cabal/t22333/all.T - testsuite/tests/haddock/perf/Fold.hs - testsuite/tests/haddock/perf/Makefile - testsuite/tests/indexed-types/should_compile/T14131.hs - testsuite/tests/indexed-types/should_compile/T15852.hs - testsuite/tests/indexed-types/should_compile/T15852.stderr - testsuite/tests/indexed-types/should_fail/T14230.hs - testsuite/tests/indexed-types/should_fail/T7938.hs - testsuite/tests/indexed-types/should_fail/T7938.stderr - + testsuite/tests/rename/should_compile/T23512b.hs - testsuite/tests/rename/should_compile/all.T - + testsuite/tests/rename/should_fail/T23512a.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/22e25a96fb0e4d918644f95ad0e82c9e685b4365...16323f4a69ab3a2c5bed410d7ad01efe93ce50c7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/22e25a96fb0e4d918644f95ad0e82c9e685b4365...16323f4a69ab3a2c5bed410d7ad01efe93ce50c7 You're receiving 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 Jun 18 23:56:43 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Sun, 18 Jun 2023 19:56:43 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] 13 commits: JS: factorize SaneDouble into its own module Message-ID: <648f99bbd88a4_2714663068f24c373565@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - bbdf8b89 by Finley McIlwaine at 2023-06-18T19:56:01-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Metric Decrease: haddock.base - - - - - 16323f4a by Finley McIlwaine at 2023-06-18T19:56:11-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - e6c931d5 by Ben Gamari at 2023-06-18T19:56:29-04:00 configure: Bump version to 9.8 - - - - - 30 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/JS/Syntax.hs - compiler/GHC/JS/Unsat/Syntax.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/StgToJS/Object.hs - compiler/GHC/StgToJS/Types.hs - compiler/GHC/ThToHs.hs - + compiler/GHC/Types/SaneDouble.hs - compiler/ghc.cabal.in - configure.ac - docs/users_guide/9.8.1-notes.rst - libraries/base/GHC/Base.hs - libraries/stm - rts/js/environment.js - + rts/js/eventlog.js - rts/rts.cabal.in - testsuite/tests/cabal/t22333/all.T - testsuite/tests/haddock/perf/Fold.hs - testsuite/tests/haddock/perf/Makefile - testsuite/tests/indexed-types/should_compile/T14131.hs - testsuite/tests/indexed-types/should_compile/T15852.hs - testsuite/tests/indexed-types/should_compile/T15852.stderr - testsuite/tests/indexed-types/should_fail/T14230.hs - testsuite/tests/indexed-types/should_fail/T7938.hs - testsuite/tests/indexed-types/should_fail/T7938.stderr - + testsuite/tests/rename/should_compile/T23512b.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/02e6f5c02a87afd3c0e4829a5d8c73ee9b4470bd...e6c931d5bcfc0f55cb618a337e9cb6f38057b4f1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/02e6f5c02a87afd3c0e4829a5d8c73ee9b4470bd...e6c931d5bcfc0f55cb618a337e9cb6f38057b4f1 You're receiving 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 Jun 19 03:17:18 2023 From: gitlab at gitlab.haskell.org (Finley McIlwaine (@FinleyMcIlwaine)) Date: Sun, 18 Jun 2023 23:17:18 -0400 Subject: [Git][ghc/ghc][wip/ipe-data-compression] 63 commits: Don't report redundant Givens from quantified constraints Message-ID: <648fc8be90ad2_be462c5ff873648@gitlab.mail> Finley McIlwaine pushed to branch wip/ipe-data-compression at Glasgow Haskell Compiler / GHC Commits: 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - HACKING.md - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/JS/Make.hs - compiler/GHC/JS/Syntax.hs - compiler/GHC/JS/Unsat/Syntax.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Arg.hs - compiler/GHC/StgToJS/Closure.hs - compiler/GHC/StgToJS/CodeGen.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/905dec2d36034196cd07481226d359896c62c416...cb9e1ce4d3b9de5b75a92ae721a207a6bc250a78 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/905dec2d36034196cd07481226d359896c62c416...cb9e1ce4d3b9de5b75a92ae721a207a6bc250a78 You're receiving 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 Jun 19 07:10:27 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 19 Jun 2023 03:10:27 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: JS: testsuite: use correct ticket numbers Message-ID: <648fff6351e0b_be462c5ff8846c2@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - bbdf8b89 by Finley McIlwaine at 2023-06-18T19:56:01-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Metric Decrease: haddock.base - - - - - 16323f4a by Finley McIlwaine at 2023-06-18T19:56:11-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - f5873b88 by Finley McIlwaine at 2023-06-19T03:10:24-04:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Driver/Backend.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/ThToHs.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 - libraries/stm - m4/fp_find_libnuma.m4 - + m4/fp_find_libzstd.m4 - rts/IPE.c - rts/IPE.h - rts/include/rts/IPE.h - rts/js/environment.js - + rts/js/eventlog.js - rts/rts.cabal.in - testsuite/tests/cabal/t22333/all.T - testsuite/tests/haddock/perf/Fold.hs - testsuite/tests/haddock/perf/Makefile - testsuite/tests/rts/ipe/ipeEventLog_fromMap.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3759b78512cb8c0f2f567e39d30b78b69d232b65...f5873b887fd87e10c6c57fbbbf60d48fc17164f4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3759b78512cb8c0f2f567e39d30b78b69d232b65...f5873b887fd87e10c6c57fbbbf60d48fc17164f4 You're receiving 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 Jun 19 09:41:00 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 19 Jun 2023 05:41:00 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: IPE data compression Message-ID: <649022aca7115_be462c5f0814085c@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - e47ff7b1 by Gergő Érdi at 2023-06-19T05:40:55-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/GHC/Types/SourceText.hs - compiler/GHC/Unit/Module/ModIface.hs - compiler/GHC/Unit/Module/Warnings.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/tests/rts/ipe/ipeEventLog_fromMap.c - testsuite/tests/rts/ipe/ipeMap.c - testsuite/tests/rts/ipe/ipe_lib.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f5873b887fd87e10c6c57fbbbf60d48fc17164f4...e47ff7b14e61ee55b498d8348d6081c96bb8945d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f5873b887fd87e10c6c57fbbbf60d48fc17164f4...e47ff7b14e61ee55b498d8348d6081c96bb8945d You're receiving 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 Jun 19 10:44:48 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Mon, 19 Jun 2023 06:44:48 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/or-pats-match Message-ID: <649031a05979b_be462b59eca415371d@gitlab.mail> David pushed new branch wip/or-pats-match at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/or-pats-match You're receiving 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 Jun 19 10:46:56 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Mon, 19 Jun 2023 06:46:56 -0400 Subject: [Git][ghc/ghc][wip/or-pats-match] 9 commits: Implement Or Patterns (Proposal 0522) Message-ID: <649032201b39a_be462c5ff81539dd@gitlab.mail> David pushed to branch wip/or-pats-match at Glasgow Haskell Compiler / GHC Commits: 062a5a03 by David Knothe at 2023-06-01T11:19:36+02:00 Implement Or Patterns (Proposal 0522) This commit introduces a language extension, `OrPatterns`, as described in proposal 0522. It extends the syntax by the production `pat -> (one of pat1, ..., patk)`. The or-pattern `pat` succeeds iff one of the patterns `pat1`, ..., `patk` succeed, in this order. Currently, or-patterns cannot bind variables. They are still of great use as they discourage the use of wildcard patterns in favour of writing out all "default" cases explicitly: ``` isIrrefutableHsPat pat = case pat of ... (one of WildPat{}, VarPat{}, LazyPat{}) = True (one of PArrPat{}, ConPatIn{}, LitPat{}, NPat{}, NPlusKPat{}, ListPat{}) = False ``` This makes code safer where data types are extended now and then - just like GHC's `Pat` in the example when adding the new `OrPat` constructor. This would be catched by `-fwarn-incomplete-patterns`, but not when a wildcard pattern was used. - Update submodule haddock. - - - - - 2369239f by David Knothe at 2023-06-01T11:19:38+02:00 stuff - - - - - d5137966 by David Knothe at 2023-06-01T11:19:39+02:00 Implement empty one of - - - - - 1838cc63 by David Knothe at 2023-06-01T11:21:49+02:00 Prohibit TyApps - - - - - c6ae3f49 by David Knothe at 2023-06-01T11:21:50+02:00 Remove unused - - - - - a0155c1e by David Knothe at 2023-06-01T11:21:50+02:00 update submodule haddock - - - - - 24c5f66b by David Knothe at 2023-06-01T11:21:50+02:00 Update tests - - - - - c93c3ddd by David Knothe at 2023-06-09T14:23:36+02:00 Play around with Match - - - - - b23a7d4a by David Knothe at 2023-06-19T12:43:03+02:00 wip: OrPat match impl - - - - - 30 changed files: - + a.out - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match.hs-boot - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Monad.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/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/Utils/Zonk.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/89bb8ad8b5fa56b83fe80dd6d7147ad81ae4e74d...b23a7d4aed173efa2f13a841f32da6832f942b13 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/89bb8ad8b5fa56b83fe80dd6d7147ad81ae4e74d...b23a7d4aed173efa2f13a841f32da6832f942b13 You're receiving 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 Jun 19 10:49:33 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Mon, 19 Jun 2023 06:49:33 -0400 Subject: [Git][ghc/ghc][wip/or-pats] Deleted 1 commit: Update Monad.hs Message-ID: <649032bdb4e10_be462b5a7ed015414c@gitlab.mail> David pushed to branch wip/or-pats 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: 0ce8e9db by David at 2023-06-09T14:42:31+00:00 Update Monad.hs - - - - - 1 changed file: - compiler/GHC/HsToCore/Monad.hs Changes: ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -154,6 +154,7 @@ instance Outputable DsMatchContext where data EquationInfo = EqnMatch (Pat GhcTc) Origin EquationInfo | EqnDone (MatchResult CoreExpr) +mkEqnInfo :: [Pat GhcTc] -> Origin -> MatchResult CoreExpr -> EquationInfo mkEqnInfo [] _ rhs = EqnDone rhs mkEqnInfo (pat:pats) orig rhs = EqnMatch pat orig (mkEqnInfo pats orig rhs) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0ce8e9db366a28464869e6f1351015f2f3b1cce3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0ce8e9db366a28464869e6f1351015f2f3b1cce3 You're receiving 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 Jun 19 10:51:04 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Mon, 19 Jun 2023 06:51:04 -0400 Subject: [Git][ghc/ghc][wip/or-pats] Deleted 1 commit: Play around with Match Message-ID: <6490331875d19_be462b5a7ed01543e5@gitlab.mail> David pushed to branch wip/or-pats 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: c93c3ddd by David Knothe at 2023-06-09T14:23:36+02:00 Play around with Match - - - - - 7 changed files: - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match.hs-boot - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Utils.hs Changes: ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -204,9 +204,7 @@ dsUnliftedBind (PatBind { pat_lhs = pat, pat_rhs = grhss do { match_nablas <- pmcGRHSs PatBindGuards grhss ; rhs <- dsGuarded grhss ty match_nablas ; let upat = unLoc pat - eqn = EqnInfo { eqn_pats = [upat], - eqn_orig = FromSource, - eqn_rhs = cantFailMatchResult body } + eqn = EqnMatch upat FromSource (EqnDone $ cantFailMatchResult body) ; var <- selectMatchVar ManyTy upat -- `var` will end up in a let binder, so the multiplicity -- doesn't matter. ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -21,13 +21,15 @@ module GHC.HsToCore.Match ) where +import GHC.Stack import GHC.Prelude import GHC.Platform import Language.Haskell.Syntax.Basic (Boxity(..)) import {-#SOURCE#-} GHC.HsToCore.Expr (dsExpr) - +import Data.List (intercalate) +import Debug.Trace import GHC.Types.Basic ( Origin(..), isGenerated ) import GHC.Types.SourceText import GHC.Driver.DynFlags @@ -178,9 +180,20 @@ with External names (#13043). See also Note [Localise pattern binders] in GHC.HsToCore.Utils -} +-- input: equationInfo +-- output: do call to `match` (recursing into matchNew) but group the first var beforehand +-- for the call to match, construct a EqnInfo with only a single pattern and put the recursive call into the eqn_rhs. + +--matchNew :: [MatchId] +-- -> Type +-- -> [EquationInfo] +-- -> Dsm (MatchResult CoreExpr) + + + type MatchId = Id -- See Note [Match Ids] -match :: [MatchId] -- ^ Variables rep\'ing the exprs we\'re matching with +match :: HasCallStack => [MatchId] -- ^ Variables rep\'ing the exprs we\'re matching with -- ^ See Note [Match Ids] -- -- ^ Note that the Match Ids carry not only a name, but @@ -192,11 +205,7 @@ match :: [MatchId] -- ^ Variables rep\'ing the exprs we\'re matching with match [] ty eqns = assertPpr (not (null eqns)) (ppr ty) $ - return (foldr1 combineMatchResults match_results) - where - match_results = [ assert (null (eqn_pats eqn)) $ - eqn_rhs eqn - | eqn <- eqns ] + combineRHSs (NEL.fromList eqns) match (v:vs) ty eqns -- Eqns *can* be empty = assertPpr (all (isInternalName . idName) vars) (ppr vars) $ @@ -207,11 +216,19 @@ match (v:vs) ty eqns -- Eqns *can* be empty ; (aux_binds, tidy_eqns) <- mapAndUnzipM (tidyEqnInfo v) eqns -- Group the equations and match each group in turn ; let grouped = groupEquations platform tidy_eqns + -- ; grouped' <- mapM (moveGroupVarsIntoRhs vs ty) grouped + ; let grouped' = grouped + + -- ; traceM ("Before moving: " ++ show (length grouped) ++ " groups:") + -- ; testPrint grouped + -- ; traceM ("After moving: " ++ show (length grouped') ++ " groups:") + -- ; testPrint grouped' + -- ; traceM "" -- print the view patterns that are commoned up to help debug - ; whenDOptM Opt_D_dump_view_pattern_commoning (debug grouped) + ; whenDOptM Opt_D_dump_view_pattern_commoning (debug grouped') - ; match_results <- match_groups grouped + ; match_results <- match_groups grouped' ; return $ foldr (.) id aux_binds <$> foldr1 combineMatchResults match_results } @@ -239,6 +256,7 @@ match (v:vs) ty eqns -- Eqns *can* be empty PgBang -> matchBangs vars ty (dropGroup eqns) PgCo {} -> matchCoercion vars ty (dropGroup eqns) PgView {} -> matchView vars ty (dropGroup eqns) + PgDistinct-> combineRHSs (dropGroup eqns) PgOr -> matchOr vars ty eq -- every or-pattern makes up a single PgOr group where eqns' = NEL.toList eqns ne l = case NEL.nonEmpty l of @@ -247,7 +265,19 @@ match (v:vs) ty eqns -- Eqns *can* be empty -- FIXME: we should also warn about view patterns that should be -- commoned up but are not - +{- + testPrint :: Applicative f => [NonEmpty (PatGroup, EquationInfo)] -> f () + testPrint groups = + traceM $ intercalate "\n" $ map + (\group -> intercalate " ; " $ map + (\(pg, eqn) -> (show pg ++ " " ++ (intercalate " " $ map (showSDocUnsafe . pprLPat . mklpat) (pats eqn)))) + (NEL.toList group)) + groups + where + pats (EqnMatch pat _ rest) = pat : pats rest + pats (EqnDone _) = [] + mklpat pat = L noSrcSpanA pat +-} -- print some stuff to see what's getting grouped -- use -dppr-debug to see the resolution of overloaded literals debug eqns = @@ -267,6 +297,10 @@ matchEmpty var res_ty mk_seq fail = return $ mkWildCase (Var var) (idScaledType var) res_ty [Alt DEFAULT [] fail] + +combineRHSs :: NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) +combineRHSs eqns = return $ foldr1 combineMatchResults $ map (\(EqnDone rhs) -> rhs) (NEL.toList eqns) + matchVariables :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) -- Real true variables, just like in matchVar, SLPJ p 94 -- No binding to do: they'll all be wildcards by now (done in tidy) @@ -319,12 +353,11 @@ matchOr (var :| vars) ty eqn = do { ; match [var] ty or_eqns -- todo: not if pats is empty }) } where - singleEqn expr (L _ pat) = EqnInfo { eqn_pats = [pat], eqn_orig = FromSource, eqn_rhs = pure expr } + singleEqn expr (L _ pat) = EqnMatch pat FromSource (EqnDone $ pure expr) -- decompose the first pattern and leave the rest alone decomposeFirstPat :: (Pat GhcTc -> Pat GhcTc) -> EquationInfo -> EquationInfo -decomposeFirstPat extractpat (eqn@(EqnInfo { eqn_pats = pat : pats })) - = eqn { eqn_pats = extractpat pat : pats} +decomposeFirstPat extract (EqnMatch pat orig rest) = EqnMatch (extract pat) orig rest decomposeFirstPat _ _ = panic "decomposeFirstPat" getCoPat, getBangPat, getViewPat :: Pat GhcTc -> Pat GhcTc @@ -408,7 +441,19 @@ only these which can be assigned a PatternGroup (see patGroup). -} -tidyEqnInfo :: Id -> EquationInfo +{- +moveGroupVarsIntoRhs :: HasCallStack => [Id] -> Type -> NonEmpty (PatGroup, EquationInfo) -> DsM (NonEmpty (PatGroup, EquationInfo)) +moveGroupVarsIntoRhs vs ty group = do + let (gp, eq) = NEL.head group + case eq of + EqnDone _ -> return group + EqnMatch pat orig _ -> do + let rest = NEL.map (\(_, EqnMatch _ _ rest) -> rest) group + rhs <- match vs ty (NEL.toList rest) + return $ NEL.singleton (gp, EqnMatch pat orig (EqnDone rhs)) +-} + +tidyEqnInfo :: HasCallStack => Id -> EquationInfo -> DsM (DsWrapper, EquationInfo) -- DsM'd because of internal call to dsLHsBinds -- and mkSelectorBinds. @@ -418,12 +463,11 @@ tidyEqnInfo :: Id -> EquationInfo -- POST CONDITION: head pattern in the EqnInfo is -- one of these for which patGroup is defined. -tidyEqnInfo _ (EqnInfo { eqn_pats = [] }) - = panic "tidyEqnInfo" +tidyEqnInfo _ (EqnDone r) = return (idDsWrapper, EqnDone r) -tidyEqnInfo v eqn@(EqnInfo { eqn_pats = pat : pats, eqn_orig = orig }) - = do { (wrap, pat') <- tidy1 v orig pat - ; return (wrap, eqn { eqn_pats = pat' : pats }) } +tidyEqnInfo v (EqnMatch pat orig rest) = do + (wrap, pat') <- tidy1 v orig pat + return (wrap, EqnMatch pat' orig rest) tidy1 :: Id -- The Id being scrutinised -> Origin -- Was this a pattern the user wrote? @@ -833,9 +877,7 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches -- from that knowledge (#18533) ; match_result <- updPmNablas pat_nablas $ dsGRHSs ctxt grhss rhs_ty rhss_nablas - ; return EqnInfo { eqn_pats = upats - , eqn_orig = FromSource - , eqn_rhs = match_result } } + ; return $ mkEqnInfo upats FromSource match_result } discard_warnings_if_generated orig = if isGenerated orig @@ -972,9 +1014,9 @@ matchSinglePatVar var mb_scrut ctx pat ty match_result addCoreScrutTmCs (maybeToList mb_scrut) [var] $ pmcPatBind (DsMatchContext ctx locn) var (unLoc pat) - ; let eqn_info = EqnInfo { eqn_pats = [unLoc (decideBangHood dflags pat)] - , eqn_orig = FromSource - , eqn_rhs = match_result } + ; let eqn_info = EqnMatch (unLoc (decideBangHood dflags pat)) + FromSource + (EqnDone match_result) ; match [var] ty [eqn_info] } @@ -1002,8 +1044,18 @@ data PatGroup | PgView (LHsExpr GhcTc) -- view pattern (e -> p): -- the LHsExpr is the expression e Type -- the Type is the type of p (equivalently, the result type of e) + | PgDistinct -- Group equations which are Done: no further grouping can be done with them | PgOr -- Or pattern +instance Show PatGroup where + show PgAny = "PgAny" + show (PgCon _) = "PgCon" + show (PgLit _) = "PgLit" + show (PgView _ _) = "PgView" + show PgOr = "PgOr" + show PgDistinct = "PgDistinct" + show _ = "PgOther" + {- Note [Don't use Literal for PgN] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Previously we had, as PatGroup constructors @@ -1030,7 +1082,7 @@ groupEquations :: Platform -> [EquationInfo] -> [NonEmpty (PatGroup, EquationInf -- (b) none of the gi are empty -- The ordering of equations is unchanged groupEquations platform eqns - = NEL.groupBy same_gp $ [(patGroup platform (firstPat eqn), eqn) | eqn <- eqns] + = NEL.groupBy same_gp $ [(patGroup platform (maybeFirstPat eqn), eqn) | eqn <- eqns] -- comprehension on NonEmpty where same_gp :: (PatGroup,EquationInfo) -> (PatGroup,EquationInfo) -> Bool @@ -1120,6 +1172,7 @@ sameGroup (PgCo t1) (PgCo t2) = t1 `eqType` t2 sameGroup (PgView e1 t1) (PgView e2 t2) = viewLExprEq (e1,t1) (e2,t2) -- ViewPats are in the same group iff the expressions -- are "equal"---conservatively, we use syntactic equality +sameGroup PgDistinct PgDistinct = True sameGroup _ _ = False -- An approximation of syntactic equality used for determining when view @@ -1246,15 +1299,19 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2 eq_list _ (_:_) [] = False eq_list eq (x:xs) (y:ys) = eq x y && eq_list eq xs ys -patGroup :: Platform -> Pat GhcTc -> PatGroup -patGroup _ (ConPat { pat_con = L _ con +patGroup :: Platform -> Maybe (Pat GhcTc) -> PatGroup +patGroup _ Nothing = PgDistinct +patGroup p (Just pat) = patGroup' p pat + +patGroup' :: Platform -> Pat GhcTc -> PatGroup +patGroup' _ (ConPat { pat_con = L _ con , pat_con_ext = ConPatTc { cpt_arg_tys = tys } }) - | RealDataCon dcon <- con = PgCon dcon - | PatSynCon psyn <- con = PgSyn psyn tys -patGroup _ (WildPat {}) = PgAny -patGroup _ (BangPat {}) = PgBang -patGroup _ (NPat _ (L _ (OverLit {ol_val=oval})) mb_neg _) = + | RealDataCon dcon <- con = PgCon dcon + | PatSynCon psyn <- con = PgSyn psyn tys +patGroup' _ (WildPat {}) = PgAny +patGroup' _ (BangPat {}) = PgBang +patGroup' _ (NPat _ (L _ (OverLit {ol_val=oval})) mb_neg _) = case (oval, isJust mb_neg) of (HsIntegral i, is_neg) -> PgN (integralFractionalLit is_neg (if is_neg then negate (il_value i) @@ -1264,17 +1321,17 @@ patGroup _ (NPat _ (L _ (OverLit {ol_val=oval})) mb_neg _) = | otherwise -> PgN f (HsIsString _ s, _) -> assert (isNothing mb_neg) $ PgOverS s -patGroup _ (NPlusKPat _ _ (L _ (OverLit {ol_val=oval})) _ _ _) = +patGroup' _ (NPlusKPat _ _ (L _ (OverLit {ol_val=oval})) _ _ _) = case oval of HsIntegral i -> PgNpK (il_value i) _ -> pprPanic "patGroup NPlusKPat" (ppr oval) -patGroup _ (ViewPat _ expr p) = PgView expr (hsPatType (unLoc p)) -patGroup platform (LitPat _ lit) = PgLit (hsLitKey platform lit) -patGroup platform (XPat ext) = case ext of +patGroup' _ (ViewPat _ expr p) = PgView expr (hsPatType (unLoc p)) +patGroup' platform (LitPat _ lit) = PgLit (hsLitKey platform lit) +patGroup' platform (XPat ext) = case ext of CoPat _ p _ -> PgCo (hsPatType p) -- Type of innelexp pattern - ExpansionPat _ p -> patGroup platform p -patGroup _ (OrPat {}) = PgOr -patGroup _ pat = pprPanic "patGroup" (ppr pat) + ExpansionPat _ p -> patGroup' platform p +patGroup' _ (OrPat {}) = PgOr +patGroup' _ pat = pprPanic "patGroup" (ppr pat) {- Note [Grouping overloaded literal patterns] ===================================== compiler/GHC/HsToCore/Match.hs-boot ===================================== @@ -1,5 +1,6 @@ module GHC.HsToCore.Match where +import GHC.Stack (HasCallStack) import GHC.Prelude import GHC.Types.Var ( Id ) import GHC.Tc.Utils.TcType ( Type ) @@ -8,7 +9,7 @@ import GHC.Core ( CoreExpr ) import GHC.Hs ( LPat, HsMatchContext, MatchGroup, LHsExpr ) import GHC.Hs.Extension ( GhcTc, GhcRn ) -match :: [Id] +match :: HasCallStack => [Id] -> Type -> [EquationInfo] -> DsM (MatchResult CoreExpr) ===================================== compiler/GHC/HsToCore/Match/Constructor.hs ===================================== @@ -153,24 +153,22 @@ matchOneConLike vars ty mult (eqn1 :| eqns) -- All eqns for a single construct ; return $ foldr1 (.) wraps <$> match_result } - shift (_, eqn@(EqnInfo - { eqn_pats = ConPat - { pat_args = args - , pat_con_ext = ConPatTc - { cpt_tvs = tvs - , cpt_dicts = ds - , cpt_binds = bind - } - } : pats - })) + shift (_, eqn@(EqnMatch (ConPat + { pat_args = args + , pat_con_ext = ConPatTc + { cpt_tvs = tvs + , cpt_dicts = ds + , cpt_binds = bind + }}) + _ rest + )) = do dsTcEvBinds bind $ \ds_bind -> return ( wrapBinds (tvs `zip` tvs1) . wrapBinds (ds `zip` dicts1) . mkCoreLets ds_bind - , eqn { eqn_orig = Generated - , eqn_pats = conArgPats val_arg_tys args ++ pats } + , mkEqnInfo (conArgPats val_arg_tys args ++ eqn_pats rest) Generated (eqn_rhs rest) ) - shift (_, (EqnInfo { eqn_pats = ps })) = pprPanic "matchOneCon/shift" (ppr ps) + shift (_, eqn) = pprPanic "matchOneCon/shift" (ppr eqn) ; let scaled_arg_tys = map (scaleScaled mult) val_arg_tys -- The 'val_arg_tys' are taken from the data type definition, they -- do not take into account the context multiplicity, therefore we ===================================== compiler/GHC/HsToCore/Match/Literal.hs ===================================== @@ -625,10 +625,10 @@ matchLiterals (var :| vars) ty sub_groups } where match_group :: NonEmpty EquationInfo -> DsM (Literal, MatchResult CoreExpr) - match_group eqns@(firstEqn :| _) + match_group eqns = do { dflags <- getDynFlags ; let platform = targetPlatform dflags - ; let LitPat _ hs_lit = firstPat firstEqn + ; let (EqnMatch (LitPat _ hs_lit) _ _) = NEL.head eqns ; match_result <- match vars ty (NEL.toList $ shiftEqns eqns) ; return (hsLitKey platform hs_lit, match_result) } @@ -726,7 +726,7 @@ matchNPlusKPats (var :| vars) ty (eqn1 :| eqns) fmap (foldr1 (.) wraps) $ match_result) } where - shift n1 eqn@(EqnInfo { eqn_pats = NPlusKPat _ (L _ n) _ _ _ _ : pats }) - = (wrapBind n n1, eqn { eqn_pats = pats }) + shift n1 eqn@(EqnMatch (NPlusKPat _ (L _ n) _ _ _ _) _ rest) + = (wrapBind n n1, rest) -- The wrapBind is a no-op for the first equation shift _ e = pprPanic "matchNPlusKPats/shift" (ppr e) ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -48,7 +48,8 @@ module GHC.HsToCore.Monad ( -- Data types DsMatchContext(..), - EquationInfo(..), MatchResult (..), runMatchResult, DsWrapper, idDsWrapper, + EquationInfo(..), mkEqnInfo, eqn_rhs, eqn_pats, + MatchResult (..), runMatchResult, DsWrapper, idDsWrapper, -- Trace injection pprRuntimeTrace @@ -130,7 +131,7 @@ data DsMatchContext instance Outputable DsMatchContext where ppr (DsMatchContext hs_match ss) = ppr ss <+> pprMatchContext hs_match -data EquationInfo +{-data EquationInfo = EqnInfo { eqn_pats :: [Pat GhcTc] -- ^ The patterns for an equation -- @@ -149,9 +150,22 @@ data EquationInfo , eqn_rhs :: MatchResult CoreExpr -- ^ What to do after match } +-} + +data EquationInfo = EqnMatch (Pat GhcTc) Origin EquationInfo | EqnDone (MatchResult CoreExpr) + +mkEqnInfo [] _ rhs = EqnDone rhs +mkEqnInfo (pat:pats) orig rhs = EqnMatch pat orig (mkEqnInfo pats orig rhs) + +eqn_pats :: EquationInfo -> [Pat GhcTc] +eqn_pats (EqnDone _) = [] +eqn_pats (EqnMatch pat _ rest) = pat : eqn_pats rest +eqn_rhs :: EquationInfo -> MatchResult CoreExpr +eqn_rhs (EqnDone rhs) = rhs +eqn_rhs (EqnMatch _ _ rest) = eqn_rhs rest instance Outputable EquationInfo where - ppr (EqnInfo pats _ _) = ppr pats + ppr = ppr . eqn_pats type DsWrapper = CoreExpr -> CoreExpr idDsWrapper :: DsWrapper ===================================== compiler/GHC/HsToCore/Utils.hs ===================================== @@ -15,7 +15,7 @@ This module exports some utility functions of no great interest. -- | Utility functions for constructing Core syntax, principally for desugaring module GHC.HsToCore.Utils ( EquationInfo(..), - firstPat, shiftEqns, + firstPat, maybeFirstPat, shiftEqns, MatchResult (..), CaseAlt(..), cantFailMatchResult, alwaysFailMatchResult, @@ -196,11 +196,16 @@ worthy of a type synonym and a few handy functions. -} firstPat :: EquationInfo -> Pat GhcTc -firstPat eqn = assert (notNull (eqn_pats eqn)) $ head (eqn_pats eqn) +firstPat (EqnMatch pat _ _) = pat +firstPat (EqnDone _) = error "firstPat: no patterns" + +maybeFirstPat :: EquationInfo -> Maybe (Pat GhcTc) +maybeFirstPat (EqnMatch pat _ _) = Just pat +maybeFirstPat (EqnDone _) = Nothing shiftEqns :: Functor f => f EquationInfo -> f EquationInfo -- Drop the first pattern in each equation -shiftEqns = fmap $ \eqn -> eqn { eqn_pats = tail (eqn_pats eqn) } +shiftEqns = fmap $ \(EqnMatch _ _ rest) -> rest -- Functions on MatchResult CoreExprs @@ -221,8 +226,8 @@ extractMatchResult match_result failure_expr = (shareFailureHandler match_result) combineMatchResults :: MatchResult CoreExpr -> MatchResult CoreExpr -> MatchResult CoreExpr -combineMatchResults match_result1@(MR_Infallible _) _ - = match_result1 +-- combineMatchResults match_result1@(MR_Infallible _) _ +-- = match_result1 combineMatchResults match_result1 match_result2 = -- if the first pattern needs a failure handler (i.e. if it is fallible), -- make it let-bind it bind it with `shareFailureHandler`. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c93c3ddd060ce347ad76731cdbcfb10da02b99dc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c93c3ddd060ce347ad76731cdbcfb10da02b99dc You're receiving 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 Jun 19 11:07:29 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 19 Jun 2023 07:07:29 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] ghc-toolchain: Fix ar supports at file Message-ID: <649036f1c97be_be462c5ff815498f@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 1435a431 by Rodrigo Mesquita at 2023-06-19T12:07:05+01:00 ghc-toolchain: Fix ar supports at file - - - - - 1 changed file: - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs Changes: ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs ===================================== @@ -107,15 +107,19 @@ checkArSupportsDashL bareAr = checking "that ar supports -L" $ withTempDir $ \di checkArSupportsAtFile :: Program -> Program -> M Bool checkArSupportsAtFile bareAr mkArchive = checking "that ar supports @-files" $ withTempDir $ \dir -> do - let f = dir "conftest.file" + let conftest = "conftest.file" + f = dir conftest atfile = dir "conftest.atfile" archive = dir "conftest.a" objs = replicate 2 f createFile f writeFile atfile (unlines objs) - callProgram mkArchive [archive, "@" ++ dir "conftest.atfile"] + callProgram mkArchive [archive, "@" ++ atfile] contents <- readProgramStdout bareAr ["t", archive] - if lines contents == objs + -- Careful: The files output by `ar t` use relative paths, so we can't + -- compare against `objs` + if lines contents == replicate 2 conftest then return True else logDebug "Contents didn't match" >> return False + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1435a431a6c39d4078c768b2f79a4fad737ac110 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1435a431a6c39d4078c768b2f79a4fad737ac110 You're receiving 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 Jun 19 11:08:00 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 19 Jun 2023 07:08:00 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Fixes Message-ID: <6490371039cfe_be462b59fa8c155497@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: c755b216 by Rodrigo Mesquita at 2023-06-19T12:07:53+01:00 Fixes - - - - - 2 changed files: - default.target.in - utils/ghc-toolchain/src/GHC/Toolchain/Tools/MergeObjs.hs Changes: ===================================== default.target.in ===================================== @@ -6,7 +6,7 @@ Target , tgtWordSize = WS at TargetWordSize@ , tgtEndianness = @TargetEndianness@ , tgtSymbolsHaveLeadingUnderscore = @LeadingUnderscoreBool@ -, tgtLlvmTarget = "@LlvmTarget@" +, tgtLlvmTarget = "@LlvmTarget_CPP@" , tgtUnregisterised = @UnregisterisedBool@ , tgtTablesNextToCode = @TablesNextToCodeBool@ , tgtUseLibffiForAdjustors = @UseLibffiForAdjustorsBool@ ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/MergeObjs.hs ===================================== @@ -23,7 +23,7 @@ newtype MergeObjs = MergeObjs { mergeObjsProgram :: Program findMergeObjs :: ProgOpt -> Cc -> CcLink -> Nm -> M MergeObjs findMergeObjs progOpt cc ccLink nm = checking "for linker for merging objects" $ do - prog <- findProgram "linker for merging objects" progOpt ["ld"] + prog <- findProgram "linker for merging objects" progOpt ["ld.gold", "ld"] let mo = MergeObjs $ over _prgFlags (++["-r"]) prog checkMergingWorks cc nm mo checkForGoldT22266 cc ccLink mo View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c755b2163a69cddb5fe64f208361bb03965f890f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c755b2163a69cddb5fe64f208361bb03965f890f You're receiving 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 Jun 19 13:11:47 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 19 Jun 2023 09:11:47 -0400 Subject: [Git][ghc/ghc][master] IPE data compression Message-ID: <64905413bf9bd_be462b59ecb81828ea@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 23 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/StgToCmm/InfoTableProv.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/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-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: ae60a90db673e679399286e3b63c21c8e7a9a9b9 + DOCKER_REV: 243a00f06550e6b9a00fa0f1530d1bb761e8b7cc # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. ===================================== .gitlab/gen_ci.hs ===================================== @@ -141,6 +141,7 @@ data BuildConfig , llvmBootstrap :: Bool , withAssertions :: Bool , withNuma :: Bool + , withZstd :: Bool , crossTarget :: Maybe String , crossEmulator :: CrossEmulator , configureWrapper :: Maybe String @@ -154,10 +155,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 @@ -172,8 +174,12 @@ mkJobFlavour BuildConfig{..} = Flavour buildFlavour opts 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 @@ -192,6 +198,7 @@ vanilla = BuildConfig , llvmBootstrap = False , withAssertions = False , withNuma = False + , withZstd = False , crossTarget = Nothing , crossEmulator = NoEmulator , configureWrapper = Nothing @@ -224,6 +231,9 @@ debug = vanilla { buildFlavour = SlowValidate , withNuma = True } +zstdIpe :: BuildConfig +zstdIpe = vanilla { withZstd = True } + static :: BuildConfig static = vanilla { fullyStatic = True } @@ -313,18 +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" - flavourString BootNonmovingGc = "boot_nonmoving_gc" + 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 BootNonmovingGc = "boot_nonmoving_gc" -- The path to the docker image (just for linux builders) dockerImage :: Arch -> Opsys -> Maybe String @@ -517,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 @@ -553,6 +563,7 @@ data Rule = FastCI -- ^ Run this job when the fast-ci label is set | 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. + | IpeData -- ^ Only run this job when the "IPE" label is set | Disable -- ^ Don't run this job. deriving (Bounded, Enum, Ord, Eq) @@ -579,12 +590,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 @@ -880,7 +893,6 @@ job_groups = modifyNightlyJobs allowFailure (modifyValidateJobs manual (validateBuilds Amd64 (Linux Debian10) noTntc)) , addValidateRule LLVMBackend (validateBuilds Amd64 (Linux Debian10) llvm) - , 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. @@ -919,6 +931,8 @@ job_groups = , modifyValidateJobs manual $ make_wasm_jobs wasm_build_config {unregisterised = True} , addValidateRule NonmovingGc (standardBuildsWithConfig Amd64 (Linux Debian11) vanilla {validateNonmovingGc = True}) + , modifyNightlyJobs (addJobRule Disable) $ + addValidateRule IpeData (validateBuilds Amd64 (Linux Debian10) zstdIpe) ] where ===================================== .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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -641,7 +641,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -703,7 +703,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -765,7 +765,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -826,7 +826,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -887,7 +887,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1008,7 +1008,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1067,7 +1067,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1186,7 +1186,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1245,7 +1245,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1304,7 +1304,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1363,7 +1363,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1422,7 +1422,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1483,7 +1483,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1544,7 +1544,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1606,7 +1606,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1665,7 +1665,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1725,7 +1725,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1784,7 +1784,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1845,7 +1845,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1907,7 +1907,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1968,7 +1968,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2028,7 +2028,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2087,7 +2087,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2142,7 +2142,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2201,7 +2201,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2264,7 +2264,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2328,7 +2328,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2389,7 +2389,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2450,7 +2450,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2516,7 +2516,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2579,7 +2579,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2642,7 +2642,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2705,7 +2705,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2766,7 +2766,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2827,7 +2827,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2888,7 +2888,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2949,7 +2949,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3011,7 +3011,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3072,7 +3072,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3135,7 +3135,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3198,7 +3198,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3261,7 +3261,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3322,7 +3322,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3383,7 +3383,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3440,7 +3440,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3500,7 +3500,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3564,7 +3564,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3628,7 +3628,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3688,7 +3688,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3749,7 +3749,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3810,7 +3810,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -3871,7 +3871,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -3931,7 +3931,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3990,7 +3990,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4048,7 +4048,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4107,7 +4107,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4130,6 +4130,64 @@ "TEST_ENV": "x86_64-linux-deb10-unreg-validate" } }, + "x86_64-linux-deb10-validate": { + "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.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\") && (\"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", + "BUILD_FLAVOUR": "validate", + "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "TEST_ENV": "x86_64-linux-deb10-validate" + } + }, "x86_64-linux-deb10-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", @@ -4165,7 +4223,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4223,7 +4281,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4282,7 +4340,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -4342,7 +4400,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4402,7 +4460,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4463,7 +4521,7 @@ ], "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\")", + "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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4522,7 +4580,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4578,7 +4636,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -1,67 +1,188 @@ +{-# 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.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, unpackFS, LexicalFastString(..)) +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. + +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). -emitIpeBufferListNode :: Module - -> [InfoProvEnt] - -> FCode () +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 + + entries_bytes :: BS.ByteString + entries_bytes = compress defaultCompressionLevel uncompressed_entries - 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 :: [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 @@ -77,7 +198,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 @@ -105,7 +226,7 @@ data StringTable = StringTable { stStrings :: DList ShortText , stLookup :: !(M.Map ShortText StrTabOffset) } -newtype StrTabOffset = StrTabOffset Int +type StrTabOffset = Word32 emptyStringTable :: StringTable emptyStringTable = @@ -130,9 +251,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 ===================================== @@ -56,6 +56,14 @@ Flag build-tool-depends Description: Use build-tool-depends Default: True +Flag with-libzstd + Default: False + Manual: True + +Flag static-libzstd + Default: False + Manual: True + -- While the boot compiler fixes ghc's unit-id to `ghc`, the stage0 compiler must still be compiled with `-this-unit-id ghc` Flag hadrian-stage0 Description: Enable if compiling the stage0 compiler with hadrian @@ -76,6 +84,16 @@ 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) + if flag(static-libzstd) + if os(darwin) + buildable: False + else + extra-libraries: :libzstd.a + else + 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 ===================================== @@ -1114,6 +1114,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 @@ -1259,6 +1263,19 @@ 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;) +STATIC_LIBZSTD=$(if [ "$StaticLibZstd" = "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 + statically linked? : $STATIC_LIBZSTD + libdw : $USING_LIBDW Using LLVM tools clang : $ClangCmd ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -148,6 +148,20 @@ Compiler `-ddump-spec-constr`, allowing only output from the typeclass specialiser or `SpecConstr` to be seen if desired. +- 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 `_ version 1.4.0 or greater + installed. The compression library `libzstd` may optionally be statically + linked in the resulting compiler (on non-darwin machines) using the + `--enable-static-libzstd` configure flag. + + 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,26 @@ 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. The compression + library ``libzstd`` may optionally be statically linked in the resulting + compiler (on non-darwin machines) using the ``--enable-static-libzstd`` + configure flag. + + 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 ===================================== @@ -199,10 +199,15 @@ 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@ +static-lib-zstd = @UseStaticLibZstd@ use-lib-numa = @UseLibNuma@ use-lib-m = @UseLibm@ use-lib-rt = @UseLibrt@ ===================================== hadrian/src/Oracles/Flag.hs ===================================== @@ -35,6 +35,8 @@ data Flag = ArSupportsAtFile | UseLibffiForAdjustors | UseLibdw | UseLibnuma + | UseLibzstd + | StaticLibzstd | UseLibm | UseLibrt | UseLibdl @@ -65,6 +67,8 @@ flag f = do UseLibffiForAdjustors -> "use-libffi-for-adjustors" UseLibdw -> "use-lib-dw" UseLibnuma -> "use-lib-numa" + UseLibzstd -> "use-lib-zstd" + StaticLibzstd -> "static-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 @@ -161,6 +163,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 ===================================== @@ -316,6 +316,8 @@ rtsCabalFlags = mconcat , flag "CabalNeedLibpthread" UseLibpthread , flag "CabalHaveLibbfd" UseLibbfd , flag "CabalHaveLibNuma" UseLibnuma + , flag "CabalHaveLibZstd" UseLibzstd + , flag "CabalStaticLibZstd" StaticLibzstd , flag "CabalNeedLibatomic" NeedLibatomic , flag "CabalUseSystemLibFFI" UseSystemFfi , flag "CabalLibffiAdjustors" UseLibffiForAdjustors ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -74,11 +74,13 @@ packageArgs = do [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" , notM cross `cabalFlag` "terminfo" , arg "-build-tool-depends" + , flag UseLibzstd `cabalFlag` "with-libzstd" -- ROMES: While the boot compiler is not updated wrt -this-unit-id -- not being fixed to `ghc`, when building stage0, we must set -- -this-unit-id to `ghc` because the boot compiler expects that. -- We do it through a cabal flag in ghc.cabal , stage0 ? arg "+hadrian-stage0" + , flag StaticLibzstd `cabalFlag` "static-libzstd" ] , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ] @@ -288,6 +290,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 @@ -394,6 +398,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,120 @@ +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] + ) + + StaticLibZstd=0 + AC_ARG_ENABLE( + static-libzstd, + [AS_HELP_STRING( + [--enable-static-libzstd], + [Statically link the libzstd compression library with the compiler + (not compatible with darwin) [default=no]] + )], + [StaticLibZstd=1], + [StaticLibZstd=0] + ) + + HaveLibZstd=0 + if test "$EnableIpeDataCompression" = "YES"; then + dnl ** Have zstd >= 1.4.0? + 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 + + # libzstd >= 1.4.0 is required for IPE data compression + fp_libzstd_version="`pkg-config --modversion libzstd`" + FP_COMPARE_VERSIONS( + [$fp_libzstd_version], + [-lt], + [1.4.0], + [AC_MSG_ERROR( + [Need at least libzstd version 1.4.0 for + --enable-ipe-data-compression]) + ] + ) + + 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)]) + + AC_DEFINE_UNQUOTED([STATIC_LIBZSTD], [$StaticLibZstd], [Define to 1 if you + wish to statically link the libzstd compression library in the compiler + (requires libzstd)]) + + if test $HaveLibZstd = "1" ; then + AC_SUBST([UseLibZstd],[YES]) + AC_SUBST([CabalHaveLibZstd],[True]) + if test $StaticLibZstd = "1" ; then + case "${host_os}" in + darwin*) + AC_MSG_ERROR( + [--enable-static-libzstd is not compatible with darwin] + ) + esac + AC_SUBST([UseStaticLibZstd],[YES]) + AC_SUBST([CabalStaticLibZstd],[True]) + else + AC_SUBST([UseStaticLibZstd],[NO]) + AC_SUBST([CabalStaticLibZstd],[False]) + fi + 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,85 @@ 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; + IpeBufferEntry *entries; + 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 == 1) { + // 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,10 @@ flag libdw default: @CabalHaveLibdw@ flag libnuma default: @CabalHaveLibNuma@ +flag libzstd + default: @CabalHaveLibZstd@ +flag static-libzstd + default: @CabalStaticLibZstd@ flag leading-underscore default: @CabalLeadingUnderscore@ flag smp @@ -212,6 +216,14 @@ library extra-libraries: elf dw if flag(libnuma) extra-libraries: numa + if flag(libzstd) + if flag(static-libzstd) + if os(darwin) + buildable: False + else + extra-libraries: :libzstd.a + else + extra-libraries: zstd if !flag(smp) cpp-options: -DNOSMP ===================================== 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/cb9e1ce4d3b9de5b75a92ae721a207a6bc250a78 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cb9e1ce4d3b9de5b75a92ae721a207a6bc250a78 You're receiving 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 Jun 19 13:12:24 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 19 Jun 2023 09:12:24 -0400 Subject: [Git][ghc/ghc][master] Add `IfaceWarnings` to represent the `ModIface`-storable parts Message-ID: <64905438140ba_be462c5f0818774a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 8 changed files: - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Types/SourceText.hs - compiler/GHC/Unit/Module/ModIface.hs - compiler/GHC/Unit/Module/Warnings.hs Changes: ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -102,7 +102,6 @@ import GHC.Types.PkgQual import GHC.Unit.External import GHC.Unit.Module -import GHC.Unit.Module.Warnings import GHC.Unit.Module.ModIface import GHC.Unit.Module.Deps import GHC.Unit.State @@ -1206,16 +1205,6 @@ pprTrustInfo trust = text "trusted:" <+> ppr trust pprTrustPkg :: Bool -> SDoc pprTrustPkg tpkg = text "require own pkg trusted:" <+> ppr tpkg -instance Outputable (Warnings pass) where - ppr = pprWarns - -pprWarns :: Warnings pass -> SDoc -pprWarns NoWarnings = Outputable.empty -pprWarns (WarnAll txt) = text "Warn all" <+> ppr txt -pprWarns (WarnSome prs) = text "Warnings:" - <+> vcat (map pprWarning prs) - where pprWarning (name, txt) = ppr name <+> ppr txt - pprIfaceAnnotation :: IfaceAnnotation -> SDoc pprIfaceAnnotation (IfaceAnnotation { ifAnnotatedTarget = target, ifAnnotatedValue = serialized }) = ppr target <+> text "annotated by" <+> ppr serialized ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -66,6 +66,8 @@ import GHC.Types.SourceFile import GHC.Types.TyThing import GHC.Types.HpcInfo import GHC.Types.CompleteMatch +import GHC.Types.SourceText +import GHC.Types.SrcLoc ( unLoc ) import GHC.Utils.Outputable import GHC.Utils.Panic @@ -291,7 +293,7 @@ mkIface_ hsc_env -- The order of fixities returned from nonDetNameEnvElts is not -- deterministic, so we sort by OccName to canonicalize it. -- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM for more details. - warns = src_warns + warns = toIfaceWarnings src_warns iface_rules = map coreRuleToIfaceRule rules iface_insts = map instanceToIfaceInst $ fixSafeInstances safe_mode (instEnvElts insts) iface_fam_insts = map famInstToIfaceFamInst fam_insts @@ -393,6 +395,21 @@ ifaceRoughMatchTcs tcs = map do_rough tcs do_rough (RM_KnownTc n) = Just (toIfaceTyCon_name n) -------------------------- +toIfaceWarnings :: Warnings GhcRn -> IfaceWarnings +toIfaceWarnings NoWarnings = IfNoWarnings +toIfaceWarnings (WarnAll txt) = IfWarnAll (toIfaceWarningTxt txt) +toIfaceWarnings (WarnSome prs) = IfWarnSome [(occ, toIfaceWarningTxt txt) | (occ, txt) <- prs] + +toIfaceWarningTxt :: WarningTxt GhcRn -> IfaceWarningTxt +toIfaceWarningTxt (WarningTxt mb_cat src strs) = IfWarningTxt (unLoc <$> mb_cat) (unLoc src) (map (toIfaceStringLiteralWithNames . unLoc) strs) +toIfaceWarningTxt (DeprecatedTxt src strs) = IfDeprecatedTxt (unLoc src) (map (toIfaceStringLiteralWithNames . unLoc) strs) + +toIfaceStringLiteralWithNames :: WithHsDocIdentifiers StringLiteral GhcRn -> (IfaceStringLiteral, [IfExtName]) +toIfaceStringLiteralWithNames (WithHsDocIdentifiers src names) = (toIfaceStringLiteral src, map unLoc names) + +toIfaceStringLiteral :: StringLiteral -> IfaceStringLiteral +toIfaceStringLiteral (StringLiteral sl fs _) = IfStringLiteral sl fs + coreRuleToIfaceRule :: CoreRule -> IfaceRule -- A plugin that installs a BuiltinRule in a CoreDoPluginPass should -- ensure that there's another CoreDoPluginPass that removes the rule. ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -962,7 +962,7 @@ addFingerprints hsc_env iface0 eps <- hscEPS hsc_env let decls = mi_decls iface0 - warn_fn = mkIfaceWarnCache (mi_warns iface0) + warn_fn = mkIfaceWarnCache (fromIfaceWarnings $ mi_warns iface0) fix_fn = mkIfaceFixCache (mi_fixities iface0) -- The ABI of a declaration represents everything that is made ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -16,6 +16,7 @@ module GHC.Iface.Syntax ( IfaceBindingX(..), IfaceMaybeRhs(..), IfaceConAlt(..), IfaceIdInfo, IfaceIdDetails(..), IfaceUnfolding(..), IfGuidance(..), IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget, + IfaceWarnings(..), IfaceWarningTxt(..), IfaceStringLiteral(..), IfaceClsInst(..), IfaceFamInst(..), IfaceTickish(..), IfaceClassBody(..), IfaceBooleanFormula(..), IfaceBang(..), @@ -33,6 +34,7 @@ module GHC.Iface.Syntax ( ifaceDeclImplicitBndrs, visibleIfConDecls, ifaceDeclFingerprints, fromIfaceBooleanFormula, + fromIfaceWarnings, -- Free Names freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst, @@ -66,7 +68,9 @@ import GHC.Types.ForeignCall import GHC.Types.Annotations( AnnPayload, AnnTarget ) import GHC.Types.Basic import GHC.Unit.Module +import GHC.Unit.Module.Warnings import GHC.Types.SrcLoc +import GHC.Types.SourceText import GHC.Data.BooleanFormula ( BooleanFormula(..), pprBooleanFormula, isTrue ) import GHC.Types.Var( VarBndr(..), binderVar, tyVarSpecToBinders, visArgTypeLike ) import GHC.Core.TyCon ( Role (..), Injectivity(..), tyConBndrVisForAllTyFlag ) @@ -74,6 +78,8 @@ import GHC.Core.DataCon (SrcStrictness(..), SrcUnpackedness(..)) import GHC.Builtin.Types ( constraintKindTyConName ) import GHC.Stg.InferTags.TagSig import GHC.Parser.Annotation (noLocA) +import GHC.Hs.Extension ( GhcRn ) +import GHC.Hs.Doc ( WithHsDocIdentifiers(..) ) import GHC.Utils.Lexeme (isLexSym) import GHC.Utils.Fingerprint @@ -338,6 +344,18 @@ data IfaceRule ifRuleOrph :: IsOrphan -- Just like IfaceClsInst } +data IfaceWarnings + = IfNoWarnings + | IfWarnAll IfaceWarningTxt + | IfWarnSome [(OccName, IfaceWarningTxt)] + +data IfaceWarningTxt + = IfWarningTxt (Maybe WarningCategory) SourceText [(IfaceStringLiteral, [IfExtName])] + | IfDeprecatedTxt SourceText [(IfaceStringLiteral, [IfExtName])] + +data IfaceStringLiteral + = IfStringLiteral SourceText FastString + data IfaceAnnotation = IfaceAnnotation { ifAnnotatedTarget :: IfaceAnnTarget, @@ -564,6 +582,24 @@ ifaceDeclFingerprints hash decl unsafeDupablePerformIO . computeFingerprint (panic "ifaceDeclFingerprints") +fromIfaceWarnings :: IfaceWarnings -> Warnings GhcRn +fromIfaceWarnings = \case + IfNoWarnings -> NoWarnings + IfWarnAll txt -> WarnAll (fromIfaceWarningTxt txt) + IfWarnSome prs -> WarnSome [(occ, fromIfaceWarningTxt txt) | (occ, txt) <- prs] + +fromIfaceWarningTxt :: IfaceWarningTxt -> WarningTxt GhcRn +fromIfaceWarningTxt = \case + IfWarningTxt mb_cat src strs -> WarningTxt (noLoc <$> mb_cat) (noLoc src) (noLoc <$> map fromIfaceStringLiteralWithNames strs) + IfDeprecatedTxt src strs -> DeprecatedTxt (noLoc src) (noLoc <$> map fromIfaceStringLiteralWithNames strs) + +fromIfaceStringLiteralWithNames :: (IfaceStringLiteral, [IfExtName]) -> WithHsDocIdentifiers StringLiteral GhcRn +fromIfaceStringLiteralWithNames (str, names) = WithHsDocIdentifiers (fromIfaceStringLiteral str) (map noLoc names) + +fromIfaceStringLiteral :: IfaceStringLiteral -> StringLiteral +fromIfaceStringLiteral (IfStringLiteral st fs) = StringLiteral st fs Nothing + + {- ************************************************************************ * * @@ -715,6 +751,25 @@ pprAxBranch pp_tc idx (IfaceAxBranch { ifaxbTyVars = tvs text "--" <+> text "incompatible with:" <+> pprWithCommas (\incomp -> text "#" <> ppr incomp) incomps +instance Outputable IfaceWarnings where + ppr = \case + IfNoWarnings -> empty + IfWarnAll txt -> text "Warn all" <+> ppr txt + IfWarnSome prs -> text "Warnings:" <+> vcat [ppr name <+> ppr txt | (name, txt) <- prs] + +instance Outputable IfaceWarningTxt where + ppr = \case + IfWarningTxt _ _ ws -> pp_ws ws + IfDeprecatedTxt _ ds -> pp_ws ds + where + pp_ws [msg] = pp_with_name msg + pp_ws msgs = brackets $ vcat . punctuate comma . map pp_with_name $ msgs + + pp_with_name = ppr . fst + +instance Outputable IfaceStringLiteral where + ppr (IfStringLiteral st fs) = pprWithSourceText st (ftext fs) + instance Outputable IfaceAnnotation where ppr (IfaceAnnotation target value) = ppr target <+> colon <+> ppr value @@ -2265,6 +2320,28 @@ instance Binary IfaceRule where a8 <- get bh return (IfaceRule a1 a2 a3 a4 a5 a6 a7 a8) +instance Binary IfaceWarnings where + put_ bh = \case + IfNoWarnings -> putByte bh 0 + IfWarnAll txt -> putByte bh 1 *> put_ bh txt + IfWarnSome prs -> putByte bh 2 *> put_ bh prs + get bh = getByte bh >>= \case + 0 -> pure IfNoWarnings + 1 -> pure IfWarnAll <*> get bh + _ -> pure IfWarnSome <*> get bh + +instance Binary IfaceWarningTxt where + put_ bh = \case + IfWarningTxt a1 a2 a3 -> putByte bh 0 *> put_ bh a1 *> put_ bh a2 *> put_ bh a3 + IfDeprecatedTxt a1 a2 -> putByte bh 1 *> put_ bh a1 *> put_ bh a2 + get bh = getByte bh >>= \case + 0 -> pure IfWarningTxt <*> get bh <*> get bh <*> get bh + _ -> pure IfDeprecatedTxt <*> get bh <*> get bh + +instance Binary IfaceStringLiteral where + put_ bh (IfStringLiteral a1 a2) = put_ bh a1 *> put_ bh a2 + get bh = IfStringLiteral <$> get bh <*> get bh + instance Binary IfaceAnnotation where put_ bh (IfaceAnnotation a1 a2) = do put_ bh a1 @@ -2822,5 +2899,19 @@ instance NFData IfaceClsInst where rnf (IfaceClsInst f1 f2 f3 f4 f5) = f1 `seq` rnf f2 `seq` rnf f3 `seq` f4 `seq` f5 `seq` () +instance NFData IfaceWarnings where + rnf = \case + IfNoWarnings -> () + IfWarnAll txt -> rnf txt + IfWarnSome txts -> rnf txts + +instance NFData IfaceWarningTxt where + rnf = \case + IfWarningTxt f1 f2 f3 -> rnf f1 `seq` rnf f2 `seq` rnf f3 + IfDeprecatedTxt f1 f2 -> rnf f1 `seq` rnf f2 + +instance NFData IfaceStringLiteral where + rnf (IfStringLiteral f1 f2) = rnf f1 `seq` rnf f2 + instance NFData IfaceAnnotation where rnf (IfaceAnnotation f1 f2) = f1 `seq` f2 `seq` () ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -47,6 +47,7 @@ import GHC.Tc.Zonk.TcType ( tcInitTidyEnv ) import GHC.Hs import GHC.Iface.Load ( loadSrcInterface ) +import GHC.Iface.Syntax ( fromIfaceWarnings ) import GHC.Builtin.Names import GHC.Parser.PostProcess ( setRdrNameSpace ) import GHC.Core.Type @@ -422,7 +423,7 @@ rnImportDecl this_mod imports = calculateAvails home_unit other_home_units iface mod_safe' want_boot (ImportedByUser imv) -- Complain if we import a deprecated module - case mi_warns iface of + case fromIfaceWarnings (mi_warns iface) of WarnAll txt -> addDiagnostic (TcRnDeprecatedModule imp_mod_name txt) _ -> return () ===================================== compiler/GHC/Types/SourceText.hs ===================================== @@ -1,5 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RecordWildCards #-} -- | Source text -- @@ -39,6 +41,7 @@ import Data.Function (on) import Data.Data import GHC.Real ( Ratio(..) ) import GHC.Types.SrcLoc +import Control.DeepSeq {- Note [Pragma source text] @@ -107,6 +110,11 @@ instance Outputable SourceText where ppr (SourceText s) = text "SourceText" <+> ftext s ppr NoSourceText = text "NoSourceText" +instance NFData SourceText where + rnf = \case + SourceText s -> rnf s + NoSourceText -> () + instance Binary SourceText where put_ bh NoSourceText = putByte bh 0 put_ bh (SourceText s) = do @@ -315,12 +323,3 @@ instance Eq StringLiteral where instance Outputable StringLiteral where ppr sl = pprWithSourceText (sl_st sl) (ftext $ sl_fs sl) - -instance Binary StringLiteral where - put_ bh (StringLiteral st fs _) = do - put_ bh st - put_ bh fs - get bh = do - st <- get bh - fs <- get bh - return (StringLiteral st fs Nothing) ===================================== compiler/GHC/Unit/Module/ModIface.hs ===================================== @@ -185,7 +185,7 @@ data ModIface_ (phase :: ModIfacePhase) -- ^ Fixities -- NOT STRICT! we read this field lazily from the interface file - mi_warns :: (Warnings GhcRn), + mi_warns :: IfaceWarnings, -- ^ Warnings -- NOT STRICT! we read this field lazily from the interface file @@ -479,7 +479,7 @@ instance Binary ModIface where mi_finsts = hasFamInsts, mi_exp_hash = exp_hash, mi_orphan_hash = orphan_hash, - mi_warn_fn = mkIfaceWarnCache warns, + mi_warn_fn = mkIfaceWarnCache $ fromIfaceWarnings warns, mi_fix_fn = mkIfaceFixCache fixities, mi_hash_fn = mkIfaceHashCache decls }}) @@ -498,7 +498,7 @@ emptyPartialModIface mod mi_exports = [], mi_used_th = False, mi_fixities = [], - mi_warns = NoWarnings, + mi_warns = IfNoWarnings, mi_anns = [], mi_insts = [], mi_fam_insts = [], @@ -567,7 +567,7 @@ instance ( NFData (IfaceBackendExts (phase :: ModIfacePhase)) `seq` mi_exports `seq` rnf mi_used_th `seq` mi_fixities - `seq` mi_warns + `seq` rnf mi_warns `seq` rnf mi_anns `seq` rnf mi_decls `seq` rnf mi_extra_decls ===================================== compiler/GHC/Unit/Module/Warnings.hs ===================================== @@ -5,6 +5,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE LambdaCase #-} -- | Warnings for a module module GHC.Unit.Module.Warnings @@ -40,7 +41,6 @@ import GHC.Types.SrcLoc import GHC.Types.Unique import GHC.Types.Unique.Set import GHC.Hs.Doc -import GHC.Hs.Extension import GHC.Utils.Outputable import GHC.Utils.Binary @@ -51,6 +51,7 @@ import Language.Haskell.Syntax.Extension import Data.Data import Data.List (isPrefixOf) import GHC.Generics ( Generic ) +import Control.DeepSeq {- @@ -103,7 +104,7 @@ the possibility of them being infinite. -- See Note [Warning categories] newtype WarningCategory = WarningCategory FastString - deriving (Binary, Data, Eq, Outputable, Show, Uniquable) + deriving (Binary, Data, Eq, Outputable, Show, Uniquable, NFData) mkWarningCategory :: FastString -> WarningCategory mkWarningCategory = WarningCategory @@ -203,29 +204,6 @@ instance Outputable (WarningTxt pass) where NoSourceText -> pp_ws ds SourceText src -> ftext src <+> pp_ws ds <+> text "#-}" -instance Binary (WarningTxt GhcRn) where - put_ bh (WarningTxt c s w) = do - putByte bh 0 - put_ bh $ unLoc <$> c - put_ bh $ unLoc s - put_ bh $ unLoc <$> w - put_ bh (DeprecatedTxt s d) = do - putByte bh 1 - put_ bh $ unLoc s - put_ bh $ unLoc <$> d - - get bh = do - h <- getByte bh - case h of - 0 -> do c <- fmap noLoc <$> get bh - s <- noLoc <$> get bh - w <- fmap noLoc <$> get bh - return (WarningTxt c s w) - _ -> do s <- noLoc <$> get bh - d <- fmap noLoc <$> get bh - return (DeprecatedTxt s d) - - pp_ws :: [Located (WithHsDocIdentifiers StringLiteral pass)] -> SDoc pp_ws [l] = ppr $ unLoc l pp_ws ws @@ -271,24 +249,6 @@ data Warnings pass deriving instance Eq (IdP pass) => Eq (Warnings pass) -instance Binary (Warnings GhcRn) where - put_ bh NoWarnings = putByte bh 0 - put_ bh (WarnAll t) = do - putByte bh 1 - put_ bh t - put_ bh (WarnSome ts) = do - putByte bh 2 - put_ bh ts - - get bh = do - h <- getByte bh - case h of - 0 -> return NoWarnings - 1 -> do aa <- get bh - return (WarnAll aa) - _ -> do aa <- get bh - return (WarnSome aa) - -- | Constructs the cache for the 'mi_warn_fn' field of a 'ModIface' mkIfaceWarnCache :: Warnings p -> OccName -> Maybe (WarningTxt p) mkIfaceWarnCache NoWarnings = \_ -> Nothing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0cbc3ae04ff4b4f5be38bddda8b1da5fb99aafd4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0cbc3ae04ff4b4f5be38bddda8b1da5fb99aafd4 You're receiving 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 Jun 19 14:21:23 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 19 Jun 2023 10:21:23 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] 3 commits: Memory usage fixes for Haddock Message-ID: <6490646385e0e_be462fca8bf420039@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: af561802 by Finley McIlwaine at 2023-06-19T09:17:44-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 1ece1a0e by Finley McIlwaine at 2023-06-19T10:21:11-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 0f2b8096 by Ben Gamari at 2023-06-19T10:21:11-04:00 configure: Bump version to 9.8 - - - - - 7 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/HsToCore/Docs.hs - configure.ac - testsuite/tests/haddock/perf/Fold.hs - testsuite/tests/haddock/perf/Makefile - utils/haddock Changes: ===================================== compiler/GHC/Driver/Backend.hs ===================================== @@ -551,17 +551,14 @@ backendRespectsSpecialise (Named NoBackend) = False -- | This back end wants the `mi_globals` field of a -- `ModIface` to be populated (with the top-level bindings --- of the original source). True for the interpreter, and --- also true for "no backend", which is used by Haddock. --- (After typechecking a module, Haddock wants access to --- the module's `GlobalRdrEnv`.) +-- of the original source). Only true for the interpreter. backendWantsGlobalBindings :: Backend -> Bool backendWantsGlobalBindings (Named NCG) = False backendWantsGlobalBindings (Named LLVM) = False backendWantsGlobalBindings (Named ViaC) = False backendWantsGlobalBindings (Named JavaScript) = False +backendWantsGlobalBindings (Named NoBackend) = False backendWantsGlobalBindings (Named Interpreter) = True -backendWantsGlobalBindings (Named NoBackend) = True -- | The back end targets a technology that implements -- `switch` natively. (For example, LLVM or C.) Therefore ===================================== compiler/GHC/Hs/Doc.hs ===================================== @@ -123,7 +123,7 @@ type LHsDoc pass = Located (HsDoc pass) data DocStructureItem = DsiSectionHeading !Int !(HsDoc GhcRn) | DsiDocChunk !(HsDoc GhcRn) - | DsiNamedChunkRef !(String) + | DsiNamedChunkRef !String | DsiExports !Avails | DsiModExport !(NonEmpty ModuleName) -- ^ We might re-export avails from multiple ===================================== compiler/GHC/HsToCore/Docs.hs ===================================== @@ -192,7 +192,13 @@ mkDocStructureFromDecls env all_exports decls = Just loc -> L loc (DsiExports [avail]) -- FIXME: This is just a workaround that we use when handling e.g. -- associated data families like in the html-test Instances.hs. - Nothing -> noLoc (DsiExports [avail]) + Nothing -> noLoc (DsiExports []) + + -- This causes the associated data family to be incorrectly documented + -- separately from its class: + -- Nothing -> noLoc (DsiExports [avail]) + + -- This panics on the associated data family: -- Nothing -> panicDoc "mkDocStructureFromDecls: No loc found for" -- (ppr avail) ===================================== 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.7], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.8], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) # Version on master must be X.Y (not X.Y.Z) for ProjectVersionMunged variable # to be useful (cf #19058). However, the version must have three components # (X.Y.Z) on stable branches (e.g. ghc-9.2) to ensure that pre-releases are ===================================== testsuite/tests/haddock/perf/Fold.hs ===================================== @@ -143,6 +143,7 @@ import Prelude import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NonEmpty import Control.Monad as Monad +import Control.Monad.Fix import Control.Monad.Reader import qualified Control.Monad.Reader as Reader import Data.Functor ===================================== testsuite/tests/haddock/perf/Makefile ===================================== @@ -4,12 +4,12 @@ include $(TOP)/mk/test.mk # We accept a 5% increase in parser allocations due to -haddock haddock_parser_perf : - WithHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fforce-recomp -Wno-all -ddump-timings -haddock -O0 Fold.hs 2>/dev/null | grep Parser | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ - WithoutHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fforce-recomp -Wno-all -ddump-timings -O0 Fold.hs 2>/dev/null | grep Parser | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ + WithHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface -fforce-recomp -Wno-all -ddump-timings -haddock -O0 Fold.hs 2>/dev/null | grep Parser | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ + WithoutHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface -fforce-recomp -Wno-all -ddump-timings -O0 Fold.hs 2>/dev/null | grep Parser | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ awk "BEGIN { ratio = ($$WithHaddock / $$WithoutHaddock); if (ratio > 1.05) {print \"-haddock allocation ratio too high:\", ratio; exit 1} else {exit 0} }" # Similarly for the renamer haddock_renamer_perf : - WithoutHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fforce-recomp -Wno-all -ddump-timings -O0 Fold.hs 2>/dev/null | grep Renamer | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ - WithHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fforce-recomp -Wno-all -ddump-timings -haddock -O0 Fold.hs 2>/dev/null | grep Renamer | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ - awk "BEGIN { ratio = ($$WithHaddock / $$WithoutHaddock); if (ratio > 1.20) {print \"-haddock allocation ratio too high:\", ratio; exit 1} else {exit 0} }" + WithoutHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface -fforce-recomp -Wno-all -ddump-timings -O0 Fold.hs 2>/dev/null | grep Renamer | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ + WithHaddock=$(shell '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface -fforce-recomp -Wno-all -ddump-timings -haddock -O0 Fold.hs 2>/dev/null | grep Renamer | grep -E -o 'alloc=[0-9]+' | cut -c7- ) ; \ + awk "BEGIN { ratio = ($$WithHaddock / $$WithoutHaddock); if (ratio > 1.05) {print \"-haddock allocation ratio too high:\", ratio; exit 1} else {exit 0} }" ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 30cf825972c53d97d6add9aa0e61bcb32ccc3ad1 +Subproject commit d3a8d4a0cbc1b9c81ac7bd2c2d329572679494f1 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e6c931d5bcfc0f55cb618a337e9cb6f38057b4f1...0f2b80960282908a0e47415384d28fd7a467f585 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e6c931d5bcfc0f55cb618a337e9cb6f38057b4f1...0f2b80960282908a0e47415384d28fd7a467f585 You're receiving 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 Jun 19 14:22:09 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 19 Jun 2023 10:22:09 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 3 commits: Fixes Message-ID: <64906491fc07_be462ef9307c202596@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: a99ff345 by Rodrigo Mesquita at 2023-06-19T14:25:56+01:00 Fixes - - - - - 6016847e by Rodrigo Mesquita at 2023-06-19T14:54:15+01:00 ghc-toolchain: Fix check for gold bug - - - - - 3d0abc4c by Rodrigo Mesquita at 2023-06-19T15:21:24+01:00 ghc-toolchain: set CC LD plat. dependent flags A lot to be said about this approach, we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? - - - - - 5 changed files: - default.target.in - utils/ghc-toolchain/src/GHC/Toolchain/Lens.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/MergeObjs.hs Changes: ===================================== default.target.in ===================================== @@ -6,7 +6,7 @@ Target , tgtWordSize = WS at TargetWordSize@ , tgtEndianness = @TargetEndianness@ , tgtSymbolsHaveLeadingUnderscore = @LeadingUnderscoreBool@ -, tgtLlvmTarget = "@LlvmTarget@" +, tgtLlvmTarget = "@LLVMTarget_CPP@" , tgtUnregisterised = @UnregisterisedBool@ , tgtTablesNextToCode = @TablesNextToCodeBool@ , tgtUseLibffiForAdjustors = @UseLibffiForAdjustorsBool@ ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Lens.hs ===================================== @@ -3,9 +3,12 @@ module GHC.Toolchain.Lens ( Lens(..) , (%) , over + , (%++) + , (&) ) where -import Prelude ((.), ($)) +import Prelude ((.), ($), (++)) +import Data.Function ((&)) data Lens a b = Lens { view :: (a -> b), set :: (b -> a -> a) } @@ -17,3 +20,11 @@ a % b = Lens { view = view b . view a over :: Lens a b -> (b -> b) -> a -> a over l f x = set l (f $ view l x) x +-- | Append @b@ to @[b]@ +-- +-- Example usage: +-- @@ +-- cc & _ccProgram % _prgFlags %++ "-U__i686" +-- @@ +(%++) :: Lens a [b] -> b -> (a -> a) +(%++) l el = over l (++[el]) ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ViewPatterns #-} module GHC.Toolchain.Tools.Cc ( Cc(..) @@ -28,6 +29,9 @@ newtype Cc = Cc { ccProgram :: Program _ccProgram :: Lens Cc Program _ccProgram = Lens ccProgram (\x o -> o{ccProgram=x}) +_ccFlags :: Lens Cc [String] +_ccFlags = _ccProgram % _prgFlags + findCc :: String -- ^ The llvm target to use if Cc supports --target -> ProgOpt -> M Cc findCc llvmTarget progOpt = checking "for C compiler" $ do @@ -57,10 +61,10 @@ checkCcWorks cc = withTempDir $ \dir -> do -- these. See #11684. ignoreUnusedArgs :: Cc -> M Cc ignoreUnusedArgs cc - | "-Qunused-arguments" `elem` (view (_ccProgram % _prgFlags) cc) = return cc + | "-Qunused-arguments" `elem` (view _ccFlags cc) = return cc | otherwise = checking "for -Qunused-arguments support" $ do - let cc' = over (_ccProgram % _prgFlags) (++["-Qunused-arguments"]) cc + let cc' = cc & _ccFlags %++ "-Qunused-arguments" (cc' <$ checkCcWorks cc') <|> return cc -- Does Cc support the --target= option? If so, we should pass it @@ -124,8 +128,50 @@ compileAsm = compile "S" ["-c"] _ccProgram -- | Add various platform-dependent compiler flags needed by GHC. We can't do -- this in `findCc` since we need a 'Cc` to determine the 'ArchOS'. addPlatformDepCcFlags :: ArchOS -> Cc -> M Cc -addPlatformDepCcFlags archOs cc - | OSMinGW32 <- archOS_OS archOs = do +addPlatformDepCcFlags archOs cc0 = do + let cc1 = addWorkaroundFor7799 archOs cc0 + cc2 <- addOSMinGW32CcFlags archOs cc1 + case archOs of + ArchOS ArchX86 OSMinGW32 -> + return $ cc2 & _ccFlags %++ "-march=i686" + ArchOS ArchX86 OSFreeBSD -> + return $ cc2 & _ccFlags %++ "-march=i686" + ArchOS ArchX86_64 OSSolaris2 -> + -- Solaris is a multi-lib platform, providing both 32- and 64-bit + -- user-land. It appears to default to 32-bit builds but we of course want to + -- compile for 64-bits on x86-64. + return $ cc2 & _ccFlags %++ "-m64" + ArchOS ArchAlpha _ -> + -- For now, to suppress the gcc warning "call-clobbered + -- register used for global register variable", we simply + -- disable all warnings altogether using the -w flag. Oh well. + return $ cc2 & over _ccFlags (++["-w","-mieee","-D_REENTRANT"]) + -- ArchOS ArchHPPA? _ -> + ArchOS ArchARM{} OSFreeBSD -> + -- On arm/freebsd, tell gcc to generate Arm + -- instructions (ie not Thumb). + return $ cc2 & _ccFlags %++ "-marm" + ArchOS ArchARM{} OSLinux -> + -- On arm/linux and arm/android, tell gcc to generate Arm + -- instructions (ie not Thumb). + return $ cc2 & _ccFlags %++ "-marm" + ArchOS ArchPPC OSAIX -> + -- We need `-D_THREAD_SAFE` to unlock the thread-local `errno`. + return $ cc2 & _ccFlags %++ "-D_THREAD_SAFE" + _ -> + return cc2 + + +-- | Workaround for #7799 +addWorkaroundFor7799 :: ArchOS -> Cc -> Cc +addWorkaroundFor7799 archOs cc + | ArchX86 <- archOS_arch archOs = cc & _ccFlags %++ "-U__i686" + | otherwise = cc + +-- | Adds flags specific to mingw32 +addOSMinGW32CcFlags :: ArchOS -> Cc -> M Cc +addOSMinGW32CcFlags archOs cc + | ArchOS _ OSMinGW32 <- archOs = do checkFStackCheck cc <|> throwE "Windows requires -fstack-check support yet the C compiler appears not to support it" | otherwise = return cc @@ -133,7 +179,7 @@ addPlatformDepCcFlags archOs cc -- See Note [Windows stack allocations]. checkFStackCheck :: Cc -> M Cc checkFStackCheck cc = withTempDir $ \dir -> checking "that -fstack-check works" $ do - let cc' = over (_ccProgram % _prgFlags) (++["-Wl,-fstack-checkzz"]) cc + let cc' = cc & _ccFlags %++ "-Wl,-fstack-checkzz" compileC cc' (dir "test.o") "int main(int argc, char **argv) { return 0; }" return cc' ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -260,13 +260,51 @@ The flag is only needed on ELF systems. On Windows (PE) and Mac OS X -- | Add various platform-dependent flags needed for reliable linking. addPlatformDepLinkFlags :: ArchOS -> Cc -> Program -> M Program -addPlatformDepLinkFlags archOs cc ccLink +addPlatformDepLinkFlags archOs cc ccLink0 = do + ccLink1 <- addNoAsNeeded archOs cc ccLink0 + case archOs of + -- ROMES:TODO: Consider dropping this alongside other configuration for solaris that was dropped + ArchOS ArchX86_64 OSSolaris2 -> + -- Solaris is a multi-lib platform, providing both 32- and 64-bit + -- user-land. It appears to default to 32-bit builds but we of course want to + -- compile for 64-bits on x86-64. + -- + -- On OpenSolaris uses gnu ld whereas SmartOS appears to use the Solaris + -- implementation, which rather uses the -64 flag. + return $ ccLink1 & _prgFlags %++ "-m64" + ArchOS ArchAlpha _ -> + -- For now, to suppress the gcc warning "call-clobbered + -- register used for global register variable", we simply + -- disable all warnings altogether using the -w flag. Oh well. + return $ ccLink1 & over _prgFlags (++["-w","-mieee","-D_REENTRANT"]) + -- ArchOS ArchHPPA? _ -> + ArchOS ArchARM{} OSFreeBSD -> + -- On arm/freebsd, tell gcc to generate Arm + -- instructions (ie not Thumb). + return $ ccLink1 & _prgFlags %++ "-Wl,-z,-noexecstack" + ArchOS ArchARM{} OSLinux -> + -- On arm/linux and arm/android, tell gcc to generate Arm + -- instructions (ie not Thumb). + return $ ccLink1 & _prgFlags %++ "-Wl,-z,-noexecstack" + ArchOS ArchAArch64 OSFreeBSD -> + return $ ccLink1 & _prgFlags %++ "-Wl,-z,-noexecstack" + ArchOS ArchAArch64 OSLinux -> + return $ ccLink1 & _prgFlags %++ "-Wl,-z,-noexecstack" + ArchOS ArchAArch64 OSNetBSD -> + return $ ccLink1 & _prgFlags %++ "-Wl,-z,-noexecstack" + ArchOS ArchPPC OSAIX -> + -- We need `-D_THREAD_SAFE` to unlock the thread-local `errno`. + return $ ccLink1 & over _prgFlags (++["-D_THREAD_SAFE","-Wl,-bnotextro"]) + _ -> + return ccLink1 + +addNoAsNeeded :: ArchOS -> Cc -> Program -> M Program +addNoAsNeeded archOs cc ccLink | OSLinux <- archOS_OS archOs = checking "that --no-as-needed works" $ do -- | See Note [ELF needed shared libs] let ccLink' = over _prgFlags (++["-Wl,--no-as-needed"]) ccLink checkLinkWorks cc ccLink' return ccLink' - | otherwise = return ccLink -- See if whether we are using a version of ld64 on darwin platforms which ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/MergeObjs.hs ===================================== @@ -4,10 +4,8 @@ module GHC.Toolchain.Tools.MergeObjs ( MergeObjs(..), findMergeObjs ) where import Control.Monad -import Control.Monad.IO.Class import Data.List import System.FilePath -import System.Process import GHC.Toolchain.Prelude import GHC.Toolchain.Utils @@ -23,7 +21,7 @@ newtype MergeObjs = MergeObjs { mergeObjsProgram :: Program findMergeObjs :: ProgOpt -> Cc -> CcLink -> Nm -> M MergeObjs findMergeObjs progOpt cc ccLink nm = checking "for linker for merging objects" $ do - prog <- findProgram "linker for merging objects" progOpt ["ld"] + prog <- findProgram "linker for merging objects" progOpt ["ld.gold", "ld"] let mo = MergeObjs $ over _prgFlags (++["-r"]) prog checkMergingWorks cc nm mo checkForGoldT22266 cc ccLink mo @@ -63,11 +61,11 @@ checkForGoldT22266 cc ccLink mergeObjs = do compileC cc a_o progA writeFile link_script ldScript callProgram (mergeObjsProgram mergeObjs) - ["-T", link_script, "-o", merged_o] + ["-T", link_script, a_o, "-o", merged_o] compileC cc main_o progMain callProgram (ccLinkProgram ccLink) ["-o", exe, merged_o, main_o] - liftIO $ callProcess exe [] + callProgram (Program exe []) [] progA = unlines [ "__attribute__((section(\".data.a\")))" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c755b2163a69cddb5fe64f208361bb03965f890f...3d0abc4ccae0b7c58d0e4a212fb97fd2e91701b8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c755b2163a69cddb5fe64f208361bb03965f890f...3d0abc4ccae0b7c58d0e4a212fb97fd2e91701b8 You're receiving 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 Jun 19 14:39:40 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 19 Jun 2023 10:39:40 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] ghc-toolchain: set CC LD plat. dependent flags Message-ID: <649068acbf4a7_be462f589f44206639@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: eb5f75b9 by Rodrigo Mesquita at 2023-06-19T15:39:29+01:00 ghc-toolchain: set CC LD plat. dependent flags A lot to be said about this approach, we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? - - - - - 4 changed files: - utils/ghc-toolchain/src/GHC/Toolchain/Lens.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/MergeObjs.hs Changes: ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Lens.hs ===================================== @@ -3,9 +3,12 @@ module GHC.Toolchain.Lens ( Lens(..) , (%) , over + , (%++) + , (&) ) where -import Prelude ((.), ($)) +import Prelude ((.), ($), (++)) +import Data.Function ((&)) data Lens a b = Lens { view :: (a -> b), set :: (b -> a -> a) } @@ -17,3 +20,11 @@ a % b = Lens { view = view b . view a over :: Lens a b -> (b -> b) -> a -> a over l f x = set l (f $ view l x) x +-- | Append @b@ to @[b]@ +-- +-- Example usage: +-- @@ +-- cc & _ccProgram % _prgFlags %++ "-U__i686" +-- @@ +(%++) :: Lens a [b] -> b -> (a -> a) +(%++) l el = over l (++[el]) ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ViewPatterns #-} module GHC.Toolchain.Tools.Cc ( Cc(..) @@ -28,6 +29,9 @@ newtype Cc = Cc { ccProgram :: Program _ccProgram :: Lens Cc Program _ccProgram = Lens ccProgram (\x o -> o{ccProgram=x}) +_ccFlags :: Lens Cc [String] +_ccFlags = _ccProgram % _prgFlags + findCc :: String -- ^ The llvm target to use if Cc supports --target -> ProgOpt -> M Cc findCc llvmTarget progOpt = checking "for C compiler" $ do @@ -57,10 +61,10 @@ checkCcWorks cc = withTempDir $ \dir -> do -- these. See #11684. ignoreUnusedArgs :: Cc -> M Cc ignoreUnusedArgs cc - | "-Qunused-arguments" `elem` (view (_ccProgram % _prgFlags) cc) = return cc + | "-Qunused-arguments" `elem` (view _ccFlags cc) = return cc | otherwise = checking "for -Qunused-arguments support" $ do - let cc' = over (_ccProgram % _prgFlags) (++["-Qunused-arguments"]) cc + let cc' = cc & _ccFlags %++ "-Qunused-arguments" (cc' <$ checkCcWorks cc') <|> return cc -- Does Cc support the --target= option? If so, we should pass it @@ -124,8 +128,50 @@ compileAsm = compile "S" ["-c"] _ccProgram -- | Add various platform-dependent compiler flags needed by GHC. We can't do -- this in `findCc` since we need a 'Cc` to determine the 'ArchOS'. addPlatformDepCcFlags :: ArchOS -> Cc -> M Cc -addPlatformDepCcFlags archOs cc - | OSMinGW32 <- archOS_OS archOs = do +addPlatformDepCcFlags archOs cc0 = do + let cc1 = addWorkaroundFor7799 archOs cc0 + cc2 <- addOSMinGW32CcFlags archOs cc1 + case archOs of + ArchOS ArchX86 OSMinGW32 -> + return $ cc2 & _ccFlags %++ "-march=i686" + ArchOS ArchX86 OSFreeBSD -> + return $ cc2 & _ccFlags %++ "-march=i686" + ArchOS ArchX86_64 OSSolaris2 -> + -- Solaris is a multi-lib platform, providing both 32- and 64-bit + -- user-land. It appears to default to 32-bit builds but we of course want to + -- compile for 64-bits on x86-64. + return $ cc2 & _ccFlags %++ "-m64" + ArchOS ArchAlpha _ -> + -- For now, to suppress the gcc warning "call-clobbered + -- register used for global register variable", we simply + -- disable all warnings altogether using the -w flag. Oh well. + return $ cc2 & over _ccFlags (++["-w","-mieee","-D_REENTRANT"]) + -- ArchOS ArchHPPA? _ -> + ArchOS ArchARM{} OSFreeBSD -> + -- On arm/freebsd, tell gcc to generate Arm + -- instructions (ie not Thumb). + return $ cc2 & _ccFlags %++ "-marm" + ArchOS ArchARM{} OSLinux -> + -- On arm/linux and arm/android, tell gcc to generate Arm + -- instructions (ie not Thumb). + return $ cc2 & _ccFlags %++ "-marm" + ArchOS ArchPPC OSAIX -> + -- We need `-D_THREAD_SAFE` to unlock the thread-local `errno`. + return $ cc2 & _ccFlags %++ "-D_THREAD_SAFE" + _ -> + return cc2 + + +-- | Workaround for #7799 +addWorkaroundFor7799 :: ArchOS -> Cc -> Cc +addWorkaroundFor7799 archOs cc + | ArchX86 <- archOS_arch archOs = cc & _ccFlags %++ "-U__i686" + | otherwise = cc + +-- | Adds flags specific to mingw32 +addOSMinGW32CcFlags :: ArchOS -> Cc -> M Cc +addOSMinGW32CcFlags archOs cc + | ArchOS _ OSMinGW32 <- archOs = do checkFStackCheck cc <|> throwE "Windows requires -fstack-check support yet the C compiler appears not to support it" | otherwise = return cc @@ -133,7 +179,7 @@ addPlatformDepCcFlags archOs cc -- See Note [Windows stack allocations]. checkFStackCheck :: Cc -> M Cc checkFStackCheck cc = withTempDir $ \dir -> checking "that -fstack-check works" $ do - let cc' = over (_ccProgram % _prgFlags) (++["-Wl,-fstack-checkzz"]) cc + let cc' = cc & _ccFlags %++ "-Wl,-fstack-checkzz" compileC cc' (dir "test.o") "int main(int argc, char **argv) { return 0; }" return cc' ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -260,13 +260,51 @@ The flag is only needed on ELF systems. On Windows (PE) and Mac OS X -- | Add various platform-dependent flags needed for reliable linking. addPlatformDepLinkFlags :: ArchOS -> Cc -> Program -> M Program -addPlatformDepLinkFlags archOs cc ccLink +addPlatformDepLinkFlags archOs cc ccLink0 = do + ccLink1 <- addNoAsNeeded archOs cc ccLink0 + case archOs of + -- ROMES:TODO: Consider dropping this alongside other configuration for solaris that was dropped + ArchOS ArchX86_64 OSSolaris2 -> + -- Solaris is a multi-lib platform, providing both 32- and 64-bit + -- user-land. It appears to default to 32-bit builds but we of course want to + -- compile for 64-bits on x86-64. + -- + -- On OpenSolaris uses gnu ld whereas SmartOS appears to use the Solaris + -- implementation, which rather uses the -64 flag. + return $ ccLink1 & _prgFlags %++ "-m64" + ArchOS ArchAlpha _ -> + -- For now, to suppress the gcc warning "call-clobbered + -- register used for global register variable", we simply + -- disable all warnings altogether using the -w flag. Oh well. + return $ ccLink1 & over _prgFlags (++["-w","-mieee","-D_REENTRANT"]) + -- ArchOS ArchHPPA? _ -> + ArchOS ArchARM{} OSFreeBSD -> + -- On arm/freebsd, tell gcc to generate Arm + -- instructions (ie not Thumb). + return $ ccLink1 & _prgFlags %++ "-Wl,-z,noexecstack" + ArchOS ArchARM{} OSLinux -> + -- On arm/linux and arm/android, tell gcc to generate Arm + -- instructions (ie not Thumb). + return $ ccLink1 & _prgFlags %++ "-Wl,-z,noexecstack" + ArchOS ArchAArch64 OSFreeBSD -> + return $ ccLink1 & _prgFlags %++ "-Wl,-z,noexecstack" + ArchOS ArchAArch64 OSLinux -> + return $ ccLink1 & _prgFlags %++ "-Wl,-z,noexecstack" + ArchOS ArchAArch64 OSNetBSD -> + return $ ccLink1 & _prgFlags %++ "-Wl,-z,noexecstack" + ArchOS ArchPPC OSAIX -> + -- We need `-D_THREAD_SAFE` to unlock the thread-local `errno`. + return $ ccLink1 & over _prgFlags (++["-D_THREAD_SAFE","-Wl,-bnotextro"]) + _ -> + return ccLink1 + +addNoAsNeeded :: ArchOS -> Cc -> Program -> M Program +addNoAsNeeded archOs cc ccLink | OSLinux <- archOS_OS archOs = checking "that --no-as-needed works" $ do -- | See Note [ELF needed shared libs] let ccLink' = over _prgFlags (++["-Wl,--no-as-needed"]) ccLink checkLinkWorks cc ccLink' return ccLink' - | otherwise = return ccLink -- See if whether we are using a version of ld64 on darwin platforms which ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/MergeObjs.hs ===================================== @@ -4,10 +4,8 @@ module GHC.Toolchain.Tools.MergeObjs ( MergeObjs(..), findMergeObjs ) where import Control.Monad -import Control.Monad.IO.Class import Data.List import System.FilePath -import System.Process import GHC.Toolchain.Prelude import GHC.Toolchain.Utils View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eb5f75b94d6ef12e096f8be75a74dc6da7ad27b1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eb5f75b94d6ef12e096f8be75a74dc6da7ad27b1 You're receiving 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 Jun 19 14:58:25 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 19 Jun 2023 10:58:25 -0400 Subject: [Git][ghc/ghc][wip/expand-do] add stmt context in tcApp rather other places Message-ID: <64906d11e44d6_be462f9b6ba8210962@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: e203ab70 by Apoorv Ingle at 2023-06-19T09:58:16-05:00 add stmt context in tcApp rather other places - - - - - 3 changed files: - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -355,7 +355,11 @@ tcApp rn_expr exp_res_ty -- Note [Handling overloaded and rebindable constructs] in GHC.Rename.Expr ; let perhaps_add_res_ty_ctxt thing_inside | insideExpansion fun_ctxt || isGeneratedSrcSpan (appCtxtLoc fun_ctxt) - = do traceTc "insideExpansion" (vcat [ppr rn_fun, ppr fun_ctxt]) + , VACall (XExpr (ExpandedStmt (HsExpanded stmt@(L loc _) _))) _ _ <- fun_ctxt + = do traceTc "insideExpansion stmt" (vcat [ppr rn_fun, ppr fun_ctxt]) + setSrcSpanA loc $ addStmtCtxt stmt thing_inside + | insideExpansion fun_ctxt -- || isGeneratedSrcSpan (appCtxtLoc fun_ctxt) + = do traceTc "insideExpansion no stmt" (vcat [ppr rn_fun, ppr fun_ctxt]) addHeadCtxt fun_ctxt thing_inside | otherwise = do traceTc "no expansion" (ppr rn_fun) @@ -705,7 +709,9 @@ addArgCtxt ctxt (L arg_loc arg) thing_inside , text "arg_loc" <+> ppr arg_loc , text "is src ctxt" <+> ppr in_src_ctxt , text "is generated code" <+> ppr in_generated_code - , text "is then" <+> ppr (is_then_fun (appCtxtExpr ctxt)) ]) + , text "is then/bind" + <+> ppr (is_then_fun (appCtxtExpr ctxt)) + <+> ppr (is_bind_fun (appCtxtExpr ctxt)) ]) ; case ctxt of VACall fun _ _ | not in_src_ctxt , is_then_fun fun || is_bind_fun fun ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -217,6 +217,7 @@ tcExpr (XExpr (ExpandedStmt (HsExpanded stmt@(L loc _) (L _ e)))) res_ty = do { traceTc "tcDoStmts" (vcat [ text "stmt:" <+> ppr stmt , text "expr:" <+> ppr e , text "res_ty:" <+> ppr res_ty + , text "loc" <+> ppr loc ]) ; setSrcSpanA loc $ addStmtCtxt stmt $ tcExpr e res_ty @@ -431,21 +432,23 @@ tcExpr (HsMultiIf _ alts) res_ty tcExpr hsDo@(HsDo _ doFlav@(DoExpr{}) (L _ stmts)) res_ty = do { expanded_expr <- expandDoStmts doFlav stmts -- Do expansion on the fly - ; let expanded_do_expr = mkExpandedExpr hsDo (unLoc expanded_expr) + ; -- let expanded_do_expr = mkExpandedExpr hsDo (unLoc expanded_expr) ; traceTc "tcDoStmts " (vcat [ text "hsDo:" <+> ppr hsDo , text "expr:" <+> ppr expanded_expr ]) - ; tcExpr expanded_do_expr res_ty + ; -- addExprCtxt hsDo $ + tcExpr (unLoc expanded_expr) res_ty } tcExpr hsDo@(HsDo _ doFlav@(MDoExpr{}) (L _ stmts)) res_ty = do { expanded_expr <- expandDoStmts doFlav stmts -- Do expansion on the fly - ; let expanded_do_expr = mkExpandedExpr hsDo (unLoc expanded_expr) + ; -- let expanded_do_expr = mkExpandedExpr hsDo (unLoc expanded_expr) ; traceTc "tcDoStmts " (vcat [ text "hsDo:" <+> ppr hsDo , text "expr:" <+> ppr expanded_expr ]) - ; tcExpr expanded_do_expr res_ty + ; -- addExprCtxt hsDo $ + tcExpr (unLoc expanded_expr) res_ty } tcExpr (HsDo _ do_or_lc stmts) res_ty ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1248,11 +1248,13 @@ expand_do_stmts do_or_lc (stmt@(L _ (BindStmt xbsrn pat e)): lstmts) -- _ = fail "Pattern match failure .." -- ------------------------------------------------------- -- pat <- e ; stmts ~~> (>>=) e f - do expand_stmts <- expand_do_stmts do_or_lc lstmts + do isRebindableOn <- xoptM LangExt.RebindableSyntax + let spanWrap = if isRebindableOn then noLocA else wrapGenSpan + expand_stmts <- expand_do_stmts do_or_lc lstmts expr@(L l _) <- mk_failable_lexpr_tcm pat expand_stmts fail_op traceTc "expand_do_stmts" (vcat [ text "loc ex stmts" <+> ppr l]) return $ wrapGenSpan (mkPopSrcSpanExpr $ wrapGenSpan (mkExpandedStmt stmt ( - (wrapGenSpan bind_op) `genHsApp` e)) -- (>>=) + (spanWrap bind_op) `genHsApp` e)) -- (>>=) `genHsApp` expr ) @@ -1263,10 +1265,12 @@ expand_do_stmts do_or_lc (stmt@(L _ (BodyStmt _ e (SyntaxExprRn f) _)) : lstmts) -- stmts ~~> stmts' -- ---------------------------------------------- -- e ; stmts ~~> (>>) e stmts' - do expand_stmts@(L l _) <- expand_do_stmts do_or_lc lstmts + do isRebindableOn <- xoptM LangExt.RebindableSyntax + let spanWrap = if isRebindableOn then noLocA else wrapGenSpan + expand_stmts@(L l _) <- expand_do_stmts do_or_lc lstmts traceTc "expand_do_stmts" (vcat [ text "loc ex stmts" <+> ppr l]) return $ wrapGenSpan (mkPopSrcSpanExpr $ wrapGenSpan (mkExpandedStmt stmt ( - (wrapGenSpan f) -- (>>) + (spanWrap f) -- (>>) `genHsApp` e)) `genHsApp` expand_stmts) -- stmts' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e203ab704f6c5b4279d7352827c476cc93dc0ac7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e203ab704f6c5b4279d7352827c476cc93dc0ac7 You're receiving 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 Jun 19 15:32:45 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 19 Jun 2023 11:32:45 -0400 Subject: [Git][ghc/ghc][wip/expand-do] 67 commits: Add role annotations to SNat, SSymbol and SChar Message-ID: <6490751d57591_be462f9a734c2189b9@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 07a03b50 by Apoorv Ingle at 2023-06-19T09:58:53-05:00 Fixes #18324 #23147 Expands do notation before typechecking using `HsExpansion` - Adds testcases T18324, T18324b, DoubleMatch Expands - Do statements - Monadic do statements - monadic fix blocks - make sure fail is used for pattern match failures in bind statments - Makes sure unused binds generate warnings - runs the pattern match check in generated lambda exprs to avoid getting suprious pattern match failures. c.f. pmcheck/should_compile/DoubleMatch.hs - PopSrcSpan in HsExpr to pop error context - Discards default monad fail alternatives that are spuriously generated - Make sure we check for generated loc span for checking if the (>>) is user written or expanded for /do/ purposes - - - - - f1083413 by Apoorv Ingle at 2023-06-19T09:59:58-05:00 - Add PopSrcSpan (XXExprGhcRn) in appropriate places while expanding statements - correct source spans displayed for warnDiscardedDoBindings - use `mkExpandStmt` to store original stmts along with expanded expr for using the right context for error message printing - improves error messages for applicative do - remove special case from isMatchContextPmChecked (long distance info is now properly propogated) - set correct src spans to statement expansions - Match ctxt while type checking HsLam is different if the lambda match is due to an expression generated from a do block - call tcExpr and not tcApp in PopSrcSpan so make sure impredicativity works fine - look into XExprs in tcInferAppHead_maybe for infering the type to make T18324 typecheck and run - - - - - 76e7b063 by Apoorv Ingle at 2023-06-19T10:00:03-05:00 generate incomplete uni patterns warnings if the origin context is a generated do expansion - - - - - ab193fcb by Apoorv Ingle at 2023-06-19T10:00:03-05:00 use the correct bind operator for qualified rebindable rec do expansions - - - - - 80028dba by Apoorv Ingle at 2023-06-19T10:00:03-05:00 trying out changes to heralds - - - - - 37031314 by Apoorv Ingle at 2023-06-19T10:00:03-05:00 add location information for last statements - - - - - 8d7fd795 by Apoorv Ingle at 2023-06-19T10:00:03-05:00 do not pop context while checking the second argument to expanded (>>) - - - - - 0a3bf898 by Apoorv Ingle at 2023-06-19T10:00:03-05:00 adjusting the generated spans for proper error messages - - - - - 5560838e by Apoorv Ingle at 2023-06-19T10:00:03-05:00 change the addHeadCtxt to include the first statement of the do block for more precise error messages - - - - - 2e3f94f2 by Apoorv Ingle at 2023-06-19T10:00:03-05:00 - don't add any ctxt in addExprCtxt for `XExpr(ExpandedStmt{})` as it is not very useful, the statement ctxt is already added by `tcExpr` and `addHeadCtxt` - - - - - 574f2e28 by Apoorv Ingle at 2023-06-19T10:00:03-05:00 - addStmtCtxt to add the right statement context in the error contexts - expansion stmt to span over bind/>>= application and pattern rather than only the arguments - - - - - fdf15de1 by Apoorv Ingle at 2023-06-19T10:00:03-05:00 add stmt context in tcApp rather other places - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e203ab704f6c5b4279d7352827c476cc93dc0ac7...fdf15de19955418e067fcee0e81e8cfda6243aea -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e203ab704f6c5b4279d7352827c476cc93dc0ac7...fdf15de19955418e067fcee0e81e8cfda6243aea You're receiving 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 Jun 19 15:33:00 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 19 Jun 2023 11:33:00 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] configure: Bump version to 9.8 Message-ID: <6490752ce7625_be462f589f44219973@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: 53eaeb89 by Ben Gamari at 2023-06-19T11:32:38-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 2 changed files: - configure.ac - utils/haddock 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.7], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.8], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) # Version on master must be X.Y (not X.Y.Z) for ProjectVersionMunged variable # to be useful (cf #19058). However, the version must have three components # (X.Y.Z) on stable branches (e.g. ghc-9.2) to ensure that pre-releases are ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 871b00b3a9cd54d8b3eea45da6febde672fd81f9 +Subproject commit d3a8d4a0cbc1b9c81ac7bd2c2d329572679494f1 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/53eaeb8924d595c0a5cc3af5f5116b8ba9ffa76b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/53eaeb8924d595c0a5cc3af5f5116b8ba9ffa76b You're receiving 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 Jun 19 15:34:00 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Mon, 19 Jun 2023 11:34:00 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T22382 Message-ID: <649075686da38_be462fb99c7c2221cf@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/T22382 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T22382 You're receiving 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 Jun 19 16:24:36 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 19 Jun 2023 12:24:36 -0400 Subject: [Git][ghc/ghc][wip/T23400] testsuite: Add test for #23400 Message-ID: <6490814477845_be462f589f44247195@gitlab.mail> Ben Gamari pushed to branch wip/T23400 at Glasgow Haskell Compiler / GHC Commits: acaa5647 by Ben Gamari at 2023-05-24T18:05:28-04:00 testsuite: Add test for #23400 - - - - - 3 changed files: - + testsuite/tests/rts/T23400.hs - + testsuite/tests/rts/T23400.stdout - testsuite/tests/rts/all.T Changes: ===================================== testsuite/tests/rts/T23400.hs ===================================== @@ -0,0 +1,39 @@ +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} + +module Main (main) where + +import Control.Monad +import Data.Array.Byte +import Data.Int +import GHC.Exts +import GHC.IO + +main :: IO () +main = do + let szInt = 8 + sz = 101 + + cur0 <- newAlignedPinnedByteArray (sz*szInt) 4096 + old0 <- newAlignedPinnedByteArray (sz*szInt) 64 + + print (sizeofMutableByteArray cur0) + print (sizeofMutableByteArray old0) + + replicateM_ 20 $ do + forM_ [0 .. sz-1] $ \i -> do + putStrLn $ "I: " <> show i + writeByteArray cur0 i (2*i) + +newAlignedPinnedByteArray :: Int -> Int -> IO (MutableByteArray RealWorld) +newAlignedPinnedByteArray (I# sz) (I# align) = IO $ \s0 -> + case newAlignedPinnedByteArray# sz align s0 of + (# s1, ba #) -> (# s1, MutableByteArray ba #) + +sizeofMutableByteArray :: MutableByteArray RealWorld -> Int +sizeofMutableByteArray (MutableByteArray arr#) = I# (sizeofMutableByteArray# arr#) + +writeByteArray :: MutableByteArray RealWorld -> Int -> Int -> IO () +writeByteArray (MutableByteArray arr#) (I# i#) (I# x#) = + IO (\s# -> case writeIntArray# arr# i# x# s# of + s'# -> (# s'#, () #)) ===================================== testsuite/tests/rts/T23400.stdout ===================================== @@ -0,0 +1,2022 @@ +808 +808 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 +I: 0 +I: 1 +I: 2 +I: 3 +I: 4 +I: 5 +I: 6 +I: 7 +I: 8 +I: 9 +I: 10 +I: 11 +I: 12 +I: 13 +I: 14 +I: 15 +I: 16 +I: 17 +I: 18 +I: 19 +I: 20 +I: 21 +I: 22 +I: 23 +I: 24 +I: 25 +I: 26 +I: 27 +I: 28 +I: 29 +I: 30 +I: 31 +I: 32 +I: 33 +I: 34 +I: 35 +I: 36 +I: 37 +I: 38 +I: 39 +I: 40 +I: 41 +I: 42 +I: 43 +I: 44 +I: 45 +I: 46 +I: 47 +I: 48 +I: 49 +I: 50 +I: 51 +I: 52 +I: 53 +I: 54 +I: 55 +I: 56 +I: 57 +I: 58 +I: 59 +I: 60 +I: 61 +I: 62 +I: 63 +I: 64 +I: 65 +I: 66 +I: 67 +I: 68 +I: 69 +I: 70 +I: 71 +I: 72 +I: 73 +I: 74 +I: 75 +I: 76 +I: 77 +I: 78 +I: 79 +I: 80 +I: 81 +I: 82 +I: 83 +I: 84 +I: 85 +I: 86 +I: 87 +I: 88 +I: 89 +I: 90 +I: 91 +I: 92 +I: 93 +I: 94 +I: 95 +I: 96 +I: 97 +I: 98 +I: 99 +I: 100 ===================================== testsuite/tests/rts/all.T ===================================== @@ -593,3 +593,5 @@ test('T17574', [js_skip], compile_and_run, ['-with-rtsopts -T']) test('T23221', [js_skip, high_memory_usage, extra_run_opts('1500000'), unless(wordsize(64), skip)], compile_and_run, ['-O -with-rtsopts -T']) test('T23142', [unless(debug_rts(), skip), req_interp], makefile_test, ['T23142']) + +test('T23400', [], compile_and_run, ['-with-rtsopts -A8k']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/acaa5647fcd260fe0b74c85dead72c20297ef5ac -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/acaa5647fcd260fe0b74c85dead72c20297ef5ac You're receiving 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 Jun 19 16:25:44 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 19 Jun 2023 12:25:44 -0400 Subject: [Git][ghc/ghc][wip/T21134] 145 commits: Migrate errors in GHC.Rename.Splice GHC.Rename.Pat Message-ID: <64908188e5ae3_be462ef9307c2478df@gitlab.mail> Ben Gamari pushed to branch wip/T21134 at Glasgow Haskell Compiler / GHC Commits: 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - 191fd7b7 by Ben Gamari at 2023-06-19T12:25:33-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - HACKING.md - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types/Prim.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/BooleanFormula.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fcf6bae587ee5c25d1c8b0d6b138caa253c69d59...191fd7b77ed375a70be5e06fc85ddde5047c45e8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fcf6bae587ee5c25d1c8b0d6b138caa253c69d59...191fd7b77ed375a70be5e06fc85ddde5047c45e8 You're receiving 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 Jun 19 16:42:56 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 19 Jun 2023 12:42:56 -0400 Subject: [Git][ghc/ghc][wip/rts-warnings] rts: Fix capitalization of prototype Message-ID: <64908590b9456_be462fca8bf4252535@gitlab.mail> Ben Gamari pushed to branch wip/rts-warnings at Glasgow Haskell Compiler / GHC Commits: 909d36c8 by Ben Gamari at 2023-06-19T12:42:37-04:00 rts: Fix capitalization of prototype - - - - - 1 changed file: - rts/include/rts/storage/ClosureMacros.h Changes: ===================================== rts/include/rts/storage/ClosureMacros.h ===================================== @@ -623,7 +623,7 @@ INLINE_HEADER void overwritingMutableClosureOfs (StgClosure *p, uint32_t offset) } // Version of 'overwritingClosure' which takes closure size as argument. -void stg_OverwritingClosureSize (StgClosure *p, uint32_t size /* in words */); +void stg_overwritingClosureSize (StgClosure *p, uint32_t size /* in words */); INLINE_HEADER void overwritingClosureSize (StgClosure *p, uint32_t size) { // This function is only called from stg_AP_STACK so we can assume it's not View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/909d36c86aab743ed3462c2a1916e6e140f4fb39 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/909d36c86aab743ed3462c2a1916e6e140f4fb39 You're receiving 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 Jun 19 17:58:12 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Mon, 19 Jun 2023 13:58:12 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/less-defaulting Message-ID: <6490973428e6e_be462150dba14266034@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/less-defaulting at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/less-defaulting You're receiving 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 Jun 19 18:01:04 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Mon, 19 Jun 2023 14:01:04 -0400 Subject: [Git][ghc/ghc][wip/less-defaulting] Change the defaulting rules in commitFlexi Message-ID: <649097e0c5aea_be462f9a734c266271@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/less-defaulting at Glasgow Haskell Compiler / GHC Commits: f95a3336 by Krzysztof Gogolewski at 2023-06-19T20:00:49+02:00 Change the defaulting rules in commitFlexi - Multiplicity isn't special, default to Any - RuntimeRep and Levity are special only when concrete - - - - - 1 changed file: - compiler/GHC/Tc/Zonk/Type.hs Changes: ===================================== compiler/GHC/Tc/Zonk/Type.hs ===================================== @@ -456,21 +456,20 @@ commitFlexi tv zonked_kind -- y = (\x -> True) undefined -- We need *some* known RuntimeRep for the x and undefined, but no one -- will choose it until we get here, in the zonker. - | isRuntimeRepTy zonked_kind - -> do { traceTc "Defaulting flexi tyvar to LiftedRep:" (pprTyVar tv) - ; return liftedRepTy } - | isLevityTy zonked_kind - -> do { traceTc "Defaulting flexi tyvar to Lifted:" (pprTyVar tv) - ; return liftedDataConTy } - | isMultiplicityTy zonked_kind - -> do { traceTc "Defaulting flexi tyvar to Many:" (pprTyVar tv) - ; return manyDataConTy } - | Just (ConcreteFRR origin) <- isConcreteTyVar_maybe tv - -> do { addErr $ TcRnZonkerMessage (ZonkerCannotDefaultConcrete origin) - ; return (anyTypeOfKind zonked_kind) } - | otherwise - -> do { traceTc "Defaulting flexi tyvar to Any:" (pprTyVar tv) - ; return (anyTypeOfKind zonked_kind) } + -> case isConcreteTyVar_maybe tv of + Nothing + -> do { traceTc "Defaulting flexi tyvar to Any:" (pprTyVar tv) + ; return (anyTypeOfKind zonked_kind) } + Just (ConcreteFRR origin) + | isRuntimeRepTy zonked_kind + -> do { traceTc "Defaulting flexi tyvar to LiftedRep:" (pprTyVar tv) + ; return liftedRepTy } + | isLevityTy zonked_kind + -> do { traceTc "Defaulting flexi tyvar to Lifted:" (pprTyVar tv) + ; return liftedDataConTy } + | otherwise + -> do { addErr $ TcRnZonkerMessage (ZonkerCannotDefaultConcrete origin) + ; return (anyTypeOfKind zonked_kind) } RuntimeUnkFlexi -> do { traceTc "Defaulting flexi tyvar to RuntimeUnk:" (pprTyVar tv) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f95a33363b385508d77de3983179e7cccc2318a3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f95a33363b385508d77de3983179e7cccc2318a3 You're receiving 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 Jun 19 18:09:49 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 19 Jun 2023 14:09:49 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] 12 commits: IPE data compression Message-ID: <649099ed79219_be462159907682674de@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - ca14741a by Finley McIlwaine at 2023-06-19T13:10:23-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - d2a421f9 by Finley McIlwaine at 2023-06-19T13:10:24-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 602ce9e2 by Ben Gamari at 2023-06-19T13:10:24-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 714d0564 by Ben Gamari at 2023-06-19T14:09:12-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 122a0816 by Sylvain Henry at 2023-06-19T14:09:16-04: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> - - - - - 888fec37 by Sylvain Henry at 2023-06-19T14:09:16-04:00 Don't use getKey - - - - - d36f7dac by Sylvain Henry at 2023-06-19T14:09:16-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - 1c50fa46 by Sylvain Henry at 2023-06-19T14:09:16-04:00 Fix some recompilation avoidance tests - - - - - 39245dee by Sylvain Henry at 2023-06-19T14:09:16-04:00 TH_import_loop is now broken as expected - - - - - 0c8d54e6 by Sylvain Henry at 2023-06-19T14:09:16-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 27 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Runtime/Context.hs - compiler/GHC/Runtime/Interpreter.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/53eaeb8924d595c0a5cc3af5f5116b8ba9ffa76b...0c8d54e602acfc14e22a018e15680598850c3788 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/53eaeb8924d595c0a5cc3af5f5116b8ba9ffa76b...0c8d54e602acfc14e22a018e15680598850c3788 You're receiving 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 Jun 19 21:11:43 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 19 Jun 2023 17:11:43 -0400 Subject: [Git][ghc/ghc][wip/T23210] 65 commits: Restore mingwex dependency on Windows Message-ID: <6490c48f57a26_be462f1c2dc030811e@gitlab.mail> Ben Gamari pushed to branch wip/T23210 at Glasgow Haskell Compiler / GHC Commits: 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 8069ce60 by Ben Gamari at 2023-06-19T17:11:36-04:00 rts: Tighten up invariants of PACK - - - - - 4fceaf4c by Ben Gamari at 2023-06-19T17:11:36-04:00 StgToByteCode: Don't assume that data con workers are nullary Previously StgToByteCode assumed that all data-con workers were of a nullary representation. This is not a valid assumption, as seen in #23210, where an unsaturated application of a unary data constructor's worker resulted in invalid bytecode. Sadly, I have not yet been able to reduce a minimal testcase for this. Fixes #23210. - - - - - 3a3bf828 by Ben Gamari at 2023-06-19T17:11:36-04:00 StgToByteCode: Fix handling of Addr# literals Previously we assumed that all unlifted types were Addr#. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/JS/Make.hs - compiler/GHC/JS/Syntax.hs - compiler/GHC/JS/Unsat/Syntax.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Stg/Utils.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/InfoTableProv.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e4e7f5d674e9fb3286e29c9b41837dc68ad07ba8...3a3bf8288bce175e210091e18a7f4407e073aea4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e4e7f5d674e9fb3286e29c9b41837dc68ad07ba8...3a3bf8288bce175e210091e18a7f4407e073aea4 You're receiving 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 Jun 19 21:25:48 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 19 Jun 2023 17:25:48 -0400 Subject: [Git][ghc/ghc][wip/testsuite-output-patch] 123 commits: Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) Message-ID: <6490c7dc101c8_be462fb99e0c315446@gitlab.mail> Ben Gamari pushed to branch wip/testsuite-output-patch at Glasgow Haskell Compiler / GHC Commits: 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - 5d0ee7c6 by Ben Gamari at 2023-06-19T12:53:49-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 889d89d1 by Ben Gamari at 2023-06-19T12:53:50-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - HACKING.md - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types/Prim.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Flags.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/12dfd80847136b182fad201a461480c81a2f514c...889d89d1dab3095055502dd225a4d9060abe37ce -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/12dfd80847136b182fad201a461480c81a2f514c...889d89d1dab3095055502dd225a4d9060abe37ce You're receiving 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 Jun 19 21:48:54 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 19 Jun 2023 17:48:54 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Add `IfaceWarnings` to represent the `ModIface`-storable parts Message-ID: <6490cd468e809_be462f9a734c315861@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 52fe555e by Arnaud Spiwack at 2023-06-19T17:48:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 727206c5 by Ben Gamari at 2023-06-19T17:48:43-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 4e3265fd by mangoiv at 2023-06-19T17:48:43-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - 16 changed files: - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/GHC/Types/SourceText.hs - compiler/GHC/Unit/Module/ModIface.hs - compiler/GHC/Unit/Module/Warnings.hs - rts/posix/Signals.c - testsuite/tests/ghci/should_run/T16096.stdout - testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr Changes: ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -117,10 +117,56 @@ dsTopLHsBinds binds top_level_err bindsType (L loc bind) = putSrcSpanDs (locA loc) $ diagnosticDs (DsTopLevelBindsNotAllowed bindsType bind) +{- +Note [Return bindings in dependency order] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The desugarer tries to desugar a non-recursive let-binding to a collection of +one or more non-recursive let-bindings. The alternative is to generate a letrec +and wait for the occurrence analyser to sort it out later, but it is pretty easy +to arrange that the [(Id,CoreExpr)] pairs returned by dsLHsBinds are returned in +dependency order + +It's most important for linear types, where non-recursive lets can be linear +whereas recursive-let can't. Since we check the output of the desugarer for +linearity (see also Note [Linting linearity]), desugaring non-recursive lets to +recursive lets would break linearity checks. An alternative is to refine the +typing rule for recursive lets so that we don't have to care (see in particular +#23218 and #18694), but the outcome of this line of work is still unclear. In +the meantime, being a little precise in the desugarer is cheap. (paragraph +written on 2023-06-09) + +In dsLHSBinds (and dependencies), a single binding can be desugared to multiple +bindings. For instance because the source binding has the {-# SPECIALIZE #-} +pragma. In: + +f _ = … + where + {-# SPECIALIZE g :: F Int -> F Int #-} + g :: C a => F a -> F a + g _ = … + +The g binding desugars to + +let { + $sg = … } in + + g + [RULES: "SPEC g" g @Int $dC = $sg] + g = … +In order to avoid generating a letrec that will immediately be reordered, we +make sure to return the binding in dependency order [$sg, g]. + +This only matters when the source binding is non-recursive as recursive bindings +are always desugared to a single mutually recursive block. + +-} -- | Desugar all other kind of bindings, Ids of strict binds are returned to -- later be forced in the binding group body, see Note [Desugar Strict binds] +-- +-- Invariant: the desugared bindings are returned in dependency order, +-- see Note [Return bindings in dependency order] dsLHsBinds :: LHsBinds GhcTc -> DsM ([Id], [(Id,CoreExpr)]) dsLHsBinds binds = do { ds_bs <- mapBagM dsLHsBind binds @@ -134,6 +180,9 @@ dsLHsBind (L loc bind) = do dflags <- getDynFlags putSrcSpanDs (locA loc) $ dsHsBind dflags bind -- | Desugar a single binding (or group of recursive binds). +-- +-- Invariant: the desugared bindings are returned in dependency order, +-- see Note [Return bindings in dependency order] dsHsBind :: DynFlags -> HsBind GhcTc -> DsM ([Id], [(Id,CoreExpr)]) @@ -263,7 +312,7 @@ dsAbsBinds dflags tyvars dicts exports (isDefaultMethod prags) (dictArity dicts) rhs - ; return (force_vars', main_bind : fromOL spec_binds) } } + ; return (force_vars', fromOL spec_binds ++ [main_bind]) } } -- Another common case: no tyvars, no dicts -- In this case we can have a much simpler desugaring @@ -322,7 +371,7 @@ dsAbsBinds dflags tyvars dicts exports -- Kill the INLINE pragma because it applies to -- the user written (local) function. The global -- Id is just the selector. Hmm. - ; return ((global', rhs) : fromOL spec_binds) } } + ; return (fromOL spec_binds ++ [(global', rhs)]) } } ; export_binds_s <- mapM mk_bind (exports ++ extra_exports) ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -160,17 +160,20 @@ ds_val_bind (is_rec, binds) body -- NB: bindings have a fixed RuntimeRep, so it's OK to call isUnliftedType case prs of [] -> return body - _ -> return (Let (Rec prs) body') } - -- Use a Rec regardless of is_rec. - -- Why? Because it allows the binds to be all - -- mixed up, which is what happens in one rare case - -- Namely, for an AbsBind with no tyvars and no dicts, - -- but which does have dictionary bindings. - -- See notes with GHC.Tc.Solver.inferLoop [NO TYVARS] - -- It turned out that wrapping a Rec here was the easiest solution - -- - -- NB The previous case dealt with unlifted bindings, so we - -- only have to deal with lifted ones now; so Rec is ok + _ -> return (mkLets (mk_binds is_rec prs) body') } + -- We can make a non-recursive let because we make sure to return + -- the bindings in dependency order in dsLHsBinds, see Note [Return bindings in dependency order] + +-- | Helper function. You can use the result of 'mk_binds' with 'mkLets' for +-- instance. +-- +-- * @'mk_binds' 'Recursive' binds@ makes a single mutually-recursive +-- bindings with all the rhs/lhs pairs in @binds@ +-- * @'mk_binds' 'NonRecursive' binds@ makes one non-recursive binding +-- for each rhs/lhs pairs in @binds@ +mk_binds :: RecFlag -> [(b, (Expr b))] -> [Bind b] +mk_binds Recursive binds = [Rec binds] +mk_binds NonRecursive binds = map (uncurry NonRec) binds ------------------ dsUnliftedBind :: HsBind GhcTc -> CoreExpr -> DsM CoreExpr ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -102,7 +102,6 @@ import GHC.Types.PkgQual import GHC.Unit.External import GHC.Unit.Module -import GHC.Unit.Module.Warnings import GHC.Unit.Module.ModIface import GHC.Unit.Module.Deps import GHC.Unit.State @@ -1206,16 +1205,6 @@ pprTrustInfo trust = text "trusted:" <+> ppr trust pprTrustPkg :: Bool -> SDoc pprTrustPkg tpkg = text "require own pkg trusted:" <+> ppr tpkg -instance Outputable (Warnings pass) where - ppr = pprWarns - -pprWarns :: Warnings pass -> SDoc -pprWarns NoWarnings = Outputable.empty -pprWarns (WarnAll txt) = text "Warn all" <+> ppr txt -pprWarns (WarnSome prs) = text "Warnings:" - <+> vcat (map pprWarning prs) - where pprWarning (name, txt) = ppr name <+> ppr txt - pprIfaceAnnotation :: IfaceAnnotation -> SDoc pprIfaceAnnotation (IfaceAnnotation { ifAnnotatedTarget = target, ifAnnotatedValue = serialized }) = ppr target <+> text "annotated by" <+> ppr serialized ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -66,6 +66,8 @@ import GHC.Types.SourceFile import GHC.Types.TyThing import GHC.Types.HpcInfo import GHC.Types.CompleteMatch +import GHC.Types.SourceText +import GHC.Types.SrcLoc ( unLoc ) import GHC.Utils.Outputable import GHC.Utils.Panic @@ -291,7 +293,7 @@ mkIface_ hsc_env -- The order of fixities returned from nonDetNameEnvElts is not -- deterministic, so we sort by OccName to canonicalize it. -- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM for more details. - warns = src_warns + warns = toIfaceWarnings src_warns iface_rules = map coreRuleToIfaceRule rules iface_insts = map instanceToIfaceInst $ fixSafeInstances safe_mode (instEnvElts insts) iface_fam_insts = map famInstToIfaceFamInst fam_insts @@ -393,6 +395,21 @@ ifaceRoughMatchTcs tcs = map do_rough tcs do_rough (RM_KnownTc n) = Just (toIfaceTyCon_name n) -------------------------- +toIfaceWarnings :: Warnings GhcRn -> IfaceWarnings +toIfaceWarnings NoWarnings = IfNoWarnings +toIfaceWarnings (WarnAll txt) = IfWarnAll (toIfaceWarningTxt txt) +toIfaceWarnings (WarnSome prs) = IfWarnSome [(occ, toIfaceWarningTxt txt) | (occ, txt) <- prs] + +toIfaceWarningTxt :: WarningTxt GhcRn -> IfaceWarningTxt +toIfaceWarningTxt (WarningTxt mb_cat src strs) = IfWarningTxt (unLoc <$> mb_cat) (unLoc src) (map (toIfaceStringLiteralWithNames . unLoc) strs) +toIfaceWarningTxt (DeprecatedTxt src strs) = IfDeprecatedTxt (unLoc src) (map (toIfaceStringLiteralWithNames . unLoc) strs) + +toIfaceStringLiteralWithNames :: WithHsDocIdentifiers StringLiteral GhcRn -> (IfaceStringLiteral, [IfExtName]) +toIfaceStringLiteralWithNames (WithHsDocIdentifiers src names) = (toIfaceStringLiteral src, map unLoc names) + +toIfaceStringLiteral :: StringLiteral -> IfaceStringLiteral +toIfaceStringLiteral (StringLiteral sl fs _) = IfStringLiteral sl fs + coreRuleToIfaceRule :: CoreRule -> IfaceRule -- A plugin that installs a BuiltinRule in a CoreDoPluginPass should -- ensure that there's another CoreDoPluginPass that removes the rule. ===================================== compiler/GHC/Iface/Recomp.hs ===================================== @@ -962,7 +962,7 @@ addFingerprints hsc_env iface0 eps <- hscEPS hsc_env let decls = mi_decls iface0 - warn_fn = mkIfaceWarnCache (mi_warns iface0) + warn_fn = mkIfaceWarnCache (fromIfaceWarnings $ mi_warns iface0) fix_fn = mkIfaceFixCache (mi_fixities iface0) -- The ABI of a declaration represents everything that is made ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -16,6 +16,7 @@ module GHC.Iface.Syntax ( IfaceBindingX(..), IfaceMaybeRhs(..), IfaceConAlt(..), IfaceIdInfo, IfaceIdDetails(..), IfaceUnfolding(..), IfGuidance(..), IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget, + IfaceWarnings(..), IfaceWarningTxt(..), IfaceStringLiteral(..), IfaceClsInst(..), IfaceFamInst(..), IfaceTickish(..), IfaceClassBody(..), IfaceBooleanFormula(..), IfaceBang(..), @@ -33,6 +34,7 @@ module GHC.Iface.Syntax ( ifaceDeclImplicitBndrs, visibleIfConDecls, ifaceDeclFingerprints, fromIfaceBooleanFormula, + fromIfaceWarnings, -- Free Names freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst, @@ -66,7 +68,9 @@ import GHC.Types.ForeignCall import GHC.Types.Annotations( AnnPayload, AnnTarget ) import GHC.Types.Basic import GHC.Unit.Module +import GHC.Unit.Module.Warnings import GHC.Types.SrcLoc +import GHC.Types.SourceText import GHC.Data.BooleanFormula ( BooleanFormula(..), pprBooleanFormula, isTrue ) import GHC.Types.Var( VarBndr(..), binderVar, tyVarSpecToBinders, visArgTypeLike ) import GHC.Core.TyCon ( Role (..), Injectivity(..), tyConBndrVisForAllTyFlag ) @@ -74,6 +78,8 @@ import GHC.Core.DataCon (SrcStrictness(..), SrcUnpackedness(..)) import GHC.Builtin.Types ( constraintKindTyConName ) import GHC.Stg.InferTags.TagSig import GHC.Parser.Annotation (noLocA) +import GHC.Hs.Extension ( GhcRn ) +import GHC.Hs.Doc ( WithHsDocIdentifiers(..) ) import GHC.Utils.Lexeme (isLexSym) import GHC.Utils.Fingerprint @@ -338,6 +344,18 @@ data IfaceRule ifRuleOrph :: IsOrphan -- Just like IfaceClsInst } +data IfaceWarnings + = IfNoWarnings + | IfWarnAll IfaceWarningTxt + | IfWarnSome [(OccName, IfaceWarningTxt)] + +data IfaceWarningTxt + = IfWarningTxt (Maybe WarningCategory) SourceText [(IfaceStringLiteral, [IfExtName])] + | IfDeprecatedTxt SourceText [(IfaceStringLiteral, [IfExtName])] + +data IfaceStringLiteral + = IfStringLiteral SourceText FastString + data IfaceAnnotation = IfaceAnnotation { ifAnnotatedTarget :: IfaceAnnTarget, @@ -564,6 +582,24 @@ ifaceDeclFingerprints hash decl unsafeDupablePerformIO . computeFingerprint (panic "ifaceDeclFingerprints") +fromIfaceWarnings :: IfaceWarnings -> Warnings GhcRn +fromIfaceWarnings = \case + IfNoWarnings -> NoWarnings + IfWarnAll txt -> WarnAll (fromIfaceWarningTxt txt) + IfWarnSome prs -> WarnSome [(occ, fromIfaceWarningTxt txt) | (occ, txt) <- prs] + +fromIfaceWarningTxt :: IfaceWarningTxt -> WarningTxt GhcRn +fromIfaceWarningTxt = \case + IfWarningTxt mb_cat src strs -> WarningTxt (noLoc <$> mb_cat) (noLoc src) (noLoc <$> map fromIfaceStringLiteralWithNames strs) + IfDeprecatedTxt src strs -> DeprecatedTxt (noLoc src) (noLoc <$> map fromIfaceStringLiteralWithNames strs) + +fromIfaceStringLiteralWithNames :: (IfaceStringLiteral, [IfExtName]) -> WithHsDocIdentifiers StringLiteral GhcRn +fromIfaceStringLiteralWithNames (str, names) = WithHsDocIdentifiers (fromIfaceStringLiteral str) (map noLoc names) + +fromIfaceStringLiteral :: IfaceStringLiteral -> StringLiteral +fromIfaceStringLiteral (IfStringLiteral st fs) = StringLiteral st fs Nothing + + {- ************************************************************************ * * @@ -715,6 +751,25 @@ pprAxBranch pp_tc idx (IfaceAxBranch { ifaxbTyVars = tvs text "--" <+> text "incompatible with:" <+> pprWithCommas (\incomp -> text "#" <> ppr incomp) incomps +instance Outputable IfaceWarnings where + ppr = \case + IfNoWarnings -> empty + IfWarnAll txt -> text "Warn all" <+> ppr txt + IfWarnSome prs -> text "Warnings:" <+> vcat [ppr name <+> ppr txt | (name, txt) <- prs] + +instance Outputable IfaceWarningTxt where + ppr = \case + IfWarningTxt _ _ ws -> pp_ws ws + IfDeprecatedTxt _ ds -> pp_ws ds + where + pp_ws [msg] = pp_with_name msg + pp_ws msgs = brackets $ vcat . punctuate comma . map pp_with_name $ msgs + + pp_with_name = ppr . fst + +instance Outputable IfaceStringLiteral where + ppr (IfStringLiteral st fs) = pprWithSourceText st (ftext fs) + instance Outputable IfaceAnnotation where ppr (IfaceAnnotation target value) = ppr target <+> colon <+> ppr value @@ -2265,6 +2320,28 @@ instance Binary IfaceRule where a8 <- get bh return (IfaceRule a1 a2 a3 a4 a5 a6 a7 a8) +instance Binary IfaceWarnings where + put_ bh = \case + IfNoWarnings -> putByte bh 0 + IfWarnAll txt -> putByte bh 1 *> put_ bh txt + IfWarnSome prs -> putByte bh 2 *> put_ bh prs + get bh = getByte bh >>= \case + 0 -> pure IfNoWarnings + 1 -> pure IfWarnAll <*> get bh + _ -> pure IfWarnSome <*> get bh + +instance Binary IfaceWarningTxt where + put_ bh = \case + IfWarningTxt a1 a2 a3 -> putByte bh 0 *> put_ bh a1 *> put_ bh a2 *> put_ bh a3 + IfDeprecatedTxt a1 a2 -> putByte bh 1 *> put_ bh a1 *> put_ bh a2 + get bh = getByte bh >>= \case + 0 -> pure IfWarningTxt <*> get bh <*> get bh <*> get bh + _ -> pure IfDeprecatedTxt <*> get bh <*> get bh + +instance Binary IfaceStringLiteral where + put_ bh (IfStringLiteral a1 a2) = put_ bh a1 *> put_ bh a2 + get bh = IfStringLiteral <$> get bh <*> get bh + instance Binary IfaceAnnotation where put_ bh (IfaceAnnotation a1 a2) = do put_ bh a1 @@ -2822,5 +2899,19 @@ instance NFData IfaceClsInst where rnf (IfaceClsInst f1 f2 f3 f4 f5) = f1 `seq` rnf f2 `seq` rnf f3 `seq` f4 `seq` f5 `seq` () +instance NFData IfaceWarnings where + rnf = \case + IfNoWarnings -> () + IfWarnAll txt -> rnf txt + IfWarnSome txts -> rnf txts + +instance NFData IfaceWarningTxt where + rnf = \case + IfWarningTxt f1 f2 f3 -> rnf f1 `seq` rnf f2 `seq` rnf f3 + IfDeprecatedTxt f1 f2 -> rnf f1 `seq` rnf f2 + +instance NFData IfaceStringLiteral where + rnf (IfStringLiteral f1 f2) = rnf f1 `seq` rnf f2 + instance NFData IfaceAnnotation where rnf (IfaceAnnotation f1 f2) = f1 `seq` f2 `seq` () ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -47,6 +47,7 @@ import GHC.Tc.Zonk.TcType ( tcInitTidyEnv ) import GHC.Hs import GHC.Iface.Load ( loadSrcInterface ) +import GHC.Iface.Syntax ( fromIfaceWarnings ) import GHC.Builtin.Names import GHC.Parser.PostProcess ( setRdrNameSpace ) import GHC.Core.Type @@ -422,7 +423,7 @@ rnImportDecl this_mod imports = calculateAvails home_unit other_home_units iface mod_safe' want_boot (ImportedByUser imv) -- Complain if we import a deprecated module - case mi_warns iface of + case fromIfaceWarnings (mi_warns iface) of WarnAll txt -> addDiagnostic (TcRnDeprecatedModule imp_mod_name txt) _ -> return () ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -2316,7 +2316,7 @@ mk_dict_err ctxt (item, (matches, unifiers, unsafe_overlapped)) = case (NE.nonEm (Nothing, _) -> do -- No matches but perhaps several unifiers { (_, rel_binds, item) <- relevantBindings True ctxt item ; candidate_insts <- get_candidate_instances - ; (imp_errs, field_suggestions) <- record_field_suggestions + ; (imp_errs, field_suggestions) <- record_field_suggestions item ; return (cannot_resolve_msg item candidate_insts rel_binds imp_errs field_suggestions) } -- Some matches => overlap errors @@ -2352,13 +2352,33 @@ mk_dict_err ctxt (item, (matches, unifiers, unsafe_overlapped)) = case (NE.nonEm | otherwise = False -- See Note [Out-of-scope fields with -XOverloadedRecordDot] - record_field_suggestions :: TcM ([ImportError], [GhcHint]) - record_field_suggestions = flip (maybe $ return ([], noHints)) record_field $ \name -> + record_field_suggestions :: ErrorItem -> TcM ([ImportError], [GhcHint]) + record_field_suggestions item = flip (maybe $ return ([], noHints)) record_field $ \name -> do { glb_env <- getGlobalRdrEnv ; lcl_env <- getLocalRdrEnv - ; if occ_name_in_scope glb_env lcl_env name - then return ([], noHints) - else unknownNameSuggestions emptyLocalRdrEnv WL_RecField (mkRdrUnqual name) } + ; let field_name_hints = report_no_fieldnames item + ; (errs, hints) <- if occ_name_in_scope glb_env lcl_env name + then return ([], noHints) + else unknownNameSuggestions emptyLocalRdrEnv WL_RecField (mkRdrUnqual name) + ; pure (errs, hints ++ field_name_hints) + } + + -- get type names from instance + -- resolve the type - if it's in scope is it a record? + -- if it's a record, report an error - the record name + the field that could not be found + report_no_fieldnames :: ErrorItem -> [GhcHint] + report_no_fieldnames item + | Just (EvVarDest evvar) <- ei_evdest item + -- we can assume that here we have a `HasField @Symbol x r a` instance + -- because of HasFieldOrigin in record_field + , Just (_, [_symbol, x, r, a]) <- tcSplitTyConApp_maybe (varType evvar) + , Just (r_tycon, _) <- tcSplitTyConApp_maybe r + , Just x_name <- isStrLitTy x + -- we check that this is a record type by checking whether it has any + -- fields (in scope) + , not . null $ tyConFieldLabels r_tycon + = [RemindRecordMissingField x_name r a] + | otherwise = [] occ_name_in_scope glb_env lcl_env occ_name = not $ null (lookupGRE_OccName (IncludeFields WantNormal) glb_env occ_name) && ===================================== compiler/GHC/Types/Hint.hs ===================================== @@ -35,7 +35,7 @@ import GHC.Hs.Extension (GhcTc, GhcRn) import GHC.Core.Coercion import GHC.Core.FamInstEnv (FamFlavor) import GHC.Core.TyCon (TyCon) -import GHC.Core.Type (PredType) +import GHC.Core.Type (PredType, Type) import GHC.Types.Fixity (LexicalFixity(..)) import GHC.Types.Name (Name, NameSpace, OccName (occNameFS), isSymOcc, nameOccName) import GHC.Types.Name.Reader (RdrName (Unqual), ImpDeclSpec) @@ -44,7 +44,7 @@ import GHC.Types.Basic (Activation, RuleName) import {-# SOURCE #-} GHC.Tc.Types.Origin ( ClsInstOrQC(..) ) import GHC.Parser.Errors.Basic import GHC.Utils.Outputable -import GHC.Data.FastString (fsLit) +import GHC.Data.FastString (fsLit, FastString) import Data.Typeable ( Typeable ) @@ -465,6 +465,9 @@ data GhcHint {-| Suggest eta-reducing a type synonym used in the implementation of abstract data. -} | SuggestEtaReduceAbsDataTySyn TyCon + {-| Remind the user that there is no field of a type and name in the record, + constructors are in the usual order $x$, $r$, $a$ -} + | RemindRecordMissingField FastString Type Type {-| Suggest binding the type variable on the LHS of the type declaration -} | SuggestBindTyVarOnLhs RdrName ===================================== compiler/GHC/Types/Hint/Ppr.hs ===================================== @@ -14,6 +14,7 @@ import GHC.Types.Hint import GHC.Core.FamInstEnv (FamFlavor(..)) import GHC.Core.TyCon +import GHC.Core.TyCo.Rep ( mkVisFunTyMany ) import GHC.Hs.Expr () -- instance Outputable import GHC.Tc.Types.Origin ( ClsInstOrQC(..) ) import GHC.Types.Id @@ -251,6 +252,12 @@ instance Outputable GhcHint where SuggestEtaReduceAbsDataTySyn tc -> text "If possible, eta-reduce the type synonym" <+> ppr_tc <+> text "so that it is nullary." where ppr_tc = quotes (ppr $ tyConName tc) + RemindRecordMissingField x r a -> + text "NB: There is no field selector" <+> ppr_sel + <+> text "in scope for record type" <+> ppr_r + where ppr_sel = quotes (ftext x <+> dcolon <+> ppr_arr_r_a) + ppr_arr_r_a = ppr $ mkVisFunTyMany r a + ppr_r = quotes $ ppr r SuggestBindTyVarOnLhs tv -> text "Bind" <+> quotes (ppr tv) <+> text "on the LHS of the type declaration" ===================================== compiler/GHC/Types/SourceText.hs ===================================== @@ -1,5 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RecordWildCards #-} -- | Source text -- @@ -39,6 +41,7 @@ import Data.Function (on) import Data.Data import GHC.Real ( Ratio(..) ) import GHC.Types.SrcLoc +import Control.DeepSeq {- Note [Pragma source text] @@ -107,6 +110,11 @@ instance Outputable SourceText where ppr (SourceText s) = text "SourceText" <+> ftext s ppr NoSourceText = text "NoSourceText" +instance NFData SourceText where + rnf = \case + SourceText s -> rnf s + NoSourceText -> () + instance Binary SourceText where put_ bh NoSourceText = putByte bh 0 put_ bh (SourceText s) = do @@ -315,12 +323,3 @@ instance Eq StringLiteral where instance Outputable StringLiteral where ppr sl = pprWithSourceText (sl_st sl) (ftext $ sl_fs sl) - -instance Binary StringLiteral where - put_ bh (StringLiteral st fs _) = do - put_ bh st - put_ bh fs - get bh = do - st <- get bh - fs <- get bh - return (StringLiteral st fs Nothing) ===================================== compiler/GHC/Unit/Module/ModIface.hs ===================================== @@ -185,7 +185,7 @@ data ModIface_ (phase :: ModIfacePhase) -- ^ Fixities -- NOT STRICT! we read this field lazily from the interface file - mi_warns :: (Warnings GhcRn), + mi_warns :: IfaceWarnings, -- ^ Warnings -- NOT STRICT! we read this field lazily from the interface file @@ -479,7 +479,7 @@ instance Binary ModIface where mi_finsts = hasFamInsts, mi_exp_hash = exp_hash, mi_orphan_hash = orphan_hash, - mi_warn_fn = mkIfaceWarnCache warns, + mi_warn_fn = mkIfaceWarnCache $ fromIfaceWarnings warns, mi_fix_fn = mkIfaceFixCache fixities, mi_hash_fn = mkIfaceHashCache decls }}) @@ -498,7 +498,7 @@ emptyPartialModIface mod mi_exports = [], mi_used_th = False, mi_fixities = [], - mi_warns = NoWarnings, + mi_warns = IfNoWarnings, mi_anns = [], mi_insts = [], mi_fam_insts = [], @@ -567,7 +567,7 @@ instance ( NFData (IfaceBackendExts (phase :: ModIfacePhase)) `seq` mi_exports `seq` rnf mi_used_th `seq` mi_fixities - `seq` mi_warns + `seq` rnf mi_warns `seq` rnf mi_anns `seq` rnf mi_decls `seq` rnf mi_extra_decls ===================================== compiler/GHC/Unit/Module/Warnings.hs ===================================== @@ -5,6 +5,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE LambdaCase #-} -- | Warnings for a module module GHC.Unit.Module.Warnings @@ -40,7 +41,6 @@ import GHC.Types.SrcLoc import GHC.Types.Unique import GHC.Types.Unique.Set import GHC.Hs.Doc -import GHC.Hs.Extension import GHC.Utils.Outputable import GHC.Utils.Binary @@ -51,6 +51,7 @@ import Language.Haskell.Syntax.Extension import Data.Data import Data.List (isPrefixOf) import GHC.Generics ( Generic ) +import Control.DeepSeq {- @@ -103,7 +104,7 @@ the possibility of them being infinite. -- See Note [Warning categories] newtype WarningCategory = WarningCategory FastString - deriving (Binary, Data, Eq, Outputable, Show, Uniquable) + deriving (Binary, Data, Eq, Outputable, Show, Uniquable, NFData) mkWarningCategory :: FastString -> WarningCategory mkWarningCategory = WarningCategory @@ -203,29 +204,6 @@ instance Outputable (WarningTxt pass) where NoSourceText -> pp_ws ds SourceText src -> ftext src <+> pp_ws ds <+> text "#-}" -instance Binary (WarningTxt GhcRn) where - put_ bh (WarningTxt c s w) = do - putByte bh 0 - put_ bh $ unLoc <$> c - put_ bh $ unLoc s - put_ bh $ unLoc <$> w - put_ bh (DeprecatedTxt s d) = do - putByte bh 1 - put_ bh $ unLoc s - put_ bh $ unLoc <$> d - - get bh = do - h <- getByte bh - case h of - 0 -> do c <- fmap noLoc <$> get bh - s <- noLoc <$> get bh - w <- fmap noLoc <$> get bh - return (WarningTxt c s w) - _ -> do s <- noLoc <$> get bh - d <- fmap noLoc <$> get bh - return (DeprecatedTxt s d) - - pp_ws :: [Located (WithHsDocIdentifiers StringLiteral pass)] -> SDoc pp_ws [l] = ppr $ unLoc l pp_ws ws @@ -271,24 +249,6 @@ data Warnings pass deriving instance Eq (IdP pass) => Eq (Warnings pass) -instance Binary (Warnings GhcRn) where - put_ bh NoWarnings = putByte bh 0 - put_ bh (WarnAll t) = do - putByte bh 1 - put_ bh t - put_ bh (WarnSome ts) = do - putByte bh 2 - put_ bh ts - - get bh = do - h <- getByte bh - case h of - 0 -> return NoWarnings - 1 -> do aa <- get bh - return (WarnAll aa) - _ -> do aa <- get bh - return (WarnSome aa) - -- | Constructs the cache for the 'mi_warn_fn' field of a 'ModIface' mkIfaceWarnCache :: Warnings p -> OccName -> Maybe (WarningTxt p) mkIfaceWarnCache NoWarnings = \_ -> Nothing ===================================== rts/posix/Signals.c ===================================== @@ -522,7 +522,9 @@ shutdown_handler(int sig STG_UNUSED) // extreme prejudice. So the first ^C tries to exit the program // cleanly, and the second one just kills it. if (getSchedState() >= SCHED_INTERRUPTING) { - stg_exit(EXIT_INTERRUPTED); + // N.B. we cannot use stg_exit() here as it calls exit() which is not + // signal-safe. See #23417. + _exit(EXIT_INTERRUPTED); } else { interruptStgRts(); } ===================================== testsuite/tests/ghci/should_run/T16096.stdout ===================================== @@ -1,6 +1,6 @@ ==================== Desugared ==================== -letrec { +let { x :: [GHC.Types.Int] [LclId] x = let { @@ -11,7 +11,7 @@ letrec { x :: [GHC.Types.Int] [LclId] x = GHC.Enum.enumFrom @GHC.Types.Int $dEnum (GHC.Types.I# 1#); } in - x; } in + x } in GHC.Base.returnIO @[GHC.Types.Any] (GHC.Types.: @@ -27,7 +27,7 @@ GHC.Base.returnIO ==================== Desugared ==================== -letrec { +let { x :: [GHC.Types.Int] [LclId] x = let { @@ -38,7 +38,7 @@ letrec { x :: [GHC.Types.Int] [LclId] x = GHC.Enum.enumFrom @GHC.Types.Int $dEnum (GHC.Types.I# 1#); } in - x; } in + x } in GHC.Base.returnIO @[GHC.Types.Any] (GHC.Types.: ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr ===================================== @@ -18,6 +18,7 @@ RecordDotSyntaxFail8.hs:37:3: error: [GHC-39999] RecordDotSyntaxFail8.hs:37:11: error: [GHC-39999] • No instance for ‘HasField "quux" Quux a0’ arising from selecting the field ‘quux’ + NB: There is no field selector ‘quux :: Quux -> a0’ in scope for record type ‘Quux’ • In the second argument of ‘($)’, namely ‘....baz.quux’ In a stmt of a 'do' block: print $ ....baz.quux In the expression: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e47ff7b14e61ee55b498d8348d6081c96bb8945d...4e3265fda3e8cb57ccc47a12cb0a45ae2a91c4a4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e47ff7b14e61ee55b498d8348d6081c96bb8945d...4e3265fda3e8cb57ccc47a12cb0a45ae2a91c4a4 You're receiving 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 Jun 19 21:53:52 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 19 Jun 2023 17:53:52 -0400 Subject: [Git][ghc/ghc][wip/romes/fixes] 159 commits: Migrate errors in GHC.Tc.Validity Message-ID: <6490ce7030304_be462fb99c7c324694@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/fixes at Glasgow Haskell Compiler / GHC Commits: 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 01960ffd by Rodrigo Mesquita at 2023-06-19T22:51:50+01:00 Remove redundant computation in eqDeBruijnExpr In eqDeBruijnExpr, we checked if the lists had the same length. However, all2 already returns False if the length doesn't match. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - HACKING.md - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types/Prim.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8316206603ca6128e352f01edf0c64060caf0294...01960ffdaa899a221f7060ec180208d552c2524b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8316206603ca6128e352f01edf0c64060caf0294...01960ffdaa899a221f7060ec180208d552c2524b You're receiving 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 Jun 19 21:57:58 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 19 Jun 2023 17:57:58 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] WIP Message-ID: <6490cf66e0eca_be462fb99c7c3270aa@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: 761d3d3b by Rodrigo Mesquita at 2023-06-19T22:57:23+01:00 WIP - - - - - 3 changed files: - compiler/GHC/Core/Functor.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/HsToCore/Pmc/Solver.hs Changes: ===================================== compiler/GHC/Core/Functor.hs ===================================== @@ -1,7 +1,10 @@ {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE FlexibleContexts #-} +-- ROMES:TODO: Rename to Core.Equality or something module GHC.Core.Functor where import GHC.Prelude @@ -15,6 +18,10 @@ import GHC.Types.Literal import GHC.Types.Tickish import Unsafe.Coerce (unsafeCoerce) +import Control.Monad.Trans.State.Strict (state) +import Data.Equality.Graph as EG +import Data.Equality.Analysis +import qualified Data.Equality.Graph.Monad as EGM import Data.Equality.Utils (Fix(..)) import GHC.Utils.Misc (all2, equalLength) @@ -63,7 +70,7 @@ instance Eq a => Eq (DeBruijnF CoreExprF a) where -- of Id binders. Now, ignoring DeBruijn indices, we'll simply get this compile -- to get a rougher estimate of performance? eqDeBruijnExprF :: forall a. Eq a => DeBruijnF CoreExprF a -> DeBruijnF CoreExprF a -> Bool -eqDeBruijnExprF (DeBruijnF (D env1 e1)) (DeBruijnF (D env2 e2)) = go e1 e2 where +eqDeBruijnExprF (DF (D env1 e1)) (DF (D env2 e2)) = go e1 e2 where go :: CoreExprF a -> CoreExprF a -> Bool go (VarF v1) (VarF v2) = eqDeBruijnVar (D env1 v1) (D env2 v2) go (LitF lit1) (LitF lit2) = lit1 == lit2 @@ -86,18 +93,16 @@ eqDeBruijnExprF (DeBruijnF (D env1 e1)) (DeBruijnF (D env2 e2)) = go e1 e2 where && e1 == e2 go (LetF (RecF ps1) e1) (LetF (RecF ps2) e2) - = equalLength ps1 ps2 + = -- See Note [Alpha-equality for let-bindings] - && all2 (\b1 b2 -> eqDeBruijnType (D env1 (varType b1)) - (D env2 (varType b2))) - bs1 bs2 + all2 (\b1 b2 -> eqDeBruijnType (D env1 (varType b1)) + (D env2 (varType b2))) + bs1 bs2 && rs1 == rs2 && e1 == e2 where (bs1,rs1) = unzip ps1 (bs2,rs2) = unzip ps2 - env1' = extendCMEs env1 bs1 - env2' = extendCMEs env2 bs2 go (CaseF e1 b1 t1 a1) (CaseF e2 b2 t2 a2) | null a1 -- See Note [Empty case alternatives] @@ -107,10 +112,9 @@ eqDeBruijnExprF (DeBruijnF (D env1 e1)) (DeBruijnF (D env2 e2)) = go e1 e2 where go _ _ = False --- With Ints as binders we can have almost trivial eq instances - instance Ord a => Ord (DeBruijnF CoreExprF a) where compare a b = if a == b then EQ else LT +-- deriving instance Ord a => Ord (DeBruijnF CoreExprF a) deriving instance Functor (DeBruijnF CoreExprF) deriving instance Foldable (DeBruijnF CoreExprF) @@ -120,9 +124,56 @@ deriving instance Traversable (DeBruijnF CoreExprF) fromCoreExpr :: CoreExpr -> Fix CoreExprF fromCoreExpr = unsafeCoerce -fromDBCoreExpr :: DeBruijn CoreExpr -> Fix (DeBruijnF CoreExprF) -fromDBCoreExpr = unsafeCoerce - toCoreExpr :: CoreExpr -> Fix CoreExprF toCoreExpr = unsafeCoerce +-- | Represents a DeBruijn CoreExpr being careful to correctly debruijnizie the expression as it is represented +representDBCoreExpr :: Analysis a (DeBruijnF CoreExprF) + => DeBruijn CoreExpr + -> EGraph a (DeBruijnF CoreExprF) + -> (ClassId, EGraph a (DeBruijnF CoreExprF)) +representDBCoreExpr (D cmenv expr) eg = case expr of + Var v -> add (Node $ DF (D cmenv (VarF v))) eg + Lit lit -> add (Node $ DF (D cmenv (LitF lit))) eg + Type t -> add (Node $ DF (D cmenv (TypeF t))) eg + Coercion c -> add (Node $ DF (D cmenv (CoercionF c))) eg + Cast e co -> let (eid,eg') = representDBCoreExpr (D cmenv e) eg + in add (Node $ DF (D cmenv (CastF eid co))) eg' + App f a -> let (fid,eg') = representDBCoreExpr (D cmenv f) eg + (aid,eg'') = representDBCoreExpr (D cmenv a) eg' + in add (Node $ DF (D cmenv (AppF fid aid))) eg'' + Tick n e -> let (eid,eg') = representDBCoreExpr (D cmenv e) eg + in add (Node $ DF (D cmenv (TickF n eid))) eg' + Lam b e -> let (eid,eg') = representDBCoreExpr (D (extendCME cmenv b) e) eg + in add (Node $ DF (D cmenv (LamF b eid))) eg' + Let (NonRec v r) e -> let (rid,eg') = representDBCoreExpr (D cmenv r) eg + (eid,eg'') = representDBCoreExpr (D (extendCME cmenv v) e) eg' + in add (Node $ DF (D cmenv (LetF (NonRecF v rid) eid))) eg'' + Let (Rec (unzip -> (bs,rs))) e -> + let cmenv' = extendCMEs cmenv bs + (bsids, eg') = EGM.runEGraphM eg $ + traverse (\r -> state $ representDBCoreExpr (D cmenv' r)) rs + (eid, eg'') = representDBCoreExpr (D cmenv' e) eg' + in add (Node $ DF (D cmenv (LetF (RecF (zip bs bsids)) eid))) eg'' + Case e b t as -> let (eid, eg') = representDBCoreExpr (D cmenv e) eg + (as', eg'') = EGM.runEGraphM eg' $ + traverse (\(Alt cons bs a) -> state $ \s -> let (aid, g) = representDBCoreExpr (D (extendCME cmenv b) a) s in (AltF cons bs aid, g)) as + in add (Node $ DF (D cmenv (CaseF eid b t as'))) eg' + + +-- ROMES:TODO: Instead of DeBruijnF CoreExprF we should have (ExprF (Int,Id)) +-- * A represent function that makes up the debruijn indices as it is representing the expressions +-- * An Eq and Ord instance which ignore the Id and rather look at the DeBruijn index. +-- +-- TODO +-- * For types, can we use eqDeBruijnType ? I think not, because Lambdas and Lets can bind type variables +-- +-- TODO: The Best Alternative: +-- +-- Each expression keeps its DeBruijnF CmEnv environment, but the represent +-- function must correctly prepare the debruijn indices, so that each e-node +-- has the debruijn indice it would have in its recursive descent in the Eq instance? +-- +-- TODO: We could even probably have Compose DeBruijn CoreExprF in that case! +-- + ===================================== compiler/GHC/Core/Map/Type.hs ===================================== @@ -515,7 +515,7 @@ lookupCME (CME { cme_env = env }) v = lookupVarEnv env v data DeBruijn a = D CmEnv a deriving (Functor,Foldable,Traversable) -- romes:TODO: For internal use only! -newtype DeBruijnF f a = DeBruijnF (DeBruijn (f a)) +newtype DeBruijnF f a = DF (DeBruijn (f a)) -- | Synthesizes a @DeBruijn a@ from an @a@, by assuming that there are no -- bound binders (an empty 'CmEnv'). This is usually what you want if there @@ -525,7 +525,7 @@ deBruijnize = D emptyCME -- | Like 'deBruijnize' but synthesizes a @DeBruijnF f a@ from an @f a@ deBruijnizeF :: Functor f => f a -> DeBruijnF f a -deBruijnizeF = DeBruijnF . deBruijnize +deBruijnizeF = DF . deBruijnize instance Eq (DeBruijn a) => Eq (DeBruijn [a]) where D _ [] == D _ [] = True ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -53,7 +53,6 @@ import GHC.Types.Id import GHC.Types.Name import GHC.Types.Var (EvVar) import GHC.Types.Var.Env -import GHC.Types.Var.Set import GHC.Types.Unique.Supply import GHC.Core @@ -99,9 +98,7 @@ import Data.List (sortBy, find) import qualified Data.List.NonEmpty as NE import Data.Ord (comparing) -import Data.Functor.Const import Data.Equality.Graph (EGraph, ClassId) -import Data.Equality.Utils (Fix(..)) import Data.Equality.Graph.Lens import qualified Data.Equality.Graph as EG import Data.Bifunctor (second) @@ -720,7 +717,7 @@ addBotCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x = do addNotBotCt :: Nabla -> Id -> MaybeT DsM Nabla addNotBotCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts=env} } x = do let (xid, env') = representId x env - (y, mvi) = lookupVarInfoNT (ts{ts_facts=env'}) x + (_y, mvi) = lookupVarInfoNT (ts{ts_facts=env'}) x (yid, env'') = representId x env' case mvi of Just vi at VI { vi_bot = bot } -> @@ -755,7 +752,7 @@ addNotConCt nabla at MkNabla{nabla_tm_st=ts at TmSt{ts_facts=env}} x nalt = do -- where `x'` is the representative of `x`. go :: Maybe VarInfo -> MaybeT DsM (Bool, Maybe VarInfo) go Nothing = pure (False, Just (emptyVarInfo x){vi_bot = IsNotBot, vi_neg = emptyPmAltConSet `extendPmAltConSet` nalt}) -- romes:TODO: Do I need to mark dirty the new thing? - go (Just vi@(VI x' pos neg _ rcm)) = do + go (Just vi@(VI _x' pos neg _ rcm)) = do -- 1. Bail out quickly when nalt contradicts a solution let contradicts nalt sol = eqPmAltCon (paca_con sol) nalt == Equal guard (not (any (contradicts nalt) pos)) @@ -1007,7 +1004,7 @@ modifyT f = StateT $ fmap ((,) ()) . f -- there weren't any such constraints. representCoreExpr :: Nabla -> CoreExpr -> (ClassId, Nabla) representCoreExpr nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = egraph } } e = - second (\g -> nabla{nabla_tm_st = ts{ts_facts = g}}) $ EG.represent (fromDBCoreExpr (deBruijnize (makeDictsCoherent e))) egraph + second (\g -> nabla{nabla_tm_st = ts{ts_facts = g}}) $ representDBCoreExpr (deBruijnize (makeDictsCoherent e)) egraph -- Use a key in which dictionaries for the same type become equal. -- See Note [Unique dictionaries in the TmOracle CoreMap] @@ -1361,7 +1358,7 @@ inhabitationTest fuel old_ty_st nabla at MkNabla{ nabla_tm_st = ts } = {-# SCC "in where nabla_not_dirty = nabla{ nabla_tm_st = ts{ts_dirty=IS.empty} } test_one :: ClassId -> Maybe VarInfo -> MaybeT DsM (Maybe VarInfo) - test_one cid Nothing = pure Nothing + test_one _ Nothing = pure Nothing test_one cid (Just vi) = lift (varNeedsTesting old_ty_st nabla cid vi) >>= \case True -> do @@ -2142,4 +2139,4 @@ updateVarInfo :: Functor f => ClassId -> (a -> f a) -> EGraph a l -> f (EGraph a -- Update the data at class @xid@ using lenses and the monadic action @go@ updateVarInfo xid = _class xid . _data --- ROMES:TODO: When exactly to rebuild? \ No newline at end of file +-- ROMES:TODO: When exactly to rebuild? View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/761d3d3b61cb674a9033fb74054372a2f7af7f50 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/761d3d3b61cb674a9033fb74054372a2f7af7f50 You're receiving 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 Jun 19 22:42:17 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Mon, 19 Jun 2023 18:42:17 -0400 Subject: [Git][ghc/ghc][wip/less-defaulting] 2 commits: Change the defaulting rules in commitFlexi Message-ID: <6490d9c93f394_be462fb99e0c3367ec@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/less-defaulting at Glasgow Haskell Compiler / GHC Commits: e82b7497 by Krzysztof Gogolewski at 2023-06-20T00:00:55+02:00 Change the defaulting rules in commitFlexi - Multiplicity isn't special, default to Any - RuntimeRep and Levity are special only when concrete - - - - - 1d8bf940 by Krzysztof Gogolewski at 2023-06-20T00:39:53+02:00 Workaround 23380 Without it, fails on f :: Bool -> Bool f x = case x of True -> True a -> a - - - - - 1 changed file: - compiler/GHC/Tc/Zonk/Type.hs Changes: ===================================== compiler/GHC/Tc/Zonk/Type.hs ===================================== @@ -456,21 +456,24 @@ commitFlexi tv zonked_kind -- y = (\x -> True) undefined -- We need *some* known RuntimeRep for the x and undefined, but no one -- will choose it until we get here, in the zonker. - | isRuntimeRepTy zonked_kind - -> do { traceTc "Defaulting flexi tyvar to LiftedRep:" (pprTyVar tv) - ; return liftedRepTy } - | isLevityTy zonked_kind - -> do { traceTc "Defaulting flexi tyvar to Lifted:" (pprTyVar tv) - ; return liftedDataConTy } | isMultiplicityTy zonked_kind -> do { traceTc "Defaulting flexi tyvar to Many:" (pprTyVar tv) ; return manyDataConTy } - | Just (ConcreteFRR origin) <- isConcreteTyVar_maybe tv - -> do { addErr $ TcRnZonkerMessage (ZonkerCannotDefaultConcrete origin) - ; return (anyTypeOfKind zonked_kind) } | otherwise - -> do { traceTc "Defaulting flexi tyvar to Any:" (pprTyVar tv) - ; return (anyTypeOfKind zonked_kind) } + -> case isConcreteTyVar_maybe tv of + Nothing + -> do { traceTc "Defaulting flexi tyvar to Any:" (pprTyVar tv) + ; return (anyTypeOfKind zonked_kind) } + Just (ConcreteFRR origin) + | isRuntimeRepTy zonked_kind + -> do { traceTc "Defaulting flexi tyvar to LiftedRep:" (pprTyVar tv) + ; return liftedRepTy } + | isLevityTy zonked_kind + -> do { traceTc "Defaulting flexi tyvar to Lifted:" (pprTyVar tv) + ; return liftedDataConTy } + | otherwise + -> do { addErr $ TcRnZonkerMessage (ZonkerCannotDefaultConcrete origin) + ; return (anyTypeOfKind zonked_kind) } RuntimeUnkFlexi -> do { traceTc "Defaulting flexi tyvar to RuntimeUnk:" (pprTyVar tv) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f95a33363b385508d77de3983179e7cccc2318a3...1d8bf940d135737acf4d030a8b746221a2a5cbbb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f95a33363b385508d77de3983179e7cccc2318a3...1d8bf940d135737acf4d030a8b746221a2a5cbbb You're receiving 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 Jun 19 23:05:04 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 19 Jun 2023 19:05:04 -0400 Subject: [Git][ghc/ghc][wip/romes/fixes] Remove redundant computation in eqDeBruijnExpr Message-ID: <6490df201aa0_be462fb99c7c34145@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/fixes at Glasgow Haskell Compiler / GHC Commits: f544a9b0 by Rodrigo Mesquita at 2023-06-20T00:04:56+01:00 Remove redundant computation in eqDeBruijnExpr In eqDeBruijnExpr, we checked if the lists had the same length. However, all2 already returns False if the length doesn't match. - - - - - 1 changed file: - compiler/GHC/Core/Map/Expr.hs Changes: ===================================== compiler/GHC/Core/Map/Expr.hs ===================================== @@ -171,11 +171,12 @@ eqDeBruijnExpr (D env1 e1) (D env2 e2) = go e1 e2 where && eqDeBruijnExpr (D (extendCME env1 v1) e1) (D (extendCME env2 v2) e2) go (Let (Rec ps1) e1) (Let (Rec ps2) e2) - = equalLength ps1 ps2 + = -- See Note [Alpha-equality for let-bindings] - && all2 (\b1 b2 -> eqDeBruijnType (D env1 (varType b1)) - (D env2 (varType b2))) - bs1 bs2 + -- NB: `all2` returns False if its argument lists differ in length + all2 (\b1 b2 -> eqDeBruijnType (D env1 (varType b1)) + (D env2 (varType b2))) + bs1 bs2 && D env1' rs1 == D env2' rs2 && eqDeBruijnExpr (D env1' e1) (D env2' e2) where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f544a9b0819f0e5662e2d8d64d0f2dc2eedde3df -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f544a9b0819f0e5662e2d8d64d0f2dc2eedde3df You're receiving 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 Jun 19 23:11:21 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Mon, 19 Jun 2023 19:11:21 -0400 Subject: [Git][ghc/ghc][wip/T23109] Run classop rule first Message-ID: <6490e09931a94_be462fb99e0c34618a@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23109 at Glasgow Haskell Compiler / GHC Commits: 9e8b53e3 by Simon Peyton Jones at 2023-06-20T00:10:55+01:00 Run classop rule first - - - - - 10 changed files: - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Types/Id.hs - compiler/GHC/Types/Id/Info.hs - compiler/GHC/Types/Id/Make.hs - compiler/GHC/Types/TyThing.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -12,13 +12,13 @@ module GHC.Core.Opt.Simplify.Env ( smPedanticBottoms, smPlatform, -- * Environments - SimplEnv(..), pprSimplEnv, -- Temp not abstract + SimplEnv(..), StaticEnv, pprSimplEnv, -- Temp not abstract seArityOpts, seCaseCase, seCaseFolding, seCaseMerge, seCastSwizzle, seDoEtaReduction, seEtaExpand, seFloatEnable, seInline, seNames, seOptCoercionOpts, sePedanticBottoms, sePhase, sePlatform, sePreInline, seRuleOpts, seRules, seUnfoldingOpts, mkSimplEnv, extendIdSubst, - extendTvSubst, extendCvSubst, + extendTvSubst, extendCvSubst, extendSubstForDFun, zapSubstEnv, setSubstEnv, bumpCaseDepth, getInScope, setInScopeFromE, setInScopeFromF, setInScopeSet, modifyInScope, addNewInScopeIds, @@ -153,6 +153,8 @@ following table: -} +type StaticEnv = SimplEnv -- Just the static part is relevant + data SimplEnv = SimplEnv { ----------- Static part of the environment ----------- @@ -379,7 +381,6 @@ data SimplSR -- and ja = Just a <=> x is a join-point of arity a -- See Note [Join arity in SimplIdSubst] - | DoneId OutId -- If x :-> DoneId v is in the SimplIdSubst -- then replace occurrences of x by v @@ -547,6 +548,20 @@ extendCvSubst env@(SimplEnv {seCvSubst = csubst}) var co = assert (isCoVar var) $ env {seCvSubst = extendVarEnv csubst var co} +extendSubstForDFun :: SimplEnv -> [OutVar] -> [(InExpr,StaticEnv)] -> SimplEnv +extendSubstForDFun env bndrs args + = foldl2 extend env bndrs args + where + extend env@(SimplEnv {seIdSubst = ids, seCvSubst = cvs, seTvSubst = tvs}) + bndr (arg,arg_se) + | isTyVar bndr, Type ty <- arg + = env { seTvSubst = extendVarEnv tvs bndr (substTy arg_se ty) } + | isCoVar bndr, Coercion co <- arg + = env { seCvSubst = extendVarEnv cvs bndr (substCo arg_se co) } + | otherwise + = assertPpr (isId bndr) (ppr bndr) $ + env { seIdSubst = extendVarEnv ids bndr (mkContEx arg_se arg) } + --------------------- getInScope :: SimplEnv -> InScopeSet getInScope env = seInScope env ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -18,6 +18,7 @@ import GHC.Platform import GHC.Driver.Flags import GHC.Core +import GHC.Core.Class( Class, classArity ) import GHC.Core.Opt.Simplify.Monad import GHC.Core.Opt.ConstantFold import GHC.Core.Type hiding ( substTy, substTyVar, extendTvSubst, extendCvSubst ) @@ -66,6 +67,7 @@ import GHC.Builtin.Names( runRWKey ) import GHC.Data.Maybe ( isNothing, orElse ) import GHC.Data.FastString +import GHC.Data.List.SetOps( getNth ) import GHC.Unit.Module ( moduleName ) import GHC.Utils.Outputable import GHC.Utils.Panic @@ -2133,25 +2135,65 @@ simplIdF env var cont where env' = setSubstEnv env tvs cvs ids - DoneId var1 -> - do { rule_base <- getSimplRules - ; let cont' = trimJoinCont var1 (isJoinId_maybe var1) cont - info = mkArgInfo env rule_base var1 cont' - ; rebuildCall env info cont' } + DoneId var1 -> simplCall env var1 cont' + where + cont' = trimJoinCont var1 (isJoinId_maybe var1) cont DoneEx e mb_join -> simplExprF env' e cont' where cont' = trimJoinCont var mb_join cont env' = zapSubstEnv env -- See Note [zapSubstEnv] +simplCall :: SimplEnv -> OutId -> SimplCont -> SimplM (SimplFloats, OutExpr) +simplCall env var cont + | ClassOpId clas idx _ <- idDetails var + , Just (env', arg', cont') <- classOpDictApp_maybe env clas idx cont + = simplExprF env' arg' cont' + + | otherwise + = do { rule_base <- getSimplRules + ; let info = mkArgInfo env rule_base var cont + ; rebuildCall env info cont } + +classOpDictApp_maybe :: SimplEnv -> Class -> Int -> SimplCont + -> Maybe (SimplEnv, InExpr, SimplCont) +classOpDictApp_maybe env cls idx cont + = go cont + where + go (ApplyToTy { sc_cont = cont }) + = go cont -- Discard leading type args + go (ApplyToVal { sc_arg = dict_arg, sc_env = dict_se, sc_cont = cont }) + | Just (dfun, dfun_args) <- splitInApp dict_se dict_arg [] -- dfun_args :: [InExpr] + , DFunUnfolding { df_bndrs = bndrs, df_args = dict_args } <- idUnfolding dfun + , bndrs `equalLength` dfun_args -- See Note [DFun arity check] + , let arg_env = extendSubstForDFun (zapSubstEnv env) bndrs dfun_args + the_arg = getNth (drop (classArity cls) dict_args) idx -- An OutExpr + = Just (arg_env, the_arg, cont) + go _ = Nothing + + splitInApp :: StaticEnv -> InExpr -> [(InExpr,StaticEnv)] + -> Maybe (OutVar, [(InExpr,StaticEnv)]) + splitInApp env (App fun arg) args + = splitInApp env fun ((arg,env):args) + splitInApp env (Var v) args + = case substId env v of + DoneId v' -> Just (v', args) + ContEx tvs cvs ids e -> splitInApp (setSubstEnv env tvs cvs ids) e args + DoneEx e _ -> splitInApp (zapSubstEnv env) e args + splitInApp _ _ _ + = Nothing + --------------------------------------------------------- -- Dealing with a call site -rebuildCall :: SimplEnv -> ArgInfo -> SimplCont +rebuildCall, rebuildCall' :: SimplEnv -> ArgInfo -> SimplCont -> SimplM (SimplFloats, OutExpr) ---------- Bottoming applications -------------- -rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args, ai_dmds = [] }) cont +rebuildCall env ai cont + = rebuildCall' env ai cont + +rebuildCall' env (ArgInfo { ai_fun = fun, ai_args = rev_args, ai_dmds = [] }) cont -- When we run out of strictness args, it means -- that the call is definitely bottom; see GHC.Core.Opt.Simplify.Utils.mkArgInfo -- Then we want to discard the entire strict continuation. E.g. @@ -2178,7 +2220,7 @@ rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args, ai_dmds = [] }) con -- If there are rewrite rules we'll skip this case until we have -- simplified enough args to satisfy nr_wanted==0 in the TryRules case below -- Then we'll try the rules, and if that fails, we'll do TryInlining -rebuildCall env info@(ArgInfo { ai_fun = fun, ai_args = rev_args +rebuildCall' env info@(ArgInfo { ai_fun = fun, ai_args = rev_args , ai_rewrite = TryInlining }) cont = do { logger <- getLogger ; let full_cont = pushSimplifiedRevArgs env rev_args cont @@ -2193,7 +2235,7 @@ rebuildCall env info@(ArgInfo { ai_fun = fun, ai_args = rev_args ---------- Try rewrite RULES, if ai_rewrite = TryRules -------------- -- See Note [Rewrite rules and inlining] -- See also Note [Trying rewrite rules] -rebuildCall env info@(ArgInfo { ai_fun = fun, ai_args = rev_args +rebuildCall' env info@(ArgInfo { ai_fun = fun, ai_args = rev_args , ai_rewrite = TryRules nr_wanted rules }) cont | nr_wanted == 0 || no_more_args = -- We've accumulated a simplified call in @@ -2213,10 +2255,10 @@ rebuildCall env info@(ArgInfo { ai_fun = fun, ai_args = rev_args _ -> True ---------- Simplify type applications and casts -------------- -rebuildCall env info (CastIt co cont) +rebuildCall' env info (CastIt co cont) = rebuildCall env (addCastTo info co) cont -rebuildCall env info (ApplyToTy { sc_arg_ty = arg_ty, sc_hole_ty = hole_ty, sc_cont = cont }) +rebuildCall' env info (ApplyToTy { sc_arg_ty = arg_ty, sc_hole_ty = hole_ty, sc_cont = cont }) = rebuildCall env (addTyArgTo info arg_ty hole_ty) cont ---------- The runRW# rule. Do this after absorbing all arguments ------ @@ -2224,7 +2266,7 @@ rebuildCall env info (ApplyToTy { sc_arg_ty = arg_ty, sc_hole_ty = hole_ty, sc_c -- -- runRW# :: forall (r :: RuntimeRep) (o :: TYPE r). (State# RealWorld -> o) -> o -- K[ runRW# rr ty body ] --> runRW rr' ty' (\s. K[ body s ]) -rebuildCall env (ArgInfo { ai_fun = fun_id, ai_args = rev_args }) +rebuildCall' env (ArgInfo { ai_fun = fun_id, ai_args = rev_args }) (ApplyToVal { sc_arg = arg, sc_env = arg_se , sc_cont = cont, sc_hole_ty = fun_ty }) | fun_id `hasKey` runRWKey @@ -2258,7 +2300,7 @@ rebuildCall env (ArgInfo { ai_fun = fun_id, ai_args = rev_args }) ; return (emptyFloats env, call') } ---------- Simplify value arguments -------------------- -rebuildCall env fun_info +rebuildCall' env fun_info (ApplyToVal { sc_arg = arg, sc_env = arg_se , sc_dup = dup_flag, sc_hole_ty = fun_ty , sc_cont = cont }) @@ -2290,7 +2332,7 @@ rebuildCall env fun_info ---------- No further useful info, revert to generic rebuild ------------ -rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args }) cont +rebuildCall' env (ArgInfo { ai_fun = fun, ai_args = rev_args }) cont = rebuild env (argInfoExpr fun rev_args) cont ----------------------------------- @@ -2378,7 +2420,7 @@ The simplifier arranges to do this, as follows. In effect, the ai_rewrite field of the ArgInfo record is the state of a little state-machine: * mkArgInfo sets the ai_rewrite field to TryRules if there are any rewrite - rules avaialable for that function. + rules available for that function. * rebuildCall simplifies arguments until enough are simplified to match the rule with greatest arity. See Note [RULES apply to simplified arguments] ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -212,8 +212,6 @@ data SimplCont CoreTickish -- Tick tickish SimplCont -type StaticEnv = SimplEnv -- Just the static part is relevant - data FromWhat = FromLet | FromBeta OutType -- See Note [DupFlag invariants] @@ -732,7 +730,6 @@ which it is on the LHS of a rule (see updModeForRules), then don't make use of the strictness info for the function. -} - {- ************************************************************************ * * ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -1606,7 +1606,7 @@ app_ok fun_ok primop_ok fun args -- been expressed by its "wrapper", so we don't need -- to take the arguments into account - ClassOpId _ is_terminating_result + ClassOpId _ _ is_terminating_result | is_terminating_result -- See Note [exprOkForSpeculation and type classes] -> assertPpr (n_val_args == 1) (ppr fun $$ ppr args) $ True ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -2064,8 +2064,8 @@ reifyThing (AGlobal (AnId id)) = do { ty <- reifyType (idType id) ; let v = reifyName id ; case idDetails id of - ClassOpId cls _ -> return (TH.ClassOpI v ty (reifyName cls)) - _ -> return (TH.VarI v ty Nothing) + ClassOpId cls _ _ -> return (TH.ClassOpI v ty (reifyName cls)) + _ -> return (TH.VarI v ty Nothing) } reifyThing (AGlobal (ATyCon tc)) = reifyTyCon tc ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -1363,10 +1363,10 @@ addDFunPrags :: DFunId -> [Id] -> DFunId -- the DFunId rather than from the skolem pieces that the typechecker -- is messing with. addDFunPrags dfun_id sc_meth_ids --- | is_newtype +-- xx | is_newtype -- = dfun_id `setIdUnfolding` mkInlineUnfoldingWithArity defaultSimpleOpts StableSystemSrc 0 con_app -- `setInlinePragma` alwaysInlinePragma { inl_sat = Just 0 } --- | otherwise +-- xx | otherwise = dfun_id `setIdUnfolding` mkDFunUnfolding dfun_bndrs dict_con dict_args `setInlinePragma` dfunInlinePragma where ===================================== compiler/GHC/Types/Id.hs ===================================== @@ -495,8 +495,8 @@ isClassOpId id = case Var.idDetails id of _other -> False isClassOpId_maybe id = case Var.idDetails id of - ClassOpId cls _ -> Just cls - _other -> Nothing + ClassOpId cls _ _ -> Just cls + _other -> Nothing isPrimOpId id = case Var.idDetails id of PrimOpId {} -> True ===================================== compiler/GHC/Types/Id/Info.hs ===================================== @@ -158,6 +158,7 @@ data IdDetails | ClassOpId -- ^ The 'Id' is a superclass selector or class operation Class -- for this class + Int -- 0-indexed selector for which class method this is Bool -- True <=> given a non-bottom dictionary, the class op will -- definitely return a non-bottom result -- and Note [exprOkForSpeculation and type classes] ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -470,7 +470,7 @@ mkDictSelId :: Name -- Name of one of the *value* selectors -- (dictionary superclass or method) -> Class -> Id mkDictSelId name clas - = mkGlobalId (ClassOpId clas terminating) name sel_ty info + = mkGlobalId (ClassOpId clas val_index terminating) name sel_ty info where tycon = classTyCon clas sel_names = map idName (classAllSelIds clas) ===================================== compiler/GHC/Types/TyThing.hs ===================================== @@ -260,7 +260,7 @@ tyThingParent_maybe (AnId id) = case idDetails id of Just (ATyCon tc) RecSelId { sel_tycon = RecSelPatSyn ps } -> Just (AConLike (PatSynCon ps)) - ClassOpId cls _ -> + ClassOpId cls _ _ -> Just (ATyCon (classTyCon cls)) _other -> Nothing tyThingParent_maybe _other = Nothing View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9e8b53e312d5570a7e74a2d7ec297816e74415d7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9e8b53e312d5570a7e74a2d7ec297816e74415d7 You're receiving 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 Jun 20 00:23:46 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 19 Jun 2023 20:23:46 -0400 Subject: [Git][ghc/ghc][wip/tsan/no-barriers] 70 commits: Restore mingwex dependency on Windows Message-ID: <6490f19295c3f_be462150dba143505f8@gitlab.mail> Ben Gamari pushed to branch wip/tsan/no-barriers at Glasgow Haskell Compiler / GHC Commits: 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 278b4a29 by Ben Gamari at 2023-06-20T00:23:41+00:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - 6d8efd5c by Ben Gamari at 2023-06-20T00:23:41+00:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 4be68db7 by Ben Gamari at 2023-06-20T00:23:41+00:00 rts: Drop load_store_barrier() This is no longer used. - - - - - f7298d6b by Ben Gamari at 2023-06-20T00:23:41+00:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 4779945b by Ben Gamari at 2023-06-20T00:23:41+00:00 rts: Eliminate remaining uses of load_load_barrier - - - - - f8cc63e3 by Sven Tennie at 2023-06-20T00:23:41+00:00 compiler: Drop MO_ReadBarrier - - - - - d6970379 by Ben Gamari at 2023-06-20T00:23:41+00:00 rts: Drop load_load_barrier This is no longer used. - - - - - 89df56ce by Sven Tennie at 2023-06-20T00:23:41+00:00 Delete write_barrier function - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.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/b0705cc5b9cbe73746584487c024050104f571c8...89df56ce4d208a5b2dc92290d587786ad58a58ed -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b0705cc5b9cbe73746584487c024050104f571c8...89df56ce4d208a5b2dc92290d587786ad58a58ed You're receiving 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 Jun 20 00:36:17 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Mon, 19 Jun 2023 20:36:17 -0400 Subject: [Git][ghc/ghc][wip/int-index/emb-type] 1062 commits: Hadrian: fix ghcDebugAssertions off-by-one error Message-ID: <6490f481ede48_be462fca8bf4351624@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/emb-type at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 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 - - - - - 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. - - - - - 08c0822c by doyougnu at 2023-02-15T00:16:39-05:00 docs: release notes, user guide: add js backend Follow up from #21078 - - - - - 79d8fd65 by Bryan Richter at 2023-02-15T00:17:15-05:00 Allow failure in nightly-x86_64-linux-deb10-no_tntc-validate See #22343 - - - - - 9ca51f9e by Cheng Shao at 2023-02-15T00:17:53-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. - - - - - 26df73fb by Oleg Grenrus at 2023-02-15T22:20:57-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 - - - - - 631c6c72 by Cheng Shao at 2023-02-16T06:43:09-05:00 docs: add a section for the wasm backend Fixes #22658 - - - - - 1878e0bd by Bryan Richter at 2023-02-16T06:43:47-05:00 tests: Mark T12903 fragile everywhere See #21184 - - - - - b9420eac by Bryan Richter at 2023-02-16T06:43:47-05:00 Mark all T5435 variants as fragile See #22970. - - - - - df3d94bd by Sylvain Henry at 2023-02-16T06:44:33-05:00 Testsuite: mark T13167 as fragile for JS (#22921) - - - - - 324e925b by Sylvain Henry at 2023-02-16T06:45:15-05:00 JS: disable debugging info for heap objects - - - - - 518af814 by Josh Meredith at 2023-02-16T10:16:32-05:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 34cd308e by Ben Gamari at 2023-02-16T10:17:08-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 12965aba by Simon Peyton Jones at 2023-02-16T10:17:46-05: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 - - - - - 5b038888 by Bodigrim at 2023-02-16T10:18:24-05:00 Documentation: add an example of SPEC usage - - - - - 681e0e8c by sheaf at 2023-02-16T14:09:56-05:00 No default finalizer exception handler Commit cfc8e2e2 introduced a mechanism for handling of exceptions that occur during Handle finalization, and 372cf730 set the default handler to print out the error to stderr. However, #21680 pointed out we might not want to set this by default, as it might pollute users' terminals with unwanted information. So, for the time being, the default handler discards the exception. Fixes #21680 - - - - - b3ac17ad by Matthew Pickering at 2023-02-16T14:10:31-05: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 ------------------------- - - - - - 8988eeef by sheaf at 2023-02-16T20:32:27-05:00 Expand synonyms in RoughMap We were failing to expand type synonyms in the function GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the RoughMap infrastructure crucially relies on type synonym expansion to work. This patch adds the missing type-synonym expansion. Fixes #22985 - - - - - 3dd50e2f by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Add test artifact Add the released testsuite tarball to the generated ghcup metadata. - - - - - c6a967d9 by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Use Ubuntu and Rocky bindists Prefer to use the Ubuntu 20.04 and 18.04 binary distributions on Ubuntu and Linux Mint. Prefer to use the Rocky 8 binary distribution on unknown distributions. - - - - - be0b7209 by Matthew Pickering at 2023-02-17T09:37:16+00:00 Add INLINABLE pragmas to `generic*` functions in Data.OldList These functions are * recursive * overloaded So it's important to add an `INLINABLE` pragma to each so that they can be specialised at the use site when the specific numeric type is known. Adding these pragmas improves the LazyText replicate benchmark (see https://gitlab.haskell.org/ghc/ghc/-/issues/22886#note_481020) https://github.com/haskell/core-libraries-committee/issues/129 - - - - - a203ad85 by Sylvain Henry at 2023-02-17T15:59:16-05:00 Merge libiserv with ghci `libiserv` serves no purpose. As it depends on `ghci` and doesn't have more dependencies than the `ghci` package, its code could live in the `ghci` package too. This commit also moves most of the code from the `iserv` program into the `ghci` package as well so that it can be reused. This is especially useful for the implementation of TH for the JS backend (#22261, !9779). - - - - - 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01: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 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-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. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-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. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-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. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 7192ef91 by Simon Peyton Jones at 2023-02-28T18:54:59-05:00 Take more care with unlifted bindings in the specialiser As #22998 showed, we were floating an unlifted binding to top level, which breaks a Core invariant. The fix is easy, albeit a little bit conservative. See Note [Care with unlifted bindings] in GHC.Core.Opt.Specialise - - - - - bb500e2a by Simon Peyton Jones at 2023-02-28T18:55:35-05:00 Account for TYPE vs CONSTRAINT in mkSelCo As #23018 showed, in mkRuntimeRepCo we need to account for coercions between TYPE and COERCION. See Note [mkRuntimeRepCo] in GHC.Core.Coercion. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-05:00 hadrian: Add dependency from lib/settings to mk/config.mk In 81975ef375de07a0ea5a69596b2077d7f5959182 we attempted to fix #20253 by adding logic to the bindist Makefile to regenerate the `settings` file from information gleaned by the bindist `configure` script. However, this fix had no effect as `lib/settings` is shipped in the binary distribution (to allow in-place use of the binary distribution). As `lib/settings` already existed and its rule declared no dependencies, `make` would fail to use the added rule to regenerate it. Fix this by explicitly declaring a dependency from `lib/settings` on `mk/config.mk`. Fixes #22982. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-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. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-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. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00: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. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 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: ...lots of lines omitted... 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. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04: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. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04: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> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+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. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - a31a0fec by Vladislav Zavialov at 2023-06-20T02:14:21+02:00 WIP: Visible forall in types of terms - - - - - 7a0e8b96 by Vladislav Zavialov at 2023-06-20T02:35:34+02:00 VDQ: reject nonlinear type variable bindings - - - - - 12c94c53 by Vladislav Zavialov at 2023-06-20T02:35:34+02:00 VDQ: workaroud for lint failure - - - - - a400b921 by Vladislav Zavialov at 2023-06-20T02:35:34+02:00 VDQ: accept test suite changes Not all of these are quite right: in some contexts, the suggestion to enable RequiredTypeArguments is incorrect, as enabling the extension wouldn't make the program accepted. - - - - - 11 changed files: - .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/108c316ac365a61a89912d2b0eb77a7a59cdea13...a400b921d03985149fff416236bb874e7d2b89b7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/108c316ac365a61a89912d2b0eb77a7a59cdea13...a400b921d03985149fff416236bb874e7d2b89b7 You're receiving 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 Jun 20 01:35:12 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 19 Jun 2023 21:35:12 -0400 Subject: [Git][ghc/ghc][wip/T22451] 124 commits: Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) Message-ID: <6491025076d64_be462fca8bf4362062@gitlab.mail> Ben Gamari pushed to branch wip/T22451 at Glasgow Haskell Compiler / GHC Commits: 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e7fbb95 by Ben Gamari at 2023-06-19T21:35:04-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - HACKING.md - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types/Prim.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Flags.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2cc8a229dbc737aaeb53a5be8a32baa3503a9e81...3e7fbb95105ea030c059b7f2c069632306d5a34f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2cc8a229dbc737aaeb53a5be8a32baa3503a9e81...3e7fbb95105ea030c059b7f2c069632306d5a34f You're receiving 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 Jun 20 01:40:33 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 19 Jun 2023 21:40:33 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/tsan/fixes-2 Message-ID: <6491039139465_be462fb99c7c3626bc@gitlab.mail> Ben Gamari pushed new branch wip/tsan/fixes-2 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/tsan/fixes-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 Tue Jun 20 01:48:32 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 19 Jun 2023 21:48:32 -0400 Subject: [Git][ghc/ghc][wip/tsan/fixes-2] 33 commits: compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE Message-ID: <649105704a99e_be462ef9307c3630c4@gitlab.mail> Ben Gamari pushed to branch wip/tsan/fixes-2 at Glasgow Haskell Compiler / GHC Commits: 8def77f5 by Ben Gamari at 2023-06-12T09:59:21+00:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - fe5e6c3e by Ben Gamari at 2023-06-12T09:59:35+00:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - ab74a337 by Ben Gamari at 2023-06-12T09:59:35+00:00 rts: Drop load_store_barrier() This is no longer used. - - - - - 0e3e7996 by Ben Gamari at 2023-06-12T10:04:24+00:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 95ca4cda by Ben Gamari at 2023-06-12T10:04:38+00:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 600e68d9 by Sven Tennie at 2023-06-12T10:06:49+00:00 compiler: Drop MO_ReadBarrier - - - - - 60991d31 by Ben Gamari at 2023-06-12T10:07:03+00:00 rts: Drop load_load_barrier This is no longer used. - - - - - b0705cc5 by Sven Tennie at 2023-06-12T10:07:03+00:00 Delete write_barrier function - - - - - 3f6c3107 by Ben Gamari at 2023-06-19T21:44:51-04:00 compiler: Style fixes - - - - - 96a91282 by Ben Gamari at 2023-06-19T21:44:51-04:00 rts/IPE: Fix unused mutex warning - - - - - 85829dd6 by Ben Gamari at 2023-06-19T21:44:51-04:00 rts: Fix implicit cast This ensures that Task.h can be built with a C++ compiler. - - - - - 3a59f243 by Ben Gamari at 2023-06-19T21:44:51-04:00 rts: Fix data race in threadPaused This only affects an assertion in the debug RTS, but it's a data race nevertheless. - - - - - c89c57df by Ben Gamari at 2023-06-19T21:44:51-04:00 rts: Silence spurious data races in ticky counters Previously we would use non-atomic accesses when bumping ticky counters, which would result in spurious data race reports from ThreadSanitizer when the threaded RTS was in use. - - - - - 324351ac by Ben Gamari at 2023-06-19T21:44:51-04:00 Improve TSAN documentation - - - - - 5ff08ecf by Ben Gamari at 2023-06-19T21:44:51-04:00 cmm: Introduce MO_RelaxedRead In hand-written Cmm it can sometimes be necessary to atomically load from memory deep within an expression (e.g. see the `CHECK_GC` macro). This MachOp provides a convenient way to do so without breaking the expression into multiple statements. - - - - - f6926c69 by Ben Gamari at 2023-06-19T21:44:51-04:00 rts: Fix various data races - - - - - 67eb640b by Ben Gamari at 2023-06-19T21:44:51-04:00 base: use atomic write when updating timer manager - - - - - ffdb0b13 by Ben Gamari at 2023-06-19T21:44:51-04:00 Use relaxed atomics to manipulate TSO status fields - - - - - af29c2bd by Ben Gamari at 2023-06-19T21:44:51-04:00 rts: Add necessary barriers when manipulating TSO owner - - - - - 50c1fcea by Ben Gamari at 2023-06-19T21:44:51-04:00 rts: Fix synchronization on thread blocking state - - - - - 0882023a by Ben Gamari at 2023-06-19T21:44:51-04:00 rts: Relaxed load MutVar info table - - - - - 3c87eceb by Ben Gamari at 2023-06-19T21:44:51-04:00 hadrian: More debug information - - - - - a8d25dda by Ben Gamari at 2023-06-19T21:44:51-04:00 hadrian: More selective TSAN instrumentation - - - - - 95b355d4 by Ben Gamari at 2023-06-19T21:44:52-04:00 codeGen/tsan: Rework handling of spilling - - - - - 4ad40535 by Ben Gamari at 2023-06-19T21:45:46-04:00 codeGen: Ensure that TSAN is aware of writeArray# write barriers - - - - - 98726ddf by Ben Gamari at 2023-06-19T21:45:48-04:00 codeGen: Ensure that array reads have necessary barriers This was the cause of #23541. - - - - - e9efe54a by Ben Gamari at 2023-06-19T21:45:48-04:00 Wordsmith TSAN Note - - - - - befb66b5 by Ben Gamari at 2023-06-19T21:45:48-04:00 codeGen: Use relaxed accesses in ticky bumping - - - - - 5f52ea7a by Ben Gamari at 2023-06-19T21:45:48-04:00 codeGen: Use relaxed-read in closureInfoPtr - - - - - 0a43fe32 by Ben Gamari at 2023-06-19T21:45:48-04:00 Fix thunk update ordering Previously we attempted to ensure soundness of concurrent thunk update by synchronizing on the access of the thunk's info table pointer field. This was believed to be sufficient since the indirectee (which may expose a closure allocated by another core) would not be examined until the info table pointer update is complete. However, it turns out that this can result in data races in the presence of multiple threads racing a update a single thunk. For instance, consider this interleaving under the old scheme: Thread A Thread B --------- --------- t=0 Enter t 1 Push update frame 2 Begin evaluation 4 Pause thread 5 t.indirectee=tso 6 Release t.info=BLACKHOLE 7 ... (e.g. GC) 8 Resume thread 9 Finish evaluation 10 Relaxed t.indirectee=x 11 Load t.info 12 Acquire fence 13 Inspect t.indirectee 14 Release t.info=BLACKHOLE Here Thread A enters thunk `t` but is soon paused, resulting in `t` being lazily blackholed at t=6. Then, at t=10 Thread A finishes evaluation and updates `t.indirectee` with a relaxed store. Meanwhile, Thread B enters the blackhole. Under the old scheme this would introduce an acquire-fence but this would only synchronize with Thread A at t=6. Consequently, the result of the evaluation, `x`, is not visible to Thread B, introducing a data race. We fix this by treating the `indirectee` field as we do all other mutable fields. This means we must always access this field with acquire-loads and release-stores. See #23185. - - - - - 527949d9 by Ben Gamari at 2023-06-19T21:45:48-04:00 STM: Use acquire loads when possible Full sequential consistency is not needed here. - - - - - 73b6eef5 by Ubuntu at 2023-06-19T21:47:12-04:00 ghc-prim: Use C11 atomics - - - - - ed7bf9c8 by Ubuntu at 2023-06-19T21:47:12-04:00 Run script - - - - - 30 changed files: - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Info.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/StgToCmm/Utils.hs - hadrian/src/Flavour.hs - libraries/base/GHC/Event/Thread.hs - libraries/ghc-prim/cbits/atomic.c - rts/Apply.cmm - rts/CloneStack.c - rts/Compact.cmm - rts/Exception.cmm - rts/Heap.c - rts/HeapStackCheck.cmm - rts/IPE.c - rts/Interpreter.c - rts/Messages.c - rts/PrimOps.cmm The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e4eb0dd20bbab6d31a30a075694c648c9c4626e1...ed7bf9c80fe2bc3415d79c8f168a65c177345a50 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e4eb0dd20bbab6d31a30a075694c648c9c4626e1...ed7bf9c80fe2bc3415d79c8f168a65c177345a50 You're receiving 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 Jun 20 01:59:38 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 19 Jun 2023 21:59:38 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Avoid desugaring non-recursive lets into recursive lets Message-ID: <6491080a6046_be462fca8bf4364685@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 1413f23f by Arnaud Spiwack at 2023-06-19T21:59:21-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - d099981c by Ben Gamari at 2023-06-19T21:59:22-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 6d2ba613 by Bodigrim at 2023-06-19T21:59:26-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 46f5ae93 by mangoiv at 2023-06-19T21:59:27-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - 12 changed files: - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - libraries/Cabal - rts/posix/Signals.c - testsuite/tests/driver/T4437.hs - testsuite/tests/driver/recomp007/Makefile - testsuite/tests/driver/recomp007/recomp007.stdout - testsuite/tests/ghci/should_run/T16096.stdout - testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr Changes: ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -117,10 +117,56 @@ dsTopLHsBinds binds top_level_err bindsType (L loc bind) = putSrcSpanDs (locA loc) $ diagnosticDs (DsTopLevelBindsNotAllowed bindsType bind) +{- +Note [Return bindings in dependency order] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The desugarer tries to desugar a non-recursive let-binding to a collection of +one or more non-recursive let-bindings. The alternative is to generate a letrec +and wait for the occurrence analyser to sort it out later, but it is pretty easy +to arrange that the [(Id,CoreExpr)] pairs returned by dsLHsBinds are returned in +dependency order + +It's most important for linear types, where non-recursive lets can be linear +whereas recursive-let can't. Since we check the output of the desugarer for +linearity (see also Note [Linting linearity]), desugaring non-recursive lets to +recursive lets would break linearity checks. An alternative is to refine the +typing rule for recursive lets so that we don't have to care (see in particular +#23218 and #18694), but the outcome of this line of work is still unclear. In +the meantime, being a little precise in the desugarer is cheap. (paragraph +written on 2023-06-09) + +In dsLHSBinds (and dependencies), a single binding can be desugared to multiple +bindings. For instance because the source binding has the {-# SPECIALIZE #-} +pragma. In: + +f _ = … + where + {-# SPECIALIZE g :: F Int -> F Int #-} + g :: C a => F a -> F a + g _ = … + +The g binding desugars to + +let { + $sg = … } in + + g + [RULES: "SPEC g" g @Int $dC = $sg] + g = … +In order to avoid generating a letrec that will immediately be reordered, we +make sure to return the binding in dependency order [$sg, g]. + +This only matters when the source binding is non-recursive as recursive bindings +are always desugared to a single mutually recursive block. + +-} -- | Desugar all other kind of bindings, Ids of strict binds are returned to -- later be forced in the binding group body, see Note [Desugar Strict binds] +-- +-- Invariant: the desugared bindings are returned in dependency order, +-- see Note [Return bindings in dependency order] dsLHsBinds :: LHsBinds GhcTc -> DsM ([Id], [(Id,CoreExpr)]) dsLHsBinds binds = do { ds_bs <- mapBagM dsLHsBind binds @@ -134,6 +180,9 @@ dsLHsBind (L loc bind) = do dflags <- getDynFlags putSrcSpanDs (locA loc) $ dsHsBind dflags bind -- | Desugar a single binding (or group of recursive binds). +-- +-- Invariant: the desugared bindings are returned in dependency order, +-- see Note [Return bindings in dependency order] dsHsBind :: DynFlags -> HsBind GhcTc -> DsM ([Id], [(Id,CoreExpr)]) @@ -263,7 +312,7 @@ dsAbsBinds dflags tyvars dicts exports (isDefaultMethod prags) (dictArity dicts) rhs - ; return (force_vars', main_bind : fromOL spec_binds) } } + ; return (force_vars', fromOL spec_binds ++ [main_bind]) } } -- Another common case: no tyvars, no dicts -- In this case we can have a much simpler desugaring @@ -322,7 +371,7 @@ dsAbsBinds dflags tyvars dicts exports -- Kill the INLINE pragma because it applies to -- the user written (local) function. The global -- Id is just the selector. Hmm. - ; return ((global', rhs) : fromOL spec_binds) } } + ; return (fromOL spec_binds ++ [(global', rhs)]) } } ; export_binds_s <- mapM mk_bind (exports ++ extra_exports) ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -160,17 +160,20 @@ ds_val_bind (is_rec, binds) body -- NB: bindings have a fixed RuntimeRep, so it's OK to call isUnliftedType case prs of [] -> return body - _ -> return (Let (Rec prs) body') } - -- Use a Rec regardless of is_rec. - -- Why? Because it allows the binds to be all - -- mixed up, which is what happens in one rare case - -- Namely, for an AbsBind with no tyvars and no dicts, - -- but which does have dictionary bindings. - -- See notes with GHC.Tc.Solver.inferLoop [NO TYVARS] - -- It turned out that wrapping a Rec here was the easiest solution - -- - -- NB The previous case dealt with unlifted bindings, so we - -- only have to deal with lifted ones now; so Rec is ok + _ -> return (mkLets (mk_binds is_rec prs) body') } + -- We can make a non-recursive let because we make sure to return + -- the bindings in dependency order in dsLHsBinds, see Note [Return bindings in dependency order] + +-- | Helper function. You can use the result of 'mk_binds' with 'mkLets' for +-- instance. +-- +-- * @'mk_binds' 'Recursive' binds@ makes a single mutually-recursive +-- bindings with all the rhs/lhs pairs in @binds@ +-- * @'mk_binds' 'NonRecursive' binds@ makes one non-recursive binding +-- for each rhs/lhs pairs in @binds@ +mk_binds :: RecFlag -> [(b, (Expr b))] -> [Bind b] +mk_binds Recursive binds = [Rec binds] +mk_binds NonRecursive binds = map (uncurry NonRec) binds ------------------ dsUnliftedBind :: HsBind GhcTc -> CoreExpr -> DsM CoreExpr ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -2316,7 +2316,7 @@ mk_dict_err ctxt (item, (matches, unifiers, unsafe_overlapped)) = case (NE.nonEm (Nothing, _) -> do -- No matches but perhaps several unifiers { (_, rel_binds, item) <- relevantBindings True ctxt item ; candidate_insts <- get_candidate_instances - ; (imp_errs, field_suggestions) <- record_field_suggestions + ; (imp_errs, field_suggestions) <- record_field_suggestions item ; return (cannot_resolve_msg item candidate_insts rel_binds imp_errs field_suggestions) } -- Some matches => overlap errors @@ -2352,13 +2352,33 @@ mk_dict_err ctxt (item, (matches, unifiers, unsafe_overlapped)) = case (NE.nonEm | otherwise = False -- See Note [Out-of-scope fields with -XOverloadedRecordDot] - record_field_suggestions :: TcM ([ImportError], [GhcHint]) - record_field_suggestions = flip (maybe $ return ([], noHints)) record_field $ \name -> + record_field_suggestions :: ErrorItem -> TcM ([ImportError], [GhcHint]) + record_field_suggestions item = flip (maybe $ return ([], noHints)) record_field $ \name -> do { glb_env <- getGlobalRdrEnv ; lcl_env <- getLocalRdrEnv - ; if occ_name_in_scope glb_env lcl_env name - then return ([], noHints) - else unknownNameSuggestions emptyLocalRdrEnv WL_RecField (mkRdrUnqual name) } + ; let field_name_hints = report_no_fieldnames item + ; (errs, hints) <- if occ_name_in_scope glb_env lcl_env name + then return ([], noHints) + else unknownNameSuggestions emptyLocalRdrEnv WL_RecField (mkRdrUnqual name) + ; pure (errs, hints ++ field_name_hints) + } + + -- get type names from instance + -- resolve the type - if it's in scope is it a record? + -- if it's a record, report an error - the record name + the field that could not be found + report_no_fieldnames :: ErrorItem -> [GhcHint] + report_no_fieldnames item + | Just (EvVarDest evvar) <- ei_evdest item + -- we can assume that here we have a `HasField @Symbol x r a` instance + -- because of HasFieldOrigin in record_field + , Just (_, [_symbol, x, r, a]) <- tcSplitTyConApp_maybe (varType evvar) + , Just (r_tycon, _) <- tcSplitTyConApp_maybe r + , Just x_name <- isStrLitTy x + -- we check that this is a record type by checking whether it has any + -- fields (in scope) + , not . null $ tyConFieldLabels r_tycon + = [RemindRecordMissingField x_name r a] + | otherwise = [] occ_name_in_scope glb_env lcl_env occ_name = not $ null (lookupGRE_OccName (IncludeFields WantNormal) glb_env occ_name) && ===================================== compiler/GHC/Types/Hint.hs ===================================== @@ -35,7 +35,7 @@ import GHC.Hs.Extension (GhcTc, GhcRn) import GHC.Core.Coercion import GHC.Core.FamInstEnv (FamFlavor) import GHC.Core.TyCon (TyCon) -import GHC.Core.Type (PredType) +import GHC.Core.Type (PredType, Type) import GHC.Types.Fixity (LexicalFixity(..)) import GHC.Types.Name (Name, NameSpace, OccName (occNameFS), isSymOcc, nameOccName) import GHC.Types.Name.Reader (RdrName (Unqual), ImpDeclSpec) @@ -44,7 +44,7 @@ import GHC.Types.Basic (Activation, RuleName) import {-# SOURCE #-} GHC.Tc.Types.Origin ( ClsInstOrQC(..) ) import GHC.Parser.Errors.Basic import GHC.Utils.Outputable -import GHC.Data.FastString (fsLit) +import GHC.Data.FastString (fsLit, FastString) import Data.Typeable ( Typeable ) @@ -465,6 +465,9 @@ data GhcHint {-| Suggest eta-reducing a type synonym used in the implementation of abstract data. -} | SuggestEtaReduceAbsDataTySyn TyCon + {-| Remind the user that there is no field of a type and name in the record, + constructors are in the usual order $x$, $r$, $a$ -} + | RemindRecordMissingField FastString Type Type {-| Suggest binding the type variable on the LHS of the type declaration -} | SuggestBindTyVarOnLhs RdrName ===================================== compiler/GHC/Types/Hint/Ppr.hs ===================================== @@ -14,6 +14,7 @@ import GHC.Types.Hint import GHC.Core.FamInstEnv (FamFlavor(..)) import GHC.Core.TyCon +import GHC.Core.TyCo.Rep ( mkVisFunTyMany ) import GHC.Hs.Expr () -- instance Outputable import GHC.Tc.Types.Origin ( ClsInstOrQC(..) ) import GHC.Types.Id @@ -251,6 +252,12 @@ instance Outputable GhcHint where SuggestEtaReduceAbsDataTySyn tc -> text "If possible, eta-reduce the type synonym" <+> ppr_tc <+> text "so that it is nullary." where ppr_tc = quotes (ppr $ tyConName tc) + RemindRecordMissingField x r a -> + text "NB: There is no field selector" <+> ppr_sel + <+> text "in scope for record type" <+> ppr_r + where ppr_sel = quotes (ftext x <+> dcolon <+> ppr_arr_r_a) + ppr_arr_r_a = ppr $ mkVisFunTyMany r a + ppr_r = quotes $ ppr r SuggestBindTyVarOnLhs tv -> text "Bind" <+> quotes (ppr tv) <+> text "on the LHS of the type declaration" ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 4bfd6a0352ecfd71e1ca756a007ca827b68416d5 +Subproject commit e71f6f263aa4d7ce7a145eb5ac417f2f580f2288 ===================================== rts/posix/Signals.c ===================================== @@ -522,7 +522,9 @@ shutdown_handler(int sig STG_UNUSED) // extreme prejudice. So the first ^C tries to exit the program // cleanly, and the second one just kills it. if (getSchedState() >= SCHED_INTERRUPTING) { - stg_exit(EXIT_INTERRUPTED); + // N.B. we cannot use stg_exit() here as it calls exit() which is not + // signal-safe. See #23417. + _exit(EXIT_INTERRUPTED); } else { interruptStgRts(); } ===================================== testsuite/tests/driver/T4437.hs ===================================== @@ -37,8 +37,7 @@ check title expected got -- See Note [Adding a language extension] in compiler/GHC/Driver/Session.hs. expectedGhcOnlyExtensions :: [String] expectedGhcOnlyExtensions = - [ "TypeAbstractions", - "ExtendedLiterals" + [ "TypeAbstractions" ] expectedCabalOnlyExtensions :: [String] ===================================== testsuite/tests/driver/recomp007/Makefile ===================================== @@ -20,11 +20,11 @@ recomp007: ./b/dist/build/test/test "$(GHC_PKG)" unregister --package-db=$(LOCAL_PKGCONF) a-1.0 $(MAKE) -s --no-print-directory prep.a2 - cd b && ../Setup configure -v0 --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF) + cd b && ../Setup configure -v0 --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF) --ipid b cd b && ../Setup build ./b/dist/build/test/test prep.%: - cd $* && ../Setup configure -v0 --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF) + cd $* && ../Setup configure -v0 --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF) --ipid $* cd $* && ../Setup build -v0 cd $* && ../Setup register -v0 --inplace ===================================== testsuite/tests/driver/recomp007/recomp007.stdout ===================================== @@ -1,6 +1,6 @@ "1.0" -Preprocessing executable 'test' for b-1.0.. -Building executable 'test' for b-1.0.. +Preprocessing executable 'test' for b-1.0... +Building executable 'test' for b-1.0... [1 of 2] Compiling B ( B.hs, dist/build/test/test-tmp/B.o ) [A package changed] [3 of 3] Linking dist/build/test/test [Objects changed] "2.0" ===================================== testsuite/tests/ghci/should_run/T16096.stdout ===================================== @@ -1,6 +1,6 @@ ==================== Desugared ==================== -letrec { +let { x :: [GHC.Types.Int] [LclId] x = let { @@ -11,7 +11,7 @@ letrec { x :: [GHC.Types.Int] [LclId] x = GHC.Enum.enumFrom @GHC.Types.Int $dEnum (GHC.Types.I# 1#); } in - x; } in + x } in GHC.Base.returnIO @[GHC.Types.Any] (GHC.Types.: @@ -27,7 +27,7 @@ GHC.Base.returnIO ==================== Desugared ==================== -letrec { +let { x :: [GHC.Types.Int] [LclId] x = let { @@ -38,7 +38,7 @@ letrec { x :: [GHC.Types.Int] [LclId] x = GHC.Enum.enumFrom @GHC.Types.Int $dEnum (GHC.Types.I# 1#); } in - x; } in + x } in GHC.Base.returnIO @[GHC.Types.Any] (GHC.Types.: ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr ===================================== @@ -18,6 +18,7 @@ RecordDotSyntaxFail8.hs:37:3: error: [GHC-39999] RecordDotSyntaxFail8.hs:37:11: error: [GHC-39999] • No instance for ‘HasField "quux" Quux a0’ arising from selecting the field ‘quux’ + NB: There is no field selector ‘quux :: Quux -> a0’ in scope for record type ‘Quux’ • In the second argument of ‘($)’, namely ‘....baz.quux’ In a stmt of a 'do' block: print $ ....baz.quux In the expression: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4e3265fda3e8cb57ccc47a12cb0a45ae2a91c4a4...46f5ae932d6a1aea8ce0bb510314caee5033a922 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4e3265fda3e8cb57ccc47a12cb0a45ae2a91c4a4...46f5ae932d6a1aea8ce0bb510314caee5033a922 You're receiving 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 Jun 20 02:25:06 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Mon, 19 Jun 2023 22:25:06 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/int-index/vdq-with-coercions Message-ID: <64910e025b96e_be462f1f926c37864d@gitlab.mail> Vladislav Zavialov pushed new branch wip/int-index/vdq-with-coercions at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/int-index/vdq-with-coercions You're receiving 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 Jun 20 03:34:31 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 19 Jun 2023 23:34:31 -0400 Subject: [Git][ghc/ghc][wip/tsan/fixes-2] 21 commits: cmm: Introduce MO_RelaxedRead Message-ID: <64911e4784a98_be462f9a734c384716@gitlab.mail> Ben Gamari pushed to branch wip/tsan/fixes-2 at Glasgow Haskell Compiler / GHC Commits: cc1b407b by Ben Gamari at 2023-06-19T22:50:14-04:00 cmm: Introduce MO_RelaxedRead In hand-written Cmm it can sometimes be necessary to atomically load from memory deep within an expression (e.g. see the `CHECK_GC` macro). This MachOp provides a convenient way to do so without breaking the expression into multiple statements. - - - - - a97eba78 by Ben Gamari at 2023-06-19T22:50:14-04:00 rts: Silence spurious data races in ticky counters Previously we would use non-atomic accesses when bumping ticky counters, which would result in spurious data race reports from ThreadSanitizer when the threaded RTS was in use. - - - - - f407fa90 by Ben Gamari at 2023-06-19T22:50:14-04:00 Improve TSAN documentation - - - - - 46d6d4e7 by Ben Gamari at 2023-06-19T22:50:14-04:00 rts: Fix various data races - - - - - a1f593e0 by Ben Gamari at 2023-06-19T22:50:14-04:00 base: use atomic write when updating timer manager - - - - - 2d7123ae by Ben Gamari at 2023-06-19T22:50:14-04:00 Use relaxed atomics to manipulate TSO status fields - - - - - 9c936fff by Ben Gamari at 2023-06-19T22:50:14-04:00 rts: Add necessary barriers when manipulating TSO owner - - - - - 6d7d123a by Ben Gamari at 2023-06-19T22:50:14-04:00 rts: Fix synchronization on thread blocking state - - - - - d02fe49c by Ben Gamari at 2023-06-19T22:50:14-04:00 rts: Relaxed load MutVar info table - - - - - dadb3d2e by Ben Gamari at 2023-06-19T22:50:14-04:00 hadrian: More debug information - - - - - 7b33d535 by Ben Gamari at 2023-06-19T22:50:14-04:00 hadrian: More selective TSAN instrumentation - - - - - ada5171f by Ben Gamari at 2023-06-19T22:50:14-04:00 codeGen/tsan: Rework handling of spilling - - - - - 4a9c2975 by Ben Gamari at 2023-06-19T22:50:15-04:00 codeGen: Ensure that TSAN is aware of writeArray# write barriers - - - - - 3dd52b2c by Ben Gamari at 2023-06-19T22:50:15-04:00 codeGen: Ensure that array reads have necessary barriers This was the cause of #23541. - - - - - 43c527f0 by Ben Gamari at 2023-06-19T22:50:15-04:00 Wordsmith TSAN Note - - - - - a1632166 by Ben Gamari at 2023-06-19T22:50:15-04:00 codeGen: Use relaxed accesses in ticky bumping - - - - - ee67cb5c by Ben Gamari at 2023-06-19T22:50:15-04:00 codeGen: Use relaxed-read in closureInfoPtr - - - - - ea485334 by Ben Gamari at 2023-06-19T22:50:15-04:00 Fix thunk update ordering Previously we attempted to ensure soundness of concurrent thunk update by synchronizing on the access of the thunk's info table pointer field. This was believed to be sufficient since the indirectee (which may expose a closure allocated by another core) would not be examined until the info table pointer update is complete. However, it turns out that this can result in data races in the presence of multiple threads racing a update a single thunk. For instance, consider this interleaving under the old scheme: Thread A Thread B --------- --------- t=0 Enter t 1 Push update frame 2 Begin evaluation 4 Pause thread 5 t.indirectee=tso 6 Release t.info=BLACKHOLE 7 ... (e.g. GC) 8 Resume thread 9 Finish evaluation 10 Relaxed t.indirectee=x 11 Load t.info 12 Acquire fence 13 Inspect t.indirectee 14 Release t.info=BLACKHOLE Here Thread A enters thunk `t` but is soon paused, resulting in `t` being lazily blackholed at t=6. Then, at t=10 Thread A finishes evaluation and updates `t.indirectee` with a relaxed store. Meanwhile, Thread B enters the blackhole. Under the old scheme this would introduce an acquire-fence but this would only synchronize with Thread A at t=6. Consequently, the result of the evaluation, `x`, is not visible to Thread B, introducing a data race. We fix this by treating the `indirectee` field as we do all other mutable fields. This means we must always access this field with acquire-loads and release-stores. See #23185. - - - - - 6591a664 by Ben Gamari at 2023-06-19T22:50:15-04:00 STM: Use acquire loads when possible Full sequential consistency is not needed here. - - - - - 7c82f5c9 by Ubuntu at 2023-06-19T22:50:15-04:00 ghc-prim: Use C11 atomics - - - - - c016e70a by Ubuntu at 2023-06-19T22:50:15-04:00 Run script - - - - - 30 changed files: - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Info.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/StgToCmm/Utils.hs - hadrian/src/Flavour.hs - libraries/base/GHC/Event/Thread.hs - libraries/ghc-prim/cbits/atomic.c - rts/Apply.cmm - rts/Compact.cmm - rts/Exception.cmm - rts/Heap.c - rts/HeapStackCheck.cmm - rts/Interpreter.c - rts/Messages.c - rts/PrimOps.cmm - rts/RaiseAsync.c - rts/STM.c - rts/Schedule.c - rts/StableName.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ed7bf9c80fe2bc3415d79c8f168a65c177345a50...c016e70ac9f39f669b59fe8f6fdaae7868d62fad -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ed7bf9c80fe2bc3415d79c8f168a65c177345a50...c016e70ac9f39f669b59fe8f6fdaae7868d62fad You're receiving 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 Jun 20 04:01:58 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 20 Jun 2023 00:01:58 -0400 Subject: [Git][ghc/ghc][wip/rts-warnings] 3 commits: rts: Disable `#pragma GCC`s on clang compilers Message-ID: <649124b6cde05_be462f9b6ba838512b@gitlab.mail> Ben Gamari pushed to branch wip/rts-warnings at Glasgow Haskell Compiler / GHC Commits: 1c9de7d4 by Ben Gamari at 2023-06-20T00:00:19-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - 632fecc8 by Ben Gamari at 2023-06-20T00:00:19-04:00 rts: Fix capitalization of prototype - - - - - a623a3da by Ben Gamari at 2023-06-20T00:01:03-04:00 rts: Fix incorrect format specifier - - - - - 3 changed files: - rts/Hash.c - rts/Threads.c - rts/include/rts/storage/ClosureMacros.h Changes: ===================================== rts/Hash.c ===================================== @@ -18,11 +18,13 @@ since we compile these things these days with cabal we can no longer specify optimization per file. So we have to resort to pragmas. */ #if defined(__GNUC__) || defined(__GNUG__) +#if !defined(__clang__) #if !defined(DEBUG) #pragma GCC push_options #pragma GCC optimize ("O3") #endif #endif +#endif #define XXH_NAMESPACE __rts_ #define XXH_STATIC_LINKING_ONLY /* access advanced declarations */ @@ -565,7 +567,9 @@ int keyCountHashTable (HashTable *table) #if defined(__GNUC__) || defined(__GNUG__) +#if !defined(__clang__) #if !defined(DEBUG) #pragma GCC pop_options #endif #endif +#endif ===================================== rts/Threads.c ===================================== @@ -1013,10 +1013,10 @@ printGlobalThreads(void) for (uint32_t g = 0; g < RtsFlags.GcFlags.generations; g++) { debugBelch("\ngen %d\n", g); for (StgTSO *t = generations[g].threads; t != END_TSO_QUEUE; t = t->global_link) { - debugBelch("thread %p (id=%lu)\n", t, t->id); + debugBelch("thread %p (id=%lu)\n", t, (unsigned long)t->id); } for (StgTSO *t = generations[g].old_threads; t != END_TSO_QUEUE; t = t->global_link) { - debugBelch("thread %p (id=%lu) (old)\n", t, t->id); + debugBelch("thread %p (id=%lu) (old)\n", t, (unsigned long)t->id); } } } ===================================== rts/include/rts/storage/ClosureMacros.h ===================================== @@ -623,7 +623,7 @@ INLINE_HEADER void overwritingMutableClosureOfs (StgClosure *p, uint32_t offset) } // Version of 'overwritingClosure' which takes closure size as argument. -void stg_OverwritingClosureSize (StgClosure *p, uint32_t size /* in words */); +void stg_overwritingClosureSize (StgClosure *p, uint32_t size /* in words */); INLINE_HEADER void overwritingClosureSize (StgClosure *p, uint32_t size) { // This function is only called from stg_AP_STACK so we can assume it's not View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/909d36c86aab743ed3462c2a1916e6e140f4fb39...a623a3dad3dc9b4e74c5c2562b9f9a0058720d29 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/909d36c86aab743ed3462c2a1916e6e140f4fb39...a623a3dad3dc9b4e74c5c2562b9f9a0058720d29 You're receiving 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 Jun 20 07:20:02 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 20 Jun 2023 03:20:02 -0400 Subject: [Git][ghc/ghc][master] Avoid desugaring non-recursive lets into recursive lets Message-ID: <64915322cec27_be462fb99c7c40305b@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 3 changed files: - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - testsuite/tests/ghci/should_run/T16096.stdout Changes: ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -117,10 +117,56 @@ dsTopLHsBinds binds top_level_err bindsType (L loc bind) = putSrcSpanDs (locA loc) $ diagnosticDs (DsTopLevelBindsNotAllowed bindsType bind) +{- +Note [Return bindings in dependency order] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The desugarer tries to desugar a non-recursive let-binding to a collection of +one or more non-recursive let-bindings. The alternative is to generate a letrec +and wait for the occurrence analyser to sort it out later, but it is pretty easy +to arrange that the [(Id,CoreExpr)] pairs returned by dsLHsBinds are returned in +dependency order + +It's most important for linear types, where non-recursive lets can be linear +whereas recursive-let can't. Since we check the output of the desugarer for +linearity (see also Note [Linting linearity]), desugaring non-recursive lets to +recursive lets would break linearity checks. An alternative is to refine the +typing rule for recursive lets so that we don't have to care (see in particular +#23218 and #18694), but the outcome of this line of work is still unclear. In +the meantime, being a little precise in the desugarer is cheap. (paragraph +written on 2023-06-09) + +In dsLHSBinds (and dependencies), a single binding can be desugared to multiple +bindings. For instance because the source binding has the {-# SPECIALIZE #-} +pragma. In: + +f _ = … + where + {-# SPECIALIZE g :: F Int -> F Int #-} + g :: C a => F a -> F a + g _ = … + +The g binding desugars to + +let { + $sg = … } in + + g + [RULES: "SPEC g" g @Int $dC = $sg] + g = … +In order to avoid generating a letrec that will immediately be reordered, we +make sure to return the binding in dependency order [$sg, g]. + +This only matters when the source binding is non-recursive as recursive bindings +are always desugared to a single mutually recursive block. + +-} -- | Desugar all other kind of bindings, Ids of strict binds are returned to -- later be forced in the binding group body, see Note [Desugar Strict binds] +-- +-- Invariant: the desugared bindings are returned in dependency order, +-- see Note [Return bindings in dependency order] dsLHsBinds :: LHsBinds GhcTc -> DsM ([Id], [(Id,CoreExpr)]) dsLHsBinds binds = do { ds_bs <- mapBagM dsLHsBind binds @@ -134,6 +180,9 @@ dsLHsBind (L loc bind) = do dflags <- getDynFlags putSrcSpanDs (locA loc) $ dsHsBind dflags bind -- | Desugar a single binding (or group of recursive binds). +-- +-- Invariant: the desugared bindings are returned in dependency order, +-- see Note [Return bindings in dependency order] dsHsBind :: DynFlags -> HsBind GhcTc -> DsM ([Id], [(Id,CoreExpr)]) @@ -263,7 +312,7 @@ dsAbsBinds dflags tyvars dicts exports (isDefaultMethod prags) (dictArity dicts) rhs - ; return (force_vars', main_bind : fromOL spec_binds) } } + ; return (force_vars', fromOL spec_binds ++ [main_bind]) } } -- Another common case: no tyvars, no dicts -- In this case we can have a much simpler desugaring @@ -322,7 +371,7 @@ dsAbsBinds dflags tyvars dicts exports -- Kill the INLINE pragma because it applies to -- the user written (local) function. The global -- Id is just the selector. Hmm. - ; return ((global', rhs) : fromOL spec_binds) } } + ; return (fromOL spec_binds ++ [(global', rhs)]) } } ; export_binds_s <- mapM mk_bind (exports ++ extra_exports) ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -160,17 +160,20 @@ ds_val_bind (is_rec, binds) body -- NB: bindings have a fixed RuntimeRep, so it's OK to call isUnliftedType case prs of [] -> return body - _ -> return (Let (Rec prs) body') } - -- Use a Rec regardless of is_rec. - -- Why? Because it allows the binds to be all - -- mixed up, which is what happens in one rare case - -- Namely, for an AbsBind with no tyvars and no dicts, - -- but which does have dictionary bindings. - -- See notes with GHC.Tc.Solver.inferLoop [NO TYVARS] - -- It turned out that wrapping a Rec here was the easiest solution - -- - -- NB The previous case dealt with unlifted bindings, so we - -- only have to deal with lifted ones now; so Rec is ok + _ -> return (mkLets (mk_binds is_rec prs) body') } + -- We can make a non-recursive let because we make sure to return + -- the bindings in dependency order in dsLHsBinds, see Note [Return bindings in dependency order] + +-- | Helper function. You can use the result of 'mk_binds' with 'mkLets' for +-- instance. +-- +-- * @'mk_binds' 'Recursive' binds@ makes a single mutually-recursive +-- bindings with all the rhs/lhs pairs in @binds@ +-- * @'mk_binds' 'NonRecursive' binds@ makes one non-recursive binding +-- for each rhs/lhs pairs in @binds@ +mk_binds :: RecFlag -> [(b, (Expr b))] -> [Bind b] +mk_binds Recursive binds = [Rec binds] +mk_binds NonRecursive binds = map (uncurry NonRec) binds ------------------ dsUnliftedBind :: HsBind GhcTc -> CoreExpr -> DsM CoreExpr ===================================== testsuite/tests/ghci/should_run/T16096.stdout ===================================== @@ -1,6 +1,6 @@ ==================== Desugared ==================== -letrec { +let { x :: [GHC.Types.Int] [LclId] x = let { @@ -11,7 +11,7 @@ letrec { x :: [GHC.Types.Int] [LclId] x = GHC.Enum.enumFrom @GHC.Types.Int $dEnum (GHC.Types.I# 1#); } in - x; } in + x } in GHC.Base.returnIO @[GHC.Types.Any] (GHC.Types.: @@ -27,7 +27,7 @@ GHC.Base.returnIO ==================== Desugared ==================== -letrec { +let { x :: [GHC.Types.Int] [LclId] x = let { @@ -38,7 +38,7 @@ letrec { x :: [GHC.Types.Int] [LclId] x = GHC.Enum.enumFrom @GHC.Types.Int $dEnum (GHC.Types.I# 1#); } in - x; } in + x } in GHC.Base.returnIO @[GHC.Types.Any] (GHC.Types.: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3e80c2b40213bebe302b1bd239af48b33f1b30ef -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3e80c2b40213bebe302b1bd239af48b33f1b30ef You're receiving 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 Jun 20 07:20:36 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 20 Jun 2023 03:20:36 -0400 Subject: [Git][ghc/ghc][master] rts: Do not call exit() from SIGINT handler Message-ID: <64915344d38ba_be462f9a734c40801a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 1 changed file: - rts/posix/Signals.c Changes: ===================================== rts/posix/Signals.c ===================================== @@ -522,7 +522,9 @@ shutdown_handler(int sig STG_UNUSED) // extreme prejudice. So the first ^C tries to exit the program // cleanly, and the second one just kills it. if (getSchedState() >= SCHED_INTERRUPTING) { - stg_exit(EXIT_INTERRUPTED); + // N.B. we cannot use stg_exit() here as it calls exit() which is not + // signal-safe. See #23417. + _exit(EXIT_INTERRUPTED); } else { interruptStgRts(); } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9fad49e027fe8616c2f9913433c744ceb1a3589b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9fad49e027fe8616c2f9913433c744ceb1a3589b You're receiving 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 Jun 20 07:21:16 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 20 Jun 2023 03:21:16 -0400 Subject: [Git][ghc/ghc][master] Bump Cabal submodule Message-ID: <6491536c91f0f_be462fca8bf44118cd@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 4 changed files: - libraries/Cabal - testsuite/tests/driver/T4437.hs - testsuite/tests/driver/recomp007/Makefile - testsuite/tests/driver/recomp007/recomp007.stdout Changes: ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 4bfd6a0352ecfd71e1ca756a007ca827b68416d5 +Subproject commit e71f6f263aa4d7ce7a145eb5ac417f2f580f2288 ===================================== testsuite/tests/driver/T4437.hs ===================================== @@ -37,8 +37,7 @@ check title expected got -- See Note [Adding a language extension] in compiler/GHC/Driver/Session.hs. expectedGhcOnlyExtensions :: [String] expectedGhcOnlyExtensions = - [ "TypeAbstractions", - "ExtendedLiterals" + [ "TypeAbstractions" ] expectedCabalOnlyExtensions :: [String] ===================================== testsuite/tests/driver/recomp007/Makefile ===================================== @@ -20,11 +20,11 @@ recomp007: ./b/dist/build/test/test "$(GHC_PKG)" unregister --package-db=$(LOCAL_PKGCONF) a-1.0 $(MAKE) -s --no-print-directory prep.a2 - cd b && ../Setup configure -v0 --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF) + cd b && ../Setup configure -v0 --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF) --ipid b cd b && ../Setup build ./b/dist/build/test/test prep.%: - cd $* && ../Setup configure -v0 --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF) + cd $* && ../Setup configure -v0 --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF) --ipid $* cd $* && ../Setup build -v0 cd $* && ../Setup register -v0 --inplace ===================================== testsuite/tests/driver/recomp007/recomp007.stdout ===================================== @@ -1,6 +1,6 @@ "1.0" -Preprocessing executable 'test' for b-1.0.. -Building executable 'test' for b-1.0.. +Preprocessing executable 'test' for b-1.0... +Building executable 'test' for b-1.0... [1 of 2] Compiling B ( B.hs, dist/build/test/test-tmp/B.o ) [A package changed] [3 of 3] Linking dist/build/test/test [Objects changed] "2.0" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7485f848fd4e6a5936a8cb79c62e62e43e5d9a66 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7485f848fd4e6a5936a8cb79c62e62e43e5d9a66 You're receiving 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 Jun 20 07:21:52 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 20 Jun 2023 03:21:52 -0400 Subject: [Git][ghc/ghc][master] [feat] add a hint to `HasField` error message Message-ID: <649153906247f_be46226268204415185@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - 4 changed files: - compiler/GHC/Tc/Errors.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr Changes: ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -2316,7 +2316,7 @@ mk_dict_err ctxt (item, (matches, unifiers, unsafe_overlapped)) = case (NE.nonEm (Nothing, _) -> do -- No matches but perhaps several unifiers { (_, rel_binds, item) <- relevantBindings True ctxt item ; candidate_insts <- get_candidate_instances - ; (imp_errs, field_suggestions) <- record_field_suggestions + ; (imp_errs, field_suggestions) <- record_field_suggestions item ; return (cannot_resolve_msg item candidate_insts rel_binds imp_errs field_suggestions) } -- Some matches => overlap errors @@ -2352,13 +2352,33 @@ mk_dict_err ctxt (item, (matches, unifiers, unsafe_overlapped)) = case (NE.nonEm | otherwise = False -- See Note [Out-of-scope fields with -XOverloadedRecordDot] - record_field_suggestions :: TcM ([ImportError], [GhcHint]) - record_field_suggestions = flip (maybe $ return ([], noHints)) record_field $ \name -> + record_field_suggestions :: ErrorItem -> TcM ([ImportError], [GhcHint]) + record_field_suggestions item = flip (maybe $ return ([], noHints)) record_field $ \name -> do { glb_env <- getGlobalRdrEnv ; lcl_env <- getLocalRdrEnv - ; if occ_name_in_scope glb_env lcl_env name - then return ([], noHints) - else unknownNameSuggestions emptyLocalRdrEnv WL_RecField (mkRdrUnqual name) } + ; let field_name_hints = report_no_fieldnames item + ; (errs, hints) <- if occ_name_in_scope glb_env lcl_env name + then return ([], noHints) + else unknownNameSuggestions emptyLocalRdrEnv WL_RecField (mkRdrUnqual name) + ; pure (errs, hints ++ field_name_hints) + } + + -- get type names from instance + -- resolve the type - if it's in scope is it a record? + -- if it's a record, report an error - the record name + the field that could not be found + report_no_fieldnames :: ErrorItem -> [GhcHint] + report_no_fieldnames item + | Just (EvVarDest evvar) <- ei_evdest item + -- we can assume that here we have a `HasField @Symbol x r a` instance + -- because of HasFieldOrigin in record_field + , Just (_, [_symbol, x, r, a]) <- tcSplitTyConApp_maybe (varType evvar) + , Just (r_tycon, _) <- tcSplitTyConApp_maybe r + , Just x_name <- isStrLitTy x + -- we check that this is a record type by checking whether it has any + -- fields (in scope) + , not . null $ tyConFieldLabels r_tycon + = [RemindRecordMissingField x_name r a] + | otherwise = [] occ_name_in_scope glb_env lcl_env occ_name = not $ null (lookupGRE_OccName (IncludeFields WantNormal) glb_env occ_name) && ===================================== compiler/GHC/Types/Hint.hs ===================================== @@ -35,7 +35,7 @@ import GHC.Hs.Extension (GhcTc, GhcRn) import GHC.Core.Coercion import GHC.Core.FamInstEnv (FamFlavor) import GHC.Core.TyCon (TyCon) -import GHC.Core.Type (PredType) +import GHC.Core.Type (PredType, Type) import GHC.Types.Fixity (LexicalFixity(..)) import GHC.Types.Name (Name, NameSpace, OccName (occNameFS), isSymOcc, nameOccName) import GHC.Types.Name.Reader (RdrName (Unqual), ImpDeclSpec) @@ -44,7 +44,7 @@ import GHC.Types.Basic (Activation, RuleName) import {-# SOURCE #-} GHC.Tc.Types.Origin ( ClsInstOrQC(..) ) import GHC.Parser.Errors.Basic import GHC.Utils.Outputable -import GHC.Data.FastString (fsLit) +import GHC.Data.FastString (fsLit, FastString) import Data.Typeable ( Typeable ) @@ -465,6 +465,9 @@ data GhcHint {-| Suggest eta-reducing a type synonym used in the implementation of abstract data. -} | SuggestEtaReduceAbsDataTySyn TyCon + {-| Remind the user that there is no field of a type and name in the record, + constructors are in the usual order $x$, $r$, $a$ -} + | RemindRecordMissingField FastString Type Type {-| Suggest binding the type variable on the LHS of the type declaration -} | SuggestBindTyVarOnLhs RdrName ===================================== compiler/GHC/Types/Hint/Ppr.hs ===================================== @@ -14,6 +14,7 @@ import GHC.Types.Hint import GHC.Core.FamInstEnv (FamFlavor(..)) import GHC.Core.TyCon +import GHC.Core.TyCo.Rep ( mkVisFunTyMany ) import GHC.Hs.Expr () -- instance Outputable import GHC.Tc.Types.Origin ( ClsInstOrQC(..) ) import GHC.Types.Id @@ -251,6 +252,12 @@ instance Outputable GhcHint where SuggestEtaReduceAbsDataTySyn tc -> text "If possible, eta-reduce the type synonym" <+> ppr_tc <+> text "so that it is nullary." where ppr_tc = quotes (ppr $ tyConName tc) + RemindRecordMissingField x r a -> + text "NB: There is no field selector" <+> ppr_sel + <+> text "in scope for record type" <+> ppr_r + where ppr_sel = quotes (ftext x <+> dcolon <+> ppr_arr_r_a) + ppr_arr_r_a = ppr $ mkVisFunTyMany r a + ppr_r = quotes $ ppr r SuggestBindTyVarOnLhs tv -> text "Bind" <+> quotes (ppr tv) <+> text "on the LHS of the type declaration" ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr ===================================== @@ -18,6 +18,7 @@ RecordDotSyntaxFail8.hs:37:3: error: [GHC-39999] RecordDotSyntaxFail8.hs:37:11: error: [GHC-39999] • No instance for ‘HasField "quux" Quux a0’ arising from selecting the field ‘quux’ + NB: There is no field selector ‘quux :: Quux -> a0’ in scope for record type ‘Quux’ • In the second argument of ‘($)’, namely ‘....baz.quux’ In a stmt of a 'do' block: print $ ....baz.quux In the expression: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1464a2a8de082f66ae250d63ab9d94dbe2ef8620 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1464a2a8de082f66ae250d63ab9d94dbe2ef8620 You're receiving 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 Jun 20 08:23:29 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 20 Jun 2023 04:23:29 -0400 Subject: [Git][ghc/ghc][wip/T23109] Newtype classops are small Message-ID: <6491620134fde_be462267a6e78431563@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23109 at Glasgow Haskell Compiler / GHC Commits: c7f6adf7 by Simon Peyton Jones at 2023-06-20T09:23:09+01:00 Newtype classops are small needs comments - - - - - 1 changed file: - compiler/GHC/Core/Unfold.hs Changes: ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -39,20 +39,26 @@ import GHC.Prelude import GHC.Core import GHC.Core.Utils -import GHC.Types.Id import GHC.Core.DataCon +import GHC.Core.Class( Class, classTyCon ) +import GHC.Core.TyCon( isNewTyCon ) +import GHC.Core.Type + +import GHC.Types.Id import GHC.Types.Literal -import GHC.Builtin.PrimOps import GHC.Types.Id.Info import GHC.Types.RepType ( isZeroBitTy ) import GHC.Types.Basic ( Arity, RecFlag ) -import GHC.Core.Type +import GHC.Types.Tickish +import GHC.Types.ForeignCall + +import GHC.Builtin.PrimOps import GHC.Builtin.Names + import GHC.Data.Bag + import GHC.Utils.Misc import GHC.Utils.Outputable -import GHC.Types.ForeignCall -import GHC.Types.Tickish import qualified Data.ByteString as BS @@ -590,11 +596,11 @@ sizeExpr opts !bOMB_OUT_SIZE top_args expr size_up_call :: Id -> [CoreExpr] -> Int -> ExprSize size_up_call fun val_args voids = case idDetails fun of - FCallId _ -> sizeN (callSize (length val_args) voids) - DataConWorkId dc -> conSize dc (length val_args) - PrimOpId op _ -> primOpSize op (length val_args) - ClassOpId {} -> classOpSize opts top_args val_args - _ -> funSize opts top_args fun (length val_args) voids + FCallId _ -> sizeN (callSize (length val_args) voids) + DataConWorkId dc -> conSize dc (length val_args) + PrimOpId op _ -> primOpSize op (length val_args) + ClassOpId cls _ _ -> classOpSize opts cls top_args val_args + _ -> funSize opts top_args fun (length val_args) voids ------------ size_up_alt (Alt _con _bndrs rhs) = size_up rhs `addSizeN` 10 @@ -659,21 +665,26 @@ litSize _other = 0 -- Must match size of nullary constructors -- Key point: if x |-> 4, then x must inline unconditionally -- (eg via case binding) -classOpSize :: UnfoldingOpts -> [Id] -> [CoreExpr] -> ExprSize +classOpSize :: UnfoldingOpts -> Class -> [Id] -> [CoreExpr] -> ExprSize -- See Note [Conlike is interesting] -classOpSize _ _ [] + +classOpSize _ cls _ _ + | isNewTyCon (classTyCon cls) = sizeZero -classOpSize opts top_args (arg1 : other_args) - = SizeIs size arg_discount 0 + +classOpSize opts _ top_args args + = case args of + [] -> sizeZero + (arg1:other_args) -> SizeIs (size other_args) (arg_discount arg1) 0 where - size = 20 + (10 * length other_args) + size other_args = 20 + (10 * length other_args) + -- If the class op is scrutinising a lambda bound dictionary then -- give it a discount, to encourage the inlining of this function -- The actual discount is rather arbitrarily chosen - arg_discount = case arg1 of - Var dict | dict `elem` top_args - -> unitBag (dict, unfoldingDictDiscount opts) - _other -> emptyBag + arg_discount (Var dict) | dict `elem` top_args + = unitBag (dict, unfoldingDictDiscount opts) + arg_discount _ = emptyBag -- | The size of a function call callSize View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c7f6adf712b866d25297e76831b46ed3b390bea6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c7f6adf712b866d25297e76831b46ed3b390bea6 You're receiving 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 Jun 20 08:52:44 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Tue, 20 Jun 2023 04:52:44 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/modern-STV-extension-shuffling] 69 commits: Don't report redundant Givens from quantified constraints Message-ID: <649168dc2c0cf_be46226f41f5c4425ef@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/modern-STV-extension-shuffling at Glasgow Haskell Compiler / GHC Commits: 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - d6144ca7 by Andrei Borzenkov at 2023-06-20T12:52:22+04:00 Extension shuffling (#23291) Where introduced 3 new extensions: - PatternSignatures - ExtendedForAllScope - MethodTypeVariables Tasks of ScopedTypeVariables extension were distributed between PatternSignatures, ExtendedForAllScope and MethodTypeVariables according to the proposal. Now ScopedTypeVaribles only implies these three exntesions. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - HACKING.md - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/JS/Make.hs - compiler/GHC/JS/Syntax.hs - compiler/GHC/JS/Unsat/Syntax.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/HsType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cbfdab32c42f8e88d60b97539d6f8b5b2c3e3845...d6144ca79c8b78818c40f6dae6088abaa8155af3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cbfdab32c42f8e88d60b97539d6f8b5b2c3e3845...d6144ca79c8b78818c40f6dae6088abaa8155af3 You're receiving 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 Jun 20 09:00:14 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Tue, 20 Jun 2023 05:00:14 -0400 Subject: [Git][ghc/ghc][wip/T22010] Deleted 1 commit: Bump GHC version in CI Message-ID: <64916a9ecbaa_be46226f41f5c4435cb@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 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: 4a8de23e by Jaro Reinders at 2023-06-15T17:16:27+02:00 Bump GHC version in CI - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -84,7 +84,7 @@ workflow: matrix: - GHC_VERSION: 9.2.5 DOCKER_IMAGE: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10-ghc9_2:$DOCKER_REV" - - GHC_VERSION: 9.4.3 + - GHC_VERSION: 9.4.4 DOCKER_IMAGE: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10:$DOCKER_REV" - GHC_VERSION: 9.6.1 DOCKER_IMAGE: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb10-ghc9_6:$DOCKER_REV" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4a8de23e71819c7f53ebbefc904f5858b14eb098 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4a8de23e71819c7f53ebbefc904f5858b14eb098 You're receiving 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 Jun 20 09:00:52 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Tue, 20 Jun 2023 05:00:52 -0400 Subject: [Git][ghc/ghc][wip/T22010] Add CmmRegOff case for iselExpr64 Message-ID: <64916ac477fd5_be462f1c2dc044375f@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: a38146aa by Jaro Reinders at 2023-06-20T11:00:47+02:00 Add CmmRegOff case for iselExpr64 - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -610,6 +610,10 @@ iselExpr64 (CmmMachOp (MO_SS_Conv W32 W64) [expr]) = do r_dst_hi r_dst_lo +iselExpr64 (CmmRegOff reg i) = do + let rep = typeWidth (cmmRegType reg) + iselExpr64 (CmmMachOp (MO_Add rep) [CmmReg reg, CmmLit (CmmInt (fromIntegral i) rep)]) + iselExpr64 expr = do platform <- getPlatform View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a38146aa955aa626b8c90ded6636edca91597ed5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a38146aa955aa626b8c90ded6636edca91597ed5 You're receiving 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 Jun 20 09:02:54 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Tue, 20 Jun 2023 05:02:54 -0400 Subject: [Git][ghc/ghc][wip/T22010] Deleted 1 commit: Add CmmRegOff case for iselExpr64 Message-ID: <64916b3eadbc9_be46226f41f5c446288@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 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: a38146aa by Jaro Reinders at 2023-06-20T11:00:47+02:00 Add CmmRegOff case for iselExpr64 - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -610,6 +610,10 @@ iselExpr64 (CmmMachOp (MO_SS_Conv W32 W64) [expr]) = do r_dst_hi r_dst_lo +iselExpr64 (CmmRegOff reg i) = do + let rep = typeWidth (cmmRegType reg) + iselExpr64 (CmmMachOp (MO_Add rep) [CmmReg reg, CmmLit (CmmInt (fromIntegral i) rep)]) + iselExpr64 expr = do platform <- getPlatform View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a38146aa955aa626b8c90ded6636edca91597ed5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a38146aa955aa626b8c90ded6636edca91597ed5 You're receiving 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 Jun 20 10:38:49 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Tue, 20 Jun 2023 06:38:49 -0400 Subject: [Git][ghc/ghc][wip/T22010] Work around #23537 Message-ID: <649181b9ab95_be462f1c2dc04631a8@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 14c189a0 by Jaro Reinders at 2023-06-20T12:38:36+02:00 Work around #23537 - - - - - 5 changed files: - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/Tc/Deriv/Utils.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/Tc/Utils/TcType.hs Changes: ===================================== compiler/GHC/HsToCore/Match/Literal.hs ===================================== @@ -369,6 +369,10 @@ warnAboutOverflowedLiterals dflags lit where bounds = Just (MinBound minB, MaxBound maxB) + -- Work around #23537 + {-# NOINLINE (==) #-} + (==) = (GHC.Prelude.==) + warnAboutEmptyEnumerations :: FamInstEnvs -> DynFlags -> LHsExpr GhcTc -> Maybe (LHsExpr GhcTc) -> LHsExpr GhcTc -> DsM () @@ -396,6 +400,10 @@ warnAboutEmptyEnumerations fam_envs dflags fromExpr mThnExpr toExpr to = wrap @a to' mThn = fmap (wrap @a . fst) mThn' + -- Work around #23537 + {-# NOINLINE (==) #-} + (==) = (GHC.Prelude.==) + platform <- targetPlatform <$> getDynFlags -- Be careful to use target Int/Word sizes! cf #17336 if | tc == intTyConName -> case platformWordSize platform of ===================================== compiler/GHC/StgToCmm/Ticky.hs ===================================== @@ -884,7 +884,9 @@ showTypeCategory ty | otherwise = case tcSplitTyConApp_maybe ty of Nothing -> '.' Just (tycon, _) -> - let anyOf us = getUnique tycon `elem` us in + let -- Work around #23537 + {-# NOINLINE anyOf #-} + anyOf us = getUnique tycon `elem` us in case () of _ | anyOf [fUNTyConKey] -> '>' | anyOf [charTyConKey] -> 'C' ===================================== compiler/GHC/Tc/Deriv/Utils.hs ===================================== @@ -931,6 +931,10 @@ stockSideConditions deriv_ctxt cls cond_vanilla = cond_stdOK deriv_ctxt True -- Vanilla data constructors but allow no data cons or polytype arguments + -- Work around #23537 + {-# NOINLINE (==) #-} + (==) = (GHC.Prelude.==) + type Condition = DynFlags ===================================== compiler/GHC/Tc/Utils/Instantiate.hs ===================================== @@ -806,6 +806,10 @@ hasFixedRuntimeRepRes std_nm user_expr ty = mapM_ do_check mb_arity | otherwise = Nothing + -- Work around #23537 + {-# NOINLINE (==) #-} + (==) = (GHC.Prelude.==) + {- ************************************************************************ * * ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -2255,19 +2255,23 @@ marshalableTyCon dflags tc boxedMarshalableTyCon :: TyCon -> Validity' TypeCannotBeMarshaledReason boxedMarshalableTyCon tc - | getUnique tc `elem` [ intTyConKey, int8TyConKey, int16TyConKey - , int32TyConKey, int64TyConKey - , wordTyConKey, word8TyConKey, word16TyConKey - , word32TyConKey, word64TyConKey - , floatTyConKey, doubleTyConKey - , ptrTyConKey, funPtrTyConKey - , charTyConKey - , stablePtrTyConKey - , boolTyConKey - ] + | anyOf [ intTyConKey, int8TyConKey, int16TyConKey + , int32TyConKey, int64TyConKey + , wordTyConKey, word8TyConKey, word16TyConKey + , word32TyConKey, word64TyConKey + , floatTyConKey, doubleTyConKey + , ptrTyConKey, funPtrTyConKey + , charTyConKey + , stablePtrTyConKey + , boolTyConKey + ] = IsValid | otherwise = NotValid NotABoxedMarshalableTyCon + where + -- Work around #23537 + {-# NOINLINE anyOf #-} + anyOf x = getUnique tc `elem` x legalFIPrimArgTyCon :: DynFlags -> TyCon -> Validity' TypeCannotBeMarshaledReason -- Check args of 'foreign import prim', only allow simple unlifted types. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/14c189a0f9cbd1d02996250b2c6a65d07b13619f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/14c189a0f9cbd1d02996250b2c6a65d07b13619f You're receiving 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 Jun 20 11:01:27 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 20 Jun 2023 07:01:27 -0400 Subject: [Git][ghc/ghc][wip/tsan/fixes-2] 24 commits: cmm: Introduce MO_RelaxedRead Message-ID: <6491870790c03_be462269778c44673b8@gitlab.mail> Ben Gamari pushed to branch wip/tsan/fixes-2 at Glasgow Haskell Compiler / GHC Commits: b7c12615 by Ben Gamari at 2023-06-20T07:01:19-04:00 cmm: Introduce MO_RelaxedRead In hand-written Cmm it can sometimes be necessary to atomically load from memory deep within an expression (e.g. see the `CHECK_GC` macro). This MachOp provides a convenient way to do so without breaking the expression into multiple statements. - - - - - 3071e04c by Ben Gamari at 2023-06-20T07:01:19-04:00 rts: Silence spurious data races in ticky counters Previously we would use non-atomic accesses when bumping ticky counters, which would result in spurious data race reports from ThreadSanitizer when the threaded RTS was in use. - - - - - 1e36ebbf by Ben Gamari at 2023-06-20T07:01:19-04:00 Improve TSAN documentation - - - - - fbef2577 by Ben Gamari at 2023-06-20T07:01:19-04:00 rts: Fix data race in Interpreter's preemption check - - - - - 4e0e2a93 by Ben Gamari at 2023-06-20T07:01:19-04:00 rts: Fix data race in threadStatus# - - - - - 4089e22a by Ben Gamari at 2023-06-20T07:01:19-04:00 rts: Fix data race in CHECK_GC - - - - - 8cbfd523 by Ben Gamari at 2023-06-20T07:01:21-04:00 rts: Relaxed ticky - - - - - 2af80d3c by Ben Gamari at 2023-06-20T07:01:21-04:00 base: use atomic write when updating timer manager - - - - - 1001d7d3 by Ben Gamari at 2023-06-20T07:01:21-04:00 Use relaxed atomics to manipulate TSO status fields - - - - - 976a3a0f by Ben Gamari at 2023-06-20T07:01:21-04:00 rts: Add necessary barriers when manipulating TSO owner - - - - - 0697b162 by Ben Gamari at 2023-06-20T07:01:21-04:00 rts: Fix synchronization on thread blocking state - - - - - bf91365b by Ben Gamari at 2023-06-20T07:01:21-04:00 rts: Relaxed load MutVar info table - - - - - 86b80408 by Ben Gamari at 2023-06-20T07:01:21-04:00 hadrian: More debug information - - - - - 625577fb by Ben Gamari at 2023-06-20T07:01:21-04:00 hadrian: More selective TSAN instrumentation - - - - - a52f26f2 by Ben Gamari at 2023-06-20T07:01:21-04:00 codeGen/tsan: Rework handling of spilling - - - - - 1822973d by Ben Gamari at 2023-06-20T07:01:21-04:00 codeGen: Ensure that TSAN is aware of writeArray# write barriers - - - - - 6678e430 by Ben Gamari at 2023-06-20T07:01:21-04:00 codeGen: Ensure that array reads have necessary barriers This was the cause of #23541. - - - - - 05a0ce5d by Ben Gamari at 2023-06-20T07:01:21-04:00 Wordsmith TSAN Note - - - - - 76989854 by Ben Gamari at 2023-06-20T07:01:21-04:00 codeGen: Use relaxed accesses in ticky bumping - - - - - 69af1402 by Ben Gamari at 2023-06-20T07:01:21-04:00 codeGen: Use relaxed-read in closureInfoPtr - - - - - 134526e4 by Ben Gamari at 2023-06-20T07:01:22-04:00 Fix thunk update ordering Previously we attempted to ensure soundness of concurrent thunk update by synchronizing on the access of the thunk's info table pointer field. This was believed to be sufficient since the indirectee (which may expose a closure allocated by another core) would not be examined until the info table pointer update is complete. However, it turns out that this can result in data races in the presence of multiple threads racing a update a single thunk. For instance, consider this interleaving under the old scheme: Thread A Thread B --------- --------- t=0 Enter t 1 Push update frame 2 Begin evaluation 4 Pause thread 5 t.indirectee=tso 6 Release t.info=BLACKHOLE 7 ... (e.g. GC) 8 Resume thread 9 Finish evaluation 10 Relaxed t.indirectee=x 11 Load t.info 12 Acquire fence 13 Inspect t.indirectee 14 Release t.info=BLACKHOLE Here Thread A enters thunk `t` but is soon paused, resulting in `t` being lazily blackholed at t=6. Then, at t=10 Thread A finishes evaluation and updates `t.indirectee` with a relaxed store. Meanwhile, Thread B enters the blackhole. Under the old scheme this would introduce an acquire-fence but this would only synchronize with Thread A at t=6. Consequently, the result of the evaluation, `x`, is not visible to Thread B, introducing a data race. We fix this by treating the `indirectee` field as we do all other mutable fields. This means we must always access this field with acquire-loads and release-stores. See #23185. - - - - - 011f88d2 by Ben Gamari at 2023-06-20T07:01:22-04:00 STM: Use acquire loads when possible Full sequential consistency is not needed here. - - - - - 892ac9d9 by Ubuntu at 2023-06-20T07:01:22-04:00 ghc-prim: Use C11 atomics - - - - - e5038a94 by Ubuntu at 2023-06-20T07:01:22-04:00 Run script - - - - - 30 changed files: - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Info.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/StgToCmm/Utils.hs - hadrian/src/Flavour.hs - libraries/base/GHC/Event/Thread.hs - libraries/ghc-prim/cbits/atomic.c - rts/Apply.cmm - rts/Compact.cmm - rts/Exception.cmm - rts/Heap.c - rts/HeapStackCheck.cmm - rts/Interpreter.c - rts/Messages.c - rts/PrimOps.cmm - rts/RaiseAsync.c - rts/STM.c - rts/Schedule.c - rts/StableName.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c016e70ac9f39f669b59fe8f6fdaae7868d62fad...e5038a94be33dd96ef0040dde0585efcb6e0cdb4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c016e70ac9f39f669b59fe8f6fdaae7868d62fad...e5038a94be33dd96ef0040dde0585efcb6e0cdb4 You're receiving 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 Jun 20 11:03:50 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 20 Jun 2023 07:03:50 -0400 Subject: [Git][ghc/ghc][wip/tsan/fixes-2] 22 commits: rts: Silence spurious data races in ticky counters Message-ID: <64918796d355d_be462270bd9d046955f@gitlab.mail> Ben Gamari pushed to branch wip/tsan/fixes-2 at Glasgow Haskell Compiler / GHC Commits: 5482c162 by Ben Gamari at 2023-06-20T07:03:45-04:00 rts: Silence spurious data races in ticky counters Previously we would use non-atomic accesses when bumping ticky counters, which would result in spurious data race reports from ThreadSanitizer when the threaded RTS was in use. - - - - - 974ff355 by Ben Gamari at 2023-06-20T07:03:45-04:00 Improve TSAN documentation - - - - - cd0e3354 by Ben Gamari at 2023-06-20T07:03:45-04:00 rts: Fix data race in Interpreter's preemption check - - - - - 28bfa51a by Ben Gamari at 2023-06-20T07:03:45-04:00 rts: Fix data race in threadStatus# - - - - - 31bbe4b2 by Ben Gamari at 2023-06-20T07:03:45-04:00 rts: Fix data race in CHECK_GC - - - - - f42ae688 by Ben Gamari at 2023-06-20T07:03:45-04:00 base: use atomic write when updating timer manager - - - - - 180deed0 by Ben Gamari at 2023-06-20T07:03:45-04:00 Use relaxed atomics to manipulate TSO status fields - - - - - 2a9a9bff by Ben Gamari at 2023-06-20T07:03:45-04:00 rts: Add necessary barriers when manipulating TSO owner - - - - - 850bf588 by Ben Gamari at 2023-06-20T07:03:45-04:00 rts: Fix synchronization on thread blocking state - - - - - 2b7be9ba by Ben Gamari at 2023-06-20T07:03:45-04:00 rts: Relaxed load MutVar info table - - - - - cc3e1e58 by Ben Gamari at 2023-06-20T07:03:45-04:00 hadrian: More debug information - - - - - 1edef489 by Ben Gamari at 2023-06-20T07:03:45-04:00 hadrian: More selective TSAN instrumentation - - - - - 44899037 by Ben Gamari at 2023-06-20T07:03:45-04:00 codeGen/tsan: Rework handling of spilling - - - - - 6c24a7d2 by Ben Gamari at 2023-06-20T07:03:45-04:00 codeGen: Ensure that TSAN is aware of writeArray# write barriers - - - - - b4447d88 by Ben Gamari at 2023-06-20T07:03:45-04:00 codeGen: Ensure that array reads have necessary barriers This was the cause of #23541. - - - - - 885f76ca by Ben Gamari at 2023-06-20T07:03:45-04:00 Wordsmith TSAN Note - - - - - b8402eb2 by Ben Gamari at 2023-06-20T07:03:46-04:00 codeGen: Use relaxed accesses in ticky bumping - - - - - 399b64da by Ben Gamari at 2023-06-20T07:03:46-04:00 codeGen: Use relaxed-read in closureInfoPtr - - - - - 15f0d664 by Ben Gamari at 2023-06-20T07:03:46-04:00 Fix thunk update ordering Previously we attempted to ensure soundness of concurrent thunk update by synchronizing on the access of the thunk's info table pointer field. This was believed to be sufficient since the indirectee (which may expose a closure allocated by another core) would not be examined until the info table pointer update is complete. However, it turns out that this can result in data races in the presence of multiple threads racing a update a single thunk. For instance, consider this interleaving under the old scheme: Thread A Thread B --------- --------- t=0 Enter t 1 Push update frame 2 Begin evaluation 4 Pause thread 5 t.indirectee=tso 6 Release t.info=BLACKHOLE 7 ... (e.g. GC) 8 Resume thread 9 Finish evaluation 10 Relaxed t.indirectee=x 11 Load t.info 12 Acquire fence 13 Inspect t.indirectee 14 Release t.info=BLACKHOLE Here Thread A enters thunk `t` but is soon paused, resulting in `t` being lazily blackholed at t=6. Then, at t=10 Thread A finishes evaluation and updates `t.indirectee` with a relaxed store. Meanwhile, Thread B enters the blackhole. Under the old scheme this would introduce an acquire-fence but this would only synchronize with Thread A at t=6. Consequently, the result of the evaluation, `x`, is not visible to Thread B, introducing a data race. We fix this by treating the `indirectee` field as we do all other mutable fields. This means we must always access this field with acquire-loads and release-stores. See #23185. - - - - - 03fa110a by Ben Gamari at 2023-06-20T07:03:46-04:00 STM: Use acquire loads when possible Full sequential consistency is not needed here. - - - - - 647b1ce6 by Ubuntu at 2023-06-20T07:03:46-04:00 ghc-prim: Use C11 atomics - - - - - e485e238 by Ubuntu at 2023-06-20T07:03:46-04:00 Run script - - - - - 30 changed files: - compiler/GHC/Cmm/Info.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/StgToCmm/Utils.hs - hadrian/src/Flavour.hs - libraries/base/GHC/Event/Thread.hs - libraries/ghc-prim/cbits/atomic.c - rts/Apply.cmm - rts/Compact.cmm - rts/Exception.cmm - rts/Heap.c - rts/HeapStackCheck.cmm - rts/Interpreter.c - rts/Messages.c - rts/PrimOps.cmm - rts/RaiseAsync.c - rts/STM.c - rts/Schedule.c - rts/StableName.c - rts/StgMiscClosures.cmm - rts/StgStartup.cmm - rts/ThreadPaused.c - rts/Threads.c - rts/TraverseHeap.c - rts/Updates.cmm - rts/Updates.h - rts/include/Cmm.h The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e5038a94be33dd96ef0040dde0585efcb6e0cdb4...e485e238e2ae4a9e9a9b6124613d1d43ad523725 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e5038a94be33dd96ef0040dde0585efcb6e0cdb4...e485e238e2ae4a9e9a9b6124613d1d43ad523725 You're receiving 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 Jun 20 11:25:30 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 20 Jun 2023 07:25:30 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Avoid desugaring non-recursive lets into recursive lets Message-ID: <64918caa28133_be46226b7d1dc4715e2@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - 09c7c797 by Ben Gamari at 2023-06-20T07:25:11-04:00 rts/ipe: Fix unused lock warning - - - - - 12f20ae5 by Ben Gamari at 2023-06-20T07:25:11-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 3eb8776f by Ben Gamari at 2023-06-20T07:25:11-04:00 rts: Various warnings fixes - - - - - 5993ec2c by Ben Gamari at 2023-06-20T07:25:11-04:00 rts: Fix printf format mismatch - - - - - 9f22f8fc by Ben Gamari at 2023-06-20T07:25:11-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - 1ce27044 by Ben Gamari at 2023-06-20T07:25:11-04:00 nonmoving: Fix unused definition warrnings - - - - - 280afc2c by Ben Gamari at 2023-06-20T07:25:11-04:00 Disable futimens on Darwin. See #22938 - - - - - 9725efe5 by Ben Gamari at 2023-06-20T07:25:11-04:00 rts: Fix incorrect CPP guard - - - - - 4fa6ffc7 by Ben Gamari at 2023-06-20T07:25:11-04: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. - - - - - 5654112e by Ben Gamari at 2023-06-20T07:25:11-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - 7d815f7f by Ben Gamari at 2023-06-20T07:25:11-04:00 rts: Fix capitalization of prototype - - - - - d1566139 by Ben Gamari at 2023-06-20T07:25:11-04:00 rts: Fix incorrect format specifier - - - - - ab375d31 by Josh Meredith at 2023-06-20T07:25:17-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 27 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Types/Hint.hs - compiler/GHC/Types/Hint/Ppr.hs - hadrian/src/Flavour.hs - libraries/Cabal - rts/Hash.c - rts/IPE.c - rts/ProfilerReportJson.c - rts/Threads.c - rts/adjustor/LibffiAdjustor.c - rts/eventlog/EventLog.c - rts/include/rts/storage/ClosureMacros.h - rts/posix/Signals.c - rts/posix/Ticker.c - rts/posix/ticker/Pthread.c - rts/posix/ticker/TimerFd.c - rts/sm/NonMovingMark.c - testsuite/tests/driver/T4437.hs - testsuite/tests/driver/recomp007/Makefile - testsuite/tests/driver/recomp007/recomp007.stdout - testsuite/tests/ghci/should_run/T16096.stdout - testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr - testsuite/tests/perf/compiler/all.T Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -409,6 +409,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" } }, @@ -2478,6 +2479,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" } }, @@ -3590,6 +3592,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" } }, ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -117,10 +117,56 @@ dsTopLHsBinds binds top_level_err bindsType (L loc bind) = putSrcSpanDs (locA loc) $ diagnosticDs (DsTopLevelBindsNotAllowed bindsType bind) +{- +Note [Return bindings in dependency order] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The desugarer tries to desugar a non-recursive let-binding to a collection of +one or more non-recursive let-bindings. The alternative is to generate a letrec +and wait for the occurrence analyser to sort it out later, but it is pretty easy +to arrange that the [(Id,CoreExpr)] pairs returned by dsLHsBinds are returned in +dependency order + +It's most important for linear types, where non-recursive lets can be linear +whereas recursive-let can't. Since we check the output of the desugarer for +linearity (see also Note [Linting linearity]), desugaring non-recursive lets to +recursive lets would break linearity checks. An alternative is to refine the +typing rule for recursive lets so that we don't have to care (see in particular +#23218 and #18694), but the outcome of this line of work is still unclear. In +the meantime, being a little precise in the desugarer is cheap. (paragraph +written on 2023-06-09) + +In dsLHSBinds (and dependencies), a single binding can be desugared to multiple +bindings. For instance because the source binding has the {-# SPECIALIZE #-} +pragma. In: + +f _ = … + where + {-# SPECIALIZE g :: F Int -> F Int #-} + g :: C a => F a -> F a + g _ = … + +The g binding desugars to + +let { + $sg = … } in + + g + [RULES: "SPEC g" g @Int $dC = $sg] + g = … +In order to avoid generating a letrec that will immediately be reordered, we +make sure to return the binding in dependency order [$sg, g]. + +This only matters when the source binding is non-recursive as recursive bindings +are always desugared to a single mutually recursive block. + +-} -- | Desugar all other kind of bindings, Ids of strict binds are returned to -- later be forced in the binding group body, see Note [Desugar Strict binds] +-- +-- Invariant: the desugared bindings are returned in dependency order, +-- see Note [Return bindings in dependency order] dsLHsBinds :: LHsBinds GhcTc -> DsM ([Id], [(Id,CoreExpr)]) dsLHsBinds binds = do { ds_bs <- mapBagM dsLHsBind binds @@ -134,6 +180,9 @@ dsLHsBind (L loc bind) = do dflags <- getDynFlags putSrcSpanDs (locA loc) $ dsHsBind dflags bind -- | Desugar a single binding (or group of recursive binds). +-- +-- Invariant: the desugared bindings are returned in dependency order, +-- see Note [Return bindings in dependency order] dsHsBind :: DynFlags -> HsBind GhcTc -> DsM ([Id], [(Id,CoreExpr)]) @@ -263,7 +312,7 @@ dsAbsBinds dflags tyvars dicts exports (isDefaultMethod prags) (dictArity dicts) rhs - ; return (force_vars', main_bind : fromOL spec_binds) } } + ; return (force_vars', fromOL spec_binds ++ [main_bind]) } } -- Another common case: no tyvars, no dicts -- In this case we can have a much simpler desugaring @@ -322,7 +371,7 @@ dsAbsBinds dflags tyvars dicts exports -- Kill the INLINE pragma because it applies to -- the user written (local) function. The global -- Id is just the selector. Hmm. - ; return ((global', rhs) : fromOL spec_binds) } } + ; return (fromOL spec_binds ++ [(global', rhs)]) } } ; export_binds_s <- mapM mk_bind (exports ++ extra_exports) ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -160,17 +160,20 @@ ds_val_bind (is_rec, binds) body -- NB: bindings have a fixed RuntimeRep, so it's OK to call isUnliftedType case prs of [] -> return body - _ -> return (Let (Rec prs) body') } - -- Use a Rec regardless of is_rec. - -- Why? Because it allows the binds to be all - -- mixed up, which is what happens in one rare case - -- Namely, for an AbsBind with no tyvars and no dicts, - -- but which does have dictionary bindings. - -- See notes with GHC.Tc.Solver.inferLoop [NO TYVARS] - -- It turned out that wrapping a Rec here was the easiest solution - -- - -- NB The previous case dealt with unlifted bindings, so we - -- only have to deal with lifted ones now; so Rec is ok + _ -> return (mkLets (mk_binds is_rec prs) body') } + -- We can make a non-recursive let because we make sure to return + -- the bindings in dependency order in dsLHsBinds, see Note [Return bindings in dependency order] + +-- | Helper function. You can use the result of 'mk_binds' with 'mkLets' for +-- instance. +-- +-- * @'mk_binds' 'Recursive' binds@ makes a single mutually-recursive +-- bindings with all the rhs/lhs pairs in @binds@ +-- * @'mk_binds' 'NonRecursive' binds@ makes one non-recursive binding +-- for each rhs/lhs pairs in @binds@ +mk_binds :: RecFlag -> [(b, (Expr b))] -> [Bind b] +mk_binds Recursive binds = [Rec binds] +mk_binds NonRecursive binds = map (uncurry NonRec) binds ------------------ dsUnliftedBind :: HsBind GhcTc -> CoreExpr -> DsM CoreExpr ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -2316,7 +2316,7 @@ mk_dict_err ctxt (item, (matches, unifiers, unsafe_overlapped)) = case (NE.nonEm (Nothing, _) -> do -- No matches but perhaps several unifiers { (_, rel_binds, item) <- relevantBindings True ctxt item ; candidate_insts <- get_candidate_instances - ; (imp_errs, field_suggestions) <- record_field_suggestions + ; (imp_errs, field_suggestions) <- record_field_suggestions item ; return (cannot_resolve_msg item candidate_insts rel_binds imp_errs field_suggestions) } -- Some matches => overlap errors @@ -2352,13 +2352,33 @@ mk_dict_err ctxt (item, (matches, unifiers, unsafe_overlapped)) = case (NE.nonEm | otherwise = False -- See Note [Out-of-scope fields with -XOverloadedRecordDot] - record_field_suggestions :: TcM ([ImportError], [GhcHint]) - record_field_suggestions = flip (maybe $ return ([], noHints)) record_field $ \name -> + record_field_suggestions :: ErrorItem -> TcM ([ImportError], [GhcHint]) + record_field_suggestions item = flip (maybe $ return ([], noHints)) record_field $ \name -> do { glb_env <- getGlobalRdrEnv ; lcl_env <- getLocalRdrEnv - ; if occ_name_in_scope glb_env lcl_env name - then return ([], noHints) - else unknownNameSuggestions emptyLocalRdrEnv WL_RecField (mkRdrUnqual name) } + ; let field_name_hints = report_no_fieldnames item + ; (errs, hints) <- if occ_name_in_scope glb_env lcl_env name + then return ([], noHints) + else unknownNameSuggestions emptyLocalRdrEnv WL_RecField (mkRdrUnqual name) + ; pure (errs, hints ++ field_name_hints) + } + + -- get type names from instance + -- resolve the type - if it's in scope is it a record? + -- if it's a record, report an error - the record name + the field that could not be found + report_no_fieldnames :: ErrorItem -> [GhcHint] + report_no_fieldnames item + | Just (EvVarDest evvar) <- ei_evdest item + -- we can assume that here we have a `HasField @Symbol x r a` instance + -- because of HasFieldOrigin in record_field + , Just (_, [_symbol, x, r, a]) <- tcSplitTyConApp_maybe (varType evvar) + , Just (r_tycon, _) <- tcSplitTyConApp_maybe r + , Just x_name <- isStrLitTy x + -- we check that this is a record type by checking whether it has any + -- fields (in scope) + , not . null $ tyConFieldLabels r_tycon + = [RemindRecordMissingField x_name r a] + | otherwise = [] occ_name_in_scope glb_env lcl_env occ_name = not $ null (lookupGRE_OccName (IncludeFields WantNormal) glb_env occ_name) && ===================================== compiler/GHC/Types/Hint.hs ===================================== @@ -35,7 +35,7 @@ import GHC.Hs.Extension (GhcTc, GhcRn) import GHC.Core.Coercion import GHC.Core.FamInstEnv (FamFlavor) import GHC.Core.TyCon (TyCon) -import GHC.Core.Type (PredType) +import GHC.Core.Type (PredType, Type) import GHC.Types.Fixity (LexicalFixity(..)) import GHC.Types.Name (Name, NameSpace, OccName (occNameFS), isSymOcc, nameOccName) import GHC.Types.Name.Reader (RdrName (Unqual), ImpDeclSpec) @@ -44,7 +44,7 @@ import GHC.Types.Basic (Activation, RuleName) import {-# SOURCE #-} GHC.Tc.Types.Origin ( ClsInstOrQC(..) ) import GHC.Parser.Errors.Basic import GHC.Utils.Outputable -import GHC.Data.FastString (fsLit) +import GHC.Data.FastString (fsLit, FastString) import Data.Typeable ( Typeable ) @@ -465,6 +465,9 @@ data GhcHint {-| Suggest eta-reducing a type synonym used in the implementation of abstract data. -} | SuggestEtaReduceAbsDataTySyn TyCon + {-| Remind the user that there is no field of a type and name in the record, + constructors are in the usual order $x$, $r$, $a$ -} + | RemindRecordMissingField FastString Type Type {-| Suggest binding the type variable on the LHS of the type declaration -} | SuggestBindTyVarOnLhs RdrName ===================================== compiler/GHC/Types/Hint/Ppr.hs ===================================== @@ -14,6 +14,7 @@ import GHC.Types.Hint import GHC.Core.FamInstEnv (FamFlavor(..)) import GHC.Core.TyCon +import GHC.Core.TyCo.Rep ( mkVisFunTyMany ) import GHC.Hs.Expr () -- instance Outputable import GHC.Tc.Types.Origin ( ClsInstOrQC(..) ) import GHC.Types.Id @@ -251,6 +252,12 @@ instance Outputable GhcHint where SuggestEtaReduceAbsDataTySyn tc -> text "If possible, eta-reduce the type synonym" <+> ppr_tc <+> text "so that it is nullary." where ppr_tc = quotes (ppr $ tyConName tc) + RemindRecordMissingField x r a -> + text "NB: There is no field selector" <+> ppr_sel + <+> text "in scope for record type" <+> ppr_r + where ppr_sel = quotes (ftext x <+> dcolon <+> ppr_arr_r_a) + ppr_arr_r_a = ppr $ mkVisFunTyMany r a + ppr_r = quotes $ ppr r SuggestBindTyVarOnLhs tv -> text "Bind" <+> quotes (ppr tv) <+> text "on the LHS of the type declaration" ===================================== hadrian/src/Flavour.hs ===================================== @@ -123,16 +123,25 @@ addArgs args' fl = fl { extraArgs = extraArgs 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 ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 4bfd6a0352ecfd71e1ca756a007ca827b68416d5 +Subproject commit e71f6f263aa4d7ce7a145eb5ac417f2f580f2288 ===================================== rts/Hash.c ===================================== @@ -18,11 +18,13 @@ since we compile these things these days with cabal we can no longer specify optimization per file. So we have to resort to pragmas. */ #if defined(__GNUC__) || defined(__GNUG__) +#if !defined(__clang__) #if !defined(DEBUG) #pragma GCC push_options #pragma GCC optimize ("O3") #endif #endif +#endif #define XXH_NAMESPACE __rts_ #define XXH_STATIC_LINKING_ONLY /* access advanced declarations */ @@ -565,7 +567,9 @@ int keyCountHashTable (HashTable *table) #if defined(__GNUC__) || defined(__GNUG__) +#if !defined(__clang__) #if !defined(DEBUG) #pragma GCC pop_options #endif #endif +#endif ===================================== rts/IPE.c ===================================== @@ -62,7 +62,10 @@ this all IPE lists of all IpeBufferListNode are traversed to insert all IPEs. After the content of a IpeBufferListNode has been inserted, it's freed. */ +#if defined(THREADED_RTS) static Mutex ipeMapLock; +#endif +// Protected by ipeMapLock static HashTable *ipeMap = NULL; // Accessed atomically ===================================== rts/ProfilerReportJson.c ===================================== @@ -52,11 +52,10 @@ static void escapeString(char const* str, char **buf) static void logCostCentres(FILE *prof_file) { - char* lbl; - char* src_loc; bool needs_comma = false; fprintf(prof_file, "[\n"); for (CostCentre *cc = CC_LIST; cc != NULL; cc = cc->link) { + char *lbl, *src_loc; escapeString(cc->label, &lbl); escapeString(cc->srcloc, &src_loc); fprintf(prof_file, @@ -70,10 +69,10 @@ logCostCentres(FILE *prof_file) cc->ccID, lbl, cc->module, src_loc, cc->is_caf ? "true" : "false"); needs_comma = true; + stgFree(lbl); + stgFree(src_loc); } fprintf(prof_file, "]\n"); - stgFree(lbl); - stgFree(src_loc); } static void ===================================== rts/Threads.c ===================================== @@ -1013,10 +1013,10 @@ printGlobalThreads(void) for (uint32_t g = 0; g < RtsFlags.GcFlags.generations; g++) { debugBelch("\ngen %d\n", g); for (StgTSO *t = generations[g].threads; t != END_TSO_QUEUE; t = t->global_link) { - debugBelch("thread %p (id=%lu)\n", t, t->id); + debugBelch("thread %p (id=%lu)\n", t, (unsigned long)t->id); } for (StgTSO *t = generations[g].old_threads; t != END_TSO_QUEUE; t = t->global_link) { - debugBelch("thread %p (id=%lu) (old)\n", t, t->id); + debugBelch("thread %p (id=%lu) (old)\n", t, (unsigned long)t->id); } } } ===================================== rts/adjustor/LibffiAdjustor.c ===================================== @@ -39,7 +39,7 @@ static AdjustorWritable allocate_adjustor(AdjustorExecutable *exec_ret, ffi_cif { AdjustorWritable writ; - ffi_status r = ffi_alloc_prep_closure(&writ, cif, wptr, hptr, exec_ret); + ffi_status r = ffi_alloc_prep_closure((ffi_closure **) &writ, cif, wptr, hptr, exec_ret); if (r != FFI_OK) barf("ffi_alloc_prep_closure failed: %d", r); ===================================== rts/eventlog/EventLog.c ===================================== @@ -759,8 +759,10 @@ void postCapsetVecEvent (EventTypeNum tag, // 1 + strlen to account for the trailing \0, used as separator int increment = 1 + strlen(argv[i]); if (size + increment > EVENT_PAYLOAD_SIZE_MAX) { - errorBelch("Event size exceeds EVENT_PAYLOAD_SIZE_MAX, record only " - "%d out of %d args", i, argc); + errorBelch("Event size exceeds EVENT_PAYLOAD_SIZE_MAX, record only %" + FMT_Word " out of %" FMT_Word " args", + (StgWord) i, + (StgWord) argc); argc = i; break; } else { ===================================== rts/include/rts/storage/ClosureMacros.h ===================================== @@ -623,7 +623,7 @@ INLINE_HEADER void overwritingMutableClosureOfs (StgClosure *p, uint32_t offset) } // Version of 'overwritingClosure' which takes closure size as argument. -void stg_OverwritingClosureSize (StgClosure *p, uint32_t size /* in words */); +void stg_overwritingClosureSize (StgClosure *p, uint32_t size /* in words */); INLINE_HEADER void overwritingClosureSize (StgClosure *p, uint32_t size) { // This function is only called from stg_AP_STACK so we can assume it's not ===================================== rts/posix/Signals.c ===================================== @@ -522,7 +522,9 @@ shutdown_handler(int sig STG_UNUSED) // extreme prejudice. So the first ^C tries to exit the program // cleanly, and the second one just kills it. if (getSchedState() >= SCHED_INTERRUPTING) { - stg_exit(EXIT_INTERRUPTED); + // N.B. we cannot use stg_exit() here as it calls exit() which is not + // signal-safe. See #23417. + _exit(EXIT_INTERRUPTED); } else { interruptStgRts(); } ===================================== 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 ===================================== @@ -39,7 +39,7 @@ static void trace_PAP_payload (MarkQueue *queue, StgClosure *fun, StgClosure **payload, StgWord size); -static bool is_nonmoving_weak(StgWeak *weak); +static bool is_nonmoving_weak(StgWeak *weak) USED_IF_DEBUG; // How many Array# entries to add to the mark queue at once? #define MARK_ARRAY_CHUNK_LENGTH 128 @@ -974,7 +974,7 @@ static void nonmovingResetUpdRemSetQueue (MarkQueue *rset) rset->top->head = 0; } -void nonmovingResetUpdRemSet (UpdRemSet *rset) +static void nonmovingResetUpdRemSet (UpdRemSet *rset) { nonmovingResetUpdRemSetQueue(&rset->queue); } ===================================== testsuite/tests/driver/T4437.hs ===================================== @@ -37,8 +37,7 @@ check title expected got -- See Note [Adding a language extension] in compiler/GHC/Driver/Session.hs. expectedGhcOnlyExtensions :: [String] expectedGhcOnlyExtensions = - [ "TypeAbstractions", - "ExtendedLiterals" + [ "TypeAbstractions" ] expectedCabalOnlyExtensions :: [String] ===================================== testsuite/tests/driver/recomp007/Makefile ===================================== @@ -20,11 +20,11 @@ recomp007: ./b/dist/build/test/test "$(GHC_PKG)" unregister --package-db=$(LOCAL_PKGCONF) a-1.0 $(MAKE) -s --no-print-directory prep.a2 - cd b && ../Setup configure -v0 --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF) + cd b && ../Setup configure -v0 --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF) --ipid b cd b && ../Setup build ./b/dist/build/test/test prep.%: - cd $* && ../Setup configure -v0 --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF) + cd $* && ../Setup configure -v0 --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF) --ipid $* cd $* && ../Setup build -v0 cd $* && ../Setup register -v0 --inplace ===================================== testsuite/tests/driver/recomp007/recomp007.stdout ===================================== @@ -1,6 +1,6 @@ "1.0" -Preprocessing executable 'test' for b-1.0.. -Building executable 'test' for b-1.0.. +Preprocessing executable 'test' for b-1.0... +Building executable 'test' for b-1.0... [1 of 2] Compiling B ( B.hs, dist/build/test/test-tmp/B.o ) [A package changed] [3 of 3] Linking dist/build/test/test [Objects changed] "2.0" ===================================== testsuite/tests/ghci/should_run/T16096.stdout ===================================== @@ -1,6 +1,6 @@ ==================== Desugared ==================== -letrec { +let { x :: [GHC.Types.Int] [LclId] x = let { @@ -11,7 +11,7 @@ letrec { x :: [GHC.Types.Int] [LclId] x = GHC.Enum.enumFrom @GHC.Types.Int $dEnum (GHC.Types.I# 1#); } in - x; } in + x } in GHC.Base.returnIO @[GHC.Types.Any] (GHC.Types.: @@ -27,7 +27,7 @@ GHC.Base.returnIO ==================== Desugared ==================== -letrec { +let { x :: [GHC.Types.Int] [LclId] x = let { @@ -38,7 +38,7 @@ letrec { x :: [GHC.Types.Int] [LclId] x = GHC.Enum.enumFrom @GHC.Types.Int $dEnum (GHC.Types.I# 1#); } in - x; } in + x } in GHC.Base.returnIO @[GHC.Types.Any] (GHC.Types.: ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr ===================================== @@ -18,6 +18,7 @@ RecordDotSyntaxFail8.hs:37:3: error: [GHC-39999] RecordDotSyntaxFail8.hs:37:11: error: [GHC-39999] • No instance for ‘HasField "quux" Quux a0’ arising from selecting the field ‘quux’ + NB: There is no field selector ‘quux :: Quux -> a0’ in scope for record type ‘Quux’ • In the second argument of ‘($)’, namely ‘....baz.quux’ In a stmt of a 'do' block: print $ ....baz.quux In the expression: ===================================== testsuite/tests/perf/compiler/all.T ===================================== @@ -658,7 +658,7 @@ test('T21839c', ['-O']) test ('InfiniteListFusion', - [collect_stats('bytes allocated',2), when(wordsize(32), skip), js_broken(22576)], + [collect_stats('bytes allocated',2), when(wordsize(32), skip)], compile_and_run, ['-O2 -package ghc']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/46f5ae932d6a1aea8ce0bb510314caee5033a922...ab375d314e0c559d7fa3f739ae3bbd14dd141f22 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/46f5ae932d6a1aea8ce0bb510314caee5033a922...ab375d314e0c559d7fa3f739ae3bbd14dd141f22 You're receiving 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 Jun 20 11:41:00 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 20 Jun 2023 07:41:00 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 6 commits: Fixes Message-ID: <6491904c50b95_be462f1c2dc04813c3@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 87c9832e by Rodrigo Mesquita at 2023-06-20T12:09:49+01:00 Fixes - - - - - aab272d5 by Rodrigo Mesquita at 2023-06-20T12:09:49+01:00 ghc-toolchain: Fix check for gold bug - - - - - 7c2492b9 by Rodrigo Mesquita at 2023-06-20T12:09:49+01:00 ghc-toolchain: set CC LD plat. dependent flags A lot to be said about this approach, we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? - - - - - 294f77f9 by Rodrigo Mesquita at 2023-06-20T12:09:49+01:00 Configure -Wl,--no-as-needed - - - - - 5a25fede by Rodrigo Mesquita at 2023-06-20T12:09:49+01:00 ghc-toolchain: configure linker options correctly - - - - - d179661e by Rodrigo Mesquita at 2023-06-20T12:40:48+01:00 Revert LLVMTarget deletion in mkprojectmkin - - - - - 8 changed files: - distrib/configure.ac.in - + m4/fp_link_supports_no_as_needed.m4 - m4/fptools_set_c_ld_flags.m4 - mk/project.mk.in - utils/ghc-toolchain/src/GHC/Toolchain/Lens.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/MergeObjs.hs Changes: ===================================== distrib/configure.ac.in ===================================== @@ -286,6 +286,7 @@ AC_SUBST(UseLibdw) FP_SETTINGS AC_CONFIG_FILES([config.mk]) +#ROMES:TODO AC_CONFIG_FILES([default.target]) AC_OUTPUT # We get caught by ===================================== m4/fp_link_supports_no_as_needed.m4 ===================================== @@ -0,0 +1,22 @@ +# FP_LINK_SUPPORTS_NO_AS_NEEDED +# ---------------------------------- +# Set the Cc linker flag -Wl,--no-as-needed if it is supported +# $1 is the name of the linker flags variable when linking with gcc +# See also Note [ELF needed shared libs] +AC_DEFUN([FP_LINK_SUPPORTS_NO_AS_NEEDED], +[ + AC_MSG_CHECKING([whether Cc linker supports -Wl,--no-as-needed]) + echo 'int f(int a) {return 2*a;}' > conftest.a.c + echo 'int f(int a); int main(int argc, char **argv) {return f(0);}' > conftest.b.c + $CC -o conftest.a.o conftest.a.c + $CC -o conftest.b.o conftest.b.c + if $CC $$1 -Wl,--no-as-needed -o conftest conftest.a.o conftest.b.o > /dev/null 2>&1 + then + $1="$$1 -Wl,--no-as-needed" + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + fi + rm -f conftest* +]) + ===================================== m4/fptools_set_c_ld_flags.m4 ===================================== @@ -17,6 +17,12 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS], ;; esac + case $$1 in + *-linux) + FP_LINK_SUPPORTS_NO_AS_NEEDED([$3]) + ;; + esac + case $$1 in i386-unknown-mingw32) $2="$$2 -march=i686" ===================================== mk/project.mk.in ===================================== @@ -94,6 +94,7 @@ TargetPlatform_CPP = @TargetPlatform_CPP@ TargetArch_CPP = @TargetArch_CPP@ TargetOS_CPP = @TargetOS_CPP@ TargetVendor_CPP = @TargetVendor_CPP@ +LLVMTarget_CPP = @LLVMTarget_CPP@ BuildPlatform_CPP = @BuildPlatform_CPP@ BuildArch_CPP = @BuildArch_CPP@ ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Lens.hs ===================================== @@ -3,9 +3,12 @@ module GHC.Toolchain.Lens ( Lens(..) , (%) , over + , (%++) + , (&) ) where -import Prelude ((.), ($)) +import Prelude ((.), ($), (++)) +import Data.Function ((&)) data Lens a b = Lens { view :: (a -> b), set :: (b -> a -> a) } @@ -17,3 +20,11 @@ a % b = Lens { view = view b . view a over :: Lens a b -> (b -> b) -> a -> a over l f x = set l (f $ view l x) x +-- | Append @b@ to @[b]@ +-- +-- Example usage: +-- @@ +-- cc & _ccProgram % _prgFlags %++ "-U__i686" +-- @@ +(%++) :: Lens a [b] -> b -> (a -> a) +(%++) l el = over l (++[el]) ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ViewPatterns #-} module GHC.Toolchain.Tools.Cc ( Cc(..) @@ -28,6 +29,9 @@ newtype Cc = Cc { ccProgram :: Program _ccProgram :: Lens Cc Program _ccProgram = Lens ccProgram (\x o -> o{ccProgram=x}) +_ccFlags :: Lens Cc [String] +_ccFlags = _ccProgram % _prgFlags + findCc :: String -- ^ The llvm target to use if Cc supports --target -> ProgOpt -> M Cc findCc llvmTarget progOpt = checking "for C compiler" $ do @@ -57,10 +61,10 @@ checkCcWorks cc = withTempDir $ \dir -> do -- these. See #11684. ignoreUnusedArgs :: Cc -> M Cc ignoreUnusedArgs cc - | "-Qunused-arguments" `elem` (view (_ccProgram % _prgFlags) cc) = return cc + | "-Qunused-arguments" `elem` (view _ccFlags cc) = return cc | otherwise = checking "for -Qunused-arguments support" $ do - let cc' = over (_ccProgram % _prgFlags) (++["-Qunused-arguments"]) cc + let cc' = cc & _ccFlags %++ "-Qunused-arguments" (cc' <$ checkCcWorks cc') <|> return cc -- Does Cc support the --target= option? If so, we should pass it @@ -124,8 +128,51 @@ compileAsm = compile "S" ["-c"] _ccProgram -- | Add various platform-dependent compiler flags needed by GHC. We can't do -- this in `findCc` since we need a 'Cc` to determine the 'ArchOS'. addPlatformDepCcFlags :: ArchOS -> Cc -> M Cc -addPlatformDepCcFlags archOs cc - | OSMinGW32 <- archOS_OS archOs = do +addPlatformDepCcFlags archOs cc0 = do + let cc1 = addWorkaroundFor7799 archOs cc0 + cc2 <- addOSMinGW32CcFlags archOs cc1 + -- As per FPTOOLS_SET_C_LD_FLAGS + case archOs of + ArchOS ArchX86 OSMinGW32 -> + return $ cc2 & _ccFlags %++ "-march=i686" + ArchOS ArchX86 OSFreeBSD -> + return $ cc2 & _ccFlags %++ "-march=i686" + ArchOS ArchX86_64 OSSolaris2 -> + -- Solaris is a multi-lib platform, providing both 32- and 64-bit + -- user-land. It appears to default to 32-bit builds but we of course want to + -- compile for 64-bits on x86-64. + return $ cc2 & _ccFlags %++ "-m64" + ArchOS ArchAlpha _ -> + -- For now, to suppress the gcc warning "call-clobbered + -- register used for global register variable", we simply + -- disable all warnings altogether using the -w flag. Oh well. + return $ cc2 & over _ccFlags (++["-w","-mieee","-D_REENTRANT"]) + -- ArchOS ArchHPPA? _ -> + ArchOS ArchARM{} OSFreeBSD -> + -- On arm/freebsd, tell gcc to generate Arm + -- instructions (ie not Thumb). + return $ cc2 & _ccFlags %++ "-marm" + ArchOS ArchARM{} OSLinux -> + -- On arm/linux and arm/android, tell gcc to generate Arm + -- instructions (ie not Thumb). + return $ cc2 & _ccFlags %++ "-marm" + ArchOS ArchPPC OSAIX -> + -- We need `-D_THREAD_SAFE` to unlock the thread-local `errno`. + return $ cc2 & _ccFlags %++ "-D_THREAD_SAFE" + _ -> + return cc2 + + +-- | Workaround for #7799 +addWorkaroundFor7799 :: ArchOS -> Cc -> Cc +addWorkaroundFor7799 archOs cc + | ArchX86 <- archOS_arch archOs = cc & _ccFlags %++ "-U__i686" + | otherwise = cc + +-- | Adds flags specific to mingw32 +addOSMinGW32CcFlags :: ArchOS -> Cc -> M Cc +addOSMinGW32CcFlags archOs cc + | ArchOS _ OSMinGW32 <- archOs = do checkFStackCheck cc <|> throwE "Windows requires -fstack-check support yet the C compiler appears not to support it" | otherwise = return cc @@ -133,7 +180,7 @@ addPlatformDepCcFlags archOs cc -- See Note [Windows stack allocations]. checkFStackCheck :: Cc -> M Cc checkFStackCheck cc = withTempDir $ \dir -> checking "that -fstack-check works" $ do - let cc' = over (_ccProgram % _prgFlags) (++["-Wl,-fstack-checkzz"]) cc + let cc' = cc & _ccFlags %++ "-Wl,-fstack-checkzz" compileC cc' (dir "test.o") "int main(int argc, char **argv) { return 0; }" return cc' ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -128,16 +128,13 @@ checkSupportsNoPie ccLink = checking "whether the cc linker supports -no-pie" $ checkSupportsCompactUnwind :: Cc -> Program -> M Bool checkSupportsCompactUnwind cc ccLink = checking "whether the cc linker understands -no_compact_unwind" $ - -- ROMES:TODO: This returns False here but True in configure because in - -- configure we check for ld supports compact unwind, whereas here we check - -- for cclink supports compact unwind... what do we need it for? withTempDir $ \dir -> do let test_o = dir "test.o" test2_o = dir "test2.o" compileC cc test_o "int foo() { return 0; }" - exitCode <- runProgram ccLink ["-r", "-no_compact_unwind", "-o", test2_o, test_o] + exitCode <- runProgram ccLink ["-r", "-Wl,-no_compact_unwind", "-o", test2_o, test_o] return $ isSuccess exitCode checkSupportsFilelist :: Cc -> Program -> M Bool @@ -154,14 +151,12 @@ checkSupportsFilelist cc ccLink = checking "whether the cc linker understands -f -- write the filenames test1_o and test2_o to the test_ofiles file writeFile test_ofiles (unlines [test1_o,test2_o]) - exitCode <- runProgram ccLink ["-r", "-filelist", test_ofiles, "-o", test_o] + exitCode <- runProgram ccLink ["-r", "-Wl,-filelist", test_ofiles, "-o", test_o] return (isSuccess exitCode) checkSupportsResponseFiles :: Cc -> Program -> M Bool checkSupportsResponseFiles cc ccLink = checking "whether the cc linker supports response files" $ - -- ROMES:TODO: This returns True here while False in configure because in - -- configure we call -shared and -dylib on LD, whereas here we do it on CcLink withTempDir $ \dir -> do let test_o = dir "test.o" compileC cc test_o "int main(void) {return 0;}" @@ -170,6 +165,9 @@ checkSupportsResponseFiles cc ccLink = checking "whether the cc linker supports out = dir "test" writeFile args_txt (unlines ["-o", out, test_o]) + -- ROMES:TODO: Should we run this with -Wl? + -- In clang, -shared seems to exist as an argument to cc but not to -Wl, + -- while -dylib works for both -- TODO: It'd be good to shortcircuit this logical `or` exitCode1 <- runProgram ccLink ["-shared", "@"++args_txt] exitCode2 <- runProgram ccLink ["-dylib", "@"++args_txt] @@ -189,7 +187,7 @@ checkLinkWorks cc ccLink = withTempDir $ \dir -> do checkLinkIsGnu :: Program -> M Bool checkLinkIsGnu ccLink = do - out <- readProgramStdout ccLink ["--version"] + out <- readProgramStdout ccLink ["-Wl,--version"] return ("GNU" `isInfixOf` out) -- | Check for binutils bug #16177 present in some versions of the bfd ld @@ -260,13 +258,52 @@ The flag is only needed on ELF systems. On Windows (PE) and Mac OS X -- | Add various platform-dependent flags needed for reliable linking. addPlatformDepLinkFlags :: ArchOS -> Cc -> Program -> M Program -addPlatformDepLinkFlags archOs cc ccLink +addPlatformDepLinkFlags archOs cc ccLink0 = do + ccLink1 <- addNoAsNeeded archOs cc ccLink0 + -- As per FPTOOLS_SET_C_LD_FLAGS + case archOs of + -- ROMES:TODO: Consider dropping this alongside other configuration for solaris that was dropped + ArchOS ArchX86_64 OSSolaris2 -> + -- Solaris is a multi-lib platform, providing both 32- and 64-bit + -- user-land. It appears to default to 32-bit builds but we of course want to + -- compile for 64-bits on x86-64. + -- + -- On OpenSolaris uses gnu ld whereas SmartOS appears to use the Solaris + -- implementation, which rather uses the -64 flag. + return $ ccLink1 & _prgFlags %++ "-m64" + ArchOS ArchAlpha _ -> + -- For now, to suppress the gcc warning "call-clobbered + -- register used for global register variable", we simply + -- disable all warnings altogether using the -w flag. Oh well. + return $ ccLink1 & over _prgFlags (++["-w","-mieee","-D_REENTRANT"]) + -- ArchOS ArchHPPA? _ -> + ArchOS ArchARM{} OSFreeBSD -> + -- On arm/freebsd, tell gcc to generate Arm + -- instructions (ie not Thumb). + return $ ccLink1 & _prgFlags %++ "-Wl,-z,noexecstack" + ArchOS ArchARM{} OSLinux -> + -- On arm/linux and arm/android, tell gcc to generate Arm + -- instructions (ie not Thumb). + return $ ccLink1 & _prgFlags %++ "-Wl,-z,noexecstack" + ArchOS ArchAArch64 OSFreeBSD -> + return $ ccLink1 & _prgFlags %++ "-Wl,-z,noexecstack" + ArchOS ArchAArch64 OSLinux -> + return $ ccLink1 & _prgFlags %++ "-Wl,-z,noexecstack" + ArchOS ArchAArch64 OSNetBSD -> + return $ ccLink1 & _prgFlags %++ "-Wl,-z,noexecstack" + ArchOS ArchPPC OSAIX -> + -- We need `-D_THREAD_SAFE` to unlock the thread-local `errno`. + return $ ccLink1 & over _prgFlags (++["-D_THREAD_SAFE","-Wl,-bnotextro"]) + _ -> + return ccLink1 + +-- | See Note [ELF needed shared libs] +addNoAsNeeded :: ArchOS -> Cc -> Program -> M Program +addNoAsNeeded archOs cc ccLink | OSLinux <- archOS_OS archOs = checking "that --no-as-needed works" $ do - -- | See Note [ELF needed shared libs] let ccLink' = over _prgFlags (++["-Wl,--no-as-needed"]) ccLink checkLinkWorks cc ccLink' return ccLink' - | otherwise = return ccLink -- See if whether we are using a version of ld64 on darwin platforms which ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/MergeObjs.hs ===================================== @@ -4,10 +4,8 @@ module GHC.Toolchain.Tools.MergeObjs ( MergeObjs(..), findMergeObjs ) where import Control.Monad -import Control.Monad.IO.Class import Data.List import System.FilePath -import System.Process import GHC.Toolchain.Prelude import GHC.Toolchain.Utils @@ -23,7 +21,7 @@ newtype MergeObjs = MergeObjs { mergeObjsProgram :: Program findMergeObjs :: ProgOpt -> Cc -> CcLink -> Nm -> M MergeObjs findMergeObjs progOpt cc ccLink nm = checking "for linker for merging objects" $ do - prog <- findProgram "linker for merging objects" progOpt ["ld"] + prog <- findProgram "linker for merging objects" progOpt ["ld.gold", "ld"] let mo = MergeObjs $ over _prgFlags (++["-r"]) prog checkMergingWorks cc nm mo checkForGoldT22266 cc ccLink mo @@ -63,11 +61,11 @@ checkForGoldT22266 cc ccLink mergeObjs = do compileC cc a_o progA writeFile link_script ldScript callProgram (mergeObjsProgram mergeObjs) - ["-T", link_script, "-o", merged_o] + ["-T", link_script, a_o, "-o", merged_o] compileC cc main_o progMain callProgram (ccLinkProgram ccLink) ["-o", exe, merged_o, main_o] - liftIO $ callProcess exe [] + callProgram (Program exe []) [] progA = unlines [ "__attribute__((section(\".data.a\")))" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eb5f75b94d6ef12e096f8be75a74dc6da7ad27b1...d179661ef6c07326c7c811376371065bbb9351b4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eb5f75b94d6ef12e096f8be75a74dc6da7ad27b1...d179661ef6c07326c7c811376371065bbb9351b4 You're receiving 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 Jun 20 12:46:11 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 20 Jun 2023 08:46:11 -0400 Subject: [Git][ghc/ghc][wip/tsan/fixes-2] 18 commits: rts: Fix data race in CHECK_GC Message-ID: <64919f9368e41_be46226b7d1dc487299@gitlab.mail> Ben Gamari pushed to branch wip/tsan/fixes-2 at Glasgow Haskell Compiler / GHC Commits: 8d96dbd0 by Ben Gamari at 2023-06-20T08:46:03-04:00 rts: Fix data race in CHECK_GC - - - - - fa2d7ece by Ben Gamari at 2023-06-20T08:46:03-04:00 base: use atomic write when updating timer manager - - - - - 8f61117e by Ben Gamari at 2023-06-20T08:46:03-04:00 Use relaxed atomics to manipulate TSO status fields - - - - - b94b1578 by Ben Gamari at 2023-06-20T08:46:03-04:00 rts: Add necessary barriers when manipulating TSO owner - - - - - 9b6e128f by Ben Gamari at 2023-06-20T08:46:03-04:00 rts: Fix synchronization on thread blocking state - - - - - cc4c72c6 by Ben Gamari at 2023-06-20T08:46:03-04:00 rts: Relaxed load MutVar info table - - - - - d8aaca20 by Ben Gamari at 2023-06-20T08:46:03-04:00 hadrian: More debug information - - - - - 4d433891 by Ben Gamari at 2023-06-20T08:46:03-04:00 hadrian: More selective TSAN instrumentation - - - - - 25811415 by Ben Gamari at 2023-06-20T08:46:03-04:00 codeGen/tsan: Rework handling of spilling - - - - - 117cdf4a by Ben Gamari at 2023-06-20T08:46:03-04:00 codeGen: Ensure that TSAN is aware of writeArray# write barriers - - - - - c4e038ab by Ben Gamari at 2023-06-20T08:46:04-04:00 codeGen: Ensure that array reads have necessary barriers This was the cause of #23541. - - - - - eada1f19 by Ben Gamari at 2023-06-20T08:46:04-04:00 Wordsmith TSAN Note - - - - - 13f259b9 by Ben Gamari at 2023-06-20T08:46:04-04:00 codeGen: Use relaxed accesses in ticky bumping - - - - - dd9364aa by Ben Gamari at 2023-06-20T08:46:04-04:00 codeGen: Use relaxed-read in closureInfoPtr - - - - - b7aecf4d by Ben Gamari at 2023-06-20T08:46:04-04:00 Fix thunk update ordering Previously we attempted to ensure soundness of concurrent thunk update by synchronizing on the access of the thunk's info table pointer field. This was believed to be sufficient since the indirectee (which may expose a closure allocated by another core) would not be examined until the info table pointer update is complete. However, it turns out that this can result in data races in the presence of multiple threads racing a update a single thunk. For instance, consider this interleaving under the old scheme: Thread A Thread B --------- --------- t=0 Enter t 1 Push update frame 2 Begin evaluation 4 Pause thread 5 t.indirectee=tso 6 Release t.info=BLACKHOLE 7 ... (e.g. GC) 8 Resume thread 9 Finish evaluation 10 Relaxed t.indirectee=x 11 Load t.info 12 Acquire fence 13 Inspect t.indirectee 14 Release t.info=BLACKHOLE Here Thread A enters thunk `t` but is soon paused, resulting in `t` being lazily blackholed at t=6. Then, at t=10 Thread A finishes evaluation and updates `t.indirectee` with a relaxed store. Meanwhile, Thread B enters the blackhole. Under the old scheme this would introduce an acquire-fence but this would only synchronize with Thread A at t=6. Consequently, the result of the evaluation, `x`, is not visible to Thread B, introducing a data race. We fix this by treating the `indirectee` field as we do all other mutable fields. This means we must always access this field with acquire-loads and release-stores. See #23185. - - - - - cb8ee074 by Ben Gamari at 2023-06-20T08:46:04-04:00 STM: Use acquire loads when possible Full sequential consistency is not needed here. - - - - - 5e918451 by Ubuntu at 2023-06-20T08:46:04-04:00 ghc-prim: Use C11 atomics - - - - - a382b0bf by Ubuntu at 2023-06-20T08:46:04-04:00 Run script - - - - - 30 changed files: - compiler/GHC/Cmm/Info.hs - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/StgToCmm/Utils.hs - hadrian/src/Flavour.hs - libraries/base/GHC/Event/Thread.hs - libraries/ghc-prim/cbits/atomic.c - rts/Apply.cmm - rts/Compact.cmm - rts/Exception.cmm - rts/Heap.c - rts/HeapStackCheck.cmm - rts/Interpreter.c - rts/Messages.c - rts/PrimOps.cmm - rts/RaiseAsync.c - rts/STM.c - rts/Schedule.c - rts/StableName.c - rts/StgMiscClosures.cmm - rts/StgStartup.cmm - rts/ThreadPaused.c - rts/Threads.c - rts/TraverseHeap.c - rts/Updates.cmm - rts/Updates.h - rts/include/Cmm.h - rts/include/rts/storage/ClosureMacros.h The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e485e238e2ae4a9e9a9b6124613d1d43ad523725...a382b0bf1073f01799a5d482dca0ca81404e61da -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e485e238e2ae4a9e9a9b6124613d1d43ad523725...a382b0bf1073f01799a5d482dca0ca81404e61da You're receiving 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 Jun 20 13:50:05 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 20 Jun 2023 09:50:05 -0400 Subject: [Git][ghc/ghc][wip/T23210] 2 commits: StgToByteCode: Don't assume that data con workers are nullary Message-ID: <6491ae8da98f7_be46226f41f5c50833a@gitlab.mail> Ben Gamari pushed to branch wip/T23210 at Glasgow Haskell Compiler / GHC Commits: 72eb03c0 by Ben Gamari at 2023-06-20T09:50:00-04:00 StgToByteCode: Don't assume that data con workers are nullary Previously StgToByteCode assumed that all data-con workers were of a nullary representation. This is not a valid assumption, as seen in #23210, where an unsaturated application of a unary data constructor's worker resulted in invalid bytecode. Sadly, I have not yet been able to reduce a minimal testcase for this. Fixes #23210. - - - - - 91fd4708 by Ben Gamari at 2023-06-20T09:50:00-04:00 StgToByteCode: Fix handling of Addr# literals Previously we assumed that all unlifted types were Addr#. - - - - - 3 changed files: - compiler/GHC/Stg/Utils.hs - compiler/GHC/StgToByteCode.hs - rts/Interpreter.c Changes: ===================================== compiler/GHC/Stg/Utils.hs ===================================== @@ -9,6 +9,7 @@ module GHC.Stg.Utils , idArgs , mkUnarisedId, mkUnarisedIds + , hasNoNonZeroWidthArgs ) where import GHC.Prelude @@ -16,6 +17,7 @@ import GHC.Prelude import GHC.Types.Id import GHC.Core.Type import GHC.Core.TyCon +import GHC.Core.Multiplicity ( scaledThing ) import GHC.Core.DataCon import GHC.Core ( AltCon(..) ) import GHC.Types.Tickish @@ -31,6 +33,13 @@ import GHC.Utils.Panic import GHC.Data.FastString +-- | Returns whether there are any arguments with a non-zero-width runtime +-- representation. +-- +-- Returns True if the datacon has no or /just/ zero-width arguments. +hasNoNonZeroWidthArgs :: DataCon -> Bool +hasNoNonZeroWidthArgs = all (isZeroBitTy . scaledThing) . dataConRepArgTys + mkUnarisedIds :: MonadUnique m => FastString -> [UnaryType] -> m [Id] mkUnarisedIds fs tys = mapM (mkUnarisedId fs) tys ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -1821,20 +1821,18 @@ pushAtom d p (StgVarArg var) -- PUSH_G doesn't tag constructors. So we use PACK here -- if we are dealing with nullary constructor. case isDataConWorkId_maybe var of - Just con -> do - massert (isNullaryRepDataCon con) - return (unitOL (PACK con 0), szb) + Just con + -- See Note [LFInfo of DataCon workers and wrappers] in GHC.Types.Id.Make. + | isNullaryRepDataCon con -> do + return (unitOL (PACK con 0), szb) - Nothing -- see Note [Generating code for top-level string literal bindings] - | isUnliftedType (idType var) -> do - massert (idType var `eqType` addrPrimTy) + _ | idType var `eqType` addrPrimTy -> return (unitOL (PUSH_ADDR (getName var)), szb) | otherwise -> do return (unitOL (PUSH_G (getName var)), szb) - pushAtom _ _ (StgLitArg lit) = pushLiteral True lit pushLiteral :: Bool -> Literal -> BcM (BCInstrList, ByteOff) ===================================== rts/Interpreter.c ===================================== @@ -1687,7 +1687,6 @@ run_BCO: // n_nptrs=1, n_ptrs=0. ASSERT(n_ptrs + n_nptrs == n_words || (n_nptrs == 1 && n_ptrs == 0)); ASSERT(n_ptrs + n_nptrs > 0); - //ASSERT(n_words > 0); // We shouldn't ever need to allocate nullary constructors for (int i = 0; i < n_words; i++) { con->payload[i] = (StgClosure*)SpW(i); } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3a3bf8288bce175e210091e18a7f4407e073aea4...91fd470830308a9c66358f5bd00a1b8ffa549824 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3a3bf8288bce175e210091e18a7f4407e073aea4...91fd470830308a9c66358f5bd00a1b8ffa549824 You're receiving 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 Jun 20 15:05:55 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 20 Jun 2023 11:05:55 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 13 commits: rts/ipe: Fix unused lock warning Message-ID: <6491c053b0252_be46229308a6c561722@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 70bffd8e by Ben Gamari at 2023-06-20T11:05:41-04:00 rts/ipe: Fix unused lock warning - - - - - 6594b76b by Ben Gamari at 2023-06-20T11:05:41-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 31060eea by Ben Gamari at 2023-06-20T11:05:41-04:00 rts: Various warnings fixes - - - - - cc5d72bc by Ben Gamari at 2023-06-20T11:05:41-04:00 rts: Fix printf format mismatch - - - - - b7db3dcb by Ben Gamari at 2023-06-20T11:05:41-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - 026e430b by Ben Gamari at 2023-06-20T11:05:41-04:00 nonmoving: Fix unused definition warrnings - - - - - 014a7279 by Ben Gamari at 2023-06-20T11:05:41-04:00 Disable futimens on Darwin. See #22938 - - - - - f63996d8 by Ben Gamari at 2023-06-20T11:05:41-04:00 rts: Fix incorrect CPP guard - - - - - c2eaba6a by Ben Gamari at 2023-06-20T11:05:41-04: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. - - - - - ec1fe0e6 by Ben Gamari at 2023-06-20T11:05:42-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - a5c6ac72 by Ben Gamari at 2023-06-20T11:05:42-04:00 rts: Fix capitalization of prototype - - - - - 47d0eac3 by Ben Gamari at 2023-06-20T11:05:42-04:00 rts: Fix incorrect format specifier - - - - - 2f514203 by Josh Meredith at 2023-06-20T11:05:47-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 15 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - hadrian/src/Flavour.hs - rts/Hash.c - rts/IPE.c - rts/ProfilerReportJson.c - rts/Threads.c - rts/adjustor/LibffiAdjustor.c - rts/eventlog/EventLog.c - rts/include/rts/storage/ClosureMacros.h - rts/posix/Ticker.c - rts/posix/ticker/Pthread.c - rts/posix/ticker/TimerFd.c - rts/sm/NonMovingMark.c - testsuite/tests/perf/compiler/all.T Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -409,6 +409,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" } }, @@ -2478,6 +2479,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" } }, @@ -3590,6 +3592,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 ===================================== @@ -123,16 +123,25 @@ addArgs args' fl = fl { extraArgs = extraArgs 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 ===================================== rts/Hash.c ===================================== @@ -18,11 +18,13 @@ since we compile these things these days with cabal we can no longer specify optimization per file. So we have to resort to pragmas. */ #if defined(__GNUC__) || defined(__GNUG__) +#if !defined(__clang__) #if !defined(DEBUG) #pragma GCC push_options #pragma GCC optimize ("O3") #endif #endif +#endif #define XXH_NAMESPACE __rts_ #define XXH_STATIC_LINKING_ONLY /* access advanced declarations */ @@ -565,7 +567,9 @@ int keyCountHashTable (HashTable *table) #if defined(__GNUC__) || defined(__GNUG__) +#if !defined(__clang__) #if !defined(DEBUG) #pragma GCC pop_options #endif #endif +#endif ===================================== rts/IPE.c ===================================== @@ -62,7 +62,10 @@ this all IPE lists of all IpeBufferListNode are traversed to insert all IPEs. After the content of a IpeBufferListNode has been inserted, it's freed. */ +#if defined(THREADED_RTS) static Mutex ipeMapLock; +#endif +// Protected by ipeMapLock static HashTable *ipeMap = NULL; // Accessed atomically ===================================== rts/ProfilerReportJson.c ===================================== @@ -52,11 +52,10 @@ static void escapeString(char const* str, char **buf) static void logCostCentres(FILE *prof_file) { - char* lbl; - char* src_loc; bool needs_comma = false; fprintf(prof_file, "[\n"); for (CostCentre *cc = CC_LIST; cc != NULL; cc = cc->link) { + char *lbl, *src_loc; escapeString(cc->label, &lbl); escapeString(cc->srcloc, &src_loc); fprintf(prof_file, @@ -70,10 +69,10 @@ logCostCentres(FILE *prof_file) cc->ccID, lbl, cc->module, src_loc, cc->is_caf ? "true" : "false"); needs_comma = true; + stgFree(lbl); + stgFree(src_loc); } fprintf(prof_file, "]\n"); - stgFree(lbl); - stgFree(src_loc); } static void ===================================== rts/Threads.c ===================================== @@ -1013,10 +1013,10 @@ printGlobalThreads(void) for (uint32_t g = 0; g < RtsFlags.GcFlags.generations; g++) { debugBelch("\ngen %d\n", g); for (StgTSO *t = generations[g].threads; t != END_TSO_QUEUE; t = t->global_link) { - debugBelch("thread %p (id=%lu)\n", t, t->id); + debugBelch("thread %p (id=%lu)\n", t, (unsigned long)t->id); } for (StgTSO *t = generations[g].old_threads; t != END_TSO_QUEUE; t = t->global_link) { - debugBelch("thread %p (id=%lu) (old)\n", t, t->id); + debugBelch("thread %p (id=%lu) (old)\n", t, (unsigned long)t->id); } } } ===================================== rts/adjustor/LibffiAdjustor.c ===================================== @@ -39,7 +39,7 @@ static AdjustorWritable allocate_adjustor(AdjustorExecutable *exec_ret, ffi_cif { AdjustorWritable writ; - ffi_status r = ffi_alloc_prep_closure(&writ, cif, wptr, hptr, exec_ret); + ffi_status r = ffi_alloc_prep_closure((ffi_closure **) &writ, cif, wptr, hptr, exec_ret); if (r != FFI_OK) barf("ffi_alloc_prep_closure failed: %d", r); ===================================== rts/eventlog/EventLog.c ===================================== @@ -759,8 +759,10 @@ void postCapsetVecEvent (EventTypeNum tag, // 1 + strlen to account for the trailing \0, used as separator int increment = 1 + strlen(argv[i]); if (size + increment > EVENT_PAYLOAD_SIZE_MAX) { - errorBelch("Event size exceeds EVENT_PAYLOAD_SIZE_MAX, record only " - "%d out of %d args", i, argc); + errorBelch("Event size exceeds EVENT_PAYLOAD_SIZE_MAX, record only %" + FMT_Word " out of %" FMT_Word " args", + (StgWord) i, + (StgWord) argc); argc = i; break; } else { ===================================== rts/include/rts/storage/ClosureMacros.h ===================================== @@ -623,7 +623,7 @@ INLINE_HEADER void overwritingMutableClosureOfs (StgClosure *p, uint32_t offset) } // Version of 'overwritingClosure' which takes closure size as argument. -void stg_OverwritingClosureSize (StgClosure *p, uint32_t size /* in words */); +void stg_overwritingClosureSize (StgClosure *p, uint32_t size /* in words */); INLINE_HEADER void overwritingClosureSize (StgClosure *p, uint32_t size) { // This function is only called from stg_AP_STACK so we can assume it's not ===================================== 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 ===================================== @@ -39,7 +39,7 @@ static void trace_PAP_payload (MarkQueue *queue, StgClosure *fun, StgClosure **payload, StgWord size); -static bool is_nonmoving_weak(StgWeak *weak); +static bool is_nonmoving_weak(StgWeak *weak) USED_IF_DEBUG; // How many Array# entries to add to the mark queue at once? #define MARK_ARRAY_CHUNK_LENGTH 128 @@ -974,7 +974,7 @@ static void nonmovingResetUpdRemSetQueue (MarkQueue *rset) rset->top->head = 0; } -void nonmovingResetUpdRemSet (UpdRemSet *rset) +static void nonmovingResetUpdRemSet (UpdRemSet *rset) { nonmovingResetUpdRemSetQueue(&rset->queue); } ===================================== testsuite/tests/perf/compiler/all.T ===================================== @@ -658,7 +658,7 @@ test('T21839c', ['-O']) test ('InfiniteListFusion', - [collect_stats('bytes allocated',2), when(wordsize(32), skip), js_broken(22576)], + [collect_stats('bytes allocated',2), when(wordsize(32), skip)], compile_and_run, ['-O2 -package ghc']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ab375d314e0c559d7fa3f739ae3bbd14dd141f22...2f514203eb5ae84cac62acbab3b0ef34b9a3e04b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ab375d314e0c559d7fa3f739ae3bbd14dd141f22...2f514203eb5ae84cac62acbab3b0ef34b9a3e04b You're receiving 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 Jun 20 16:12:54 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Tue, 20 Jun 2023 12:12:54 -0400 Subject: [Git][ghc/ghc][wip/T22010] Fix the Word64Map/Set issue Message-ID: <6491d0064bf65_be462270bd9e459644a@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 48dffdf3 by Jaro Reinders at 2023-06-20T18:12:42+02:00 Fix the Word64Map/Set issue - - - - - 1 changed file: - compiler/GHC/Utils/Containers/Internal/BitUtil.hs Changes: ===================================== compiler/GHC/Utils/Containers/Internal/BitUtil.hs ===================================== @@ -35,11 +35,10 @@ module GHC.Utils.Containers.Internal.BitUtil , highestBitMask , shiftLL , shiftRL - , wordSize ) where import Data.Bits (popCount, unsafeShiftL, unsafeShiftR - , countLeadingZeros, finiteBitSize + , countLeadingZeros ) import Prelude import Data.Word @@ -66,14 +65,10 @@ bitcount a x = a + popCount x -- | Return a word where only the highest bit is set. highestBitMask :: Word64 -> Word64 -highestBitMask w = shiftLL 1 (wordSize - 1 - countLeadingZeros w) +highestBitMask w = shiftLL 1 (63 - countLeadingZeros w) {-# INLINE highestBitMask #-} -- Right and left logical shifts. shiftRL, shiftLL :: Word64 -> Int -> Word64 shiftRL = unsafeShiftR -shiftLL = unsafeShiftL - -{-# INLINE wordSize #-} -wordSize :: Int -wordSize = finiteBitSize (0 :: Word) +shiftLL = unsafeShiftL \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/48dffdf3e63e0a1c40fda21dc37cdbf4cae8c2a6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/48dffdf3e63e0a1c40fda21dc37cdbf4cae8c2a6 You're receiving 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 Jun 20 18:19:24 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 20 Jun 2023 14:19:24 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 5 commits: Fix stack job Message-ID: <6491edac307e9_be462270bd9e4604980@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 12216ec3 by Rodrigo Mesquita at 2023-06-20T15:11:15+01:00 Fix stack job - - - - - 6131a50e by Rodrigo Mesquita at 2023-06-20T18:36:13+01:00 ghc-toolchain: Create default.target in the bindist - - - - - 5272b0d0 by Rodrigo Mesquita at 2023-06-20T18:37:42+01:00 Part of -Wl,--no-as-needed saga - - - - - 361f9bc9 by Rodrigo Mesquita at 2023-06-20T19:10:28+01:00 Support more targets and dont use llvmtarget - - - - - aebdaeb0 by Rodrigo Mesquita at 2023-06-20T19:10:45+01:00 fixup! Part of -Wl,--no-as-needed saga - - - - - 9 changed files: - distrib/configure.ac.in - hadrian/bindist/config.mk.in - hadrian/src/Rules/BinaryDist.hs - hadrian/stack.yaml - m4/fptools_set_c_ld_flags.m4 - m4/ghc_toolchain.m4 - utils/ghc-toolchain/Main.hs - utils/ghc-toolchain/src/GHC/Toolchain/ParseTriple.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs Changes: ===================================== distrib/configure.ac.in ===================================== @@ -286,7 +286,7 @@ AC_SUBST(UseLibdw) FP_SETTINGS AC_CONFIG_FILES([config.mk]) -#ROMES:TODO AC_CONFIG_FILES([default.target]) +AC_CONFIG_FILES([default.target]) AC_OUTPUT # We get caught by ===================================== hadrian/bindist/config.mk.in ===================================== @@ -255,6 +255,8 @@ TargetHasIdentDirective = @TargetHasIdentDirective@ TargetHasSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbols@ TargetHasLibm = @TargetHasLibm@ TablesNextToCode = @TablesNextToCode@ +LeadingUnderscore = @LeadingUnderscore@ +LlvmTarget = @LlvmTarget@ SettingsCCompilerCommand = @SettingsCCompilerCommand@ SettingsCxxCompilerCommand = @SettingsCxxCompilerCommand@ ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -258,6 +258,7 @@ bindistRules = do need $ map (bindistFilesDir -/-) (["configure", "Makefile"] ++ bindistInstallFiles) copyFile ("hadrian" -/- "bindist" -/- "config.mk.in") (bindistFilesDir -/- "config.mk.in") + copyFile ("default.target.in") (bindistFilesDir -/- "default.target.in") forM_ bin_targets $ \(pkg, _) -> do needed_wrappers <- pkgToWrappers pkg forM_ needed_wrappers $ \wrapper_name -> do ===================================== hadrian/stack.yaml ===================================== @@ -2,7 +2,7 @@ resolver: lts-19.8 packages: - '.' -- 'utils/ghc-toolchain' +- '../utils/ghc-toolchain' nix: enable: false ===================================== m4/fptools_set_c_ld_flags.m4 ===================================== @@ -17,8 +17,9 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS], ;; esac + -- ROMES:TODO: ELF, mention note case $$1 in - *-linux) + *-linux|*-freebsd*) FP_LINK_SUPPORTS_NO_AS_NEEDED([$3]) ;; esac ===================================== m4/ghc_toolchain.m4 ===================================== @@ -28,10 +28,9 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], utils/ghc-toolchain/Main.hs -o acghc-toolchain rm -f acargs - dnl TODO: LLVMTarget vs Target, which should go where? - dnl echo "--triple=$target" >> acargs - dnl For now, LlvmTarget matches the configure output. - echo "--triple=$LlvmTarget" >> acargs + + echo "--triple=$target" >> acargs + echo "--llvm-triple=$LlvmTarget" >> acargs # echo "--cc=$CC" >> acargs # ADD_GHC_TOOLCHAIN_ARG([cc-opt], [$CONF_CC_OPTS_STAGE1]) ===================================== utils/ghc-toolchain/Main.hs ===================================== @@ -5,7 +5,7 @@ module Main where import Control.Monad import Data.Char (toUpper) -import Data.Maybe (isNothing) +import Data.Maybe (isNothing,fromMaybe) import System.Exit import System.Console.GetOpt import System.Environment @@ -33,6 +33,7 @@ import GHC.Toolchain.Tools.Readelf data Opts = Opts { optTriple :: String , optTargetPrefix :: Maybe String + , optLlvmTriple :: Maybe String , optCc :: ProgOpt , optCxx :: ProgOpt , optCpp :: ProgOpt @@ -57,6 +58,7 @@ emptyOpts :: Opts emptyOpts = Opts { optTriple = "" , optTargetPrefix = Nothing + , optLlvmTriple = Nothing , optCc = po0 , optCxx = po0 , optCpp = po0 @@ -98,6 +100,9 @@ _optWindres = Lens optWindres (\x o -> o {optWindres=x}) _optTriple :: Lens Opts String _optTriple = Lens optTriple (\x o -> o {optTriple=x}) +_optLlvmTriple :: Lens Opts (Maybe String) +_optLlvmTriple = Lens optLlvmTriple (\x o -> o {optLlvmTriple=x}) + _optTargetPrefix :: Lens Opts (Maybe String) _optTargetPrefix = Lens optTargetPrefix (\x o -> o {optTargetPrefix=x}) @@ -123,6 +128,7 @@ options :: [OptDescr (Opts -> Opts)] options = [ tripleOpt , targetPrefixOpt + , llvmTripleOpt , verbosityOpt , keepTempOpt ] ++ @@ -174,6 +180,7 @@ options = ] tripleOpt = Option ['t'] ["triple"] (ReqArg (set _optTriple) "TRIPLE") "Target triple" + llvmTripleOpt = Option [] ["llvm-triple"] (ReqArg (set _optLlvmTriple . Just) "LLVMTRIPLE") "LLVM Target triple" targetPrefixOpt = Option ['T'] ["target-prefix"] (ReqArg (set _optTargetPrefix . Just) "PREFIX") "A target prefix which will be added to all tool names when searching for toolchain components" @@ -297,7 +304,8 @@ archHasNativeAdjustors = \case mkTarget :: Opts -> M Target mkTarget opts = do - let tgtLlvmTarget = optTriple opts + -- Use Llvm target if specified, otherwise use triple as llvm target + let tgtLlvmTarget = fromMaybe (optTriple opts) (optLlvmTriple opts) cc0 <- findCc tgtLlvmTarget (optCc opts) cxx <- findCxx tgtLlvmTarget (optCxx opts) cpp <- findCpp (optCpp opts) cc0 ===================================== utils/ghc-toolchain/src/GHC/Toolchain/ParseTriple.hs ===================================== @@ -38,7 +38,7 @@ parseArch cc arch = "s390x" -> pure ArchS390X "arm" -> findArmIsa cc _ | "armv" `isPrefixOf` arch -> findArmIsa cc - "arm64" -> pure ArchAArch64 -- TODO Should we support this alias or does this cause confusion? + "arm64" -> pure ArchAArch64 "aarch64" -> pure ArchAArch64 "alpha" -> pure ArchAlpha "mips" -> pure ArchMipseb @@ -46,6 +46,7 @@ parseArch cc arch = "mipsel" -> pure ArchMipsel "riscv64" -> pure ArchRISCV64 "hppa" -> pure ArchUnknown + "wasm32" -> pure ArchWasm32 _ -> throwE $ "Unknown architecture " ++ arch parseOs :: String -> String -> M OS @@ -68,6 +69,7 @@ parseOs vendor os = "nto-qnc" -> pure OSQNXNTO "aix" -> pure OSAIX "gnu" -> pure OSHurd + "wasi" -> pure OSWasi _ -> throwE $ "Unknown vendor/operating system " ++ vendor ++ "-" ++ os splitOn :: Char -> String -> [String] ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -126,6 +126,11 @@ checkSupportsNoPie ccLink = checking "whether the cc linker supports -no-pie" $ (code, out, _err) <- readProgram ccLink ["-no-pie", "-Werror", "-x", "c", test_c, "-o", test] return (isSuccess code && not ("unrecognized" `isInfixOf` out)) +-- ROMES:TODO: This check is wrong here and in configure because with ld.gold parses "-n" "o_compact_unwind" +-- TODO: +-- * Check if compiling for darwin +-- * Then do the check +-- * Otherwise say its just not supported checkSupportsCompactUnwind :: Cc -> Program -> M Bool checkSupportsCompactUnwind cc ccLink = checking "whether the cc linker understands -no_compact_unwind" $ withTempDir $ \dir -> do @@ -155,6 +160,7 @@ checkSupportsFilelist cc ccLink = checking "whether the cc linker understands -f return (isSuccess exitCode) +-- ROMES:TODO: Move to MergeTools, don't use neither of these, check that merging works with the @args.txt checkSupportsResponseFiles :: Cc -> Program -> M Bool checkSupportsResponseFiles cc ccLink = checking "whether the cc linker supports response files" $ withTempDir $ \dir -> do View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d179661ef6c07326c7c811376371065bbb9351b4...aebdaeb0f77e4f561ebdb19d4567bae20f608f98 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d179661ef6c07326c7c811376371065bbb9351b4...aebdaeb0f77e4f561ebdb19d4567bae20f608f98 You're receiving 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 Jun 20 18:24:23 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 20 Jun 2023 14:24:23 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] allow duplos in place of triples Message-ID: <6491eed7e1c5c_be4622c31082c6053a6@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 750061ce by Rodrigo Mesquita at 2023-06-20T19:24:17+01:00 allow duplos in place of triples - - - - - 2 changed files: - utils/ghc-toolchain/src/GHC/Toolchain/ParseTriple.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs Changes: ===================================== utils/ghc-toolchain/src/GHC/Toolchain/ParseTriple.hs ===================================== @@ -9,17 +9,21 @@ import GHC.Toolchain.CheckArm import GHC.Toolchain.Tools.Cc -- | Parse a triple `arch-vendor-os` into an 'ArchOS' and a vendor name 'String' -parseTriple :: Cc -> String -> M (ArchOS, String) +parseTriple :: Cc -> String -> M (ArchOS, Maybe String) parseTriple cc triple + | [archName, osName] <- parts + = do arch <- parseArch cc archName + os <- parseOs osName + return (ArchOS arch os, Nothing) | [archName, vendorName, osName] <- parts = do arch <- parseArch cc archName - os <- parseOs vendorName osName - return $ (ArchOS arch os, vendorName) + os <- parseOs osName + return (ArchOS arch os, Just vendorName) | [archName, vendorName, osName, _abi] <- parts = do arch <- parseArch cc archName - os <- parseOs vendorName osName - return $ (ArchOS arch os, vendorName) + os <- parseOs osName + return (ArchOS arch os, Just vendorName) | otherwise = throwE $ "malformed triple " ++ triple @@ -49,8 +53,8 @@ parseArch cc arch = "wasm32" -> pure ArchWasm32 _ -> throwE $ "Unknown architecture " ++ arch -parseOs :: String -> String -> M OS -parseOs vendor os = +parseOs :: String -> M OS +parseOs os = case os of "linux" -> pure OSLinux "linux-android" -> pure OSLinux @@ -70,7 +74,7 @@ parseOs vendor os = "aix" -> pure OSAIX "gnu" -> pure OSHurd "wasi" -> pure OSWasi - _ -> throwE $ "Unknown vendor/operating system " ++ vendor ++ "-" ++ os + _ -> throwE $ "Unknown operating system " ++ os splitOn :: Char -> String -> [String] splitOn sep = go ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs ===================================== @@ -31,7 +31,7 @@ instance Show Ar where , "}" ] -findAr :: String -- ^ Vendor name from the target triple +findAr :: Maybe String -- ^ Vendor name from the target triple, if specified -> ProgOpt -> M Ar findAr vendor progOpt = checking "for 'ar'" $ do bareAr <- findProgram "ar archiver" progOpt ["ar"] @@ -48,7 +48,7 @@ findAr vendor progOpt = checking "for 'ar'" $ do -- TODO: It'd be better not to handle Apple specifically here? -- It's quite tedious to check for Apple's crazy timestamps in -- .a files, so we hardcode it. - | vendor == "apple" = True + | vendor == Just "apple" = True | mode:_ <- prgFlags mkArchive , 's' `elem` mode = False | otherwise = True View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/750061ce178ffa949f369c4f805c674b4c3a88b9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/750061ce178ffa949f369c4f805c674b4c3a88b9 You're receiving 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 Jun 20 18:26:45 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 20 Jun 2023 14:26:45 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 13 commits: rts/ipe: Fix unused lock warning Message-ID: <6491ef656ccf4_be462269778c460736b@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: ad2b4264 by Ben Gamari at 2023-06-20T14:26:31-04:00 rts/ipe: Fix unused lock warning - - - - - a5cf9ba3 by Ben Gamari at 2023-06-20T14:26:31-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 84820bdc by Ben Gamari at 2023-06-20T14:26:31-04:00 rts: Various warnings fixes - - - - - 76c76324 by Ben Gamari at 2023-06-20T14:26:31-04:00 rts: Fix printf format mismatch - - - - - 0153db5d by Ben Gamari at 2023-06-20T14:26:31-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - 9161f08c by Ben Gamari at 2023-06-20T14:26:31-04:00 nonmoving: Fix unused definition warrnings - - - - - d0398448 by Ben Gamari at 2023-06-20T14:26:31-04:00 Disable futimens on Darwin. See #22938 - - - - - d7541bb5 by Ben Gamari at 2023-06-20T14:26:31-04:00 rts: Fix incorrect CPP guard - - - - - 30611243 by Ben Gamari at 2023-06-20T14:26:31-04: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. - - - - - 8352af17 by Ben Gamari at 2023-06-20T14:26:31-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - 1860d0ce by Ben Gamari at 2023-06-20T14:26:32-04:00 rts: Fix capitalization of prototype - - - - - 0330240a by Ben Gamari at 2023-06-20T14:26:32-04:00 rts: Fix incorrect format specifier - - - - - 3ec80b61 by Josh Meredith at 2023-06-20T14:26:37-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 15 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - hadrian/src/Flavour.hs - rts/Hash.c - rts/IPE.c - rts/ProfilerReportJson.c - rts/Threads.c - rts/adjustor/LibffiAdjustor.c - rts/eventlog/EventLog.c - rts/include/rts/storage/ClosureMacros.h - rts/posix/Ticker.c - rts/posix/ticker/Pthread.c - rts/posix/ticker/TimerFd.c - rts/sm/NonMovingMark.c - testsuite/tests/perf/compiler/all.T Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -409,6 +409,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" } }, @@ -2478,6 +2479,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" } }, @@ -3590,6 +3592,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 ===================================== @@ -123,16 +123,25 @@ addArgs args' fl = fl { extraArgs = extraArgs 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 ===================================== rts/Hash.c ===================================== @@ -18,11 +18,13 @@ since we compile these things these days with cabal we can no longer specify optimization per file. So we have to resort to pragmas. */ #if defined(__GNUC__) || defined(__GNUG__) +#if !defined(__clang__) #if !defined(DEBUG) #pragma GCC push_options #pragma GCC optimize ("O3") #endif #endif +#endif #define XXH_NAMESPACE __rts_ #define XXH_STATIC_LINKING_ONLY /* access advanced declarations */ @@ -565,7 +567,9 @@ int keyCountHashTable (HashTable *table) #if defined(__GNUC__) || defined(__GNUG__) +#if !defined(__clang__) #if !defined(DEBUG) #pragma GCC pop_options #endif #endif +#endif ===================================== rts/IPE.c ===================================== @@ -62,7 +62,10 @@ this all IPE lists of all IpeBufferListNode are traversed to insert all IPEs. After the content of a IpeBufferListNode has been inserted, it's freed. */ +#if defined(THREADED_RTS) static Mutex ipeMapLock; +#endif +// Protected by ipeMapLock static HashTable *ipeMap = NULL; // Accessed atomically ===================================== rts/ProfilerReportJson.c ===================================== @@ -52,11 +52,10 @@ static void escapeString(char const* str, char **buf) static void logCostCentres(FILE *prof_file) { - char* lbl; - char* src_loc; bool needs_comma = false; fprintf(prof_file, "[\n"); for (CostCentre *cc = CC_LIST; cc != NULL; cc = cc->link) { + char *lbl, *src_loc; escapeString(cc->label, &lbl); escapeString(cc->srcloc, &src_loc); fprintf(prof_file, @@ -70,10 +69,10 @@ logCostCentres(FILE *prof_file) cc->ccID, lbl, cc->module, src_loc, cc->is_caf ? "true" : "false"); needs_comma = true; + stgFree(lbl); + stgFree(src_loc); } fprintf(prof_file, "]\n"); - stgFree(lbl); - stgFree(src_loc); } static void ===================================== rts/Threads.c ===================================== @@ -1013,10 +1013,10 @@ printGlobalThreads(void) for (uint32_t g = 0; g < RtsFlags.GcFlags.generations; g++) { debugBelch("\ngen %d\n", g); for (StgTSO *t = generations[g].threads; t != END_TSO_QUEUE; t = t->global_link) { - debugBelch("thread %p (id=%lu)\n", t, t->id); + debugBelch("thread %p (id=%lu)\n", t, (unsigned long)t->id); } for (StgTSO *t = generations[g].old_threads; t != END_TSO_QUEUE; t = t->global_link) { - debugBelch("thread %p (id=%lu) (old)\n", t, t->id); + debugBelch("thread %p (id=%lu) (old)\n", t, (unsigned long)t->id); } } } ===================================== rts/adjustor/LibffiAdjustor.c ===================================== @@ -39,7 +39,7 @@ static AdjustorWritable allocate_adjustor(AdjustorExecutable *exec_ret, ffi_cif { AdjustorWritable writ; - ffi_status r = ffi_alloc_prep_closure(&writ, cif, wptr, hptr, exec_ret); + ffi_status r = ffi_alloc_prep_closure((ffi_closure **) &writ, cif, wptr, hptr, exec_ret); if (r != FFI_OK) barf("ffi_alloc_prep_closure failed: %d", r); ===================================== rts/eventlog/EventLog.c ===================================== @@ -759,8 +759,10 @@ void postCapsetVecEvent (EventTypeNum tag, // 1 + strlen to account for the trailing \0, used as separator int increment = 1 + strlen(argv[i]); if (size + increment > EVENT_PAYLOAD_SIZE_MAX) { - errorBelch("Event size exceeds EVENT_PAYLOAD_SIZE_MAX, record only " - "%d out of %d args", i, argc); + errorBelch("Event size exceeds EVENT_PAYLOAD_SIZE_MAX, record only %" + FMT_Word " out of %" FMT_Word " args", + (StgWord) i, + (StgWord) argc); argc = i; break; } else { ===================================== rts/include/rts/storage/ClosureMacros.h ===================================== @@ -623,7 +623,7 @@ INLINE_HEADER void overwritingMutableClosureOfs (StgClosure *p, uint32_t offset) } // Version of 'overwritingClosure' which takes closure size as argument. -void stg_OverwritingClosureSize (StgClosure *p, uint32_t size /* in words */); +void stg_overwritingClosureSize (StgClosure *p, uint32_t size /* in words */); INLINE_HEADER void overwritingClosureSize (StgClosure *p, uint32_t size) { // This function is only called from stg_AP_STACK so we can assume it's not ===================================== 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 ===================================== @@ -39,7 +39,7 @@ static void trace_PAP_payload (MarkQueue *queue, StgClosure *fun, StgClosure **payload, StgWord size); -static bool is_nonmoving_weak(StgWeak *weak); +static bool is_nonmoving_weak(StgWeak *weak) USED_IF_DEBUG; // How many Array# entries to add to the mark queue at once? #define MARK_ARRAY_CHUNK_LENGTH 128 @@ -974,7 +974,7 @@ static void nonmovingResetUpdRemSetQueue (MarkQueue *rset) rset->top->head = 0; } -void nonmovingResetUpdRemSet (UpdRemSet *rset) +static void nonmovingResetUpdRemSet (UpdRemSet *rset) { nonmovingResetUpdRemSetQueue(&rset->queue); } ===================================== testsuite/tests/perf/compiler/all.T ===================================== @@ -658,7 +658,7 @@ test('T21839c', ['-O']) test ('InfiniteListFusion', - [collect_stats('bytes allocated',2), when(wordsize(32), skip), js_broken(22576)], + [collect_stats('bytes allocated',2), when(wordsize(32), skip)], compile_and_run, ['-O2 -package ghc']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2f514203eb5ae84cac62acbab3b0ef34b9a3e04b...3ec80b613b38917b2152bd760b907a658099dc96 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2f514203eb5ae84cac62acbab3b0ef34b9a3e04b...3ec80b613b38917b2152bd760b907a658099dc96 You're receiving 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 Jun 20 18:38:04 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 20 Jun 2023 14:38:04 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] WIP: Trying 9.6 CI Message-ID: <6491f20cd62c2_be46229308a6c612957@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 3153fdbe by Rodrigo Mesquita at 2023-06-20T19:37:59+01:00 WIP: Trying 9.6 CI - - - - - 1 changed file: - .gitlab/gen_ci.hs Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -380,7 +380,7 @@ opsysVariables _ FreeBSD13 = mconcat -- [1] https://www.freebsd.org/doc/en/books/porters-handbook/using-iconv.html) "CONFIGURE_ARGS" =: "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib" , "HADRIAN_ARGS" =: "--docs=no-sphinx" - , "GHC_VERSION" =: "9.4.3" + , "GHC_VERSION" =: "9.6.1" , "CABAL_INSTALL_VERSION" =: "3.8.1.0" ] opsysVariables _ (Linux distro) = distroVariables distro @@ -410,7 +410,7 @@ opsysVariables _ (Windows {}) = , "HADRIAN_ARGS" =: "--docs=no-sphinx" , "LANG" =: "en_US.UTF-8" , "CABAL_INSTALL_VERSION" =: "3.8.1.0" - , "GHC_VERSION" =: "9.4.3" ] + , "GHC_VERSION" =: "9.6.1" ] opsysVariables _ _ = mempty View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3153fdbe53f2c5b15131147beeb2a682aa3edb0f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3153fdbe53f2c5b15131147beeb2a682aa3edb0f You're receiving 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 Jun 20 18:39:07 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 20 Jun 2023 14:39:07 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Deleted 1 commit: WIP: Trying 9.6 CI Message-ID: <6491f24b5820b_be4622deac2c0613322@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection 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: 3153fdbe by Rodrigo Mesquita at 2023-06-20T19:37:59+01:00 WIP: Trying 9.6 CI - - - - - 1 changed file: - .gitlab/gen_ci.hs Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -380,7 +380,7 @@ opsysVariables _ FreeBSD13 = mconcat -- [1] https://www.freebsd.org/doc/en/books/porters-handbook/using-iconv.html) "CONFIGURE_ARGS" =: "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib" , "HADRIAN_ARGS" =: "--docs=no-sphinx" - , "GHC_VERSION" =: "9.4.3" + , "GHC_VERSION" =: "9.6.1" , "CABAL_INSTALL_VERSION" =: "3.8.1.0" ] opsysVariables _ (Linux distro) = distroVariables distro @@ -410,7 +410,7 @@ opsysVariables _ (Windows {}) = , "HADRIAN_ARGS" =: "--docs=no-sphinx" , "LANG" =: "en_US.UTF-8" , "CABAL_INSTALL_VERSION" =: "3.8.1.0" - , "GHC_VERSION" =: "9.4.3" ] + , "GHC_VERSION" =: "9.6.1" ] opsysVariables _ _ = mempty View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3153fdbe53f2c5b15131147beeb2a682aa3edb0f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3153fdbe53f2c5b15131147beeb2a682aa3edb0f You're receiving 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 Jun 20 19:32:30 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 20 Jun 2023 15:32:30 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/romes/ghc-platform Message-ID: <6491fececf9_be46229308a6c61576a@gitlab.mail> Rodrigo Mesquita pushed new branch wip/romes/ghc-platform at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/ghc-platform You're receiving 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 Jun 20 19:38:44 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 20 Jun 2023 15:38:44 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 2 commits: Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Message-ID: <6492004462eb9_be4622deac2c061915a@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: fab8b5b3 by Rodrigo Mesquita at 2023-06-20T20:35:24+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - 078ba491 by Rodrigo Mesquita at 2023-06-20T20:38:15+01:00 Use ghc-platform instead of ghc-boot - - - - - 11 changed files: - hadrian/hadrian.cabal - hadrian/src/Packages.hs - hadrian/src/Settings/Default.hs - libraries/ghc-boot/ghc-boot.cabal.in - + libraries/ghc-platform/CHANGELOG.md - + libraries/ghc-platform/LICENSE - + libraries/ghc-platform/ghc-platform.cabal - libraries/ghc-boot/GHC/Platform/ArchOS.hs → libraries/ghc-platform/src/GHC/Platform/ArchOS.hs - m4/ghc_toolchain.m4 - + utils/ghc-toolchain/acghc-toolchain - utils/ghc-toolchain/ghc-toolchain.cabal Changes: ===================================== hadrian/hadrian.cabal ===================================== @@ -166,8 +166,8 @@ executable hadrian , text >= 1.2 && < 3 , cryptohash-sha256 >= 0.11 && < 0.12 , base16-bytestring >= 0.1.1 && < 1.1.0.0 + , ghc-platform , ghc-toolchain - , ghc-boot ghc-options: -Wall -Wincomplete-record-updates -Wredundant-constraints ===================================== hadrian/src/Packages.hs ===================================== @@ -4,7 +4,7 @@ module Packages ( array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, - exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, + exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, @@ -36,7 +36,7 @@ ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps , compareSizes, compiler, containers, deepseq, deriveConstants, directory - , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh + , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell @@ -52,7 +52,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, - exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, + exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, @@ -83,6 +83,7 @@ ghc = prg "ghc-bin" `setPath` "ghc" ghcBignum = lib "ghc-bignum" ghcBoot = lib "ghc-boot" ghcBootTh = lib "ghc-boot-th" +ghcPlatform = lib "ghc-platform" ghcCompact = lib "ghc-compact" ghcConfig = prg "ghc-config" `setPath` "testsuite/ghc-config" ghcHeap = lib "ghc-heap" ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -85,6 +85,7 @@ stage0Packages = do , runGhc , ghcBoot , ghcBootTh + , ghcPlatform , ghcHeap , ghci , ghcPkg ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -51,7 +51,6 @@ Library GHC.Serialized GHC.ForeignSrcLang GHC.HandleEncoding - GHC.Platform.ArchOS GHC.Platform.Host GHC.Settings.Utils GHC.UniqueSubdir @@ -65,6 +64,10 @@ Library , GHC.ForeignSrcLang.Type , GHC.Lexeme + -- reexport platform modules from ghc-platform + reexported-modules: + GHC.Platform.ArchOS + -- but done by Hadrian autogen-modules: GHC.Version @@ -77,6 +80,7 @@ Library directory >= 1.2 && < 1.4, filepath >= 1.3 && < 1.5, deepseq >= 1.4 && < 1.5, + ghc-platform >= 0.1, ghc-boot-th == @ProjectVersionMunged@ if !os(windows) build-depends: ===================================== libraries/ghc-platform/CHANGELOG.md ===================================== @@ -0,0 +1,8 @@ +# Revision history for ghc-platform + +## 0.1.0.0 -- 2023-06-20 + +* First version. Split off the `GHC.Platform.ArchOS` module from the + non-reinstallable `ghc-boot` package into this reinstallable standalone + package which abides by the PVP, in part motivated by the ongoing work on + `ghc-toolchain` towards runtime retargetability. ===================================== libraries/ghc-platform/LICENSE ===================================== @@ -0,0 +1,30 @@ +Copyright (c) 2023, Rodrigo Mesquita + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Rodrigo Mesquita nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ===================================== libraries/ghc-platform/ghc-platform.cabal ===================================== @@ -0,0 +1,20 @@ +cabal-version: 3.0 +name: ghc-platform +version: 0.1.0.0 +synopsis: Platform information used by GHC and friends +license: BSD-3-Clause +license-file: LICENSE +author: Rodrigo Mesquita +maintainer: ghc-devs at haskell.org +build-type: Simple +extra-doc-files: CHANGELOG.md + +common warnings + ghc-options: -Wall + +library + import: warnings + exposed-modules: GHC.Platform.ArchOS + build-depends: base >=4.17.0.0 + hs-source-dirs: src + default-language: Haskell2010 ===================================== libraries/ghc-boot/GHC/Platform/ArchOS.hs → libraries/ghc-platform/src/GHC/Platform/ArchOS.hs ===================================== ===================================== m4/ghc_toolchain.m4 ===================================== @@ -22,7 +22,7 @@ AC_DEFUN([ENABLE_GHC_TOOLCHAIN_ARG], AC_DEFUN([FIND_GHC_TOOLCHAIN], [ "$GHC" -v0 \ - -ilibraries/ghc-boot -iutils/ghc-toolchain/src \ + -ilibraries/ghc-platform -iutils/ghc-toolchain/src \ -XNoImplicitPrelude \ -odir actmp-ghc-toolchain -hidir actmp-ghc-toolchain \ utils/ghc-toolchain/Main.hs -o acghc-toolchain ===================================== utils/ghc-toolchain/acghc-toolchain ===================================== Binary files /dev/null and b/utils/ghc-toolchain/acghc-toolchain differ ===================================== utils/ghc-toolchain/ghc-toolchain.cabal ===================================== @@ -50,6 +50,6 @@ executable ghc-toolchain filepath, process, transformers, - ghc-boot, + ghc-platform, ghc-toolchain default-language: Haskell2010 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/750061ce178ffa949f369c4f805c674b4c3a88b9...078ba4919d614dba6341935f82a8fc64a060d143 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/750061ce178ffa949f369c4f805c674b4c3a88b9...078ba4919d614dba6341935f82a8fc64a060d143 You're receiving 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 Jun 20 19:50:33 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 20 Jun 2023 15:50:33 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Use ghc-platform instead of ghc-boot Message-ID: <6492030934b37_be46229308a6c619956@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 68237873 by Rodrigo Mesquita at 2023-06-20T20:50:23+01:00 Use ghc-platform instead of ghc-boot - - - - - 4 changed files: - hadrian/hadrian.cabal - m4/ghc_toolchain.m4 - + utils/ghc-toolchain/acghc-toolchain - utils/ghc-toolchain/ghc-toolchain.cabal Changes: ===================================== hadrian/hadrian.cabal ===================================== @@ -166,8 +166,8 @@ executable hadrian , text >= 1.2 && < 3 , cryptohash-sha256 >= 0.11 && < 0.12 , base16-bytestring >= 0.1.1 && < 1.1.0.0 + , ghc-platform , ghc-toolchain - , ghc-boot ghc-options: -Wall -Wincomplete-record-updates -Wredundant-constraints ===================================== m4/ghc_toolchain.m4 ===================================== @@ -22,7 +22,7 @@ AC_DEFUN([ENABLE_GHC_TOOLCHAIN_ARG], AC_DEFUN([FIND_GHC_TOOLCHAIN], [ "$GHC" -v0 \ - -ilibraries/ghc-boot -iutils/ghc-toolchain/src \ + -ilibraries/ghc-platform/src -iutils/ghc-toolchain/src \ -XNoImplicitPrelude \ -odir actmp-ghc-toolchain -hidir actmp-ghc-toolchain \ utils/ghc-toolchain/Main.hs -o acghc-toolchain ===================================== utils/ghc-toolchain/acghc-toolchain ===================================== Binary files /dev/null and b/utils/ghc-toolchain/acghc-toolchain differ ===================================== utils/ghc-toolchain/ghc-toolchain.cabal ===================================== @@ -50,6 +50,6 @@ executable ghc-toolchain filepath, process, transformers, - ghc-boot, + ghc-platform, ghc-toolchain default-language: Haskell2010 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/68237873c320d00da3cebda35abf5a4e3283d54f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/68237873c320d00da3cebda35abf5a4e3283d54f You're receiving 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 Jun 20 19:53:14 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 20 Jun 2023 15:53:14 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] 9 commits: Memory usage fixes for Haddock Message-ID: <649203aab346a_be46229308a6c620674@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: e89efb5f by Finley McIlwaine at 2023-06-20T15:39:18-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 1e08ce17 by Finley McIlwaine at 2023-06-20T15:48:50-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - c0abc47b by Sylvain Henry at 2023-06-20T15:48:54-04: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> - - - - - 5c794929 by Sylvain Henry at 2023-06-20T15:51:08-04:00 Don't use getKey - - - - - 20e6c52e by Sylvain Henry at 2023-06-20T15:51:10-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - b43968dc by Sylvain Henry at 2023-06-20T15:51:11-04:00 Fix some recompilation avoidance tests - - - - - 614d5c57 by Sylvain Henry at 2023-06-20T15:51:12-04:00 TH_import_loop is now broken as expected - - - - - 256c39dc by Sylvain Henry at 2023-06-20T15:51:13-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - e3388370 by Ben Gamari at 2023-06-20T15:51:28-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Runtime/Context.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/Stg/FVs.hs - compiler/GHC/Stg/Pipeline.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/Types.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Utils/Misc.hs - compiler/ghc.cabal.in - configure.ac - + ghc-interp.js - hadrian/src/Base.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0c8d54e602acfc14e22a018e15680598850c3788...e3388370fa196e9637aa92160923713cbb007d91 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0c8d54e602acfc14e22a018e15680598850c3788...e3388370fa196e9637aa92160923713cbb007d91 You're receiving 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 Jun 20 20:14:32 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 20 Jun 2023 16:14:32 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Use ghc-platform instead of ghc-boot Message-ID: <649208a8c5d7e_be4622deac2c0621073@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: d1442b69 by Rodrigo Mesquita at 2023-06-20T21:14:21+01:00 Use ghc-platform instead of ghc-boot - - - - - 6 changed files: - hadrian/cabal.project - hadrian/hadrian.cabal - hadrian/stack.yaml - m4/ghc_toolchain.m4 - + utils/ghc-toolchain/acghc-toolchain - utils/ghc-toolchain/ghc-toolchain.cabal Changes: ===================================== hadrian/cabal.project ===================================== @@ -1,5 +1,6 @@ packages: ./ ../utils/ghc-toolchain/ + ../libraries/ghc-platform/ -- This essentially freezes the build plan for hadrian index-state: 2023-03-30T10:00:00Z ===================================== hadrian/hadrian.cabal ===================================== @@ -166,8 +166,8 @@ executable hadrian , text >= 1.2 && < 3 , cryptohash-sha256 >= 0.11 && < 0.12 , base16-bytestring >= 0.1.1 && < 1.1.0.0 + , ghc-platform , ghc-toolchain - , ghc-boot ghc-options: -Wall -Wincomplete-record-updates -Wredundant-constraints ===================================== hadrian/stack.yaml ===================================== @@ -3,6 +3,7 @@ resolver: lts-19.8 packages: - '.' - '../utils/ghc-toolchain' +- '../libraries/ghc-platform' nix: enable: false ===================================== m4/ghc_toolchain.m4 ===================================== @@ -22,7 +22,7 @@ AC_DEFUN([ENABLE_GHC_TOOLCHAIN_ARG], AC_DEFUN([FIND_GHC_TOOLCHAIN], [ "$GHC" -v0 \ - -ilibraries/ghc-boot -iutils/ghc-toolchain/src \ + -ilibraries/ghc-platform/src -iutils/ghc-toolchain/src \ -XNoImplicitPrelude \ -odir actmp-ghc-toolchain -hidir actmp-ghc-toolchain \ utils/ghc-toolchain/Main.hs -o acghc-toolchain ===================================== utils/ghc-toolchain/acghc-toolchain ===================================== Binary files /dev/null and b/utils/ghc-toolchain/acghc-toolchain differ ===================================== utils/ghc-toolchain/ghc-toolchain.cabal ===================================== @@ -50,6 +50,6 @@ executable ghc-toolchain filepath, process, transformers, - ghc-boot, + ghc-platform, ghc-toolchain default-language: Haskell2010 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d1442b69ca9f96d252c08c11940b6435ce46ef30 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d1442b69ca9f96d252c08c11940b6435ce46ef30 You're receiving 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 Jun 20 20:57:06 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 20 Jun 2023 16:57:06 -0400 Subject: [Git][ghc/ghc][master] 12 commits: rts/ipe: Fix unused lock warning Message-ID: <649212a22ee95_3d2611c618812229@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 14 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - hadrian/src/Flavour.hs - rts/Hash.c - rts/IPE.c - rts/ProfilerReportJson.c - rts/Threads.c - rts/adjustor/LibffiAdjustor.c - rts/eventlog/EventLog.c - rts/include/rts/storage/ClosureMacros.h - rts/posix/Ticker.c - rts/posix/ticker/Pthread.c - rts/posix/ticker/TimerFd.c - rts/sm/NonMovingMark.c Changes: ===================================== .gitlab/gen_ci.hs ===================================== @@ -409,6 +409,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" } }, @@ -2478,6 +2479,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" } }, @@ -3590,6 +3592,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 ===================================== @@ -123,16 +123,25 @@ addArgs args' fl = fl { extraArgs = extraArgs 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 ===================================== rts/Hash.c ===================================== @@ -18,11 +18,13 @@ since we compile these things these days with cabal we can no longer specify optimization per file. So we have to resort to pragmas. */ #if defined(__GNUC__) || defined(__GNUG__) +#if !defined(__clang__) #if !defined(DEBUG) #pragma GCC push_options #pragma GCC optimize ("O3") #endif #endif +#endif #define XXH_NAMESPACE __rts_ #define XXH_STATIC_LINKING_ONLY /* access advanced declarations */ @@ -565,7 +567,9 @@ int keyCountHashTable (HashTable *table) #if defined(__GNUC__) || defined(__GNUG__) +#if !defined(__clang__) #if !defined(DEBUG) #pragma GCC pop_options #endif #endif +#endif ===================================== rts/IPE.c ===================================== @@ -62,7 +62,10 @@ this all IPE lists of all IpeBufferListNode are traversed to insert all IPEs. After the content of a IpeBufferListNode has been inserted, it's freed. */ +#if defined(THREADED_RTS) static Mutex ipeMapLock; +#endif +// Protected by ipeMapLock static HashTable *ipeMap = NULL; // Accessed atomically ===================================== rts/ProfilerReportJson.c ===================================== @@ -52,11 +52,10 @@ static void escapeString(char const* str, char **buf) static void logCostCentres(FILE *prof_file) { - char* lbl; - char* src_loc; bool needs_comma = false; fprintf(prof_file, "[\n"); for (CostCentre *cc = CC_LIST; cc != NULL; cc = cc->link) { + char *lbl, *src_loc; escapeString(cc->label, &lbl); escapeString(cc->srcloc, &src_loc); fprintf(prof_file, @@ -70,10 +69,10 @@ logCostCentres(FILE *prof_file) cc->ccID, lbl, cc->module, src_loc, cc->is_caf ? "true" : "false"); needs_comma = true; + stgFree(lbl); + stgFree(src_loc); } fprintf(prof_file, "]\n"); - stgFree(lbl); - stgFree(src_loc); } static void ===================================== rts/Threads.c ===================================== @@ -1013,10 +1013,10 @@ printGlobalThreads(void) for (uint32_t g = 0; g < RtsFlags.GcFlags.generations; g++) { debugBelch("\ngen %d\n", g); for (StgTSO *t = generations[g].threads; t != END_TSO_QUEUE; t = t->global_link) { - debugBelch("thread %p (id=%lu)\n", t, t->id); + debugBelch("thread %p (id=%lu)\n", t, (unsigned long)t->id); } for (StgTSO *t = generations[g].old_threads; t != END_TSO_QUEUE; t = t->global_link) { - debugBelch("thread %p (id=%lu) (old)\n", t, t->id); + debugBelch("thread %p (id=%lu) (old)\n", t, (unsigned long)t->id); } } } ===================================== rts/adjustor/LibffiAdjustor.c ===================================== @@ -39,7 +39,7 @@ static AdjustorWritable allocate_adjustor(AdjustorExecutable *exec_ret, ffi_cif { AdjustorWritable writ; - ffi_status r = ffi_alloc_prep_closure(&writ, cif, wptr, hptr, exec_ret); + ffi_status r = ffi_alloc_prep_closure((ffi_closure **) &writ, cif, wptr, hptr, exec_ret); if (r != FFI_OK) barf("ffi_alloc_prep_closure failed: %d", r); ===================================== rts/eventlog/EventLog.c ===================================== @@ -759,8 +759,10 @@ void postCapsetVecEvent (EventTypeNum tag, // 1 + strlen to account for the trailing \0, used as separator int increment = 1 + strlen(argv[i]); if (size + increment > EVENT_PAYLOAD_SIZE_MAX) { - errorBelch("Event size exceeds EVENT_PAYLOAD_SIZE_MAX, record only " - "%d out of %d args", i, argc); + errorBelch("Event size exceeds EVENT_PAYLOAD_SIZE_MAX, record only %" + FMT_Word " out of %" FMT_Word " args", + (StgWord) i, + (StgWord) argc); argc = i; break; } else { ===================================== rts/include/rts/storage/ClosureMacros.h ===================================== @@ -623,7 +623,7 @@ INLINE_HEADER void overwritingMutableClosureOfs (StgClosure *p, uint32_t offset) } // Version of 'overwritingClosure' which takes closure size as argument. -void stg_OverwritingClosureSize (StgClosure *p, uint32_t size /* in words */); +void stg_overwritingClosureSize (StgClosure *p, uint32_t size /* in words */); INLINE_HEADER void overwritingClosureSize (StgClosure *p, uint32_t size) { // This function is only called from stg_AP_STACK so we can assume it's not ===================================== 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 ===================================== @@ -39,7 +39,7 @@ static void trace_PAP_payload (MarkQueue *queue, StgClosure *fun, StgClosure **payload, StgWord size); -static bool is_nonmoving_weak(StgWeak *weak); +static bool is_nonmoving_weak(StgWeak *weak) USED_IF_DEBUG; // How many Array# entries to add to the mark queue at once? #define MARK_ARRAY_CHUNK_LENGTH 128 @@ -974,7 +974,7 @@ static void nonmovingResetUpdRemSetQueue (MarkQueue *rset) rset->top->head = 0; } -void nonmovingResetUpdRemSet (UpdRemSet *rset) +static void nonmovingResetUpdRemSet (UpdRemSet *rset) { nonmovingResetUpdRemSetQueue(&rset->queue); } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1464a2a8de082f66ae250d63ab9d94dbe2ef8620...17f250d70ebe90a55fb9385460e5c5500bdb42a6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1464a2a8de082f66ae250d63ab9d94dbe2ef8620...17f250d70ebe90a55fb9385460e5c5500bdb42a6 You're receiving 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 Jun 20 20:57:38 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 20 Jun 2023 16:57:38 -0400 Subject: [Git][ghc/ghc][master] JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) Message-ID: <649212c28f007_3d2611c61381555c@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 1 changed file: - testsuite/tests/perf/compiler/all.T Changes: ===================================== testsuite/tests/perf/compiler/all.T ===================================== @@ -658,7 +658,7 @@ test('T21839c', ['-O']) test ('InfiniteListFusion', - [collect_stats('bytes allocated',2), when(wordsize(32), skip), js_broken(22576)], + [collect_stats('bytes allocated',2), when(wordsize(32), skip)], compile_and_run, ['-O2 -package ghc']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0ff1c5017d7d32cc92ac1ac6f54e12471658d167 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0ff1c5017d7d32cc92ac1ac6f54e12471658d167 You're receiving 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 Jun 20 21:02:06 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 20 Jun 2023 17:02:06 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] del async dep Message-ID: <649213ceec191_3d2611c5fe415862@gitlab.mail> Spam detection software, running on the system "mail.haskell.org", has identified this incoming email as possible spam. The original message has been attached to this so you can view it (if it isn't spam) or label similar future email. If you have any questions, see @@CONTACT_ADDRESS@@ for details. Content preview: Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 00d5ea66 by Rodrigo Mesquita at 2023-06-20T22:00:45+01:00 del async dep - - - - - [...] Content analysis details: (6.9 points, 5.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- -0.0 T_RP_MATCHES_RCVD Envelope sender domain matches handover relay domain 1.1 URI_HEX URI: URI hostname has long hexadecimal sequence 5.0 UNWANTED_LANGUAGE_BODY BODY: Message written in an undesired language 0.0 HTML_MESSAGE BODY: HTML included in message 0.8 BAYES_50 BODY: Bayes spam probability is 40 to 60% [score: 0.4875] 0.0 T_DKIM_INVALID DKIM-Signature header exists but is not valid The original message was not completely plain text, and may be unsafe to open with some email clients; in particular, it may contain a virus, or confirm that your address can receive spam. If you wish to view it, it may be safer to save it to a file and open it with an editor. -------------- next part -------------- An embedded message was scrubbed... From: "Rodrigo Mesquita (@alt-romes)" Subject: [Git][ghc/ghc][wip/toolchain-selection] del async dep Date: Tue, 20 Jun 2023 17:02:06 -0400 Size: 15035 URL: From gitlab at gitlab.haskell.org Tue Jun 20 21:43:08 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 20 Jun 2023 17:43:08 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Use ghc-platform instead of ghc-boot Message-ID: <64921d6c55588_3d26111395c8c256bc@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: a9a1b8bc by Rodrigo Mesquita at 2023-06-20T22:42:54+01:00 Use ghc-platform instead of ghc-boot del async dep - - - - - 6 changed files: - hadrian/cabal.project - hadrian/hadrian.cabal - hadrian/stack.yaml - m4/ghc_toolchain.m4 - + utils/ghc-toolchain/acghc-toolchain - utils/ghc-toolchain/ghc-toolchain.cabal Changes: ===================================== hadrian/cabal.project ===================================== @@ -1,5 +1,6 @@ packages: ./ ../utils/ghc-toolchain/ + ../libraries/ghc-platform/ -- This essentially freezes the build plan for hadrian index-state: 2023-03-30T10:00:00Z ===================================== hadrian/hadrian.cabal ===================================== @@ -166,8 +166,8 @@ executable hadrian , text >= 1.2 && < 3 , cryptohash-sha256 >= 0.11 && < 0.12 , base16-bytestring >= 0.1.1 && < 1.1.0.0 + , ghc-platform , ghc-toolchain - , ghc-boot ghc-options: -Wall -Wincomplete-record-updates -Wredundant-constraints ===================================== hadrian/stack.yaml ===================================== @@ -3,6 +3,7 @@ resolver: lts-19.8 packages: - '.' - '../utils/ghc-toolchain' +- '../libraries/ghc-platform' nix: enable: false ===================================== m4/ghc_toolchain.m4 ===================================== @@ -22,7 +22,7 @@ AC_DEFUN([ENABLE_GHC_TOOLCHAIN_ARG], AC_DEFUN([FIND_GHC_TOOLCHAIN], [ "$GHC" -v0 \ - -ilibraries/ghc-boot -iutils/ghc-toolchain/src \ + -ilibraries/ghc-platform/src -iutils/ghc-toolchain/src \ -XNoImplicitPrelude \ -odir actmp-ghc-toolchain -hidir actmp-ghc-toolchain \ utils/ghc-toolchain/Main.hs -o acghc-toolchain ===================================== utils/ghc-toolchain/acghc-toolchain ===================================== Binary files /dev/null and b/utils/ghc-toolchain/acghc-toolchain differ ===================================== utils/ghc-toolchain/ghc-toolchain.cabal ===================================== @@ -36,8 +36,7 @@ library filepath, process, transformers, - async, - ghc-boot + ghc-platform hs-source-dirs: src default-language: Haskell2010 @@ -50,6 +49,6 @@ executable ghc-toolchain filepath, process, transformers, - ghc-boot, + ghc-platform, ghc-toolchain default-language: Haskell2010 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a9a1b8bce5e980e6e953140ee1cc8c112c44d703 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a9a1b8bce5e980e6e953140ee1cc8c112c44d703 You're receiving 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 Jun 20 23:42:12 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Tue, 20 Jun 2023 19:42:12 -0400 Subject: [Git][ghc/ghc][wip/T23109] Inline more, sooner Message-ID: <64923954d9076_3d2611c618835927@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23109 at Glasgow Haskell Compiler / GHC Commits: e3730ab1 by Simon Peyton Jones at 2023-06-21T00:41:51+01:00 Inline more, sooner - - - - - 1 changed file: - compiler/GHC/Core/Opt/Simplify/Iteration.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -424,6 +424,9 @@ simplAuxBind env bndr new_rhs -- 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 ... + || case (idOccInfo bndr) of + OneOcc{ occ_n_br = 1, occ_in_lam = NotInsideLam } -> True + _ -> False = return ( emptyFloats env , case new_rhs of Coercion co -> extendCvSubst env bndr co @@ -2148,7 +2151,8 @@ simplCall :: SimplEnv -> OutId -> SimplCont -> SimplM (SimplFloats, OutExpr) simplCall env var cont | ClassOpId clas idx _ <- idDetails var , Just (env', arg', cont') <- classOpDictApp_maybe env clas idx cont - = simplExprF env' arg' cont' + = -- pprTrace "simplCall:classop" (ppr var $$ ppr arg') $ + simplExprF env' arg' cont' | otherwise = do { rule_base <- getSimplRules @@ -3570,7 +3574,7 @@ knownCon env scrut dc_floats dc dc_ty_args dc_args bndr bs rhs cont -- 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) <- simplAuxBind env' b' arg -- arg satisfies let-can-float invariant - ; (floats2, env3) <- bind_args env2 bs' args + ; (floats2, env3) <- bind_args env2 bs' args ; return (floats1 `addFloats` floats2, env3) } bind_args _ _ _ = View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e3730ab130971689ecf18669899b2d6fa2b91cba -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e3730ab130971689ecf18669899b2d6fa2b91cba You're receiving 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 Jun 21 09:22:04 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 21 Jun 2023 05:22:04 -0400 Subject: [Git][ghc/ghc][wip/T23109] Two Simplifier optimistaions Message-ID: <6492c13ce2f43_1cc9dd59e0638221b6@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23109 at Glasgow Haskell Compiler / GHC Commits: 9d4130f6 by Simon Peyton Jones at 2023-06-21T10:21:06+01:00 Two Simplifier optimistaions Inline in exprIsConAppMaybe Inline in postInlineUnconditinally - - - - - 3 changed files: - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/SimpleOpt.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -971,7 +971,9 @@ completeBind env bind_cxt old_bndr new_bndr new_rhs -- substitution will happen, since we are going to discard the binding else -- Keep the binding; do cast worker/wrapper - -- pprTrace "Binding" (ppr new_bndr <+> ppr new_unfolding) $ + simplTrace "completeBind" (vcat [ text "bndrs" <+> ppr old_bndr <+> ppr new_bndr + , text "occ" <+> ppr occ_info + , text "eta_rhs" <+> ppr eta_rhs ]) $ tryCastWorkerWrapper env bind_cxt old_bndr occ_info new_bndr_w_info eta_rhs } addLetBndrInfo :: OutId -> ArityType -> Unfolding -> OutId @@ -2151,7 +2153,7 @@ simplCall :: SimplEnv -> OutId -> SimplCont -> SimplM (SimplFloats, OutExpr) simplCall env var cont | ClassOpId clas idx _ <- idDetails var , Just (env', arg', cont') <- classOpDictApp_maybe env clas idx cont - = -- pprTrace "simplCall:classop" (ppr var $$ ppr arg') $ + = simplTrace "simplCall:classop" (ppr var $$ ppr arg') $ simplExprF env' arg' cont' | otherwise ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -1537,7 +1537,7 @@ postInlineUnconditionally env bind_cxt bndr occ_info rhs -> n_br < 100 -- See Note [Suppress exponential blowup] - && smallEnoughToInline uf_opts unfolding -- Small enough to dup + && (smallEnoughToInline uf_opts unfolding || n_br == 1) -- Small enough to dup -- ToDo: consider discount on smallEnoughToInline if int_cxt is true -- -- NB: Do NOT inline arbitrarily big things, even if occ_n_br=1 ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -512,6 +512,12 @@ do_beta_by_substitution bndr rhs = exprIsTrivial rhs -- Can duplicate || safe_to_inline (idOccInfo bndr) -- Occurs at most once +do_case_elim :: CoreExpr -> Id -> [Id] -> Bool +do_case_elim scrut case_bndr alt_bndrs + = exprIsHNF scrut + && safe_to_inline (idOccInfo case_bndr) + && all isDeadBinder alt_bndrs + ------------------- simple_out_bind :: TopLevelFlag -> SimpleOptEnv @@ -1290,13 +1296,17 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr in go subst' (float:floats) expr cont go subst floats (Case scrut b _ [Alt con vars expr]) cont + | do_case_elim scrut' b vars + = go (extend subst b scrut') floats expr cont + | otherwise = let - scrut' = subst_expr subst scrut (subst', b') = subst_bndr subst b (subst'', vars') = subst_bndrs subst' vars float = FloatCase scrut' b' con vars' in go subst'' (float:floats) expr cont + where + scrut' = subst_expr subst scrut go (Right sub) floats (Var v) cont = go (Left (getSubstInScope sub)) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9d4130f649066a5e77a5f718782afac024501818 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9d4130f649066a5e77a5f718782afac024501818 You're receiving 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 Jun 21 11:13:38 2023 From: gitlab at gitlab.haskell.org (Oleg Grenrus (@phadej)) Date: Wed, 21 Jun 2023 07:13:38 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/warn-and-run Message-ID: <6492db62ed2f7_1cc9ddc5f303367f@gitlab.mail> Oleg Grenrus pushed new branch wip/warn-and-run at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/warn-and-run You're receiving 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 Jun 21 11:38:19 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Wed, 21 Jun 2023 07:38:19 -0400 Subject: [Git][ghc/ghc][wip/T22010] Comment out lift deriving in Word64Map/Set Message-ID: <6492e12b10da5_1cc9ddc5f444268d@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 9129d59f by Jaro Reinders at 2023-06-21T13:38:05+02:00 Comment out lift deriving in Word64Map/Set - - - - - 2 changed files: - compiler/GHC/Data/Word64Map/Internal.hs - compiler/GHC/Data/Word64Set/Internal.hs Changes: ===================================== compiler/GHC/Data/Word64Map/Internal.hs ===================================== @@ -2,7 +2,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE PatternGuards #-} #ifdef __GLASGOW_HASKELL__ -{-# LANGUAGE DeriveLift #-} +-- {-# LANGUAGE DeriveLift #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} @@ -326,9 +326,9 @@ import Data.Data (Data(..), Constr, mkConstr, constrIndex, Fixity(Prefix), import GHC.Exts (build) import qualified GHC.Exts as GHCExts import Text.Read -import Language.Haskell.TH.Syntax (Lift) +-- import Language.Haskell.TH.Syntax (Lift) -- See Note [ Template Haskell Dependencies ] -import Language.Haskell.TH () +-- import Language.Haskell.TH () #endif import qualified Control.Category as Category import Data.Word @@ -381,7 +381,7 @@ type Word64SetPrefix = Word64 type Word64SetBitMap = Word64 -- | @since 0.6.6 -deriving instance Lift a => Lift (Word64Map a) +-- deriving instance Lift a => Lift (Word64Map a) bitmapOf :: Word64 -> Word64SetBitMap bitmapOf x = shiftLL 1 (fromIntegral (x .&. Word64Set.suffixBitMask)) ===================================== compiler/GHC/Data/Word64Set/Internal.hs ===================================== @@ -2,7 +2,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE PatternGuards #-} #ifdef __GLASGOW_HASKELL__ -{-# LANGUAGE DeriveLift #-} +-- {-# LANGUAGE DeriveLift #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} @@ -219,9 +219,9 @@ import Text.Read #if __GLASGOW_HASKELL__ import qualified GHC.Exts -import Language.Haskell.TH.Syntax (Lift) +-- import Language.Haskell.TH.Syntax (Lift) -- See Note [ Template Haskell Dependencies ] -import Language.Haskell.TH () +-- import Language.Haskell.TH () #endif import qualified Data.Foldable as Foldable @@ -278,10 +278,10 @@ type Mask = Word64 type BitMap = Word64 type Key = Word64 -#ifdef __GLASGOW_HASKELL__ +-- #ifdef __GLASGOW_HASKELL__ -- | @since 0.6.6 -deriving instance Lift Word64Set -#endif +-- deriving instance Lift Word64Set +-- #endif instance Monoid Word64Set where mempty = empty View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9129d59fa1a5b16b555f466bc570f72ea45366e2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9129d59fa1a5b16b555f466bc570f72ea45366e2 You're receiving 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 Jun 21 11:46:13 2023 From: gitlab at gitlab.haskell.org (Oleg Grenrus (@phadej)) Date: Wed, 21 Jun 2023 07:46:13 -0400 Subject: [Git][ghc/ghc][wip/warn-and-run] Add warn_and_run test kind Message-ID: <6492e3052d022_1cc9ddc5f444301c@gitlab.mail> Oleg Grenrus pushed to branch wip/warn-and-run at Glasgow Haskell Compiler / GHC Commits: 0876faad by Oleg Grenrus at 2023-06-21T14:46:00+03:00 Add warn_and_run test kind This is a compile_and_run variant which also captures the GHC's stderr. The warn_and_run name is best I can come up with, as compile_and_run is taken. This is useful specifically for testing warnings. We want to test that when warning triggers, and it's not a false positive, i.e. that the runtime behaviour is indeed "incorrect". As an example a single test is altered to use warn_and_run - - - - - 5 changed files: - testsuite/driver/testlib.py - testsuite/tests/rename/should_compile/all.T - testsuite/tests/rename/should_compile/rn039.stderr → testsuite/tests/rename/should_compile/rn039.ghc.stderr - testsuite/tests/rename/should_compile/rn039.hs - + testsuite/tests/rename/should_compile/rn039.stdout Changes: ===================================== testsuite/driver/testlib.py ===================================== @@ -1620,7 +1620,8 @@ async def compile_and_run__(name: TestName, top_mod: Path, extra_mods: List[str], extra_hc_opts: str, - backpack: bool=False + backpack: bool=False, + compile_stderr: bool=False ) -> PassFail: # print 'Compile and run, extra args = ', extra_hc_opts @@ -1637,6 +1638,23 @@ async def compile_and_run__(name: TestName, if badResult(result): return result + if compile_stderr: + expected_stderr_file = find_expected_file(name, 'ghc.stderr') + actual_stderr_file = add_suffix(name, 'comp.stderr') + diff_file_name = in_testdir(add_suffix(name, 'comp.diff')) + + if not await compare_outputs(way, 'stderr', + join_normalisers(getTestOpts().extra_errmsg_normaliser, + normalise_errmsg), + expected_stderr_file, actual_stderr_file, + diff_file=diff_file_name, + whitespace_normaliser=getattr(getTestOpts(), + "whitespace_normaliser", + normalise_whitespace)): + stderr = diff_file_name.read_text() + diff_file_name.unlink() + return failBecause('ghc.stderr mismatch', stderr=stderr) +# cmd = './' + name + exe_extension() # we don't check the compiler's stderr for a compile-and-run test @@ -1651,6 +1669,9 @@ async def multimod_compile_and_run( name, way, top_mod, extra_hc_opts ): async def multi_compile_and_run( name, way, top_mod, extra_mods, extra_hc_opts ): return await compile_and_run__( name, way, top_mod, extra_mods, extra_hc_opts) +async def warn_and_run( name, way, extra_hc_opts ): + return await compile_and_run__( name, way, None, [], extra_hc_opts, compile_stderr = True) + def stats( name, way, stats_file ): opts = getTestOpts() return check_stats(name, way, in_testdir(stats_file), opts.stats_range_fields) ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -31,7 +31,7 @@ test('rn037', normal, compile, ['']) # Missing: # test('rn038', normal, compile, ['']) -test('rn039', normal, compile, ['']) +test('rn039', normal, warn_and_run, ['']) test('rn040', normal, compile, ['-fwarn-unused-binds -fwarn-unused-matches']) test('rn041', normal, compile, ['']) test('rn042', [extra_files(['Rn042_A.hs'])], multimod_compile, ['rn042', '-v0']) ===================================== testsuite/tests/rename/should_compile/rn039.stderr → testsuite/tests/rename/should_compile/rn039.ghc.stderr ===================================== @@ -1,5 +1,7 @@ +[1 of 2] Compiling Main ( rn039.hs, rn039.o ) -rn039.hs:6:16: warning: [GHC-63397] [-Wname-shadowing (in -Wall)] +rn039.hs:6:20: warning: [GHC-63397] [-Wname-shadowing (in -Wall)] This binding for ‘-’ shadows the existing binding - imported from ‘Prelude’ at rn039.hs:2:8-20 + imported from ‘Prelude’ at rn039.hs:2:8-11 (and originally defined in ‘GHC.Num’) +[2 of 2] Linking rn039 ===================================== testsuite/tests/rename/should_compile/rn039.hs ===================================== @@ -1,6 +1,9 @@ {-# OPTIONS -fwarn-name-shadowing #-} -module ShouldCompile where +module Main (main) where -- !!! test shadowing of a global name -g = 42 where f -1 = -1 -- shadows (-), probably by accident! +g = 42 - 1 where f -1 = -1 -- shadows (-), probably by accident! + +main :: IO () +main = print g ===================================== testsuite/tests/rename/should_compile/rn039.stdout ===================================== @@ -0,0 +1 @@ +-1 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0876faadf671f80dd8617508b4f0869ada4c68da -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0876faadf671f80dd8617508b4f0869ada4c68da You're receiving 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 Jun 21 12:47:06 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 21 Jun 2023 08:47:06 -0400 Subject: [Git][ghc/ghc] Pushed new branch ghc-9.8 Message-ID: <6492f14adc02c_1cc9ddc5f6c481b6@gitlab.mail> Ben Gamari pushed new branch ghc-9.8 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/ghc-9.8 You're receiving 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 Jun 21 12:47:23 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 21 Jun 2023 08:47:23 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] 2 commits: Add support for deprecating exported items (proposal #134) Message-ID: <6492f15bd6a91_1cc9ddc5ee0486b7@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: cef9b9a6 by Ben Gamari at 2023-06-20T15:58:35-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 128b0d5c by Ben Gamari at 2023-06-21T08:43:55-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Utils/Backpack.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/GHC/Types/Name/Env.hs - compiler/GHC/Types/Name/Reader.hs - compiler/GHC/Unit/Module/ModIface.hs - compiler/GHC/Unit/Module/Warnings.hs - configure.ac The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e3388370fa196e9637aa92160923713cbb007d91...128b0d5c8a8711e5326c28d69375456e09a23ade -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e3388370fa196e9637aa92160923713cbb007d91...128b0d5c8a8711e5326c28d69375456e09a23ade You're receiving 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 Jun 21 14:57:31 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 21 Jun 2023 10:57:31 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/simplifier-tweaks Message-ID: <64930fdb84dac_1cc9ddc5ee066088@gitlab.mail> Simon Peyton Jones pushed new branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/simplifier-tweaks You're receiving 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 Jun 21 15:57:04 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 21 Jun 2023 11:57:04 -0400 Subject: [Git][ghc/ghc][wip/tsan/no-barriers] 8 commits: compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE Message-ID: <64931dd0c80eb_1cc9dd59e06387574c@gitlab.mail> Ben Gamari pushed to branch wip/tsan/no-barriers at Glasgow Haskell Compiler / GHC Commits: 97cb2d85 by Ben Gamari at 2023-06-21T11:56:52-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - 01d6d432 by Ben Gamari at 2023-06-21T11:56:52-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 3e13ab42 by Ben Gamari at 2023-06-21T11:56:52-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - 4147848e by Ben Gamari at 2023-06-21T11:56:52-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 402a3ee6 by Ben Gamari at 2023-06-21T11:56:52-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 55b6f730 by Sven Tennie at 2023-06-21T11:56:52-04:00 compiler: Drop MO_ReadBarrier - - - - - 21e9428e by Ben Gamari at 2023-06-21T11:56:52-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 1e7b6cc1 by Sven Tennie at 2023-06-21T11:56:52-04:00 Delete write_barrier function - - - - - 25 changed files: - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/StgToCmm/Prim.hs - rts/CloneStack.c - rts/PrimOps.cmm - rts/RaiseAsync.c - rts/RtsSymbols.c - rts/Sparks.c - rts/TopHandler.c - rts/include/Cmm.h - rts/include/Stg.h - rts/include/stg/SMP.h - rts/sm/Evac.c - rts/sm/GC.c - rts/sm/GCAux.c - rts/sm/Sanity.c - testsuite/tests/rts/testwsdeque.c Changes: ===================================== compiler/GHC/Cmm/MachOp.hs ===================================== @@ -670,8 +670,6 @@ data CallishMachOp | MO_SubIntC Width | MO_U_Mul2 Width - | MO_ReadBarrier - | MO_WriteBarrier | MO_Touch -- Keep variables live (when using interior pointers) -- Prefetch @@ -701,6 +699,9 @@ data CallishMachOp | MO_BSwap Width | MO_BRev Width + | MO_AcquireFence + | MO_ReleaseFence + -- | Atomic read-modify-write. Arguments are @[dest, n]@. | MO_AtomicRMW Width AtomicMachOp -- | Atomic read. Arguments are @[addr]@. ===================================== compiler/GHC/Cmm/Parser.y ===================================== @@ -1117,8 +1117,11 @@ callishMachOps platform = listToUFM $ ( "fabs32f", (MO_F32_Fabs,) ), ( "sqrt32f", (MO_F32_Sqrt,) ), - ( "read_barrier", (MO_ReadBarrier,)), - ( "write_barrier", (MO_WriteBarrier,)), + -- TODO: It would be nice to rename the following operations to + -- acquire_fence and release_fence. Be aware that there'll be issues + -- with an overlapping token ('acquire') in the lexer. + ( "fence_acquire", (MO_AcquireFence,)), + ( "fence_release", (MO_ReleaseFence,)), ( "memcpy", memcpyLikeTweakArgs MO_Memcpy ), ( "memset", memcpyLikeTweakArgs MO_Memset ), ( "memmove", memcpyLikeTweakArgs MO_Memmove ), ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -1558,9 +1558,8 @@ genCCall target dest_regs arg_regs bid = do MO_U_Mul2 _w -> unsupported mop -- Memory Ordering - -- TODO DMBSY is probably *way* too much! - MO_ReadBarrier -> return (unitOL DMBSY, Nothing) - MO_WriteBarrier -> return (unitOL DMBSY, Nothing) + MO_AcquireFence -> return (unitOL DMBISH, Nothing) + MO_ReleaseFence -> return (unitOL DMBISH, Nothing) MO_Touch -> return (nilOL, Nothing) -- Keep variables live (when using interior pointers) -- Prefetch MO_Prefetch_Data _n -> return (nilOL, Nothing) -- Prefetch hint. ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -136,6 +136,7 @@ regUsageOfInstr platform instr = case instr of -- 8. Synchronization Instructions ------------------------------------------- DMBSY -> usage ([], []) + DMBISH -> usage ([], []) -- 9. Floating Point Instructions -------------------------------------------- FCVT dst src -> usage (regOp src, regOp dst) @@ -276,6 +277,7 @@ patchRegsOfInstr instr env = case instr of -- 8. Synchronization Instructions ----------------------------------------- DMBSY -> DMBSY + DMBISH -> DMBISH -- 9. Floating Point Instructions ------------------------------------------ FCVT o1 o2 -> FCVT (patchOp o1) (patchOp o2) @@ -645,6 +647,7 @@ data Instr -- 8. Synchronization Instructions ----------------------------------------- | DMBSY + | DMBISH -- 9. Floating Point Instructions -- Float ConVerT | FCVT Operand Operand @@ -724,6 +727,7 @@ instrCon i = BL{} -> "BL" BCOND{} -> "BCOND" DMBSY{} -> "DMBSY" + DMBISH{} -> "DMBISH" FCVT{} -> "FCVT" SCVTF{} -> "SCVTF" FCVTZS{} -> "FCVTZS" ===================================== compiler/GHC/CmmToAsm/AArch64/Ppr.hs ===================================== @@ -530,6 +530,7 @@ pprInstr platform instr = case instr of -- 8. Synchronization Instructions ------------------------------------------- DMBSY -> line $ text "\tdmb sy" + DMBISH -> line $ text "\tdmb ish" -- 9. Floating Point Instructions -------------------------------------------- FCVT o1 o2 -> op2 (text "\tfcvt") o1 o2 SCVTF o1 o2 -> op2 (text "\tscvtf") o1 o2 ===================================== compiler/GHC/CmmToAsm/PPC/CodeGen.hs ===================================== @@ -1126,9 +1126,9 @@ genCCall :: ForeignTarget -- function to call -> [CmmFormal] -- where to put the result -> [CmmActual] -- arguments (of mixed type) -> NatM InstrBlock -genCCall (PrimTarget MO_ReadBarrier) _ _ +genCCall (PrimTarget MO_AcquireFence) _ _ = return $ unitOL LWSYNC -genCCall (PrimTarget MO_WriteBarrier) _ _ +genCCall (PrimTarget MO_ReleaseFence) _ _ = return $ unitOL LWSYNC genCCall (PrimTarget MO_Touch) _ _ @@ -2094,8 +2094,8 @@ genCCall' config gcp target dest_regs args MO_AddIntC {} -> unsupported MO_SubIntC {} -> unsupported MO_U_Mul2 {} -> unsupported - MO_ReadBarrier -> unsupported - MO_WriteBarrier -> unsupported + MO_AcquireFence -> unsupported + MO_ReleaseFence -> unsupported MO_Touch -> unsupported MO_Prefetch_Data _ -> unsupported unsupported = panic ("outOfLineCmmOp: " ++ show mop ===================================== compiler/GHC/CmmToAsm/Wasm/FromCmm.hs ===================================== @@ -1186,8 +1186,8 @@ lower_CallishMachOp lbl MO_F32_ExpM1 rs xs = lower_CallishMachOp lbl MO_F32_Fabs rs xs = lower_CMO_Un_Homo lbl "fabsf" rs xs lower_CallishMachOp lbl MO_F32_Sqrt rs xs = lower_CMO_Un_Homo lbl "sqrtf" rs xs lower_CallishMachOp lbl (MO_UF_Conv w0) rs xs = lower_MO_UF_Conv lbl w0 rs xs -lower_CallishMachOp _ MO_ReadBarrier _ _ = pure $ WasmStatements WasmNop -lower_CallishMachOp _ MO_WriteBarrier _ _ = pure $ WasmStatements WasmNop +lower_CallishMachOp _ MO_AcquireFence _ _ = pure $ WasmStatements WasmNop +lower_CallishMachOp _ MO_ReleaseFence _ _ = pure $ WasmStatements WasmNop lower_CallishMachOp _ MO_Touch _ _ = pure $ WasmStatements WasmNop lower_CallishMachOp _ (MO_Prefetch_Data {}) _ _ = pure $ WasmStatements WasmNop lower_CallishMachOp lbl (MO_Memcpy {}) [] xs = do ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -2160,8 +2160,8 @@ genSimplePrim bid (MO_Memcpy align) [] [dst,src,n] = genMemCpy bid a genSimplePrim bid (MO_Memmove align) [] [dst,src,n] = genMemMove bid align dst src n genSimplePrim bid (MO_Memcmp align) [res] [dst,src,n] = genMemCmp bid align res dst src n genSimplePrim bid (MO_Memset align) [] [dst,c,n] = genMemSet bid align dst c n -genSimplePrim _ MO_ReadBarrier [] [] = return nilOL -- barriers compile to no code on x86/x86-64; -genSimplePrim _ MO_WriteBarrier [] [] = return nilOL -- we keep it this long in order to prevent earlier optimisations. +genSimplePrim _ MO_AcquireFence [] [] = return nilOL -- barriers compile to no code on x86/x86-64; +genSimplePrim _ MO_ReleaseFence [] [] = return nilOL -- we keep it this long in order to prevent earlier optimisations. genSimplePrim _ MO_Touch [] [_] = return nilOL genSimplePrim _ (MO_Prefetch_Data n) [] [src] = genPrefetchData n src genSimplePrim _ (MO_BSwap width) [dst] [src] = genByteSwap width dst src ===================================== compiler/GHC/CmmToC.hs ===================================== @@ -261,6 +261,11 @@ pprStmt platform stmt = CmmUnsafeForeignCall (PrimTarget MO_Touch) _results _args -> empty CmmUnsafeForeignCall (PrimTarget (MO_Prefetch_Data _)) _results _args -> empty + CmmUnsafeForeignCall (PrimTarget MO_ReleaseFence) [] [] -> + text "__atomic_thread_fence(__ATOMIC_RELEASE);" + CmmUnsafeForeignCall (PrimTarget MO_AcquireFence) [] [] -> + text "__atomic_thread_fence(__ATOMIC_ACQUIRE);" + CmmUnsafeForeignCall target@(PrimTarget op) results args -> fn_call where @@ -944,8 +949,8 @@ pprCallishMachOp_for_C mop MO_F32_ExpM1 -> text "expm1f" MO_F32_Sqrt -> text "sqrtf" MO_F32_Fabs -> text "fabsf" - MO_ReadBarrier -> text "load_load_barrier" - MO_WriteBarrier -> text "write_barrier" + MO_AcquireFence -> unsupported + MO_ReleaseFence -> unsupported MO_Memcpy _ -> text "__builtin_memcpy" MO_Memset _ -> text "__builtin_memset" MO_Memmove _ -> text "__builtin_memmove" ===================================== compiler/GHC/CmmToLlvm/CodeGen.hs ===================================== @@ -171,34 +171,15 @@ getInstrinct fname retTy parTys = fty = LMFunction funSig in getInstrinct2 fname fty --- | Memory barrier instruction for LLVM >= 3.0 -barrier :: LlvmM StmtData -barrier = do - let s = Fence False SyncSeqCst - return (unitOL s, []) - --- | Insert a 'barrier', unless the target platform is in the provided list of --- exceptions (where no code will be emitted instead). -barrierUnless :: [Arch] -> LlvmM StmtData -barrierUnless exs = do - platform <- getPlatform - if platformArch platform `elem` exs - then return (nilOL, []) - else barrier - -- | Foreign Calls genCall :: ForeignTarget -> [CmmFormal] -> [CmmActual] -> LlvmM StmtData -- Barriers need to be handled specially as they are implemented as LLVM -- intrinsic functions. -genCall (PrimTarget MO_ReadBarrier) _ _ = - barrierUnless [ArchX86, ArchX86_64] - -genCall (PrimTarget MO_WriteBarrier) _ _ = - barrierUnless [ArchX86, ArchX86_64] - -genCall (PrimTarget MO_Touch) _ _ = - return (nilOL, []) +genCall (PrimTarget MO_AcquireFence) _ _ = runStmtsDecls $ + statement $ Fence False SyncAcquire +genCall (PrimTarget MO_ReleaseFence) _ _ = runStmtsDecls $ + statement $ Fence False SyncRelease genCall (PrimTarget (MO_UF_Conv w)) [dst] [e] = runStmtsDecls $ do dstV <- getCmmRegW (CmmLocal dst) @@ -1008,8 +989,8 @@ cmmPrimOpFunctions mop = do -- We support MO_U_Mul2 through ordinary LLVM mul instruction, see the -- appropriate case of genCall. MO_U_Mul2 {} -> unsupported - MO_ReadBarrier -> unsupported - MO_WriteBarrier -> unsupported + MO_ReleaseFence -> unsupported + MO_AcquireFence -> unsupported MO_Touch -> unsupported MO_UF_Conv _ -> unsupported ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -2177,7 +2177,7 @@ doWritePtrArrayOp addr idx val -- This write barrier is to ensure that the heap writes to the object -- referred to by val have happened before we write val into the array. -- See #12469 for details. - emitPrimCall [] MO_WriteBarrier [] + emitPrimCall [] MO_ReleaseFence [] mkBasicIndexedWrite hdr_size addr ty idx val emit (setInfo addr (CmmLit (CmmLabel mkMAP_DIRTY_infoLabel))) @@ -3048,7 +3048,7 @@ doWriteSmallPtrArrayOp addr idx val = do mkBasicIndexedRead NaturallyAligned (smallArrPtrsHdrSize profile) Nothing ty tmp addr ty idx whenUpdRemSetEnabled $ emitUpdRemSetPush (CmmReg (CmmLocal tmp)) - emitPrimCall [] MO_WriteBarrier [] -- #12469 + emitPrimCall [] MO_ReleaseFence [] -- #12469 mkBasicIndexedWrite (smallArrPtrsHdrSize profile) addr ty idx val emit (setInfo addr (CmmLit (CmmLabel mkSMAP_DIRTY_infoLabel))) ===================================== rts/CloneStack.c ===================================== @@ -74,9 +74,7 @@ void sendCloneStackMessage(StgTSO *tso, HsStablePtr mvar) { msg = (MessageCloneStack *)allocate(srcCapability, sizeofW(MessageCloneStack)); msg->tso = tso; msg->result = (StgMVar*)deRefStablePtr(mvar); - SET_HDR(msg, &stg_MSG_CLONE_STACK_info, CCS_SYSTEM); - // Ensure that writes constructing Message are committed before sending. - write_barrier(); + SET_HDR_RELEASE(msg, &stg_MSG_CLONE_STACK_info, CCS_SYSTEM); sendMessage(srcCapability, tso->cap, (Message *)msg); } ===================================== rts/PrimOps.cmm ===================================== @@ -2505,8 +2505,8 @@ stg_unpackClosurezh ( P_ closure ) { W_ info, ptrs, nptrs, p, ptrs_arr, dat_arr; MAYBE_GC_P(stg_unpackClosurezh, closure); - info = %GET_STD_INFO(UNTAG(closure)); - prim_read_barrier; + info = GET_INFO_ACQUIRE(UNTAG(closure)); + info = %STD_INFO(info); ptrs = TO_W_(%INFO_PTRS(info)); nptrs = TO_W_(%INFO_NPTRS(info)); @@ -2820,8 +2820,7 @@ stg_noDuplicatezh /* no arg list: explicit stack layout */ stg_getApStackValzh ( P_ ap_stack, W_ offset ) { W_ ap_stackinfo; - ap_stackinfo = %INFO_PTR(UNTAG(ap_stack)); - prim_read_barrier; + ap_stackinfo = GET_INFO_ACQUIRE(UNTAG(ap_stack)); if (ap_stackinfo == stg_AP_STACK_info) { return (1,StgAP_STACK_payload(ap_stack,offset)); } else { ===================================== rts/RaiseAsync.c ===================================== @@ -238,7 +238,7 @@ throwToMsg (Capability *cap, MessageThrowTo *msg) goto check_target; retry: - write_barrier(); + RELEASE_FENCE(); debugTrace(DEBUG_sched, "throwTo: retrying..."); check_target: @@ -874,9 +874,10 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception, ap->payload[i] = (StgClosure *)*sp++; } - write_barrier(); // XXX: Necessary? SET_HDR(ap,&stg_AP_STACK_info, ((StgClosure *)frame)->header.prof.ccs /* ToDo */); + // N.B. This will be made visible by updateThunk below, which + // implies a release memory barrier. TICK_ALLOC_UP_THK(AP_STACK_sizeW(words),0); //IF_DEBUG(scheduler, ===================================== rts/RtsSymbols.c ===================================== @@ -929,9 +929,6 @@ extern char **environ; SymI_HasProto(hs_spt_remove) \ SymI_HasProto(hs_spt_keys) \ SymI_HasProto(hs_spt_key_count) \ - SymI_HasProto(write_barrier) \ - SymI_HasProto(store_load_barrier) \ - SymI_HasProto(load_load_barrier) \ SymI_HasProto(cas) \ SymI_HasProto(_assertFail) \ SymI_HasProto(keepCAFs) \ ===================================== rts/Sparks.c ===================================== @@ -209,8 +209,7 @@ pruneSparkQueue (bool nonmovingMarkFinished, Capability *cap) cap->spark_stats.fizzled++; traceEventSparkFizzle(cap); } else { - info = RELAXED_LOAD(&spark->header.info); - load_load_barrier(); + info = ACQUIRE_LOAD(&spark->header.info); if (IS_FORWARDING_PTR(info)) { tmp = (StgClosure*)UN_FORWARDING_PTR(info); /* if valuable work: shift inside the pool */ ===================================== rts/TopHandler.c ===================================== @@ -32,8 +32,7 @@ StgTSO *getTopHandlerThread(void) { // topHandlerPtr was never initialised return NULL; } - const StgInfoTable *info = weak->header.info; - load_load_barrier(); + const StgInfoTable *info = ACQUIRE_LOAD(&weak->header.info); if (info == &stg_WEAK_info) { StgClosure *key = ((StgWeak*)weak)->key; ===================================== rts/include/Cmm.h ===================================== @@ -677,21 +677,18 @@ * explicit ordered accesses to make ordering apparent to TSAN. */ -// Memory barriers. +// Memory barriers // For discussion of how these are used to fence heap object // accesses see Note [Heap memory barriers] in SMP.h. #if defined(THREADED_RTS) -#define prim_read_barrier prim %read_barrier() #define prim_write_barrier prim %write_barrier() // See Note [ThreadSanitizer and fences] -#define RELEASE_FENCE prim %write_barrier() -#define ACQUIRE_FENCE prim %read_barrier() +#define RELEASE_FENCE prim %fence_release(); +#define ACQUIRE_FENCE prim %fence_acquire(); #else -#define prim_read_barrier /* nothing */ -#define prim_write_barrier /* nothing */ #define RELEASE_FENCE /* nothing */ #define ACQUIRE_FENCE /* nothing */ #endif /* THREADED_RTS */ ===================================== rts/include/Stg.h ===================================== @@ -392,7 +392,7 @@ external prototype return neither of these types to workaround #11395. #endif #include "stg/Prim.h" /* ghc-prim fallbacks */ -#include "stg/SMP.h" // write_barrier() inline is required +#include "stg/SMP.h" /* ----------------------------------------------------------------------------- Moving Floats and Doubles ===================================== rts/include/stg/SMP.h ===================================== @@ -44,11 +44,6 @@ void arm_atomic_spin_unlock(void); ------------------------------------------------------------------------- */ #if !IN_STG_CODE || IN_STGCRUN -// We only want the barriers, e.g. write_barrier(), declared in .hc -// files. Defining the other inline functions here causes type -// mismatch errors from gcc, because the generated C code is assuming -// that there are no prototypes in scope. - /* * The atomic exchange operation: xchg(p,w) exchanges the value * pointed to by p with the value w, returning the old value. @@ -105,24 +100,6 @@ EXTERN_INLINE void busy_wait_nop(void); #endif // !IN_STG_CODE -/* - * Various kinds of memory barrier. - * write_barrier: prevents future stores occurring before preceding stores. - * store_load_barrier: prevents future loads occurring before preceding stores. - * load_load_barrier: prevents future loads occurring before earlier loads. - * - * Reference for these: "The JSR-133 Cookbook for Compiler Writers" - * http://gee.cs.oswego.edu/dl/jmm/cookbook.html - * - * To check whether you got these right, try the test in - * testsuite/tests/rts/testwsdeque.c - * This tests the work-stealing deque implementation, which relies on - * properly working store_load and load_load memory barriers. - */ -EXTERN_INLINE void write_barrier(void); -EXTERN_INLINE void store_load_barrier(void); -EXTERN_INLINE void load_load_barrier(void); - /* * Note [Heap memory barriers] * ~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -354,7 +331,7 @@ EXTERN_INLINE void load_load_barrier(void); * Exchange the value pointed to by p with w and return the former. This * function is used to acquire a lock. An acquire memory barrier is sufficient * for a lock operation because corresponding unlock operation issues a - * store-store barrier (write_barrier()) immediately before releasing the lock. + * store-store barrier (release-store) immediately before releasing the lock. */ EXTERN_INLINE StgWord xchg(StgPtr p, StgWord w) @@ -463,91 +440,6 @@ busy_wait_nop(void) #endif // !IN_STG_CODE -/* - * We need to tell both the compiler AND the CPU about the barriers. - * It's no good preventing the CPU from reordering the operations if - * the compiler has already done so - hence the "memory" restriction - * on each of the barriers below. - */ -EXTERN_INLINE void -write_barrier(void) { -#if defined(NOSMP) - return; -#elif defined(TSAN_ENABLED) - // RELEASE is a bit stronger than the store-store barrier provided by - // write_barrier, consequently we only use this case as a conservative - // approximation when using ThreadSanitizer. See Note [ThreadSanitizer]. - __atomic_thread_fence(__ATOMIC_RELEASE); -#elif defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) \ - || defined(powerpc64le_HOST_ARCH) - __asm__ __volatile__ ("lwsync" : : : "memory"); -#elif defined(s390x_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH) - __asm__ __volatile__ ("dmb st" : : : "memory"); -#elif defined(riscv64_HOST_ARCH) - __asm__ __volatile__ ("fence w,w" : : : "memory"); -#elif defined(loongarch64_HOST_ARCH) - __asm__ __volatile__ ("dbar 0" : : : "memory"); -#else -#error memory barriers unimplemented on this architecture -#endif -} - -EXTERN_INLINE void -store_load_barrier(void) { -#if defined(NOSMP) - return; -#elif defined(i386_HOST_ARCH) - __asm__ __volatile__ ("lock; addl $0,0(%%esp)" : : : "memory"); -#elif defined(x86_64_HOST_ARCH) - __asm__ __volatile__ ("lock; addq $0,0(%%rsp)" : : : "memory"); -#elif defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) \ - || defined(powerpc64le_HOST_ARCH) - __asm__ __volatile__ ("sync" : : : "memory"); -#elif defined(s390x_HOST_ARCH) - __asm__ __volatile__ ("bcr 14,0" : : : "memory"); -#elif defined(arm_HOST_ARCH) - __asm__ __volatile__ ("dmb" : : : "memory"); -#elif defined(aarch64_HOST_ARCH) - __asm__ __volatile__ ("dmb sy" : : : "memory"); -#elif defined(riscv64_HOST_ARCH) - __asm__ __volatile__ ("fence w,r" : : : "memory"); -#elif defined(loongarch64_HOST_ARCH) - __asm__ __volatile__ ("dbar 0" : : : "memory"); -#else -#error memory barriers unimplemented on this architecture -#endif -} - -EXTERN_INLINE void -load_load_barrier(void) { -#if defined(NOSMP) - return; -#elif defined(i386_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(x86_64_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) \ - || defined(powerpc64le_HOST_ARCH) - __asm__ __volatile__ ("lwsync" : : : "memory"); -#elif defined(s390x_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(arm_HOST_ARCH) - __asm__ __volatile__ ("dmb" : : : "memory"); -#elif defined(aarch64_HOST_ARCH) - __asm__ __volatile__ ("dmb ld" : : : "memory"); -#elif defined(riscv64_HOST_ARCH) - __asm__ __volatile__ ("fence r,r" : : : "memory"); -#elif defined(loongarch64_HOST_ARCH) - __asm__ __volatile__ ("dbar 0" : : : "memory"); -#else -#error memory barriers unimplemented on this architecture -#endif -} - // Load a pointer from a memory location that might be being modified // concurrently. This prevents the compiler from optimising away // multiple loads of the memory location, as it might otherwise do in @@ -586,13 +478,6 @@ load_load_barrier(void) { /* ---------------------------------------------------------------------- */ #else /* !THREADED_RTS */ -EXTERN_INLINE void write_barrier(void); -EXTERN_INLINE void store_load_barrier(void); -EXTERN_INLINE void load_load_barrier(void); -EXTERN_INLINE void write_barrier () {} /* nothing */ -EXTERN_INLINE void store_load_barrier() {} /* nothing */ -EXTERN_INLINE void load_load_barrier () {} /* nothing */ - // Relaxed atomic operations #define RELAXED_LOAD(ptr) *ptr #define RELAXED_STORE(ptr,val) *ptr = val ===================================== rts/sm/Evac.c ===================================== @@ -1394,8 +1394,7 @@ selector_loop: // the same selector thunk. SET_INFO((StgClosure*)p, (StgInfoTable *)info_ptr); OVERWRITING_CLOSURE((StgClosure*)p); - SET_INFO((StgClosure*)p, &stg_WHITEHOLE_info); - write_barrier(); + SET_INFO_RELEASE((StgClosure*)p, &stg_WHITEHOLE_info); #if defined(PARALLEL_GC) abort(); // LDV is incompatible with parallel GC #endif ===================================== rts/sm/GC.c ===================================== @@ -1508,7 +1508,6 @@ waitForGcThreads (Capability *cap, bool idle_cap[]) if (i == me || idle_cap[i]) { continue; } if (SEQ_CST_LOAD(&gc_threads[i]->wakeup) != GC_THREAD_STANDING_BY) { prodCapability(getCapability(i), cap->running_task); - write_barrier(); interruptCapability(getCapability(i)); } } ===================================== rts/sm/GCAux.c ===================================== @@ -91,8 +91,8 @@ isAlive(StgClosure *p) return TAG_CLOSURE(tag,(StgClosure*)UN_FORWARDING_PTR(info)); } + ACQUIRE_LOAD(&q->header.info); info = INFO_PTR_TO_STRUCT(info); - load_load_barrier(); switch (info->type) { ===================================== rts/sm/Sanity.c ===================================== @@ -355,8 +355,7 @@ checkClosure( const StgClosure* p ) p = UNTAG_CONST_CLOSURE(p); - info = p->header.info; - load_load_barrier(); + info = ACQUIRE_LOAD(&p->header.info); if (IS_FORWARDING_PTR(info)) { barf("checkClosure: found EVACUATED closure %d", info->type); @@ -367,7 +366,6 @@ checkClosure( const StgClosure* p ) #endif info = INFO_PTR_TO_STRUCT(info); - load_load_barrier(); switch (info->type) { @@ -772,8 +770,7 @@ checkSTACK (StgStack *stack) void checkTSO(StgTSO *tso) { - const StgInfoTable *info = (const StgInfoTable*) tso->_link->header.info; - load_load_barrier(); + const StgInfoTable *info = (const StgInfoTable*) ACQUIRE_LOAD(&tso->_link)->header.info; ASSERT(tso->_link == END_TSO_QUEUE || info == &stg_MVAR_TSO_QUEUE_info || ===================================== testsuite/tests/rts/testwsdeque.c ===================================== @@ -34,47 +34,25 @@ void * myStealWSDeque_ (WSDeque *q, uint32_t n) { void * stolen; - StgWord b,t; // Can't do this on someone else's spark pool: // ASSERT_WSDEQUE_INVARIANTS(q); // NB. these loads must be ordered, otherwise there is a race // between steal and pop. - t = q->top; - load_load_barrier(); - b = q->bottom; + StgWord t = ACQUIRE_LOAD(&q->top); + SEQ_CST_FENCE(); + StgWord b = ACQUIRE_LOAD(&q->bottom); - // NB. b and t are unsigned; we need a signed value for the test - // below, because it is possible that t > b during a - // concurrent popWSQueue() operation. - if ((long)b - (long)t <= 0 ) { - return NULL; /* already looks empty, abort */ + void *result = NULL; + if (t < b) { + /* Non-empty queue */ + result = RELAXED_LOAD(&q->elements[t % q->size]); + if (!cas_top(q, t, t+1)) { + return NULL; + } } - // NB. the load of q->bottom must be ordered before the load of - // q->elements[t & q-> moduloSize]. See comment "KG:..." below - // and Ticket #13633. - load_load_barrier(); - /* now access array, see pushBottom() */ - stolen = q->elements[t & q->moduloSize]; - - /* now decide whether we have won */ - if ( !(CASTOP(&(q->top),t,t+1)) ) { - /* lost the race, someone else has changed top in the meantime */ - return NULL; - } /* else: OK, top has been incremented by the cas call */ - - // debugBelch("stealWSDeque_: t=%d b=%d\n", t, b); - -// Can't do this on someone else's spark pool: -// ASSERT_WSDEQUE_INVARIANTS(q); - - bufs[n] ++; - if (bufs[n] == BUF) { bufs[n] = 0; } - last_b[n][bufs[n]] = b; - last_t[n][bufs[n]] = t; - last_v[n][bufs[n]] = (StgWord)stolen; - return stolen; + return result; } void * View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/89df56ce4d208a5b2dc92290d587786ad58a58ed...1e7b6cc1eab4526f77da5db219546e4a58cae70d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/89df56ce4d208a5b2dc92290d587786ad58a58ed...1e7b6cc1eab4526f77da5db219546e4a58cae70d You're receiving 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 Jun 21 16:01:14 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 21 Jun 2023 12:01:14 -0400 Subject: [Git][ghc/ghc][wip/tsan/fixes-2] 97 commits: Restore mingwex dependency on Windows Message-ID: <64931eca6d189_1cc9ddc5ee07652@gitlab.mail> Ben Gamari pushed to branch wip/tsan/fixes-2 at Glasgow Haskell Compiler / GHC Commits: 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 97cb2d85 by Ben Gamari at 2023-06-21T11:56:52-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - 01d6d432 by Ben Gamari at 2023-06-21T11:56:52-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 3e13ab42 by Ben Gamari at 2023-06-21T11:56:52-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - 4147848e by Ben Gamari at 2023-06-21T11:56:52-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 402a3ee6 by Ben Gamari at 2023-06-21T11:56:52-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 55b6f730 by Sven Tennie at 2023-06-21T11:56:52-04:00 compiler: Drop MO_ReadBarrier - - - - - 21e9428e by Ben Gamari at 2023-06-21T11:56:52-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 1e7b6cc1 by Sven Tennie at 2023-06-21T11:56:52-04:00 Delete write_barrier function - - - - - 4a117a46 by Ben Gamari at 2023-06-21T12:00:25-04:00 compiler: Style fixes - - - - - 3973de79 by Ben Gamari at 2023-06-21T12:00:25-04:00 rts/IPE: Fix unused mutex warning - - - - - 1bcb20e1 by Ben Gamari at 2023-06-21T12:00:25-04:00 rts: Fix implicit cast This ensures that Task.h can be built with a C++ compiler. - - - - - 7d423338 by Ben Gamari at 2023-06-21T12:00:25-04:00 rts: Fix data race in threadPaused This only affects an assertion in the debug RTS, but it's a data race nevertheless. - - - - - 755b423e by Ben Gamari at 2023-06-21T12:00:25-04:00 cmm: Introduce MO_RelaxedRead In hand-written Cmm it can sometimes be necessary to atomically load from memory deep within an expression (e.g. see the `CHECK_GC` macro). This MachOp provides a convenient way to do so without breaking the expression into multiple statements. - - - - - 17ccec19 by Ben Gamari at 2023-06-21T12:00:25-04:00 rts: Silence spurious data races in ticky counters Previously we would use non-atomic accesses when bumping ticky counters, which would result in spurious data race reports from ThreadSanitizer when the threaded RTS was in use. - - - - - 7b5d5df8 by Ben Gamari at 2023-06-21T12:00:25-04:00 Improve TSAN documentation - - - - - a1e8b09b by Ben Gamari at 2023-06-21T12:00:25-04:00 rts: Fix data race in Interpreter's preemption check - - - - - 2badaea2 by Ben Gamari at 2023-06-21T12:00:25-04:00 rts: Fix data race in threadStatus# - - - - - 69f0fb88 by Ben Gamari at 2023-06-21T12:00:25-04:00 rts: Fix data race in CHECK_GC - - - - - b83a32ff by Ben Gamari at 2023-06-21T12:00:25-04:00 base: use atomic write when updating timer manager - - - - - 94f8ac8c by Ben Gamari at 2023-06-21T12:00:25-04:00 Use relaxed atomics to manipulate TSO status fields - - - - - 0111680e by Ben Gamari at 2023-06-21T12:00:25-04:00 rts: Add necessary barriers when manipulating TSO owner - - - - - c2826d70 by Ben Gamari at 2023-06-21T12:00:25-04:00 rts: Fix synchronization on thread blocking state - - - - - 6d90fb45 by Ben Gamari at 2023-06-21T12:00:25-04:00 rts: Relaxed load MutVar info table - - - - - e1d7f306 by Ben Gamari at 2023-06-21T12:00:25-04:00 hadrian: More debug information - - - - - 000bb564 by Ben Gamari at 2023-06-21T12:00:25-04:00 hadrian: More selective TSAN instrumentation - - - - - 06b71989 by Ben Gamari at 2023-06-21T12:00:25-04:00 codeGen/tsan: Rework handling of spilling - - - - - 4bd438a5 by Ben Gamari at 2023-06-21T12:00:58-04:00 codeGen: Ensure that TSAN is aware of writeArray# write barriers - - - - - ff9624a4 by Ben Gamari at 2023-06-21T12:00:59-04:00 codeGen: Ensure that array reads have necessary barriers This was the cause of #23541. - - - - - 4626e476 by Ben Gamari at 2023-06-21T12:00:59-04:00 Wordsmith TSAN Note - - - - - a4e9bf78 by Ben Gamari at 2023-06-21T12:00:59-04:00 codeGen: Use relaxed accesses in ticky bumping - - - - - f847b67a by Ben Gamari at 2023-06-21T12:00:59-04:00 codeGen: Use relaxed-read in closureInfoPtr - - - - - d03a70ac by Ben Gamari at 2023-06-21T12:01:00-04:00 Fix thunk update ordering Previously we attempted to ensure soundness of concurrent thunk update by synchronizing on the access of the thunk's info table pointer field. This was believed to be sufficient since the indirectee (which may expose a closure allocated by another core) would not be examined until the info table pointer update is complete. However, it turns out that this can result in data races in the presence of multiple threads racing a update a single thunk. For instance, consider this interleaving under the old scheme: Thread A Thread B --------- --------- t=0 Enter t 1 Push update frame 2 Begin evaluation 4 Pause thread 5 t.indirectee=tso 6 Release t.info=BLACKHOLE 7 ... (e.g. GC) 8 Resume thread 9 Finish evaluation 10 Relaxed t.indirectee=x 11 Load t.info 12 Acquire fence 13 Inspect t.indirectee 14 Release t.info=BLACKHOLE Here Thread A enters thunk `t` but is soon paused, resulting in `t` being lazily blackholed at t=6. Then, at t=10 Thread A finishes evaluation and updates `t.indirectee` with a relaxed store. Meanwhile, Thread B enters the blackhole. Under the old scheme this would introduce an acquire-fence but this would only synchronize with Thread A at t=6. Consequently, the result of the evaluation, `x`, is not visible to Thread B, introducing a data race. We fix this by treating the `indirectee` field as we do all other mutable fields. This means we must always access this field with acquire-loads and release-stores. See #23185. - - - - - 55efcd83 by Ben Gamari at 2023-06-21T12:01:00-04:00 STM: Use acquire loads when possible Full sequential consistency is not needed here. - - - - - 1d6caacc by Ubuntu at 2023-06-21T12:01:00-04:00 ghc-prim: Use C11 atomics - - - - - a177f3fe by Ubuntu at 2023-06-21T12:01:00-04:00 Run script - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Info.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a382b0bf1073f01799a5d482dca0ca81404e61da...a177f3fe91f796331bc0abfb84aaf55b1186821d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a382b0bf1073f01799a5d482dca0ca81404e61da...a177f3fe91f796331bc0abfb84aaf55b1186821d You're receiving 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 Jun 21 16:05:20 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 21 Jun 2023 12:05:20 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] 27 commits: Avoid desugaring non-recursive lets into recursive lets Message-ID: <64931fc0bca08_1cc9ddc5f30771b0@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 95152283 by Ben Gamari at 2023-06-21T12:04:59-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - cc2f3ecf by Ben Gamari at 2023-06-21T12:04:59-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Runtime/Context.hs - compiler/GHC/Runtime/Interpreter.hs - + compiler/GHC/Runtime/Interpreter/JS.hs - + compiler/GHC/Runtime/Interpreter/Process.hs - compiler/GHC/Runtime/Interpreter/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/128b0d5c8a8711e5326c28d69375456e09a23ade...cc2f3ecf2914d97b4ade3f5339c4a97fec082d2a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/128b0d5c8a8711e5326c28d69375456e09a23ade...cc2f3ecf2914d97b4ade3f5339c4a97fec082d2a You're receiving 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 Jun 21 16:58:52 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 21 Jun 2023 12:58:52 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] 2 commits: Add support for deprecating exported items (proposal #134) Message-ID: <64932c4c6560_1cc9ddc5f30916c9@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: 4904d007 by Ben Gamari at 2023-06-21T12:58:37-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 9796d612 by Ben Gamari at 2023-06-21T12:58:37-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Utils/Backpack.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/GHC/Types/Name/Env.hs - compiler/GHC/Types/Name/Reader.hs - compiler/GHC/Unit/Module/ModIface.hs - compiler/GHC/Unit/Module/Warnings.hs - configure.ac The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cc2f3ecf2914d97b4ade3f5339c4a97fec082d2a...9796d612ed44296f2c6752830923938c20b70a36 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cc2f3ecf2914d97b4ade3f5339c4a97fec082d2a...9796d612ed44296f2c6752830923938c20b70a36 You're receiving 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 Jun 21 16:59:45 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 21 Jun 2023 12:59:45 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] 2 commits: Add support for deprecating exported items (proposal #134) Message-ID: <64932c81496ca_1cc9ddc5f1c921a5@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Utils/Backpack.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/GHC/Types/Name/Env.hs - compiler/GHC/Types/Name/Reader.hs - compiler/GHC/Unit/Module/ModIface.hs - compiler/GHC/Unit/Module/Warnings.hs - configure.ac The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9796d612ed44296f2c6752830923938c20b70a36...c18658545ce45254a4679c13de5dcc56a4c8373f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9796d612ed44296f2c6752830923938c20b70a36...c18658545ce45254a4679c13de5dcc56a4c8373f You're receiving 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 Jun 21 19:35:16 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 21 Jun 2023 15:35:16 -0400 Subject: [Git][ghc/ghc][master] 10 commits: Memory usage fixes for Haddock Message-ID: <649350f47f82e_1cc9ddc5f30115331@gitlab.mail> Ben Gamari pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 95152283 by Ben Gamari at 2023-06-21T12:04:59-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - cc2f3ecf by Ben Gamari at 2023-06-21T12:04:59-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Runtime/Context.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/Loader.hs - + compiler/GHC/Runtime/Utils.hs - compiler/GHC/Stg/FVs.hs - compiler/GHC/Stg/Pipeline.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0ff1c5017d7d32cc92ac1ac6f54e12471658d167...cc2f3ecf2914d97b4ade3f5339c4a97fec082d2a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0ff1c5017d7d32cc92ac1ac6f54e12471658d167...cc2f3ecf2914d97b4ade3f5339c4a97fec082d2a You're receiving 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 Jun 21 19:36:00 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 21 Jun 2023 15:36:00 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Add support for deprecating exported items (proposal #134) Message-ID: <649351209884d_1cc9dd1814f394117369@gitlab.mail> Ben Gamari pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Utils/Backpack.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/GHC/Types/Name/Env.hs - compiler/GHC/Types/Name/Reader.hs - compiler/GHC/Unit/Module/ModIface.hs - compiler/GHC/Unit/Module/Warnings.hs - configure.ac The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cc2f3ecf2914d97b4ade3f5339c4a97fec082d2a...c18658545ce45254a4679c13de5dcc56a4c8373f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cc2f3ecf2914d97b4ade3f5339c4a97fec082d2a...c18658545ce45254a4679c13de5dcc56a4c8373f You're receiving 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 Jun 21 20:08:34 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 21 Jun 2023 16:08:34 -0400 Subject: [Git][ghc/ghc][ghc-9.8] 27 commits: Avoid desugaring non-recursive lets into recursive lets Message-ID: <649358c2c91ee_198842c64304614e@gitlab.mail> Ben Gamari pushed to branch ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Runtime/Context.hs - compiler/GHC/Runtime/Interpreter.hs - + compiler/GHC/Runtime/Interpreter/JS.hs - + compiler/GHC/Runtime/Interpreter/Process.hs - compiler/GHC/Runtime/Interpreter/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/128b0d5c8a8711e5326c28d69375456e09a23ade...c18658545ce45254a4679c13de5dcc56a4c8373f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/128b0d5c8a8711e5326c28d69375456e09a23ade...c18658545ce45254a4679c13de5dcc56a4c8373f You're receiving 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 Jun 22 00:15:46 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Wed, 21 Jun 2023 20:15:46 -0400 Subject: [Git][ghc/ghc][wip/expand-do] 40 commits: Avoid desugaring non-recursive lets into recursive lets Message-ID: <649392b22e258_1988424d64af858762@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - d9169e81 by Apoorv Ingle at 2023-06-21T19:14:21-05:00 Fixes #18324 #23147 Expands do notation before typechecking using `HsExpansion` - Adds testcases T18324, T18324b, DoubleMatch Expands - Do statements - Monadic do statements - monadic fix blocks - make sure fail is used for pattern match failures in bind statments - Makes sure unused binds generate warnings - runs the pattern match check in generated lambda exprs to avoid getting suprious pattern match failures. c.f. pmcheck/should_compile/DoubleMatch.hs - PopSrcSpan in HsExpr to pop error context - Discards default monad fail alternatives that are spuriously generated - Make sure we check for generated loc span for checking if the (>>) is user written or expanded for /do/ purposes - - - - - 747b59d8 by Apoorv Ingle at 2023-06-21T19:14:25-05:00 - Add PopSrcSpan (XXExprGhcRn) in appropriate places while expanding statements - correct source spans displayed for warnDiscardedDoBindings - use `mkExpandStmt` to store original stmts along with expanded expr for using the right context for error message printing - improves error messages for applicative do - remove special case from isMatchContextPmChecked (long distance info is now properly propogated) - set correct src spans to statement expansions - Match ctxt while type checking HsLam is different if the lambda match is due to an expression generated from a do block - call tcExpr and not tcApp in PopSrcSpan so make sure impredicativity works fine - look into XExprs in tcInferAppHead_maybe for infering the type to make T18324 typecheck and run - - - - - ad45def2 by Apoorv Ingle at 2023-06-21T19:14:25-05:00 generate incomplete uni patterns warnings if the origin context is a generated do expansion - - - - - bc3951a5 by Apoorv Ingle at 2023-06-21T19:14:25-05:00 use the correct bind operator for qualified rebindable rec do expansions - - - - - 562ec532 by Apoorv Ingle at 2023-06-21T19:14:25-05:00 trying out changes to heralds - - - - - aec892ff by Apoorv Ingle at 2023-06-21T19:14:25-05:00 add location information for last statements - - - - - 7d9b6145 by Apoorv Ingle at 2023-06-21T19:14:25-05:00 do not pop context while checking the second argument to expanded (>>) - - - - - bbda0942 by Apoorv Ingle at 2023-06-21T19:14:26-05:00 adjusting the generated spans for proper error messages - - - - - 33816587 by Apoorv Ingle at 2023-06-21T19:14:26-05:00 change the addHeadCtxt to include the first statement of the do block for more precise error messages - - - - - b2738df1 by Apoorv Ingle at 2023-06-21T19:14:26-05:00 - don't add any ctxt in addExprCtxt for `XExpr(ExpandedStmt{})` as it is not very useful, the statement ctxt is already added by `tcExpr` and `addHeadCtxt` - - - - - 10791bad by Apoorv Ingle at 2023-06-21T19:14:26-05:00 - addStmtCtxt to add the right statement context in the error contexts - expansion stmt to span over bind/>>= application and pattern rather than only the arguments - - - - - a60953dd by Apoorv Ingle at 2023-06-21T19:14:26-05:00 add stmt context in tcApp rather other places - - - - - ba37e108 by Apoorv Ingle at 2023-06-21T19:14:26-05:00 add the correct expression context in tcApp - - - - - 30 changed files: - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Linker/Loader.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fdf15de19955418e067fcee0e81e8cfda6243aea...ba37e108a1ba9be5b4ae996c4c75dc74d764d12c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fdf15de19955418e067fcee0e81e8cfda6243aea...ba37e108a1ba9be5b4ae996c4c75dc74d764d12c You're receiving 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 Jun 22 01:06:00 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 21 Jun 2023 21:06:00 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/fix-smp Message-ID: <64939e78946ea_198842ebe7cc6329f@gitlab.mail> Ben Gamari pushed new branch wip/fix-smp at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fix-smp You're receiving 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 Jun 22 01:08:10 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 21 Jun 2023 21:08:10 -0400 Subject: [Git][ghc/ghc][master] configure: Bump version to 9.9 Message-ID: <64939efaac6d1_1988423fc6406527@gitlab.mail> Ben Gamari pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 2 changed files: - configure.ac - utils/haddock 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.8], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.9], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) # Version on master must be X.Y (not X.Y.Z) for ProjectVersionMunged variable # to be useful (cf #19058). However, the version must have three components # (X.Y.Z) on stable branches (e.g. ghc-9.2) to ensure that pre-releases are ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 4bf963f87b5d994b1ddc72ee4bd2bd968637e2de +Subproject commit 495c0655dcb9a9482054c5e48c0106f57f5ddb06 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4e1de71cd561d39fbc6bf95a62045b918761e077 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4e1de71cd561d39fbc6bf95a62045b918761e077 You're receiving 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 Jun 22 01:08:17 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 21 Jun 2023 21:08:17 -0400 Subject: [Git][ghc/ghc] Pushed new tag ghc-9.9-start Message-ID: <64939f011153d_1988423fc640658b4@gitlab.mail> Ben Gamari pushed new tag ghc-9.9-start at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/ghc-9.9-start You're receiving 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 Jun 22 07:33:05 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 22 Jun 2023 03:33:05 -0400 Subject: [Git][ghc/ghc][wip/T22010] Use Word64 for hoopl labels Message-ID: <6493f9319e657_19884268e46d4776e1@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 783893e1 by Jaro Reinders at 2023-06-22T09:32:59+02:00 Use Word64 for hoopl labels - - - - - 3 changed files: - compiler/GHC/Cmm/BlockId.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs Changes: ===================================== compiler/GHC/Cmm/BlockId.hs ===================================== @@ -34,8 +34,7 @@ compilation unit in which it appears. type BlockId = Label mkBlockId :: Unique -> BlockId -mkBlockId unique = mkHooplLabel $ fromIntegral $ getKey unique --- TODO: should BlockIds also use Word64? +mkBlockId unique = mkHooplLabel $ getKey unique newBlockId :: MonadUnique m => m BlockId newBlockId = mkBlockId <$> getUniqueM ===================================== compiler/GHC/Cmm/Dataflow/Collections.hs ===================================== @@ -12,10 +12,11 @@ module GHC.Cmm.Dataflow.Collections import GHC.Prelude -import qualified Data.IntMap.Strict as M -import qualified Data.IntSet as S +import qualified GHC.Data.Word64Map.Strict as M +import qualified GHC.Data.Word64Set as S import Data.List (foldl1') +import Data.Word (Word64) class IsSet set where type ElemOf set @@ -107,10 +108,10 @@ mapUnions maps = foldl1' mapUnion maps -- Basic instances ----------------------------------------------------------------------------- -newtype UniqueSet = US S.IntSet deriving (Eq, Ord, Show, Semigroup, Monoid) +newtype UniqueSet = US S.Word64Set deriving (Eq, Ord, Show, Semigroup, Monoid) instance IsSet UniqueSet where - type ElemOf UniqueSet = Int + type ElemOf UniqueSet = Word64 setNull (US s) = S.null s setSize (US s) = S.size s @@ -133,11 +134,11 @@ instance IsSet UniqueSet where setElems (US s) = S.elems s setFromList ks = US (S.fromList ks) -newtype UniqueMap v = UM (M.IntMap v) +newtype UniqueMap v = UM (M.Word64Map v) deriving (Eq, Ord, Show, Functor, Foldable, Traversable) instance IsMap UniqueMap where - type KeyOf UniqueMap = Int + type KeyOf UniqueMap = Word64 mapNull (UM m) = M.null m mapSize (UM m) = M.size m ===================================== compiler/GHC/Cmm/Dataflow/Label.hs ===================================== @@ -22,16 +22,17 @@ import GHC.Cmm.Dataflow.Collections import GHC.Types.Unique (Uniquable(..)) import GHC.Data.TrieMap +import Data.Word (Word64) ----------------------------------------------------------------------------- -- Label ----------------------------------------------------------------------------- -newtype Label = Label { lblToUnique :: Int } +newtype Label = Label { lblToUnique :: Word64 } deriving (Eq, Ord) -mkHooplLabel :: Int -> Label +mkHooplLabel :: Word64 -> Label mkHooplLabel = Label instance Show Label where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/783893e198366718f52f361954a77598bfdb8c80 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/783893e198366718f52f361954a77598bfdb8c80 You're receiving 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 Jun 22 10:07:18 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 22 Jun 2023 06:07:18 -0400 Subject: [Git][ghc/ghc][wip/T22010] Fix Word64Set Message-ID: <64941d56d89b5_1988426ebca989427a@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 8f6a284d by Jaro Reinders at 2023-06-22T12:07:02+02:00 Fix Word64Set - - - - - 3 changed files: - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Data/Word64Map/Internal.hs - compiler/GHC/Data/Word64Set/Internal.hs Changes: ===================================== compiler/GHC/Cmm/LRegSet.hs ===================================== @@ -27,7 +27,7 @@ import GHC.Data.Word64Set as Word64Set -- Compact sets for membership tests of local variables. type LRegSet = Word64Set.Word64Set -type LRegKey = Int +type LRegKey = Word64 emptyLRegSet :: LRegSet emptyLRegSet = Word64Set.empty ===================================== compiler/GHC/Data/Word64Map/Internal.hs ===================================== @@ -3088,7 +3088,7 @@ keysSet (Bin p m l r) fromSet :: (Key -> a) -> Word64Set.Word64Set -> Word64Map a fromSet _ Word64Set.Nil = Nil fromSet f (Word64Set.Bin p m l r) = Bin p m (fromSet f l) (fromSet f r) -fromSet f (Word64Set.Tip kx bm) = buildTree f kx bm (fromIntegral (Word64Set.suffixBitMask + 1)) +fromSet f (Word64Set.Tip kx bm) = buildTree f kx bm (Word64Set.suffixBitMask + 1) where -- This is slightly complicated, as we to convert the dense -- representation of Word64Set into tree representation of Word64Map. ===================================== compiler/GHC/Data/Word64Set/Internal.hs ===================================== @@ -1568,7 +1568,7 @@ indexOfTheOnlyBit bitmask = fromIntegral $ countTrailingZeros bitmask lowestBitSet x = fromIntegral $ countTrailingZeros x -highestBitSet x = fromIntegral $ WORD_SIZE_IN_BITS - 1 - countLeadingZeros x +highestBitSet x = fromIntegral $ 63 - countLeadingZeros x lowestBitMask :: Nat -> Nat lowestBitMask x = x .&. negate x @@ -1598,21 +1598,21 @@ foldl'Bits prefix f z bitmap = go bitmap z foldrBits prefix f z bitmap = go (revNat bitmap) z where go 0 acc = acc - go bm acc = go (bm `xor` bitmask) ((f $! (prefix+(WORD_SIZE_IN_BITS-1)-bi)) acc) + go bm acc = go (bm `xor` bitmask) ((f $! (prefix+63-bi)) acc) where !bitmask = lowestBitMask bm !bi = indexOfTheOnlyBit bitmask foldr'Bits prefix f z bitmap = go (revNat bitmap) z where go 0 acc = acc - go bm !acc = go (bm `xor` bitmask) ((f $! (prefix+(WORD_SIZE_IN_BITS-1)-bi)) acc) + go bm !acc = go (bm `xor` bitmask) ((f $! (prefix+63-bi)) acc) where !bitmask = lowestBitMask bm !bi = indexOfTheOnlyBit bitmask takeWhileAntitoneBits prefix predicate bitmap = -- Binary search for the first index where the predicate returns false, but skip a predicate -- call if the high half of the current range is empty. This ensures - -- min (log2 WORD_SIZE_IN_BITS + 1) (popcount bitmap) predicate calls. + -- min (log2 64 + 1 = 7) (popcount bitmap) predicate calls. let next d h (n',b') = if n' .&. h /= 0 && (predicate $! prefix + fromIntegral (b'+d)) then (n' `shiftRL` d, b'+d) else (n',b') {-# INLINE next #-} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8f6a284d2e50d8f1b43387e55c63cc8238891767 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8f6a284d2e50d8f1b43387e55c63cc8238891767 You're receiving 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 Jun 22 12:38:25 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 22 Jun 2023 08:38:25 -0400 Subject: [Git][ghc/ghc][wip/T22010] Revert "Make GHCi work with 64-bit uniques" Message-ID: <649440c1da4c3_1988429386860117994@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 39592e1d by Jaro Reinders at 2023-06-22T14:38:12+02:00 Revert "Make GHCi work with 64-bit uniques" This reverts commit c962ef3bf43b09770298a9f195e104c02b25d7e2. - - - - - 2 changed files: - libraries/ghci/GHCi/Message.hs - libraries/ghci/GHCi/Run.hs Changes: ===================================== libraries/ghci/GHCi/Message.hs ===================================== @@ -380,7 +380,7 @@ data EvalStatus_ a b | EvalBreak Bool HValueRef{- AP_STACK -} Int {- break index -} - Word64 {- uniq of ModuleName -} + Int {- uniq of ModuleName -} (RemoteRef (ResumeContext b)) (RemotePtr CostCentreStack) -- Cost centre stack deriving (Generic, Show) ===================================== libraries/ghci/GHCi/Run.hs ===================================== @@ -40,7 +40,6 @@ import GHC.Conc.Sync import GHC.IO hiding ( bracket ) import System.Mem.Weak ( deRefWeak ) import Unsafe.Coerce -import GHC.Word -- ----------------------------------------------------------------------------- -- Implement messages @@ -294,11 +293,7 @@ withBreakAction opts breakMVar statusMVar act resume_r <- mkRemoteRef resume apStack_r <- mkRemoteRef apStack ccs <- toRemotePtr <$> getCCSOf apStack -#if !MIN_VERSION_GLASGOW_HASKELL(9,3,0,0) || WORD_SIZE_IN_BITS < 64 - putMVar statusMVar $ EvalBreak is_exception apStack_r (I# ix#) (W64# uniq#) resume_r ccs -#else - putMVar statusMVar $ EvalBreak is_exception apStack_r (I# ix#) (W64# (word64ToWord# uniq#)) resume_r ccs -#endif + putMVar statusMVar $ EvalBreak is_exception apStack_r (I# ix#) uniq# resume_r ccs takeMVar breakMVar resetBreakAction stablePtr = do @@ -347,7 +342,7 @@ resetStepFlag = poke stepFlag 0 type BreakpointCallback = Int# -- the breakpoint index - -> Word64# -- the module uniq + -> Int# -- the module uniq -> Bool -- exception? -> HValue -- the AP_STACK, or exception -> IO () View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/39592e1d48add9a7da1fb2367f0ceef9c3a1272e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/39592e1d48add9a7da1fb2367f0ceef9c3a1272e You're receiving 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 Jun 22 12:42:43 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 22 Jun 2023 08:42:43 -0400 Subject: [Git][ghc/ghc][wip/T22010] Fix type error in Interpreter.hs Message-ID: <649441c339d9e_198842c652de811842c@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 9e568111 by Jaro Reinders at 2023-06-22T14:42:37+02:00 Fix type error in Interpreter.hs - - - - - 1 changed file: - compiler/GHC/Runtime/Interpreter.hs Changes: ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -398,7 +398,7 @@ handleSeqHValueStatus interp unit_env eval_status = resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt let hmi = expectJust "handleRunStatus" $ lookupHptDirectly (ue_hpt unit_env) - (mkUniqueGrimily mod_uniq) + (mkUniqueGrimily (fromIntegral mod_uniq)) modl = mi_module (hm_iface hmi) bp | is_exception = Nothing | otherwise = Just (BreakInfo modl ix) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9e568111b5600d687859c5d3e9d458d7a541cc4d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9e568111b5600d687859c5d3e9d458d7a541cc4d You're receiving 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 Jun 22 12:48:12 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 22 Jun 2023 08:48:12 -0400 Subject: [Git][ghc/ghc][wip/T22010] Fix type errors in Eval.hs Message-ID: <6494430cf0ef_1988426ab53001189e@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 88dc0eac by Jaro Reinders at 2023-06-22T14:48:04+02:00 Fix type errors in Eval.hs - - - - - 1 changed file: - compiler/GHC/Runtime/Eval.hs Changes: ===================================== compiler/GHC/Runtime/Eval.hs ===================================== @@ -333,7 +333,7 @@ handleRunStatus step expr bindings final_ids status history let dflags = hsc_dflags hsc_env let hmi = expectJust "handleRunStatus" $ lookupHptDirectly (hsc_HPT hsc_env) - (mkUniqueGrimily mod_uniq) + (mkUniqueGrimily (fromIntegral mod_uniq)) modl = mi_module (hm_iface hmi) breaks = getModBreaks hmi @@ -366,7 +366,7 @@ handleRunStatus step expr bindings final_ids status history apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref let hmi = expectJust "handleRunStatus" $ lookupHptDirectly (hsc_HPT hsc_env) - (mkUniqueGrimily mod_uniq) + (mkUniqueGrimily (fromIntegral mod_uniq)) modl = mi_module (hm_iface hmi) bp | is_exception = Nothing | otherwise = Just (BreakInfo modl ix) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/88dc0eacc563af5f611855e22002f42e061894a1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/88dc0eacc563af5f611855e22002f42e061894a1 You're receiving 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 Jun 22 12:51:16 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 22 Jun 2023 08:51:16 -0400 Subject: [Git][ghc/ghc][wip/T22010] Fix type error in Run.hs Message-ID: <649443c496e57_19884251ab6201194c8@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: d75b332a by Jaro Reinders at 2023-06-22T14:51:10+02:00 Fix type error in Run.hs - - - - - 1 changed file: - libraries/ghci/GHCi/Run.hs Changes: ===================================== libraries/ghci/GHCi/Run.hs ===================================== @@ -293,7 +293,7 @@ withBreakAction opts breakMVar statusMVar act resume_r <- mkRemoteRef resume apStack_r <- mkRemoteRef apStack ccs <- toRemotePtr <$> getCCSOf apStack - putMVar statusMVar $ EvalBreak is_exception apStack_r (I# ix#) uniq# resume_r ccs + putMVar statusMVar $ EvalBreak is_exception apStack_r (I# ix#) (I# uniq#) resume_r ccs takeMVar breakMVar resetBreakAction stablePtr = do View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d75b332a450bafb9eb2eda132ae1a7fda6065a23 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d75b332a450bafb9eb2eda132ae1a7fda6065a23 You're receiving 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 Jun 22 12:57:09 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 22 Jun 2023 08:57:09 -0400 Subject: [Git][ghc/ghc][wip/T22834] 688 commits: Fix tyvar scoping within class SPECIALISE pragmas Message-ID: <6494452593479_198842c652de81251f0@gitlab.mail> Ben Gamari pushed to branch wip/T22834 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 - - - - - 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. - - - - - 08c0822c by doyougnu at 2023-02-15T00:16:39-05:00 docs: release notes, user guide: add js backend Follow up from #21078 - - - - - 79d8fd65 by Bryan Richter at 2023-02-15T00:17:15-05:00 Allow failure in nightly-x86_64-linux-deb10-no_tntc-validate See #22343 - - - - - 9ca51f9e by Cheng Shao at 2023-02-15T00:17:53-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. - - - - - 26df73fb by Oleg Grenrus at 2023-02-15T22:20:57-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 - - - - - 631c6c72 by Cheng Shao at 2023-02-16T06:43:09-05:00 docs: add a section for the wasm backend Fixes #22658 - - - - - 1878e0bd by Bryan Richter at 2023-02-16T06:43:47-05:00 tests: Mark T12903 fragile everywhere See #21184 - - - - - b9420eac by Bryan Richter at 2023-02-16T06:43:47-05:00 Mark all T5435 variants as fragile See #22970. - - - - - df3d94bd by Sylvain Henry at 2023-02-16T06:44:33-05:00 Testsuite: mark T13167 as fragile for JS (#22921) - - - - - 324e925b by Sylvain Henry at 2023-02-16T06:45:15-05:00 JS: disable debugging info for heap objects - - - - - 518af814 by Josh Meredith at 2023-02-16T10:16:32-05:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 34cd308e by Ben Gamari at 2023-02-16T10:17:08-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 12965aba by Simon Peyton Jones at 2023-02-16T10:17:46-05: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 - - - - - 5b038888 by Bodigrim at 2023-02-16T10:18:24-05:00 Documentation: add an example of SPEC usage - - - - - 681e0e8c by sheaf at 2023-02-16T14:09:56-05:00 No default finalizer exception handler Commit cfc8e2e2 introduced a mechanism for handling of exceptions that occur during Handle finalization, and 372cf730 set the default handler to print out the error to stderr. However, #21680 pointed out we might not want to set this by default, as it might pollute users' terminals with unwanted information. So, for the time being, the default handler discards the exception. Fixes #21680 - - - - - b3ac17ad by Matthew Pickering at 2023-02-16T14:10:31-05: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 ------------------------- - - - - - 8988eeef by sheaf at 2023-02-16T20:32:27-05:00 Expand synonyms in RoughMap We were failing to expand type synonyms in the function GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the RoughMap infrastructure crucially relies on type synonym expansion to work. This patch adds the missing type-synonym expansion. Fixes #22985 - - - - - 3dd50e2f by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Add test artifact Add the released testsuite tarball to the generated ghcup metadata. - - - - - c6a967d9 by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Use Ubuntu and Rocky bindists Prefer to use the Ubuntu 20.04 and 18.04 binary distributions on Ubuntu and Linux Mint. Prefer to use the Rocky 8 binary distribution on unknown distributions. - - - - - be0b7209 by Matthew Pickering at 2023-02-17T09:37:16+00:00 Add INLINABLE pragmas to `generic*` functions in Data.OldList These functions are * recursive * overloaded So it's important to add an `INLINABLE` pragma to each so that they can be specialised at the use site when the specific numeric type is known. Adding these pragmas improves the LazyText replicate benchmark (see https://gitlab.haskell.org/ghc/ghc/-/issues/22886#note_481020) https://github.com/haskell/core-libraries-committee/issues/129 - - - - - a203ad85 by Sylvain Henry at 2023-02-17T15:59:16-05:00 Merge libiserv with ghci `libiserv` serves no purpose. As it depends on `ghci` and doesn't have more dependencies than the `ghci` package, its code could live in the `ghci` package too. This commit also moves most of the code from the `iserv` program into the `ghci` package as well so that it can be reused. This is especially useful for the implementation of TH for the JS backend (#22261, !9779). - - - - - 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01: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 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-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. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-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. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-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. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 7192ef91 by Simon Peyton Jones at 2023-02-28T18:54:59-05:00 Take more care with unlifted bindings in the specialiser As #22998 showed, we were floating an unlifted binding to top level, which breaks a Core invariant. The fix is easy, albeit a little bit conservative. See Note [Care with unlifted bindings] in GHC.Core.Opt.Specialise - - - - - bb500e2a by Simon Peyton Jones at 2023-02-28T18:55:35-05:00 Account for TYPE vs CONSTRAINT in mkSelCo As #23018 showed, in mkRuntimeRepCo we need to account for coercions between TYPE and COERCION. See Note [mkRuntimeRepCo] in GHC.Core.Coercion. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-05:00 hadrian: Add dependency from lib/settings to mk/config.mk In 81975ef375de07a0ea5a69596b2077d7f5959182 we attempted to fix #20253 by adding logic to the bindist Makefile to regenerate the `settings` file from information gleaned by the bindist `configure` script. However, this fix had no effect as `lib/settings` is shipped in the binary distribution (to allow in-place use of the binary distribution). As `lib/settings` already existed and its rule declared no dependencies, `make` would fail to use the added rule to regenerate it. Fix this by explicitly declaring a dependency from `lib/settings` on `mk/config.mk`. Fixes #22982. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-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. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-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. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00: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. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 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: ...lots of lines omitted... 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. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04: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. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04: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> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+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. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 7ea096ce by Ben Gamari at 2023-06-22T12:57:02+00: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. - - - - - a88ca3c2 by Ben Gamari at 2023-06-22T12:57:02+00:00 nativeGen: Set explicit section types on all platforms - - - - - 23b2ce21 by GHC GitLab CI at 2023-06-22T12:57:02+00:00 linker/PEi386: Don't sign-extend symbol section number - - - - - 27 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/generate_job_metadata - .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - .gitlab/rel_eng/upload_ghc_libs.py - .gitlab/test-metrics.sh - .gitmodules - CODEOWNERS - HACKING.md - cabal.project-reinstall - compile_flags.txt - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/24f97b1fc34a9f02f1f608a0a93ec269db1813d1...23b2ce2159f5f350a94e785a7767763a948f35f2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/24f97b1fc34a9f02f1f608a0a93ec269db1813d1...23b2ce2159f5f350a94e785a7767763a948f35f2 You're receiving 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 Jun 22 13:28:34 2023 From: gitlab at gitlab.haskell.org (Torsten Schmits (@torsten.schmits)) Date: Thu, 22 Jun 2023 09:28:34 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/torsten.schmits/16468 Message-ID: <64944c827306c_198842c652de8127092@gitlab.mail> Torsten Schmits pushed new branch wip/torsten.schmits/16468 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/torsten.schmits/16468 You're receiving 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 Jun 22 13:30:34 2023 From: gitlab at gitlab.haskell.org (Torsten Schmits (@torsten.schmits)) Date: Thu, 22 Jun 2023 09:30:34 -0400 Subject: [Git][ghc/ghc][wip/torsten.schmits/16468] Relax defaulting of RuntimeRep/Levity when printing Message-ID: <64944cfa1710_19884251ab62013206@gitlab.mail> Torsten Schmits pushed to branch wip/torsten.schmits/16468 at Glasgow Haskell Compiler / GHC Commits: 8df99f79 by Torsten Schmits at 2023-06-22T15:30:21+02:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 5 changed files: - compiler/GHC/Iface/Type.hs - compiler/GHC/Types/Unique/DFM.hs - + testsuite/tests/ghci/scripts/T16468.script - + testsuite/tests/ghci/scripts/T16468.stdout - testsuite/tests/ghci/scripts/all.T Changes: ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -987,7 +987,7 @@ ppr_ty ctxt_prec ty@(IfaceFunTy af w ty1 ty2) -- Should be a visible argument | isVisibleFunArg af = (pprTypeArrow af wthis <+> ppr_ty funPrec ty1) : ppr_fun_tail wnext ty2 ppr_fun_tail wthis other_ty - = [pprTypeArrow af wthis <+> pprIfaceType other_ty] + = [pprTypeArrow af wthis <+> ppr_ty topPrec other_ty] ppr_ty ctxt_prec (IfaceAppTy t ts) = if_print_coercions @@ -1097,28 +1097,29 @@ as they appear during kind-checking of "newtype T :: TYPE r where..." defaultIfaceTyVarsOfKind :: Bool -- ^ default 'RuntimeRep'/'Levity' variables? -> Bool -- ^ default 'Multiplicity' variables? -> IfaceType -> IfaceType -defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv ty +defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv True ty where go :: FastStringEnv IfaceType -- Set of enclosing forall-ed RuntimeRep/Levity/Multiplicity variables + -> Bool -> IfaceType -> IfaceType - go subs (IfaceForAllTy (Bndr (IfaceTvBndr (var, var_kind)) argf) ty) + go subs rank1 (IfaceForAllTy (Bndr (IfaceTvBndr (var, var_kind)) argf) ty) | isInvisibleForAllTyFlag argf -- Don't default *visible* quantification -- or we get the mess in #13963 - , Just substituted_ty <- check_substitution var_kind + , Just substituted_ty <- check_substitution rank1 var_kind = let subs' = extendFsEnv subs var substituted_ty -- Record that we should replace it with LiftedRep/Lifted/Many, -- and recurse, discarding the forall - in go subs' ty + in go subs' rank1 ty - go subs (IfaceForAllTy bndr ty) - = IfaceForAllTy (go_ifacebndr subs bndr) (go subs ty) + go subs rank1 (IfaceForAllTy bndr ty) + = IfaceForAllTy (go_ifacebndr subs rank1 bndr) (go subs rank1 ty) - go subs ty@(IfaceTyVar tv) = case lookupFsEnv subs tv of + go subs _ ty@(IfaceTyVar tv) = case lookupFsEnv subs tv of Just s -> s Nothing -> ty - go _ ty@(IfaceFreeTyVar tv) + go _ _ ty@(IfaceFreeTyVar tv) -- See Note [Defaulting RuntimeRep variables], about free vars | def_rep , GHC.Core.Type.isRuntimeRepTy (tyVarKind tv) @@ -1138,47 +1139,49 @@ defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv ty | otherwise = ty - go subs (IfaceTyConApp tc tc_args) - = IfaceTyConApp tc (go_args subs tc_args) + go subs rank1 (IfaceTyConApp tc tc_args) + = IfaceTyConApp tc (go_args subs rank1 tc_args) - go subs (IfaceTupleTy sort is_prom tc_args) - = IfaceTupleTy sort is_prom (go_args subs tc_args) + go subs rank1 (IfaceTupleTy sort is_prom tc_args) + = IfaceTupleTy sort is_prom (go_args subs rank1 tc_args) - go subs (IfaceFunTy af w arg res) - = IfaceFunTy af (go subs w) (go subs arg) (go subs res) + go subs rank1 (IfaceFunTy af w arg res) + = IfaceFunTy af (go subs rank1 w) (go subs False arg) (go subs False res) - go subs (IfaceAppTy t ts) - = IfaceAppTy (go subs t) (go_args subs ts) + go subs rank1 (IfaceAppTy t ts) + = IfaceAppTy (go subs rank1 t) (go_args subs rank1 ts) - go subs (IfaceCastTy x co) - = IfaceCastTy (go subs x) co + go subs rank1 (IfaceCastTy x co) + = IfaceCastTy (go subs rank1 x) co - go _ ty@(IfaceLitTy {}) = ty - go _ ty@(IfaceCoercionTy {}) = ty + go _ _ ty@(IfaceLitTy {}) = ty + go _ _ ty@(IfaceCoercionTy {}) = ty - go_ifacebndr :: FastStringEnv IfaceType -> IfaceForAllBndr -> IfaceForAllBndr - go_ifacebndr subs (Bndr (IfaceIdBndr (w, n, t)) argf) - = Bndr (IfaceIdBndr (w, n, go subs t)) argf - go_ifacebndr subs (Bndr (IfaceTvBndr (n, t)) argf) - = Bndr (IfaceTvBndr (n, go subs t)) argf + go_ifacebndr :: FastStringEnv IfaceType -> Bool -> IfaceForAllBndr -> IfaceForAllBndr + go_ifacebndr subs rank1 (Bndr (IfaceIdBndr (w, n, t)) argf) + = Bndr (IfaceIdBndr (w, n, go subs rank1 t)) argf + go_ifacebndr subs rank1 (Bndr (IfaceTvBndr (n, t)) argf) + = Bndr (IfaceTvBndr (n, go subs rank1 t)) argf - go_args :: FastStringEnv IfaceType -> IfaceAppArgs -> IfaceAppArgs - go_args _ IA_Nil = IA_Nil - go_args subs (IA_Arg ty argf args) - = IA_Arg (go subs ty) argf (go_args subs args) + go_args :: FastStringEnv IfaceType -> Bool -> IfaceAppArgs -> IfaceAppArgs + go_args _ _ IA_Nil = IA_Nil + go_args subs rank1 (IA_Arg ty argf args) + = IA_Arg (go subs rank1 ty) argf (go_args subs rank1 args) - check_substitution :: IfaceType -> Maybe IfaceType - check_substitution (IfaceTyConApp tc _) + check_substitution :: Bool -> IfaceType -> Maybe IfaceType + check_substitution rank1 (IfaceTyConApp tc _) | def_rep , tc `ifaceTyConHasKey` runtimeRepTyConKey + , rank1 = Just liftedRep_ty | def_rep , tc `ifaceTyConHasKey` levityTyConKey + , rank1 = Just lifted_ty | def_mult , tc `ifaceTyConHasKey` multiplicityTyConKey = Just many_ty - check_substitution _ = Nothing + check_substitution _ _ = Nothing -- | The type ('BoxedRep 'Lifted), also known as LiftedRep. liftedRep_ty :: IfaceType @@ -1367,7 +1370,7 @@ ppr_sigma show_forall ctxt_prec iface_ty -- Then it could handle both invisible and required binders, and -- splitIfaceReqForallTy wouldn't be necessary here. in ppr_iface_forall_part show_forall invis_tvs theta $ - sep [pprIfaceForAll req_tvs, ppr tau'] + sep [pprIfaceForAll req_tvs, ppr_ty topPrec tau'] pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc pprUserIfaceForAll tvs ===================================== compiler/GHC/Types/Unique/DFM.hs ===================================== @@ -94,7 +94,7 @@ import qualified Data.IntSet as I -- order then `udfmToList` returns them in deterministic order. -- -- There is an implementation cost: each element is given a serial number --- as it is added, and `udfmToList` sorts it's result by this serial +-- as it is added, and `udfmToList` sorts its result by this serial -- number. So you should only use `UniqDFM` if you need the deterministic -- property. -- ===================================== testsuite/tests/ghci/scripts/T16468.script ===================================== @@ -0,0 +1,13 @@ +:set -XLinearTypes -XImpredicativeTypes +import GHC.Types (RuntimeRep (..), Levity (..), TYPE, Type) +import Data.Proxy +f :: forall p. (forall (r :: RuntimeRep). Int -> p r) %1 -> p ('BoxedRep 'Lifted); f x = x 5 +:type f +g :: forall p. Int -> forall (r :: RuntimeRep). p r; g _ = undefined +:type g +g' :: Int -> forall p (r :: RuntimeRep). p r; g' _ = undefined +:type g' +h :: Int -> forall (r :: RuntimeRep). TYPE r; h _ = undefined +:type h +i :: forall (r :: RuntimeRep). Int -> TYPE r; i _ = undefined +:type i ===================================== testsuite/tests/ghci/scripts/T16468.stdout ===================================== @@ -0,0 +1,6 @@ +f :: (forall (r :: RuntimeRep). Int -> p r) + %1 -> p GHC.Types.LiftedRep +g :: Int -> forall (r :: RuntimeRep). p r +g' :: Int -> forall (p :: RuntimeRep -> *) (r :: RuntimeRep). p r +h :: Int -> forall (r :: RuntimeRep). TYPE r +i :: Int -> * ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -375,3 +375,4 @@ test('T22695', normal, ghci_script, ['T22695.script']) test('T22817', normal, ghci_script, ['T22817.script']) test('T22908', normal, ghci_script, ['T22908.script']) test('T23062', normal, ghci_script, ['T23062.script']) +test('T16468', normal, ghci_script, ['T16468.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8df99f7928e81007645a54a638f9833cd35e2de9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8df99f7928e81007645a54a638f9833cd35e2de9 You're receiving 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 Jun 22 15:25:59 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Thu, 22 Jun 2023 11:25:59 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/metadata-modifier Message-ID: <649468072a5cb_3a0200c5f943847@gitlab.mail> Matthew Pickering pushed new branch wip/metadata-modifier at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/metadata-modifier You're receiving 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 Jun 22 16:52:23 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Thu, 22 Jun 2023 12:52:23 -0400 Subject: [Git][ghc/ghc][wip/expand-do] disable expansion if applicative do is enabled Message-ID: <64947c4727d8_3a0200c5f1c32874@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: b70012d2 by Apoorv Ingle at 2023-06-22T11:52:13-05:00 disable expansion if applicative do is enabled - - - - - 4 changed files: - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs - + compiler/GHC/Tc/Utils/.#Monad.hs Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -326,7 +326,8 @@ tcApp :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) tcApp rn_expr exp_res_ty | (fun@(rn_fun, fun_ctxt), rn_args) <- splitHsApps rn_expr = do { traceTc "tcApp {" $ - vcat [ text "rn_fun:" <+> ppr rn_fun + vcat [ text "rn_expr:" <+> ppr rn_expr + , text "rn_fun:" <+> ppr rn_fun , text "rn_args:" <+> ppr rn_args , text "fun_ctxt:" <+> ppr fun_ctxt , text "fun_ctxt loc" <+> ppr (appCtxtLoc fun_ctxt) ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -89,6 +89,8 @@ import GHC.Utils.Outputable as Outputable import GHC.Utils.Panic import GHC.Utils.Panic.Plain +import qualified GHC.LanguageExtensions as LangExt + import Control.Monad import qualified Data.List.NonEmpty as NE @@ -429,26 +431,34 @@ tcExpr (HsMultiIf _ alts) res_ty ; return (HsMultiIf res_ty alts') } where match_ctxt = MC { mc_what = IfAlt, mc_body = tcBody } -tcExpr hsDo@(HsDo _ doFlav@(DoExpr{}) (L _ stmts)) res_ty - = do { expanded_expr <- expandDoStmts doFlav stmts +tcExpr hsDo@(HsDo _ doFlav@(DoExpr{}) ss@(L _ stmts)) res_ty + = do { isApplicativeDo <- xoptM LangExt.ApplicativeDo + ; if isApplicativeDo + then tcDoStmts doFlav ss res_ty + else do { expanded_expr <- expandDoStmts doFlav stmts -- Do expansion on the fly - ; let expanded_do_expr = mkExpandedExpr hsDo (unLoc expanded_expr) - ; traceTc "tcDoStmts " (vcat [ text "hsDo:" <+> ppr hsDo - , text "expr:" <+> ppr expanded_expr - ]) - ; -- addExprCtxt hsDo $ - tcExpr expanded_do_expr res_ty + ; let expanded_do_expr = mkExpandedExpr hsDo (unLoc expanded_expr) + ; traceTc "tcDoStmts " (vcat [ text "hsDo:" <+> ppr hsDo + , text "expr:" <+> ppr expanded_expr + ]) + ; -- addExprCtxt hsDo $ + tcExpr expanded_do_expr res_ty + } } -tcExpr hsDo@(HsDo _ doFlav@(MDoExpr{}) (L _ stmts)) res_ty - = do { expanded_expr <- expandDoStmts doFlav stmts +tcExpr hsDo@(HsDo _ doFlav@(MDoExpr{}) ss@(L _ stmts)) res_ty + = do { isApplicativeDo <- xoptM LangExt.ApplicativeDo + ; if isApplicativeDo + then tcDoStmts doFlav ss res_ty + else do { expanded_expr <- expandDoStmts doFlav stmts -- Do expansion on the fly - ; let expanded_do_expr = mkExpandedExpr hsDo (unLoc expanded_expr) - ; traceTc "tcDoStmts " (vcat [ text "hsDo:" <+> ppr hsDo - , text "expr:" <+> ppr expanded_expr - ]) - ; -- addExprCtxt hsDo $ - tcExpr expanded_do_expr res_ty + ; let expanded_do_expr = mkExpandedExpr hsDo (unLoc expanded_expr) + ; traceTc "tcDoStmts " (vcat [ text "hsDo:" <+> ppr hsDo + , text "expr:" <+> ppr expanded_expr + ]) + ; -- addExprCtxt hsDo $ + tcExpr expanded_do_expr res_ty + } } tcExpr (HsDo _ do_or_lc stmts) res_ty ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -320,11 +320,16 @@ tcDoStmts ListComp (L l stmts) res_ty (mkCheckExpType elt_ty) ; return $ mkHsWrapCo co (HsDo list_ty ListComp (L l stmts')) } -tcDoStmts (DoExpr _) ss _ - = pprPanic "tcDoStmts DoExpr" (ppr ss) +tcDoStmts doExpr@(DoExpr _) (L l stmts) res_ty + = do { stmts' <- tcStmts (HsDoStmt doExpr) tcDoStmt stmts res_ty + ; res_ty <- readExpType res_ty + ; return (HsDo res_ty doExpr (L l stmts')) } + -tcDoStmts (MDoExpr _) ss _ - = pprPanic "tcDoStmts MDoExpr" (ppr ss) +tcDoStmts mDoExpr@(MDoExpr _) (L l stmts) res_ty + = do { stmts' <- tcStmts (HsDoStmt mDoExpr) tcDoStmt stmts res_ty + ; res_ty <- readExpType res_ty + ; return (HsDo res_ty mDoExpr (L l stmts')) } tcDoStmts MonadComp (L l stmts) res_ty = do { stmts' <- tcStmts (HsDoStmt MonadComp) tcMcStmt stmts res_ty ===================================== compiler/GHC/Tc/Utils/.#Monad.hs ===================================== @@ -0,0 +1 @@ +aningle at CS-M030.1455 \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b70012d2eb5ed82af123a83664f79b5845c586d8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b70012d2eb5ed82af123a83664f79b5845c586d8 You're receiving 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 Jun 22 16:53:12 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Thu, 22 Jun 2023 12:53:12 -0400 Subject: [Git][ghc/ghc][wip/expand-do] disable expansion if applicative do is enabled Message-ID: <64947c787930a_3a0200c5f0833390@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: fe5ec2e2 by Apoorv Ingle at 2023-06-22T11:53:01-05:00 disable expansion if applicative do is enabled - - - - - 3 changed files: - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -326,7 +326,8 @@ tcApp :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) tcApp rn_expr exp_res_ty | (fun@(rn_fun, fun_ctxt), rn_args) <- splitHsApps rn_expr = do { traceTc "tcApp {" $ - vcat [ text "rn_fun:" <+> ppr rn_fun + vcat [ text "rn_expr:" <+> ppr rn_expr + , text "rn_fun:" <+> ppr rn_fun , text "rn_args:" <+> ppr rn_args , text "fun_ctxt:" <+> ppr fun_ctxt , text "fun_ctxt loc" <+> ppr (appCtxtLoc fun_ctxt) ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -89,6 +89,8 @@ import GHC.Utils.Outputable as Outputable import GHC.Utils.Panic import GHC.Utils.Panic.Plain +import qualified GHC.LanguageExtensions as LangExt + import Control.Monad import qualified Data.List.NonEmpty as NE @@ -429,26 +431,34 @@ tcExpr (HsMultiIf _ alts) res_ty ; return (HsMultiIf res_ty alts') } where match_ctxt = MC { mc_what = IfAlt, mc_body = tcBody } -tcExpr hsDo@(HsDo _ doFlav@(DoExpr{}) (L _ stmts)) res_ty - = do { expanded_expr <- expandDoStmts doFlav stmts +tcExpr hsDo@(HsDo _ doFlav@(DoExpr{}) ss@(L _ stmts)) res_ty + = do { isApplicativeDo <- xoptM LangExt.ApplicativeDo + ; if isApplicativeDo + then tcDoStmts doFlav ss res_ty + else do { expanded_expr <- expandDoStmts doFlav stmts -- Do expansion on the fly - ; let expanded_do_expr = mkExpandedExpr hsDo (unLoc expanded_expr) - ; traceTc "tcDoStmts " (vcat [ text "hsDo:" <+> ppr hsDo - , text "expr:" <+> ppr expanded_expr - ]) - ; -- addExprCtxt hsDo $ - tcExpr expanded_do_expr res_ty + ; let expanded_do_expr = mkExpandedExpr hsDo (unLoc expanded_expr) + ; traceTc "tcDoStmts " (vcat [ text "hsDo:" <+> ppr hsDo + , text "expr:" <+> ppr expanded_expr + ]) + ; -- addExprCtxt hsDo $ + tcExpr expanded_do_expr res_ty + } } -tcExpr hsDo@(HsDo _ doFlav@(MDoExpr{}) (L _ stmts)) res_ty - = do { expanded_expr <- expandDoStmts doFlav stmts +tcExpr hsDo@(HsDo _ doFlav@(MDoExpr{}) ss@(L _ stmts)) res_ty + = do { isApplicativeDo <- xoptM LangExt.ApplicativeDo + ; if isApplicativeDo + then tcDoStmts doFlav ss res_ty + else do { expanded_expr <- expandDoStmts doFlav stmts -- Do expansion on the fly - ; let expanded_do_expr = mkExpandedExpr hsDo (unLoc expanded_expr) - ; traceTc "tcDoStmts " (vcat [ text "hsDo:" <+> ppr hsDo - , text "expr:" <+> ppr expanded_expr - ]) - ; -- addExprCtxt hsDo $ - tcExpr expanded_do_expr res_ty + ; let expanded_do_expr = mkExpandedExpr hsDo (unLoc expanded_expr) + ; traceTc "tcDoStmts " (vcat [ text "hsDo:" <+> ppr hsDo + , text "expr:" <+> ppr expanded_expr + ]) + ; -- addExprCtxt hsDo $ + tcExpr expanded_do_expr res_ty + } } tcExpr (HsDo _ do_or_lc stmts) res_ty ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -320,11 +320,16 @@ tcDoStmts ListComp (L l stmts) res_ty (mkCheckExpType elt_ty) ; return $ mkHsWrapCo co (HsDo list_ty ListComp (L l stmts')) } -tcDoStmts (DoExpr _) ss _ - = pprPanic "tcDoStmts DoExpr" (ppr ss) +tcDoStmts doExpr@(DoExpr _) (L l stmts) res_ty + = do { stmts' <- tcStmts (HsDoStmt doExpr) tcDoStmt stmts res_ty + ; res_ty <- readExpType res_ty + ; return (HsDo res_ty doExpr (L l stmts')) } + -tcDoStmts (MDoExpr _) ss _ - = pprPanic "tcDoStmts MDoExpr" (ppr ss) +tcDoStmts mDoExpr@(MDoExpr _) (L l stmts) res_ty + = do { stmts' <- tcStmts (HsDoStmt mDoExpr) tcDoStmt stmts res_ty + ; res_ty <- readExpType res_ty + ; return (HsDo res_ty mDoExpr (L l stmts')) } tcDoStmts MonadComp (L l stmts) res_ty = do { stmts' <- tcStmts (HsDoStmt MonadComp) tcMcStmt stmts res_ty View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fe5ec2e2f08ce6109f59810bad6fe9a0247d61ab -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fe5ec2e2f08ce6109f59810bad6fe9a0247d61ab You're receiving 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 Jun 22 16:57:36 2023 From: gitlab at gitlab.haskell.org (Torsten Schmits (@torsten.schmits)) Date: Thu, 22 Jun 2023 12:57:36 -0400 Subject: [Git][ghc/ghc][wip/torsten.schmits/23272] 141 commits: Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) Message-ID: <64947d806619d_3a0200251d1f83931d@gitlab.mail> Torsten Schmits pushed to branch wip/torsten.schmits/23272 at Glasgow Haskell Compiler / GHC Commits: 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 34272c3b by Torsten Schmits at 2023-06-22T18:57:20+02:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - HACKING.md - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types/Prim.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Data/IOEnv.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/DynFlags.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/32d304dce9933623e2c53e81d32950f7649478fe...34272c3b8ebb193adb210831b694aa310944ada1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/32d304dce9933623e2c53e81d32950f7649478fe...34272c3b8ebb193adb210831b694aa310944ada1 You're receiving 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 Jun 22 17:01:19 2023 From: gitlab at gitlab.haskell.org (Torsten Schmits (@torsten.schmits)) Date: Thu, 22 Jun 2023 13:01:19 -0400 Subject: [Git][ghc/ghc][wip/torsten.schmits/23272] 12 commits: Memory usage fixes for Haddock Message-ID: <64947e5f130c0_3a0200c5f30410b6@gitlab.mail> Torsten Schmits pushed to branch wip/torsten.schmits/23272 at Glasgow Haskell Compiler / GHC Commits: 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 2a23174c by Torsten Schmits at 2023-06-22T19:01:08+02:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Runtime/Context.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/Loader.hs - + compiler/GHC/Runtime/Utils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/34272c3b8ebb193adb210831b694aa310944ada1...2a23174c6f6d247ba6a1fe7cead024bf181d04e7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/34272c3b8ebb193adb210831b694aa310944ada1...2a23174c6f6d247ba6a1fe7cead024bf181d04e7 You're receiving 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 Jun 22 17:27:05 2023 From: gitlab at gitlab.haskell.org (Torsten Schmits (@torsten.schmits)) Date: Thu, 22 Jun 2023 13:27:05 -0400 Subject: [Git][ghc/ghc][wip/torsten.schmits/16468] Relax defaulting of RuntimeRep/Levity when printing Message-ID: <649484698a975_3a0200251d1f845568@gitlab.mail> Torsten Schmits pushed to branch wip/torsten.schmits/16468 at Glasgow Haskell Compiler / GHC Commits: 9dbe152d by Torsten Schmits at 2023-06-22T19:26:58+02:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 5 changed files: - compiler/GHC/Iface/Type.hs - compiler/GHC/Types/Unique/DFM.hs - + testsuite/tests/ghci/scripts/T16468.script - + testsuite/tests/ghci/scripts/T16468.stdout - testsuite/tests/ghci/scripts/all.T Changes: ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -987,7 +987,7 @@ ppr_ty ctxt_prec ty@(IfaceFunTy af w ty1 ty2) -- Should be a visible argument | isVisibleFunArg af = (pprTypeArrow af wthis <+> ppr_ty funPrec ty1) : ppr_fun_tail wnext ty2 ppr_fun_tail wthis other_ty - = [pprTypeArrow af wthis <+> pprIfaceType other_ty] + = [pprTypeArrow af wthis <+> ppr_ty topPrec other_ty] ppr_ty ctxt_prec (IfaceAppTy t ts) = if_print_coercions @@ -1097,28 +1097,29 @@ as they appear during kind-checking of "newtype T :: TYPE r where..." defaultIfaceTyVarsOfKind :: Bool -- ^ default 'RuntimeRep'/'Levity' variables? -> Bool -- ^ default 'Multiplicity' variables? -> IfaceType -> IfaceType -defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv ty +defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv True ty where go :: FastStringEnv IfaceType -- Set of enclosing forall-ed RuntimeRep/Levity/Multiplicity variables + -> Bool -> IfaceType -> IfaceType - go subs (IfaceForAllTy (Bndr (IfaceTvBndr (var, var_kind)) argf) ty) + go subs rank1 (IfaceForAllTy (Bndr (IfaceTvBndr (var, var_kind)) argf) ty) | isInvisibleForAllTyFlag argf -- Don't default *visible* quantification -- or we get the mess in #13963 - , Just substituted_ty <- check_substitution var_kind + , Just substituted_ty <- check_substitution rank1 var_kind = let subs' = extendFsEnv subs var substituted_ty -- Record that we should replace it with LiftedRep/Lifted/Many, -- and recurse, discarding the forall - in go subs' ty + in go subs' rank1 ty - go subs (IfaceForAllTy bndr ty) - = IfaceForAllTy (go_ifacebndr subs bndr) (go subs ty) + go subs rank1 (IfaceForAllTy bndr ty) + = IfaceForAllTy (go_ifacebndr subs rank1 bndr) (go subs rank1 ty) - go subs ty@(IfaceTyVar tv) = case lookupFsEnv subs tv of + go subs _ ty@(IfaceTyVar tv) = case lookupFsEnv subs tv of Just s -> s Nothing -> ty - go _ ty@(IfaceFreeTyVar tv) + go _ _ ty@(IfaceFreeTyVar tv) -- See Note [Defaulting RuntimeRep variables], about free vars | def_rep , GHC.Core.Type.isRuntimeRepTy (tyVarKind tv) @@ -1138,47 +1139,49 @@ defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv ty | otherwise = ty - go subs (IfaceTyConApp tc tc_args) - = IfaceTyConApp tc (go_args subs tc_args) + go subs rank1 (IfaceTyConApp tc tc_args) + = IfaceTyConApp tc (go_args subs rank1 tc_args) - go subs (IfaceTupleTy sort is_prom tc_args) - = IfaceTupleTy sort is_prom (go_args subs tc_args) + go subs rank1 (IfaceTupleTy sort is_prom tc_args) + = IfaceTupleTy sort is_prom (go_args subs rank1 tc_args) - go subs (IfaceFunTy af w arg res) - = IfaceFunTy af (go subs w) (go subs arg) (go subs res) + go subs rank1 (IfaceFunTy af w arg res) + = IfaceFunTy af (go subs rank1 w) (go subs False arg) (go subs False res) - go subs (IfaceAppTy t ts) - = IfaceAppTy (go subs t) (go_args subs ts) + go subs rank1 (IfaceAppTy t ts) + = IfaceAppTy (go subs rank1 t) (go_args subs rank1 ts) - go subs (IfaceCastTy x co) - = IfaceCastTy (go subs x) co + go subs rank1 (IfaceCastTy x co) + = IfaceCastTy (go subs rank1 x) co - go _ ty@(IfaceLitTy {}) = ty - go _ ty@(IfaceCoercionTy {}) = ty + go _ _ ty@(IfaceLitTy {}) = ty + go _ _ ty@(IfaceCoercionTy {}) = ty - go_ifacebndr :: FastStringEnv IfaceType -> IfaceForAllBndr -> IfaceForAllBndr - go_ifacebndr subs (Bndr (IfaceIdBndr (w, n, t)) argf) - = Bndr (IfaceIdBndr (w, n, go subs t)) argf - go_ifacebndr subs (Bndr (IfaceTvBndr (n, t)) argf) - = Bndr (IfaceTvBndr (n, go subs t)) argf + go_ifacebndr :: FastStringEnv IfaceType -> Bool -> IfaceForAllBndr -> IfaceForAllBndr + go_ifacebndr subs rank1 (Bndr (IfaceIdBndr (w, n, t)) argf) + = Bndr (IfaceIdBndr (w, n, go subs rank1 t)) argf + go_ifacebndr subs rank1 (Bndr (IfaceTvBndr (n, t)) argf) + = Bndr (IfaceTvBndr (n, go subs rank1 t)) argf - go_args :: FastStringEnv IfaceType -> IfaceAppArgs -> IfaceAppArgs - go_args _ IA_Nil = IA_Nil - go_args subs (IA_Arg ty argf args) - = IA_Arg (go subs ty) argf (go_args subs args) + go_args :: FastStringEnv IfaceType -> Bool -> IfaceAppArgs -> IfaceAppArgs + go_args _ _ IA_Nil = IA_Nil + go_args subs rank1 (IA_Arg ty argf args) + = IA_Arg (go subs rank1 ty) argf (go_args subs rank1 args) - check_substitution :: IfaceType -> Maybe IfaceType - check_substitution (IfaceTyConApp tc _) + check_substitution :: Bool -> IfaceType -> Maybe IfaceType + check_substitution rank1 (IfaceTyConApp tc _) | def_rep , tc `ifaceTyConHasKey` runtimeRepTyConKey + , rank1 = Just liftedRep_ty | def_rep , tc `ifaceTyConHasKey` levityTyConKey + , rank1 = Just lifted_ty | def_mult , tc `ifaceTyConHasKey` multiplicityTyConKey = Just many_ty - check_substitution _ = Nothing + check_substitution _ _ = Nothing -- | The type ('BoxedRep 'Lifted), also known as LiftedRep. liftedRep_ty :: IfaceType @@ -1367,7 +1370,7 @@ ppr_sigma show_forall ctxt_prec iface_ty -- Then it could handle both invisible and required binders, and -- splitIfaceReqForallTy wouldn't be necessary here. in ppr_iface_forall_part show_forall invis_tvs theta $ - sep [pprIfaceForAll req_tvs, ppr tau'] + sep [pprIfaceForAll req_tvs, ppr_ty topPrec tau'] pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc pprUserIfaceForAll tvs ===================================== compiler/GHC/Types/Unique/DFM.hs ===================================== @@ -94,7 +94,7 @@ import qualified Data.IntSet as I -- order then `udfmToList` returns them in deterministic order. -- -- There is an implementation cost: each element is given a serial number --- as it is added, and `udfmToList` sorts it's result by this serial +-- as it is added, and `udfmToList` sorts its result by this serial -- number. So you should only use `UniqDFM` if you need the deterministic -- property. -- ===================================== testsuite/tests/ghci/scripts/T16468.script ===================================== @@ -0,0 +1,27 @@ +import GHC.Types (RuntimeRep (..), Levity (..), TYPE) +import Data.Proxy + +f :: forall p. (forall (r :: RuntimeRep). Int -> p r) -> p ('BoxedRep 'Lifted); f x = x 5 +g :: forall p. Int -> forall (r :: RuntimeRep). p r; g _ = undefined +g' :: Int -> forall p (r :: RuntimeRep). p r; g' _ = undefined +h :: Int -> forall (r :: RuntimeRep). TYPE r; h _ = undefined +i :: forall (r :: RuntimeRep). Int -> TYPE r; i _ = undefined +j :: forall p. Eq (p ('BoxedRep 'Lifted)) => Int -> forall (r :: RuntimeRep). p r; j _ = undefined +k :: forall p (r' :: RuntimeRep). Eq (p r') => (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) -> p r'; k x = x 5 + +:type f +:type g +:type g' +:type h +:type i +:type j +:type k + +:set -fprint-explicit-runtime-reps +:type f +:type g +:type g' +:type h +:type i +:type j +:type k ===================================== testsuite/tests/ghci/scripts/T16468.stdout ===================================== @@ -0,0 +1,21 @@ +f :: (forall (r :: RuntimeRep). Int -> p r) + -> p GHC.Types.LiftedRep +g :: Int -> forall (r :: RuntimeRep). p r +g' :: Int -> forall (p :: RuntimeRep -> *) (r :: RuntimeRep). p r +h :: Int -> forall (r :: RuntimeRep). TYPE r +i :: Int -> * +j :: Eq (p GHC.Types.LiftedRep) => + Int -> forall (r :: RuntimeRep). p r +k :: Eq (p GHC.Types.LiftedRep) => + (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) + -> p GHC.Types.LiftedRep +f :: (forall (r :: RuntimeRep). Int -> p r) + -> p GHC.Types.LiftedRep +g :: Int -> forall (r :: RuntimeRep). p r +g' :: Int -> forall (p :: RuntimeRep -> *) (r :: RuntimeRep). p r +h :: Int -> forall (r :: RuntimeRep). TYPE r +i :: Int -> TYPE r +j :: Eq (p GHC.Types.LiftedRep) => + Int -> forall (r :: RuntimeRep). p r +k :: Eq (p r') => + (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) -> p r' ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -375,3 +375,4 @@ test('T22695', normal, ghci_script, ['T22695.script']) test('T22817', normal, ghci_script, ['T22817.script']) test('T22908', normal, ghci_script, ['T22908.script']) test('T23062', normal, ghci_script, ['T23062.script']) +test('T16468', normal, ghci_script, ['T16468.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9dbe152d887a9bd656ed43b3718b40159fa22506 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9dbe152d887a9bd656ed43b3718b40159fa22506 You're receiving 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 Jun 22 18:38:01 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 22 Jun 2023 14:38:01 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/ipe-optimisation-9.4 Message-ID: <64949509ac186_3a020027da10c548e2@gitlab.mail> Ben Gamari pushed new branch wip/ipe-optimisation-9.4 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ipe-optimisation-9.4 You're receiving 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 Jun 22 18:49:29 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 22 Jun 2023 14:49:29 -0400 Subject: [Git][ghc/ghc][wip/ipe-optimisation-9.4] IPE data compression Message-ID: <649497b9b6bed_3a0200c5f08552eb@gitlab.mail> Ben Gamari pushed to branch wip/ipe-optimisation-9.4 at Glasgow Haskell Compiler / GHC Commits: 195afb96 by Finley McIlwaine at 2023-06-22T14:48:36-04:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 19 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Data/FastString.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/ghc.cabal.in - configure.ac - docs/users_guide/debug-info.rst - hadrian/cfg/system.config.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Settings/Packages.hs - libraries/bytestring - libraries/containers - libraries/ghc-bignum/gmp/gmp-tarballs - libraries/parsec - libraries/text - m4/fp_find_libnuma.m4 - + m4/fp_find_libzstd.m4 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/195afb96baaf3055231bd3c61486b233524c7720 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/195afb96baaf3055231bd3c61486b233524c7720 You're receiving 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 Jun 22 18:51:56 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 22 Jun 2023 14:51:56 -0400 Subject: [Git][ghc/ghc][wip/ipe-optimisation-9.4] IPE data compression Message-ID: <6494984ca3ac4_3a0200c5fa8556eb@gitlab.mail> Ben Gamari pushed to branch wip/ipe-optimisation-9.4 at Glasgow Haskell Compiler / GHC Commits: f9aa4172 by Finley McIlwaine at 2023-06-22T14:51:51-04:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 19 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Data/FastString.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/ghc.cabal.in - configure.ac - docs/users_guide/debug-info.rst - hadrian/cfg/system.config.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Settings/Packages.hs - libraries/bytestring - libraries/containers - libraries/ghc-bignum/gmp/gmp-tarballs - libraries/parsec - libraries/text - m4/fp_find_libnuma.m4 - + m4/fp_find_libzstd.m4 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f9aa417272f4cf7ab8d11ebf8e10e8d64f50400f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f9aa417272f4cf7ab8d11ebf8e10e8d64f50400f You're receiving 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 Jun 22 18:57:45 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 22 Jun 2023 14:57:45 -0400 Subject: [Git][ghc/ghc][wip/ipe-optimisation-9.4] IPE data compression Message-ID: <649499a954570_3a0200251d1f8558eb@gitlab.mail> Ben Gamari pushed to branch wip/ipe-optimisation-9.4 at Glasgow Haskell Compiler / GHC Commits: c92c0685 by Finley McIlwaine at 2023-06-22T14:57:37-04:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 19 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Data/FastString.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/ghc.cabal.in - configure.ac - docs/users_guide/debug-info.rst - hadrian/cfg/system.config.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Settings/Packages.hs - libraries/bytestring - libraries/containers - libraries/ghc-bignum/gmp/gmp-tarballs - libraries/parsec - libraries/text - m4/fp_find_libnuma.m4 - + m4/fp_find_libzstd.m4 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c92c0685b59f34a48df53052f061db8e49fda2bc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c92c0685b59f34a48df53052f061db8e49fda2bc You're receiving 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 Jun 22 19:58:26 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 22 Jun 2023 15:58:26 -0400 Subject: [Git][ghc/ghc][wip/ipe-optimisation-9.4] IPE data compression Message-ID: <6494a7e2c299_3a0200251d1f856876@gitlab.mail> Ben Gamari pushed to branch wip/ipe-optimisation-9.4 at Glasgow Haskell Compiler / GHC Commits: f783ca35 by Finley McIlwaine at 2023-06-22T15:57:59-04:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 27 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Data/FastString.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/ghc.cabal.in - configure.ac - docs/users_guide/debug-info.rst - hadrian/cfg/system.config.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Settings/Packages.hs - libraries/bytestring - libraries/containers - libraries/ghc-bignum/gmp/gmp-tarballs - libraries/parsec - libraries/text - 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/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-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: 58d08589371e78829a3279c6f8b1241e155d7f70 + DOCKER_REV: 243a00f06550e6b9a00fa0f1530d1bb761e8b7cc # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. @@ -414,7 +414,7 @@ doc-tarball: optional: true - job: nightly-x86_64-windows-validate optional: true - - job: release-x86_64-windows-release + - job: release-x86_64-windows-release+no_split_sections optional: true tags: @@ -456,8 +456,6 @@ doc-tarball: hackage-doc-tarball: stage: packaging needs: - - job: x86_64-linux-fedora33-release-hackage - optional: true - job: nightly-x86_64-linux-fedora33-release-hackage optional: true - job: release-x86_64-linux-fedora33-release-hackage ===================================== .gitlab/gen_ci.hs ===================================== @@ -116,6 +116,7 @@ data BuildConfig , llvmBootstrap :: Bool , withAssertions :: Bool , withNuma :: Bool + , withZstd :: Bool , fullyStatic :: Bool , tablesNextToCode :: Bool , threadSanitiser :: Bool @@ -126,6 +127,7 @@ configureArgsStr :: BuildConfig -> String configureArgsStr bc = intercalate " " $ ["--enable-unregisterised"| unregisterised bc ] ++ ["--disable-tables-next-to-code" | not (tablesNextToCode bc) ] + ++ ["--enable-ipe-data-compression" | withZstd bc ] -- Compute the hadrian flavour from the BuildConfig mkJobFlavour :: BuildConfig -> Flavour @@ -156,6 +158,7 @@ vanilla = BuildConfig , llvmBootstrap = False , withAssertions = False , withNuma = False + , withZstd = False , fullyStatic = False , tablesNextToCode = True , threadSanitiser = False @@ -180,6 +183,9 @@ debug = vanilla { buildFlavour = SlowValidate , withNuma = True } +zstdIpe :: BuildConfig +zstdIpe = vanilla { withZstd = True } + static :: BuildConfig static = vanilla { fullyStatic = True } @@ -494,7 +500,8 @@ 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. - | ARMLabel -- ^ Only run this job when the "ARM" label is set. + | ARMLabel -- ^ Only run this job when the "ARM" 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) @@ -521,6 +528,8 @@ 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 @@ -791,6 +800,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , standardBuilds I386 (Linux Debian9) , allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) static) , disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt)) + , addValidateRule IpeData (validateBuilds Amd64 (Linux Debian10) zstdIpe) ] where ===================================== .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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && ($CI_MERGE_REQUEST_LABELS =~ /.*ARM.*/) && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*ARM.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -216,7 +216,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -274,7 +274,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -337,7 +337,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -396,7 +396,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -458,7 +458,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -517,7 +517,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -582,7 +582,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -643,7 +643,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -705,7 +705,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -767,7 +767,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -827,7 +827,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -886,7 +886,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -945,7 +945,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1005,7 +1005,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1064,7 +1064,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1083,7 +1083,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-ipe-data-compression", "TEST_ENV": "x86_64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -1123,7 +1123,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1182,7 +1182,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1241,7 +1241,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1302,7 +1302,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1361,7 +1361,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1420,7 +1420,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1482,7 +1482,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1543,7 +1543,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1605,7 +1605,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1666,7 +1666,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1721,7 +1721,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1780,7 +1780,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1843,7 +1843,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1907,7 +1907,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1967,7 +1967,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2030,7 +2030,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2090,7 +2090,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2156,7 +2156,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2218,7 +2218,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2281,7 +2281,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2344,7 +2344,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2405,7 +2405,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2465,7 +2465,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2525,7 +2525,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2585,7 +2585,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2645,7 +2645,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2708,7 +2708,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2770,7 +2770,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2832,7 +2832,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2895,7 +2895,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2951,7 +2951,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3011,7 +3011,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3075,7 +3075,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3139,7 +3139,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3199,7 +3199,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3260,7 +3260,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3321,7 +3321,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3380,7 +3380,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3439,7 +3439,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -3497,7 +3497,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3556,7 +3556,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3614,7 +3614,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/) && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3633,7 +3633,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-ipe-data-compression", "TEST_ENV": "x86_64-linux-deb10-validate" } }, @@ -3672,7 +3672,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3730,7 +3730,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3789,7 +3789,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -3849,7 +3849,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3907,7 +3907,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3965,7 +3965,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4026,7 +4026,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4086,7 +4086,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4147,7 +4147,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4207,7 +4207,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4261,7 +4261,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4319,7 +4319,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], ===================================== compiler/GHC/Data/FastString.hs ===================================== @@ -52,6 +52,9 @@ module GHC.Data.FastString fastStringToShortByteString, mkFastStringShortByteString, + -- * ShortText + fastStringToShortText, + -- * FastZString FastZString, hPutFZS, @@ -118,6 +121,7 @@ import GHC.Utils.IO.Unsafe import GHC.Utils.Panic.Plain import GHC.Utils.Misc import GHC.Data.FastMutInt +import GHC.Data.ShortText (ShortText(..)) import Control.Concurrent.MVar import Control.DeepSeq @@ -526,6 +530,9 @@ mkFastStringShortByteString :: ShortByteString -> FastString mkFastStringShortByteString sbs = inlinePerformIO $ mkFastStringWith (mkNewFastStringShortByteString sbs) sbs +fastStringToShortText :: FastString -> ShortText +fastStringToShortText = ShortText . fs_sbs + -- | Creates a UTF-8 encoded 'FastString' from a 'String' mkFastString :: String -> FastString {-# NOINLINE[1] mkFastString #-} ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -1,66 +1,188 @@ +{-# 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.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 (unpackFS) +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 @@ -70,13 +192,13 @@ toCgIPE platform ctx module_name ipe = do let label_str = maybe "" snd (infoTableProv ipe) let (src_loc_file, src_loc_span) = case infoTableProv ipe of - Nothing -> ("", "") + Nothing -> (mempty, "") Just (span, _) -> - let file = unpackFS $ srcSpanFile span + let file = fastStringToShortText $ srcSpanFile span coords = renderWithContext ctx (pprUserRealSpan False span) in (file, coords) - label <- lookupStringTable $ ST.pack label_str - src_file <- lookupStringTable $ ST.pack src_loc_file + label <- lookupStringTable $ ST.pack label_str + src_file <- lookupStringTable src_loc_file src_span <- lookupStringTable $ ST.pack src_loc_span return $ CgInfoProvEnt { ipeInfoTablePtr = infoTablePtr ipe , ipeTableName = table_name @@ -104,7 +226,7 @@ data StringTable = StringTable { stStrings :: DList ShortText , stLookup :: !(M.Map ShortText StrTabOffset) } -newtype StrTabOffset = StrTabOffset Int +type StrTabOffset = Word32 emptyStringTable :: StringTable emptyStringTable = @@ -129,9 +251,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 ===================================== @@ -62,6 +62,14 @@ Flag build-tool-depends Description: Use build-tool-depends Default: True +Flag with-libzstd + Default: False + Manual: True + +Flag static-libzstd + Default: False + Manual: True + Library Default-Language: Haskell2010 Exposed: False @@ -76,6 +84,16 @@ 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) + if flag(static-libzstd) + if os(darwin) + buildable: False + else + extra-libraries: :libzstd.a + else + extra-libraries: zstd + CPP-Options: -DHAVE_LIBZSTD + Build-Depends: base >= 4.11 && < 4.18, deepseq >= 1.4 && < 1.5, directory >= 1 && < 1.4, ===================================== configure.ac ===================================== @@ -1148,6 +1148,10 @@ AS_IF([test x"${UseLibffiForAdjustors}" = x"YES"], ) AC_SUBST([CabalLibffiAdjustors]) +dnl ** IPE data compression +dnl -------------------------------------------------------------- +FP_FIND_LIBZSTD + dnl ** Other RTS features dnl -------------------------------------------------------------- FP_FIND_LIBDW @@ -1318,6 +1322,19 @@ 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;) +STATIC_LIBZSTD=$(if [ "$StaticLibZstd" = "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 + statically linked? : $STATIC_LIBZSTD + libdw : $USING_LIBDW Using LLVM tools clang : $ClangCmd ===================================== docs/users_guide/debug-info.rst ===================================== @@ -370,9 +370,26 @@ 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. The compression + library ``libzstd`` may optionally be statically linked in the resulting + compiler (on non-darwin machines) using the ``--enable-static-libzstd`` + configure flag. + + 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 ===================================== @@ -201,8 +201,13 @@ libdw-lib-dir = @LibdwLibDir@ libnuma-include-dir = @LibNumaIncludeDir@ libnuma-lib-dir = @LibNumaLibDir@ +libzstd-include-dir = @LibZstdIncludeDir@ +libzstd-lib-dir = @LibZstdLibDir@ + # Optional Dependencies: #======================= with-libdw = @UseLibdw@ with-libnuma = @UseLibNuma@ +use-lib-zstd = @UseLibZstd@ +static-lib-zstd = @UseStaticLibZstd@ ===================================== hadrian/src/Oracles/Flag.hs ===================================== @@ -34,6 +34,8 @@ data Flag = ArSupportsAtFile | BootstrapThreadedRts | BootstrapEventLoggingRts | UseLibffiForAdjustors + | UseLibzstd + | StaticLibzstd -- Note, if a flag is set to empty string we treat it as set to NO. This seems -- fragile, but some flags do behave like this. @@ -58,6 +60,8 @@ flag f = do BootstrapThreadedRts -> "bootstrap-threaded-rts" BootstrapEventLoggingRts -> "bootstrap-event-logging-rts" UseLibffiForAdjustors -> "use-libffi-for-adjustors" + UseLibzstd -> "use-lib-zstd" + StaticLibzstd -> "static-lib-zstd" value <- lookupSystemConfig key when (value `notElem` ["YES", "NO", ""]) . error $ "Configuration flag " ++ quote (key ++ " = " ++ value) ++ " cannot be parsed." ===================================== 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/Settings/Packages.hs ===================================== @@ -75,6 +75,8 @@ packageArgs = do [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" , notM cross `cabalFlag` "terminfo" , arg "-build-tool-depends" + , flag UseLibzstd `cabalFlag` "with-libzstd" + , flag StaticLibzstd `cabalFlag` "static-libzstd" ] , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ] @@ -290,6 +292,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 @@ -397,6 +401,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/bytestring ===================================== @@ -1 +1 @@ -Subproject commit 9cab76dc861f651c3940e873ce921d9e09733cc8 +Subproject commit 1543e054a314865d89a259065921d5acba03d966 ===================================== libraries/containers ===================================== @@ -1 +1 @@ -Subproject commit 9f4a93604c66a5e605ce46fc30003b71802b3cfd +Subproject commit 50175b72dc781f82a419bddafba1bdd758fbee4b ===================================== libraries/ghc-bignum/gmp/gmp-tarballs ===================================== @@ -1 +1 @@ -Subproject commit 4f26049af40afb380eaf033ab91404cd2e214919 +Subproject commit 31f9909680ba8fe00d27fd8a6f5d198a0a96c1ac ===================================== libraries/parsec ===================================== @@ -1 +1 @@ -Subproject commit 1f542120d9adc5e22f8791a6d595210e93c6c389 +Subproject commit a74c68e948c99621100447014f48ccac7ee0448e ===================================== libraries/text ===================================== @@ -1 +1 @@ -Subproject commit e815d4d9bc362f4a3a36a850931fd3504eda967e +Subproject commit fdb06ff327519f3c0fc6cc9997b7cb7fe8ab8178 ===================================== 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,120 @@ +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] + ) + + StaticLibZstd=0 + AC_ARG_ENABLE( + static-libzstd, + [AS_HELP_STRING( + [--enable-static-libzstd], + [Statically link the libzstd compression library with the compiler + (not compatible with darwin) [default=no]] + )], + [StaticLibZstd=1], + [StaticLibZstd=0] + ) + + HaveLibZstd=0 + if test "$EnableIpeDataCompression" = "YES"; then + dnl ** Have zstd >= 1.4.0? + 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 + + # libzstd >= 1.4.0 is required for IPE data compression + fp_libzstd_version="`pkg-config --modversion libzstd`" + FP_COMPARE_VERSIONS( + [$fp_libzstd_version], + [-lt], + [1.4.0], + [AC_MSG_ERROR( + [Need at least libzstd version 1.4.0 for + --enable-ipe-data-compression]) + ] + ) + + 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)]) + + AC_DEFINE_UNQUOTED([STATIC_LIBZSTD], [$StaticLibZstd], [Define to 1 if you + wish to statically link the libzstd compression library in the compiler + (requires libzstd)]) + + if test $HaveLibZstd = "1" ; then + AC_SUBST([UseLibZstd],[YES]) + AC_SUBST([CabalHaveLibZstd],[True]) + if test $StaticLibZstd = "1" ; then + case "${host_os}" in + darwin*) + AC_MSG_ERROR( + [--enable-static-libzstd is not compatible with darwin] + ) + esac + AC_SUBST([UseStaticLibZstd],[YES]) + AC_SUBST([CabalStaticLibZstd],[True]) + else + AC_SUBST([UseStaticLibZstd],[NO]) + AC_SUBST([CabalStaticLibZstd],[False]) + fi + 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,19 +82,18 @@ 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] } }; } @@ -105,8 +109,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; @@ -169,16 +183,85 @@ 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; + IpeBufferEntry *entries; + 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 == 1) { + // 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 ===================================== @@ -30,6 +30,10 @@ flag libdw default: @CabalHaveLibdw@ flag libnuma default: @CabalHaveLibNuma@ +flag libzstd + default: @CabalHaveLibZstd@ +flag static-libzstd + default: @CabalStaticLibZstd@ flag 64bit default: @Cabal64bit@ flag leading-underscore @@ -148,6 +152,14 @@ library extra-libraries: elf dw if flag(libnuma) extra-libraries: numa + if flag(libzstd) + if flag(static-libzstd) + if os(darwin) + buildable: False + else + extra-libraries: :libzstd.a + else + extra-libraries: zstd if !flag(smp) cpp-options: -DNOSMP ===================================== 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/f783ca35913b6276d749454015a7d67cb2ca7673 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f783ca35913b6276d749454015a7d67cb2ca7673 You're receiving 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 Jun 22 21:02:38 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 22 Jun 2023 17:02:38 -0400 Subject: [Git][ghc/ghc][wip/ipe-optimisation-9.4] IPE data compression Message-ID: <6494b6eebe526_3a0200c5f4459125@gitlab.mail> Ben Gamari pushed to branch wip/ipe-optimisation-9.4 at Glasgow Haskell Compiler / GHC Commits: 24f95937 by Finley McIlwaine at 2023-06-22T17:02:15-04:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 27 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Data/FastString.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/ghc.cabal.in - configure.ac - docs/users_guide/debug-info.rst - hadrian/cfg/system.config.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Settings/Packages.hs - libraries/bytestring - libraries/containers - libraries/ghc-bignum/gmp/gmp-tarballs - libraries/parsec - libraries/text - 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/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-ci.yml ===================================== @@ -414,7 +414,7 @@ doc-tarball: optional: true - job: nightly-x86_64-windows-validate optional: true - - job: release-x86_64-windows-release + - job: release-x86_64-windows-release+no_split_sections optional: true tags: @@ -456,8 +456,6 @@ doc-tarball: hackage-doc-tarball: stage: packaging needs: - - job: x86_64-linux-fedora33-release-hackage - optional: true - job: nightly-x86_64-linux-fedora33-release-hackage optional: true - job: release-x86_64-linux-fedora33-release-hackage ===================================== .gitlab/gen_ci.hs ===================================== @@ -116,6 +116,7 @@ data BuildConfig , llvmBootstrap :: Bool , withAssertions :: Bool , withNuma :: Bool + , withZstd :: Bool , fullyStatic :: Bool , tablesNextToCode :: Bool , threadSanitiser :: Bool @@ -126,6 +127,7 @@ configureArgsStr :: BuildConfig -> String configureArgsStr bc = intercalate " " $ ["--enable-unregisterised"| unregisterised bc ] ++ ["--disable-tables-next-to-code" | not (tablesNextToCode bc) ] + ++ ["--enable-ipe-data-compression" | withZstd bc ] -- Compute the hadrian flavour from the BuildConfig mkJobFlavour :: BuildConfig -> Flavour @@ -156,6 +158,7 @@ vanilla = BuildConfig , llvmBootstrap = False , withAssertions = False , withNuma = False + , withZstd = False , fullyStatic = False , tablesNextToCode = True , threadSanitiser = False @@ -180,6 +183,9 @@ debug = vanilla { buildFlavour = SlowValidate , withNuma = True } +zstdIpe :: BuildConfig +zstdIpe = vanilla { withZstd = True } + static :: BuildConfig static = vanilla { fullyStatic = True } @@ -494,7 +500,8 @@ 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. - | ARMLabel -- ^ Only run this job when the "ARM" label is set. + | ARMLabel -- ^ Only run this job when the "ARM" 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) @@ -521,6 +528,8 @@ 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 @@ -791,6 +800,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , standardBuilds I386 (Linux Debian9) , allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) static) , disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt)) + , addValidateRule IpeData (validateBuilds Amd64 (Linux Debian10) zstdIpe) ] where ===================================== .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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && ($CI_MERGE_REQUEST_LABELS =~ /.*ARM.*/) && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*ARM.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -216,7 +216,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -274,7 +274,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -337,7 +337,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -396,7 +396,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -458,7 +458,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -517,7 +517,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -582,7 +582,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -643,7 +643,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -705,7 +705,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -767,7 +767,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -827,7 +827,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -886,7 +886,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -945,7 +945,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1005,7 +1005,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1064,7 +1064,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1083,7 +1083,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-ipe-data-compression", "TEST_ENV": "x86_64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -1123,7 +1123,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1182,7 +1182,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1241,7 +1241,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1302,7 +1302,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1361,7 +1361,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1420,7 +1420,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1482,7 +1482,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1543,7 +1543,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1605,7 +1605,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1666,7 +1666,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1721,7 +1721,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1780,7 +1780,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1843,7 +1843,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1907,7 +1907,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1967,7 +1967,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2030,7 +2030,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2090,7 +2090,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2156,7 +2156,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2218,7 +2218,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2281,7 +2281,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2344,7 +2344,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2405,7 +2405,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2465,7 +2465,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2525,7 +2525,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2585,7 +2585,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2645,7 +2645,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2708,7 +2708,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2770,7 +2770,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2832,7 +2832,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2895,7 +2895,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2951,7 +2951,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3011,7 +3011,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3075,7 +3075,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3139,7 +3139,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3199,7 +3199,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3260,7 +3260,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3321,7 +3321,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3380,7 +3380,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3439,7 +3439,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -3497,7 +3497,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3556,7 +3556,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3614,7 +3614,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/) && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3633,7 +3633,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-ipe-data-compression", "TEST_ENV": "x86_64-linux-deb10-validate" } }, @@ -3672,7 +3672,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3730,7 +3730,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3789,7 +3789,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -3849,7 +3849,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3907,7 +3907,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3965,7 +3965,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4026,7 +4026,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4086,7 +4086,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4147,7 +4147,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4207,7 +4207,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4261,7 +4261,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4319,7 +4319,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], ===================================== compiler/GHC/Data/FastString.hs ===================================== @@ -52,6 +52,9 @@ module GHC.Data.FastString fastStringToShortByteString, mkFastStringShortByteString, + -- * ShortText + fastStringToShortText, + -- * FastZString FastZString, hPutFZS, @@ -118,6 +121,7 @@ import GHC.Utils.IO.Unsafe import GHC.Utils.Panic.Plain import GHC.Utils.Misc import GHC.Data.FastMutInt +import GHC.Data.ShortText (ShortText(..)) import Control.Concurrent.MVar import Control.DeepSeq @@ -526,6 +530,9 @@ mkFastStringShortByteString :: ShortByteString -> FastString mkFastStringShortByteString sbs = inlinePerformIO $ mkFastStringWith (mkNewFastStringShortByteString sbs) sbs +fastStringToShortText :: FastString -> ShortText +fastStringToShortText = ShortText . fs_sbs + -- | Creates a UTF-8 encoded 'FastString' from a 'String' mkFastString :: String -> FastString {-# NOINLINE[1] mkFastString #-} ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -1,66 +1,188 @@ +{-# 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.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 (unpackFS) +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 @@ -70,13 +192,13 @@ toCgIPE platform ctx module_name ipe = do let label_str = maybe "" snd (infoTableProv ipe) let (src_loc_file, src_loc_span) = case infoTableProv ipe of - Nothing -> ("", "") + Nothing -> (mempty, "") Just (span, _) -> - let file = unpackFS $ srcSpanFile span + let file = fastStringToShortText $ srcSpanFile span coords = renderWithContext ctx (pprUserRealSpan False span) in (file, coords) - label <- lookupStringTable $ ST.pack label_str - src_file <- lookupStringTable $ ST.pack src_loc_file + label <- lookupStringTable $ ST.pack label_str + src_file <- lookupStringTable src_loc_file src_span <- lookupStringTable $ ST.pack src_loc_span return $ CgInfoProvEnt { ipeInfoTablePtr = infoTablePtr ipe , ipeTableName = table_name @@ -104,7 +226,7 @@ data StringTable = StringTable { stStrings :: DList ShortText , stLookup :: !(M.Map ShortText StrTabOffset) } -newtype StrTabOffset = StrTabOffset Int +type StrTabOffset = Word32 emptyStringTable :: StringTable emptyStringTable = @@ -129,9 +251,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 ===================================== @@ -62,6 +62,14 @@ Flag build-tool-depends Description: Use build-tool-depends Default: True +Flag with-libzstd + Default: False + Manual: True + +Flag static-libzstd + Default: False + Manual: True + Library Default-Language: Haskell2010 Exposed: False @@ -76,6 +84,16 @@ 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) + if flag(static-libzstd) + if os(darwin) + buildable: False + else + extra-libraries: :libzstd.a + else + extra-libraries: zstd + CPP-Options: -DHAVE_LIBZSTD + Build-Depends: base >= 4.11 && < 4.18, deepseq >= 1.4 && < 1.5, directory >= 1 && < 1.4, ===================================== configure.ac ===================================== @@ -1148,6 +1148,10 @@ AS_IF([test x"${UseLibffiForAdjustors}" = x"YES"], ) AC_SUBST([CabalLibffiAdjustors]) +dnl ** IPE data compression +dnl -------------------------------------------------------------- +FP_FIND_LIBZSTD + dnl ** Other RTS features dnl -------------------------------------------------------------- FP_FIND_LIBDW @@ -1318,6 +1322,19 @@ 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;) +STATIC_LIBZSTD=$(if [ "$StaticLibZstd" = "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 + statically linked? : $STATIC_LIBZSTD + libdw : $USING_LIBDW Using LLVM tools clang : $ClangCmd ===================================== docs/users_guide/debug-info.rst ===================================== @@ -370,9 +370,26 @@ 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. The compression + library ``libzstd`` may optionally be statically linked in the resulting + compiler (on non-darwin machines) using the ``--enable-static-libzstd`` + configure flag. + + 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 ===================================== @@ -201,8 +201,13 @@ libdw-lib-dir = @LibdwLibDir@ libnuma-include-dir = @LibNumaIncludeDir@ libnuma-lib-dir = @LibNumaLibDir@ +libzstd-include-dir = @LibZstdIncludeDir@ +libzstd-lib-dir = @LibZstdLibDir@ + # Optional Dependencies: #======================= with-libdw = @UseLibdw@ with-libnuma = @UseLibNuma@ +use-lib-zstd = @UseLibZstd@ +static-lib-zstd = @UseStaticLibZstd@ ===================================== hadrian/src/Oracles/Flag.hs ===================================== @@ -34,6 +34,8 @@ data Flag = ArSupportsAtFile | BootstrapThreadedRts | BootstrapEventLoggingRts | UseLibffiForAdjustors + | UseLibzstd + | StaticLibzstd -- Note, if a flag is set to empty string we treat it as set to NO. This seems -- fragile, but some flags do behave like this. @@ -58,6 +60,8 @@ flag f = do BootstrapThreadedRts -> "bootstrap-threaded-rts" BootstrapEventLoggingRts -> "bootstrap-event-logging-rts" UseLibffiForAdjustors -> "use-libffi-for-adjustors" + UseLibzstd -> "use-lib-zstd" + StaticLibzstd -> "static-lib-zstd" value <- lookupSystemConfig key when (value `notElem` ["YES", "NO", ""]) . error $ "Configuration flag " ++ quote (key ++ " = " ++ value) ++ " cannot be parsed." ===================================== 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/Settings/Packages.hs ===================================== @@ -75,6 +75,8 @@ packageArgs = do [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" , notM cross `cabalFlag` "terminfo" , arg "-build-tool-depends" + , flag UseLibzstd `cabalFlag` "with-libzstd" + , flag StaticLibzstd `cabalFlag` "static-libzstd" ] , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ] @@ -290,6 +292,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 @@ -397,6 +401,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/bytestring ===================================== @@ -1 +1 @@ -Subproject commit 9cab76dc861f651c3940e873ce921d9e09733cc8 +Subproject commit 1543e054a314865d89a259065921d5acba03d966 ===================================== libraries/containers ===================================== @@ -1 +1 @@ -Subproject commit 9f4a93604c66a5e605ce46fc30003b71802b3cfd +Subproject commit 50175b72dc781f82a419bddafba1bdd758fbee4b ===================================== libraries/ghc-bignum/gmp/gmp-tarballs ===================================== @@ -1 +1 @@ -Subproject commit 4f26049af40afb380eaf033ab91404cd2e214919 +Subproject commit 31f9909680ba8fe00d27fd8a6f5d198a0a96c1ac ===================================== libraries/parsec ===================================== @@ -1 +1 @@ -Subproject commit 1f542120d9adc5e22f8791a6d595210e93c6c389 +Subproject commit a74c68e948c99621100447014f48ccac7ee0448e ===================================== libraries/text ===================================== @@ -1 +1 @@ -Subproject commit e815d4d9bc362f4a3a36a850931fd3504eda967e +Subproject commit fdb06ff327519f3c0fc6cc9997b7cb7fe8ab8178 ===================================== 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,120 @@ +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] + ) + + StaticLibZstd=0 + AC_ARG_ENABLE( + static-libzstd, + [AS_HELP_STRING( + [--enable-static-libzstd], + [Statically link the libzstd compression library with the compiler + (not compatible with darwin) [default=no]] + )], + [StaticLibZstd=1], + [StaticLibZstd=0] + ) + + HaveLibZstd=0 + if test "$EnableIpeDataCompression" = "YES"; then + dnl ** Have zstd >= 1.4.0? + 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 + + # libzstd >= 1.4.0 is required for IPE data compression + fp_libzstd_version="`pkg-config --modversion libzstd`" + FP_COMPARE_VERSIONS( + [$fp_libzstd_version], + [-lt], + [1.4.0], + [AC_MSG_ERROR( + [Need at least libzstd version 1.4.0 for + --enable-ipe-data-compression]) + ] + ) + + 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)]) + + AC_DEFINE_UNQUOTED([STATIC_LIBZSTD], [$StaticLibZstd], [Define to 1 if you + wish to statically link the libzstd compression library in the compiler + (requires libzstd)]) + + if test $HaveLibZstd = "1" ; then + AC_SUBST([UseLibZstd],[YES]) + AC_SUBST([CabalHaveLibZstd],[True]) + if test $StaticLibZstd = "1" ; then + case "${host_os}" in + darwin*) + AC_MSG_ERROR( + [--enable-static-libzstd is not compatible with darwin] + ) + esac + AC_SUBST([UseStaticLibZstd],[YES]) + AC_SUBST([CabalStaticLibZstd],[True]) + else + AC_SUBST([UseStaticLibZstd],[NO]) + AC_SUBST([CabalStaticLibZstd],[False]) + fi + 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,19 +82,18 @@ 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] } }; } @@ -105,8 +109,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; @@ -169,16 +183,85 @@ 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; + IpeBufferEntry *entries; + 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 == 1) { + // 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 ===================================== @@ -30,6 +30,10 @@ flag libdw default: @CabalHaveLibdw@ flag libnuma default: @CabalHaveLibNuma@ +flag libzstd + default: @CabalHaveLibZstd@ +flag static-libzstd + default: @CabalStaticLibZstd@ flag 64bit default: @Cabal64bit@ flag leading-underscore @@ -148,6 +152,14 @@ library extra-libraries: elf dw if flag(libnuma) extra-libraries: numa + if flag(libzstd) + if flag(static-libzstd) + if os(darwin) + buildable: False + else + extra-libraries: :libzstd.a + else + extra-libraries: zstd if !flag(smp) cpp-options: -DNOSMP ===================================== 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/24f9593747ba8888514cce127757122e9159c183 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/24f9593747ba8888514cce127757122e9159c183 You're receiving 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 Jun 22 21:04:24 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 22 Jun 2023 17:04:24 -0400 Subject: [Git][ghc/ghc][wip/ipe-optimisation-9.4] IPE data compression Message-ID: <6494b758cc232_3a0200c5f085937a@gitlab.mail> Ben Gamari pushed to branch wip/ipe-optimisation-9.4 at Glasgow Haskell Compiler / GHC Commits: d12dc60b by Finley McIlwaine at 2023-06-22T17:03:54-04:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 27 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Data/FastString.hs - compiler/GHC/StgToCmm/InfoTableProv.hs - compiler/ghc.cabal.in - configure.ac - docs/users_guide/debug-info.rst - hadrian/cfg/system.config.in - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Settings/Packages.hs - libraries/bytestring - libraries/containers - libraries/ghc-bignum/gmp/gmp-tarballs - libraries/parsec - libraries/text - 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/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-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: 58d08589371e78829a3279c6f8b1241e155d7f70 + DOCKER_REV: 243a00f06550e6b9a00fa0f1530d1bb761e8b7cc # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. ===================================== .gitlab/gen_ci.hs ===================================== @@ -116,6 +116,7 @@ data BuildConfig , llvmBootstrap :: Bool , withAssertions :: Bool , withNuma :: Bool + , withZstd :: Bool , fullyStatic :: Bool , tablesNextToCode :: Bool , threadSanitiser :: Bool @@ -126,6 +127,7 @@ configureArgsStr :: BuildConfig -> String configureArgsStr bc = intercalate " " $ ["--enable-unregisterised"| unregisterised bc ] ++ ["--disable-tables-next-to-code" | not (tablesNextToCode bc) ] + ++ ["--enable-ipe-data-compression" | withZstd bc ] -- Compute the hadrian flavour from the BuildConfig mkJobFlavour :: BuildConfig -> Flavour @@ -156,6 +158,7 @@ vanilla = BuildConfig , llvmBootstrap = False , withAssertions = False , withNuma = False + , withZstd = False , fullyStatic = False , tablesNextToCode = True , threadSanitiser = False @@ -180,6 +183,9 @@ debug = vanilla { buildFlavour = SlowValidate , withNuma = True } +zstdIpe :: BuildConfig +zstdIpe = vanilla { withZstd = True } + static :: BuildConfig static = vanilla { fullyStatic = True } @@ -494,7 +500,8 @@ 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. - | ARMLabel -- ^ Only run this job when the "ARM" label is set. + | ARMLabel -- ^ Only run this job when the "ARM" 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) @@ -521,6 +528,8 @@ 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 @@ -791,6 +800,7 @@ jobs = M.fromList $ concatMap flattenJobGroup $ , standardBuilds I386 (Linux Debian9) , allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) static) , disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt)) + , addValidateRule IpeData (validateBuilds Amd64 (Linux Debian10) zstdIpe) ] where ===================================== .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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && ($CI_MERGE_REQUEST_LABELS =~ /.*ARM.*/) && (\"true\" == \"true\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*ARM.*/) && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -216,7 +216,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -274,7 +274,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -337,7 +337,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -396,7 +396,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -458,7 +458,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -517,7 +517,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -582,7 +582,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -643,7 +643,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -705,7 +705,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -767,7 +767,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -827,7 +827,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -886,7 +886,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -945,7 +945,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1005,7 +1005,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1064,7 +1064,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1083,7 +1083,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-ipe-data-compression", "TEST_ENV": "x86_64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -1123,7 +1123,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1182,7 +1182,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1241,7 +1241,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1302,7 +1302,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1361,7 +1361,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1420,7 +1420,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1482,7 +1482,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1543,7 +1543,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1605,7 +1605,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1666,7 +1666,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1721,7 +1721,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1780,7 +1780,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1843,7 +1843,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1907,7 +1907,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -1967,7 +1967,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2030,7 +2030,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2090,7 +2090,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2156,7 +2156,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2218,7 +2218,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2281,7 +2281,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2344,7 +2344,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2405,7 +2405,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2465,7 +2465,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2525,7 +2525,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2585,7 +2585,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2645,7 +2645,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2708,7 +2708,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2770,7 +2770,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2832,7 +2832,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2895,7 +2895,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -2951,7 +2951,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3011,7 +3011,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3075,7 +3075,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3139,7 +3139,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*FreeBSD.*/) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3199,7 +3199,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3260,7 +3260,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3321,7 +3321,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3380,7 +3380,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3439,7 +3439,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -3497,7 +3497,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3556,7 +3556,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3614,7 +3614,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && ($CI_MERGE_REQUEST_LABELS =~ /.*IPE.*/) && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3633,7 +3633,7 @@ "BIGNUM_BACKEND": "gmp", "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", - "CONFIGURE_ARGS": "", + "CONFIGURE_ARGS": "--enable-ipe-data-compression", "TEST_ENV": "x86_64-linux-deb10-validate" } }, @@ -3672,7 +3672,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3730,7 +3730,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && ($CI_MERGE_REQUEST_LABELS =~ /.*LLVM backend.*/) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -3789,7 +3789,7 @@ "rules": [ { "allow_failure": true, - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "manual" } ], @@ -3849,7 +3849,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3907,7 +3907,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -3965,7 +3965,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4026,7 +4026,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"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\") && (\"true\" == \"true\")", "when": "on_success" } ], @@ -4086,7 +4086,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4147,7 +4147,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4207,7 +4207,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4261,7 +4261,7 @@ ], "rules": [ { - "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", + "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"disabled\" != \"disabled\")", "when": "on_success" } ], @@ -4319,7 +4319,7 @@ ], "rules": [ { - "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", + "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")", "when": "on_success" } ], ===================================== compiler/GHC/Data/FastString.hs ===================================== @@ -52,6 +52,9 @@ module GHC.Data.FastString fastStringToShortByteString, mkFastStringShortByteString, + -- * ShortText + fastStringToShortText, + -- * FastZString FastZString, hPutFZS, @@ -118,6 +121,7 @@ import GHC.Utils.IO.Unsafe import GHC.Utils.Panic.Plain import GHC.Utils.Misc import GHC.Data.FastMutInt +import GHC.Data.ShortText (ShortText(..)) import Control.Concurrent.MVar import Control.DeepSeq @@ -526,6 +530,9 @@ mkFastStringShortByteString :: ShortByteString -> FastString mkFastStringShortByteString sbs = inlinePerformIO $ mkFastStringWith (mkNewFastStringShortByteString sbs) sbs +fastStringToShortText :: FastString -> ShortText +fastStringToShortText = ShortText . fs_sbs + -- | Creates a UTF-8 encoded 'FastString' from a 'String' mkFastString :: String -> FastString {-# NOINLINE[1] mkFastString #-} ===================================== compiler/GHC/StgToCmm/InfoTableProv.hs ===================================== @@ -1,66 +1,188 @@ +{-# 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.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 (unpackFS) +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 @@ -70,13 +192,13 @@ toCgIPE platform ctx module_name ipe = do let label_str = maybe "" snd (infoTableProv ipe) let (src_loc_file, src_loc_span) = case infoTableProv ipe of - Nothing -> ("", "") + Nothing -> (mempty, "") Just (span, _) -> - let file = unpackFS $ srcSpanFile span + let file = fastStringToShortText $ srcSpanFile span coords = renderWithContext ctx (pprUserRealSpan False span) in (file, coords) - label <- lookupStringTable $ ST.pack label_str - src_file <- lookupStringTable $ ST.pack src_loc_file + label <- lookupStringTable $ ST.pack label_str + src_file <- lookupStringTable src_loc_file src_span <- lookupStringTable $ ST.pack src_loc_span return $ CgInfoProvEnt { ipeInfoTablePtr = infoTablePtr ipe , ipeTableName = table_name @@ -104,7 +226,7 @@ data StringTable = StringTable { stStrings :: DList ShortText , stLookup :: !(M.Map ShortText StrTabOffset) } -newtype StrTabOffset = StrTabOffset Int +type StrTabOffset = Word32 emptyStringTable :: StringTable emptyStringTable = @@ -129,9 +251,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 ===================================== @@ -62,6 +62,14 @@ Flag build-tool-depends Description: Use build-tool-depends Default: True +Flag with-libzstd + Default: False + Manual: True + +Flag static-libzstd + Default: False + Manual: True + Library Default-Language: Haskell2010 Exposed: False @@ -76,6 +84,16 @@ 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) + if flag(static-libzstd) + if os(darwin) + buildable: False + else + extra-libraries: :libzstd.a + else + extra-libraries: zstd + CPP-Options: -DHAVE_LIBZSTD + Build-Depends: base >= 4.11 && < 4.18, deepseq >= 1.4 && < 1.5, directory >= 1 && < 1.4, ===================================== configure.ac ===================================== @@ -1148,6 +1148,10 @@ AS_IF([test x"${UseLibffiForAdjustors}" = x"YES"], ) AC_SUBST([CabalLibffiAdjustors]) +dnl ** IPE data compression +dnl -------------------------------------------------------------- +FP_FIND_LIBZSTD + dnl ** Other RTS features dnl -------------------------------------------------------------- FP_FIND_LIBDW @@ -1318,6 +1322,19 @@ 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;) +STATIC_LIBZSTD=$(if [ "$StaticLibZstd" = "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 + statically linked? : $STATIC_LIBZSTD + libdw : $USING_LIBDW Using LLVM tools clang : $ClangCmd ===================================== docs/users_guide/debug-info.rst ===================================== @@ -370,9 +370,26 @@ 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. The compression + library ``libzstd`` may optionally be statically linked in the resulting + compiler (on non-darwin machines) using the ``--enable-static-libzstd`` + configure flag. + + 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 ===================================== @@ -201,8 +201,13 @@ libdw-lib-dir = @LibdwLibDir@ libnuma-include-dir = @LibNumaIncludeDir@ libnuma-lib-dir = @LibNumaLibDir@ +libzstd-include-dir = @LibZstdIncludeDir@ +libzstd-lib-dir = @LibZstdLibDir@ + # Optional Dependencies: #======================= with-libdw = @UseLibdw@ with-libnuma = @UseLibNuma@ +use-lib-zstd = @UseLibZstd@ +static-lib-zstd = @UseStaticLibZstd@ ===================================== hadrian/src/Oracles/Flag.hs ===================================== @@ -34,6 +34,8 @@ data Flag = ArSupportsAtFile | BootstrapThreadedRts | BootstrapEventLoggingRts | UseLibffiForAdjustors + | UseLibzstd + | StaticLibzstd -- Note, if a flag is set to empty string we treat it as set to NO. This seems -- fragile, but some flags do behave like this. @@ -58,6 +60,8 @@ flag f = do BootstrapThreadedRts -> "bootstrap-threaded-rts" BootstrapEventLoggingRts -> "bootstrap-event-logging-rts" UseLibffiForAdjustors -> "use-libffi-for-adjustors" + UseLibzstd -> "use-lib-zstd" + StaticLibzstd -> "static-lib-zstd" value <- lookupSystemConfig key when (value `notElem` ["YES", "NO", ""]) . error $ "Configuration flag " ++ quote (key ++ " = " ++ value) ++ " cannot be parsed." ===================================== 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/Settings/Packages.hs ===================================== @@ -75,6 +75,8 @@ packageArgs = do [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter" , notM cross `cabalFlag` "terminfo" , arg "-build-tool-depends" + , flag UseLibzstd `cabalFlag` "with-libzstd" + , flag StaticLibzstd `cabalFlag` "static-libzstd" ] , builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ] @@ -290,6 +292,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 @@ -397,6 +401,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/bytestring ===================================== @@ -1 +1 @@ -Subproject commit 9cab76dc861f651c3940e873ce921d9e09733cc8 +Subproject commit 1543e054a314865d89a259065921d5acba03d966 ===================================== libraries/containers ===================================== @@ -1 +1 @@ -Subproject commit 9f4a93604c66a5e605ce46fc30003b71802b3cfd +Subproject commit 50175b72dc781f82a419bddafba1bdd758fbee4b ===================================== libraries/ghc-bignum/gmp/gmp-tarballs ===================================== @@ -1 +1 @@ -Subproject commit 4f26049af40afb380eaf033ab91404cd2e214919 +Subproject commit 31f9909680ba8fe00d27fd8a6f5d198a0a96c1ac ===================================== libraries/parsec ===================================== @@ -1 +1 @@ -Subproject commit 1f542120d9adc5e22f8791a6d595210e93c6c389 +Subproject commit a74c68e948c99621100447014f48ccac7ee0448e ===================================== libraries/text ===================================== @@ -1 +1 @@ -Subproject commit e815d4d9bc362f4a3a36a850931fd3504eda967e +Subproject commit fdb06ff327519f3c0fc6cc9997b7cb7fe8ab8178 ===================================== 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,120 @@ +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] + ) + + StaticLibZstd=0 + AC_ARG_ENABLE( + static-libzstd, + [AS_HELP_STRING( + [--enable-static-libzstd], + [Statically link the libzstd compression library with the compiler + (not compatible with darwin) [default=no]] + )], + [StaticLibZstd=1], + [StaticLibZstd=0] + ) + + HaveLibZstd=0 + if test "$EnableIpeDataCompression" = "YES"; then + dnl ** Have zstd >= 1.4.0? + 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 + + # libzstd >= 1.4.0 is required for IPE data compression + fp_libzstd_version="`pkg-config --modversion libzstd`" + FP_COMPARE_VERSIONS( + [$fp_libzstd_version], + [-lt], + [1.4.0], + [AC_MSG_ERROR( + [Need at least libzstd version 1.4.0 for + --enable-ipe-data-compression]) + ] + ) + + 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)]) + + AC_DEFINE_UNQUOTED([STATIC_LIBZSTD], [$StaticLibZstd], [Define to 1 if you + wish to statically link the libzstd compression library in the compiler + (requires libzstd)]) + + if test $HaveLibZstd = "1" ; then + AC_SUBST([UseLibZstd],[YES]) + AC_SUBST([CabalHaveLibZstd],[True]) + if test $StaticLibZstd = "1" ; then + case "${host_os}" in + darwin*) + AC_MSG_ERROR( + [--enable-static-libzstd is not compatible with darwin] + ) + esac + AC_SUBST([UseStaticLibZstd],[YES]) + AC_SUBST([CabalStaticLibZstd],[True]) + else + AC_SUBST([UseStaticLibZstd],[NO]) + AC_SUBST([CabalStaticLibZstd],[False]) + fi + 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,19 +82,18 @@ 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] } }; } @@ -105,8 +109,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; @@ -169,16 +183,85 @@ 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; + IpeBufferEntry *entries; + 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 == 1) { + // 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 ===================================== @@ -30,6 +30,10 @@ flag libdw default: @CabalHaveLibdw@ flag libnuma default: @CabalHaveLibNuma@ +flag libzstd + default: @CabalHaveLibZstd@ +flag static-libzstd + default: @CabalStaticLibZstd@ flag 64bit default: @Cabal64bit@ flag leading-underscore @@ -148,6 +152,14 @@ library extra-libraries: elf dw if flag(libnuma) extra-libraries: numa + if flag(libzstd) + if flag(static-libzstd) + if os(darwin) + buildable: False + else + extra-libraries: :libzstd.a + else + extra-libraries: zstd if !flag(smp) cpp-options: -DNOSMP ===================================== 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/d12dc60bf8b9c2d6a8c060564ec3e92eb2c755eb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d12dc60bf8b9c2d6a8c060564ec3e92eb2c755eb You're receiving 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 Jun 22 21:17:21 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 22 Jun 2023 17:17:21 -0400 Subject: [Git][ghc/ghc][wip/ipe-optimisation-9.4] 2 commits: Drop unused LANGUAGE pragma Message-ID: <6494ba61ac74c_3a0200c5f30614c7@gitlab.mail> Ben Gamari pushed to branch wip/ipe-optimisation-9.4 at Glasgow Haskell Compiler / GHC Commits: e6fd74b6 by Ben Gamari at 2023-06-22T17:15:23-04:00 Drop unused LANGUAGE pragma - - - - - 48daf5dd by Ben Gamari at 2023-06-22T17:17:12-04:00 gitlab-ci: Allow linters to fail - - - - - 2 changed files: - .gitlab-ci.yml - compiler/GHC/Data/OrdList.hs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -93,6 +93,7 @@ workflow: .lint: stage: tool-lint + allow_failure: true tags: - lint rules: ===================================== compiler/GHC/Data/OrdList.hs ===================================== @@ -9,7 +9,6 @@ {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE UnboxedSums #-} -{-# LANGUAGE UnboxedTuples #-} -- | Provide trees (of instructions), so that lists of instructions can be -- appended in linear time. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d12dc60bf8b9c2d6a8c060564ec3e92eb2c755eb...48daf5dd5e90e00f54ceb555f8b0fd8958aa38aa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d12dc60bf8b9c2d6a8c060564ec3e92eb2c755eb...48daf5dd5e90e00f54ceb555f8b0fd8958aa38aa You're receiving 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 Jun 22 23:01:27 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 22 Jun 2023 19:01:27 -0400 Subject: [Git][ghc/ghc][wip/tsan/fixes-2] 6 commits: hadrian: Ensure that way-flags are passed to CC Message-ID: <6494d2c75095a_3a0200c5fa8698c6@gitlab.mail> Ben Gamari pushed to branch wip/tsan/fixes-2 at Glasgow Haskell Compiler / GHC Commits: ae33b2c4 by Ben Gamari at 2023-06-22T18:58:53-04:00 hadrian: Ensure that way-flags are passed to CC Previously the way-specific compilation flags (e.g. `-DDEBUG`, `-DTHREADED_RTS`) would not be passed to the CC invocations. This meant that C dependency files would not correctly reflect dependencies predicated on the way, resulting in the rather painful #23554. Closes #23554. - - - - - d1297dec by Ben Gamari at 2023-06-22T18:59:22-04:00 rts/Interpreter: Fix data race - - - - - 634f8086 by Ben Gamari at 2023-06-22T18:59:48-04:00 rts/Messages: Fix data race - - - - - e6b6660a by Ben Gamari at 2023-06-22T19:00:06-04:00 rts/Prof: Fix data race - - - - - 3f409a46 by Ben Gamari at 2023-06-22T19:00:31-04:00 rts: Fix various data races - - - - - 31b8071c by Ben Gamari at 2023-06-22T19:00:43-04:00 rts: Use fence rather than redundant load - - - - - 11 changed files: - hadrian/src/Settings/Builders/Common.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Packages.hs - rts/Interpreter.c - rts/Messages.c - rts/Proftimer.c - rts/include/rts/storage/ClosureMacros.h - rts/sm/Evac.c - rts/sm/GC.c - rts/sm/GCAux.c - rts/sm/Storage.c Changes: ===================================== hadrian/src/Settings/Builders/Common.hs ===================================== @@ -6,7 +6,8 @@ module Settings.Builders.Common ( module Settings, module UserSettings, cIncludeArgs, ldArgs, cArgs, cppArgs, cWarnings, - packageDatabaseArgs, bootPackageDatabaseArgs + packageDatabaseArgs, bootPackageDatabaseArgs, + wayCcArgs ) where import Hadrian.Haskell.Cabal.Type @@ -65,3 +66,12 @@ bootPackageDatabaseArgs = do dbPath <- expr $ packageDbPath loc expr $ need [dbPath -/- packageDbStamp] stage0 ? packageDatabaseArgs + +wayCcArgs :: Args +wayCcArgs = do + way <- getWay + mconcat [ (Threaded `wayUnit` way) ? arg "-DTHREADED_RTS" + , (Debug `wayUnit` way) ? arg "-DDEBUG" + , (way == debug || way == debugDynamic) ? arg "-DTICKY_TICKY" + ] + ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -240,11 +240,14 @@ wayGhcArgs = do mconcat [ if Dynamic `wayUnit` way then pure ["-fPIC", "-dynamic"] else arg "-static" - , (Threaded `wayUnit` way) ? arg "-optc-DTHREADED_RTS" - , (Debug `wayUnit` way) ? arg "-optc-DDEBUG" , (Profiling `wayUnit` way) ? arg "-prof" - , (way == debug || way == debugDynamic) ? - pure ["-ticky", "-DTICKY_TICKY"] ] + , (way == debug || way == debugDynamic) ? arg "-ticky" + , wayCcArgs + -- We must pass CPP flags via -optc as well to ensure that they + -- are passed to the preprocessor when, e.g., compiling Cmm + -- sources. + , map ("-optc"++) <$> wayCcArgs + ] -- | Args related to correct handling of packages, such as setting -- -this-unit-id and passing -package-id for dependencies ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -6,6 +6,7 @@ import Oracles.Setting import Oracles.Flag import Packages import Settings +import Settings.Builders.Common (wayCcArgs) -- | Package-specific command-line arguments. packageArgs :: Args @@ -312,6 +313,7 @@ rtsPackageArgs = package rts ? do let cArgs = mconcat [ rtsWarnings + , wayCcArgs , arg "-fomit-frame-pointer" -- RTS *must* be compiled with optimisations. The INLINE_HEADER macro -- requires that functions are inlined to work as expected. Inlining ===================================== rts/Interpreter.c ===================================== @@ -315,8 +315,9 @@ interpretBCO (Capability* cap) LOAD_THREAD_STATE(); - RELAXED_STORE(&cap->r.rHpLim, (P_)1); // HpLim is the context-switch flag; when it - // goes to zero we must return to the scheduler. + // N.B. HpLim is the context-switch flag; when it + // goes to zero we must return to the scheduler. + RELAXED_STORE_ALWAYS(&cap->r.rHpLim, (P_)1); IF_DEBUG(interpreter, debugBelch( ===================================== rts/Messages.c ===================================== @@ -205,7 +205,7 @@ uint32_t messageBlackHole(Capability *cap, MessageBlackHole *msg) StgTSO *owner = (StgTSO*)p; #if defined(THREADED_RTS) - if (owner->cap != cap) { + if (RELAXED_LOAD(&owner->cap) != cap) { sendMessage(cap, owner->cap, (Message*)msg); debugTraceCap(DEBUG_sched, cap, "forwarding message to cap %d", owner->cap->no); @@ -275,7 +275,7 @@ uint32_t messageBlackHole(Capability *cap, MessageBlackHole *msg) ASSERT(owner != END_TSO_QUEUE); #if defined(THREADED_RTS) - if (owner->cap != cap) { + if (RELAXED_LOAD(&owner->cap) != cap) { sendMessage(cap, owner->cap, (Message*)msg); debugTraceCap(DEBUG_sched, cap, "forwarding message to cap %d", owner->cap->no); ===================================== rts/Proftimer.c ===================================== @@ -124,7 +124,8 @@ handleProfTick(void) uint32_t n; for (n=0; n < getNumCapabilities(); n++) { Capability *cap = getCapability(n); - cap->r.rCCCS->time_ticks++; + CostCentreStack *ccs = RELAXED_LOAD(&cap->r.rCCCS); + ccs->time_ticks++; traceProfSampleCostCentre(cap, cap->r.rCCCS, total_ticks); } } ===================================== rts/include/rts/storage/ClosureMacros.h ===================================== @@ -182,7 +182,7 @@ EXTERN_INLINE StgHalfWord GET_TAG(const StgClosure *con) // Use when changing a closure from one kind to another #define OVERWRITE_INFO(c, new_info) \ OVERWRITING_CLOSURE((StgClosure *)(c)); \ - SET_INFO((StgClosure *)(c), (new_info)); \ + SET_INFO_RELAXED((StgClosure *)(c), (new_info)); \ LDV_RECORD_CREATE(c); /* ----------------------------------------------------------------------------- ===================================== rts/sm/Evac.c ===================================== @@ -1542,7 +1542,7 @@ selector_loop: bale_out: // We didn't manage to evaluate this thunk; restore the old info // pointer. But don't forget: we still need to evacuate the thunk itself. - SET_INFO((StgClosure *)p, (const StgInfoTable *)info_ptr); + SET_INFO_RELAXED((StgClosure *)p, (const StgInfoTable *)info_ptr); // THREADED_RTS: we just unlocked the thunk, so another thread // might get in and update it. copy() will lock it again and // check whether it was updated in the meantime. ===================================== rts/sm/GC.c ===================================== @@ -340,8 +340,8 @@ GarbageCollect (struct GcConfig config, // attribute any costs to CCS_GC #if defined(PROFILING) for (n = 0; n < getNumCapabilities(); n++) { - save_CCS[n] = getCapability(n)->r.rCCCS; - getCapability(n)->r.rCCCS = CCS_GC; + save_CCS[n] = RELAXED_LOAD(&getCapability(n)->r.rCCCS); + RELAXED_STORE(&getCapability(n)->r.rCCCS, CCS_GC); } #endif ===================================== rts/sm/GCAux.c ===================================== @@ -91,7 +91,7 @@ isAlive(StgClosure *p) return TAG_CLOSURE(tag,(StgClosure*)UN_FORWARDING_PTR(info)); } - ACQUIRE_LOAD(&q->header.info); + ACQUIRE_FENCE_ON(&q->header.info); info = INFO_PTR_TO_STRUCT(info); switch (info->type) { ===================================== rts/sm/Storage.c ===================================== @@ -1431,7 +1431,7 @@ dirty_MUT_VAR(StgRegTable *reg, StgMutVar *mvar, StgClosure *old) Capability *cap = regTableToCapability(reg); // No barrier required here as no other heap object fields are read. See // Note [Heap memory barriers] in SMP.h. - SET_INFO((StgClosure*) mvar, &stg_MUT_VAR_DIRTY_info); + SET_INFO_RELAXED((StgClosure*) mvar, &stg_MUT_VAR_DIRTY_info); recordClosureMutated(cap, (StgClosure *) mvar); IF_NONMOVING_WRITE_BARRIER_ENABLED { // See Note [Dirty flags in the non-moving collector] in NonMoving.c @@ -1453,7 +1453,7 @@ dirty_TVAR(Capability *cap, StgTVar *p, // No barrier required here as no other heap object fields are read. See // Note [Heap memory barriers] in SMP.h. if (RELAXED_LOAD(&p->header.info) == &stg_TVAR_CLEAN_info) { - SET_INFO((StgClosure*) p, &stg_TVAR_DIRTY_info); + SET_INFO_RELAXED((StgClosure*) p, &stg_TVAR_DIRTY_info); recordClosureMutated(cap,(StgClosure*)p); IF_NONMOVING_WRITE_BARRIER_ENABLED { // See Note [Dirty flags in the non-moving collector] in NonMoving.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a177f3fe91f796331bc0abfb84aaf55b1186821d...31b8071c6535820e4edc0a45620a1a66da469a88 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a177f3fe91f796331bc0abfb84aaf55b1186821d...31b8071c6535820e4edc0a45620a1a66da469a88 You're receiving 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 Jun 23 01:25:55 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 22 Jun 2023 21:25:55 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 26 commits: rts/ipe: Fix unused lock warning Message-ID: <6494f4a3e7dd9_3a0200251d1f8760d0@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 8bf19573 by Ben Gamari at 2023-06-22T21:25:50-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - c7397a89 by Matthew Pickering at 2023-06-22T21:25:50-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Runtime/Context.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/Loader.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3ec80b613b38917b2152bd760b907a658099dc96...c7397a89704ad5bd049120052367b4d89531fed6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3ec80b613b38917b2152bd760b907a658099dc96...c7397a89704ad5bd049120052367b4d89531fed6 You're receiving 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 Jun 23 05:36:48 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 23 Jun 2023 01:36:48 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: rts: Work around missing prototypes errors Message-ID: <64952f707e208_3a02001032c93010557@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 80483f92 by Ben Gamari at 2023-06-23T01:36:44-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 46818aa3 by Matthew Pickering at 2023-06-23T01:36:44-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 2 changed files: - .gitlab-ci.yml - rts/include/stg/SMP.h Changes: ===================================== .gitlab-ci.yml ===================================== @@ -1063,7 +1063,7 @@ ghcup-metadata-nightly: artifacts: false - job: project-version script: - - nix shell --extra-experimental-features nix-command -f .gitlab/rel_eng -c ghcup-metadata --metadata ghcup-0.0.7.yaml --date="$(date -d $CI_PIPELINE_CREATED_AT +%Y-%M-%d)" --pipeline-id="$CI_PIPELINE_ID" --version="$ProjectVersion" > "metadata_test.yaml" + - nix shell --extra-experimental-features nix-command -f .gitlab/rel_eng -c ghcup-metadata --metadata ghcup-0.0.7.yaml --date="$(date -d $CI_PIPELINE_CREATED_AT +%Y-%m-%d)" --pipeline-id="$CI_PIPELINE_ID" --version="$ProjectVersion" > "metadata_test.yaml" rules: - if: $NIGHTLY @@ -1100,7 +1100,7 @@ ghcup-metadata-release: # No explicit needs for release pipeline as we assume we need everything and everything will pass. extends: .ghcup-metadata script: - - nix shell --extra-experimental-features nix-command -f .gitlab/rel_eng -c ghcup-metadata --release-mode --metadata ghcup-0.0.7.yaml --date="$(date -d $CI_PIPELINE_CREATED_AT +%Y-%M-%d)" --pipeline-id="$CI_PIPELINE_ID" --version="$ProjectVersion" > "metadata_test.yaml" + - nix shell --extra-experimental-features nix-command -f .gitlab/rel_eng -c ghcup-metadata --release-mode --metadata ghcup-0.0.7.yaml --date="$(date -d $CI_PIPELINE_CREATED_AT +%Y-%m-%d)" --pipeline-id="$CI_PIPELINE_ID" --version="$ProjectVersion" > "metadata_test.yaml" rules: - if: '$RELEASE_JOB == "yes"' ===================================== rts/include/stg/SMP.h ===================================== @@ -589,9 +589,9 @@ load_load_barrier(void) { EXTERN_INLINE void write_barrier(void); EXTERN_INLINE void store_load_barrier(void); EXTERN_INLINE void load_load_barrier(void); -EXTERN_INLINE void write_barrier () {} /* nothing */ -EXTERN_INLINE void store_load_barrier() {} /* nothing */ -EXTERN_INLINE void load_load_barrier () {} /* nothing */ +EXTERN_INLINE void write_barrier (void) {} /* nothing */ +EXTERN_INLINE void store_load_barrier(void) {} /* nothing */ +EXTERN_INLINE void load_load_barrier (void) {} /* nothing */ // Relaxed atomic operations #define RELAXED_LOAD(ptr) *ptr View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c7397a89704ad5bd049120052367b4d89531fed6...46818aa3d1cd7fbe8b89205817f7ed74585d3ede -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c7397a89704ad5bd049120052367b4d89531fed6...46818aa3d1cd7fbe8b89205817f7ed74585d3ede You're receiving 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 Jun 23 07:57:05 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 23 Jun 2023 03:57:05 -0400 Subject: [Git][ghc/ghc][master] rts: Work around missing prototypes errors Message-ID: <649550515ea6c_3a0200c5f4412808b@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 1 changed file: - rts/include/stg/SMP.h Changes: ===================================== rts/include/stg/SMP.h ===================================== @@ -589,9 +589,9 @@ load_load_barrier(void) { EXTERN_INLINE void write_barrier(void); EXTERN_INLINE void store_load_barrier(void); EXTERN_INLINE void load_load_barrier(void); -EXTERN_INLINE void write_barrier () {} /* nothing */ -EXTERN_INLINE void store_load_barrier() {} /* nothing */ -EXTERN_INLINE void load_load_barrier () {} /* nothing */ +EXTERN_INLINE void write_barrier (void) {} /* nothing */ +EXTERN_INLINE void store_load_barrier(void) {} /* nothing */ +EXTERN_INLINE void load_load_barrier (void) {} /* nothing */ // Relaxed atomic operations #define RELAXED_LOAD(ptr) *ptr View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5b6612bc4f6b0a7ecc9868750bee1c359ffca871 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5b6612bc4f6b0a7ecc9868750bee1c359ffca871 You're receiving 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 Jun 23 07:57:45 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 23 Jun 2023 03:57:45 -0400 Subject: [Git][ghc/ghc][master] ghcup-metadata: Fix date modifier (M = minutes, m = month) Message-ID: <64955079af948_3a0200132850741331c5@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -1063,7 +1063,7 @@ ghcup-metadata-nightly: artifacts: false - job: project-version script: - - nix shell --extra-experimental-features nix-command -f .gitlab/rel_eng -c ghcup-metadata --metadata ghcup-0.0.7.yaml --date="$(date -d $CI_PIPELINE_CREATED_AT +%Y-%M-%d)" --pipeline-id="$CI_PIPELINE_ID" --version="$ProjectVersion" > "metadata_test.yaml" + - nix shell --extra-experimental-features nix-command -f .gitlab/rel_eng -c ghcup-metadata --metadata ghcup-0.0.7.yaml --date="$(date -d $CI_PIPELINE_CREATED_AT +%Y-%m-%d)" --pipeline-id="$CI_PIPELINE_ID" --version="$ProjectVersion" > "metadata_test.yaml" rules: - if: $NIGHTLY @@ -1100,7 +1100,7 @@ ghcup-metadata-release: # No explicit needs for release pipeline as we assume we need everything and everything will pass. extends: .ghcup-metadata script: - - nix shell --extra-experimental-features nix-command -f .gitlab/rel_eng -c ghcup-metadata --release-mode --metadata ghcup-0.0.7.yaml --date="$(date -d $CI_PIPELINE_CREATED_AT +%Y-%M-%d)" --pipeline-id="$CI_PIPELINE_ID" --version="$ProjectVersion" > "metadata_test.yaml" + - nix shell --extra-experimental-features nix-command -f .gitlab/rel_eng -c ghcup-metadata --release-mode --metadata ghcup-0.0.7.yaml --date="$(date -d $CI_PIPELINE_CREATED_AT +%Y-%m-%d)" --pipeline-id="$CI_PIPELINE_ID" --version="$ProjectVersion" > "metadata_test.yaml" rules: - if: '$RELEASE_JOB == "yes"' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/43b66a132ad0e6b14e191f27c2599832850e05f2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/43b66a132ad0e6b14e191f27c2599832850e05f2 You're receiving 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 Jun 23 08:10:01 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 23 Jun 2023 04:10:01 -0400 Subject: [Git][ghc/ghc][wip/T22010] Add genSym.js Message-ID: <649553596aee4_3a02001373045c1350f@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 2bd06da6 by Jaro Reinders at 2023-06-23T10:09:49+02:00 Add genSym.js - - - - - 2 changed files: - compiler/ghc.cabal.in - + compiler/jsbits/genSym.js Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -160,6 +160,9 @@ Library cbits/cutils.c cbits/genSym.c cbits/keepCAFsForGHCi.c + + js-sources: + jsbits/genSym.js hs-source-dirs: . ===================================== compiler/jsbits/genSym.js ===================================== @@ -0,0 +1,15 @@ +//#OPTIONS: CPP +#include "Unique.h" + +// We assume that the unique tag occupies less than 32 bits (should be safe) +#define HIGH_UNIQUE_BITS (32 - UNIQUE_TAG_BITS) +#define HIGH_UNIQUE_MASK ((1 << HIGH_UNIQUE_BITS) - 1) + +function genSym() { + var rl = h$hs_plusWord64(h$ghc_unique_counter64.i3[1] >>> 0, h$ghc_unique_counter64.i3[0] >>> 0, 0, h$ghc_unique_inc.i3[0] >>> 0); + h$ret1 = (h$ret1 & HIGH_UNIQUE_MASK) >>> 0; + // h$ret1 contains the higher part (rh) + h$ghc_unique_counter64.i3[0] = rl | 0; + h$ghc_unique_counter64.i3[1] = h$ret1 | 0; + return rl; // h$ret1 still contains rh +} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2bd06da6eced0c0f4eb6135dbd2eee0061c88a04 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2bd06da6eced0c0f4eb6135dbd2eee0061c88a04 You're receiving 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 Jun 23 08:28:35 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 23 Jun 2023 04:28:35 -0400 Subject: [Git][ghc/ghc][wip/T22010] Move JS unique globals from RTS to compiler Message-ID: <649557b355ef3_3a0200139c59ec1424d4@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 4a4086ec by Jaro Reinders at 2023-06-23T10:28:29+02:00 Move JS unique globals from RTS to compiler - - - - - 2 changed files: - compiler/jsbits/genSym.js - rts/js/globals.js Changes: ===================================== compiler/jsbits/genSym.js ===================================== @@ -5,6 +5,17 @@ #define HIGH_UNIQUE_BITS (32 - UNIQUE_TAG_BITS) #define HIGH_UNIQUE_MASK ((1 << HIGH_UNIQUE_BITS) - 1) +// The 'ghc_unique_inc' and 'ghc_unique_counter64' are in the native RTS. It allows them to be +// shared with plugins even if two different instances of the GHC library are +// loaded at the same time (#19940) +// However, cross compilers do not support plugins so we have moved these globals back +// into the compiler. +var h$ghc_unique_inc = h$newByteArray(4); +h$ghc_unique_inc.i3[0] = 1; +var h$ghc_unique_counter64 = h$newByteArray(8); +h$ghc_unique_counter64.i3[0] = 0; +h$ghc_unique_counter64.i3[1] = 0; + function genSym() { var rl = h$hs_plusWord64(h$ghc_unique_counter64.i3[1] >>> 0, h$ghc_unique_counter64.i3[0] >>> 0, 0, h$ghc_unique_inc.i3[0] >>> 0); h$ret1 = (h$ret1 & HIGH_UNIQUE_MASK) >>> 0; ===================================== rts/js/globals.js ===================================== @@ -16,10 +16,4 @@ GVAR(h$getOrSetLibHSghcGlobalHasPprDebug, has_ppr_debug) GVAR(h$getOrSetLibHSghcGlobalHasNoDebugOutput, has_no_debug_output) GVAR(h$getOrSetLibHSghcGlobalHasNoStateHack, has_no_state_hack) -GVAR(h$getOrSetLibHSghcFastStringTable, faststring_table) - -var h$ghc_unique_inc = h$newByteArray(4); -h$ghc_unique_inc.i3[0] = 1; -var h$ghc_unique_counter64 = h$newByteArray(8); -h$ghc_unique_counter64.i3[0] = 0; -h$ghc_unique_counter64.i3[1] = 0; +GVAR(h$getOrSetLibHSghcFastStringTable, faststring_table) \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4a4086ecc16098551ab1cba5d14b80a71c632a3a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4a4086ecc16098551ab1cba5d14b80a71c632a3a You're receiving 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 Jun 23 08:39:14 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 23 Jun 2023 04:39:14 -0400 Subject: [Git][ghc/ghc][wip/T22010] Add h$ prefix to genSym Message-ID: <64955a328d5c_3a02001373045c1500c3@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 43c273d0 by Jaro Reinders at 2023-06-23T10:39:07+02:00 Add h$ prefix to genSym - - - - - 1 changed file: - compiler/jsbits/genSym.js Changes: ===================================== compiler/jsbits/genSym.js ===================================== @@ -16,7 +16,7 @@ var h$ghc_unique_counter64 = h$newByteArray(8); h$ghc_unique_counter64.i3[0] = 0; h$ghc_unique_counter64.i3[1] = 0; -function genSym() { +function h$genSym() { var rl = h$hs_plusWord64(h$ghc_unique_counter64.i3[1] >>> 0, h$ghc_unique_counter64.i3[0] >>> 0, 0, h$ghc_unique_inc.i3[0] >>> 0); h$ret1 = (h$ret1 & HIGH_UNIQUE_MASK) >>> 0; // h$ret1 contains the higher part (rh) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/43c273d0e4169a1f339d95c8564c75ac08b3ba3f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/43c273d0e4169a1f339d95c8564c75ac08b3ba3f You're receiving 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 Jun 23 09:20:01 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 23 Jun 2023 05:20:01 -0400 Subject: [Git][ghc/ghc][wip/T22010] Update documentation accounting for 64 bit uniques Message-ID: <649563c16759b_3a020013359f18161242@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 2dfe61bd by Jaro Reinders at 2023-06-23T11:19:50+02:00 Update documentation accounting for 64 bit uniques - - - - - 2 changed files: - compiler/GHC/Types/Unique.hs - compiler/GHC/Types/Unique/Supply.hs Changes: ===================================== compiler/GHC/Types/Unique.hs ===================================== @@ -72,9 +72,9 @@ import Language.Haskell.Syntax.Module.Name Note [Uniques and masks] ~~~~~~~~~~~~~~~~~~~~~~~~ -A `Unique` in GHC is a Word-sized value composed of two pieces: +A `Unique` in GHC is a 64 bit value composed of two pieces: * A "mask", of width `UNIQUE_TAG_BITS`, in the high order bits -* A number, of width `uNIQUE_BITS`, which fills up the remainder of the Word +* A number, of width `uNIQUE_BITS`, which fills up the remainder of the Word64 The mask is typically an ASCII character. It is typically used to make it easier to distinguish uniques constructed by different parts of the compiler. @@ -82,7 +82,7 @@ There is a (potentially incomplete) list of unique masks used given in GHC.Builtin.Uniques. See Note [Uniques for wired-in prelude things and known masks] `mkUnique` constructs a `Unique` from its pieces - mkUnique :: Char -> Int -> Unique + mkUnique :: Char -> Word64 -> Unique -} @@ -269,7 +269,7 @@ The alternatives are: 1) Use UniqFM or UniqDFM, see Note [Deterministic UniqFM] to decide which 2) Create a newtype wrapper based on Unique ordering where nondeterminism - is controlled. See Module.ModuleEnv + is controlled. See GHC.Unit.Module.Env.ModuleEnv 3) Change the algorithm to use nonDetCmpUnique and document why it's still deterministic 4) Use TrieMap as done in GHC.Cmm.CommonBlockElim.groupByLabel @@ -313,13 +313,12 @@ instance Show Unique where ************************************************************************ A character-stingy way to read/write numbers (notably Uniques). -The ``62-its'' are \tr{[0-9a-zA-Z]}. We don't handle negative Ints. +The ``62-its'' are \tr{[0-9a-zA-Z]}. Code stolen from Lennart. -} w64ToBase62 :: Word64 -> String -w64ToBase62 n_ - = assert (n_ >= 0) $ go n_ "" +w64ToBase62 n_ = go n_ "" where go n cs | n < 62 = let !c = chooseChar62 (fromIntegral n) in c : cs ===================================== compiler/GHC/Types/Unique/Supply.hs ===================================== @@ -69,17 +69,17 @@ import GHC.Exts( wordToWord64# ) The basic idea (due to Lennart Augustsson) is that a UniqSupply is lazily-evaluated infinite tree. -* At each MkSplitUniqSupply node is a unique Int, and two +* At each MkSplitUniqSupply node is a unique Word64, and two sub-trees (see data UniqSupply) * takeUniqFromSupply :: UniqSupply -> (Unique, UniqSupply) - returns the unique Int and one of the sub-trees + returns the unique Word64 and one of the sub-trees * splitUniqSupply :: UniqSupply -> (UniqSupply, UniqSupply) returns the two sub-trees * When you poke on one of the thunks, it does a foreign call - to get a fresh Int from a thread-safe counter, and returns + to get a fresh Word64 from a thread-safe counter, and returns a fresh MkSplitUniqSupply node. This has to be as efficient as possible: it should allocate only * The fresh node @@ -109,7 +109,7 @@ and thread it through the code, while in GHC.Core.Opt.Simplify.Monad we use the and `uniqFromMask` in getUniqueM. Ultimately all these boil down to each new unique consisting of the mask and the result from -a call to `genSym`. The later producing a distinct number for each invocation ensuring +a call to `genSym`. The latter producing a distinct number for each invocation ensuring uniques are distinct. Note [Optimising the unique supply] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2dfe61bd7dacfe302c68193512c49c1f22a1d500 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2dfe61bd7dacfe302c68193512c49c1f22a1d500 You're receiving 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 Jun 23 09:49:02 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Fri, 23 Jun 2023 05:49:02 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/romes/fixes-2 Message-ID: <64956a8e11cd9_3a020013730470167142@gitlab.mail> Rodrigo Mesquita pushed new branch wip/romes/fixes-2 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/fixes-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 Fri Jun 23 10:02:10 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 23 Jun 2023 06:02:10 -0400 Subject: [Git][ghc/ghc][wip/T22010] Fix type synonyms in Dominators.hs Message-ID: <64956da21a3a4_3a020014203190172978@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 82adadaa by Jaro Reinders at 2023-06-23T12:01:55+02:00 Fix type synonyms in Dominators.hs - - - - - 1 changed file: - compiler/GHC/CmmToAsm/CFG/Dominators.hs Changes: ===================================== compiler/GHC/CmmToAsm/CFG/Dominators.hs ===================================== @@ -21,8 +21,8 @@ /Advanced Compiler Design and Implementation/, 1997. \[3\] Brisk, Sarrafzadeh, - /Interference Graphs for Procedures in Static Single/ - /Information Form are Interval Graphs/, 2007. + /Interference CGraphs for Procedures in Static Single/ + /Information Form are Interval CGraphs/, 2007. * Strictness @@ -40,7 +40,7 @@ module GHC.CmmToAsm.CFG.Dominators ( ,pddfs,rpddfs ,fromAdj,fromEdges ,toAdj,toEdges - ,asTree,asGraph + ,asTree,asCGraph ,parents,ancestors ) where @@ -69,27 +69,31 @@ import Data.Word ----------------------------------------------------------------------------- -type Node = Int -type Path = [Node] -type Edge = (Node,Node) -type Graph = IntMap IntSet -type Rooted = (Word64, Word64Map Word64Set) +-- Compacted nodes; these can be stored in contiguous arrays +type CNode = Int +type CGraph = IntMap IntSet + +type Node = Word64 +type Path = [Node] +type Edge = (Node, Node) +type Graph = Word64Map Word64Set +type Rooted = (Node, Graph) ----------------------------------------------------------------------------- -- | /Dominators/. -- Complexity as for @idom@ -dom :: Rooted -> [(Word64, [Word64])] +dom :: Rooted -> [(Node, Path)] dom = ancestors . domTree -- | /Post-dominators/. -- Complexity as for @idom at . -pdom :: Rooted -> [(Word64, [Word64])] +pdom :: Rooted -> [(Node, Path)] pdom = ancestors . pdomTree -- | /Dominator tree/. -- Complexity as for @idom at . -domTree :: Rooted -> Tree Word64 +domTree :: Rooted -> Tree Node domTree a@(r,_) = let is = filter ((/=r).fst) (idom a) tg = fromEdges (fmap swap is) @@ -97,7 +101,7 @@ domTree a@(r,_) = -- | /Post-dominator tree/. -- Complexity as for @idom at . -pdomTree :: Rooted -> Tree Word64 +pdomTree :: Rooted -> Tree Node pdomTree a@(r,_) = let is = filter ((/=r).fst) (ipdom a) tg = fromEdges (fmap swap is) @@ -110,49 +114,50 @@ pdomTree a@(r,_) = -- This Complexity bound assumes /O(1)/ indexing. Since we're -- using @IntMap@, it has an additional /lg |V|/ factor -- somewhere in there. I'm not sure where. -idom :: Rooted -> [(Word64,Word64)] +idom :: Rooted -> [(Node,Node)] idom rg = runST (evalS idomM =<< initEnv (pruneReach rg)) -- | /Immediate post-dominators/. -- Complexity as for @idom at . -ipdom :: Rooted -> [(Word64,Word64)] +ipdom :: Rooted -> [(Node,Node)] ipdom rg = runST (evalS idomM =<< initEnv (pruneReach (second predGW rg))) ----------------------------------------------------------------------------- -- | /Post-dominated depth-first search/. -pddfs :: Rooted -> [Word64] +pddfs :: Rooted -> [Node] pddfs = reverse . rpddfs -- | /Reverse post-dominated depth-first search/. -rpddfs :: Rooted -> [Word64] +rpddfs :: Rooted -> [Node] rpddfs = concat . levels . pdomTree ----------------------------------------------------------------------------- type Dom s a = S s (Env s) a +type NodeSet = Word64Set type NodeMap a = Word64Map a data Env s = Env - {succE :: !Graph - ,predE :: !Graph - ,bucketE :: !Graph + {succE :: !CGraph + ,predE :: !CGraph + ,bucketE :: !CGraph ,dfsE :: {-# UNPACK #-}!Int - ,zeroE :: {-# UNPACK #-}!Node - ,rootE :: {-# UNPACK #-}!Node - ,labelE :: {-# UNPACK #-}!(Arr s Node) - ,parentE :: {-# UNPACK #-}!(Arr s Node) - ,ancestorE :: {-# UNPACK #-}!(Arr s Node) - ,childE :: {-# UNPACK #-}!(Arr s Node) - ,ndfsE :: {-# UNPACK #-}!(Arr s Node) + ,zeroE :: {-# UNPACK #-}!CNode + ,rootE :: {-# UNPACK #-}!CNode + ,labelE :: {-# UNPACK #-}!(Arr s CNode) + ,parentE :: {-# UNPACK #-}!(Arr s CNode) + ,ancestorE :: {-# UNPACK #-}!(Arr s CNode) + ,childE :: {-# UNPACK #-}!(Arr s CNode) + ,ndfsE :: {-# UNPACK #-}!(Arr s CNode) ,dfnE :: {-# UNPACK #-}!(Arr s Int) ,sdnoE :: {-# UNPACK #-}!(Arr s Int) ,sizeE :: {-# UNPACK #-}!(Arr s Int) - ,domE :: {-# UNPACK #-}!(Arr s Node) - ,rnE :: {-# UNPACK #-}!(Arr s Word64)} + ,domE :: {-# UNPACK #-}!(Arr s CNode) + ,rnE :: {-# UNPACK #-}!(Arr s Node)} ----------------------------------------------------------------------------- -idomM :: Dom s [(Word64,Word64)] +idomM :: Dom s [(Node,Node)] idomM = do dfsDom =<< rootM n <- gets dfsE @@ -192,7 +197,7 @@ idomM = do ----------------------------------------------------------------------------- -eval :: Node -> Dom s Node +eval :: CNode -> Dom s CNode eval v = do n0 <- zeroM a <- ancestorM v @@ -209,7 +214,7 @@ eval v = do True-> return l False-> return la -compress :: Node -> Dom s () +compress :: CNode -> Dom s () compress v = do n0 <- zeroM a <- ancestorM v @@ -228,7 +233,7 @@ compress v = do ----------------------------------------------------------------------------- -link :: Node -> Node -> Dom s () +link :: CNode -> CNode -> Dom s () link v w = do n0 <- zeroM lw <- labelM w @@ -272,7 +277,7 @@ link v w = do ----------------------------------------------------------------------------- -dfsDom :: Node -> Dom s () +dfsDom :: CNode -> Dom s () dfsDom i = do _ <- go i n0 <- zeroM @@ -297,7 +302,7 @@ dfsDom i = do initEnv :: Rooted -> ST s (Env s) initEnv (r0,g0) = do - -- Graph renumbered to indices from 1 to |V| + -- CGraph renumbered to indices from 1 to |V| let (g,rnmap) = renum 1 g0 pred = predG g -- reverse graph root = rnmap WM.! r0 -- renamed root @@ -351,7 +356,7 @@ initEnv (r0,g0) = do ,bucketE = bucket ,domE = doms}) -fromEnv :: Dom s [(Word64,Word64)] +fromEnv :: Dom s [(Node,Node)] fromEnv = do dom <- gets domE rn <- gets rnE @@ -365,33 +370,33 @@ fromEnv = do ----------------------------------------------------------------------------- -zeroM :: Dom s Node +zeroM :: Dom s CNode zeroM = gets zeroE -domM :: Node -> Dom s Node +domM :: CNode -> Dom s CNode domM = fetch domE -rootM :: Dom s Node +rootM :: Dom s CNode rootM = gets rootE -succsM :: Node -> Dom s [Node] +succsM :: CNode -> Dom s [CNode] succsM i = gets (IS.toList . (! i) . succE) -predsM :: Node -> Dom s [Node] +predsM :: CNode -> Dom s [CNode] predsM i = gets (IS.toList . (! i) . predE) -bucketM :: Node -> Dom s [Node] +bucketM :: CNode -> Dom s [CNode] bucketM i = gets (IS.toList . (! i) . bucketE) -sizeM :: Node -> Dom s Int +sizeM :: CNode -> Dom s Int sizeM = fetch sizeE -sdnoM :: Node -> Dom s Int +sdnoM :: CNode -> Dom s Int sdnoM = fetch sdnoE --- dfnM :: Node -> Dom s Int +-- dfnM :: CNode -> Dom s Int -- dfnM = fetch dfnE -ndfsM :: Int -> Dom s Node +ndfsM :: Int -> Dom s CNode ndfsM = fetch ndfsE -childM :: Node -> Dom s Node +childM :: CNode -> Dom s CNode childM = fetch childE -ancestorM :: Node -> Dom s Node +ancestorM :: CNode -> Dom s CNode ancestorM = fetch ancestorE -parentM :: Node -> Dom s Node +parentM :: CNode -> Dom s CNode parentM = fetch parentE -labelM :: Node -> Dom s Node +labelM :: CNode -> Dom s CNode labelM = fetch labelE nextM :: Dom s Int nextM = do @@ -426,7 +431,7 @@ new n = unsafeNewArray_ (0,n-1) newI :: Int -> ST s (Arr s Int) newI = new -newW :: Int -> ST s (Arr s Word64) +newW :: Int -> ST s (Arr s Node) newW = new writes :: (MArray (A s) a (ST s)) @@ -437,19 +442,19 @@ writes a xs = forM_ xs (\(i,x) -> (a.=x) i) (!) :: Monoid a => IntMap a -> Int -> a (!) g n = maybe mempty id (IM.lookup n g) -fromAdj :: [(Word64, [Word64])] -> Word64Map Word64Set +fromAdj :: [(Node, [Node])] -> Graph fromAdj = WM.fromList . fmap (second WS.fromList) -fromEdges :: [(Word64,Word64)] -> Word64Map Word64Set +fromEdges :: [(Node,Node)] -> Graph fromEdges = collectW WS.union fst (WS.singleton . snd) toAdj :: Graph -> [(Node, [Node])] -toAdj = fmap (second IS.toList) . IM.toList +toAdj = fmap (second WS.toList) . WM.toList toEdges :: Graph -> [Edge] toEdges = concatMap (uncurry (fmap . (,))) . toAdj -predG :: Graph -> Graph +predG :: CGraph -> CGraph predG g = IM.unionWith IS.union (go g) g0 where g0 = fmap (const mempty) g go = flip IM.foldrWithKey mempty (\i a m -> @@ -458,7 +463,7 @@ predG g = IM.unionWith IS.union (go g) g0 m (IS.toList a)) -predGW :: Word64Map Word64Set -> Word64Map Word64Set +predGW :: Graph -> Graph predGW g = WM.unionWith WS.union (go g) g0 where g0 = fmap (const mempty) g go = flip WM.foldrWithKey mempty (\i a m -> @@ -492,26 +497,26 @@ ancestors = go [] in p acc' xs ++ concatMap (go acc') xs p is = fmap (flip (,) is . rootLabel) -asGraph :: Tree Word64 -> Rooted -asGraph t@(Node a _) = let g = go t in (a, fromAdj g) +asCGraph :: Tree Node -> Rooted +asCGraph t@(Node a _) = let g = go t in (a, fromAdj g) where go (Node a ts) = let as = (fst . unzip . fmap tip) ts in (a, as) : concatMap go ts -asTree :: Rooted -> Tree Word64 +asTree :: Rooted -> Tree Node asTree (r,g) = let go a = Node a (fmap go ((WS.toList . f) a)) f = (g !) in go r where (!) g n = maybe mempty id (WM.lookup n g) -reachable :: (Word64 -> Word64Set) -> (Word64 -> Word64Set) +reachable :: (Node -> NodeSet) -> (Node -> NodeSet) reachable f a = go (WS.singleton a) a where go seen a = let s = f a as = WS.toList (s `WS.difference` seen) in foldl' go (s `WS.union` seen) as collectW :: (c -> c -> c) - -> (a -> Word64) -> (a -> c) -> [a] -> Word64Map c + -> (a -> Node) -> (a -> c) -> [a] -> Word64Map c collectW (<>) f g = foldl' (\m a -> WM.insertWith (<>) (f a) @@ -522,7 +527,7 @@ collectW (<>) f g -- Gives nodes sequential names starting at n. -- Returns the new graph and a mapping. -- (renamed, old -> new) -renum :: Node -> Word64Map Word64Set -> (Graph, NodeMap Node) +renum :: Int -> Graph -> (CGraph, NodeMap CNode) renum from = (\(_,m,g)->(g,m)) . WM.foldrWithKey (\i ss (!n,!env,!new)-> @@ -535,9 +540,9 @@ renum from = (\(_,m,g)->(g,m)) new2 = IM.insertWith IS.union j ss2 new in (n3,env3,new2)) (from,mempty,mempty) where go :: Int - -> NodeMap Node - -> Word64 - -> (Node,Int,NodeMap Node) + -> NodeMap CNode + -> Node + -> (CNode,Int,NodeMap CNode) go !n !env i = case WM.lookup i env of Just j -> (j,n,env) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/82adadaaa03fdcbb3bfb8f281f47573c2741790d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/82adadaaa03fdcbb3bfb8f281f47573c2741790d You're receiving 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 Jun 23 10:06:51 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 23 Jun 2023 06:06:51 -0400 Subject: [Git][ghc/ghc][wip/T22010] Fix js-sources Message-ID: <64956ebb7a762_3a020013359f1817511d@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 076fc72a by Jaro Reinders at 2023-06-23T12:06:45+02:00 Fix js-sources - - - - - 1 changed file: - compiler/ghc.cabal.in Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -156,13 +156,14 @@ Library -- as it's magic. GHC-Options: -this-unit-id ghc - c-sources: + if arch(javascript) + js-sources: + jsbits/genSym.js + else + c-sources: cbits/cutils.c cbits/genSym.c cbits/keepCAFsForGHCi.c - - js-sources: - jsbits/genSym.js hs-source-dirs: . View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/076fc72a1a3dae9d6eb7710dc1186f3c4c101e82 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/076fc72a1a3dae9d6eb7710dc1186f3c4c101e82 You're receiving 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 Jun 23 10:19:20 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 23 Jun 2023 06:19:20 -0400 Subject: [Git][ghc/ghc][wip/T22010] Remove unused import Message-ID: <649571a8370cc_3a020013b9f92017732f@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 46a39f58 by Jaro Reinders at 2023-06-23T12:19:09+02:00 Remove unused import - - - - - 1 changed file: - compiler/GHC/Types/Unique.hs Changes: ===================================== compiler/GHC/Types/Unique.hs ===================================== @@ -53,7 +53,6 @@ import GHC.Prelude import GHC.Data.FastString import GHC.Utils.Outputable -import GHC.Utils.Panic.Plain -- just for implementing a fast [0,61) -> Char function import GHC.Exts (indexCharOffAddr#, Char(..), Int(..)) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/46a39f58b745bf8cebc47721c71a718125ce00f5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/46a39f58b745bf8cebc47721c71a718125ce00f5 You're receiving 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 Jun 23 12:18:10 2023 From: gitlab at gitlab.haskell.org (Torsten Schmits (@torsten.schmits)) Date: Fri, 23 Jun 2023 08:18:10 -0400 Subject: [Git][ghc/ghc][wip/torsten.schmits/16468] Relax defaulting of RuntimeRep/Levity when printing Message-ID: <64958d82ce42a_3a020013eae15c19873@gitlab.mail> Torsten Schmits pushed to branch wip/torsten.schmits/16468 at Glasgow Haskell Compiler / GHC Commits: 8107180c by Torsten Schmits at 2023-06-23T14:18:03+02:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 5 changed files: - compiler/GHC/Iface/Type.hs - compiler/GHC/Types/Unique/DFM.hs - + testsuite/tests/ghci/scripts/T16468.script - + testsuite/tests/ghci/scripts/T16468.stdout - testsuite/tests/ghci/scripts/all.T Changes: ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -987,7 +987,7 @@ ppr_ty ctxt_prec ty@(IfaceFunTy af w ty1 ty2) -- Should be a visible argument | isVisibleFunArg af = (pprTypeArrow af wthis <+> ppr_ty funPrec ty1) : ppr_fun_tail wnext ty2 ppr_fun_tail wthis other_ty - = [pprTypeArrow af wthis <+> pprIfaceType other_ty] + = [pprTypeArrow af wthis <+> ppr_ty topPrec other_ty] ppr_ty ctxt_prec (IfaceAppTy t ts) = if_print_coercions @@ -1044,9 +1044,11 @@ Haskell programs, so it makes little sense to make all users pay this syntactic overhead. For this reason it was decided that we would hide RuntimeRep variables -for now (see #11549). We do this by defaulting all type variables of -kind RuntimeRep to LiftedRep. -Likewise, we default all Multiplicity variables to Many. +for now (see #11549). We do this right in the pretty-printer, by pre-processing +the type we are about to print, to default any type variables of kind RuntimeRep +that are bound by toplevel invisible quantification to LiftedRep. +Likewise, we default Multiplicity variables to Many and Levity variables to +Lifted. This is done in a pass right before pretty-printing (defaultIfaceTyVarsOfKind, controlled by @@ -1073,6 +1075,22 @@ metavariables are converted, skolem variables are not. There's one exception though: TyVarTv metavariables should not be defaulted, as they appear during kind-checking of "newtype T :: TYPE r where..." (test T18357a). Therefore, we additionally test for isTyConableTyVar. + +Wrinkles: + +(W1) The loop 'go' in 'defaultIfaceTyVarsOfKind' passes a Bool flag, 'rank1', + around that indicates whether we haven't yet descended into the arguments + of a function type. + This is used to decide whether newly bound variables are eligible for + defaulting – we do not want contravariant foralls to be defaulted because + that would result in an incorrect, rather than specialized, type. + For example: + ∀ p (r :: RuntimeRep) . (∀ (r' :: RuntimeRep) . Int -> p r') -> p r + We want to default @r@, but not @r'@. + When examining the first forall, 'rank1' is True. + The toplevel function type is matched as IfaceFunTy, where we recurse into + 'go' by passing False for 'rank1'. + The forall in the first argument then skips adding a substitution for 'r''. -} -- | Default 'RuntimeRep' variables to 'LiftedRep', @@ -1097,28 +1115,29 @@ as they appear during kind-checking of "newtype T :: TYPE r where..." defaultIfaceTyVarsOfKind :: Bool -- ^ default 'RuntimeRep'/'Levity' variables? -> Bool -- ^ default 'Multiplicity' variables? -> IfaceType -> IfaceType -defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv ty +defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv True ty where go :: FastStringEnv IfaceType -- Set of enclosing forall-ed RuntimeRep/Levity/Multiplicity variables + -> Bool -- Are we in a toplevel forall, where defaulting is allowed for RR/L? -> IfaceType -> IfaceType - go subs (IfaceForAllTy (Bndr (IfaceTvBndr (var, var_kind)) argf) ty) + go subs rank1 (IfaceForAllTy (Bndr (IfaceTvBndr (var, var_kind)) argf) ty) | isInvisibleForAllTyFlag argf -- Don't default *visible* quantification -- or we get the mess in #13963 - , Just substituted_ty <- check_substitution var_kind + , Just substituted_ty <- check_substitution rank1 var_kind = let subs' = extendFsEnv subs var substituted_ty -- Record that we should replace it with LiftedRep/Lifted/Many, -- and recurse, discarding the forall - in go subs' ty + in go subs' rank1 ty - go subs (IfaceForAllTy bndr ty) - = IfaceForAllTy (go_ifacebndr subs bndr) (go subs ty) + go subs rank1 (IfaceForAllTy bndr ty) + = IfaceForAllTy (go_ifacebndr subs rank1 bndr) (go subs rank1 ty) - go subs ty@(IfaceTyVar tv) = case lookupFsEnv subs tv of + go subs _ ty@(IfaceTyVar tv) = case lookupFsEnv subs tv of Just s -> s Nothing -> ty - go _ ty@(IfaceFreeTyVar tv) + go _ _ ty@(IfaceFreeTyVar tv) -- See Note [Defaulting RuntimeRep variables], about free vars | def_rep , GHC.Core.Type.isRuntimeRepTy (tyVarKind tv) @@ -1138,47 +1157,49 @@ defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv ty | otherwise = ty - go subs (IfaceTyConApp tc tc_args) - = IfaceTyConApp tc (go_args subs tc_args) + go subs rank1 (IfaceTyConApp tc tc_args) + = IfaceTyConApp tc (go_args subs rank1 tc_args) - go subs (IfaceTupleTy sort is_prom tc_args) - = IfaceTupleTy sort is_prom (go_args subs tc_args) + go subs rank1 (IfaceTupleTy sort is_prom tc_args) + = IfaceTupleTy sort is_prom (go_args subs rank1 tc_args) - go subs (IfaceFunTy af w arg res) - = IfaceFunTy af (go subs w) (go subs arg) (go subs res) + go subs rank1 (IfaceFunTy af w arg res) + = IfaceFunTy af (go subs rank1 w) (go subs False arg) (go subs False res) - go subs (IfaceAppTy t ts) - = IfaceAppTy (go subs t) (go_args subs ts) + go subs rank1 (IfaceAppTy t ts) + = IfaceAppTy (go subs rank1 t) (go_args subs rank1 ts) - go subs (IfaceCastTy x co) - = IfaceCastTy (go subs x) co + go subs rank1 (IfaceCastTy x co) + = IfaceCastTy (go subs rank1 x) co - go _ ty@(IfaceLitTy {}) = ty - go _ ty@(IfaceCoercionTy {}) = ty + go _ _ ty@(IfaceLitTy {}) = ty + go _ _ ty@(IfaceCoercionTy {}) = ty - go_ifacebndr :: FastStringEnv IfaceType -> IfaceForAllBndr -> IfaceForAllBndr - go_ifacebndr subs (Bndr (IfaceIdBndr (w, n, t)) argf) - = Bndr (IfaceIdBndr (w, n, go subs t)) argf - go_ifacebndr subs (Bndr (IfaceTvBndr (n, t)) argf) - = Bndr (IfaceTvBndr (n, go subs t)) argf + go_ifacebndr :: FastStringEnv IfaceType -> Bool -> IfaceForAllBndr -> IfaceForAllBndr + go_ifacebndr subs rank1 (Bndr (IfaceIdBndr (w, n, t)) argf) + = Bndr (IfaceIdBndr (w, n, go subs rank1 t)) argf + go_ifacebndr subs rank1 (Bndr (IfaceTvBndr (n, t)) argf) + = Bndr (IfaceTvBndr (n, go subs rank1 t)) argf - go_args :: FastStringEnv IfaceType -> IfaceAppArgs -> IfaceAppArgs - go_args _ IA_Nil = IA_Nil - go_args subs (IA_Arg ty argf args) - = IA_Arg (go subs ty) argf (go_args subs args) + go_args :: FastStringEnv IfaceType -> Bool -> IfaceAppArgs -> IfaceAppArgs + go_args _ _ IA_Nil = IA_Nil + go_args subs rank1 (IA_Arg ty argf args) + = IA_Arg (go subs rank1 ty) argf (go_args subs rank1 args) - check_substitution :: IfaceType -> Maybe IfaceType - check_substitution (IfaceTyConApp tc _) + check_substitution :: Bool -> IfaceType -> Maybe IfaceType + check_substitution rank1 (IfaceTyConApp tc _) | def_rep , tc `ifaceTyConHasKey` runtimeRepTyConKey + , rank1 = Just liftedRep_ty | def_rep , tc `ifaceTyConHasKey` levityTyConKey + , rank1 = Just lifted_ty | def_mult , tc `ifaceTyConHasKey` multiplicityTyConKey = Just many_ty - check_substitution _ = Nothing + check_substitution _ _ = Nothing -- | The type ('BoxedRep 'Lifted), also known as LiftedRep. liftedRep_ty :: IfaceType @@ -1367,7 +1388,7 @@ ppr_sigma show_forall ctxt_prec iface_ty -- Then it could handle both invisible and required binders, and -- splitIfaceReqForallTy wouldn't be necessary here. in ppr_iface_forall_part show_forall invis_tvs theta $ - sep [pprIfaceForAll req_tvs, ppr tau'] + sep [pprIfaceForAll req_tvs, ppr_ty topPrec tau'] pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc pprUserIfaceForAll tvs ===================================== compiler/GHC/Types/Unique/DFM.hs ===================================== @@ -94,7 +94,7 @@ import qualified Data.IntSet as I -- order then `udfmToList` returns them in deterministic order. -- -- There is an implementation cost: each element is given a serial number --- as it is added, and `udfmToList` sorts it's result by this serial +-- as it is added, and `udfmToList` sorts its result by this serial -- number. So you should only use `UniqDFM` if you need the deterministic -- property. -- ===================================== testsuite/tests/ghci/scripts/T16468.script ===================================== @@ -0,0 +1,27 @@ +import GHC.Types (RuntimeRep (..), Levity (..), TYPE) +import Data.Proxy + +f :: forall p (r' :: RuntimeRep). (forall (r :: RuntimeRep). Int -> p r) -> p r'; f x = x 5 +g :: forall p. Int -> forall (r :: RuntimeRep). p r; g _ = undefined +g' :: Int -> forall p (r :: RuntimeRep). p r; g' _ = undefined +h :: Int -> forall (r :: RuntimeRep). TYPE r; h _ = undefined +i :: forall (r :: RuntimeRep). Int -> TYPE r; i _ = undefined +j :: forall p. Eq (p ('BoxedRep 'Lifted)) => Int -> forall (r :: RuntimeRep). p r; j _ = undefined +k :: forall p (r' :: RuntimeRep). Eq (p r') => (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) -> p r'; k x = x 5 + +:type f +:type g +:type g' +:type h +:type i +:type j +:type k + +:set -fprint-explicit-runtime-reps +:type f +:type g +:type g' +:type h +:type i +:type j +:type k ===================================== testsuite/tests/ghci/scripts/T16468.stdout ===================================== @@ -0,0 +1,20 @@ +f :: (forall (r :: RuntimeRep). Int -> p r) + -> p GHC.Types.LiftedRep +g :: Int -> forall (r :: RuntimeRep). p r +g' :: Int -> forall (p :: RuntimeRep -> *) (r :: RuntimeRep). p r +h :: Int -> forall (r :: RuntimeRep). TYPE r +i :: Int -> * +j :: Eq (p GHC.Types.LiftedRep) => + Int -> forall (r :: RuntimeRep). p r +k :: Eq (p GHC.Types.LiftedRep) => + (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) + -> p GHC.Types.LiftedRep +f :: (forall (r :: RuntimeRep). Int -> p r) -> p r' +g :: Int -> forall (r :: RuntimeRep). p r +g' :: Int -> forall (p :: RuntimeRep -> *) (r :: RuntimeRep). p r +h :: Int -> forall (r :: RuntimeRep). TYPE r +i :: Int -> TYPE r +j :: Eq (p GHC.Types.LiftedRep) => + Int -> forall (r :: RuntimeRep). p r +k :: Eq (p r') => + (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) -> p r' ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -375,3 +375,4 @@ test('T22695', normal, ghci_script, ['T22695.script']) test('T22817', normal, ghci_script, ['T22817.script']) test('T22908', normal, ghci_script, ['T22908.script']) test('T23062', normal, ghci_script, ['T23062.script']) +test('T16468', normal, ghci_script, ['T16468.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8107180cbba3a84f6c3654a27b77365e7397a6e7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8107180cbba3a84f6c3654a27b77365e7397a6e7 You're receiving 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 Jun 23 12:22:37 2023 From: gitlab at gitlab.haskell.org (Torsten Schmits (@torsten.schmits)) Date: Fri, 23 Jun 2023 08:22:37 -0400 Subject: [Git][ghc/ghc][wip/torsten.schmits/16468] Relax defaulting of RuntimeRep/Levity when printing Message-ID: <64958e8db85a7_3a020013b9f920209017@gitlab.mail> Torsten Schmits pushed to branch wip/torsten.schmits/16468 at Glasgow Haskell Compiler / GHC Commits: a9bab5b3 by Torsten Schmits at 2023-06-23T14:22:30+02:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 5 changed files: - compiler/GHC/Iface/Type.hs - compiler/GHC/Types/Unique/DFM.hs - + testsuite/tests/ghci/scripts/T16468.script - + testsuite/tests/ghci/scripts/T16468.stdout - testsuite/tests/ghci/scripts/all.T Changes: ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -987,7 +987,7 @@ ppr_ty ctxt_prec ty@(IfaceFunTy af w ty1 ty2) -- Should be a visible argument | isVisibleFunArg af = (pprTypeArrow af wthis <+> ppr_ty funPrec ty1) : ppr_fun_tail wnext ty2 ppr_fun_tail wthis other_ty - = [pprTypeArrow af wthis <+> pprIfaceType other_ty] + = [pprTypeArrow af wthis <+> ppr_ty topPrec other_ty] ppr_ty ctxt_prec (IfaceAppTy t ts) = if_print_coercions @@ -1044,9 +1044,11 @@ Haskell programs, so it makes little sense to make all users pay this syntactic overhead. For this reason it was decided that we would hide RuntimeRep variables -for now (see #11549). We do this by defaulting all type variables of -kind RuntimeRep to LiftedRep. -Likewise, we default all Multiplicity variables to Many. +for now (see #11549). We do this right in the pretty-printer, by pre-processing +the type we are about to print, to default any type variables of kind RuntimeRep +that are bound by toplevel invisible quantification to LiftedRep. +Likewise, we default Multiplicity variables to Many and Levity variables to +Lifted. This is done in a pass right before pretty-printing (defaultIfaceTyVarsOfKind, controlled by @@ -1073,6 +1075,22 @@ metavariables are converted, skolem variables are not. There's one exception though: TyVarTv metavariables should not be defaulted, as they appear during kind-checking of "newtype T :: TYPE r where..." (test T18357a). Therefore, we additionally test for isTyConableTyVar. + +Wrinkles: + +(W1) The loop 'go' in 'defaultIfaceTyVarsOfKind' passes a Bool flag, 'rank1', + around that indicates whether we haven't yet descended into the arguments + of a function type. + This is used to decide whether newly bound variables are eligible for + defaulting – we do not want contravariant foralls to be defaulted because + that would result in an incorrect, rather than specialized, type. + For example: + ∀ p (r :: RuntimeRep) . (∀ (r' :: RuntimeRep) . p r') -> p r + We want to default @r@, but not @r'@. + When examining the first forall, 'rank1' is True. + The toplevel function type is matched as IfaceFunTy, where we recurse into + 'go' by passing False for 'rank1'. + The forall in the first argument then skips adding a substitution for 'r''. -} -- | Default 'RuntimeRep' variables to 'LiftedRep', @@ -1097,28 +1115,29 @@ as they appear during kind-checking of "newtype T :: TYPE r where..." defaultIfaceTyVarsOfKind :: Bool -- ^ default 'RuntimeRep'/'Levity' variables? -> Bool -- ^ default 'Multiplicity' variables? -> IfaceType -> IfaceType -defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv ty +defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv True ty where go :: FastStringEnv IfaceType -- Set of enclosing forall-ed RuntimeRep/Levity/Multiplicity variables + -> Bool -- Are we in a toplevel forall, where defaulting is allowed for RR/L? -> IfaceType -> IfaceType - go subs (IfaceForAllTy (Bndr (IfaceTvBndr (var, var_kind)) argf) ty) + go subs rank1 (IfaceForAllTy (Bndr (IfaceTvBndr (var, var_kind)) argf) ty) | isInvisibleForAllTyFlag argf -- Don't default *visible* quantification -- or we get the mess in #13963 - , Just substituted_ty <- check_substitution var_kind + , Just substituted_ty <- check_substitution rank1 var_kind = let subs' = extendFsEnv subs var substituted_ty -- Record that we should replace it with LiftedRep/Lifted/Many, -- and recurse, discarding the forall - in go subs' ty + in go subs' rank1 ty - go subs (IfaceForAllTy bndr ty) - = IfaceForAllTy (go_ifacebndr subs bndr) (go subs ty) + go subs rank1 (IfaceForAllTy bndr ty) + = IfaceForAllTy (go_ifacebndr subs rank1 bndr) (go subs rank1 ty) - go subs ty@(IfaceTyVar tv) = case lookupFsEnv subs tv of + go subs _ ty@(IfaceTyVar tv) = case lookupFsEnv subs tv of Just s -> s Nothing -> ty - go _ ty@(IfaceFreeTyVar tv) + go _ _ ty@(IfaceFreeTyVar tv) -- See Note [Defaulting RuntimeRep variables], about free vars | def_rep , GHC.Core.Type.isRuntimeRepTy (tyVarKind tv) @@ -1138,47 +1157,49 @@ defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv ty | otherwise = ty - go subs (IfaceTyConApp tc tc_args) - = IfaceTyConApp tc (go_args subs tc_args) + go subs rank1 (IfaceTyConApp tc tc_args) + = IfaceTyConApp tc (go_args subs rank1 tc_args) - go subs (IfaceTupleTy sort is_prom tc_args) - = IfaceTupleTy sort is_prom (go_args subs tc_args) + go subs rank1 (IfaceTupleTy sort is_prom tc_args) + = IfaceTupleTy sort is_prom (go_args subs rank1 tc_args) - go subs (IfaceFunTy af w arg res) - = IfaceFunTy af (go subs w) (go subs arg) (go subs res) + go subs rank1 (IfaceFunTy af w arg res) + = IfaceFunTy af (go subs rank1 w) (go subs False arg) (go subs False res) - go subs (IfaceAppTy t ts) - = IfaceAppTy (go subs t) (go_args subs ts) + go subs rank1 (IfaceAppTy t ts) + = IfaceAppTy (go subs rank1 t) (go_args subs rank1 ts) - go subs (IfaceCastTy x co) - = IfaceCastTy (go subs x) co + go subs rank1 (IfaceCastTy x co) + = IfaceCastTy (go subs rank1 x) co - go _ ty@(IfaceLitTy {}) = ty - go _ ty@(IfaceCoercionTy {}) = ty + go _ _ ty@(IfaceLitTy {}) = ty + go _ _ ty@(IfaceCoercionTy {}) = ty - go_ifacebndr :: FastStringEnv IfaceType -> IfaceForAllBndr -> IfaceForAllBndr - go_ifacebndr subs (Bndr (IfaceIdBndr (w, n, t)) argf) - = Bndr (IfaceIdBndr (w, n, go subs t)) argf - go_ifacebndr subs (Bndr (IfaceTvBndr (n, t)) argf) - = Bndr (IfaceTvBndr (n, go subs t)) argf + go_ifacebndr :: FastStringEnv IfaceType -> Bool -> IfaceForAllBndr -> IfaceForAllBndr + go_ifacebndr subs rank1 (Bndr (IfaceIdBndr (w, n, t)) argf) + = Bndr (IfaceIdBndr (w, n, go subs rank1 t)) argf + go_ifacebndr subs rank1 (Bndr (IfaceTvBndr (n, t)) argf) + = Bndr (IfaceTvBndr (n, go subs rank1 t)) argf - go_args :: FastStringEnv IfaceType -> IfaceAppArgs -> IfaceAppArgs - go_args _ IA_Nil = IA_Nil - go_args subs (IA_Arg ty argf args) - = IA_Arg (go subs ty) argf (go_args subs args) + go_args :: FastStringEnv IfaceType -> Bool -> IfaceAppArgs -> IfaceAppArgs + go_args _ _ IA_Nil = IA_Nil + go_args subs rank1 (IA_Arg ty argf args) + = IA_Arg (go subs rank1 ty) argf (go_args subs rank1 args) - check_substitution :: IfaceType -> Maybe IfaceType - check_substitution (IfaceTyConApp tc _) + check_substitution :: Bool -> IfaceType -> Maybe IfaceType + check_substitution rank1 (IfaceTyConApp tc _) | def_rep , tc `ifaceTyConHasKey` runtimeRepTyConKey + , rank1 = Just liftedRep_ty | def_rep , tc `ifaceTyConHasKey` levityTyConKey + , rank1 = Just lifted_ty | def_mult , tc `ifaceTyConHasKey` multiplicityTyConKey = Just many_ty - check_substitution _ = Nothing + check_substitution _ _ = Nothing -- | The type ('BoxedRep 'Lifted), also known as LiftedRep. liftedRep_ty :: IfaceType @@ -1367,7 +1388,7 @@ ppr_sigma show_forall ctxt_prec iface_ty -- Then it could handle both invisible and required binders, and -- splitIfaceReqForallTy wouldn't be necessary here. in ppr_iface_forall_part show_forall invis_tvs theta $ - sep [pprIfaceForAll req_tvs, ppr tau'] + sep [pprIfaceForAll req_tvs, ppr_ty topPrec tau'] pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc pprUserIfaceForAll tvs ===================================== compiler/GHC/Types/Unique/DFM.hs ===================================== @@ -94,7 +94,7 @@ import qualified Data.IntSet as I -- order then `udfmToList` returns them in deterministic order. -- -- There is an implementation cost: each element is given a serial number --- as it is added, and `udfmToList` sorts it's result by this serial +-- as it is added, and `udfmToList` sorts its result by this serial -- number. So you should only use `UniqDFM` if you need the deterministic -- property. -- ===================================== testsuite/tests/ghci/scripts/T16468.script ===================================== @@ -0,0 +1,27 @@ +import GHC.Types (RuntimeRep (..), Levity (..), TYPE) +import Data.Proxy + +f :: forall p (r' :: RuntimeRep). (forall (r :: RuntimeRep). Int -> p r) -> p r'; f x = x 5 +g :: forall p. Int -> forall (r :: RuntimeRep). p r; g _ = undefined +g' :: Int -> forall p (r :: RuntimeRep). p r; g' _ = undefined +h :: Int -> forall (r :: RuntimeRep). TYPE r; h _ = undefined +i :: forall (r :: RuntimeRep). Int -> TYPE r; i _ = undefined +j :: forall p. Eq (p ('BoxedRep 'Lifted)) => Int -> forall (r :: RuntimeRep). p r; j _ = undefined +k :: forall p (r' :: RuntimeRep). Eq (p r') => (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) -> p r'; k x = x 5 + +:type f +:type g +:type g' +:type h +:type i +:type j +:type k + +:set -fprint-explicit-runtime-reps +:type f +:type g +:type g' +:type h +:type i +:type j +:type k ===================================== testsuite/tests/ghci/scripts/T16468.stdout ===================================== @@ -0,0 +1,20 @@ +f :: (forall (r :: RuntimeRep). Int -> p r) + -> p GHC.Types.LiftedRep +g :: Int -> forall (r :: RuntimeRep). p r +g' :: Int -> forall (p :: RuntimeRep -> *) (r :: RuntimeRep). p r +h :: Int -> forall (r :: RuntimeRep). TYPE r +i :: Int -> * +j :: Eq (p GHC.Types.LiftedRep) => + Int -> forall (r :: RuntimeRep). p r +k :: Eq (p GHC.Types.LiftedRep) => + (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) + -> p GHC.Types.LiftedRep +f :: (forall (r :: RuntimeRep). Int -> p r) -> p r' +g :: Int -> forall (r :: RuntimeRep). p r +g' :: Int -> forall (p :: RuntimeRep -> *) (r :: RuntimeRep). p r +h :: Int -> forall (r :: RuntimeRep). TYPE r +i :: Int -> TYPE r +j :: Eq (p GHC.Types.LiftedRep) => + Int -> forall (r :: RuntimeRep). p r +k :: Eq (p r') => + (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) -> p r' ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -375,3 +375,4 @@ test('T22695', normal, ghci_script, ['T22695.script']) test('T22817', normal, ghci_script, ['T22817.script']) test('T22908', normal, ghci_script, ['T22908.script']) test('T23062', normal, ghci_script, ['T23062.script']) +test('T16468', normal, ghci_script, ['T16468.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a9bab5b3d4c8dc041502d47e54dfe40f928c021c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a9bab5b3d4c8dc041502d47e54dfe40f928c021c You're receiving 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 Jun 23 12:25:39 2023 From: gitlab at gitlab.haskell.org (Torsten Schmits (@torsten.schmits)) Date: Fri, 23 Jun 2023 08:25:39 -0400 Subject: [Git][ghc/ghc][wip/torsten.schmits/16468] Relax defaulting of RuntimeRep/Levity when printing Message-ID: <64958f43e41f5_3a02001373045c20941@gitlab.mail> Torsten Schmits pushed to branch wip/torsten.schmits/16468 at Glasgow Haskell Compiler / GHC Commits: a80e0a68 by Torsten Schmits at 2023-06-23T14:25:30+02:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 5 changed files: - compiler/GHC/Iface/Type.hs - compiler/GHC/Types/Unique/DFM.hs - + testsuite/tests/ghci/scripts/T16468.script - + testsuite/tests/ghci/scripts/T16468.stdout - testsuite/tests/ghci/scripts/all.T Changes: ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -987,7 +987,7 @@ ppr_ty ctxt_prec ty@(IfaceFunTy af w ty1 ty2) -- Should be a visible argument | isVisibleFunArg af = (pprTypeArrow af wthis <+> ppr_ty funPrec ty1) : ppr_fun_tail wnext ty2 ppr_fun_tail wthis other_ty - = [pprTypeArrow af wthis <+> pprIfaceType other_ty] + = [pprTypeArrow af wthis <+> ppr_ty topPrec other_ty] ppr_ty ctxt_prec (IfaceAppTy t ts) = if_print_coercions @@ -1044,9 +1044,11 @@ Haskell programs, so it makes little sense to make all users pay this syntactic overhead. For this reason it was decided that we would hide RuntimeRep variables -for now (see #11549). We do this by defaulting all type variables of -kind RuntimeRep to LiftedRep. -Likewise, we default all Multiplicity variables to Many. +for now (see #11549). We do this right in the pretty-printer, by pre-processing +the type we are about to print, to default any type variables of kind RuntimeRep +that are bound by toplevel invisible quantification to LiftedRep. +Likewise, we default Multiplicity variables to Many and Levity variables to +Lifted. This is done in a pass right before pretty-printing (defaultIfaceTyVarsOfKind, controlled by @@ -1073,6 +1075,22 @@ metavariables are converted, skolem variables are not. There's one exception though: TyVarTv metavariables should not be defaulted, as they appear during kind-checking of "newtype T :: TYPE r where..." (test T18357a). Therefore, we additionally test for isTyConableTyVar. + +Wrinkles: + +(W1) The loop 'go' in 'defaultIfaceTyVarsOfKind' passes a Bool flag, 'rank1', + around that indicates whether we haven't yet descended into the arguments + of a function type. + This is used to decide whether newly bound variables are eligible for + defaulting – we do not want contravariant foralls to be defaulted because + that would result in an incorrect, rather than specialized, type. + For example: + ∀ p (r1 :: RuntimeRep) . (∀ (r2 :: RuntimeRep) . p r2) -> p r1 + We want to default 'r1', but not 'r2'. + When examining the first forall, 'rank1' is True. + The toplevel function type is matched as IfaceFunTy, where we recurse into + 'go' by passing False for 'rank1'. + The forall in the first argument then skips adding a substitution for 'r2'. -} -- | Default 'RuntimeRep' variables to 'LiftedRep', @@ -1097,28 +1115,29 @@ as they appear during kind-checking of "newtype T :: TYPE r where..." defaultIfaceTyVarsOfKind :: Bool -- ^ default 'RuntimeRep'/'Levity' variables? -> Bool -- ^ default 'Multiplicity' variables? -> IfaceType -> IfaceType -defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv ty +defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv True ty where go :: FastStringEnv IfaceType -- Set of enclosing forall-ed RuntimeRep/Levity/Multiplicity variables + -> Bool -- Are we in a toplevel forall, where defaulting is allowed for RR/L? -> IfaceType -> IfaceType - go subs (IfaceForAllTy (Bndr (IfaceTvBndr (var, var_kind)) argf) ty) + go subs rank1 (IfaceForAllTy (Bndr (IfaceTvBndr (var, var_kind)) argf) ty) | isInvisibleForAllTyFlag argf -- Don't default *visible* quantification -- or we get the mess in #13963 - , Just substituted_ty <- check_substitution var_kind + , Just substituted_ty <- check_substitution rank1 var_kind = let subs' = extendFsEnv subs var substituted_ty -- Record that we should replace it with LiftedRep/Lifted/Many, -- and recurse, discarding the forall - in go subs' ty + in go subs' rank1 ty - go subs (IfaceForAllTy bndr ty) - = IfaceForAllTy (go_ifacebndr subs bndr) (go subs ty) + go subs rank1 (IfaceForAllTy bndr ty) + = IfaceForAllTy (go_ifacebndr subs rank1 bndr) (go subs rank1 ty) - go subs ty@(IfaceTyVar tv) = case lookupFsEnv subs tv of + go subs _ ty@(IfaceTyVar tv) = case lookupFsEnv subs tv of Just s -> s Nothing -> ty - go _ ty@(IfaceFreeTyVar tv) + go _ _ ty@(IfaceFreeTyVar tv) -- See Note [Defaulting RuntimeRep variables], about free vars | def_rep , GHC.Core.Type.isRuntimeRepTy (tyVarKind tv) @@ -1138,47 +1157,49 @@ defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv ty | otherwise = ty - go subs (IfaceTyConApp tc tc_args) - = IfaceTyConApp tc (go_args subs tc_args) + go subs rank1 (IfaceTyConApp tc tc_args) + = IfaceTyConApp tc (go_args subs rank1 tc_args) - go subs (IfaceTupleTy sort is_prom tc_args) - = IfaceTupleTy sort is_prom (go_args subs tc_args) + go subs rank1 (IfaceTupleTy sort is_prom tc_args) + = IfaceTupleTy sort is_prom (go_args subs rank1 tc_args) - go subs (IfaceFunTy af w arg res) - = IfaceFunTy af (go subs w) (go subs arg) (go subs res) + go subs rank1 (IfaceFunTy af w arg res) + = IfaceFunTy af (go subs rank1 w) (go subs False arg) (go subs False res) - go subs (IfaceAppTy t ts) - = IfaceAppTy (go subs t) (go_args subs ts) + go subs rank1 (IfaceAppTy t ts) + = IfaceAppTy (go subs rank1 t) (go_args subs rank1 ts) - go subs (IfaceCastTy x co) - = IfaceCastTy (go subs x) co + go subs rank1 (IfaceCastTy x co) + = IfaceCastTy (go subs rank1 x) co - go _ ty@(IfaceLitTy {}) = ty - go _ ty@(IfaceCoercionTy {}) = ty + go _ _ ty@(IfaceLitTy {}) = ty + go _ _ ty@(IfaceCoercionTy {}) = ty - go_ifacebndr :: FastStringEnv IfaceType -> IfaceForAllBndr -> IfaceForAllBndr - go_ifacebndr subs (Bndr (IfaceIdBndr (w, n, t)) argf) - = Bndr (IfaceIdBndr (w, n, go subs t)) argf - go_ifacebndr subs (Bndr (IfaceTvBndr (n, t)) argf) - = Bndr (IfaceTvBndr (n, go subs t)) argf + go_ifacebndr :: FastStringEnv IfaceType -> Bool -> IfaceForAllBndr -> IfaceForAllBndr + go_ifacebndr subs rank1 (Bndr (IfaceIdBndr (w, n, t)) argf) + = Bndr (IfaceIdBndr (w, n, go subs rank1 t)) argf + go_ifacebndr subs rank1 (Bndr (IfaceTvBndr (n, t)) argf) + = Bndr (IfaceTvBndr (n, go subs rank1 t)) argf - go_args :: FastStringEnv IfaceType -> IfaceAppArgs -> IfaceAppArgs - go_args _ IA_Nil = IA_Nil - go_args subs (IA_Arg ty argf args) - = IA_Arg (go subs ty) argf (go_args subs args) + go_args :: FastStringEnv IfaceType -> Bool -> IfaceAppArgs -> IfaceAppArgs + go_args _ _ IA_Nil = IA_Nil + go_args subs rank1 (IA_Arg ty argf args) + = IA_Arg (go subs rank1 ty) argf (go_args subs rank1 args) - check_substitution :: IfaceType -> Maybe IfaceType - check_substitution (IfaceTyConApp tc _) + check_substitution :: Bool -> IfaceType -> Maybe IfaceType + check_substitution rank1 (IfaceTyConApp tc _) | def_rep , tc `ifaceTyConHasKey` runtimeRepTyConKey + , rank1 = Just liftedRep_ty | def_rep , tc `ifaceTyConHasKey` levityTyConKey + , rank1 = Just lifted_ty | def_mult , tc `ifaceTyConHasKey` multiplicityTyConKey = Just many_ty - check_substitution _ = Nothing + check_substitution _ _ = Nothing -- | The type ('BoxedRep 'Lifted), also known as LiftedRep. liftedRep_ty :: IfaceType @@ -1367,7 +1388,7 @@ ppr_sigma show_forall ctxt_prec iface_ty -- Then it could handle both invisible and required binders, and -- splitIfaceReqForallTy wouldn't be necessary here. in ppr_iface_forall_part show_forall invis_tvs theta $ - sep [pprIfaceForAll req_tvs, ppr tau'] + sep [pprIfaceForAll req_tvs, ppr_ty topPrec tau'] pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc pprUserIfaceForAll tvs ===================================== compiler/GHC/Types/Unique/DFM.hs ===================================== @@ -94,7 +94,7 @@ import qualified Data.IntSet as I -- order then `udfmToList` returns them in deterministic order. -- -- There is an implementation cost: each element is given a serial number --- as it is added, and `udfmToList` sorts it's result by this serial +-- as it is added, and `udfmToList` sorts its result by this serial -- number. So you should only use `UniqDFM` if you need the deterministic -- property. -- ===================================== testsuite/tests/ghci/scripts/T16468.script ===================================== @@ -0,0 +1,27 @@ +import GHC.Types (RuntimeRep (..), Levity (..), TYPE) +import Data.Proxy + +f :: forall p (r' :: RuntimeRep). (forall (r :: RuntimeRep). Int -> p r) -> p r'; f x = x 5 +g :: forall p. Int -> forall (r :: RuntimeRep). p r; g _ = undefined +g' :: Int -> forall p (r :: RuntimeRep). p r; g' _ = undefined +h :: Int -> forall (r :: RuntimeRep). TYPE r; h _ = undefined +i :: forall (r :: RuntimeRep). Int -> TYPE r; i _ = undefined +j :: forall p. Eq (p ('BoxedRep 'Lifted)) => Int -> forall (r :: RuntimeRep). p r; j _ = undefined +k :: forall p (r' :: RuntimeRep). Eq (p r') => (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) -> p r'; k x = x 5 + +:type f +:type g +:type g' +:type h +:type i +:type j +:type k + +:set -fprint-explicit-runtime-reps +:type f +:type g +:type g' +:type h +:type i +:type j +:type k ===================================== testsuite/tests/ghci/scripts/T16468.stdout ===================================== @@ -0,0 +1,20 @@ +f :: (forall (r :: RuntimeRep). Int -> p r) + -> p GHC.Types.LiftedRep +g :: Int -> forall (r :: RuntimeRep). p r +g' :: Int -> forall (p :: RuntimeRep -> *) (r :: RuntimeRep). p r +h :: Int -> forall (r :: RuntimeRep). TYPE r +i :: Int -> * +j :: Eq (p GHC.Types.LiftedRep) => + Int -> forall (r :: RuntimeRep). p r +k :: Eq (p GHC.Types.LiftedRep) => + (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) + -> p GHC.Types.LiftedRep +f :: (forall (r :: RuntimeRep). Int -> p r) -> p r' +g :: Int -> forall (r :: RuntimeRep). p r +g' :: Int -> forall (p :: RuntimeRep -> *) (r :: RuntimeRep). p r +h :: Int -> forall (r :: RuntimeRep). TYPE r +i :: Int -> TYPE r +j :: Eq (p GHC.Types.LiftedRep) => + Int -> forall (r :: RuntimeRep). p r +k :: Eq (p r') => + (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) -> p r' ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -375,3 +375,4 @@ test('T22695', normal, ghci_script, ['T22695.script']) test('T22817', normal, ghci_script, ['T22817.script']) test('T22908', normal, ghci_script, ['T22908.script']) test('T23062', normal, ghci_script, ['T23062.script']) +test('T16468', normal, ghci_script, ['T16468.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a80e0a688f277d27e1052171feb72147616aad59 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a80e0a688f277d27e1052171feb72147616aad59 You're receiving 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 Jun 23 13:57:41 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Fri, 23 Jun 2023 09:57:41 -0400 Subject: [Git][ghc/ghc][wip/romes/linear-core] Improve based on core lint errors Message-ID: <6495a4d5a24fd_3a020013359f1822047a@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/linear-core at Glasgow Haskell Compiler / GHC Commits: 225caa12 by Rodrigo Mesquita at 2023-06-23T14:56:37+01:00 Improve based on core lint errors - - - - - 30 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/SetLevels.hs - + compiler/GHC/Core/Opt/SetLevels.hs-boot - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/StaticArgs.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Foreign/C.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/HsToCore/Match.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/225caa129f4671f29c3d73ee54f81b610576b522 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/225caa129f4671f29c3d73ee54f81b610576b522 You're receiving 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 Jun 23 14:59:09 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Fri, 23 Jun 2023 10:59:09 -0400 Subject: [Git][ghc/ghc][wip/romes/fixes-2] task: Substitute some datas for newtypes Message-ID: <6495b33d1f55c_3a020013730470222079@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/fixes-2 at Glasgow Haskell Compiler / GHC Commits: 362ac22c by Rodrigo Mesquita at 2023-06-23T15:58:54+01:00 task: Substitute some datas for newtypes Some low-hanging fruit of data type definitions which could be defined by a zero-cost newtype instead. None of these changes cause regressions wrt laziness of newtypes (pattern matching on a newtype constructor doesn't force it). - - - - - 4 changed files: - compiler/GHC/CmmToAsm/AArch64/RegInfo.hs - compiler/GHC/CmmToAsm/PPC/RegInfo.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Driver/Pipeline/Phases.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/RegInfo.hs ===================================== @@ -8,7 +8,7 @@ import GHC.Cmm import GHC.Utils.Outputable -data JumpDest = DestBlockId BlockId +newtype JumpDest = DestBlockId BlockId -- Debug Instance instance Outputable JumpDest where ===================================== compiler/GHC/CmmToAsm/PPC/RegInfo.hs ===================================== @@ -27,7 +27,7 @@ import GHC.Cmm.CLabel import GHC.Types.Unique import GHC.Utils.Outputable (ppr, text, Outputable, (<>)) -data JumpDest = DestBlockId BlockId +newtype JumpDest = DestBlockId BlockId -- Debug Instance instance Outputable JumpDest where ===================================== compiler/GHC/Core/Map/Type.hs ===================================== @@ -542,7 +542,7 @@ instance Eq (DeBruijn a) => Eq (DeBruijn (Maybe a)) where -- We also need to do the same for multiplicity! Which, since multiplicities are -- encoded simply as a 'Type', amounts to have a Trie for a pair of types. Tries -- of pairs are composition. -data BndrMap a = BndrMap (TypeMapG (MaybeMap TypeMapG a)) +newtype BndrMap a = BndrMap (TypeMapG (MaybeMap TypeMapG a)) -- TODO(22292): derive instance Functor BndrMap where ===================================== compiler/GHC/Driver/Pipeline/Phases.hs ===================================== @@ -51,4 +51,4 @@ data TPhase res where T_MergeForeign :: PipeEnv -> HscEnv -> FilePath -> [FilePath] -> TPhase FilePath -- | A wrapper around the interpretation function for phases. -data PhaseHook = PhaseHook (forall a . TPhase a -> IO a) +newtype PhaseHook = PhaseHook (forall a . TPhase a -> IO a) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/362ac22c305cfb22254ee8810a75b9973b051881 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/362ac22c305cfb22254ee8810a75b9973b051881 You're receiving 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 Jun 23 15:28:34 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 23 Jun 2023 11:28:34 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/mr-review-template Message-ID: <6495ba22ecda3_3a0200163f8264222380@gitlab.mail> Matthew Pickering pushed new branch wip/mr-review-template at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/mr-review-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 Fri Jun 23 15:35:05 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 23 Jun 2023 11:35:05 -0400 Subject: [Git][ghc/ghc][wip/mr-review-template] Move MR template to Default.md Message-ID: <6495bba9e4acb_3a020013b9f920226686@gitlab.mail> Matthew Pickering pushed to branch wip/mr-review-template at Glasgow Haskell Compiler / GHC Commits: ba15bf7d by Matthew Pickering at 2023-06-23T16:34:37+01:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 1 changed file: - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md Changes: ===================================== .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md ===================================== View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ba15bf7d6e3671dcd9415e708a22fe8562ca40b3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ba15bf7d6e3671dcd9415e708a22fe8562ca40b3 You're receiving 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 Jun 23 15:38:20 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 23 Jun 2023 11:38:20 -0400 Subject: [Git][ghc/ghc][wip/tsan/fixes-2] codeGen: More precise barriers for eager blackholing Message-ID: <6495bc6c73db1_3a020013359f182274ba@gitlab.mail> Ben Gamari pushed to branch wip/tsan/fixes-2 at Glasgow Haskell Compiler / GHC Commits: e10dfa47 by Ben Gamari at 2023-06-22T19:04:44-04:00 codeGen: More precise barriers for eager blackholing - - - - - 1 changed file: - compiler/GHC/StgToCmm/Bind.hs Changes: ===================================== compiler/GHC/StgToCmm/Bind.hs ===================================== @@ -702,11 +702,11 @@ emitBlackHoleCode node = do when eager_blackholing $ do whenUpdRemSetEnabled $ emitUpdRemSetPushThunk node - emitAtomicStore platform MemOrderSeqCst + emitAtomicStore platform MemOrderRelease (cmmOffsetW platform node (fixedHdrSizeW profile)) (currentTSOExpr platform) -- See Note [Heap memory barriers] in SMP.h. - emitAtomicStore platform MemOrderRelaxed + emitAtomicStore platform MemOrderRelease node (CmmReg (CmmGlobal $ GlobalRegUse EagerBlackholeInfo $ bWord platform)) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e10dfa4737d446b6cace5af9e0eefef689c4ca99 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e10dfa4737d446b6cace5af9e0eefef689c4ca99 You're receiving 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 Jun 23 17:08:19 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Fri, 23 Jun 2023 13:08:19 -0400 Subject: [Git][ghc/ghc][wip/romes/fixes-2] task: Substitute some datatypes for newtypes Message-ID: <6495d1838b500_3a02001c19aa702718c3@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/fixes-2 at Glasgow Haskell Compiler / GHC Commits: 8b68ac69 by Rodrigo Mesquita at 2023-06-23T18:04:06+01:00 task: Substitute some datatypes for newtypes * Substitutes some data type declarations for newtype declarations * Adds comment to `LlvmConfigCache`, which must decidedly not be a newtype. Fixes #23555 - - - - - 5 changed files: - compiler/GHC/CmmToAsm/AArch64/RegInfo.hs - compiler/GHC/CmmToAsm/PPC/RegInfo.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Driver/LlvmConfigCache.hs - compiler/GHC/Driver/Pipeline/Phases.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/RegInfo.hs ===================================== @@ -8,7 +8,7 @@ import GHC.Cmm import GHC.Utils.Outputable -data JumpDest = DestBlockId BlockId +newtype JumpDest = DestBlockId BlockId -- Debug Instance instance Outputable JumpDest where ===================================== compiler/GHC/CmmToAsm/PPC/RegInfo.hs ===================================== @@ -27,7 +27,7 @@ import GHC.Cmm.CLabel import GHC.Types.Unique import GHC.Utils.Outputable (ppr, text, Outputable, (<>)) -data JumpDest = DestBlockId BlockId +newtype JumpDest = DestBlockId BlockId -- Debug Instance instance Outputable JumpDest where ===================================== compiler/GHC/Core/Map/Type.hs ===================================== @@ -542,7 +542,7 @@ instance Eq (DeBruijn a) => Eq (DeBruijn (Maybe a)) where -- We also need to do the same for multiplicity! Which, since multiplicities are -- encoded simply as a 'Type', amounts to have a Trie for a pair of types. Tries -- of pairs are composition. -data BndrMap a = BndrMap (TypeMapG (MaybeMap TypeMapG a)) +newtype BndrMap a = BndrMap (TypeMapG (MaybeMap TypeMapG a)) -- TODO(22292): derive instance Functor BndrMap where ===================================== compiler/GHC/Driver/LlvmConfigCache.hs ===================================== @@ -18,6 +18,8 @@ import System.IO.Unsafe -- Currently implemented with unsafe lazy IO. But it could be implemented with -- an IORef as the exposed interface is in IO. data LlvmConfigCache = LlvmConfigCache LlvmConfig +-- NB: It is crucial for this to be a datatype, not a newtype. +-- Allocations can increase across the board over 20% otherwise (!10708) initLlvmConfigCache :: FilePath -> IO LlvmConfigCache initLlvmConfigCache top_dir = pure $ LlvmConfigCache (unsafePerformIO $ initLlvmConfig top_dir) ===================================== compiler/GHC/Driver/Pipeline/Phases.hs ===================================== @@ -51,4 +51,4 @@ data TPhase res where T_MergeForeign :: PipeEnv -> HscEnv -> FilePath -> [FilePath] -> TPhase FilePath -- | A wrapper around the interpretation function for phases. -data PhaseHook = PhaseHook (forall a . TPhase a -> IO a) +newtype PhaseHook = PhaseHook (forall a . TPhase a -> IO a) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8b68ac6971a19ba0fbe9e99576033fc6f5e8e276 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8b68ac6971a19ba0fbe9e99576033fc6f5e8e276 You're receiving 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 Jun 23 17:13:01 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Fri, 23 Jun 2023 13:13:01 -0400 Subject: [Git][ghc/ghc][wip/expand-do] handle a special in desugaring when a do block has only one statment, the ds... Message-ID: <6495d29d11b0c_3a020013e6b4742736f5@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 2b3e0526 by Apoorv Ingle at 2023-06-23T12:12:46-05:00 handle a special in desugaring when a do block has only one statment, the ds location should be set to that of the last statement - - - - - 7 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Utils/Unify.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -1145,7 +1145,6 @@ instance (Outputable a, Outputable b) => Outputable (HsExpansion a b) where ppr (HsExpanded orig expanded) = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) (ppr orig) - -- = braces (ppr orig) $$ braces (text "Expansion:" <+> ppr expanded) {- ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -264,7 +264,10 @@ dsExpr (HsOverLit _ lit) dsExpr e@(XExpr ext_expr_tc) = case ext_expr_tc of - ExpansionExpr (HsExpanded _ b) -> dsExpr b + ExpansionExpr (HsExpanded orig b) -> + case isSingleDoStmt orig of + Just loc -> putSrcSpanDsA loc $ dsExpr b + Nothing -> dsExpr b WrapExpr {} -> dsHsWrapped e ConLikeTc con tvs tys -> dsConLike con tvs tys -- Hpc Support @@ -284,6 +287,9 @@ dsExpr e@(XExpr ext_expr_tc) do { assert (exprType e2 `eqType` boolTy) mkBinaryTickBox ixT ixF e2 } + where + isSingleDoStmt (HsDo _ _ (L _ [L loc _])) = Just loc + isSingleDoStmt _ = Nothing -- Strip ticks due to #21701, need to be invariant about warnings we produce whether -- this is enabled or not. ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -775,8 +775,9 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches' ; let matches = if any (is_pat_syn_match origin) matches' then filter (non_gen_wc origin) matches' - -- filter out the wild pattern fail alternatives that - -- generate spurious overlapping warnings + -- filter out the wild pattern fail alternatives + -- They generate spurious overlapping warnings + -- Due to pattern synonyms treated as refutable patterns else matches' ; new_vars <- case matches of [] -> newSysLocalsDs arg_tys @@ -849,7 +850,9 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches' is_pat_syn_match _ _ = False -- generated match pattern that is not a wildcard non_gen_wc :: Origin -> LMatch GhcTc (LHsExpr GhcTc) -> Bool - non_gen_wc (Generated _) (L _ (Match _ _ ([L _ (WildPat _)]) _)) = False + non_gen_wc origin (L _ (Match _ _ ([L _ (WildPat _)]) _)) + | isDoExpansionGenerated origin = False + | otherwise = True non_gen_wc _ _ = True {- Note [Long-distance information in matchWrapper] ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -160,7 +160,7 @@ pmcMatches origin ctxt vars matches = {-# SCC "pmcMatches" #-} do tracePm "pmcMatches {" $ hang (vcat [ppr ctxt, ppr vars, text "Matches:"]) 2 - (vcat (map ppr matches) $$ (text "missing:" <+> ppr missing)) + ((ppr matches) $$ (text "missing:" <+> ppr missing)) case NE.nonEmpty matches of Nothing -> do -- This must be an -XEmptyCase. See Note [Checking EmptyCase] ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -367,7 +367,7 @@ tcApp rn_expr exp_res_ty = do traceTc "tcApp" (vcat [text "insideExpansion", ppr rn_fun, ppr fun_ctxt]) addHeadCtxt fun_ctxt thing_inside | otherwise - = do traceTc "tcApp" (vcat [text "no expansion", ppr rn_fun]) + = do traceTc "tcApp" (vcat [text "no expansion", ppr rn_fun, ppr fun_ctxt]) addFunResCtxt rn_fun rn_args app_res_rho exp_res_ty $ thing_inside @@ -729,14 +729,8 @@ addArgCtxt ctxt (L arg_loc arg) thing_inside <+> ppr (is_then_fun (appCtxtExpr ctxt)) <+> ppr (is_bind_fun (appCtxtExpr ctxt)) ]) ; case ctxt of - -- VACall _ _ _ | not in_src_ctxt -- the context we are in is generated - -- , not rebindableOn - -- -> do traceTc "addArgCtxt 1" empty - -- thing_inside -- do not do anything in case of expanded (>>) - -- -- TODO: this behaviour is not quite right - -- -- user written (>>)/(>>=) are infix and then 'expanded' to be prefix VACall fun arg_no _ | not in_generated_code && not (is_then_fun fun || is_bind_fun fun) - -> do traceTc "addArgCtxt 2" empty + -> do traceTc "addArgCtxt 2a" empty setSrcSpanA arg_loc $ addErrCtxt (funAppCtxt fun arg arg_no) $ thing_inside ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -300,6 +300,7 @@ splitHsApps e = go e (top_ctxt 0 e) [] top_ctxt n (HsAppType _ fun _ _) = top_lctxt (n+1) fun top_ctxt n (HsApp _ fun _) = top_lctxt (n+1) fun top_ctxt n (XExpr (ExpandedExpr (HsExpanded orig _))) = VACall orig n noSrcSpan + top_ctxt n other_fun@(XExpr (ExpandedStmt _)) = VACall other_fun n generatedSrcSpan top_ctxt n other_fun = VACall other_fun n noSrcSpan top_lctxt n (L _ fun) = top_ctxt n fun ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -832,10 +832,9 @@ unifyExpectedType :: HsExpr GhcRn -> ExpRhoType -- Expected -> TcM TcCoercionN unifyExpectedType rn_expr act_ty exp_ty - = do traceTc "unifyExpectedType" (ppr rn_expr) - case exp_ty of - Infer inf_res -> fillInferResult act_ty inf_res - Check exp_ty -> unifyType (Just $ HsExprRnThing rn_expr) act_ty exp_ty + = case exp_ty of + Infer inf_res -> fillInferResult act_ty inf_res + Check exp_ty -> unifyType (Just $ HsExprRnThing rn_expr) act_ty exp_ty ------------------------ tcSubTypePat :: CtOrigin -> UserTypeCtxt View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2b3e05262d892fa27bdd47aecf19b40c39af7579 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2b3e05262d892fa27bdd47aecf19b40c39af7579 You're receiving 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 Jun 23 17:51:08 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Fri, 23 Jun 2023 13:51:08 -0400 Subject: [Git][ghc/ghc][wip/romes/linear-core] 3 commits: Fix incorrect change Message-ID: <6495db8cf285a_3a020013e6b474281184@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/linear-core at Glasgow Haskell Compiler / GHC Commits: 06a72689 by Rodrigo Mesquita at 2023-06-23T15:10:09+01:00 Fix incorrect change - - - - - 2f9d9e0e by Rodrigo Mesquita at 2023-06-23T15:34:38+01:00 Revert some parts of debugging with pat synonyms mess and has call stacks and assertions Revert "Temporary assertions bsed on typeable" Adn some more bits? This reverts commit d6ec303a089ccbdfb35dfe2e0e1c8a92053a0118. Revert all that shings - - - - - 32e1ae08 by Rodrigo Mesquita at 2023-06-23T18:50:31+01:00 Major clean up With lint in place, identifying bugs through the core outputs and by the context and phase it is in seems easier than through all the debugging and tracing and assertions I was doing. - - - - - 30 changed files: - compiler/GHC/Core.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/Exitify.hs - compiler/GHC/Core/Opt/FloatIn.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/SetLevels.hs - − compiler/GHC/Core/Opt/SetLevels.hs-boot - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/StaticArgs.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Hs/Binds.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/225caa129f4671f29c3d73ee54f81b610576b522...32e1ae0831dfc44424b3ffdf115e2e112cfe83e7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/225caa129f4671f29c3d73ee54f81b610576b522...32e1ae0831dfc44424b3ffdf115e2e112cfe83e7 You're receiving 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 Jun 23 20:21:13 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 23 Jun 2023 16:21:13 -0400 Subject: [Git][ghc/ghc][wip/tsan/fixes-2] 2 commits: testsuite: Add AtomicModifyIORef test Message-ID: <6495feb9c90c_3a020013359f182958f3@gitlab.mail> Ben Gamari pushed to branch wip/tsan/fixes-2 at Glasgow Haskell Compiler / GHC Commits: b1bbaed6 by Ben Gamari at 2023-06-23T16:21:01-04:00 testsuite: Add AtomicModifyIORef test - - - - - 0d2e7625 by Ben Gamari at 2023-06-23T16:21:01-04:00 fixup! Fix synchronization on thread blocking state - - - - - 3 changed files: - + libraries/base/tests/AtomicModifyIORef.hs - libraries/base/tests/all.T - rts/PrimOps.cmm Changes: ===================================== libraries/base/tests/AtomicModifyIORef.hs ===================================== @@ -0,0 +1,21 @@ +import Control.Concurrent +import Control.Monad +import Data.IORef + +main :: IO () +main = do + let nThreads = 10 + nIncrs = 10000000 + + ref <- newIORef (42 :: Int) + dones <- replicateM nThreads $ do + done <- newEmptyMVar + forkIO $ do + replicateM_ nIncrs $ atomicModifyIORef' ref $ \old -> (old + 1, ()) + putMVar done () + putStrLn "." + return done + + mapM_ takeMVar dones + readIORef ref >>= print + ===================================== libraries/base/tests/all.T ===================================== @@ -308,5 +308,6 @@ test('listThreads', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['' test('listThreads1', omit_ghci, compile_and_run, ['']) test('inits1tails1', normal, compile_and_run, ['']) test('CLC149', normal, compile, ['']) +test('AtomicModifyIORef', normal, compile_and_run, ['']) test('AtomicSwapIORef', normal, compile_and_run, ['']) test('T23454', normal, compile_fail, ['']) ===================================== rts/PrimOps.cmm ===================================== @@ -1731,15 +1731,11 @@ stg_takeMVarzh ( P_ mvar /* :: MVar a */ ) StgMVarTSOQueue_link(q) = END_TSO_QUEUE; StgMVarTSOQueue_tso(q) = CurrentTSO; SET_HDR(q, stg_MVAR_TSO_QUEUE_info, CCS_SYSTEM); - // Write barrier before we make the new MVAR_TSO_QUEUE - // visible to other cores. - // See Note [Heap memory barriers] - RELEASE_FENCE; if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) { - StgMVar_head(mvar) = q; + %release StgMVar_head(mvar) = q; } else { - StgMVarTSOQueue_link(StgMVar_tail(mvar)) = q; + %release StgMVarTSOQueue_link(StgMVar_tail(mvar)) = q; ccall recordClosureMutated(MyCapability() "ptr", StgMVar_tail(mvar)); } @@ -1900,13 +1896,11 @@ stg_putMVarzh ( P_ mvar, /* :: MVar a */ StgMVarTSOQueue_tso(q) = CurrentTSO; SET_HDR(q, stg_MVAR_TSO_QUEUE_info, CCS_SYSTEM); - // See Note [Heap memory barriers] - RELEASE_FENCE; if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) { - StgMVar_head(mvar) = q; + %release StgMVar_head(mvar) = q; } else { - StgMVarTSOQueue_link(StgMVar_tail(mvar)) = q; + %release StgMVarTSOQueue_link(StgMVar_tail(mvar)) = q; ccall recordClosureMutated(MyCapability() "ptr", StgMVar_tail(mvar)); } @@ -2109,13 +2103,11 @@ stg_readMVarzh ( P_ mvar, /* :: MVar a */ ) StgMVarTSOQueue_tso(q) = CurrentTSO; SET_HDR(q, stg_MVAR_TSO_QUEUE_info, CCS_SYSTEM); - // See Note [Heap memory barriers] - RELEASE_FENCE; + %release StgMVar_head(mvar) = q; StgTSO__link(CurrentTSO) = q; StgTSO_block_info(CurrentTSO) = mvar; %release StgTSO_why_blocked(CurrentTSO) = BlockedOnMVarRead::I16; - StgMVar_head(mvar) = q; if (StgMVar_tail(mvar) == stg_END_TSO_QUEUE_closure) { StgMVar_tail(mvar) = q; @@ -2243,7 +2235,7 @@ stg_readIOPortzh ( P_ ioport /* :: IOPort a */ ) SET_HDR(q, stg_MVAR_TSO_QUEUE_info, CCS_SYSTEM); - StgMVar_head(ioport) = q; + %release StgMVar_head(ioport) = q; StgTSO__link(CurrentTSO) = q; StgTSO_block_info(CurrentTSO) = ioport; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e10dfa4737d446b6cace5af9e0eefef689c4ca99...0d2e7625a71e9a29b32de05e06422f965a13661d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e10dfa4737d446b6cace5af9e0eefef689c4ca99...0d2e7625a71e9a29b32de05e06422f965a13661d You're receiving 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 Jun 23 20:22:40 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 23 Jun 2023 16:22:40 -0400 Subject: [Git][ghc/ghc][wip/tsan/fixes-2] 22 commits: rts: Fix synchronization on thread blocking state Message-ID: <6495ff108af4_3a0200133ec5fc296278@gitlab.mail> Ben Gamari pushed to branch wip/tsan/fixes-2 at Glasgow Haskell Compiler / GHC Commits: f4499a11 by Ben Gamari at 2023-06-23T16:22:32-04:00 rts: Fix synchronization on thread blocking state - - - - - 108b9164 by Ben Gamari at 2023-06-23T16:22:32-04:00 rts: Relaxed load MutVar info table - - - - - 1e0e47ca by Ben Gamari at 2023-06-23T16:22:32-04:00 hadrian: More debug information - - - - - 4bdd4370 by Ben Gamari at 2023-06-23T16:22:32-04:00 hadrian: More selective TSAN instrumentation - - - - - 0550072f by Ben Gamari at 2023-06-23T16:22:32-04:00 codeGen/tsan: Rework handling of spilling - - - - - 6f2f4e18 by Ben Gamari at 2023-06-23T16:22:32-04:00 codeGen: Ensure that TSAN is aware of writeArray# write barriers - - - - - c32e4e2e by Ben Gamari at 2023-06-23T16:22:32-04:00 codeGen: Ensure that array reads have necessary barriers This was the cause of #23541. - - - - - d2201622 by Ben Gamari at 2023-06-23T16:22:32-04:00 Wordsmith TSAN Note - - - - - 7bbf8245 by Ben Gamari at 2023-06-23T16:22:32-04:00 codeGen: Use relaxed accesses in ticky bumping - - - - - 0c18f3ff by Ben Gamari at 2023-06-23T16:22:32-04:00 codeGen: Use relaxed-read in closureInfoPtr - - - - - 083c7b4c by Ben Gamari at 2023-06-23T16:22:32-04:00 Fix thunk update ordering Previously we attempted to ensure soundness of concurrent thunk update by synchronizing on the access of the thunk's info table pointer field. This was believed to be sufficient since the indirectee (which may expose a closure allocated by another core) would not be examined until the info table pointer update is complete. However, it turns out that this can result in data races in the presence of multiple threads racing a update a single thunk. For instance, consider this interleaving under the old scheme: Thread A Thread B --------- --------- t=0 Enter t 1 Push update frame 2 Begin evaluation 4 Pause thread 5 t.indirectee=tso 6 Release t.info=BLACKHOLE 7 ... (e.g. GC) 8 Resume thread 9 Finish evaluation 10 Relaxed t.indirectee=x 11 Load t.info 12 Acquire fence 13 Inspect t.indirectee 14 Release t.info=BLACKHOLE Here Thread A enters thunk `t` but is soon paused, resulting in `t` being lazily blackholed at t=6. Then, at t=10 Thread A finishes evaluation and updates `t.indirectee` with a relaxed store. Meanwhile, Thread B enters the blackhole. Under the old scheme this would introduce an acquire-fence but this would only synchronize with Thread A at t=6. Consequently, the result of the evaluation, `x`, is not visible to Thread B, introducing a data race. We fix this by treating the `indirectee` field as we do all other mutable fields. This means we must always access this field with acquire-loads and release-stores. See #23185. - - - - - 27b51df9 by Ben Gamari at 2023-06-23T16:22:32-04:00 STM: Use acquire loads when possible Full sequential consistency is not needed here. - - - - - 352c52ac by Ubuntu at 2023-06-23T16:22:32-04:00 ghc-prim: Use C11 atomics - - - - - 37d24c44 by Ubuntu at 2023-06-23T16:22:32-04:00 Run script - - - - - 6efff2e0 by Ben Gamari at 2023-06-23T16:22:32-04:00 hadrian: Ensure that way-flags are passed to CC Previously the way-specific compilation flags (e.g. `-DDEBUG`, `-DTHREADED_RTS`) would not be passed to the CC invocations. This meant that C dependency files would not correctly reflect dependencies predicated on the way, resulting in the rather painful #23554. Closes #23554. - - - - - 64c18366 by Ben Gamari at 2023-06-23T16:22:32-04:00 rts/Interpreter: Fix data race - - - - - 7fb9ef15 by Ben Gamari at 2023-06-23T16:22:32-04:00 rts/Messages: Fix data race - - - - - b1c2cbb9 by Ben Gamari at 2023-06-23T16:22:32-04:00 rts/Prof: Fix data race - - - - - 20a46f28 by Ben Gamari at 2023-06-23T16:22:32-04:00 rts: Fix various data races - - - - - 555d054a by Ben Gamari at 2023-06-23T16:22:32-04:00 rts: Use fence rather than redundant load - - - - - 02a6b271 by Ben Gamari at 2023-06-23T16:22:32-04:00 codeGen: More precise barriers for eager blackholing - - - - - 6093adb7 by Ben Gamari at 2023-06-23T16:22:32-04:00 testsuite: Add AtomicModifyIORef test - - - - - 30 changed files: - compiler/GHC/Cmm/Info.hs - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/StgToCmm/Bind.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/StgToCmm/Utils.hs - hadrian/src/Flavour.hs - hadrian/src/Settings/Builders/Common.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Packages.hs - + libraries/base/tests/AtomicModifyIORef.hs - libraries/base/tests/all.T - libraries/ghc-prim/cbits/atomic.c - rts/Apply.cmm - rts/Compact.cmm - rts/Exception.cmm - rts/Heap.c - rts/Interpreter.c - rts/Messages.c - rts/PrimOps.cmm - rts/Proftimer.c - rts/RaiseAsync.c - rts/STM.c - rts/Schedule.c - rts/StableName.c - rts/StgMiscClosures.cmm - rts/ThreadPaused.c - rts/Threads.c - rts/TraverseHeap.c - rts/Updates.cmm The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0d2e7625a71e9a29b32de05e06422f965a13661d...6093adb74d77096b8053910cd81d1f2116bd47c3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0d2e7625a71e9a29b32de05e06422f965a13661d...6093adb74d77096b8053910cd81d1f2116bd47c3 You're receiving 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 Jun 23 21:50:41 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Fri, 23 Jun 2023 17:50:41 -0400 Subject: [Git][ghc/ghc][wip/romes/linear-core] 179 commits: Migrate errors in GHC.Tc.Validity Message-ID: <649613b1d0c3a_3a020013e6b474299550@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/linear-core at Glasgow Haskell Compiler / GHC Commits: 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 8ae458df by Rodrigo Mesquita at 2023-06-23T22:40:44+01:00 WIP: Anotate provenance and mult or usageenv - - - - - 6af3a788 by Rodrigo Mesquita at 2023-06-23T22:41:04+01:00 More fixes, in particular in bindNonRec... In bindNonRec make sure if we return a case instead of a let we make the idBinding correct - - - - - c07dde82 by Rodrigo Mesquita at 2023-06-23T22:41:05+01:00 Lint binding site matches id binding - - - - - afbe37bc by Rodrigo Mesquita at 2023-06-23T22:41:05+01:00 ROMES: WIP improvements In particular, we note that in dsUnliftedBind we pass to matchEquations variables which were let bound, which get further down the line used in matchOneConLike (and in bindNonRec too) as case-pattern bound variables! In this situation, where we use originally let-bound variables as case bound variables, we must ensure the case bound variables are set to be `LambdaBound` with the correct multiplicity (which should be some mix of scaling with the constructor annotated multiplicities) TODO: The multiplicity corresponding to the constructor multiplicity scaled by ... This broke through one more wall in the compilation of stage1 caused by incorrect provenences (well, really, by variables being moved around binding types while the provenence isn't updated) - - - - - db06b7b2 by Rodrigo Mesquita at 2023-06-23T22:41:05+01:00 Document 'selectMatchVars' - - - - - 83dfbeaf by Rodrigo Mesquita at 2023-06-23T22:41:05+01:00 Make match variables always lambda bound The burning question being: Will variables selected for match (`selectMatchVar`) always be bound in case patterns? - - - - - 211a5f17 by Rodrigo Mesquita at 2023-06-23T22:41:05+01:00 ROMES WIP - - - - - dee9a696 by Rodrigo Mesquita at 2023-06-23T22:41:05+01:00 Temporary assertions bsed on typeable Drop this commit! - - - - - cf71b5fe by Rodrigo Mesquita at 2023-06-23T22:42:00+01:00 Fix IdBindings of multiple top-level let bindings - - - - - 22037cb5 by Rodrigo Mesquita at 2023-06-23T22:42:01+01:00 The IdBinding of an Id and keeping it up to date Introduces two notes explaining the design of IdBindings and how they're kept up to date. See: - Note [The IdBinding of an Id] - Note [Keeping the IdBinding up to date] - - - - - c5488d29 by Rodrigo Mesquita at 2023-06-23T22:42:25+01:00 Some progress - - - - - 08c9276d by Rodrigo Mesquita at 2023-06-23T22:42:27+01:00 More progress - - - - - dc8ff708 by Rodrigo Mesquita at 2023-06-23T22:42:27+01:00 Lam and Let pattern synonyms For debugging purposes only :) This way, we're able to more easily find the first binder in which the IdBinding is wrong. - - - - - 1e99dfd9 by Rodrigo Mesquita at 2023-06-23T22:42:27+01:00 Progress - - - - - d159a3e6 by Rodrigo Mesquita at 2023-06-23T22:42:27+01:00 Multiple further fixes of IdBindings... - - - - - 1b4429fa by Rodrigo Mesquita at 2023-06-23T22:42:37+01:00 Improve based on core lint errors - - - - - 007650e6 by Rodrigo Mesquita at 2023-06-23T22:42:38+01:00 Fix incorrect change - - - - - 87232226 by Rodrigo Mesquita at 2023-06-23T22:42:38+01:00 Revert some parts of debugging with pat synonyms mess and has call stacks and assertions Revert "Temporary assertions bsed on typeable" Adn some more bits? This reverts commit d6ec303a089ccbdfb35dfe2e0e1c8a92053a0118. Revert all that shings - - - - - f89c9be0 by Rodrigo Mesquita at 2023-06-23T22:44:28+01:00 Major clean up With lint in place, identifying bugs through the core outputs and by the context and phase it is in seems easier than through all the debugging and tracing and assertions I was doing. - - - - - d3d51061 by Rodrigo Mesquita at 2023-06-23T22:44:30+01:00 Revert BndrMap with IdBindingMap First, try to get it to work assuming LetBound vars have ManyTy as they used to (but we convert them on inserting and looking them up on the map) Revert this when the "right" solution (having an IdBindingMap) is implemented - - - - - 28ebeed4 by Rodrigo Mesquita at 2023-06-23T22:50:27+01:00 Some tweaks and note: * It seems very important that if we update the Id binding of some Id that happens in a binder we also update the Id binding of occurrences of that Id in Var expressions. Otherwise we'll fail important things like lookups on triemaps - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - HACKING.md - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types/Prim.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Make.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CSE.hs - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/32e1ae0831dfc44424b3ffdf115e2e112cfe83e7...28ebeed4e4da051c9ea5ce01b8805ba6d5be9152 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/32e1ae0831dfc44424b3ffdf115e2e112cfe83e7...28ebeed4e4da051c9ea5ce01b8805ba6d5be9152 You're receiving 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 Jun 23 22:05:11 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Fri, 23 Jun 2023 18:05:11 -0400 Subject: [Git][ghc/ghc][wip/expand-do] do not add argument context if it is a do statement Message-ID: <64961717a093d_3a020014278aa83014d1@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: e13451b4 by Apoorv Ingle at 2023-06-23T17:04:58-05:00 do not add argument context if it is a do statement - - - - - 3 changed files: - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Match.hs Changes: ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -264,10 +264,7 @@ dsExpr (HsOverLit _ lit) dsExpr e@(XExpr ext_expr_tc) = case ext_expr_tc of - ExpansionExpr (HsExpanded orig b) -> - case isSingleDoStmt orig of - Just loc -> putSrcSpanDsA loc $ dsExpr b - Nothing -> dsExpr b + ExpansionExpr (HsExpanded _ b) -> dsExpr b WrapExpr {} -> dsHsWrapped e ConLikeTc con tvs tys -> dsConLike con tvs tys -- Hpc Support @@ -287,9 +284,6 @@ dsExpr e@(XExpr ext_expr_tc) do { assert (exprType e2 `eqType` boolTy) mkBinaryTickBox ixT ixF e2 } - where - isSingleDoStmt (HsDo _ _ (L _ [L loc _])) = Just loc - isSingleDoStmt _ = Nothing -- Strip ticks due to #21701, need to be invariant about warnings we produce whether -- this is enabled or not. ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -734,6 +734,10 @@ addArgCtxt ctxt (L arg_loc arg) thing_inside setSrcSpanA arg_loc $ addErrCtxt (funAppCtxt fun arg arg_no) $ thing_inside + VACall fun _ _ | not in_generated_code && (is_then_fun fun || is_bind_fun fun) + -> do traceTc "addArgCtxt 2b" empty -- Skip setting "In the expression..." + -- We have already set the context "In the stmt" + thing_inside _ -> do traceTc "addArgCtxt 3" empty setSrcSpanA arg_loc $ addExprCtxt arg $ -- Auto-suppressed if arg_loc is generated ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1244,7 +1244,7 @@ expand_do_stmts do_or_lc (stmt@(L _ (LetStmt _ bs)) : lstmts) = do expand_stmts <- expand_do_stmts do_or_lc lstmts return $ wrapGenSpan (mkExpandedStmt stmt (genHsLet bs $ genPopSrcSpanExpr expand_stmts)) -expand_do_stmts do_or_lc (stmt@(L _ (BindStmt xbsrn pat e)): lstmts) +expand_do_stmts do_or_lc (stmt@(L loc (BindStmt xbsrn pat e)): lstmts) | SyntaxExprRn bind_op <- xbsrn_bindOp xbsrn , fail_op <- xbsrn_failOp xbsrn = -- the pattern binding pat can fail @@ -1258,14 +1258,14 @@ expand_do_stmts do_or_lc (stmt@(L _ (BindStmt xbsrn pat e)): lstmts) expand_stmts <- expand_do_stmts do_or_lc lstmts expr@(L l _) <- mk_failable_lexpr_tcm pat expand_stmts fail_op traceTc "expand_do_stmts" (vcat [ text "loc ex stmts" <+> ppr l]) - return $ wrapGenSpan (mkPopSrcSpanExpr $ wrapGenSpan (mkExpandedStmt stmt ( - (wrapGenSpan bind_op) `genHsApp` e)) -- (>>=) - `genHsApp` - expr - ) + return $ wrapGenSpan (mkPopSrcSpanExpr $ L loc (mkExpandedStmt stmt ( + (wrapGenSpan bind_op) + `genHsApp` e)) -- (>>=) + `genHsApp` + expr) | otherwise = pprPanic "expand do: shouldn't happen" (text "stmt" <+> ppr stmt) -expand_do_stmts do_or_lc (stmt@(L _ (BodyStmt _ e (SyntaxExprRn then_op) _)) : lstmts) = +expand_do_stmts do_or_lc (stmt@(L loc (BodyStmt _ e (SyntaxExprRn then_op) _)) : lstmts) = -- See Note [BodyStmt] -- stmts ~~> stmts' -- ---------------------------------------------- @@ -1274,7 +1274,7 @@ expand_do_stmts do_or_lc (stmt@(L _ (BodyStmt _ e (SyntaxExprRn then_op) _)) : l -- let spanWrap = if isRebindableOn then noLocA else wrapGenSpan expand_stmts@(L l _) <- expand_do_stmts do_or_lc lstmts traceTc "expand_do_stmts" (vcat [ text "loc ex stmts" <+> ppr l]) - return $ wrapGenSpan (mkPopSrcSpanExpr $ wrapGenSpan (mkExpandedStmt stmt ( + return $ wrapGenSpan (mkPopSrcSpanExpr $ L loc (mkExpandedStmt stmt ( (wrapGenSpan then_op) -- (>>) `genHsApp` e)) `genHsApp` View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e13451b4a16e0beb09a063ef2941fce9dc0a6beb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e13451b4a16e0beb09a063ef2941fce9dc0a6beb You're receiving 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 Jun 23 22:05:44 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Fri, 23 Jun 2023 18:05:44 -0400 Subject: [Git][ghc/ghc][wip/romes/fixes-2] task: Substitute some datatypes for newtypes Message-ID: <64961738a7718_3a0200163f8264301973@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/fixes-2 at Glasgow Haskell Compiler / GHC Commits: 9d820cbc by Rodrigo Mesquita at 2023-06-23T23:05:32+01:00 task: Substitute some datatypes for newtypes * Substitutes some data type declarations for newtype declarations * Adds comment to `LlvmConfigCache`, which must decidedly not be a newtype. Fixes #23555 - - - - - 5 changed files: - compiler/GHC/CmmToAsm/AArch64/RegInfo.hs - compiler/GHC/CmmToAsm/PPC/RegInfo.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/Driver/LlvmConfigCache.hs - compiler/GHC/Driver/Pipeline/Phases.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/RegInfo.hs ===================================== @@ -8,7 +8,7 @@ import GHC.Cmm import GHC.Utils.Outputable -data JumpDest = DestBlockId BlockId +newtype JumpDest = DestBlockId BlockId -- Debug Instance instance Outputable JumpDest where ===================================== compiler/GHC/CmmToAsm/PPC/RegInfo.hs ===================================== @@ -27,7 +27,7 @@ import GHC.Cmm.CLabel import GHC.Types.Unique import GHC.Utils.Outputable (ppr, text, Outputable, (<>)) -data JumpDest = DestBlockId BlockId +newtype JumpDest = DestBlockId BlockId -- Debug Instance instance Outputable JumpDest where ===================================== compiler/GHC/Core/Map/Type.hs ===================================== @@ -542,7 +542,7 @@ instance Eq (DeBruijn a) => Eq (DeBruijn (Maybe a)) where -- We also need to do the same for multiplicity! Which, since multiplicities are -- encoded simply as a 'Type', amounts to have a Trie for a pair of types. Tries -- of pairs are composition. -data BndrMap a = BndrMap (TypeMapG (MaybeMap TypeMapG a)) +newtype BndrMap a = BndrMap (TypeMapG (MaybeMap TypeMapG a)) -- TODO(22292): derive instance Functor BndrMap where ===================================== compiler/GHC/Driver/LlvmConfigCache.hs ===================================== @@ -18,6 +18,8 @@ import System.IO.Unsafe -- Currently implemented with unsafe lazy IO. But it could be implemented with -- an IORef as the exposed interface is in IO. data LlvmConfigCache = LlvmConfigCache LlvmConfig +-- NB: It is crucial for this to be a datatype, not a newtype. +-- Allocations can increase across the board over 20% otherwise (see the discussion on !10708 and non-final pipelines) initLlvmConfigCache :: FilePath -> IO LlvmConfigCache initLlvmConfigCache top_dir = pure $ LlvmConfigCache (unsafePerformIO $ initLlvmConfig top_dir) ===================================== compiler/GHC/Driver/Pipeline/Phases.hs ===================================== @@ -51,4 +51,4 @@ data TPhase res where T_MergeForeign :: PipeEnv -> HscEnv -> FilePath -> [FilePath] -> TPhase FilePath -- | A wrapper around the interpretation function for phases. -data PhaseHook = PhaseHook (forall a . TPhase a -> IO a) +newtype PhaseHook = PhaseHook (forall a . TPhase a -> IO a) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9d820cbc2e8a7e61bded28be8d6710f73010d00a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9d820cbc2e8a7e61bded28be8d6710f73010d00a You're receiving 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 Jun 23 22:51:20 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Fri, 23 Jun 2023 18:51:20 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23543 Message-ID: <649621e8a4948_3a020014278aa830422d@gitlab.mail> Ryan Scott pushed new branch wip/T23543 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23543 You're receiving 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 Jun 24 11:19:09 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Sat, 24 Jun 2023 07:19:09 -0400 Subject: [Git][ghc/ghc][wip/T23543] Fix typechecking of promoted empty lists Message-ID: <6496d12d699ea_11170cc7858982fd@gitlab.mail> Ryan Scott pushed to branch wip/T23543 at Glasgow Haskell Compiler / GHC Commits: a918bf4d by Ryan Scott at 2023-06-24T07:18:02-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - 7 changed files: - compiler/GHC/Tc/Gen/HsType.hs - testsuite/tests/ghci/scripts/T15898.stderr - testsuite/tests/ghci/scripts/T6018ghcifail.stderr - testsuite/tests/ghci/scripts/T7939.stdout - + testsuite/tests/typecheck/should_compile/T23543.hs - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_fail/T6018fail.stderr Changes: ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -1253,6 +1253,12 @@ tc_hs_type mode rn_ty@(HsSumTy _ hs_tys) exp_kind --------- Promoted lists and tuples tc_hs_type mode rn_ty@(HsExplicitListTy _ _ tys) exp_kind + -- The '[] case is handled in tc_infer_hs_type. + -- See Note [Future-proofing the type checker]. + | null tys + = tc_infer_hs_type_ek mode rn_ty exp_kind + + | otherwise = do { tks <- mapM (tc_infer_lhs_type mode) tys ; (taus', kind) <- unifyKinds tys tks ; let ty = (foldr (mk_cons kind) (mk_nil kind) taus') ===================================== testsuite/tests/ghci/scripts/T15898.stderr ===================================== @@ -18,7 +18,7 @@ In an equation for ‘it’: it = undefined :: [(), ()] :6:14: error: [GHC-83865] - • Expected a type, but ‘'( '[], '[])’ has kind ‘([k0], [k1])’ + • Expected a type, but ‘'( '[], '[])’ has kind ‘([a0], [a1])’ • In an expression type signature: '( '[], '[]) In the expression: undefined :: '( '[], '[]) In an equation for ‘it’: it = undefined :: '( '[], '[]) ===================================== testsuite/tests/ghci/scripts/T6018ghcifail.stderr ===================================== @@ -41,18 +41,18 @@ :55:41: error: [GHC-05175] Type family equation violates the family's injectivity annotation. - Type/kind variable ‘k1’ + Type/kind variable ‘a1’ cannot be inferred from the right-hand side. In the type family equation: - PolyKindVarsF @{[k1]} @[k2] ('[] @k1) = '[] @k2 + PolyKindVarsF @{[a1]} @[a2] ('[] @a1) = '[] @a2 -- Defined at :55:41 :60:15: error: [GHC-05175] Type family equation violates the family's injectivity annotation. - Type/kind variable ‘k1’ + Type/kind variable ‘a1’ cannot be inferred from the right-hand side. In the type family equation: - PolyKindVars @[k1] @[k2] ('[] @k1) = '[] @k2 + PolyKindVars @[a1] @[a2] ('[] @a1) = '[] @a2 -- Defined at :60:15 :64:15: error: [GHC-05175] ===================================== testsuite/tests/ghci/scripts/T7939.stdout ===================================== @@ -19,12 +19,12 @@ type family H a where H False = True -- Defined at T7939.hs:15:1 H :: Bool -> Bool -type J :: forall {k}. [k] -> Bool -type family J a where +type J :: forall {a}. [a] -> Bool +type family J a1 where J '[] = False - forall k (h :: k) (t :: [k]). J (h : t) = True + forall a (h :: a) (t :: [a]). J (h : t) = True -- Defined at T7939.hs:18:1 -J :: [k] -> Bool +J :: [a] -> Bool type K :: forall {a}. [a] -> Maybe a type family K a1 where K '[] = Nothing ===================================== testsuite/tests/typecheck/should_compile/T23543.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +module T23543 where + +type N :: forall a. Maybe a +type N = ('Nothing :: forall a. Maybe a) + +type L :: forall a. [a] +type L = ('[] :: forall a. [a]) ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -880,3 +880,4 @@ test('T22560b', normal, compile, ['']) test('T22560c', normal, compile, ['']) test('T22560d', extra_files(['T22560d.hs']), ghci_script, ['T22560d.script']) test('T22560e', normal, compile, ['']) +test('T23543', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/T6018fail.stderr ===================================== @@ -52,18 +52,18 @@ T6018fail.hs:53:15: error: [GHC-05175] T6018fail.hs:61:10: error: [GHC-05175] Type family equation violates the family's injectivity annotation. - Type/kind variable ‘k1’ + Type/kind variable ‘a1’ cannot be inferred from the right-hand side. In the type family equation: - PolyKindVarsF @{[k1]} @[k2] ('[] @k1) = '[] @k2 + PolyKindVarsF @{[a1]} @[a2] ('[] @a1) = '[] @a2 -- Defined at T6018fail.hs:61:10 T6018fail.hs:64:15: error: [GHC-05175] Type family equation violates the family's injectivity annotation. - Type/kind variable ‘k1’ + Type/kind variable ‘a1’ cannot be inferred from the right-hand side. In the type family equation: - PolyKindVars @[k1] @[k2] ('[] @k1) = '[] @k2 + PolyKindVars @[a1] @[a2] ('[] @a1) = '[] @a2 -- Defined at T6018fail.hs:64:15 T6018fail.hs:68:15: error: [GHC-05175] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a918bf4d568567ef3f543794ab5093d5169d2841 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a918bf4d568567ef3f543794ab5093d5169d2841 You're receiving 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 Jun 24 11:33:29 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Sat, 24 Jun 2023 07:33:29 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/DIB-INSTANCES] 51 commits: Report scoped kind variables at the type-checking phase (#16635) Message-ID: <6496d489c4f5b_11170cc79ac10142e@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/DIB-INSTANCES at Glasgow Haskell Compiler / GHC Commits: 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - e8532729 by Andrei Borzenkov at 2023-06-24T15:33:10+04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/JS/Syntax.hs - compiler/GHC/JS/Unsat/Syntax.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7cfbb301a3d8cd2af5e5cc801ae5933ccd198bf4...e8532729f8f77fd99863715c26e9846865a96c30 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7cfbb301a3d8cd2af5e5cc801ae5933ccd198bf4...e8532729f8f77fd99863715c26e9846865a96c30 You're receiving 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 Jun 24 11:33:54 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Sat, 24 Jun 2023 07:33:54 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/MR10360-backport-9.4 Message-ID: <6496d4a23a7bc_11170cc79d410202f@gitlab.mail> Ryan Scott pushed new branch wip/MR10360-backport-9.4 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/MR10360-backport-9.4 You're receiving 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 Jun 24 11:37:22 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Sat, 24 Jun 2023 07:37:22 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/MR10360-backport-9.6 Message-ID: <6496d5722a071_11170cc78581040d@gitlab.mail> Ryan Scott pushed new branch wip/MR10360-backport-9.6 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/MR10360-backport-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 Sat Jun 24 13:53:18 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Sat, 24 Jun 2023 09:53:18 -0400 Subject: [Git][ghc/ghc][wip/forall-vis-coercions] 44 commits: JS: factorize SaneDouble into its own module Message-ID: <6496f54e1971d_11170cc79d412367@gitlab.mail> Simon Peyton Jones pushed to branch wip/forall-vis-coercions at Glasgow Haskell Compiler / GHC Commits: a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - d52ed1d0 by Matthew Craven at 2023-06-24T14:52:59+01:00 Equality of forall-types is visiblity aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [Forall coercions] in GHC.Core.TyCo.Rep - - - - - 87ecea59 by Simon Peyton Jones at 2023-06-24T14:52:59+01:00 Fix to eta expansion See new function GHC.Core.Opt.Arity.mkEtaForAllMCo. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/HsToCore/Binds.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bc25bdc6b3224efd2f67005ed62f584324406da0...87ecea591c785c0e3304424f60d5161a5a19584a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bc25bdc6b3224efd2f67005ed62f584324406da0...87ecea591c785c0e3304424f60d5161a5a19584a You're receiving 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 Jun 24 15:03:25 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Sat, 24 Jun 2023 11:03:25 -0400 Subject: [Git][ghc/ghc][wip/int-index/vdq-with-coercions] 37 commits: Avoid desugaring non-recursive lets into recursive lets Message-ID: <649705bd3625c_11170cc786c130937@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/vdq-with-coercions at Glasgow Haskell Compiler / GHC Commits: 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - d52ed1d0 by Matthew Craven at 2023-06-24T14:52:59+01:00 Equality of forall-types is visiblity aware This patch finally (I hope) nails the question of whether (forall a. ty) and (forall a -> ty) are `eqType`: they aren't! There is a long discussion in #22762, plus useful Notes: * Note [ForAllTy and type equality] in GHC.Core.TyCo.Compare * Note [Comparing visiblities] in GHC.Core.TyCo.Compare * Note [Forall coercions] in GHC.Core.TyCo.Rep - - - - - 87ecea59 by Simon Peyton Jones at 2023-06-24T14:52:59+01:00 Fix to eta expansion See new function GHC.Core.Opt.Arity.mkEtaForAllMCo. - - - - - e822be16 by Vladislav Zavialov at 2023-06-24T16:23:48+02:00 WIP: Visible forall in types of terms - - - - - 67903273 by Vladislav Zavialov at 2023-06-24T17:02:10+02:00 VDQ: Add test WithSpineVDQ_LintErr - - - - - b68b48db by Vladislav Zavialov at 2023-06-24T17:02:18+02:00 VDQ: reject nonlinear type variable bindings - - - - - 5f0f5135 by Vladislav Zavialov at 2023-06-24T17:02:18+02:00 VDQ: accept test suite changes Not all of these are quite right: in some contexts, the suggestion to enable RequiredTypeArguments is incorrect, as enabling the extension wouldn't make the program accepted. - - - - - 2db0efdc by Vladislav Zavialov at 2023-06-24T17:02:18+02:00 VDQ: Use visibility coercions - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Coercion.hs-boot - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Reduction.hs - compiler/GHC/Core/TyCo/Compare.hs - compiler/GHC/Core/TyCo/FVs.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Core/TyCo/Tidy.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/Expr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ae86587d201631fb6b5a5f59cab5aac3faab526c...2db0efdc580310e9aa5b75671b60280b6f935a16 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ae86587d201631fb6b5a5f59cab5aac3faab526c...2db0efdc580310e9aa5b75671b60280b6f935a16 You're receiving 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 Jun 24 17:19:18 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Sat, 24 Jun 2023 13:19:18 -0400 Subject: [Git][ghc/ghc][wip/supersven/riscv64-ncg] Fix (CmmLit (CmmInt w i)) where i doesn't fit in w Message-ID: <64972596d5c0e_11170cc79e81358a3@gitlab.mail> Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC Commits: 7687dd32 by Sven Tennie at 2023-06-24T19:18:07+02:00 Fix (CmmLit (CmmInt w i)) where i doesn't fit in w - - - - - 2 changed files: - compiler/GHC/CmmToAsm/RV64/CodeGen.hs - compiler/GHC/CmmToAsm/RV64/Instr.hs Changes: ===================================== compiler/GHC/CmmToAsm/RV64/CodeGen.hs ===================================== @@ -496,35 +496,44 @@ getRegister' config plat (CmmMachOp (MO_Sub w0) [x, CmmLit (CmmInt i w1)]) | i < -- Generic case. -getRegister' config plat expr - = case expr of - CmmReg (CmmGlobal PicBaseReg) - -> pprPanic "getRegisterReg-memory" (ppr $ PicBaseReg) - CmmLit lit - -> case lit of +getRegister' config plat expr = + case expr of + CmmReg (CmmGlobal PicBaseReg) -> + pprPanic "getRegisterReg-memory" (ppr PicBaseReg) + CmmLit lit -> + case lit of CmmInt 0 w -> pure $ Fixed (intFormat w) zero_reg nilOL + CmmInt i w | isEncodeableInWidth w i -> do + pure (Any (intFormat w) (\dst -> unitOL $ annExpr expr (MOV (OpReg w dst) (OpImm (ImmInteger i))))) - CmmInt i W8 | i >= 0 -> do - return (Any (intFormat W8) (\dst -> unitOL $ annExpr expr (MOV (OpReg W8 dst) (OpImm (ImmInteger (narrowU W8 i)))))) - CmmInt i W16 | i >= 0 -> do - return (Any (intFormat W16) (\dst -> unitOL $ annExpr expr (MOV (OpReg W16 dst) (OpImm (ImmInteger (narrowU W16 i)))))) - - CmmInt i W8 -> do - return (Any (intFormat W8) (\dst -> unitOL $ annExpr expr (MOV (OpReg W8 dst) (OpImm (ImmInteger (narrowU W8 i)))))) - CmmInt i W16 -> do - return (Any (intFormat W16) (\dst -> unitOL $ annExpr expr (MOV (OpReg W16 dst) (OpImm (ImmInteger (narrowU W16 i)))))) - - -- We need to be careful to not shorten this for negative literals. - -- Those need the upper bits set. We'd either have to explicitly sign - -- or figure out something smarter. Lowered to - -- `MOV dst XZR` + -- i does not fit. Be careful to keep the sign. CmmInt i w -> do - return (Any (intFormat w) (\dst -> unitOL $ annExpr expr (MOV (OpReg w dst) (OpImm (ImmInteger i))))) - - CmmInt _i rep -> do - (op, imm_code) <- litToImm' lit - return (Any (intFormat rep) (\dst -> imm_code `snocOL` annExpr expr (MOV (OpReg rep dst) op))) + let -- select all but the sign (most significant) bit + mask = allOneMask (maxBitNo - 1) + numBits = i .&. mask + truncatedI = numBits .|. signBit i + pure + ( Any + (intFormat w) + ( \dst -> + toOL + [ annExpr + expr + (MOV (OpReg w dst) (OpImm (ImmInteger truncatedI))) + ] + ) + ) + where + allOneMask :: Int -> Integer + allOneMask 0 = bit 0 + allOneMask n = bit n .|. allOneMask (n - 1) + + signBit :: Integer -> Integer + signBit i | signum i < 0 = bit maxBitNo + signBit _i = 0 + + maxBitNo = widthInBits w - 1 -- floatToBytes (fromRational f) CmmFloat 0 w -> do ===================================== compiler/GHC/CmmToAsm/RV64/Instr.hs ===================================== @@ -894,3 +894,8 @@ intMax12bit = 2047 fitsIn32bits :: (Num a, Ord a, Bits a) => a -> Bool fitsIn32bits i = (-1 `shiftL` 31) <= i && i <= (1 `shiftL` 31 -1) +isNbitEncodeable :: Int -> Integer -> Bool +isNbitEncodeable n i = let shift = n - 1 in (-1 `shiftL` shift) <= i && i < (1 `shiftL` shift) + +isEncodeableInWidth :: Width -> Integer -> Bool +isEncodeableInWidth = isNbitEncodeable . widthInBits View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7687dd327d436475c451670c0de1f22bd799d901 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7687dd327d436475c451670c0de1f22bd799d901 You're receiving 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 Jun 24 21:36:15 2023 From: gitlab at gitlab.haskell.org (Torsten Schmits (@torsten.schmits)) Date: Sat, 24 Jun 2023 17:36:15 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/torsten.schmits/doc-fix-linear-types-link Message-ID: <649761cf98fe2_11170cc785814933a@gitlab.mail> Torsten Schmits pushed new branch wip/torsten.schmits/doc-fix-linear-types-link at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/torsten.schmits/doc-fix-linear-types-link You're receiving 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 Jun 24 21:38:41 2023 From: gitlab at gitlab.haskell.org (Torsten Schmits (@torsten.schmits)) Date: Sat, 24 Jun 2023 17:38:41 -0400 Subject: [Git][ghc/ghc][wip/torsten.schmits/doc-fix-linear-types-link] 3 commits: rts: Work around missing prototypes errors Message-ID: <64976261eb5b3_11170c608e6c415439a@gitlab.mail> Torsten Schmits pushed to branch wip/torsten.schmits/doc-fix-linear-types-link at Glasgow Haskell Compiler / GHC Commits: 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 6a6d7221 by Torsten Schmits at 2023-06-24T23:38:34+02:00 Remove duplicate link label in linear types docs - - - - - 3 changed files: - .gitlab-ci.yml - docs/users_guide/exts/linear_types.rst - rts/include/stg/SMP.h Changes: ===================================== .gitlab-ci.yml ===================================== @@ -1063,7 +1063,7 @@ ghcup-metadata-nightly: artifacts: false - job: project-version script: - - nix shell --extra-experimental-features nix-command -f .gitlab/rel_eng -c ghcup-metadata --metadata ghcup-0.0.7.yaml --date="$(date -d $CI_PIPELINE_CREATED_AT +%Y-%M-%d)" --pipeline-id="$CI_PIPELINE_ID" --version="$ProjectVersion" > "metadata_test.yaml" + - nix shell --extra-experimental-features nix-command -f .gitlab/rel_eng -c ghcup-metadata --metadata ghcup-0.0.7.yaml --date="$(date -d $CI_PIPELINE_CREATED_AT +%Y-%m-%d)" --pipeline-id="$CI_PIPELINE_ID" --version="$ProjectVersion" > "metadata_test.yaml" rules: - if: $NIGHTLY @@ -1100,7 +1100,7 @@ ghcup-metadata-release: # No explicit needs for release pipeline as we assume we need everything and everything will pass. extends: .ghcup-metadata script: - - nix shell --extra-experimental-features nix-command -f .gitlab/rel_eng -c ghcup-metadata --release-mode --metadata ghcup-0.0.7.yaml --date="$(date -d $CI_PIPELINE_CREATED_AT +%Y-%M-%d)" --pipeline-id="$CI_PIPELINE_ID" --version="$ProjectVersion" > "metadata_test.yaml" + - nix shell --extra-experimental-features nix-command -f .gitlab/rel_eng -c ghcup-metadata --release-mode --metadata ghcup-0.0.7.yaml --date="$(date -d $CI_PIPELINE_CREATED_AT +%Y-%m-%d)" --pipeline-id="$CI_PIPELINE_ID" --version="$ProjectVersion" > "metadata_test.yaml" rules: - if: '$RELEASE_JOB == "yes"' ===================================== docs/users_guide/exts/linear_types.rst ===================================== @@ -14,7 +14,7 @@ Linear types warts, and bad error messages; everything down to the syntax is subject to change**. See, in particular, :ref:`linear-types-limitations` below. We encourage you to experiment -with this extension and report issues in the GHC bug tracker `the GHC +with this extension and report issues in `the GHC bug tracker `__, adding the tag ``LinearTypes``. ===================================== rts/include/stg/SMP.h ===================================== @@ -589,9 +589,9 @@ load_load_barrier(void) { EXTERN_INLINE void write_barrier(void); EXTERN_INLINE void store_load_barrier(void); EXTERN_INLINE void load_load_barrier(void); -EXTERN_INLINE void write_barrier () {} /* nothing */ -EXTERN_INLINE void store_load_barrier() {} /* nothing */ -EXTERN_INLINE void load_load_barrier () {} /* nothing */ +EXTERN_INLINE void write_barrier (void) {} /* nothing */ +EXTERN_INLINE void store_load_barrier(void) {} /* nothing */ +EXTERN_INLINE void load_load_barrier (void) {} /* nothing */ // Relaxed atomic operations #define RELAXED_LOAD(ptr) *ptr View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/74f96c1fb57b93b0ba5b93541adf1361599a89ee...6a6d7221b0525e9cd32e9a02f1ebe44879125218 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/74f96c1fb57b93b0ba5b93541adf1361599a89ee...6a6d7221b0525e9cd32e9a02f1ebe44879125218 You're receiving 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 Jun 24 21:58:27 2023 From: gitlab at gitlab.haskell.org (Melanie Brown (@mixphix)) Date: Sat, 24 Jun 2023 17:58:27 -0400 Subject: [Git][ghc/ghc][wip/clc-86] 81 commits: Change WarningWithFlag to plural WarningWithFlags Message-ID: <6497670381d87_11170cc79841570d9@gitlab.mail> Melanie Brown pushed to branch wip/clc-86 at Glasgow Haskell Compiler / GHC Commits: a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - d0c2da47 by Melanie Brown at 2023-06-24T17:57:47-04:00 Merge branch 'master' into wip/clc-86 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Iface/Decl.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1d669e2574926d5052767c57e8c8775efc105ac1...d0c2da47f613fd5cc74be75ba4c33c72d20b8018 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1d669e2574926d5052767c57e8c8775efc105ac1...d0c2da47f613fd5cc74be75ba4c33c72d20b8018 You're receiving 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 Jun 24 22:07:13 2023 From: gitlab at gitlab.haskell.org (Melanie Brown (@mixphix)) Date: Sat, 24 Jun 2023 18:07:13 -0400 Subject: [Git][ghc/ghc][wip/clc-86] Deprecate Data.List.NonEmpty.unzip Message-ID: <64976911a29b1_11170c608e6c41577e2@gitlab.mail> Melanie Brown pushed to branch wip/clc-86 at Glasgow Haskell Compiler / GHC Commits: d80325d2 by Melanie Phoenix at 2023-06-24T18:06:51-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 10 changed files: - compiler/GHC/Data/Bag.hs - libraries/Cabal - libraries/base/Control/Monad/Zip.hs - libraries/base/Data/List/NonEmpty.hs - libraries/base/changelog.md - libraries/hpc - libraries/process - libraries/stm - utils/haddock - utils/hsc2hs Changes: ===================================== compiler/GHC/Data/Bag.hs ===================================== @@ -7,6 +7,7 @@ Bag: an unordered collection with duplicates -} {-# LANGUAGE ScopedTypeVariables, DeriveTraversable, TypeFamilies #-} +{-# OPTIONS_GHC -Wno-deprecations #-} module GHC.Data.Bag ( Bag, -- abstract type ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit e71f6f263aa4d7ce7a145eb5ac417f2f580f2288 +Subproject commit 280a7a71e495da8f25ae33dbc6e743526b9106f9 ===================================== libraries/base/Control/Monad/Zip.hs ===================================== @@ -20,6 +20,7 @@ module Control.Monad.Zip where import Control.Monad (liftM, liftM2) import Data.Functor.Identity +import qualified Data.Functor import Data.Monoid import Data.Ord ( Down(..) ) import Data.Proxy @@ -65,7 +66,7 @@ instance MonadZip [] where instance MonadZip NE.NonEmpty where mzip = NE.zip mzipWith = NE.zipWith - munzip = NE.unzip + munzip = Data.Functor.unzip -- | @since 4.8.0.0 instance MonadZip Identity where ===================================== libraries/base/Data/List/NonEmpty.hs ===================================== @@ -472,6 +472,7 @@ zipWith f ~(x :| xs) ~(y :| ys) = f x y :| List.zipWith f xs ys -- | The 'unzip' function is the inverse of the 'zip' function. unzip :: Functor f => f (a,b) -> (f a, f b) unzip xs = (fst <$> xs, snd <$> xs) +{-# DEPRECATED unzip "This function will be made monomorphic in base-4.22, consider switching to Data.Functor.unzip" #-} -- | The 'nub' function removes duplicate elements from a list. In -- particular, it keeps only the first occurrence of each element. ===================================== libraries/base/changelog.md ===================================== @@ -33,6 +33,7 @@ * Implement `GHC.IORef.atomicSwapIORef` via a new dedicated primop `atomicSwapMutVar#` ([CLC proposal #139](https://github.com/haskell/core-libraries-committee/issues/139)) * Change codebuffers to use an unboxed implementation, while providing a compatibility layer using pattern synonyms. ([CLC proposal #134](https://github.com/haskell/core-libraries-committee/issues/134)) * Add nominal role annotations to SNat/SSymbol/SChar ([CLC proposal #170](https://github.com/haskell/core-libraries-committee/issues/170)) + * Deprecate `Data.List.NonEmpty.unzip` ([CLC proposal #86](https://github.com/haskell/core-libraries-committee/issues/86)) ## 4.18.0.0 *March 2023* * Shipped with GHC 9.6.1 ===================================== libraries/hpc ===================================== @@ -1 +1 @@ -Subproject commit efd3826085953f618a1626b6c701c0314ba8b9bc +Subproject commit bb5c55d697b0d0e6b8cce5ff5037273241de3239 ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit 6092a13f6bf2ef76105683c7f9e278c0dcadceec +Subproject commit e60ab049b92238b0111654589f17b6ee68249f01 ===================================== libraries/stm ===================================== @@ -1 +1 @@ -Subproject commit 86172e75bd4f5c400b3a6f0cd3945bdb7c03bcdd +Subproject commit cfb7e775c5f6df281b7052b7b4e4a51dafda10d2 ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 495c0655dcb9a9482054c5e48c0106f57f5ddb06 +Subproject commit 03ba53ca764f56a13d12607c110f923f129e809a ===================================== utils/hsc2hs ===================================== @@ -1 +1 @@ -Subproject commit f70b360b295298e4da10afe02ebf022b21342008 +Subproject commit 1ba092932f86c1fda15091d355ba7975b8554437 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d80325d2c2ea8908342577068286df7d741907e2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d80325d2c2ea8908342577068286df7d741907e2 You're receiving 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 Jun 25 00:54:16 2023 From: gitlab at gitlab.haskell.org (Melanie Brown (@mixphix)) Date: Sat, 24 Jun 2023 20:54:16 -0400 Subject: [Git][ghc/ghc][wip/clc-86] Deprecate Data.List.NonEmpty.unzip Message-ID: <64979038a30ed_11170c96eb3d4169881@gitlab.mail> Melanie Brown pushed to branch wip/clc-86 at Glasgow Haskell Compiler / GHC Commits: 61674993 by Melanie Phoenix at 2023-06-24T20:54:10-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 10 changed files: - compiler/GHC/Data/Bag.hs - libraries/Cabal - libraries/base/Control/Monad/Zip.hs - libraries/base/Data/List/NonEmpty.hs - libraries/base/changelog.md - libraries/hpc - libraries/process - libraries/stm - utils/haddock - utils/hsc2hs Changes: ===================================== compiler/GHC/Data/Bag.hs ===================================== @@ -7,6 +7,7 @@ Bag: an unordered collection with duplicates -} {-# LANGUAGE ScopedTypeVariables, DeriveTraversable, TypeFamilies #-} +{-# OPTIONS_GHC -Wno-deprecations #-} module GHC.Data.Bag ( Bag, -- abstract type ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit e71f6f263aa4d7ce7a145eb5ac417f2f580f2288 +Subproject commit 280a7a71e495da8f25ae33dbc6e743526b9106f9 ===================================== libraries/base/Control/Monad/Zip.hs ===================================== @@ -20,6 +20,7 @@ module Control.Monad.Zip where import Control.Monad (liftM, liftM2) import Data.Functor.Identity +import qualified Data.Functor import Data.Monoid import Data.Ord ( Down(..) ) import Data.Proxy @@ -65,7 +66,7 @@ instance MonadZip [] where instance MonadZip NE.NonEmpty where mzip = NE.zip mzipWith = NE.zipWith - munzip = NE.unzip + munzip = Data.Functor.unzip -- | @since 4.8.0.0 instance MonadZip Identity where ===================================== libraries/base/Data/List/NonEmpty.hs ===================================== @@ -472,6 +472,7 @@ zipWith f ~(x :| xs) ~(y :| ys) = f x y :| List.zipWith f xs ys -- | The 'unzip' function is the inverse of the 'zip' function. unzip :: Functor f => f (a,b) -> (f a, f b) unzip xs = (fst <$> xs, snd <$> xs) +{-# DEPRECATED unzip "This function will be made monomorphic in base-4.22, consider switching to Data.Functor.unzip" #-} -- | The 'nub' function removes duplicate elements from a list. In -- particular, it keeps only the first occurrence of each element. ===================================== libraries/base/changelog.md ===================================== @@ -33,6 +33,7 @@ * Implement `GHC.IORef.atomicSwapIORef` via a new dedicated primop `atomicSwapMutVar#` ([CLC proposal #139](https://github.com/haskell/core-libraries-committee/issues/139)) * Change codebuffers to use an unboxed implementation, while providing a compatibility layer using pattern synonyms. ([CLC proposal #134](https://github.com/haskell/core-libraries-committee/issues/134)) * Add nominal role annotations to SNat/SSymbol/SChar ([CLC proposal #170](https://github.com/haskell/core-libraries-committee/issues/170)) + * Deprecate `Data.List.NonEmpty.unzip` ([CLC proposal #86](https://github.com/haskell/core-libraries-committee/issues/86)) ## 4.18.0.0 *March 2023* * Shipped with GHC 9.6.1 ===================================== libraries/hpc ===================================== @@ -1 +1 @@ -Subproject commit efd3826085953f618a1626b6c701c0314ba8b9bc +Subproject commit bb5c55d697b0d0e6b8cce5ff5037273241de3239 ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit 6092a13f6bf2ef76105683c7f9e278c0dcadceec +Subproject commit e60ab049b92238b0111654589f17b6ee68249f01 ===================================== libraries/stm ===================================== @@ -1 +1 @@ -Subproject commit 86172e75bd4f5c400b3a6f0cd3945bdb7c03bcdd +Subproject commit cfb7e775c5f6df281b7052b7b4e4a51dafda10d2 ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 495c0655dcb9a9482054c5e48c0106f57f5ddb06 +Subproject commit 03ba53ca764f56a13d12607c110f923f129e809a ===================================== utils/hsc2hs ===================================== @@ -1 +1 @@ -Subproject commit f70b360b295298e4da10afe02ebf022b21342008 +Subproject commit 1ba092932f86c1fda15091d355ba7975b8554437 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/61674993c5cf45edc7895d9189a7c862e7034f1b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/61674993c5cf45edc7895d9189a7c862e7034f1b You're receiving 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 Jun 25 00:55:11 2023 From: gitlab at gitlab.haskell.org (Melanie Brown (@mixphix)) Date: Sat, 24 Jun 2023 20:55:11 -0400 Subject: [Git][ghc/ghc][wip/clc-86] Deprecate Data.List.NonEmpty.unzip Message-ID: <6497906fb3a52_11170cc79ac170554@gitlab.mail> Melanie Brown pushed to branch wip/clc-86 at Glasgow Haskell Compiler / GHC Commits: 89b03b54 by Melanie Phoenix at 2023-06-24T20:54:48-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 4 changed files: - compiler/GHC/Data/Bag.hs - libraries/base/Control/Monad/Zip.hs - libraries/base/Data/List/NonEmpty.hs - libraries/base/changelog.md Changes: ===================================== compiler/GHC/Data/Bag.hs ===================================== @@ -7,6 +7,7 @@ Bag: an unordered collection with duplicates -} {-# LANGUAGE ScopedTypeVariables, DeriveTraversable, TypeFamilies #-} +{-# OPTIONS_GHC -Wno-deprecations #-} module GHC.Data.Bag ( Bag, -- abstract type ===================================== libraries/base/Control/Monad/Zip.hs ===================================== @@ -20,6 +20,7 @@ module Control.Monad.Zip where import Control.Monad (liftM, liftM2) import Data.Functor.Identity +import qualified Data.Functor import Data.Monoid import Data.Ord ( Down(..) ) import Data.Proxy @@ -65,7 +66,7 @@ instance MonadZip [] where instance MonadZip NE.NonEmpty where mzip = NE.zip mzipWith = NE.zipWith - munzip = NE.unzip + munzip = Data.Functor.unzip -- | @since 4.8.0.0 instance MonadZip Identity where ===================================== libraries/base/Data/List/NonEmpty.hs ===================================== @@ -472,6 +472,7 @@ zipWith f ~(x :| xs) ~(y :| ys) = f x y :| List.zipWith f xs ys -- | The 'unzip' function is the inverse of the 'zip' function. unzip :: Functor f => f (a,b) -> (f a, f b) unzip xs = (fst <$> xs, snd <$> xs) +{-# DEPRECATED unzip "This function will be made monomorphic in base-4.22, consider switching to Data.Functor.unzip" #-} -- | The 'nub' function removes duplicate elements from a list. In -- particular, it keeps only the first occurrence of each element. ===================================== libraries/base/changelog.md ===================================== @@ -33,6 +33,7 @@ * Implement `GHC.IORef.atomicSwapIORef` via a new dedicated primop `atomicSwapMutVar#` ([CLC proposal #139](https://github.com/haskell/core-libraries-committee/issues/139)) * Change codebuffers to use an unboxed implementation, while providing a compatibility layer using pattern synonyms. ([CLC proposal #134](https://github.com/haskell/core-libraries-committee/issues/134)) * Add nominal role annotations to SNat/SSymbol/SChar ([CLC proposal #170](https://github.com/haskell/core-libraries-committee/issues/170)) + * Deprecate `Data.List.NonEmpty.unzip` ([CLC proposal #86](https://github.com/haskell/core-libraries-committee/issues/86)) ## 4.18.0.0 *March 2023* * Shipped with GHC 9.6.1 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/89b03b548bb1d5866eff4f621c686831777f04c5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/89b03b548bb1d5866eff4f621c686831777f04c5 You're receiving 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 Jun 25 16:33:59 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Sun, 25 Jun 2023 12:33:59 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] Use numbers when threading e-graph to fix a bug Message-ID: <64986c77a8696_64cc0c76a01059e4@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: 1f78dd7d by Rodrigo Mesquita at 2023-06-25T17:32:46+01:00 Use numbers when threading e-graph to fix a bug - - - - - 2 changed files: - compiler/GHC/Core/Functor.hs - compiler/GHC/HsToCore/Pmc/Solver.hs Changes: ===================================== compiler/GHC/Core/Functor.hs ===================================== @@ -128,37 +128,39 @@ toCoreExpr :: CoreExpr -> Fix CoreExprF toCoreExpr = unsafeCoerce -- | Represents a DeBruijn CoreExpr being careful to correctly debruijnizie the expression as it is represented +-- TODO: Use `Compose DeBruijn CoreExprF` instead +-- Always represent Ids, at least for now. We're seemingly using inexistent ids representDBCoreExpr :: Analysis a (DeBruijnF CoreExprF) => DeBruijn CoreExpr -> EGraph a (DeBruijnF CoreExprF) -> (ClassId, EGraph a (DeBruijnF CoreExprF)) -representDBCoreExpr (D cmenv expr) eg = case expr of - Var v -> add (Node $ DF (D cmenv (VarF v))) eg - Lit lit -> add (Node $ DF (D cmenv (LitF lit))) eg - Type t -> add (Node $ DF (D cmenv (TypeF t))) eg - Coercion c -> add (Node $ DF (D cmenv (CoercionF c))) eg - Cast e co -> let (eid,eg') = representDBCoreExpr (D cmenv e) eg - in add (Node $ DF (D cmenv (CastF eid co))) eg' - App f a -> let (fid,eg') = representDBCoreExpr (D cmenv f) eg - (aid,eg'') = representDBCoreExpr (D cmenv a) eg' - in add (Node $ DF (D cmenv (AppF fid aid))) eg'' - Tick n e -> let (eid,eg') = representDBCoreExpr (D cmenv e) eg - in add (Node $ DF (D cmenv (TickF n eid))) eg' - Lam b e -> let (eid,eg') = representDBCoreExpr (D (extendCME cmenv b) e) eg - in add (Node $ DF (D cmenv (LamF b eid))) eg' - Let (NonRec v r) e -> let (rid,eg') = representDBCoreExpr (D cmenv r) eg - (eid,eg'') = representDBCoreExpr (D (extendCME cmenv v) e) eg' - in add (Node $ DF (D cmenv (LetF (NonRecF v rid) eid))) eg'' +representDBCoreExpr (D cmenv expr) eg0 = case expr of + Var v -> add (Node $ DF (D cmenv (VarF v))) eg0 + Lit lit -> add (Node $ DF (D cmenv (LitF lit))) eg0 + Type t -> add (Node $ DF (D cmenv (TypeF t))) eg0 + Coercion c -> add (Node $ DF (D cmenv (CoercionF c))) eg0 + Cast e co -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 + in add (Node $ DF (D cmenv (CastF eid co))) eg1 + App f a -> let (fid,eg1) = representDBCoreExpr (D cmenv f) eg0 + (aid,eg2) = representDBCoreExpr (D cmenv a) eg1 + in add (Node $ DF (D cmenv (AppF fid aid))) eg2 + Tick n e -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 + in add (Node $ DF (D cmenv (TickF n eid))) eg1 + Lam b e -> let (eid,eg1) = representDBCoreExpr (D (extendCME cmenv b) e) eg0 + in add (Node $ DF (D cmenv (LamF b eid))) eg1 + Let (NonRec v r) e -> let (rid,eg1) = representDBCoreExpr (D cmenv r) eg0 + (eid,eg2) = representDBCoreExpr (D (extendCME cmenv v) e) eg1 + in add (Node $ DF (D cmenv (LetF (NonRecF v rid) eid))) eg2 Let (Rec (unzip -> (bs,rs))) e -> let cmenv' = extendCMEs cmenv bs - (bsids, eg') = EGM.runEGraphM eg $ + (bsids, eg1) = EGM.runEGraphM eg0 $ traverse (\r -> state $ representDBCoreExpr (D cmenv' r)) rs - (eid, eg'') = representDBCoreExpr (D cmenv' e) eg' - in add (Node $ DF (D cmenv (LetF (RecF (zip bs bsids)) eid))) eg'' - Case e b t as -> let (eid, eg') = representDBCoreExpr (D cmenv e) eg - (as', eg'') = EGM.runEGraphM eg' $ + (eid, eg2) = representDBCoreExpr (D cmenv' e) eg1 + in add (Node $ DF (D cmenv (LetF (RecF (zip bs bsids)) eid))) eg2 + Case e b t as -> let (eid, eg1) = representDBCoreExpr (D cmenv e) eg0 + (as', eg2) = EGM.runEGraphM eg1 $ traverse (\(Alt cons bs a) -> state $ \s -> let (aid, g) = representDBCoreExpr (D (extendCME cmenv b) a) s in (AltF cons bs aid, g)) as - in add (Node $ DF (D cmenv (CaseF eid b t as'))) eg' + in add (Node $ DF (D cmenv (CaseF eid b t as'))) eg2 -- ROMES:TODO: Instead of DeBruijnF CoreExprF we should have (ExprF (Int,Id)) ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -562,6 +562,9 @@ where you can find the solution in a perhaps more digestible format. -- | A high-level pattern-match constraint. Corresponds to φ from Figure 3 of -- the LYG paper. +-- ROMES:TODO: Ultimately, all these Ids could be replaced by e-class ids which +-- are generated during desugaring, but there are some details to it +-- (propagating the e-graphs in which these e-classes were created) data PhiCt = PhiTyCt !PredType -- ^ A type constraint "T ~ U". View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1f78dd7d207db07ffeca18e53635324f54b366c1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1f78dd7d207db07ffeca18e53635324f54b366c1 You're receiving 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 Jun 25 16:34:47 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Sun, 25 Jun 2023 12:34:47 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] fixup! Add e-graphs submodule (hegg) Message-ID: <64986ca7c38c8_64cc0c76a010635d@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: deb79e16 by Rodrigo Mesquita at 2023-06-25T17:34:40+01:00 fixup! Add e-graphs submodule (hegg) - - - - - 1 changed file: - libraries/hegg Changes: ===================================== libraries/hegg ===================================== @@ -1 +1 @@ -Subproject commit 94339b984e48bd6ce009b4e70c9374e8ac4981cd +Subproject commit 42747bc1c40131bfb1142eec99928a24689384b9 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/deb79e164b8c1af182123e4e66ccf12eaa9b848b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/deb79e164b8c1af182123e4e66ccf12eaa9b848b You're receiving 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 Jun 25 17:35:21 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Sun, 25 Jun 2023 13:35:21 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] 3 commits: Add e-graphs submodule (hegg) Message-ID: <64987ad924eab_64cc0c75d812052a@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: a97ab784 by Rodrigo Mesquita at 2023-06-25T17:56:17+01:00 Add e-graphs submodule (hegg) - - - - - e821aed9 by Rodrigo Mesquita at 2023-06-25T17:56:17+01:00 Compiler working with e-graph IWP WIP WIP WIP WIP Use numbers when threading e-graph to fix a bug - - - - - fb48c348 by Rodrigo Mesquita at 2023-06-25T18:12:53+01:00 IPW - - - - - 13 changed files: - .gitmodules - + compiler/GHC/Core/Functor.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/Types/Unique/SDFM.hs - compiler/ghc.cabal.in - hadrian/src/Packages.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Default.hs - + libraries/hegg - packages Changes: ===================================== .gitmodules ===================================== @@ -117,3 +117,6 @@ [submodule "utils/hpc"] path = utils/hpc url = https://gitlab.haskell.org/hpc/hpc-bin.git +[submodule "libraries/hegg"] + path = libraries/hegg + url = https://github.com/alt-romes/hegg.git ===================================== compiler/GHC/Core/Functor.hs ===================================== @@ -0,0 +1,165 @@ +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE FlexibleContexts #-} + +-- ROMES:TODO: Rename to Core.Equality or something +module GHC.Core.Functor where + +import GHC.Prelude + +import GHC.Core +import GHC.Core.TyCo.Rep +import GHC.Core.Map.Type +import GHC.Core.Map.Expr +import GHC.Types.Var +import GHC.Types.Literal +import GHC.Types.Tickish +import Unsafe.Coerce (unsafeCoerce) + +import Control.Monad.Trans.State.Strict (state) +import Data.Equality.Graph as EG +import Data.Equality.Analysis +import qualified Data.Equality.Graph.Monad as EGM +import Data.Equality.Utils (Fix(..)) + +import GHC.Utils.Misc (all2, equalLength) + +import Data.Functor.Compose + +import Data.Coerce + +type DeBruijnF = Compose DeBruijn + +-- Important to note the binders are also represented by $a$ +-- This is because in the e-graph we will represent binders with the +-- equivalence class id of things equivalent to it. +-- +-- Unfortunately type binders are still not correctly accounted for. +-- Perhaps it'd really be better to make DeBruijn work over these types + +-- ROMES:TODO: Rename module to specify this is for egraphs + +data AltF b a + = AltF AltCon [b] a + deriving (Functor, Foldable, Traversable, Eq, Ord) + +data BindF b a + = NonRecF b a + | RecF [(b, a)] + deriving (Functor, Foldable, Traversable, Eq, Ord) + +data ExprF b a + = VarF Id + | LitF Literal + | AppF a a + | LamF b a + | LetF (BindF b a) a + | CaseF a b Type [AltF b a] + + | CastF a CoercionR + | TickF CoreTickish a + | TypeF Type + | CoercionF Coercion + deriving (Functor, Foldable, Traversable) + +type CoreExprF + = ExprF CoreBndr + +instance {-# OVERLAPS #-} Eq a => Eq (DeBruijnF CoreExprF a) where + (==) = eqDeBruijnExprF + +-- ROMES:TODO: This instance is plain wrong. This DeBruijn scheme won't +-- particularly work for our situation, we'll likely have to have ints instead +-- of Id binders. Now, ignoring DeBruijn indices, we'll simply get this compile +-- to get a rougher estimate of performance? +eqDeBruijnExprF :: forall a. Eq a => DeBruijnF CoreExprF a -> DeBruijnF CoreExprF a -> Bool +eqDeBruijnExprF (Compose (D env1 e1)) (Compose (D env2 e2)) = go e1 e2 where + go :: CoreExprF a -> CoreExprF a -> Bool + go (VarF v1) (VarF v2) = eqDeBruijnVar (D env1 v1) (D env2 v2) + go (LitF lit1) (LitF lit2) = lit1 == lit2 + go (TypeF t1) (TypeF t2) = eqDeBruijnType (D env1 t1) (D env2 t2) + -- See Note [Alpha-equality for Coercion arguments] + go (CoercionF {}) (CoercionF {}) = True + go (CastF e1 co1) (CastF e2 co2) = D env1 co1 == D env2 co2 && e1 == e2 + go (AppF f1 a1) (AppF f2 a2) = f1 == f2 && a1 == a2 + go (TickF n1 e1) (TickF n2 e2) + = eqDeBruijnTickish (D env1 n1) (D env2 n2) + && e1 == e2 + + go (LamF b1 e1) (LamF b2 e2) + = eqDeBruijnType (D env1 (varType b1)) (D env2 (varType b2)) + && D env1 (varMultMaybe b1) == D env2 (varMultMaybe b2) + && e1 == e2 + + go (LetF (NonRecF v1 r1) e1) (LetF (NonRecF v2 r2) e2) + = r1 == r2 -- See Note [Alpha-equality for let-bindings] + && e1 == e2 + + go (LetF (RecF ps1) e1) (LetF (RecF ps2) e2) + = + -- See Note [Alpha-equality for let-bindings] + all2 (\b1 b2 -> eqDeBruijnType (D env1 (varType b1)) + (D env2 (varType b2))) + bs1 bs2 + && rs1 == rs2 + && e1 == e2 + where + (bs1,rs1) = unzip ps1 + (bs2,rs2) = unzip ps2 + + go (CaseF e1 b1 t1 a1) (CaseF e2 b2 t2 a2) + | null a1 -- See Note [Empty case alternatives] + = null a2 && e1 == e2 && D env1 t1 == D env2 t2 + | otherwise + = e1 == e2 && a1 == a2 + + go _ _ = False + +-- instance Ord a => Ord (DeBruijnF CoreExprF a) where +-- compare a b = if a == b then EQ else LT +-- deriving instance Ord a => Ord (DeBruijnF CoreExprF a) + +-- | 'unsafeCoerce' mostly because I'm too lazy to write the boilerplate. +fromCoreExpr :: CoreExpr -> Fix CoreExprF +fromCoreExpr = unsafeCoerce + +toCoreExpr :: CoreExpr -> Fix CoreExprF +toCoreExpr = unsafeCoerce + +-- | Represents a DeBruijn CoreExpr being careful to correctly debruijnizie the expression as it is represented +-- +-- Always represent Ids, at least for now. We're seemingly using inexistent ids +representDBCoreExpr :: Analysis a (DeBruijnF CoreExprF) + => DeBruijn CoreExpr + -> EGraph a (DeBruijnF CoreExprF) + -> (ClassId, EGraph a (DeBruijnF CoreExprF)) +representDBCoreExpr (D cmenv expr) eg0 = case expr of + Var v -> add (Node $ Compose (D cmenv (VarF v))) eg0 + Lit lit -> add (Node $ Compose (D cmenv (LitF lit))) eg0 + Type t -> add (Node $ Compose (D cmenv (TypeF t))) eg0 + Coercion c -> add (Node $ Compose (D cmenv (CoercionF c))) eg0 + Cast e co -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 + in add (Node $ Compose (D cmenv (CastF eid co))) eg1 + App f a -> let (fid,eg1) = representDBCoreExpr (D cmenv f) eg0 + (aid,eg2) = representDBCoreExpr (D cmenv a) eg1 + in add (Node $ Compose (D cmenv (AppF fid aid))) eg2 + Tick n e -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 + in add (Node $ Compose (D cmenv (TickF n eid))) eg1 + Lam b e -> let (eid,eg1) = representDBCoreExpr (D (extendCME cmenv b) e) eg0 + in add (Node $ Compose (D cmenv (LamF b eid))) eg1 + Let (NonRec v r) e -> let (rid,eg1) = representDBCoreExpr (D cmenv r) eg0 + (eid,eg2) = representDBCoreExpr (D (extendCME cmenv v) e) eg1 + in add (Node $ Compose (D cmenv (LetF (NonRecF v rid) eid))) eg2 + Let (Rec (unzip -> (bs,rs))) e -> + let cmenv' = extendCMEs cmenv bs + (bsids, eg1) = EGM.runEGraphM eg0 $ + traverse (\r -> state $ representDBCoreExpr (D cmenv' r)) rs + (eid, eg2) = representDBCoreExpr (D cmenv' e) eg1 + in add (Node $ Compose (D cmenv (LetF (RecF (zip bs bsids)) eid))) eg2 + Case e b t as -> let (eid, eg1) = representDBCoreExpr (D cmenv e) eg0 + (as', eg2) = EGM.runEGraphM eg1 $ + traverse (\(Alt cons bs a) -> state $ \s -> let (aid, g) = representDBCoreExpr (D (extendCME cmenv b) a) s in (AltF cons bs aid, g)) as + in add (Node $ Compose (D cmenv (CaseF eid b t as'))) eg2 + ===================================== compiler/GHC/Core/Map/Expr.hs ===================================== @@ -18,6 +18,8 @@ module GHC.Core.Map.Expr ( CoreMap, emptyCoreMap, extendCoreMap, lookupCoreMap, foldCoreMap, -- * Alpha equality eqDeBruijnExpr, eqCoreExpr, + -- ** Exports for CoreExprF instances + eqDeBruijnTickish, eqDeBruijnVar, -- * 'TrieMap' class reexports TrieMap(..), insertTM, deleteTM, lkDFreeVar, xtDFreeVar, ===================================== compiler/GHC/Core/Map/Type.hs ===================================== @@ -6,6 +6,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DeriveTraversable #-} module GHC.Core.Map.Type ( -- * Re-export generic interface @@ -512,6 +513,7 @@ lookupCME (CME { cme_env = env }) v = lookupVarEnv env v -- export the constructor. Make a helper function if you find yourself -- needing it. data DeBruijn a = D CmEnv a + deriving (Functor, Foldable, Traversable) -- romes:TODO: for internal use only! -- | Synthesizes a @DeBruijn a@ from an @a@, by assuming that there are no -- bound binders (an empty 'CmEnv'). This is usually what you want if there ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -49,18 +49,17 @@ import GHC.Data.Bag import GHC.Types.CompleteMatch import GHC.Types.Unique.Set import GHC.Types.Unique.DSet -import GHC.Types.Unique.SDFM import GHC.Types.Id import GHC.Types.Name import GHC.Types.Var (EvVar) import GHC.Types.Var.Env -import GHC.Types.Var.Set import GHC.Types.Unique.Supply import GHC.Core import GHC.Core.FVs (exprFreeVars) import GHC.Core.TyCo.Compare( eqType ) -import GHC.Core.Map.Expr +import GHC.Core.Map.Type +import GHC.Core.Functor import GHC.Core.Predicate (typeDeterminesValue) import GHC.Core.SimpleOpt (simpleOptExpr, exprIsConApp_maybe) import GHC.Core.Utils (exprType) @@ -99,6 +98,13 @@ import Data.List (sortBy, find) import qualified Data.List.NonEmpty as NE import Data.Ord (comparing) +import Data.Equality.Graph (EGraph, ClassId) +import Data.Equality.Graph.Lens +import qualified Data.Equality.Graph as EG +import Data.Bifunctor (second) +import Data.Function ((&)) +import qualified Data.IntSet as IS + -- -- * Main exports -- @@ -556,6 +562,9 @@ where you can find the solution in a perhaps more digestible format. -- | A high-level pattern-match constraint. Corresponds to φ from Figure 3 of -- the LYG paper. +-- ROMES:TODO: Ultimately, all these Ids could be replaced by e-class ids which +-- are generated during desugaring, but there are some details to it +-- (propagating the e-graphs in which these e-classes were created) data PhiCt = PhiTyCt !PredType -- ^ A type constraint "T ~ U". @@ -685,32 +694,47 @@ filterUnliftedFields con args = -- ⊥. addBotCt :: Nabla -> Id -> MaybeT DsM Nabla addBotCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x = do - let (y, vi at VI { vi_bot = bot }) = lookupVarInfoNT (nabla_tm_st nabla) x - case bot of - IsNotBot -> mzero -- There was x ≁ ⊥. Contradiction! - IsBot -> pure nabla -- There already is x ~ ⊥. Nothing left to do - MaybeBot -- We add x ~ ⊥ - | definitelyUnliftedType (idType x) - -- Case (3) in Note [Strict fields and variables of unlifted type] - -> mzero -- unlifted vars can never be ⊥ - | otherwise - -> do - let vi' = vi{ vi_bot = IsBot } - pure nabla{ nabla_tm_st = ts{ts_facts = addToUSDFM env y vi' } } +-- ROMES:TODO: bit of a hack to represent binders with `Var`, which is likely wrong (lambda bound vars might get equivalent to global ones?). Will need to justify this well +-- Perhaps I can get a new e-class everytime I have a new binder, and use the e-class Id as the true identifier. +-- (would just require adding a primitive to create empty e-classes. easy.) + let (xid, env') = representId x env + env'' <- updateVarInfo xid go env' + pure nabla{nabla_tm_st = ts{ts_facts = env''}} + where + go :: Maybe VarInfo -> MaybeT DsM (Maybe VarInfo) + go Nothing = pure (Just (emptyVarInfo x){vi_bot = IsBot}) + go (Just vi at VI { vi_bot = bot }) + = case bot of + IsNotBot -> mzero -- There was x ≁ ⊥. Contradiction! + IsBot -> pure (Just vi) -- There already is x ~ ⊥. Nothing left to do + MaybeBot -- We add x ~ ⊥ + | definitelyUnliftedType (idType x) + -- Case (3) in Note [Strict fields and variables of unlifted type] + -> mzero -- unlifted vars can never be ⊥ + | otherwise + -> do + pure (Just vi{ vi_bot = IsBot }) -- | Adds the constraint @x ~/ ⊥@ to 'Nabla'. Quite similar to 'addNotConCt', -- but only cares for the ⊥ "constructor". addNotBotCt :: Nabla -> Id -> MaybeT DsM Nabla addNotBotCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts=env} } x = do - let (y, vi at VI { vi_bot = bot }) = lookupVarInfoNT (nabla_tm_st nabla) x - case bot of - IsBot -> mzero -- There was x ~ ⊥. Contradiction! - IsNotBot -> pure nabla -- There already is x ≁ ⊥. Nothing left to do - MaybeBot -> do -- We add x ≁ ⊥ and test if x is still inhabited - -- Mark dirty for a delayed inhabitation test - let vi' = vi{ vi_bot = IsNotBot} - pure $ markDirty y - $ nabla{ nabla_tm_st = ts{ ts_facts = addToUSDFM env y vi' } } + let (xid, env') = representId x env + (_y, mvi) = lookupVarInfoNT (ts{ts_facts=env'}) x + (yid, env'') = representId x env' + case mvi of + Just vi at VI { vi_bot = bot } -> + case bot of + IsBot -> mzero -- There was x ~ ⊥. Contradiction! + IsNotBot -> pure nabla -- There already is x ≁ ⊥. Nothing left to do + MaybeBot -> do -- We add x ≁ ⊥ and test if x is still inhabited + -- Mark dirty for a delayed inhabitation test + let vi' = vi{ vi_bot = IsNotBot} + pure $ markDirty yid + $ nabla{nabla_tm_st = ts{ ts_facts = env'' & _class xid . _data .~ Just vi'}} + Nothing -> + pure $ markDirty yid -- as above + $ nabla{nabla_tm_st = ts{ ts_facts = env'' & _class xid . _data .~ Just ((emptyVarInfo x){vi_bot = IsNotBot})}} -- | Record a @x ~/ K@ constraint, e.g. that a particular 'Id' @x@ can't -- take the shape of a 'PmAltCon' @K@ in the 'Nabla' and return @Nothing@ if @@ -719,17 +743,19 @@ addNotBotCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts=env} } x = do addNotConCt :: Nabla -> Id -> PmAltCon -> MaybeT DsM Nabla addNotConCt _ _ (PmAltConLike (RealDataCon dc)) | isNewDataCon dc = mzero -- (3) in Note [Coverage checking Newtype matches] -addNotConCt nabla x nalt = do - (mb_mark_dirty, nabla') <- trvVarInfo go nabla x +addNotConCt nabla at MkNabla{nabla_tm_st=ts at TmSt{ts_facts=env}} x nalt = do + let (xid, env') = representId x env + (mb_mark_dirty, nabla') <- trvVarInfo go nabla{nabla_tm_st=ts{ts_facts=env'}} xid pure $ case mb_mark_dirty of - Just x -> markDirty x nabla' - Nothing -> nabla' + True -> markDirty xid nabla' + False -> nabla' where -- Update `x`'s 'VarInfo' entry. Fail ('MaybeT') if contradiction, -- otherwise return updated entry and `Just x'` if `x` should be marked dirty, -- where `x'` is the representative of `x`. - go :: VarInfo -> MaybeT DsM (Maybe Id, VarInfo) - go vi@(VI x' pos neg _ rcm) = do + go :: Maybe VarInfo -> MaybeT DsM (Bool, Maybe VarInfo) + go Nothing = pure (False, Just (emptyVarInfo x){vi_bot = IsNotBot, vi_neg = emptyPmAltConSet `extendPmAltConSet` nalt}) -- romes:TODO: Do I need to mark dirty the new thing? + go (Just vi@(VI _x' pos neg _ rcm)) = do -- 1. Bail out quickly when nalt contradicts a solution let contradicts nalt sol = eqPmAltCon (paca_con sol) nalt == Equal guard (not (any (contradicts nalt) pos)) @@ -748,12 +774,12 @@ addNotConCt nabla x nalt = do pure $ case mb_rcm' of -- If nalt could be removed from a COMPLETE set, we'll get back Just and -- have to mark x dirty, by returning Just x'. - Just rcm' -> (Just x', vi'{ vi_rcm = rcm' }) + Just rcm' -> (True, Just vi'{ vi_rcm = rcm' }) -- Otherwise, nalt didn't occur in any residual COMPLETE set and we -- don't have to mark it dirty. So we return Nothing, which in the case -- above would have compromised precision. -- See Note [Shortcutting the inhabitation test], grep for T17836. - Nothing -> (Nothing, vi') + Nothing -> (False, Just vi') hasRequiredTheta :: PmAltCon -> Bool hasRequiredTheta (PmAltConLike cl) = notNull req_theta @@ -769,7 +795,9 @@ hasRequiredTheta _ = False -- See Note [TmState invariants]. addConCt :: Nabla -> Id -> PmAltCon -> [TyVar] -> [Id] -> MaybeT DsM Nabla addConCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x alt tvs args = do - let vi@(VI _ pos neg bot _) = lookupVarInfo ts x + let (xid, env') = representId x env + -- ROMES:TODO: Also looks like a function on varinfo (adjust) + let vi@(VI _ pos neg bot _) = fromMaybe (emptyVarInfo x) $ lookupVarInfo (ts{ts_facts=env'}) x -- First try to refute with a negative fact guard (not (elemPmAltConSet alt neg)) -- Then see if any of the other solutions (remember: each of them is an @@ -788,7 +816,7 @@ addConCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x alt tvs args = Nothing -> do let pos' = PACA alt tvs args : pos let nabla_with bot' = - nabla{ nabla_tm_st = ts{ts_facts = addToUSDFM env x (vi{vi_pos = pos', vi_bot = bot'})} } + nabla{nabla_tm_st = ts{ts_facts = env' & _class xid ._data .~ (Just vi{vi_pos = pos', vi_bot = bot'})}} -- Do (2) in Note [Coverage checking Newtype matches] case (alt, args) of (PmAltConLike (RealDataCon dc), [y]) | isNewDataCon dc -> @@ -817,9 +845,12 @@ equateTys ts us = -- -- See Note [TmState invariants]. addVarCt :: Nabla -> Id -> Id -> MaybeT DsM Nabla +-- This is where equality-graphs really come into play. addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = - case equateUSDFM env x y of - (Nothing, env') -> pure (nabla{ nabla_tm_st = ts{ ts_facts = env' } }) + -- ROMES:TODO: equate auxiliary var that finds both vars, and lookups up the domain associated. However, I think we no longer should have Just/Nothing but rather always store emptyVarInfo for new e-nodes + -- equate should also update e-graph, basically re-implement "equateUSDFM" in terms of the e-graph, or inline it or so + case equate env x y of + (Nothing, env') -> pure $ nabla{nabla_tm_st=ts{ts_facts=env'}} -- We keep the VarInfo as Nothing -- Add the constraints we had for x to y (Just vi_x, env') -> do let nabla_equated = nabla{ nabla_tm_st = ts{ts_facts = env'} } @@ -829,6 +860,25 @@ addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = -- Do the same for negative info let add_neg nabla nalt = addNotConCt nabla y nalt foldlM add_neg nabla_pos (pmAltConSetElems (vi_neg vi_x)) + where + -- @equate env x y@ makes @x@ and @y@ point to the same entry, + -- thereby merging @x@'s class with @y@'s. + -- If both @x@ and @y@ are in the domain of the map, then @y@'s entry will be + -- chosen as the new entry and @x@'s old entry will be returned. + -- + -- Examples in terms of the model (see 'UniqSDFM'): + -- >>> equate [] u1 u2 == (Nothing, [({u1,u2}, Nothing)]) + -- >>> equate [({u1,u3}, Just ele1)] u3 u4 == (Nothing, [({u1,u3,u4}, Just ele1)]) + -- >>> equate [({u1,u3}, Just ele1)] u4 u3 == (Nothing, [({u1,u3,u4}, Just ele1)]) + -- >>> equate [({u1,u3}, Just ele1), ({u2}, Just ele2)] u3 u2 == (Just ele1, [({u2,u1,u3}, Just ele2)]) + equate :: TmEGraph -> Id -> Id -> (Maybe VarInfo, TmEGraph) + equate eg x y = do + let (xid, eg') = representId x eg + (yid, eg'') = representId y eg' + (_, eg''') = EG.merge xid yid eg'' + in (eg' ^. _class xid ._data, eg''') + -- Note: lookup in eg', because it's before the merge. + -- | Inspects a 'PmCoreCt' @let x = e@ by recording constraints for @x@ based -- on the shape of the 'CoreExpr' @e at . Examples: @@ -895,10 +945,12 @@ addCoreCt nabla x e = do -- semantically equivalent to @e@, in which case we may add the constraint -- @x ~ y at . equate_with_similar_expr :: Id -> CoreExpr -> StateT Nabla (MaybeT DsM) () - equate_with_similar_expr x e = do - rep <- StateT $ \nabla -> lift (representCoreExpr nabla e) + equate_with_similar_expr _x e = do + _ <- StateT $ \nabla -> pure (representCoreExpr nabla e) + pure () -- Note that @rep == x@ if we encountered @e@ for the first time. - modifyT (\nabla -> addVarCt nabla x rep) + -- ROMES:TODO: I don't think we need to do this anymore + -- modifyT (\nabla -> addVarCt nabla x rep) bind_expr :: CoreExpr -> StateT Nabla (MaybeT DsM) Id bind_expr e = do @@ -953,24 +1005,18 @@ modifyT f = StateT $ fmap ((,) ()) . f -- Which is the @x@ of a @let x = e'@ constraint (with @e@ semantically -- equivalent to @e'@) we encountered earlier, or a fresh identifier if -- there weren't any such constraints. -representCoreExpr :: Nabla -> CoreExpr -> DsM (Id, Nabla) -representCoreExpr nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_reps = reps } } e - | Just rep <- lookupCoreMap reps key = pure (rep, nabla) - | otherwise = do - rep <- mkPmId (exprType e) - let reps' = extendCoreMap reps key rep - let nabla' = nabla{ nabla_tm_st = ts{ ts_reps = reps' } } - pure (rep, nabla') - where - key = makeDictsCoherent e - -- Use a key in which dictionaries for the same type become equal. - -- See Note [Unique dictionaries in the TmOracle CoreMap] +representCoreExpr :: Nabla -> CoreExpr -> (ClassId, Nabla) +representCoreExpr nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = egraph } } e = + second (\g -> nabla{nabla_tm_st = ts{ts_facts = g}}) $ representDBCoreExpr (deBruijnize (makeDictsCoherent e)) egraph + -- Use a key in which dictionaries for the same type become equal. + -- See Note [Unique dictionaries in the TmOracle CoreMap] -- | Change out 'Id's which are uniquely determined by their type to a -- common value, so that different names for dictionaries of the same type -- are considered equal when building a 'CoreMap'. -- -- See Note [Unique dictionaries in the TmOracle CoreMap] +-- ROMES:TODO: I suppose this should be taken into account by the Eq instance of DeBruijnF CoreExprF -- if we do that there then we're sure that EG.represent takes that into account. makeDictsCoherent :: CoreExpr -> CoreExpr makeDictsCoherent var@(Var v) | let ty = idType v @@ -1059,6 +1105,7 @@ In the end, replacing dictionaries with an error value in the pattern-match checker was the most self-contained, although we might want to revisit once we implement a more robust approach to computing equality in the pattern-match checker (see #19272). +ROMES:TODO: I don't think e-graphs avoid this situation, because the names of the binders will still differ (although the Eq instance could take this into account?) -} {- Note [The Pos/Neg invariant] @@ -1271,22 +1318,24 @@ tyStateRefined :: TyState -> TyState -> Bool -- refinement of b or vice versa! tyStateRefined a b = ty_st_n a /= ty_st_n b -markDirty :: Id -> Nabla -> Nabla +markDirty :: ClassId -> Nabla -> Nabla markDirty x nabla at MkNabla{nabla_tm_st = ts at TmSt{ts_dirty = dirty} } = - nabla{ nabla_tm_st = ts{ ts_dirty = extendDVarSet dirty x } } + nabla{nabla_tm_st = ts{ ts_dirty = IS.insert x dirty }} -traverseDirty :: Monad m => (VarInfo -> m VarInfo) -> TmState -> m TmState +traverseDirty :: Monad m => (ClassId -> Maybe VarInfo -> m (Maybe VarInfo)) -> TmState -> m TmState traverseDirty f ts at TmSt{ts_facts = env, ts_dirty = dirty} = - go (uniqDSetToList dirty) env + + go (IS.elems dirty) env where go [] env = pure ts{ts_facts=env} - go (x:xs) !env = do - vi' <- f (lookupVarInfo ts x) - go xs (addToUSDFM env x vi') + go (x:xs) !_env = do + let vi = env ^._class x._data + vi' <- f x vi + go xs (env & _class x._data .~ vi') -- Use 'over' or so instead? -traverseAll :: Monad m => (VarInfo -> m VarInfo) -> TmState -> m TmState +traverseAll :: Monad m => (ClassId -> Maybe VarInfo -> m (Maybe VarInfo)) -> TmState -> m TmState traverseAll f ts at TmSt{ts_facts = env} = do - env' <- traverseUSDFM f env + env' <- (_iclasses.(\fab (i,cl) -> let mvi = fab (i,cl^._data) in (cl &) . (_data .~) <$> mvi)) (uncurry f) env pure ts{ts_facts = env'} -- | Makes sure the given 'Nabla' is still inhabited, by trying to instantiate @@ -1308,31 +1357,35 @@ inhabitationTest fuel old_ty_st nabla at MkNabla{ nabla_tm_st = ts } = {-# SCC "in ts' <- if tyStateRefined old_ty_st (nabla_ty_st nabla) then traverseAll test_one ts else traverseDirty test_one ts - pure nabla{ nabla_tm_st = ts'{ts_dirty=emptyDVarSet}} + pure nabla{ nabla_tm_st = ts'{ts_dirty=IS.empty}} where - nabla_not_dirty = nabla{ nabla_tm_st = ts{ts_dirty=emptyDVarSet} } - test_one :: VarInfo -> MaybeT DsM VarInfo - test_one vi = - lift (varNeedsTesting old_ty_st nabla vi) >>= \case + nabla_not_dirty = nabla{ nabla_tm_st = ts{ts_dirty=IS.empty} } + test_one :: ClassId -> Maybe VarInfo -> MaybeT DsM (Maybe VarInfo) + test_one _ Nothing = pure Nothing + test_one cid (Just vi) = + lift (varNeedsTesting old_ty_st nabla cid vi) >>= \case True -> do -- lift $ tracePm "test_one" (ppr vi) -- No solution yet and needs testing -- We have to test with a Nabla where all dirty bits are cleared - instantiate (fuel-1) nabla_not_dirty vi - _ -> pure vi + Just <$> instantiate (fuel-1) nabla_not_dirty vi + _ -> pure (Just vi) + +-- ROMES:TODO: The dirty shortcutting bit seems like the bookeeping on nodes to +-- upward merge, perhaps we can rid of it too -- | Checks whether the given 'VarInfo' needs to be tested for inhabitants. -- Returns `False` when we can skip the inhabitation test, presuming it would -- say "yes" anyway. See Note [Shortcutting the inhabitation test]. -varNeedsTesting :: TyState -> Nabla -> VarInfo -> DsM Bool -varNeedsTesting _ MkNabla{nabla_tm_st=tm_st} vi - | elemDVarSet (vi_id vi) (ts_dirty tm_st) = pure True -varNeedsTesting _ _ vi +varNeedsTesting :: TyState -> Nabla -> ClassId -> VarInfo -> DsM Bool +varNeedsTesting _ MkNabla{nabla_tm_st=tm_st} cid _ + | IS.member cid (ts_dirty tm_st) = pure True +varNeedsTesting _ _ _ vi | notNull (vi_pos vi) = pure False -varNeedsTesting old_ty_st MkNabla{nabla_ty_st=new_ty_st} _ +varNeedsTesting old_ty_st MkNabla{nabla_ty_st=new_ty_st} _ _ -- Same type state => still inhabited | not (tyStateRefined old_ty_st new_ty_st) = pure False -varNeedsTesting old_ty_st MkNabla{nabla_ty_st=new_ty_st} vi = do +varNeedsTesting old_ty_st MkNabla{nabla_ty_st=new_ty_st} _ vi = do -- These normalisations are relatively expensive, but still better than having -- to perform a full inhabitation test (_, _, old_norm_ty) <- tntrGuts <$> pmTopNormaliseType old_ty_st (idType $ vi_id vi) @@ -1360,19 +1413,20 @@ instBot _fuel nabla vi = {-# SCC "instBot" #-} do pure vi addNormalisedTypeMatches :: Nabla -> Id -> DsM (ResidualCompleteMatches, Nabla) -addNormalisedTypeMatches nabla at MkNabla{ nabla_ty_st = ty_st } x - = trvVarInfo add_matches nabla x +addNormalisedTypeMatches nabla at MkNabla{ nabla_ty_st = ty_st, nabla_tm_st = ts at TmSt{ts_facts=env} } x + | (xid,env') <- representId x env + = trvVarInfo (add_matches . fromMaybe (emptyVarInfo x)) nabla{nabla_tm_st=ts{ts_facts=env'}} xid where add_matches vi at VI{ vi_rcm = rcm } -- important common case, shaving down allocations of PmSeriesG by -5% - | isRcmInitialised rcm = pure (rcm, vi) + | isRcmInitialised rcm = pure (rcm, Just vi) add_matches vi at VI{ vi_rcm = rcm } = do norm_res_ty <- normaliseSourceTypeWHNF ty_st (idType x) env <- dsGetFamInstEnvs rcm' <- case splitReprTyConApp_maybe env norm_res_ty of Just (rep_tc, _args, _co) -> addTyConMatches rep_tc rcm Nothing -> addCompleteMatches rcm - pure (rcm', vi{ vi_rcm = rcm' }) + pure (rcm', Just vi{ vi_rcm = rcm' }) -- | Does a 'splitTyConApp_maybe' and then tries to look through a data family -- application to find the representation TyCon, to which the data constructors @@ -1393,7 +1447,7 @@ instCompleteSets fuel nabla vi = {-# SCC "instCompleteSets" #-} do let x = vi_id vi (rcm, nabla) <- lift (addNormalisedTypeMatches nabla x) nabla <- foldM (\nabla cls -> instCompleteSet fuel nabla x cls) nabla (getRcm rcm) - pure (lookupVarInfo (nabla_tm_st nabla) x) + pure (fromMaybe (emptyVarInfo x) (lookupVarInfo (nabla_tm_st nabla) x)) anyConLikeSolution :: (ConLike -> Bool) -> [PmAltConApp] -> Bool anyConLikeSolution p = any (go . paca_con) @@ -1422,7 +1476,7 @@ instCompleteSet fuel nabla x cs | otherwise = {-# SCC "instCompleteSet" #-} go nabla (sorted_candidates cs) where - vi = lookupVarInfo (nabla_tm_st nabla) x + vi = fromMaybe (emptyVarInfo x) $ lookupVarInfo (nabla_tm_st nabla) x sorted_candidates :: CompleteMatch -> [ConLike] sorted_candidates cm @@ -1909,9 +1963,9 @@ generateInhabitingPatterns :: GenerateInhabitingPatternsMode -> [Id] -> Int -> N -- See Note [Why inhabitationTest doesn't call generateInhabitingPatterns] generateInhabitingPatterns _ _ 0 _ = pure [] generateInhabitingPatterns _ [] _ nabla = pure [nabla] -generateInhabitingPatterns mode (x:xs) n nabla = do +generateInhabitingPatterns mode (x:xs) n nabla at MkNabla{nabla_tm_st=ts} = do tracePm "generateInhabitingPatterns" (ppr mode <+> ppr n <+> ppr (x:xs) $$ ppr nabla) - let VI _ pos neg _ _ = lookupVarInfo (nabla_tm_st nabla) x + let (VI _ pos neg _ _) = fromMaybe (emptyVarInfo x) $ lookupVarInfo ts x case pos of _:_ -> do -- Example for multiple solutions (must involve a PatSyn): @@ -1948,8 +2002,8 @@ generateInhabitingPatterns mode (x:xs) n nabla = do mb_stuff <- runMaybeT $ instantiate_newtype_chain x nabla dcs case mb_stuff of Nothing -> pure [] - Just (y, newty_nabla) -> do - let vi = lookupVarInfo (nabla_tm_st newty_nabla) y + Just (y, newty_nabla at MkNabla{nabla_tm_st=ts}) -> do + let vi = fromMaybe (emptyVarInfo y) $ lookupVarInfo ts y env <- dsGetFamInstEnvs rcm <- case splitReprTyConApp_maybe env rep_ty of Just (tc, _, _) -> addTyConMatches tc (vi_rcm vi) @@ -2082,3 +2136,10 @@ Note that for -XEmptyCase, we don't want to emit a minimal cover. We arrange that by passing 'CaseSplitTopLevel' to 'generateInhabitingPatterns'. We detect the -XEmptyCase case in 'reportWarnings' by looking for 'ReportEmptyCase'. -} + +-- | Update the value of the analysis data of some e-class by its id. +updateVarInfo :: Functor f => ClassId -> (a -> f a) -> EGraph a l -> f (EGraph a l) +-- Update the data at class @xid@ using lenses and the monadic action @go@ +updateVarInfo xid = _class xid . _data + +-- ROMES:TODO: When exactly to rebuild? ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -1,3 +1,7 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} @@ -10,12 +14,12 @@ module GHC.HsToCore.Pmc.Solver.Types ( -- * Normalised refinement types - BotInfo(..), PmAltConApp(..), VarInfo(..), TmState(..), TyState(..), + BotInfo(..), PmAltConApp(..), VarInfo(..), TmState(..), TmEGraph, TyState(..), Nabla(..), Nablas(..), initNablas, lookupRefuts, lookupSolution, -- ** Looking up 'VarInfo' - lookupVarInfo, lookupVarInfoNT, trvVarInfo, + lookupVarInfo, lookupVarInfoNT, trvVarInfo, emptyVarInfo, representId, -- ** Caching residual COMPLETE sets CompleteMatch, ResidualCompleteMatches(..), getRcm, isRcmInitialised, @@ -44,8 +48,8 @@ import GHC.Data.FastString import GHC.Types.Id import GHC.Types.Var.Set import GHC.Types.Unique.DSet -import GHC.Types.Unique.SDFM import GHC.Types.Name +import GHC.Core.Functor import GHC.Core.DataCon import GHC.Core.ConLike import GHC.Utils.Outputable @@ -59,6 +63,7 @@ import GHC.Types.Literal import GHC.Core import GHC.Core.TyCo.Compare( eqType ) import GHC.Core.Map.Expr +import GHC.Core.Map.Type import GHC.Core.Utils (exprType) import GHC.Builtin.Names import GHC.Builtin.Types @@ -75,6 +80,18 @@ import Data.Ratio import GHC.Real (Ratio(..)) import qualified Data.Semigroup as Semi +import Data.Functor.Const +import Data.Functor.Compose +import Data.Function ((&)) +import Data.Equality.Analysis (Analysis(..)) +import Data.Equality.Graph (EGraph, ClassId) +import Data.Equality.Utils (Fix(..)) +import Data.Equality.Graph.Lens +import qualified Data.Equality.Graph as EG +import Data.IntSet (IntSet) +import qualified Data.IntSet as IS (empty) +import Data.Bifunctor (second) + -- import GHC.Driver.Ppr -- @@ -131,25 +148,25 @@ instance Outputable TyState where initTyState :: TyState initTyState = TySt 0 emptyInert --- | The term oracle state. Stores 'VarInfo' for encountered 'Id's. These --- entries are possibly shared when we figure out that two variables must be --- equal, thus represent the same set of values. +-- | The term oracle state. Stores 'VarInfo' for encountered 'Id's and +-- 'CoreExpr's. These entries are possibly shared when we figure out that two +-- variables must be equal, thus represent the same set of values. -- -- See Note [TmState invariants] in "GHC.HsToCore.Pmc.Solver". data TmState = TmSt - { ts_facts :: !(UniqSDFM Id VarInfo) - -- ^ Facts about term variables. Deterministic env, so that we generate - -- deterministic error messages. - , ts_reps :: !(CoreMap Id) - -- ^ An environment for looking up whether we already encountered semantically - -- equivalent expressions that we want to represent by the same 'Id' - -- representative. - , ts_dirty :: !DIdSet + { ts_facts :: !TmEGraph + -- ^ Facts about terms. + + -- ROMES:TODO: ts_dirty looks a bit to me like the bookeeping needed to know + -- which nodes to upward merge, perhaps we can get rid of it too. + , ts_dirty :: !IntSet -- ^ Which 'VarInfo' needs to be checked for inhabitants because of new -- negative constraints (e.g. @x ≁ ⊥@ or @x ≁ K@). } +type TmEGraph = EGraph (Maybe VarInfo) (DeBruijnF CoreExprF) + -- | Information about an 'Id'. Stores positive ('vi_pos') facts, like @x ~ Just 42@, -- and negative ('vi_neg') facts, like "x is not (:)". -- Also caches the type ('vi_ty'), the 'ResidualCompleteMatches' of a COMPLETE set @@ -161,6 +178,8 @@ data VarInfo { vi_id :: !Id -- ^ The 'Id' in question. Important for adding new constraints relative to -- this 'VarInfo' when we don't easily have the 'Id' available. + -- ROMES:TODO: What is the Id in question when we might have multiple Ids in the same equivalence class? + -- It seems currenlty this is the representative of the e-class, so we could probably drop it, in favour of Type or so (since sometimes we need to know the type, and that's also reasonable data for the e-class to have) , vi_pos :: ![PmAltConApp] -- ^ Positive info: 'PmAltCon' apps it is (i.e. @x ~ [Just y, PatSyn z]@), all @@ -168,7 +187,7 @@ data VarInfo -- pattern matches involving pattern synonym -- case x of { Just y -> case x of PatSyn z -> ... } -- However, no more than one RealDataCon in the list, otherwise contradiction - -- because of generativity. + -- because of generativity (which would violate Invariant 1 from the paper). , vi_neg :: !PmAltConSet -- ^ Negative info: A list of 'PmAltCon's that it cannot match. @@ -202,6 +221,18 @@ data VarInfo -- to recognise completion of a COMPLETE set efficiently for large enums. } +-- | This instance is seriously wrong for general purpose, it's just required for instancing Analysis. +-- There ought to be a better way. +instance Eq VarInfo where + (==) _ _ = False +instance Analysis (Maybe VarInfo) (DeBruijnF CoreExprF) where + {-# INLINE makeA #-} + {-# INLINE joinA #-} + makeA _ = Nothing + -- romes: so currently, variables are joined in 'addVarCt' manually by getting the old value of $x$ and assuming the value of $y$ was chosen. + -- That's obviously bad now, it'd be much more clearer to do it here. It's just the nabla threading that's more trouble + joinA _a b = b + data PmAltConApp = PACA { paca_con :: !PmAltCon @@ -227,7 +258,7 @@ instance Outputable BotInfo where -- | Not user-facing. instance Outputable TmState where - ppr (TmSt state reps dirty) = ppr state $$ ppr reps $$ ppr dirty + ppr (TmSt _ dirty) = text "" $$ ppr dirty -- | Not user-facing. instance Outputable VarInfo where @@ -248,7 +279,7 @@ instance Outputable VarInfo where -- | Initial state of the term oracle. initTmState :: TmState -initTmState = TmSt emptyUSDFM emptyCoreMap emptyDVarSet +initTmState = TmSt EG.emptyEGraph IS.empty -- | A data type that caches for the 'VarInfo' of @x@ the results of querying -- 'dsGetCompleteMatches' and then striking out all occurrences of @K@ for @@ -300,9 +331,13 @@ emptyVarInfo x , vi_rcm = emptyRCM } -lookupVarInfo :: TmState -> Id -> VarInfo --- (lookupVarInfo tms x) tells what we know about 'x' -lookupVarInfo (TmSt env _ _) x = fromMaybe (emptyVarInfo x) (lookupUSDFM env x) +-- | @lookupVarInfo tms x@ tells what we know about 'x' +--- romes:TODO: This will have a different type. I don't know what yet. +-- romes:TODO I don't think this is what we want any longer, more like represent Id and see if it was previously represented by some data or not? +-- romes:TodO should return VarInfo rather than Maybe VarInfo +lookupVarInfo :: TmState -> Id -> Maybe VarInfo +lookupVarInfo (TmSt eg _) x + = let (xid, eg') = representId x eg in eg' ^._class xid._data -- | Like @lookupVarInfo ts x@, but @lookupVarInfo ts x = (y, vi)@ also looks -- through newtype constructors. We have @x ~ N1 (... (Nk y))@ such that the @@ -314,31 +349,35 @@ lookupVarInfo (TmSt env _ _) x = fromMaybe (emptyVarInfo x) (lookupUSDFM env x) -- modulo type normalisation! -- -- See also Note [Coverage checking Newtype matches] in GHC.HsToCore.Pmc.Solver. -lookupVarInfoNT :: TmState -> Id -> (Id, VarInfo) +lookupVarInfoNT :: TmState -> Id -> (Id, Maybe VarInfo) lookupVarInfoNT ts x = case lookupVarInfo ts x of - VI{ vi_pos = as_newtype -> Just y } -> lookupVarInfoNT ts y - res -> (x, res) + Just VI{ vi_pos = as_newtype -> Just y } -> lookupVarInfoNT ts y + res -> (x, res) where as_newtype = listToMaybe . mapMaybe go go PACA{paca_con = PmAltConLike (RealDataCon dc), paca_ids = [y]} | isNewDataCon dc = Just y go _ = Nothing -trvVarInfo :: Functor f => (VarInfo -> f (a, VarInfo)) -> Nabla -> Id -> f (a, Nabla) +-- romes: We could probably inline this +trvVarInfo :: forall f a. Functor f => (Maybe VarInfo -> f (a,Maybe VarInfo)) -> Nabla -> ClassId -> f (a,Nabla) trvVarInfo f nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts = env} } x - = set_vi <$> f (lookupVarInfo ts x) - where - set_vi (a, vi') = - (a, nabla{ nabla_tm_st = ts{ ts_facts = addToUSDFM env (vi_id vi') vi' } }) + = second (\g -> nabla{nabla_tm_st = ts{ts_facts=g}}) <$> updateAccum (_class x._data) f env + where + updateAccum :: forall f a s c. Functor f => Lens' s a -> (a -> f (c,a)) -> s -> f (c,s) + updateAccum lens g = getCompose . lens @(Compose f ((,) c)) (Compose . g) ------------------------------------------------ -- * Exported utility functions querying 'Nabla' +-- ROMES:TODO: Document +-- | Lookup the refutable patterns, i.e. the pattern alt cons that certainly can't happen?? +-- ROMES:TODO: ClassId? lookupRefuts :: Nabla -> Id -> [PmAltCon] -- Unfortunately we need the extra bit of polymorphism and the unfortunate -- duplication of lookupVarInfo here. lookupRefuts MkNabla{ nabla_tm_st = ts } x = - pmAltConSetElems $ vi_neg $ lookupVarInfo ts x + maybe [] (pmAltConSetElems . vi_neg) $ lookupVarInfo ts x isDataConSolution :: PmAltConApp -> Bool isDataConSolution PACA{paca_con = PmAltConLike (RealDataCon _)} = True @@ -347,11 +386,13 @@ isDataConSolution _ = False -- @lookupSolution nabla x@ picks a single solution ('vi_pos') of @x@ from -- possibly many, preferring 'RealDataCon' solutions whenever possible. lookupSolution :: Nabla -> Id -> Maybe PmAltConApp -lookupSolution nabla x = case vi_pos (lookupVarInfo (nabla_tm_st nabla) x) of - [] -> Nothing - pos@(x:_) - | Just sol <- find isDataConSolution pos -> Just sol - | otherwise -> Just x +lookupSolution nabla x = do + varinfo <- lookupVarInfo (nabla_tm_st nabla) x + case vi_pos varinfo of + [] -> Nothing + pos@(x:_) + | Just sol <- find isDataConSolution pos -> Just sol + | otherwise -> Just x -------------------------------------------------------------------------------- -- The rest is just providing an IR for (overloaded!) literals and AltCons that @@ -465,6 +506,7 @@ extendPmAltConSet (PACS cls lits) (PmAltConLike cl) extendPmAltConSet (PACS cls lits) (PmAltLit lit) = PACS cls (unionLists lits [lit]) +-- | The elements of a 'PmAltConSet' pmAltConSetElems :: PmAltConSet -> [PmAltCon] pmAltConSetElems (PACS cls lits) = map PmAltConLike (uniqDSetToList cls) ++ map PmAltLit lits @@ -797,3 +839,8 @@ instance Outputable PmAltCon where instance Outputable PmEquality where ppr = text . show + + +representId :: Id -> TmEGraph -> (ClassId, TmEGraph) +-- ROMES:TODO: bit of a hack to represent binders with `Var`, which is likely wrong (lambda bound vars might get equivalent to global ones?). Will need to justify this well +representId x = EG.add (EG.Node (deBruijnizeF (VarF x))) -- debruijn things are compared correctly wrt binders, but we can still have a debruijn var w name with no prob ===================================== compiler/GHC/Types/Unique/SDFM.hs ===================================== @@ -82,6 +82,7 @@ lookupUSDFM usdfm x = snd (lookupReprAndEntryUSDFM usdfm x) -- >>> equateUSDFM [({u1,u3}, Just ele1)] u3 u4 == (Nothing, [({u1,u3,u4}, Just ele1)]) -- >>> equateUSDFM [({u1,u3}, Just ele1)] u4 u3 == (Nothing, [({u1,u3,u4}, Just ele1)]) -- >>> equateUSDFM [({u1,u3}, Just ele1), ({u2}, Just ele2)] u3 u2 == (Just ele1, [({u2,u1,u3}, Just ele2)]) +-- ROMES:TODO: Are all USDFM functions just for the PMC Nabla TM? equateUSDFM :: Uniquable key => UniqSDFM key ele -> key -> key -> (Maybe ele, UniqSDFM key ele) equateUSDFM usdfm@(USDFM env) x y = ===================================== compiler/ghc.cabal.in ===================================== @@ -88,6 +88,7 @@ Library array >= 0.1 && < 0.6, filepath >= 1 && < 1.5, template-haskell == 2.20.*, + hegg, hpc == 0.6.*, transformers >= 0.5 && < 0.7, exceptions == 0.10.*, @@ -299,6 +300,7 @@ Library GHC.Core.ConLike GHC.Core.DataCon GHC.Core.FamInstEnv + GHC.Core.Functor GHC.Core.FVs GHC.Core.InstEnv GHC.Core.Lint ===================================== hadrian/src/Packages.hs ===================================== @@ -6,7 +6,7 @@ module Packages ( compareSizes, compiler, containers, deepseq, deriveConstants, directory, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, - hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, + hegg, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, touchy, transformers, unlit, unix, win32, xhtml, @@ -37,8 +37,8 @@ ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps , compareSizes, compiler, containers, deepseq, deriveConstants, directory , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh - , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs - , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl + , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline + , hegg, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml , timeout @@ -53,7 +53,7 @@ isGhcPackage = (`elem` ghcPackages) array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, - ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, + ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hegg, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml, @@ -93,6 +93,7 @@ ghcPkg = util "ghc-pkg" ghcPrim = lib "ghc-prim" haddock = util "haddock" haskeline = lib "haskeline" +hegg = lib "hegg" hsc2hs = util "hsc2hs" hp2ps = util "hp2ps" hpc = lib "hpc" ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -162,6 +162,7 @@ toolTargets = [ binary , ghci , ghcPkg -- # executable -- , haddock -- # depends on ghc library + , hegg , hsc2hs -- # executable , hpc , hpcBin -- # executable ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -89,6 +89,7 @@ stage0Packages = do , ghci , ghcPkg , haddock + , hegg , hsc2hs , hpc , hpcBin @@ -137,6 +138,7 @@ stage1Packages = do , ghcPkg , ghcPrim , haskeline + , hegg , hp2ps , hsc2hs , integerGmp ===================================== libraries/hegg ===================================== @@ -0,0 +1 @@ +Subproject commit d2862ab93d0420841aae3b8436f27301814d61a0 ===================================== packages ===================================== @@ -51,6 +51,7 @@ libraries/deepseq - - ssh://g libraries/directory - - ssh://git at github.com/haskell/directory.git libraries/filepath - - ssh://git at github.com/haskell/filepath.git libraries/haskeline - - https://github.com/judah/haskeline.git +libraries/hegg - - https://github.com/alt-romes/hegg.git libraries/hpc - - - libraries/mtl - - https://github.com/haskell/mtl.git libraries/parsec - - https://github.com/haskell/parsec.git View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/deb79e164b8c1af182123e4e66ccf12eaa9b848b...fb48c3487bc588e22b16838ebee9654719caf4bb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/deb79e164b8c1af182123e4e66ccf12eaa9b848b...fb48c3487bc588e22b16838ebee9654719caf4bb You're receiving 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 Jun 25 19:02:35 2023 From: gitlab at gitlab.haskell.org (Melanie Brown (@mixphix)) Date: Sun, 25 Jun 2023 15:02:35 -0400 Subject: [Git][ghc/ghc][wip/clc-86] Deprecate Data.List.NonEmpty.unzip Message-ID: <64988f4b916a5_64cc01f1a800123126@gitlab.mail> Melanie Brown pushed to branch wip/clc-86 at Glasgow Haskell Compiler / GHC Commits: aa934bd9 by Melanie Phoenix at 2023-06-25T15:02:31-04:00 Deprecate Data.List.NonEmpty.unzip - - - - - 6 changed files: - compiler/GHC/Data/Bag.hs - compiler/GHC/HsToCore/Match/Constructor.hs - hadrian/src/Rules/Dependencies.hs - libraries/base/Control/Monad/Zip.hs - libraries/base/Data/List/NonEmpty.hs - libraries/base/changelog.md Changes: ===================================== compiler/GHC/Data/Bag.hs ===================================== @@ -7,6 +7,7 @@ Bag: an unordered collection with duplicates -} {-# LANGUAGE ScopedTypeVariables, DeriveTraversable, TypeFamilies #-} +{-# OPTIONS_GHC -Wno-deprecations #-} module GHC.Data.Bag ( Bag, -- abstract type ===================================== compiler/GHC/HsToCore/Match/Constructor.hs ===================================== @@ -2,6 +2,7 @@ {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +{-# OPTIONS_GHC -Wno-deprecations #-} {- (c) The University of Glasgow 2006 ===================================== hadrian/src/Rules/Dependencies.hs ===================================== @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -Wno-deprecations #-} + module Rules.Dependencies (buildPackageDependencies) where import Data.Bifunctor ===================================== libraries/base/Control/Monad/Zip.hs ===================================== @@ -20,6 +20,7 @@ module Control.Monad.Zip where import Control.Monad (liftM, liftM2) import Data.Functor.Identity +import qualified Data.Functor import Data.Monoid import Data.Ord ( Down(..) ) import Data.Proxy @@ -65,7 +66,7 @@ instance MonadZip [] where instance MonadZip NE.NonEmpty where mzip = NE.zip mzipWith = NE.zipWith - munzip = NE.unzip + munzip = Data.Functor.unzip -- | @since 4.8.0.0 instance MonadZip Identity where ===================================== libraries/base/Data/List/NonEmpty.hs ===================================== @@ -472,6 +472,7 @@ zipWith f ~(x :| xs) ~(y :| ys) = f x y :| List.zipWith f xs ys -- | The 'unzip' function is the inverse of the 'zip' function. unzip :: Functor f => f (a,b) -> (f a, f b) unzip xs = (fst <$> xs, snd <$> xs) +{-# DEPRECATED unzip "This function will be made monomorphic in base-4.22, consider switching to Data.Functor.unzip" #-} -- | The 'nub' function removes duplicate elements from a list. In -- particular, it keeps only the first occurrence of each element. ===================================== libraries/base/changelog.md ===================================== @@ -33,6 +33,7 @@ * Implement `GHC.IORef.atomicSwapIORef` via a new dedicated primop `atomicSwapMutVar#` ([CLC proposal #139](https://github.com/haskell/core-libraries-committee/issues/139)) * Change codebuffers to use an unboxed implementation, while providing a compatibility layer using pattern synonyms. ([CLC proposal #134](https://github.com/haskell/core-libraries-committee/issues/134)) * Add nominal role annotations to SNat/SSymbol/SChar ([CLC proposal #170](https://github.com/haskell/core-libraries-committee/issues/170)) + * Deprecate `Data.List.NonEmpty.unzip` ([CLC proposal #86](https://github.com/haskell/core-libraries-committee/issues/86)) ## 4.18.0.0 *March 2023* * Shipped with GHC 9.6.1 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aa934bd958cb8addc84ba76566008b8a0712ecfb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/aa934bd958cb8addc84ba76566008b8a0712ecfb You're receiving 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 Jun 25 20:02:43 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Sun, 25 Jun 2023 16:02:43 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/testsuite-no-cusks-transitional Message-ID: <64989d6370260_64cc0c76c81272cf@gitlab.mail> Vladislav Zavialov pushed new branch wip/testsuite-no-cusks-transitional at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/testsuite-no-cusks-transitional You're receiving 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 Jun 25 20:15:27 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Sun, 25 Jun 2023 16:15:27 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] Core Equality module pretty much good to go Message-ID: <6498a05f4ad84_64cc0c77541312f@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: 4d72410f by Rodrigo Mesquita at 2023-06-25T21:15:15+01:00 Core Equality module pretty much good to go IPW - - - - - 3 changed files: - compiler/GHC/Core/Functor.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs Changes: ===================================== compiler/GHC/Core/Functor.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE MagicHash #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ViewPatterns #-} @@ -7,6 +8,7 @@ -- ROMES:TODO: Rename to Core.Equality or something module GHC.Core.Functor where +import GHC.Exts (dataToTag#, tagToEnum#, (>#), (<#)) import GHC.Prelude import GHC.Core @@ -24,8 +26,7 @@ import Data.Equality.Analysis import qualified Data.Equality.Graph.Monad as EGM import Data.Equality.Utils (Fix(..)) -import GHC.Utils.Misc (all2, equalLength) -import Data.Functor.Identity (Identity(..)) +import GHC.Utils.Misc (all2) -- Important to note the binders are also represented by $a$ -- This is because in the e-graph we will represent binders with the @@ -38,12 +39,12 @@ import Data.Functor.Identity (Identity(..)) data AltF b a = AltF AltCon [b] a - deriving (Functor, Foldable, Traversable, Eq, Ord) + deriving (Functor, Foldable, Traversable) data BindF b a = NonRecF b a | RecF [(b, a)] - deriving (Functor, Foldable, Traversable, Eq, Ord) + deriving (Functor, Foldable, Traversable) data ExprF b a = VarF Id @@ -61,16 +62,20 @@ data ExprF b a type CoreExprF = ExprF CoreBndr +type CoreAltF + = AltF CoreBndr +type CoreBindF + = BindF CoreBndr -instance Eq a => Eq (DeBruijnF CoreExprF a) where - (==) = eqDeBruijnExprF +newtype DeBruijnF f a = DF (DeBruijn (f a)) + deriving (Functor, Foldable, Traversable) -- ROMES:TODO: This instance is plain wrong. This DeBruijn scheme won't -- particularly work for our situation, we'll likely have to have ints instead -- of Id binders. Now, ignoring DeBruijn indices, we'll simply get this compile -- to get a rougher estimate of performance? -eqDeBruijnExprF :: forall a. Eq a => DeBruijnF CoreExprF a -> DeBruijnF CoreExprF a -> Bool -eqDeBruijnExprF (DF (D env1 e1)) (DF (D env2 e2)) = go e1 e2 where +eqDeBruijnExprF :: forall a. Eq a => DeBruijn (CoreExprF a) -> DeBruijn (CoreExprF a) -> Bool +eqDeBruijnExprF (D env1 e1) (D env2 e2) = go e1 e2 where go :: CoreExprF a -> CoreExprF a -> Bool go (VarF v1) (VarF v2) = eqDeBruijnVar (D env1 v1) (D env2 v2) go (LitF lit1) (LitF lit2) = lit1 == lit2 @@ -88,37 +93,30 @@ eqDeBruijnExprF (DF (D env1 e1)) (DF (D env2 e2)) = go e1 e2 where && D env1 (varMultMaybe b1) == D env2 (varMultMaybe b2) && e1 == e2 - go (LetF (NonRecF v1 r1) e1) (LetF (NonRecF v2 r2) e2) - = r1 == r2 -- See Note [Alpha-equality for let-bindings] - && e1 == e2 - - go (LetF (RecF ps1) e1) (LetF (RecF ps2) e2) - = - -- See Note [Alpha-equality for let-bindings] - all2 (\b1 b2 -> eqDeBruijnType (D env1 (varType b1)) - (D env2 (varType b2))) - bs1 bs2 - && rs1 == rs2 + go (LetF abs e1) (LetF bbs e2) + = D env1 abs == D env2 bbs && e1 == e2 - where - (bs1,rs1) = unzip ps1 - (bs2,rs2) = unzip ps2 - go (CaseF e1 b1 t1 a1) (CaseF e2 b2 t2 a2) + go (CaseF e1 _b1 t1 a1) (CaseF e2 _b2 t2 a2) | null a1 -- See Note [Empty case alternatives] = null a2 && e1 == e2 && D env1 t1 == D env2 t2 | otherwise - = e1 == e2 && a1 == a2 + = e1 == e2 && D env1 a1 == D env2 a2 go _ _ = False -instance Ord a => Ord (DeBruijnF CoreExprF a) where - compare a b = if a == b then EQ else LT --- deriving instance Ord a => Ord (DeBruijnF CoreExprF a) - -deriving instance Functor (DeBruijnF CoreExprF) -deriving instance Foldable (DeBruijnF CoreExprF) -deriving instance Traversable (DeBruijnF CoreExprF) +-- ROMES:TODO: This one can be derived automatically, but perhaps it's better +-- to be explicit here? We don't even really require the DeBruijn context here +eqDeBruijnAltF :: forall a. Eq a => DeBruijn (CoreAltF a) -> DeBruijn (CoreAltF a) -> Bool +eqDeBruijnAltF (D _env1 a1) (D _env2 a2) = go a1 a2 where + go (AltF DEFAULT _ rhs1) (AltF DEFAULT _ rhs2) + = rhs1 == rhs2 + go (AltF (LitAlt lit1) _ rhs1) (AltF (LitAlt lit2) _ rhs2) + = lit1 == lit2 && rhs1 == rhs2 + go (AltF (DataAlt dc1) _bs1 rhs1) (AltF (DataAlt dc2) _bs2 rhs2) + = dc1 == dc2 && + rhs1 == rhs2 -- the CM environments were extended on representation (see 'representDBAltExpr') + go _ _ = False -- | 'unsafeCoerce' mostly because I'm too lazy to write the boilerplate. fromCoreExpr :: CoreExpr -> Fix CoreExprF @@ -128,8 +126,9 @@ toCoreExpr :: CoreExpr -> Fix CoreExprF toCoreExpr = unsafeCoerce -- | Represents a DeBruijn CoreExpr being careful to correctly debruijnizie the expression as it is represented --- TODO: Use `Compose DeBruijn CoreExprF` instead +-- -- Always represent Ids, at least for now. We're seemingly using inexistent ids +-- ROMES:TODO: do this all inside EGraphM instead representDBCoreExpr :: Analysis a (DeBruijnF CoreExprF) => DeBruijn CoreExpr -> EGraph a (DeBruijnF CoreExprF) @@ -154,28 +153,205 @@ representDBCoreExpr (D cmenv expr) eg0 = case expr of Let (Rec (unzip -> (bs,rs))) e -> let cmenv' = extendCMEs cmenv bs (bsids, eg1) = EGM.runEGraphM eg0 $ - traverse (\r -> state $ representDBCoreExpr (D cmenv' r)) rs + traverse (state . representDBCoreExpr . D cmenv') rs (eid, eg2) = representDBCoreExpr (D cmenv' e) eg1 in add (Node $ DF (D cmenv (LetF (RecF (zip bs bsids)) eid))) eg2 Case e b t as -> let (eid, eg1) = representDBCoreExpr (D cmenv e) eg0 (as', eg2) = EGM.runEGraphM eg1 $ - traverse (\(Alt cons bs a) -> state $ \s -> let (aid, g) = representDBCoreExpr (D (extendCME cmenv b) a) s in (AltF cons bs aid, g)) as + traverse (state . representDBAltExpr . D (extendCME cmenv b)) as in add (Node $ DF (D cmenv (CaseF eid b t as'))) eg2 +representDBAltExpr :: Analysis a (DeBruijnF CoreExprF) + => DeBruijn CoreAlt + -> EGraph a (DeBruijnF CoreExprF) + -> (CoreAltF ClassId, EGraph a (DeBruijnF CoreExprF)) +representDBAltExpr (D cm (Alt cons bs a)) eg0 = + let (ai, eg1) = representDBCoreExpr (D (extendCMEs cm bs) a) eg0 + in (AltF cons bs ai, eg1) --- ROMES:TODO: Instead of DeBruijnF CoreExprF we should have (ExprF (Int,Id)) --- * A represent function that makes up the debruijn indices as it is representing the expressions --- * An Eq and Ord instance which ignore the Id and rather look at the DeBruijn index. --- --- TODO --- * For types, can we use eqDeBruijnType ? I think not, because Lambdas and Lets can bind type variables --- --- TODO: The Best Alternative: --- --- Each expression keeps its DeBruijnF CmEnv environment, but the represent --- function must correctly prepare the debruijn indices, so that each e-node --- has the debruijn indice it would have in its recursive descent in the Eq instance? --- --- TODO: We could even probably have Compose DeBruijn CoreExprF in that case! --- +instance Eq a => Eq (DeBruijn (CoreAltF a)) where + (==) = eqDeBruijnAltF + +instance Eq a => Eq (DeBruijn (CoreExprF a)) where + (==) = eqDeBruijnExprF + +instance Eq a => Eq (DeBruijnF CoreExprF a) where + (==) (DF a) (DF b) = eqDeBruijnExprF a b + +instance Eq a => Eq (DeBruijnF CoreAltF a) where + (==) (DF a) (DF b) = eqDeBruijnAltF a b + +deriving instance Ord a => Ord (DeBruijnF CoreExprF a) + +instance Ord a => Ord (DeBruijn (CoreExprF a)) where + -- We must assume that if `a` is DeBruijn expression, it is already correctly "extended" because 'representDBCoreExpr' ensures that. + -- RM:TODO: We don't yet compare the CmEnv at any point. Should we? + -- RM: I don't think so, the CmEnv is used to determine whether bound variables are equal, but they don't otherwise influence the result. + -- Or rather, if the subexpression with variables is equal, then the CmEnv is necessarily equal too? + -- So I think that just works... + -- Wait, in that sense, couldn't we find a way to derive ord? the important part being that to compare Types and Vars we must use the DeBruijn Env ... + compare a b + = case a of + D cma (VarF va) + -> case b of + D cmb (VarF vb) -> cmpDeBruijnVar (D cma va) (D cmb vb) + _ -> LT + D _ (LitF la) + -> case b of + D _ VarF{} -> GT + D _ (LitF lb) -> la `compare` lb + _ -> LT + D _ (AppF af aarg) + -> case dataToTag# b of + bt + -> if tagToEnum# (bt ># 2#) then + LT + else + case b of + D _ (AppF bf barg) + -> case compare af bf of + LT -> LT + EQ -> aarg `compare` barg -- e.g. here, if we had for children other expresssions debruijnized, they would have the *correct* environments, so we needn't worry. + -- the issue to automatically deriving is only really the 'Var' and 'Type' parameters ... + GT -> GT + _ -> GT + D _ (LamF _abind abody) + -> case dataToTag# b of + bt + -> if tagToEnum# (bt ># 3#) then + LT + else + case b of + D _ (LamF _bbind bbody) -- we can ignore the binder since the represented DB expression has the correct DB environments by construction (see 'representDBCoreExpr') + -> compare abody bbody + _ -> GT + D cma (LetF as abody) + -> case dataToTag# b of + bt + -> if tagToEnum# (bt ># 4#) then + LT + else + case b of + D cmb (LetF bs bbody) + -> case compare (D cma as) (D cmb bs) of + LT -> LT + EQ -> compare abody bbody + GT -> GT + _ -> GT + D cma (CaseF cax _cabind catype caalt) + -> case dataToTag# b of + bt + -> if tagToEnum# (bt <# 5#) then + GT + else + case b of + D cmb (CaseF cbx _cbbind cbtype cbalt) + -> case compare cax cbx of + LT -> LT + -- ROMES:TODO: Consider changing order of comparisons to a more efficient one + EQ -> case cmpDeBruijnType (D cma catype) (D cmb cbtype) of + LT -> LT + EQ -> D cma caalt `compare` D cmb cbalt + GT -> GT + GT -> GT + _ -> LT + D cma (CastF cax caco) + -> case dataToTag# b of + bt + -> if tagToEnum# (bt <# 6#) then + GT + else + case b of + D cmb (CastF cbx cbco) + -> case compare cax cbx of + LT -> LT + EQ -> cmpDeBruijnCoercion (D cma caco) (D cmb cbco) + GT -> GT + _ -> LT + D cma (TickF tatickish tax) + -> case dataToTag# b of + bt + -> if tagToEnum# (bt <# 7#) then + GT + else + case b of + D cmb (TickF tbtickish tbx) + -> case cmpDeBruijnTickish (D cma tatickish) (D cmb tbtickish) of + LT -> LT + EQ -> tax `compare` tbx + GT -> GT + _ -> LT + D cma (TypeF at) + -> case b of + D _ CoercionF{} -> LT + D cmb (TypeF bt) -> cmpDeBruijnType (D cma at) (D cmb bt) + _ -> GT + D cma (CoercionF aco) + -> case b of + D cmb (CoercionF bco) -> cmpDeBruijnCoercion (D cma aco) (D cmb bco) + _ -> GT + +instance Eq a => Eq (DeBruijn (CoreBindF a)) where + D cma a == D cmb b = go a b where + go (NonRecF _v1 r1) (NonRecF _v2 r2) + = r1 == r2 -- See Note [Alpha-equality for let-bindings] + + go (RecF ps1) (RecF ps2) + = + -- See Note [Alpha-equality for let-bindings] + all2 (\b1 b2 -> eqDeBruijnType (D cma (varType b1)) + (D cmb (varType b2))) + bs1 bs2 + && rs1 == rs2 + where + (bs1,rs1) = unzip ps1 + (bs2,rs2) = unzip ps2 + + go _ _ = False + + +instance Ord a => Ord (DeBruijn (CoreBindF a)) where + compare a b + = case a of + D _cma (NonRecF _ab ax) + -> case b of + D _cmb (NonRecF _bb bx) -- Again, we ignore the binders bc on representation they were accounted for correctly. + -> ax `compare` bx + _ -> LT + D _cma (RecF as) + -> case b of + D _cmb (RecF bs) -> compare (map snd as) (map snd bs) + _ -> GT + + +instance Ord a => Ord (DeBruijn (CoreAltF a)) where + compare a b + = case a of + D _cma (AltF ac _abs arhs) + -> case b of + D _cmb (AltF bc _bbs brhs) + -> case compare ac bc of + LT -> LT + EQ -> -- Again, we don't look at binders bc we assume on representation they were accounted for correctly. + arhs `compare` brhs + GT -> GT + +cmpDeBruijnTickish :: DeBruijn CoreTickish -> DeBruijn CoreTickish -> Ordering +cmpDeBruijnTickish (D env1 t1) (D env2 t2) = go t1 t2 where + go (Breakpoint lext lid lids) (Breakpoint rext rid rids) + = case compare lid rid of + LT -> LT + EQ -> case compare (D env1 lids) (D env2 rids) of + LT -> LT + EQ -> compare lext rext + GT -> GT + GT -> GT + go l r = compare l r + +-- ROMES:TODO: DEBRUIJN ORDERING ON TYPES!!! +cmpDeBruijnType :: DeBruijn Type -> DeBruijn Type -> Ordering +cmpDeBruijnType _ _ = EQ +-- ROMES:TODO: DEBRUIJN ORDERING ON COERCIONS!!! +cmpDeBruijnCoercion :: DeBruijn Coercion -> DeBruijn Coercion -> Ordering +cmpDeBruijnCoercion _ _ = EQ ===================================== compiler/GHC/Core/Map/Type.hs ===================================== @@ -22,7 +22,8 @@ module GHC.Core.Map.Type ( -- * Utilities for use by friends only TypeMapG, CoercionMapG, - DeBruijn(..), DeBruijnF(..), deBruijnize, deBruijnizeF, eqDeBruijnType, eqDeBruijnVar, + DeBruijn(..), deBruijnize, eqDeBruijnType, eqDeBruijnVar, + cmpDeBruijnVar, BndrMap, xtBndr, lkBndr, VarMap, xtVar, lkVar, lkDFreeVar, xtDFreeVar, @@ -283,6 +284,9 @@ eqDeBruijnType env_t1@(D env1 t1) env_t2@(D env2 t2) = instance Eq (DeBruijn Var) where (==) = eqDeBruijnVar +instance Ord (DeBruijn Var) where + compare = cmpDeBruijnVar + eqDeBruijnVar :: DeBruijn Var -> DeBruijn Var -> Bool eqDeBruijnVar (D env1 v1) (D env2 v2) = case (lookupCME env1 v1, lookupCME env2 v2) of @@ -290,6 +294,13 @@ eqDeBruijnVar (D env1 v1) (D env2 v2) = (Nothing, Nothing) -> v1 == v2 _ -> False +cmpDeBruijnVar :: DeBruijn Var -> DeBruijn Var -> Ordering +cmpDeBruijnVar (D env1 v1) (D env2 v2) = + case (lookupCME env1 v1, lookupCME env2 v2) of + (Just b1, Just b2) -> compare b1 b2 + (Nothing, Nothing) -> compare v1 v2 + (z,w) -> compare z w -- Compare Maybes on whether they're Just or Nothing + instance {-# OVERLAPPING #-} Outputable a => Outputable (TypeMapG a) where ppr m = text "TypeMap elts" <+> ppr (foldTM (:) m []) @@ -513,9 +524,7 @@ lookupCME (CME { cme_env = env }) v = lookupVarEnv env v -- export the constructor. Make a helper function if you find yourself -- needing it. data DeBruijn a = D CmEnv a - deriving (Functor,Foldable,Traversable) -- romes:TODO: For internal use only! - -newtype DeBruijnF f a = DF (DeBruijn (f a)) + deriving (Functor, Foldable, Traversable) -- romes:TODO: for internal use only! -- | Synthesizes a @DeBruijn a@ from an @a@, by assuming that there are no -- bound binders (an empty 'CmEnv'). This is usually what you want if there @@ -523,16 +532,21 @@ newtype DeBruijnF f a = DF (DeBruijn (f a)) deBruijnize :: a -> DeBruijn a deBruijnize = D emptyCME --- | Like 'deBruijnize' but synthesizes a @DeBruijnF f a@ from an @f a@ -deBruijnizeF :: Functor f => f a -> DeBruijnF f a -deBruijnizeF = DF . deBruijnize - instance Eq (DeBruijn a) => Eq (DeBruijn [a]) where D _ [] == D _ [] = True D env (x:xs) == D env' (x':xs') = D env x == D env' x' && D env xs == D env' xs' _ == _ = False +instance Ord (DeBruijn a) => Ord (DeBruijn [a]) where + D _ [] `compare` D _ [] = EQ + D env (x:xs) `compare` D env' (x':xs') = case D env x `compare` D env' x' of + LT -> LT + EQ -> D env xs `compare` D env' xs' + GT -> GT + D _ [] `compare` D _ (_:_) = LT + D _ (_:_) `compare` D _ [] = GT + instance Eq (DeBruijn a) => Eq (DeBruijn (Maybe a)) where D _ Nothing == D _ Nothing = True D env (Just x) == D env' (Just x') = D env x == D env' x' ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -46,7 +46,6 @@ import GHC.Prelude import GHC.Data.Bag import GHC.Data.FastString import GHC.Types.Id -import GHC.Types.Var.Set import GHC.Types.Unique.DSet import GHC.Types.Name import GHC.Core.Functor @@ -62,7 +61,6 @@ import GHC.Core.TyCon import GHC.Types.Literal import GHC.Core import GHC.Core.TyCo.Compare( eqType ) -import GHC.Core.Map.Expr import GHC.Core.Map.Type import GHC.Core.Utils (exprType) import GHC.Builtin.Names @@ -80,12 +78,9 @@ import Data.Ratio import GHC.Real (Ratio(..)) import qualified Data.Semigroup as Semi -import Data.Functor.Const import Data.Functor.Compose -import Data.Function ((&)) import Data.Equality.Analysis (Analysis(..)) import Data.Equality.Graph (EGraph, ClassId) -import Data.Equality.Utils (Fix(..)) import Data.Equality.Graph.Lens import qualified Data.Equality.Graph as EG import Data.IntSet (IntSet) @@ -843,4 +838,4 @@ instance Outputable PmEquality where representId :: Id -> TmEGraph -> (ClassId, TmEGraph) -- ROMES:TODO: bit of a hack to represent binders with `Var`, which is likely wrong (lambda bound vars might get equivalent to global ones?). Will need to justify this well -representId x = EG.add (EG.Node (deBruijnizeF (VarF x))) -- debruijn things are compared correctly wrt binders, but we can still have a debruijn var w name with no prob +representId x = EG.add (EG.Node (DF (deBruijnize (VarF x)))) -- debruijn things are compared correctly wrt binders, but we can still have a debruijn var w name with no prob View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4d72410fe0931fd1a94c8efcd3c8c8d52af2f396 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4d72410fe0931fd1a94c8efcd3c8c8d52af2f396 You're receiving 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 Jun 25 21:55:14 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Sun, 25 Jun 2023 17:55:14 -0400 Subject: [Git][ghc/ghc][wip/T23543] Fix typechecking of promoted empty lists Message-ID: <6498b7c23c075_64cc0c76c8134812@gitlab.mail> Ryan Scott pushed to branch wip/T23543 at Glasgow Haskell Compiler / GHC Commits: 005f5d34 by Ryan Scott at 2023-06-25T17:54:52-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - 7 changed files: - compiler/GHC/Tc/Gen/HsType.hs - testsuite/tests/ghci/scripts/T15898.stderr - testsuite/tests/ghci/scripts/T6018ghcifail.stderr - testsuite/tests/ghci/scripts/T7939.stdout - + testsuite/tests/typecheck/should_compile/T23543.hs - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_fail/T6018fail.stderr Changes: ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -1003,6 +1003,13 @@ But, we want to make sure that our pattern-matches are complete. So, we have a bunch of repetitive code just so that we get warnings if we're missing any patterns. +Note particularly (c.f. #23543): + +* `HsExplicitListTy` with an empty argument list is handled by + `tc_infer_hs_type`, because it can have a polymorphic kind + `forall k. k -> [k]`. +* `HsExplicitListTy` with a non-empty argument list is handled by `tc_hs_type`, + because it can only have a monomorphic kind. -} ------------------------------------------ @@ -1075,6 +1082,7 @@ tc_infer_hs_type _ (XHsType ty) tc_infer_hs_type _ (HsExplicitListTy _ _ tys) | null tys -- this is so that we can use visible kind application with '[] -- e.g ... '[] @Bool + -- See Note [Future-proofing the type checker] = return (mkTyConTy promotedNilDataCon, mkSpecForAllTys [alphaTyVar] $ mkListTy alphaTy) @@ -1253,6 +1261,12 @@ tc_hs_type mode rn_ty@(HsSumTy _ hs_tys) exp_kind --------- Promoted lists and tuples tc_hs_type mode rn_ty@(HsExplicitListTy _ _ tys) exp_kind + -- The '[] case is handled in tc_infer_hs_type. + -- See Note [Future-proofing the type checker]. + | null tys + = tc_infer_hs_type_ek mode rn_ty exp_kind + + | otherwise = do { tks <- mapM (tc_infer_lhs_type mode) tys ; (taus', kind) <- unifyKinds tys tks ; let ty = (foldr (mk_cons kind) (mk_nil kind) taus') ===================================== testsuite/tests/ghci/scripts/T15898.stderr ===================================== @@ -18,7 +18,7 @@ In an equation for ‘it’: it = undefined :: [(), ()] :6:14: error: [GHC-83865] - • Expected a type, but ‘'( '[], '[])’ has kind ‘([k0], [k1])’ + • Expected a type, but ‘'( '[], '[])’ has kind ‘([a0], [a1])’ • In an expression type signature: '( '[], '[]) In the expression: undefined :: '( '[], '[]) In an equation for ‘it’: it = undefined :: '( '[], '[]) ===================================== testsuite/tests/ghci/scripts/T6018ghcifail.stderr ===================================== @@ -41,18 +41,18 @@ :55:41: error: [GHC-05175] Type family equation violates the family's injectivity annotation. - Type/kind variable ‘k1’ + Type/kind variable ‘a1’ cannot be inferred from the right-hand side. In the type family equation: - PolyKindVarsF @{[k1]} @[k2] ('[] @k1) = '[] @k2 + PolyKindVarsF @{[a1]} @[a2] ('[] @a1) = '[] @a2 -- Defined at :55:41 :60:15: error: [GHC-05175] Type family equation violates the family's injectivity annotation. - Type/kind variable ‘k1’ + Type/kind variable ‘a1’ cannot be inferred from the right-hand side. In the type family equation: - PolyKindVars @[k1] @[k2] ('[] @k1) = '[] @k2 + PolyKindVars @[a1] @[a2] ('[] @a1) = '[] @a2 -- Defined at :60:15 :64:15: error: [GHC-05175] ===================================== testsuite/tests/ghci/scripts/T7939.stdout ===================================== @@ -19,12 +19,12 @@ type family H a where H False = True -- Defined at T7939.hs:15:1 H :: Bool -> Bool -type J :: forall {k}. [k] -> Bool -type family J a where +type J :: forall {a}. [a] -> Bool +type family J a1 where J '[] = False - forall k (h :: k) (t :: [k]). J (h : t) = True + forall a (h :: a) (t :: [a]). J (h : t) = True -- Defined at T7939.hs:18:1 -J :: [k] -> Bool +J :: [a] -> Bool type K :: forall {a}. [a] -> Maybe a type family K a1 where K '[] = Nothing ===================================== testsuite/tests/typecheck/should_compile/T23543.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +module T23543 where + +type N :: forall a. Maybe a +type N = ('Nothing :: forall a. Maybe a) + +type L :: forall a. [a] +type L = ('[] :: forall a. [a]) ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -880,3 +880,4 @@ test('T22560b', normal, compile, ['']) test('T22560c', normal, compile, ['']) test('T22560d', extra_files(['T22560d.hs']), ghci_script, ['T22560d.script']) test('T22560e', normal, compile, ['']) +test('T23543', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/T6018fail.stderr ===================================== @@ -52,18 +52,18 @@ T6018fail.hs:53:15: error: [GHC-05175] T6018fail.hs:61:10: error: [GHC-05175] Type family equation violates the family's injectivity annotation. - Type/kind variable ‘k1’ + Type/kind variable ‘a1’ cannot be inferred from the right-hand side. In the type family equation: - PolyKindVarsF @{[k1]} @[k2] ('[] @k1) = '[] @k2 + PolyKindVarsF @{[a1]} @[a2] ('[] @a1) = '[] @a2 -- Defined at T6018fail.hs:61:10 T6018fail.hs:64:15: error: [GHC-05175] Type family equation violates the family's injectivity annotation. - Type/kind variable ‘k1’ + Type/kind variable ‘a1’ cannot be inferred from the right-hand side. In the type family equation: - PolyKindVars @[k1] @[k2] ('[] @k1) = '[] @k2 + PolyKindVars @[a1] @[a2] ('[] @a1) = '[] @a2 -- Defined at T6018fail.hs:64:15 T6018fail.hs:68:15: error: [GHC-05175] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/005f5d348d60413541c078ca2932f3d7d8e2b9de -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/005f5d348d60413541c078ca2932f3d7d8e2b9de You're receiving 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 Jun 26 00:45:48 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Sun, 25 Jun 2023 20:45:48 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] 6 commits: Create Core.Equality module Message-ID: <6498dfbcaf6b5_64cc022056dc149550@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: ef3491ab by Rodrigo Mesquita at 2023-06-25T21:38:30+01:00 Create Core.Equality module This module defines CoreExprF -- the base functor of CoreExpr, and equality and ordering operations on the debruijnized CoreExprF. Furthermore, it provides a function to represent a CoreExpr in an e-graph. This is a requirement to represent, reason about equality, and manipulate CoreExprs in e-graphs. E-graphs are going to be used in the pattern match checker (#19272), and potentially for type family rewriting (#TODO) -- amongst other oportunities that are unlocked by having them available. - - - - - c10de2cb by Rodrigo Mesquita at 2023-06-25T21:54:59+01:00 Question - - - - - 4196be31 by Rodrigo Mesquita at 2023-06-26T00:45:49+01:00 Was going great until I started needing to thread ClassIds together with Ids. Ret-think this. - - - - - 0fb5b1d8 by Rodrigo Mesquita at 2023-06-26T01:18:46+01:00 A solution with more lookups - - - - - d7bb5a38 by Rodrigo Mesquita at 2023-06-26T01:33:26+01:00 Fixes to Pmc.Ppr module - - - - - fedc7282 by Rodrigo Mesquita at 2023-06-26T01:45:26+01:00 Wow, a lot (stage1) is working actually, without PMC errprs - - - - - 11 changed files: - + compiler/GHC/Core/Equality.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Ppr.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/Types/Unique/SDFM.hs - compiler/ghc.cabal.in Changes: ===================================== compiler/GHC/Core/Equality.hs ===================================== @@ -0,0 +1,351 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE FlexibleContexts #-} + +module GHC.Core.Equality where + +import GHC.Exts (dataToTag#, tagToEnum#, (>#), (<#)) +import GHC.Prelude + +import GHC.Core +import GHC.Core.TyCo.Rep +import GHC.Core.Map.Type +import GHC.Core.Map.Expr +import GHC.Types.Var +import GHC.Types.Literal +import GHC.Types.Tickish +import Unsafe.Coerce (unsafeCoerce) + +import Control.Monad.Trans.State.Strict (state) +import Data.Equality.Graph as EG +import Data.Equality.Analysis +import qualified Data.Equality.Graph.Monad as EGM +import Data.Equality.Utils (Fix(..)) + +import GHC.Utils.Misc (all2) + +-- Important to note the binders are also represented by $a$ +-- This is because in the e-graph we will represent binders with the +-- equivalence class id of things equivalent to it. +-- +-- Unfortunately type binders are still not correctly accounted for. +-- Perhaps it'd really be better to make DeBruijn work over these types + +data AltF b a + = AltF AltCon [b] a + deriving (Functor, Foldable, Traversable) + +data BindF b a + = NonRecF b a + | RecF [(b, a)] + deriving (Functor, Foldable, Traversable) + +data ExprF b a + = VarF Id + | LitF Literal + | AppF a a + | LamF b a + | LetF (BindF b a) a + | CaseF a b Type [AltF b a] + + | CastF a CoercionR + | TickF CoreTickish a + | TypeF Type + | CoercionF Coercion + deriving (Functor, Foldable, Traversable) + +type CoreExprF + = ExprF CoreBndr +type CoreAltF + = AltF CoreBndr +type CoreBindF + = BindF CoreBndr + +newtype DeBruijnF f a = DF (DeBruijn (f a)) + deriving (Functor, Foldable, Traversable) + +eqDeBruijnExprF :: forall a. Eq a => DeBruijn (CoreExprF a) -> DeBruijn (CoreExprF a) -> Bool +eqDeBruijnExprF (D env1 e1) (D env2 e2) = go e1 e2 where + go :: CoreExprF a -> CoreExprF a -> Bool + go (VarF v1) (VarF v2) = eqDeBruijnVar (D env1 v1) (D env2 v2) + go (LitF lit1) (LitF lit2) = lit1 == lit2 + go (TypeF t1) (TypeF t2) = eqDeBruijnType (D env1 t1) (D env2 t2) + -- See Note [Alpha-equality for Coercion arguments] + go (CoercionF {}) (CoercionF {}) = True + go (CastF e1 co1) (CastF e2 co2) = D env1 co1 == D env2 co2 && e1 == e2 + go (AppF f1 a1) (AppF f2 a2) = f1 == f2 && a1 == a2 + go (TickF n1 e1) (TickF n2 e2) + = eqDeBruijnTickish (D env1 n1) (D env2 n2) + && e1 == e2 + + go (LamF b1 e1) (LamF b2 e2) + = eqDeBruijnType (D env1 (varType b1)) (D env2 (varType b2)) + && D env1 (varMultMaybe b1) == D env2 (varMultMaybe b2) + && e1 == e2 + + go (LetF abs e1) (LetF bbs e2) + = D env1 abs == D env2 bbs + && e1 == e2 + + go (CaseF e1 _b1 t1 a1) (CaseF e2 _b2 t2 a2) + | null a1 -- See Note [Empty case alternatives] + = null a2 && e1 == e2 && D env1 t1 == D env2 t2 + | otherwise + = e1 == e2 && D env1 a1 == D env2 a2 + + go _ _ = False + +-- ROMES:TODO: This one can be derived automatically, but perhaps it's better +-- to be explicit here? We don't even really require the DeBruijn context here +eqDeBruijnAltF :: forall a. Eq a => DeBruijn (CoreAltF a) -> DeBruijn (CoreAltF a) -> Bool +eqDeBruijnAltF (D _env1 a1) (D _env2 a2) = go a1 a2 where + go (AltF DEFAULT _ rhs1) (AltF DEFAULT _ rhs2) + = rhs1 == rhs2 + go (AltF (LitAlt lit1) _ rhs1) (AltF (LitAlt lit2) _ rhs2) + = lit1 == lit2 && rhs1 == rhs2 + go (AltF (DataAlt dc1) _bs1 rhs1) (AltF (DataAlt dc2) _bs2 rhs2) + = dc1 == dc2 && + rhs1 == rhs2 -- the CM environments were extended on representation (see 'representDBAltExpr') + go _ _ = False + +-- | 'unsafeCoerce' mostly because I'm too lazy to write the boilerplate. +fromCoreExpr :: CoreExpr -> Fix CoreExprF +fromCoreExpr = unsafeCoerce + +toCoreExpr :: CoreExpr -> Fix CoreExprF +toCoreExpr = unsafeCoerce + +-- | Represents a DeBruijn CoreExpr being careful to correctly debruijnizie the expression as it is represented +-- +-- Always represent Ids, at least for now. We're seemingly using inexistent ids +-- ROMES:TODO: do this all inside EGraphM instead +representDBCoreExpr :: Analysis a (DeBruijnF CoreExprF) + => DeBruijn CoreExpr + -> EGraph a (DeBruijnF CoreExprF) + -> (ClassId, EGraph a (DeBruijnF CoreExprF)) +representDBCoreExpr (D cmenv expr) eg0 = case expr of + Var v -> add (Node $ DF (D cmenv (VarF v))) eg0 + Lit lit -> add (Node $ DF (D cmenv (LitF lit))) eg0 + Type t -> add (Node $ DF (D cmenv (TypeF t))) eg0 + Coercion c -> add (Node $ DF (D cmenv (CoercionF c))) eg0 + Cast e co -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 + in add (Node $ DF (D cmenv (CastF eid co))) eg1 + App f a -> let (fid,eg1) = representDBCoreExpr (D cmenv f) eg0 + (aid,eg2) = representDBCoreExpr (D cmenv a) eg1 + in add (Node $ DF (D cmenv (AppF fid aid))) eg2 + Tick n e -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 + in add (Node $ DF (D cmenv (TickF n eid))) eg1 + Lam b e -> let (eid,eg1) = representDBCoreExpr (D (extendCME cmenv b) e) eg0 + in add (Node $ DF (D cmenv (LamF b eid))) eg1 + Let (NonRec v r) e -> let (rid,eg1) = representDBCoreExpr (D cmenv r) eg0 + (eid,eg2) = representDBCoreExpr (D (extendCME cmenv v) e) eg1 + in add (Node $ DF (D cmenv (LetF (NonRecF v rid) eid))) eg2 + Let (Rec (unzip -> (bs,rs))) e -> + let cmenv' = extendCMEs cmenv bs + (bsids, eg1) = EGM.runEGraphM eg0 $ + traverse (state . representDBCoreExpr . D cmenv') rs + (eid, eg2) = representDBCoreExpr (D cmenv' e) eg1 + in add (Node $ DF (D cmenv (LetF (RecF (zip bs bsids)) eid))) eg2 + Case e b t as -> let (eid, eg1) = representDBCoreExpr (D cmenv e) eg0 + (as', eg2) = EGM.runEGraphM eg1 $ + traverse (state . representDBAltExpr . D (extendCME cmenv b)) as + in add (Node $ DF (D cmenv (CaseF eid b t as'))) eg2 + +representDBAltExpr :: Analysis a (DeBruijnF CoreExprF) + => DeBruijn CoreAlt + -> EGraph a (DeBruijnF CoreExprF) + -> (CoreAltF ClassId, EGraph a (DeBruijnF CoreExprF)) +representDBAltExpr (D cm (Alt cons bs a)) eg0 = + let (ai, eg1) = representDBCoreExpr (D (extendCMEs cm bs) a) eg0 + in (AltF cons bs ai, eg1) + +instance Eq a => Eq (DeBruijn (CoreAltF a)) where + (==) = eqDeBruijnAltF + +instance Eq a => Eq (DeBruijn (CoreExprF a)) where + (==) = eqDeBruijnExprF + +instance Eq a => Eq (DeBruijnF CoreExprF a) where + (==) (DF a) (DF b) = eqDeBruijnExprF a b + +instance Eq a => Eq (DeBruijnF CoreAltF a) where + (==) (DF a) (DF b) = eqDeBruijnAltF a b + +deriving instance Ord a => Ord (DeBruijnF CoreExprF a) + +instance Ord a => Ord (DeBruijn (CoreExprF a)) where + -- We must assume that if `a` is DeBruijn expression, it is already correctly "extended" because 'representDBCoreExpr' ensures that. + -- RM:TODO: We don't yet compare the CmEnv at any point. Should we? + -- RM: I don't think so, the CmEnv is used to determine whether bound variables are equal, but they don't otherwise influence the result. + -- Or rather, if the subexpression with variables is equal, then the CmEnv is necessarily equal too? + -- So I think that just works... + -- Wait, in that sense, couldn't we find a way to derive ord? the important part being that to compare Types and Vars we must use the DeBruijn Env ... + compare a b + = case a of + D cma (VarF va) + -> case b of + D cmb (VarF vb) -> cmpDeBruijnVar (D cma va) (D cmb vb) + _ -> LT + D _ (LitF la) + -> case b of + D _ VarF{} -> GT + D _ (LitF lb) -> la `compare` lb + _ -> LT + D _ (AppF af aarg) + -> case dataToTag# b of + bt + -> if tagToEnum# (bt ># 2#) then + LT + else + case b of + D _ (AppF bf barg) + -> case compare af bf of + LT -> LT + EQ -> aarg `compare` barg -- e.g. here, if we had for children other expresssions debruijnized, they would have the *correct* environments, so we needn't worry. + -- the issue to automatically deriving is only really the 'Var' and 'Type' parameters ... + GT -> GT + _ -> GT + D _ (LamF _abind abody) + -> case dataToTag# b of + bt + -> if tagToEnum# (bt ># 3#) then + LT + else + case b of + D _ (LamF _bbind bbody) -- we can ignore the binder since the represented DB expression has the correct DB environments by construction (see 'representDBCoreExpr') + -> compare abody bbody + _ -> GT + D cma (LetF as abody) + -> case dataToTag# b of + bt + -> if tagToEnum# (bt ># 4#) then + LT + else + case b of + D cmb (LetF bs bbody) + -> case compare (D cma as) (D cmb bs) of + LT -> LT + EQ -> compare abody bbody + GT -> GT + _ -> GT + D cma (CaseF cax _cabind catype caalt) + -> case dataToTag# b of + bt + -> if tagToEnum# (bt <# 5#) then + GT + else + case b of + D cmb (CaseF cbx _cbbind cbtype cbalt) + -> case compare cax cbx of + LT -> LT + -- ROMES:TODO: Consider changing order of comparisons to a more efficient one + EQ -> case cmpDeBruijnType (D cma catype) (D cmb cbtype) of + LT -> LT + EQ -> D cma caalt `compare` D cmb cbalt + GT -> GT + GT -> GT + _ -> LT + D cma (CastF cax caco) + -> case dataToTag# b of + bt + -> if tagToEnum# (bt <# 6#) then + GT + else + case b of + D cmb (CastF cbx cbco) + -> case compare cax cbx of + LT -> LT + EQ -> cmpDeBruijnCoercion (D cma caco) (D cmb cbco) + GT -> GT + _ -> LT + D cma (TickF tatickish tax) + -> case dataToTag# b of + bt + -> if tagToEnum# (bt <# 7#) then + GT + else + case b of + D cmb (TickF tbtickish tbx) + -> case cmpDeBruijnTickish (D cma tatickish) (D cmb tbtickish) of + LT -> LT + EQ -> tax `compare` tbx + GT -> GT + _ -> LT + D cma (TypeF at) + -> case b of + D _ CoercionF{} -> LT + D cmb (TypeF bt) -> cmpDeBruijnType (D cma at) (D cmb bt) + _ -> GT + D cma (CoercionF aco) + -> case b of + D cmb (CoercionF bco) -> cmpDeBruijnCoercion (D cma aco) (D cmb bco) + _ -> GT + +instance Eq a => Eq (DeBruijn (CoreBindF a)) where + D cma a == D cmb b = go a b where + go (NonRecF _v1 r1) (NonRecF _v2 r2) + = r1 == r2 -- See Note [Alpha-equality for let-bindings] + + go (RecF ps1) (RecF ps2) + = + -- See Note [Alpha-equality for let-bindings] + all2 (\b1 b2 -> eqDeBruijnType (D cma (varType b1)) + (D cmb (varType b2))) + bs1 bs2 + && rs1 == rs2 + where + (bs1,rs1) = unzip ps1 + (bs2,rs2) = unzip ps2 + + go _ _ = False + + +instance Ord a => Ord (DeBruijn (CoreBindF a)) where + compare a b + = case a of + D _cma (NonRecF _ab ax) + -> case b of + D _cmb (NonRecF _bb bx) -- Again, we ignore the binders bc on representation they were accounted for correctly. + -> ax `compare` bx + _ -> LT + D _cma (RecF as) + -> case b of + D _cmb (RecF bs) -> compare (map snd as) (map snd bs) + _ -> GT + + +instance Ord a => Ord (DeBruijn (CoreAltF a)) where + compare a b + = case a of + D _cma (AltF ac _abs arhs) + -> case b of + D _cmb (AltF bc _bbs brhs) + -> case compare ac bc of + LT -> LT + EQ -> -- Again, we don't look at binders bc we assume on representation they were accounted for correctly. + arhs `compare` brhs + GT -> GT + +cmpDeBruijnTickish :: DeBruijn CoreTickish -> DeBruijn CoreTickish -> Ordering +cmpDeBruijnTickish (D env1 t1) (D env2 t2) = go t1 t2 where + go (Breakpoint lext lid lids) (Breakpoint rext rid rids) + = case compare lid rid of + LT -> LT + EQ -> case compare (D env1 lids) (D env2 rids) of + LT -> LT + EQ -> compare lext rext + GT -> GT + GT -> GT + go l r = compare l r + +-- ROMES:TODO: DEBRUIJN ORDERING ON TYPES!!! +cmpDeBruijnType :: DeBruijn Type -> DeBruijn Type -> Ordering +cmpDeBruijnType _ _ = EQ + +-- ROMES:TODO: DEBRUIJN ORDERING ON COERCIONS!!! +cmpDeBruijnCoercion :: DeBruijn Coercion -> DeBruijn Coercion -> Ordering +cmpDeBruijnCoercion _ _ = EQ + ===================================== compiler/GHC/Core/Map/Expr.hs ===================================== @@ -18,6 +18,8 @@ module GHC.Core.Map.Expr ( CoreMap, emptyCoreMap, extendCoreMap, lookupCoreMap, foldCoreMap, -- * Alpha equality eqDeBruijnExpr, eqCoreExpr, + -- ** Exports for CoreExprF instances + eqDeBruijnTickish, eqDeBruijnVar, -- * 'TrieMap' class reexports TrieMap(..), insertTM, deleteTM, lkDFreeVar, xtDFreeVar, ===================================== compiler/GHC/Core/Map/Type.hs ===================================== @@ -6,6 +6,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DeriveTraversable #-} module GHC.Core.Map.Type ( -- * Re-export generic interface @@ -16,12 +17,13 @@ module GHC.Core.Map.Type ( LooseTypeMap, -- ** With explicit scoping CmEnv, lookupCME, extendTypeMapWithScope, lookupTypeMapWithScope, - mkDeBruijnContext, extendCME, extendCMEs, emptyCME, + mkDeBruijnContext, extendCME, extendCMEs, emptyCME, sizeCME, -- * Utilities for use by friends only TypeMapG, CoercionMapG, DeBruijn(..), deBruijnize, eqDeBruijnType, eqDeBruijnVar, + cmpDeBruijnVar, BndrMap, xtBndr, lkBndr, VarMap, xtVar, lkVar, lkDFreeVar, xtDFreeVar, @@ -282,6 +284,9 @@ eqDeBruijnType env_t1@(D env1 t1) env_t2@(D env2 t2) = instance Eq (DeBruijn Var) where (==) = eqDeBruijnVar +instance Ord (DeBruijn Var) where + compare = cmpDeBruijnVar + eqDeBruijnVar :: DeBruijn Var -> DeBruijn Var -> Bool eqDeBruijnVar (D env1 v1) (D env2 v2) = case (lookupCME env1 v1, lookupCME env2 v2) of @@ -289,6 +294,13 @@ eqDeBruijnVar (D env1 v1) (D env2 v2) = (Nothing, Nothing) -> v1 == v2 _ -> False +cmpDeBruijnVar :: DeBruijn Var -> DeBruijn Var -> Ordering +cmpDeBruijnVar (D env1 v1) (D env2 v2) = + case (lookupCME env1 v1, lookupCME env2 v2) of + (Just b1, Just b2) -> compare b1 b2 + (Nothing, Nothing) -> compare v1 v2 + (z,w) -> compare z w -- Compare Maybes on whether they're Just or Nothing + instance {-# OVERLAPPING #-} Outputable a => Outputable (TypeMapG a) where ppr m = text "TypeMap elts" <+> ppr (foldTM (:) m []) @@ -505,6 +517,10 @@ extendCMEs env vs = foldl' extendCME env vs lookupCME :: CmEnv -> Var -> Maybe BoundVar lookupCME (CME { cme_env = env }) v = lookupVarEnv env v +-- | \(O(1)\). Number of elements in the CmEnv. +sizeCME :: CmEnv -> Int +sizeCME CME{cme_next=next} = next + -- | @DeBruijn a@ represents @a@ modulo alpha-renaming. This is achieved -- by equipping the value with a 'CmEnv', which tracks an on-the-fly deBruijn -- numbering. This allows us to define an 'Eq' instance for @DeBruijn a@, even @@ -512,6 +528,7 @@ lookupCME (CME { cme_env = env }) v = lookupVarEnv env v -- export the constructor. Make a helper function if you find yourself -- needing it. data DeBruijn a = D CmEnv a + deriving (Functor, Foldable, Traversable) -- romes:TODO: for internal use only! -- | Synthesizes a @DeBruijn a@ from an @a@, by assuming that there are no -- bound binders (an empty 'CmEnv'). This is usually what you want if there @@ -525,6 +542,15 @@ instance Eq (DeBruijn a) => Eq (DeBruijn [a]) where D env xs == D env' xs' _ == _ = False +instance Ord (DeBruijn a) => Ord (DeBruijn [a]) where + D _ [] `compare` D _ [] = EQ + D env (x:xs) `compare` D env' (x':xs') = case D env x `compare` D env' x' of + LT -> LT + EQ -> D env xs `compare` D env' xs' + GT -> GT + D _ [] `compare` D _ (_:_) = LT + D _ (_:_) `compare` D _ [] = GT + instance Eq (DeBruijn a) => Eq (DeBruijn (Maybe a)) where D _ Nothing == D _ Nothing = True D env (Just x) == D env' (Just x') = D env x == D env' x' ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -393,7 +393,8 @@ getNFirstUncovered mode vars n (MkNablas nablas) = go n (bagToList nablas) go 0 _ = pure [] go _ [] = pure [] go n (nabla:nablas) = do - front <- generateInhabitingPatterns mode vars n nabla + let (vars', nabla') = representIds vars nabla -- they're already there, we're just getting the e-class ids back + front <- generateInhabitingPatterns mode vars' n nabla' back <- go (n - length front) nablas pure (front ++ back) ===================================== compiler/GHC/HsToCore/Pmc/Check.hs ===================================== @@ -106,6 +106,8 @@ checkGrd :: PmGrd -> CheckAction RedSets checkGrd grd = CA $ \inc -> case grd of -- let x = e: Refine with x ~ e PmLet x e -> do + -- romes: we could potentially do update the trees to use e-class ids here, + -- or in pmcMatches matched <- addPhiCtNablas inc (PhiCoreCt x e) tracePm "check:Let" (ppr x <+> char '=' <+> ppr e) pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched } @@ -182,7 +184,7 @@ checkEmptyCase pe@(PmEmptyCase { pe_var = var }) = CA $ \inc -> do unc <- addPhiCtNablas inc (PhiNotBotCt var) pure CheckResult { cr_ret = pe, cr_uncov = unc, cr_approx = mempty } -checkPatBind :: (PmPatBind Pre) -> CheckAction (PmPatBind Post) +checkPatBind :: PmPatBind Pre -> CheckAction (PmPatBind Post) checkPatBind = coerce checkGRHS {- Note [Checking EmptyCase] ===================================== compiler/GHC/HsToCore/Pmc/Desugar.hs ===================================== @@ -326,6 +326,8 @@ desugarEmptyCase :: Id -> DsM PmEmptyCase desugarEmptyCase var = pure PmEmptyCase { pe_var = var } -- | Desugar the non-empty 'Match'es of a 'MatchGroup'. +-- +-- Returns a desugared guard tree of guard expressions. desugarMatches :: [Id] -> NonEmpty (LMatch GhcTc (LHsExpr GhcTc)) -> DsM (PmMatchGroup Pre) desugarMatches vars matches = ===================================== compiler/GHC/HsToCore/Pmc/Ppr.hs ===================================== @@ -13,8 +13,6 @@ import GHC.Data.List.Infinite (Infinite (..)) import qualified GHC.Data.List.Infinite as Inf import GHC.Types.Basic import GHC.Types.Id -import GHC.Types.Var.Env -import GHC.Types.Unique.DFM import GHC.Core.ConLike import GHC.Core.DataCon import GHC.Builtin.Types @@ -27,6 +25,10 @@ import Data.List.NonEmpty (NonEmpty, nonEmpty, toList) import GHC.HsToCore.Pmc.Types +import Data.Equality.Graph (ClassId) +import Data.IntMap (IntMap) +import qualified Data.IntMap as IM + -- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its -- components and refutable shapes associated to any mentioned variables. -- @@ -42,16 +44,17 @@ import GHC.HsToCore.Pmc.Types -- additional elements are indicated by "...". pprUncovered :: Nabla -> [Id] -> SDoc pprUncovered nabla vas - | isNullUDFM refuts = fsep vec -- there are no refutations - | otherwise = hang (fsep vec) 4 $ - text "where" <+> vcat (map (pprRefutableShapes . snd) (udfmToList refuts)) + | IM.null refuts = fsep vec -- there are no refutations + | otherwise = hang (fsep vec) 4 $ + text "where" <+> vcat (map (pprRefutableShapes . snd) (IM.toList refuts)) where init_prec -- No outer parentheses when it's a unary pattern by assuming lowest -- precedence | [_] <- vas = topPrec | otherwise = appPrec - ppr_action = mapM (pprPmVar init_prec) vas + (vas',_nabla') = representIds vas nabla + ppr_action = mapM (pprPmVar init_prec) vas' (vec, renamings) = runPmPpr nabla ppr_action refuts = prettifyRefuts nabla renamings @@ -96,35 +99,37 @@ substitution to the vectors before printing them out (see function `pprOne' in -- | Extract and assigns pretty names to constraint variables with refutable -- shapes. -prettifyRefuts :: Nabla -> DIdEnv (Id, SDoc) -> DIdEnv (SDoc, [PmAltCon]) -prettifyRefuts nabla = listToUDFM_Directly . map attach_refuts . udfmToList +prettifyRefuts :: Nabla -> IntMap (ClassId, SDoc) -> IntMap (SDoc, [PmAltCon]) +prettifyRefuts nabla = IM.mapWithKey attach_refuts where - attach_refuts (u, (x, sdoc)) = (u, (sdoc, lookupRefuts nabla x)) + -- RM: why map with key? + attach_refuts :: ClassId -> (ClassId, SDoc) -> (SDoc, [PmAltCon]) + attach_refuts _u (x, sdoc) = (sdoc, lookupRefuts nabla x) -type PmPprM a = RWS Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) a +type PmPprM a = RWS Nabla () (IntMap (ClassId, SDoc), Infinite SDoc) a -- Try nice names p,q,r,s,t before using the (ugly) t_i nameList :: Infinite SDoc nameList = map text ["p","q","r","s","t"] Inf.++ flip Inf.unfoldr (0 :: Int) (\ u -> (text ('t':show u), u+1)) -runPmPpr :: Nabla -> PmPprM a -> (a, DIdEnv (Id, SDoc)) -runPmPpr nabla m = case runRWS m nabla (emptyDVarEnv, nameList) of +runPmPpr :: Nabla -> PmPprM a -> (a, IntMap (ClassId, SDoc)) +runPmPpr nabla m = case runRWS m nabla (IM.empty, nameList) of (a, (renamings, _), _) -> (a, renamings) -- | Allocates a new, clean name for the given 'Id' if it doesn't already have -- one. -getCleanName :: Id -> PmPprM SDoc +getCleanName :: ClassId -> PmPprM SDoc getCleanName x = do (renamings, name_supply) <- get let Inf clean_name name_supply' = name_supply - case lookupDVarEnv renamings x of + case IM.lookup x renamings of Just (_, nm) -> pure nm Nothing -> do - put (extendDVarEnv renamings x (x, clean_name), name_supply') + put (IM.insert x (x, clean_name) renamings, name_supply') pure clean_name -checkRefuts :: Id -> PmPprM (Maybe SDoc) -- the clean name if it has negative info attached +checkRefuts :: ClassId -> PmPprM (Maybe SDoc) -- the clean name if it has negative info attached checkRefuts x = do nabla <- ask case lookupRefuts nabla x of @@ -134,20 +139,20 @@ checkRefuts x = do -- | Pretty print a variable, but remember to prettify the names of the variables -- that refer to neg-literals. The ones that cannot be shown are printed as -- underscores. -pprPmVar :: PprPrec -> Id -> PmPprM SDoc +pprPmVar :: PprPrec -> ClassId -> PmPprM SDoc pprPmVar prec x = do nabla <- ask case lookupSolution nabla x of Just (PACA alt _tvs args) -> pprPmAltCon prec alt args Nothing -> fromMaybe underscore <$> checkRefuts x -pprPmAltCon :: PprPrec -> PmAltCon -> [Id] -> PmPprM SDoc +pprPmAltCon :: PprPrec -> PmAltCon -> [ClassId] -> PmPprM SDoc pprPmAltCon _prec (PmAltLit l) _ = pure (ppr l) pprPmAltCon prec (PmAltConLike cl) args = do nabla <- ask pprConLike nabla prec cl args -pprConLike :: Nabla -> PprPrec -> ConLike -> [Id] -> PmPprM SDoc +pprConLike :: Nabla -> PprPrec -> ConLike -> [ClassId] -> PmPprM SDoc pprConLike nabla _prec cl args | Just pm_expr_list <- pmExprAsList nabla (PmAltConLike cl) args = case pm_expr_list of @@ -174,8 +179,8 @@ pprConLike _nabla prec cl args -- | The result of 'pmExprAsList'. data PmExprList - = NilTerminated [Id] - | WcVarTerminated (NonEmpty Id) Id + = NilTerminated [ClassId] + | WcVarTerminated (NonEmpty ClassId) ClassId -- | Extract a list of 'Id's out of a sequence of cons cells, optionally -- terminated by a wildcard variable instead of @[]@. Some examples: @@ -186,7 +191,7 @@ data PmExprList -- ending in a wildcard variable x (of list type). Should be pretty-printed as -- (1:2:_). -- * @pmExprAsList [] == Just ('NilTerminated' [])@ -pmExprAsList :: Nabla -> PmAltCon -> [Id] -> Maybe PmExprList +pmExprAsList :: Nabla -> PmAltCon -> [ClassId] -> Maybe PmExprList pmExprAsList nabla = go_con [] where go_var rev_pref x ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -49,18 +49,17 @@ import GHC.Data.Bag import GHC.Types.CompleteMatch import GHC.Types.Unique.Set import GHC.Types.Unique.DSet -import GHC.Types.Unique.SDFM import GHC.Types.Id import GHC.Types.Name import GHC.Types.Var (EvVar) import GHC.Types.Var.Env -import GHC.Types.Var.Set import GHC.Types.Unique.Supply import GHC.Core import GHC.Core.FVs (exprFreeVars) import GHC.Core.TyCo.Compare( eqType ) -import GHC.Core.Map.Expr +import GHC.Core.Map.Type +import GHC.Core.Equality import GHC.Core.Predicate (typeDeterminesValue) import GHC.Core.SimpleOpt (simpleOptExpr, exprIsConApp_maybe) import GHC.Core.Utils (exprType) @@ -99,6 +98,15 @@ import Data.List (sortBy, find) import qualified Data.List.NonEmpty as NE import Data.Ord (comparing) +import Data.Equality.Graph (ClassId) +import Data.Equality.Graph.Lens +import qualified Data.Equality.Graph as EG +import Data.Bifunctor (second) +import Data.Function ((&)) +import qualified Data.IntSet as IS +import Data.Tuple (swap) +import Data.Traversable (mapAccumL) + -- -- * Main exports -- @@ -556,6 +564,9 @@ where you can find the solution in a perhaps more digestible format. -- | A high-level pattern-match constraint. Corresponds to φ from Figure 3 of -- the LYG paper. +-- ROMES:TODO: Ultimately, all these Ids could be replaced by e-class ids which +-- are generated during desugaring, but there are some details to it +-- (propagating the e-graphs in which these e-classes were created) data PhiCt = PhiTyCt !PredType -- ^ A type constraint "T ~ U". @@ -662,74 +673,83 @@ nameTyCt pred_ty = do -- 'addTyCts' before, through 'addPhiCts'. addPhiTmCt :: Nabla -> PhiCt -> MaybeT DsM Nabla addPhiTmCt _ (PhiTyCt ct) = pprPanic "addPhiCt:TyCt" (ppr ct) -- See the precondition -addPhiTmCt nabla (PhiCoreCt x e) = addCoreCt nabla x e +addPhiTmCt nabla (PhiCoreCt x e) = let (xid, nabla') = representId x nabla + in addCoreCt nabla' xid e addPhiTmCt nabla (PhiConCt x con tvs dicts args) = do -- Case (1) of Note [Strict fields and variables of unlifted type] -- PhiConCt correspond to the higher-level φ constraints from the paper with -- bindings semantics. It disperses into lower-level δ constraints that the -- 'add*Ct' functions correspond to. - nabla' <- addTyCts nabla (listToBag dicts) - nabla'' <- addConCt nabla' x con tvs args - foldlM addNotBotCt nabla'' (filterUnliftedFields con args) -addPhiTmCt nabla (PhiNotConCt x con) = addNotConCt nabla x con -addPhiTmCt nabla (PhiBotCt x) = addBotCt nabla x -addPhiTmCt nabla (PhiNotBotCt x) = addNotBotCt nabla x - -filterUnliftedFields :: PmAltCon -> [Id] -> [Id] + nabla1 <- addTyCts nabla (listToBag dicts) + let (xid, nabla2) = representId x nabla1 + let (args_ids, nabla3) = representIds args nabla2 + -- romes: here we could have something like (merge (add K arg_ids) x) + -- or actually that should be done by addConCt? + nabla4 <- addConCt nabla3 xid con tvs args_ids + foldlM addNotBotCt nabla4 (filterUnliftedFields con (zip args_ids args)) +addPhiTmCt nabla (PhiNotConCt x con) = let (xid, nabla') = representId x nabla + in addNotConCt nabla' xid con +addPhiTmCt nabla (PhiBotCt x) = let (xid, nabla') = representId x nabla + in addBotCt nabla' xid +addPhiTmCt nabla (PhiNotBotCt x) = let (xid, nabla') = representId x nabla + in addNotBotCt nabla' xid + +filterUnliftedFields :: PmAltCon -> [(ClassId,Id)] -> [ClassId] filterUnliftedFields con args = - [ arg | (arg, bang) <- zipEqual "addPhiCt" args (pmAltConImplBangs con) - , isBanged bang || definitelyUnliftedType (idType arg) ] + [ arg_id | ((arg_id,arg), bang) <- zipEqual "addPhiCt" args (pmAltConImplBangs con) + , isBanged bang || definitelyUnliftedType (idType arg) ] -- | Adds the constraint @x ~ ⊥@, e.g. that evaluation of a particular 'Id' @x@ -- surely diverges. Quite similar to 'addConCt', only that it only cares about -- ⊥. -addBotCt :: Nabla -> Id -> MaybeT DsM Nabla -addBotCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x = do - let (y, vi at VI { vi_bot = bot }) = lookupVarInfoNT (nabla_tm_st nabla) x - case bot of - IsNotBot -> mzero -- There was x ≁ ⊥. Contradiction! - IsBot -> pure nabla -- There already is x ~ ⊥. Nothing left to do - MaybeBot -- We add x ~ ⊥ - | definitelyUnliftedType (idType x) - -- Case (3) in Note [Strict fields and variables of unlifted type] - -> mzero -- unlifted vars can never be ⊥ - | otherwise - -> do - let vi' = vi{ vi_bot = IsBot } - pure nabla{ nabla_tm_st = ts{ts_facts = addToUSDFM env y vi' } } +addBotCt :: Nabla -> ClassId -> MaybeT DsM Nabla +addBotCt nabla x = updateVarInfo x go nabla + where + go :: VarInfo -> MaybeT DsM VarInfo + go vi at VI { vi_bot = bot } + = case bot of + IsNotBot -> mzero -- There was x ≁ ⊥. Contradiction! + IsBot -> return vi -- There already is x ~ ⊥. Nothing left to do + MaybeBot -- We add x ~ ⊥ + | definitelyUnliftedType (eclassType x nabla) + -- Case (3) in Note [Strict fields and variables of unlifted type] + -> mzero -- unlifted vars can never be ⊥ + | otherwise + -> do + return vi{ vi_bot = IsBot } -- | Adds the constraint @x ~/ ⊥@ to 'Nabla'. Quite similar to 'addNotConCt', -- but only cares for the ⊥ "constructor". -addNotBotCt :: Nabla -> Id -> MaybeT DsM Nabla +addNotBotCt :: Nabla -> ClassId -> MaybeT DsM Nabla addNotBotCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts=env} } x = do - let (y, vi at VI { vi_bot = bot }) = lookupVarInfoNT (nabla_tm_st nabla) x + let (yid, vi at VI { vi_bot = bot }) = lookupVarInfoNT ts x case bot of IsBot -> mzero -- There was x ~ ⊥. Contradiction! IsNotBot -> pure nabla -- There already is x ≁ ⊥. Nothing left to do MaybeBot -> do -- We add x ≁ ⊥ and test if x is still inhabited -- Mark dirty for a delayed inhabitation test let vi' = vi{ vi_bot = IsNotBot} - pure $ markDirty y - $ nabla{ nabla_tm_st = ts{ ts_facts = addToUSDFM env y vi' } } + pure $ markDirty yid + $ nabla{nabla_tm_st = ts{ ts_facts = env & _class yid . _data .~ vi'}} -- | Record a @x ~/ K@ constraint, e.g. that a particular 'Id' @x@ can't -- take the shape of a 'PmAltCon' @K@ in the 'Nabla' and return @Nothing@ if -- that leads to a contradiction. -- See Note [TmState invariants]. -addNotConCt :: Nabla -> Id -> PmAltCon -> MaybeT DsM Nabla +addNotConCt :: Nabla -> ClassId -> PmAltCon -> MaybeT DsM Nabla addNotConCt _ _ (PmAltConLike (RealDataCon dc)) | isNewDataCon dc = mzero -- (3) in Note [Coverage checking Newtype matches] addNotConCt nabla x nalt = do (mb_mark_dirty, nabla') <- trvVarInfo go nabla x pure $ case mb_mark_dirty of - Just x -> markDirty x nabla' - Nothing -> nabla' + True -> markDirty x nabla' + False -> nabla' where -- Update `x`'s 'VarInfo' entry. Fail ('MaybeT') if contradiction, -- otherwise return updated entry and `Just x'` if `x` should be marked dirty, -- where `x'` is the representative of `x`. - go :: VarInfo -> MaybeT DsM (Maybe Id, VarInfo) - go vi@(VI x' pos neg _ rcm) = do + go :: VarInfo -> MaybeT DsM (Bool, VarInfo) + go vi@(VI _x' pos neg _ rcm) = do -- 1. Bail out quickly when nalt contradicts a solution let contradicts nalt sol = eqPmAltCon (paca_con sol) nalt == Equal guard (not (any (contradicts nalt) pos)) @@ -748,12 +768,12 @@ addNotConCt nabla x nalt = do pure $ case mb_rcm' of -- If nalt could be removed from a COMPLETE set, we'll get back Just and -- have to mark x dirty, by returning Just x'. - Just rcm' -> (Just x', vi'{ vi_rcm = rcm' }) + Just rcm' -> (True, vi'{ vi_rcm = rcm' }) -- Otherwise, nalt didn't occur in any residual COMPLETE set and we -- don't have to mark it dirty. So we return Nothing, which in the case -- above would have compromised precision. -- See Note [Shortcutting the inhabitation test], grep for T17836. - Nothing -> (Nothing, vi') + Nothing -> (False, vi') hasRequiredTheta :: PmAltCon -> Bool hasRequiredTheta (PmAltConLike cl) = notNull req_theta @@ -767,8 +787,9 @@ hasRequiredTheta _ = False -- have on @x@, reject (@Nothing@) otherwise. -- -- See Note [TmState invariants]. -addConCt :: Nabla -> Id -> PmAltCon -> [TyVar] -> [Id] -> MaybeT DsM Nabla -addConCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x alt tvs args = do +addConCt :: Nabla -> ClassId -> PmAltCon -> [TyVar] -> [ClassId] -> MaybeT DsM Nabla +addConCt nabla at MkNabla{ nabla_tm_st = ts } x alt tvs args = do + -- ROMES:TODO: Also looks like a function on varinfo (adjust) let vi@(VI _ pos neg bot _) = lookupVarInfo ts x -- First try to refute with a negative fact guard (not (elemPmAltConSet alt neg)) @@ -788,7 +809,7 @@ addConCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x alt tvs args = Nothing -> do let pos' = PACA alt tvs args : pos let nabla_with bot' = - nabla{ nabla_tm_st = ts{ts_facts = addToUSDFM env x (vi{vi_pos = pos', vi_bot = bot'})} } + nabla{nabla_tm_st = ts{ts_facts = ts_facts ts & _class x ._data .~ vi{vi_pos = pos', vi_bot = bot'}}} -- Do (2) in Note [Coverage checking Newtype matches] case (alt, args) of (PmAltConLike (RealDataCon dc), [y]) | isNewDataCon dc -> @@ -816,12 +837,15 @@ equateTys ts us = -- @nabla@ has integrated the knowledge from the equality constraint. -- -- See Note [TmState invariants]. -addVarCt :: Nabla -> Id -> Id -> MaybeT DsM Nabla +addVarCt :: Nabla -> ClassId -> ClassId -> MaybeT DsM Nabla +-- This is where equality-graphs really come into play. addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = - case equateUSDFM env x y of - (Nothing, env') -> pure (nabla{ nabla_tm_st = ts{ ts_facts = env' } }) + -- ROMES:TODO: equate auxiliary var that finds both vars, and lookups up the domain associated. However, I think we no longer should have Just/Nothing but rather always store emptyVarInfo for new e-nodes + -- equate should also update e-graph, basically re-implement "equateUSDFM" in terms of the e-graph, or inline it or so + case equate env x y of -- Add the constraints we had for x to y - (Just vi_x, env') -> do + -- See Note [Joining e-classes PMC] todo mention from joinA + (vi_x, env') -> do let nabla_equated = nabla{ nabla_tm_st = ts{ts_facts = env'} } -- and then gradually merge every positive fact we have on x into y let add_pos nabla (PACA cl tvs args) = addConCt nabla y cl tvs args @@ -829,6 +853,22 @@ addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = -- Do the same for negative info let add_neg nabla nalt = addNotConCt nabla y nalt foldlM add_neg nabla_pos (pmAltConSetElems (vi_neg vi_x)) + where + -- @equate env x y@ makes @x@ and @y@ point to the same entry, + -- thereby merging @x@'s class with @y@'s. + -- If both @x@ and @y@ are in the domain of the map, then @y@'s entry will be + -- chosen as the new entry and @x@'s old entry will be returned. + -- + -- Examples in terms of the model (see 'UniqSDFM'): + -- >>> equate [] u1 u2 == (Nothing, [({u1,u2}, Nothing)]) + -- >>> equate [({u1,u3}, Just ele1)] u3 u4 == (Nothing, [({u1,u3,u4}, Just ele1)]) + -- >>> equate [({u1,u3}, Just ele1)] u4 u3 == (Nothing, [({u1,u3,u4}, Just ele1)]) + -- >>> equate [({u1,u3}, Just ele1), ({u2}, Just ele2)] u3 u2 == (Just ele1, [({u2,u1,u3}, Just ele2)]) + equate :: TmEGraph -> ClassId -> ClassId -> (VarInfo, TmEGraph) + equate eg x y = let (_, eg') = EG.merge x y eg + in (eg ^. _class x ._data, eg') + -- Note: lookup in @eg@, not @eg'@, because it's before the merge. + -- | Inspects a 'PmCoreCt' @let x = e@ by recording constraints for @x@ based -- on the shape of the 'CoreExpr' @e at . Examples: @@ -842,7 +882,7 @@ addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = -- for other literals. See 'coreExprAsPmLit'. -- * Finally, if we have @let x = e@ and we already have seen @let y = e@, we -- want to record @x ~ y at . -addCoreCt :: Nabla -> Id -> CoreExpr -> MaybeT DsM Nabla +addCoreCt :: Nabla -> ClassId -> CoreExpr -> MaybeT DsM Nabla addCoreCt nabla x e = do simpl_opts <- initSimpleOpts <$> getDynFlags let e' = simpleOptExpr simpl_opts e @@ -851,8 +891,9 @@ addCoreCt nabla x e = do where -- Takes apart a 'CoreExpr' and tries to extract as much information about -- literals and constructor applications as possible. - core_expr :: Id -> CoreExpr -> StateT Nabla (MaybeT DsM) () + core_expr :: ClassId -> CoreExpr -> StateT Nabla (MaybeT DsM) () -- TODO: Handle newtypes properly, by wrapping the expression in a DataCon + -- RM: Could this be done better with e-graphs? The whole newtype stuff -- This is the right thing for casts involving data family instances and -- their representation TyCon, though (which are not visible in source -- syntax). See Note [COMPLETE sets on data families] @@ -874,9 +915,10 @@ addCoreCt nabla x e = do <- exprIsConApp_maybe in_scope_env e = data_con_app x in_scope dc args -- See Note [Detecting pattern synonym applications in expressions] - | Var y <- e, Nothing <- isDataConId_maybe x + | Var y <- e, Nothing <- isDataConId_maybe (eclassMatchId x nabla) -- RM:TODO: can we lookup in this nabla or should we get the one from the StateT somehow? -- We don't consider DataCons flexible variables - = modifyT (\nabla -> addVarCt nabla x y) + = modifyT (\nabla -> let (yid, nabla') = representId y nabla + in addVarCt nabla' x yid) | otherwise -- Any other expression. Try to find other uses of a semantically -- equivalent expression and represent them by the same variable! @@ -894,17 +936,21 @@ addCoreCt nabla x e = do -- see if we already encountered a constraint @let y = e'@ with @e'@ -- semantically equivalent to @e@, in which case we may add the constraint -- @x ~ y at . - equate_with_similar_expr :: Id -> CoreExpr -> StateT Nabla (MaybeT DsM) () - equate_with_similar_expr x e = do - rep <- StateT $ \nabla -> lift (representCoreExpr nabla e) + equate_with_similar_expr :: ClassId -> CoreExpr -> StateT Nabla (MaybeT DsM) () + equate_with_similar_expr _x e = do + rep <- StateT $ \nabla -> pure (representCoreExpr nabla e) -- Note that @rep == x@ if we encountered @e@ for the first time. + + -- ROMES:TODO: I don't think we need to do the following anymore, represent should directly do so in the right e-class (if rebuilt) modifyT (\nabla -> addVarCt nabla x rep) + -- ROMES:TODO: When to rebuild? - bind_expr :: CoreExpr -> StateT Nabla (MaybeT DsM) Id + bind_expr :: CoreExpr -> StateT Nabla (MaybeT DsM) ClassId bind_expr e = do x <- lift (lift (mkPmId (exprType e))) - core_expr x e - pure x + xid <- StateT $ \nabla -> pure $ representId x nabla + core_expr xid e + pure xid -- Look at @let x = K taus theta es@ and generate the following -- constraints (assuming universals were dropped from @taus@ before): @@ -913,7 +959,7 @@ addCoreCt nabla x e = do -- 3. @y_1 ~ e_1, ..., y_m ~ e_m@ for fresh @y_i@ -- 4. @x ~ K as ys@ -- This is quite similar to PmCheck.pmConCts. - data_con_app :: Id -> InScopeSet -> DataCon -> [CoreExpr] -> StateT Nabla (MaybeT DsM) () + data_con_app :: ClassId -> InScopeSet -> DataCon -> [CoreExpr] -> StateT Nabla (MaybeT DsM) () data_con_app x in_scope dc args = do let dc_ex_tvs = dataConExTyCoVars dc arty = dataConSourceArity dc @@ -936,13 +982,13 @@ addCoreCt nabla x e = do -- Adds a literal constraint, i.e. @x ~ 42 at . -- Also we assume that literal expressions won't diverge, so this -- will add a @x ~/ ⊥@ constraint. - pm_lit :: Id -> PmLit -> StateT Nabla (MaybeT DsM) () + pm_lit :: ClassId -> PmLit -> StateT Nabla (MaybeT DsM) () pm_lit x lit = do modifyT $ \nabla -> addNotBotCt nabla x pm_alt_con_app x (PmAltLit lit) [] [] -- Adds the given constructor application as a solution for @x at . - pm_alt_con_app :: Id -> PmAltCon -> [TyVar] -> [Id] -> StateT Nabla (MaybeT DsM) () + pm_alt_con_app :: ClassId -> PmAltCon -> [TyVar] -> [ClassId] -> StateT Nabla (MaybeT DsM) () pm_alt_con_app x con tvs args = modifyT $ \nabla -> addConCt nabla x con tvs args -- | Like 'modify', but with an effectful modifier action @@ -953,24 +999,18 @@ modifyT f = StateT $ fmap ((,) ()) . f -- Which is the @x@ of a @let x = e'@ constraint (with @e@ semantically -- equivalent to @e'@) we encountered earlier, or a fresh identifier if -- there weren't any such constraints. -representCoreExpr :: Nabla -> CoreExpr -> DsM (Id, Nabla) -representCoreExpr nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_reps = reps } } e - | Just rep <- lookupCoreMap reps key = pure (rep, nabla) - | otherwise = do - rep <- mkPmId (exprType e) - let reps' = extendCoreMap reps key rep - let nabla' = nabla{ nabla_tm_st = ts{ ts_reps = reps' } } - pure (rep, nabla') - where - key = makeDictsCoherent e - -- Use a key in which dictionaries for the same type become equal. - -- See Note [Unique dictionaries in the TmOracle CoreMap] +representCoreExpr :: Nabla -> CoreExpr -> (ClassId, Nabla) +representCoreExpr nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = egraph } } e = + second (\g -> nabla{nabla_tm_st = ts{ts_facts = g}}) $ representDBCoreExpr (deBruijnize (makeDictsCoherent e)) egraph + -- Use a key in which dictionaries for the same type become equal. + -- See Note [Unique dictionaries in the TmOracle CoreMap] -- | Change out 'Id's which are uniquely determined by their type to a -- common value, so that different names for dictionaries of the same type -- are considered equal when building a 'CoreMap'. -- -- See Note [Unique dictionaries in the TmOracle CoreMap] +-- ROMES:TODO: I suppose this should be taken into account by the Eq instance of DeBruijnF CoreExprF -- if we do that there then we're sure that EG.represent takes that into account. makeDictsCoherent :: CoreExpr -> CoreExpr makeDictsCoherent var@(Var v) | let ty = idType v @@ -1059,6 +1099,7 @@ In the end, replacing dictionaries with an error value in the pattern-match checker was the most self-contained, although we might want to revisit once we implement a more robust approach to computing equality in the pattern-match checker (see #19272). +ROMES:TODO: I don't think e-graphs avoid this situation, because the names of the binders will still differ (although the Eq instance could take this into account?) -} {- Note [The Pos/Neg invariant] @@ -1271,22 +1312,24 @@ tyStateRefined :: TyState -> TyState -> Bool -- refinement of b or vice versa! tyStateRefined a b = ty_st_n a /= ty_st_n b -markDirty :: Id -> Nabla -> Nabla +markDirty :: ClassId -> Nabla -> Nabla markDirty x nabla at MkNabla{nabla_tm_st = ts at TmSt{ts_dirty = dirty} } = - nabla{ nabla_tm_st = ts{ ts_dirty = extendDVarSet dirty x } } + nabla{nabla_tm_st = ts{ ts_dirty = IS.insert x dirty }} -traverseDirty :: Monad m => (VarInfo -> m VarInfo) -> TmState -> m TmState +traverseDirty :: Monad m => (ClassId -> VarInfo -> m VarInfo) -> TmState -> m TmState traverseDirty f ts at TmSt{ts_facts = env, ts_dirty = dirty} = - go (uniqDSetToList dirty) env + + go (IS.elems dirty) env where go [] env = pure ts{ts_facts=env} - go (x:xs) !env = do - vi' <- f (lookupVarInfo ts x) - go xs (addToUSDFM env x vi') + go (x:xs) !_env = do + let vi = env ^._class x._data + vi' <- f x vi + go xs (env & _class x._data .~ vi') -- Use 'over' or so instead? -traverseAll :: Monad m => (VarInfo -> m VarInfo) -> TmState -> m TmState +traverseAll :: Monad m => (ClassId -> VarInfo -> m VarInfo) -> TmState -> m TmState traverseAll f ts at TmSt{ts_facts = env} = do - env' <- traverseUSDFM f env + env' <- (_iclasses.(\fab (i,cl) -> let mvi = fab (i,cl^._data) in (cl &) . (_data .~) <$> mvi)) (uncurry f) env pure ts{ts_facts = env'} -- | Makes sure the given 'Nabla' is still inhabited, by trying to instantiate @@ -1308,31 +1351,34 @@ inhabitationTest fuel old_ty_st nabla at MkNabla{ nabla_tm_st = ts } = {-# SCC "in ts' <- if tyStateRefined old_ty_st (nabla_ty_st nabla) then traverseAll test_one ts else traverseDirty test_one ts - pure nabla{ nabla_tm_st = ts'{ts_dirty=emptyDVarSet}} + pure nabla{ nabla_tm_st = ts'{ts_dirty=IS.empty}} where - nabla_not_dirty = nabla{ nabla_tm_st = ts{ts_dirty=emptyDVarSet} } - test_one :: VarInfo -> MaybeT DsM VarInfo - test_one vi = - lift (varNeedsTesting old_ty_st nabla vi) >>= \case + nabla_not_dirty = nabla{ nabla_tm_st = ts{ts_dirty=IS.empty} } + test_one :: ClassId -> VarInfo -> MaybeT DsM VarInfo + test_one cid vi = + lift (varNeedsTesting old_ty_st nabla cid vi) >>= \case True -> do -- lift $ tracePm "test_one" (ppr vi) -- No solution yet and needs testing -- We have to test with a Nabla where all dirty bits are cleared - instantiate (fuel-1) nabla_not_dirty vi - _ -> pure vi + instantiate (fuel-1) nabla_not_dirty (cid,vi) + _ -> return vi + +-- ROMES:TODO: The dirty shortcutting bit seems like the bookeeping on nodes to +-- upward merge, perhaps we can rid of it too -- | Checks whether the given 'VarInfo' needs to be tested for inhabitants. -- Returns `False` when we can skip the inhabitation test, presuming it would -- say "yes" anyway. See Note [Shortcutting the inhabitation test]. -varNeedsTesting :: TyState -> Nabla -> VarInfo -> DsM Bool -varNeedsTesting _ MkNabla{nabla_tm_st=tm_st} vi - | elemDVarSet (vi_id vi) (ts_dirty tm_st) = pure True -varNeedsTesting _ _ vi +varNeedsTesting :: TyState -> Nabla -> ClassId -> VarInfo -> DsM Bool +varNeedsTesting _ MkNabla{nabla_tm_st=tm_st} cid _ + | IS.member cid (ts_dirty tm_st) = pure True +varNeedsTesting _ _ _ vi | notNull (vi_pos vi) = pure False -varNeedsTesting old_ty_st MkNabla{nabla_ty_st=new_ty_st} _ +varNeedsTesting old_ty_st MkNabla{nabla_ty_st=new_ty_st} _ _ -- Same type state => still inhabited | not (tyStateRefined old_ty_st new_ty_st) = pure False -varNeedsTesting old_ty_st MkNabla{nabla_ty_st=new_ty_st} vi = do +varNeedsTesting old_ty_st MkNabla{nabla_ty_st=new_ty_st} _ vi = do -- These normalisations are relatively expensive, but still better than having -- to perform a full inhabitation test (_, _, old_norm_ty) <- tntrGuts <$> pmTopNormaliseType old_ty_st (idType $ vi_id vi) @@ -1349,25 +1395,25 @@ varNeedsTesting old_ty_st MkNabla{nabla_ty_st=new_ty_st} vi = do -- NB: Does /not/ filter each CompleteMatch with the oracle; members may -- remain that do not satisfy it. This lazy approach just -- avoids doing unnecessary work. -instantiate :: Int -> Nabla -> VarInfo -> MaybeT DsM VarInfo -instantiate fuel nabla vi = {-# SCC "instantiate" #-} - (instBot fuel nabla vi <|> instCompleteSets fuel nabla vi) +instantiate :: Int -> Nabla -> (ClassId, VarInfo) -> MaybeT DsM VarInfo +instantiate fuel nabla (ci,vi) = {-# SCC "instantiate" #-} + (instBot fuel nabla (ci,vi) <|> instCompleteSets fuel nabla ci) -- | The \(⊢_{Bot}\) rule from the paper -instBot :: Int -> Nabla -> VarInfo -> MaybeT DsM VarInfo -instBot _fuel nabla vi = {-# SCC "instBot" #-} do - _nabla' <- addBotCt nabla (vi_id vi) +instBot :: Int -> Nabla -> (ClassId,VarInfo) -> MaybeT DsM VarInfo +instBot _fuel nabla (cid,vi) = {-# SCC "instBot" #-} do + _nabla' <- addBotCt nabla cid pure vi -addNormalisedTypeMatches :: Nabla -> Id -> DsM (ResidualCompleteMatches, Nabla) -addNormalisedTypeMatches nabla at MkNabla{ nabla_ty_st = ty_st } x - = trvVarInfo add_matches nabla x +addNormalisedTypeMatches :: Nabla -> ClassId -> DsM (ResidualCompleteMatches, Nabla) +addNormalisedTypeMatches nabla at MkNabla{ nabla_ty_st = ty_st } xid + = trvVarInfo add_matches nabla xid where add_matches vi at VI{ vi_rcm = rcm } -- important common case, shaving down allocations of PmSeriesG by -5% | isRcmInitialised rcm = pure (rcm, vi) add_matches vi at VI{ vi_rcm = rcm } = do - norm_res_ty <- normaliseSourceTypeWHNF ty_st (idType x) + norm_res_ty <- normaliseSourceTypeWHNF ty_st (eclassType xid nabla) env <- dsGetFamInstEnvs rcm' <- case splitReprTyConApp_maybe env norm_res_ty of Just (rep_tc, _args, _co) -> addTyConMatches rep_tc rcm @@ -1388,12 +1434,11 @@ splitReprTyConApp_maybe env ty = -- inhabitant, the whole thing is uninhabited. It returns the updated 'VarInfo' -- where all the attempted ConLike instantiations have been purged from the -- 'ResidualCompleteMatches', which functions as a cache. -instCompleteSets :: Int -> Nabla -> VarInfo -> MaybeT DsM VarInfo -instCompleteSets fuel nabla vi = {-# SCC "instCompleteSets" #-} do - let x = vi_id vi - (rcm, nabla) <- lift (addNormalisedTypeMatches nabla x) - nabla <- foldM (\nabla cls -> instCompleteSet fuel nabla x cls) nabla (getRcm rcm) - pure (lookupVarInfo (nabla_tm_st nabla) x) +instCompleteSets :: Int -> Nabla -> ClassId -> MaybeT DsM VarInfo +instCompleteSets fuel nabla cid = {-# SCC "instCompleteSets" #-} do + (rcm, nabla) <- lift (addNormalisedTypeMatches nabla cid) + nabla <- foldM (\nabla cls -> instCompleteSet fuel nabla cid cls) nabla (getRcm rcm) + pure (lookupVarInfo (nabla_tm_st nabla) cid) anyConLikeSolution :: (ConLike -> Bool) -> [PmAltConApp] -> Bool anyConLikeSolution p = any (go . paca_con) @@ -1411,18 +1456,19 @@ anyConLikeSolution p = any (go . paca_con) -- original Nabla, not a proper refinement! No positive information will be -- added, only negative information from failed instantiation attempts, -- entirely as an optimisation. -instCompleteSet :: Int -> Nabla -> Id -> CompleteMatch -> MaybeT DsM Nabla -instCompleteSet fuel nabla x cs - | anyConLikeSolution (`elementOfUniqDSet` (cmConLikes cs)) (vi_pos vi) +instCompleteSet :: Int -> Nabla -> ClassId -> CompleteMatch -> MaybeT DsM Nabla +instCompleteSet fuel nabla xid cs + | anyConLikeSolution (`elementOfUniqDSet` cmConLikes cs) (vi_pos vi) -- No need to instantiate a constructor of this COMPLETE set if we already -- have a solution! = pure nabla - | not (completeMatchAppliesAtType (varType x) cs) + | not (completeMatchAppliesAtType (eclassType xid nabla) cs) = pure nabla | otherwise = {-# SCC "instCompleteSet" #-} go nabla (sorted_candidates cs) where - vi = lookupVarInfo (nabla_tm_st nabla) x + vi = lookupVarInfo (nabla_tm_st nabla) xid + x = vi_id vi sorted_candidates :: CompleteMatch -> [ConLike] sorted_candidates cm @@ -1443,12 +1489,11 @@ instCompleteSet fuel nabla x cs | isDataConTriviallyInhabited dc = pure nabla go nabla (con:cons) = do - let x = vi_id vi let recur_not_con = do - nabla' <- addNotConCt nabla x (PmAltConLike con) + nabla' <- addNotConCt nabla xid (PmAltConLike con) go nabla' cons (nabla <$ instCon fuel nabla x con) -- return the original nabla, not the - -- refined one! + -- refined one! <|> recur_not_con -- Assume that x can't be con. Encode that fact -- with addNotConCt and recur. @@ -1532,6 +1577,7 @@ instCon fuel nabla at MkNabla{nabla_ty_st = ty_st} x con = {-# SCC "instCon" #-} Ma -- (4) Instantiate fresh term variables as arguments to the constructor let field_tys' = substTys sigma_ex $ map scaledThing field_tys arg_ids <- mapM mkPmId field_tys' + let (nabla', arg_class_ids) = mapAccumL (\nab id -> swap $ representId id nab) nabla arg_ids tracePm (hdr "(cts)") $ vcat [ ppr x <+> dcolon <+> ppr match_ty , text "In WHNF:" <+> ppr (isSourceTypeInWHNF match_ty) <+> ppr norm_match_ty @@ -1544,10 +1590,10 @@ instCon fuel nabla at MkNabla{nabla_ty_st = ty_st} x con = {-# SCC "instCon" #-} Ma runMaybeT $ do -- Case (2) of Note [Strict fields and variables of unlifted type] let alt = PmAltConLike con - let branching_factor = length $ filterUnliftedFields alt arg_ids + let branching_factor = length $ filterUnliftedFields alt (zip arg_class_ids arg_ids) let ct = PhiConCt x alt ex_tvs gammas arg_ids nabla1 <- traceWhenFailPm (hdr "(ct unsatisfiable) }") (ppr ct) $ - addPhiTmCt nabla ct + addPhiTmCt nabla' ct -- See Note [Fuel for the inhabitation test] let new_fuel | branching_factor <= 1 = fuel @@ -1564,13 +1610,13 @@ instCon fuel nabla at MkNabla{nabla_ty_st = ty_st} x con = {-# SCC "instCon" #-} Ma , ppr new_fuel ] nabla2 <- traceWhenFailPm (hdr "(inh test failed) }") (ppr nabla1) $ - inhabitationTest new_fuel (nabla_ty_st nabla) nabla1 + inhabitationTest new_fuel (nabla_ty_st nabla') nabla1 lift $ tracePm (hdr "(inh test succeeded) }") (ppr nabla2) pure nabla2 Nothing -> do tracePm (hdr "(match_ty not instance of res_ty) }") empty pure (Just nabla) -- Matching against match_ty failed. Inhabited! - -- See Note [Instantiating a ConLike]. + -- See Note [Instantiating a ConLike]. -- | @matchConLikeResTy _ _ ty K@ tries to match @ty@ against the result -- type of @K@, @res_ty at . It returns a substitution @s@ for @K@'s universal @@ -1905,13 +1951,15 @@ instance Outputable GenerateInhabitingPatternsMode where -- perhaps empty) refinements of @nabla@ that represent inhabited patterns. -- Negative information is only retained if literals are involved or for -- recursive GADTs. -generateInhabitingPatterns :: GenerateInhabitingPatternsMode -> [Id] -> Int -> Nabla -> DsM [Nabla] +-- +-- The list of 'Id's @vs@ is the list of match-ids ? and they have all already been represented in the e-graph, we just represent them again to re-gain class id information +generateInhabitingPatterns :: GenerateInhabitingPatternsMode -> [ClassId] -> Int -> Nabla -> DsM [Nabla] -- See Note [Why inhabitationTest doesn't call generateInhabitingPatterns] generateInhabitingPatterns _ _ 0 _ = pure [] generateInhabitingPatterns _ [] _ nabla = pure [nabla] -generateInhabitingPatterns mode (x:xs) n nabla = do +generateInhabitingPatterns mode (x:xs) n nabla at MkNabla{nabla_tm_st=ts} = do tracePm "generateInhabitingPatterns" (ppr mode <+> ppr n <+> ppr (x:xs) $$ ppr nabla) - let VI _ pos neg _ _ = lookupVarInfo (nabla_tm_st nabla) x + let VI _ pos neg _ _ = lookupVarInfo ts x case pos of _:_ -> do -- Example for multiple solutions (must involve a PatSyn): @@ -1941,15 +1989,15 @@ generateInhabitingPatterns mode (x:xs) n nabla = do -- Tries to instantiate a variable by possibly following the chain of -- newtypes and then instantiating to all ConLikes of the wrapped type's -- minimal residual COMPLETE set. - try_instantiate :: Id -> [Id] -> Int -> Nabla -> DsM [Nabla] + try_instantiate :: ClassId -> [ClassId] -> Int -> Nabla -> DsM [Nabla] -- Convention: x binds the outer constructor in the chain, y the inner one. try_instantiate x xs n nabla = do - (_src_ty, dcs, rep_ty) <- tntrGuts <$> pmTopNormaliseType (nabla_ty_st nabla) (idType x) + (_src_ty, dcs, rep_ty) <- tntrGuts <$> pmTopNormaliseType (nabla_ty_st nabla) (eclassType x nabla) mb_stuff <- runMaybeT $ instantiate_newtype_chain x nabla dcs case mb_stuff of Nothing -> pure [] - Just (y, newty_nabla) -> do - let vi = lookupVarInfo (nabla_tm_st newty_nabla) y + Just (y, newty_nabla at MkNabla{nabla_tm_st=ts}) -> do + let vi = lookupVarInfo ts y env <- dsGetFamInstEnvs rcm <- case splitReprTyConApp_maybe env rep_ty of Just (tc, _, _) -> addTyConMatches tc (vi_rcm vi) @@ -1973,16 +2021,17 @@ generateInhabitingPatterns mode (x:xs) n nabla = do -- Instantiates a chain of newtypes, beginning at @x at . -- Turns @x nabla [T,U,V]@ to @(y, nabla')@, where @nabla'@ we has the fact -- @x ~ T (U (V y))@. - instantiate_newtype_chain :: Id -> Nabla -> [(Type, DataCon, Type)] -> MaybeT DsM (Id, Nabla) + instantiate_newtype_chain :: ClassId -> Nabla -> [(Type, DataCon, Type)] -> MaybeT DsM (ClassId, Nabla) instantiate_newtype_chain x nabla [] = pure (x, nabla) instantiate_newtype_chain x nabla ((_ty, dc, arg_ty):dcs) = do y <- lift $ mkPmId arg_ty + let (yid,nabla') = representId y nabla -- Newtypes don't have existentials (yet?!), so passing an empty -- list as ex_tvs. - nabla' <- addConCt nabla x (PmAltConLike (RealDataCon dc)) [] [y] - instantiate_newtype_chain y nabla' dcs + nabla'' <- addConCt nabla' x (PmAltConLike (RealDataCon dc)) [] [yid] + instantiate_newtype_chain yid nabla'' dcs - instantiate_cons :: Id -> Type -> [Id] -> Int -> Nabla -> [ConLike] -> DsM [Nabla] + instantiate_cons :: ClassId -> Type -> [ClassId] -> Int -> Nabla -> [ConLike] -> DsM [Nabla] instantiate_cons _ _ _ _ _ [] = pure [] instantiate_cons _ _ _ 0 _ _ = pure [] instantiate_cons _ ty xs n nabla _ @@ -1991,8 +2040,8 @@ generateInhabitingPatterns mode (x:xs) n nabla = do = generateInhabitingPatterns mode xs n nabla instantiate_cons x ty xs n nabla (cl:cls) = do -- The following line is where we call out to the inhabitationTest! - mb_nabla <- runMaybeT $ instCon 4 nabla x cl - tracePm "instantiate_cons" (vcat [ ppr x <+> dcolon <+> ppr (idType x) + mb_nabla <- runMaybeT $ instCon 4 nabla (eclassMatchId x nabla) cl + tracePm "instantiate_cons" (vcat [ ppr x <+> dcolon <+> ppr (eclassType x nabla) , ppr ty , ppr cl , ppr nabla @@ -2082,3 +2131,17 @@ Note that for -XEmptyCase, we don't want to emit a minimal cover. We arrange that by passing 'CaseSplitTopLevel' to 'generateInhabitingPatterns'. We detect the -XEmptyCase case in 'reportWarnings' by looking for 'ReportEmptyCase'. -} + +-- | Update the value of the analysis data of some e-class by its id. +updateVarInfo :: Functor f => ClassId -> (VarInfo -> f VarInfo) -> Nabla -> f Nabla +-- Update the data at class @xid@ using lenses and the monadic action @go@ +updateVarInfo xid f nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=eg } } = (\eg' -> nabla{ nabla_tm_st = ts{ts_facts = eg'} }) <$> (_class xid . _data) f eg + +eclassMatchId :: ClassId -> Nabla -> Id +eclassMatchId cid = vi_id . (^. _class cid . _data) . (ts_facts . nabla_tm_st) + +eclassType :: ClassId -> Nabla -> Type +eclassType cid = idType . eclassMatchId cid + + +-- ROMES:TODO: When exactly to rebuild? ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -1,3 +1,7 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} @@ -10,12 +14,12 @@ module GHC.HsToCore.Pmc.Solver.Types ( -- * Normalised refinement types - BotInfo(..), PmAltConApp(..), VarInfo(..), TmState(..), TyState(..), + BotInfo(..), PmAltConApp(..), VarInfo(..), TmState(..), TmEGraph, TyState(..), Nabla(..), Nablas(..), initNablas, lookupRefuts, lookupSolution, -- ** Looking up 'VarInfo' - lookupVarInfo, lookupVarInfoNT, trvVarInfo, + lookupVarInfo, lookupVarInfoNT, trvVarInfo, emptyVarInfo, representId, representIds, -- ** Caching residual COMPLETE sets CompleteMatch, ResidualCompleteMatches(..), getRcm, isRcmInitialised, @@ -42,10 +46,9 @@ import GHC.Prelude import GHC.Data.Bag import GHC.Data.FastString import GHC.Types.Id -import GHC.Types.Var.Set import GHC.Types.Unique.DSet -import GHC.Types.Unique.SDFM import GHC.Types.Name +import GHC.Core.Equality import GHC.Core.DataCon import GHC.Core.ConLike import GHC.Utils.Outputable @@ -58,7 +61,7 @@ import GHC.Core.TyCon import GHC.Types.Literal import GHC.Core import GHC.Core.TyCo.Compare( eqType ) -import GHC.Core.Map.Expr +import GHC.Core.Map.Type import GHC.Core.Utils (exprType) import GHC.Builtin.Names import GHC.Builtin.Types @@ -75,6 +78,17 @@ import Data.Ratio import GHC.Real (Ratio(..)) import qualified Data.Semigroup as Semi +import Data.Tuple (swap) +import Data.Traversable (mapAccumL) +import Data.Functor.Compose +import Data.Equality.Analysis (Analysis(..)) +import Data.Equality.Graph (EGraph, ClassId) +import Data.Equality.Graph.Lens +import qualified Data.Equality.Graph as EG +import Data.IntSet (IntSet) +import qualified Data.IntSet as IS (empty) +import Data.Bifunctor (second) + -- import GHC.Driver.Ppr -- @@ -131,21 +145,19 @@ instance Outputable TyState where initTyState :: TyState initTyState = TySt 0 emptyInert --- | The term oracle state. Stores 'VarInfo' for encountered 'Id's. These --- entries are possibly shared when we figure out that two variables must be --- equal, thus represent the same set of values. +-- | The term oracle state. Stores 'VarInfo' for encountered 'Id's and +-- 'CoreExpr's. These entries are possibly shared when we figure out that two +-- variables must be equal, thus represent the same set of values. -- -- See Note [TmState invariants] in "GHC.HsToCore.Pmc.Solver". data TmState = TmSt - { ts_facts :: !(UniqSDFM Id VarInfo) - -- ^ Facts about term variables. Deterministic env, so that we generate - -- deterministic error messages. - , ts_reps :: !(CoreMap Id) - -- ^ An environment for looking up whether we already encountered semantically - -- equivalent expressions that we want to represent by the same 'Id' - -- representative. - , ts_dirty :: !DIdSet + { ts_facts :: !TmEGraph + -- ^ Facts about terms. + + -- ROMES:TODO: ts_dirty looks a bit to me like the bookeeping needed to know + -- which nodes to upward merge, perhaps we can get rid of it too. + , ts_dirty :: !IntSet -- ^ Which 'VarInfo' needs to be checked for inhabitants because of new -- negative constraints (e.g. @x ≁ ⊥@ or @x ≁ K@). } @@ -161,6 +173,8 @@ data VarInfo { vi_id :: !Id -- ^ The 'Id' in question. Important for adding new constraints relative to -- this 'VarInfo' when we don't easily have the 'Id' available. + -- ROMES:TODO: What is the Id in question when we might have multiple Ids in the same equivalence class? + -- It seems currenlty this is the representative of the e-class, so we could probably drop it, in favour of Type or so (since sometimes we need to know the type, and that's also reasonable data for the e-class to have) , vi_pos :: ![PmAltConApp] -- ^ Positive info: 'PmAltCon' apps it is (i.e. @x ~ [Just y, PatSyn z]@), all @@ -168,7 +182,7 @@ data VarInfo -- pattern matches involving pattern synonym -- case x of { Just y -> case x of PatSyn z -> ... } -- However, no more than one RealDataCon in the list, otherwise contradiction - -- because of generativity. + -- because of generativity (which would violate Invariant 1 from the paper). , vi_neg :: !PmAltConSet -- ^ Negative info: A list of 'PmAltCon's that it cannot match. @@ -206,7 +220,7 @@ data PmAltConApp = PACA { paca_con :: !PmAltCon , paca_tvs :: ![TyVar] - , paca_ids :: ![Id] + , paca_ids :: ![ClassId] } -- | See 'vi_bot'. @@ -227,7 +241,7 @@ instance Outputable BotInfo where -- | Not user-facing. instance Outputable TmState where - ppr (TmSt state reps dirty) = ppr state $$ ppr reps $$ ppr dirty + ppr (TmSt _ dirty) = text "" $$ ppr dirty -- | Not user-facing. instance Outputable VarInfo where @@ -248,7 +262,7 @@ instance Outputable VarInfo where -- | Initial state of the term oracle. initTmState :: TmState -initTmState = TmSt emptyUSDFM emptyCoreMap emptyDVarSet +initTmState = TmSt EG.emptyEGraph IS.empty -- | A data type that caches for the 'VarInfo' of @x@ the results of querying -- 'dsGetCompleteMatches' and then striking out all occurrences of @K@ for @@ -300,9 +314,14 @@ emptyVarInfo x , vi_rcm = emptyRCM } -lookupVarInfo :: TmState -> Id -> VarInfo --- (lookupVarInfo tms x) tells what we know about 'x' -lookupVarInfo (TmSt env _ _) x = fromMaybe (emptyVarInfo x) (lookupUSDFM env x) +-- | @lookupVarInfo tms x@ tells what we know about 'x' +--- romes:TODO: This will have a different type. I don't know what yet. +-- romes:TODO I don't think this is what we want any longer, more like represent Id and see if it was previously represented by some data or not? +-- romes:TodO should return VarInfo rather than Maybe VarInfo +lookupVarInfo :: TmState -> ClassId -> VarInfo +lookupVarInfo (TmSt eg _) x +-- RM: Yea, I don't like the fact that currently all e-classes are created by Ids and have an Empty Var info, yet we must call "fromMaybe" here. Not good. + = eg ^._class x._data -- | Like @lookupVarInfo ts x@, but @lookupVarInfo ts x = (y, vi)@ also looks -- through newtype constructors. We have @x ~ N1 (... (Nk y))@ such that the @@ -314,27 +333,33 @@ lookupVarInfo (TmSt env _ _) x = fromMaybe (emptyVarInfo x) (lookupUSDFM env x) -- modulo type normalisation! -- -- See also Note [Coverage checking Newtype matches] in GHC.HsToCore.Pmc.Solver. -lookupVarInfoNT :: TmState -> Id -> (Id, VarInfo) +-- +-- RM: looks like we could get perhaps represent the newtypes in the e-graph instead and somehow simplify this? +lookupVarInfoNT :: TmState -> ClassId -> (ClassId, VarInfo) lookupVarInfoNT ts x = case lookupVarInfo ts x of VI{ vi_pos = as_newtype -> Just y } -> lookupVarInfoNT ts y - res -> (x, res) + res -> (x, res) where as_newtype = listToMaybe . mapMaybe go go PACA{paca_con = PmAltConLike (RealDataCon dc), paca_ids = [y]} | isNewDataCon dc = Just y go _ = Nothing -trvVarInfo :: Functor f => (VarInfo -> f (a, VarInfo)) -> Nabla -> Id -> f (a, Nabla) +-- romes: We could probably inline this +trvVarInfo :: forall f a. Functor f => (VarInfo -> f (a,VarInfo)) -> Nabla -> ClassId -> f (a,Nabla) trvVarInfo f nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts = env} } x - = set_vi <$> f (lookupVarInfo ts x) - where - set_vi (a, vi') = - (a, nabla{ nabla_tm_st = ts{ ts_facts = addToUSDFM env (vi_id vi') vi' } }) + = second (\g -> nabla{nabla_tm_st = ts{ts_facts=g}}) <$> updateAccum (_class x._data) f env + where + updateAccum :: forall f a s c. Functor f => Lens' s a -> (a -> f (c,a)) -> s -> f (c,s) + updateAccum lens g = getCompose . lens @(Compose f ((,) c)) (Compose . g) ------------------------------------------------ -- * Exported utility functions querying 'Nabla' -lookupRefuts :: Nabla -> Id -> [PmAltCon] +-- ROMES:TODO: Document +-- | Lookup the refutable patterns, i.e. the pattern alt cons that certainly can't happen?? +-- ROMES:TODO: ClassId? +lookupRefuts :: Nabla -> ClassId -> [PmAltCon] -- Unfortunately we need the extra bit of polymorphism and the unfortunate -- duplication of lookupVarInfo here. lookupRefuts MkNabla{ nabla_tm_st = ts } x = @@ -346,7 +371,7 @@ isDataConSolution _ = False -- @lookupSolution nabla x@ picks a single solution ('vi_pos') of @x@ from -- possibly many, preferring 'RealDataCon' solutions whenever possible. -lookupSolution :: Nabla -> Id -> Maybe PmAltConApp +lookupSolution :: Nabla -> ClassId -> Maybe PmAltConApp lookupSolution nabla x = case vi_pos (lookupVarInfo (nabla_tm_st nabla) x) of [] -> Nothing pos@(x:_) @@ -465,6 +490,7 @@ extendPmAltConSet (PACS cls lits) (PmAltConLike cl) extendPmAltConSet (PACS cls lits) (PmAltLit lit) = PACS cls (unionLists lits [lit]) +-- | The elements of a 'PmAltConSet' pmAltConSetElems :: PmAltConSet -> [PmAltCon] pmAltConSetElems (PACS cls lits) = map PmAltConLike (uniqDSetToList cls) ++ map PmAltLit lits @@ -789,7 +815,7 @@ instance Outputable PmLit where , (charPrimTy, primCharSuffix) , (floatPrimTy, primFloatSuffix) , (doublePrimTy, primDoubleSuffix) ] - suffix = fromMaybe empty (snd <$> find (eqType ty . fst) tbl) + suffix = maybe empty snd (find (eqType ty . fst) tbl) instance Outputable PmAltCon where ppr (PmAltConLike cl) = ppr cl @@ -797,3 +823,45 @@ instance Outputable PmAltCon where instance Outputable PmEquality where ppr = text . show + +-- +-- * E-graphs to represent normalised refinment types +-- + +type TmEGraph = EGraph VarInfo (DeBruijnF CoreExprF) + +representId :: Id -> Nabla -> (ClassId, Nabla) +-- Will need to justify this well +representId x (MkNabla tyst tmst at TmSt{ts_facts=eg0}) + = case EG.add (EG.Node (DF (deBruijnize (VarF x)))) eg0 of + (xid, eg1) -> (xid, MkNabla tyst tmst{ts_facts=eg1}) + +representIds :: [Id] -> Nabla -> ([ClassId], Nabla) +representIds xs nabla = swap $ mapAccumL (\acc x -> swap $ representId x acc) nabla xs + +-- | This instance is seriously wrong for general purpose, it's just required for instancing Analysis. +-- There ought to be a better way. +instance Eq VarInfo where + (==) _ _ = False +instance Analysis VarInfo (DeBruijnF CoreExprF) where + {-# INLINE makeA #-} + {-# INLINE joinA #-} + + -- When an e-class is created for a variable, we create an VarInfo from it. + -- It doesn't matter if this variable is bound or free, since it's the first + -- variable in this e-class (and all others would have to be equivalent to + -- it) + -- + -- Also, the Eq instance for DeBruijn Vars will ensure that two free + -- variables with the same Id are equal and so they will be represented in + -- the same e-class + makeA (DF (D _ (VarF x))) = emptyVarInfo x + makeA _ = emptyVarInfo unitDataConId -- ROMES:TODO: this is dummy information which should never be used, this is quite wrong :) + -- I think the reason we end up in this + -- situation is bc we first represent an expression and only then merge it with some Id. + -- we'd need a way to represent directly into an e-class then, to not trigger the new e-class. + + -- romes: so currently, variables are joined in 'addVarCt' manually by getting the old value of $x$ and assuming the value of $y$ was chosen. + -- That's obviously bad now, it'd be much more clearer to do it here. It's just the nabla threading that's more trouble + joinA _a b = b + ===================================== compiler/GHC/Types/Unique/SDFM.hs ===================================== @@ -82,6 +82,7 @@ lookupUSDFM usdfm x = snd (lookupReprAndEntryUSDFM usdfm x) -- >>> equateUSDFM [({u1,u3}, Just ele1)] u3 u4 == (Nothing, [({u1,u3,u4}, Just ele1)]) -- >>> equateUSDFM [({u1,u3}, Just ele1)] u4 u3 == (Nothing, [({u1,u3,u4}, Just ele1)]) -- >>> equateUSDFM [({u1,u3}, Just ele1), ({u2}, Just ele2)] u3 u2 == (Just ele1, [({u2,u1,u3}, Just ele2)]) +-- ROMES:TODO: Are all USDFM functions just for the PMC Nabla TM? equateUSDFM :: Uniquable key => UniqSDFM key ele -> key -> key -> (Maybe ele, UniqSDFM key ele) equateUSDFM usdfm@(USDFM env) x y = ===================================== compiler/ghc.cabal.in ===================================== @@ -300,6 +300,7 @@ Library GHC.Core.ConLike GHC.Core.DataCon GHC.Core.FamInstEnv + GHC.Core.Equality GHC.Core.FVs GHC.Core.InstEnv GHC.Core.Lint View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4d72410fe0931fd1a94c8efcd3c8c8d52af2f396...fedc72828fa29a76215c927c01ea602a851cc1e0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4d72410fe0931fd1a94c8efcd3c8c8d52af2f396...fedc72828fa29a76215c927c01ea602a851cc1e0 You're receiving 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 Jun 26 08:27:50 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 26 Jun 2023 04:27:50 -0400 Subject: [Git][ghc/ghc][wip/T22010] Bump spec-constr threshold to make it fire again Message-ID: <64994c06ba6ce_64cc0c76f0186023@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: b8d74979 by Jaro Reinders at 2023-06-26T10:27:44+02:00 Bump spec-constr threshold to make it fire again - - - - - 1 changed file: - compiler/GHC/Linker/Deps.hs Changes: ===================================== compiler/GHC/Linker/Deps.hs ===================================== @@ -1,3 +1,8 @@ +-- The transition from Int to Word64 for uniques makes functions slightly larger +-- without this GHC option some optimizations fail to fire. +-- See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10568#note_505751 +{-# OPTIONS_GHC -fspec-constr-threshold=10000 #-} + {-# LANGUAGE CPP #-} {-# LANGUAGE TupleSections, RecordWildCards #-} {-# LANGUAGE BangPatterns #-} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b8d74979bf335de0e39db5cd7d9a687e59f6297d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b8d74979bf335de0e39db5cd7d9a687e59f6297d You're receiving 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 Jun 26 08:43:37 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 26 Jun 2023 04:43:37 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: rts: Work around missing prototypes errors Message-ID: <64994fb920b4e_64cc0c774019787c@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - ff803506 by Sylvain Henry at 2023-06-26T04:43:21-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 7f598a99 by Arnaud Spiwack at 2023-06-26T04:43:32-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Builtin/Types.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Stg/Syntax.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/ArgRep.hs - compiler/GHC/StgToCmm/Lit.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/StgToJS/Types.hs - compiler/GHC/StgToJS/Utils.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/RepType.hs - rts/Disassembler.c - rts/Interpreter.c - rts/include/stg/SMP.h - rts/js/rts.js - rts/js/verify.js - + testsuite/tests/ghci/should_run/LargeBCO.hs - + testsuite/tests/ghci/should_run/LargeBCO.stdout - + testsuite/tests/ghci/should_run/LargeBCO_A.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/46818aa3d1cd7fbe8b89205817f7ed74585d3ede...7f598a99ee7a2fb2bd0a0e5ee6261086e3fbbb36 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/46818aa3d1cd7fbe8b89205817f7ed74585d3ede...7f598a99ee7a2fb2bd0a0e5ee6261086e3fbbb36 You're receiving 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 Jun 26 09:43:27 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 26 Jun 2023 05:43:27 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/polymorphic-spec Message-ID: <64995dbf62a38_64cc0c7754220426@gitlab.mail> Matthew Pickering pushed new branch wip/polymorphic-spec at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/polymorphic-spec You're receiving 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 Jun 26 09:45:17 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 26 Jun 2023 05:45:17 -0400 Subject: [Git][ghc/ghc][wip/polymorphic-spec] Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Message-ID: <64995e2d2035a_64cc0c76f02238bd@gitlab.mail> Matthew Pickering pushed to branch wip/polymorphic-spec at Glasgow Haskell Compiler / GHC Commits: 43a185ff by Matthew Pickering at 2023-06-26T10:44:47+01:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Fixes #23559 - - - - - 7 changed files: - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/using-optimisation.rst - testsuite/tests/simplCore/should_compile/T8331.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -2490,6 +2490,12 @@ specArgFreeIds (SpecDict dx) = exprFreeIds dx specArgFreeIds UnspecType = emptyVarSet specArgFreeIds UnspecArg = emptyVarSet +specArgFreeVars :: SpecArg -> VarSet +specArgFreeVars (SpecType ty) = tyCoVarsOfType ty +specArgFreeVars (SpecDict dx) = exprFreeVars dx +specArgFreeVars UnspecType = emptyVarSet +specArgFreeVars UnspecArg = emptyVarSet + isSpecDict :: SpecArg -> Bool isSpecDict (SpecDict {}) = True isSpecDict _ = False @@ -2798,6 +2804,12 @@ non-dictionary bindings too. Note [Specialising polymorphic dictionaries] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Note June 2023: This has proved to be quite a tricky optimisation to get right +see (#23469, #23109, #21229, #23445) so it is now guarded by a flag +`-fpolymorphic-specialisation`. + + Consider class M a where { foo :: a -> Int } @@ -2988,14 +3000,23 @@ getTheta = fmap piTyBinderType . filter isInvisiblePiTyBinder . filter isAnonPiT ------------------------------------------------------------ -singleCall :: Id -> [SpecArg] -> UsageDetails -singleCall id args +singleCall :: SpecEnv -> Id -> [SpecArg] -> UsageDetails +singleCall spec_env id args = MkUD {ud_binds = emptyFDBs, ud_calls = unitDVarEnv id $ CIS id $ unitBag (CI { ci_key = args , ci_fvs = call_fvs }) } where - call_fvs = foldr (unionVarSet . specArgFreeIds) emptyVarSet args + call_fvs = + foldr (unionVarSet . free_var_fn) emptyVarSet args + + free_var_fn = + if gopt Opt_PolymorphicSpecialisation (se_dflags spec_env) + then specArgFreeIds + else specArgFreeVars + + + -- specArgFreeIds: we specifically look for free Ids, not TyVars -- see (MP1) in Note [Specialising polymorphic dictionaries] -- @@ -3014,7 +3035,7 @@ mkCallUDs' env f args | wantCallsFor env f -- We want it, and... , not (null ci_key) -- this call site has a useful specialisation = -- pprTrace "mkCallUDs: keeping" _trace_doc - singleCall f ci_key + singleCall env f ci_key | otherwise -- See also Note [Specialisations already covered] = -- pprTrace "mkCallUDs: discarding" _trace_doc ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -257,6 +257,7 @@ data GeneralFlag | Opt_Specialise | Opt_SpecialiseAggressively | Opt_CrossModuleSpecialise + | Opt_PolymorphicSpecialisation | Opt_InlineGenerics | Opt_InlineGenericsAggressively | Opt_StaticArgumentTransformation ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2429,6 +2429,7 @@ fFlagsDeps = [ flagSpec "specialize-aggressively" Opt_SpecialiseAggressively, flagSpec "cross-module-specialise" Opt_CrossModuleSpecialise, flagSpec "cross-module-specialize" Opt_CrossModuleSpecialise, + flagSpec "polymorphic-specialisation" Opt_PolymorphicSpecialisation, flagSpec "inline-generics" Opt_InlineGenerics, flagSpec "inline-generics-aggressively" Opt_InlineGenericsAggressively, flagSpec "static-argument-transformation" Opt_StaticArgumentTransformation, ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -174,11 +174,16 @@ Compiler D(D2) ) D = D1 | D2 - + This allows for changing the structure of a library without immediately breaking user code, but instead being able to warn the user that a change in the library interface will occur in the future. +- Guard polymorphic specialisation behind the flag :ghc-flag:`-fpolymorphic-specialisation`. + This optimisation has led to a number of incorrect runtime result bugs, so we are disabling it + by default for now whilst we consider more carefully an appropiate fix. + (See :ghc-ticket:`23469`, :ghc-ticket:`23109`, :ghc-ticket:`21229`, :ghc-ticket:`23445`) + GHCi ~~~~ @@ -241,8 +246,8 @@ Runtime system We use this functionality in GHCi to modify how some messages are displayed. - The extensions fields of constructors of ``IE`` now take ``Maybe (WarningTxt p)`` - in ``GhcPs`` and ``GhcRn`` variants of the Syntax Tree. - This represents the warning assigned to a certain export item, + in ``GhcPs`` and ``GhcRn`` variants of the Syntax Tree. + This represents the warning assigned to a certain export item, which is used for :ref:`deprecated-exports`. ``ghc-heap`` library ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -1113,6 +1113,21 @@ as such you shouldn't need to set any of them explicitly. A flag which they are called in this module. Note that specialisation must be enabled (by ``-fspecialise``) for this to have any effect. +.. ghc-flag:: -fpolymorphic-specialisation + :shortdesc: Allow specialisation to abstract over free type variables + :type: dynamic + :reverse: -fno-polymorphic-specialisation + :category: + + :default: off + + Warning, this feature is highly experimental and may lead to incorrect runtime + results. Use at your own risk (:ghc-ticket:`23469`, :ghc-ticket:`23109`, :ghc-ticket:`21229`, :ghc-ticket:`23445`). + + Enable specialisation of function calls to known dictionaries with free type variables. + The created specialisation will abstract over the type variables free in the dictionary. + + .. ghc-flag:: -flate-specialise :shortdesc: Run a late specialisation pass :type: dynamic ===================================== testsuite/tests/simplCore/should_compile/T8331.stderr ===================================== @@ -1,149 +1,5 @@ ==================== Tidy Core rules ==================== -"SPEC $c*> @(ST s) @_" - forall (@s) (@r) ($dApplicative :: Applicative (ST s)). - $fApplicativeReaderT_$c*> @(ST s) @r $dApplicative - = ($fApplicativeReaderT2 @s @r) - `cast` (forall (a :: <*>_N) (b :: <*>_N). - _R - %<'Many>_N ->_R _R - %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) - ; Sym (N:ReaderT[0] <*>_N _R _R _N) - :: Coercible - (forall {a} {b}. - ReaderT r (ST s) a -> ReaderT r (ST s) b -> r -> STRep s b) - (forall {a} {b}. - ReaderT r (ST s) a -> ReaderT r (ST s) b -> ReaderT r (ST s) b)) -"SPEC $c<$ @(ST s) @_" - forall (@s) (@r) ($dFunctor :: Functor (ST s)). - $fFunctorReaderT_$c<$ @(ST s) @r $dFunctor - = ($fApplicativeReaderT6 @s @r) - `cast` (forall (a :: <*>_N) (b :: <*>_N). - _R - %<'Many>_N ->_R _R - %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) - ; Sym (N:ReaderT[0] <*>_N _R _R _N) - :: Coercible - (forall {a} {b}. a -> ReaderT r (ST s) b -> r -> STRep s a) - (forall {a} {b}. a -> ReaderT r (ST s) b -> ReaderT r (ST s) a)) -"SPEC $c<* @(ST s) @_" - forall (@s) (@r) ($dApplicative :: Applicative (ST s)). - $fApplicativeReaderT_$c<* @(ST s) @r $dApplicative - = ($fApplicativeReaderT1 @s @r) - `cast` (forall (a :: <*>_N) (b :: <*>_N). - _R - %<'Many>_N ->_R _R - %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) - ; Sym (N:ReaderT[0] <*>_N _R _R _N) - :: Coercible - (forall {a} {b}. - ReaderT r (ST s) a -> ReaderT r (ST s) b -> r -> STRep s a) - (forall {a} {b}. - ReaderT r (ST s) a -> ReaderT r (ST s) b -> ReaderT r (ST s) a)) -"SPEC $c<*> @(ST s) @_" - forall (@s) (@r) ($dApplicative :: Applicative (ST s)). - $fApplicativeReaderT9 @(ST s) @r $dApplicative - = ($fApplicativeReaderT4 @s @r) - `cast` (forall (a :: <*>_N) (b :: <*>_N). - b)>_R - %<'Many>_N ->_R _R - %<'Many>_N ->_R _R - %<'Many>_N ->_R Sym (N:ST[0] _N _R) - :: Coercible - (forall {a} {b}. - ReaderT r (ST s) (a -> b) -> ReaderT r (ST s) a -> r -> STRep s b) - (forall {a} {b}. - ReaderT r (ST s) (a -> b) -> ReaderT r (ST s) a -> r -> ST s b)) -"SPEC $c>> @(ST s) @_" - forall (@s) (@r) ($dMonad :: Monad (ST s)). - $fMonadReaderT1 @(ST s) @r $dMonad - = $fMonadAbstractIOSTReaderT_$s$c>> @s @r -"SPEC $c>>= @(ST s) @_" - forall (@s) (@r) ($dMonad :: Monad (ST s)). - $fMonadReaderT2 @(ST s) @r $dMonad - = ($fMonadAbstractIOSTReaderT2 @s @r) - `cast` (forall (a :: <*>_N) (b :: <*>_N). - _R - %<'Many>_N ->_R ReaderT r (ST s) b>_R - %<'Many>_N ->_R _R - %<'Many>_N ->_R Sym (N:ST[0] _N _R) - :: Coercible - (forall {a} {b}. - ReaderT r (ST s) a -> (a -> ReaderT r (ST s) b) -> r -> STRep s b) - (forall {a} {b}. - ReaderT r (ST s) a -> (a -> ReaderT r (ST s) b) -> r -> ST s b)) -"SPEC $cfmap @(ST s) @_" - forall (@s) (@r) ($dFunctor :: Functor (ST s)). - $fFunctorReaderT_$cfmap @(ST s) @r $dFunctor - = ($fApplicativeReaderT7 @s @r) - `cast` (forall (a :: <*>_N) (b :: <*>_N). - b>_R - %<'Many>_N ->_R _R - %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) - ; Sym (N:ReaderT[0] <*>_N _R _R _N) - :: Coercible - (forall {a} {b}. (a -> b) -> ReaderT r (ST s) a -> r -> STRep s b) - (forall {a} {b}. - (a -> b) -> ReaderT r (ST s) a -> ReaderT r (ST s) b)) -"SPEC $cliftA2 @(ST s) @_" - forall (@s) (@r) ($dApplicative :: Applicative (ST s)). - $fApplicativeReaderT_$cliftA2 @(ST s) @r $dApplicative - = ($fApplicativeReaderT3 @s @r) - `cast` (forall (a :: <*>_N) (b :: <*>_N) (c :: <*>_N). - b -> c>_R - %<'Many>_N ->_R _R - %<'Many>_N ->_R _R - %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) - ; Sym (N:ReaderT[0] <*>_N _R _R _N) - :: Coercible - (forall {a} {b} {c}. - (a -> b -> c) - -> ReaderT r (ST s) a -> ReaderT r (ST s) b -> r -> STRep s c) - (forall {a} {b} {c}. - (a -> b -> c) - -> ReaderT r (ST s) a -> ReaderT r (ST s) b -> ReaderT r (ST s) c)) -"SPEC $cp1Applicative @(ST s) @_" - forall (@s) (@r) ($dApplicative :: Applicative (ST s)). - $fApplicativeReaderT_$cp1Applicative @(ST s) @r $dApplicative - = $fApplicativeReaderT_$s$fFunctorReaderT @s @r -"SPEC $cp1Monad @(ST s) @_" - forall (@s) (@r) ($dMonad :: Monad (ST s)). - $fMonadReaderT_$cp1Monad @(ST s) @r $dMonad - = $fApplicativeReaderT_$s$fApplicativeReaderT @s @r -"SPEC $cpure @(ST s) @_" - forall (@s) (@r) ($dApplicative :: Applicative (ST s)). - $fApplicativeReaderT_$cpure @(ST s) @r $dApplicative - = ($fApplicativeReaderT5 @s @r) - `cast` (forall (a :: <*>_N). - _R - %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) - ; Sym (N:ReaderT[0] <*>_N _R _R _N) - :: Coercible - (forall {a}. a -> r -> STRep s a) - (forall {a}. a -> ReaderT r (ST s) a)) -"SPEC $creturn @(ST s) @_" - forall (@s) (@r) ($dMonad :: Monad (ST s)). - $fMonadReaderT_$creturn @(ST s) @r $dMonad - = ($fApplicativeReaderT5 @s @r) - `cast` (forall (a :: <*>_N). - _R - %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) - ; Sym (N:ReaderT[0] <*>_N _R _R _N) - :: Coercible - (forall {a}. a -> r -> STRep s a) - (forall {a}. a -> ReaderT r (ST s) a)) -"SPEC $fApplicativeReaderT @(ST s) @_" - forall (@s) (@r) ($dApplicative :: Applicative (ST s)). - $fApplicativeReaderT @(ST s) @r $dApplicative - = $fApplicativeReaderT_$s$fApplicativeReaderT @s @r -"SPEC $fFunctorReaderT @(ST s) @_" - forall (@s) (@r) ($dFunctor :: Functor (ST s)). - $fFunctorReaderT @(ST s) @r $dFunctor - = $fApplicativeReaderT_$s$fFunctorReaderT @s @r -"SPEC $fMonadReaderT @(ST s) @_" - forall (@s) (@r) ($dMonad :: Monad (ST s)). - $fMonadReaderT @(ST s) @r $dMonad - = $fMonadAbstractIOSTReaderT_$s$fMonadReaderT @s @r "USPEC useAbstractMonad @(ReaderT Int (ST s))" forall (@s) ($dMonadAbstractIOST :: MonadAbstractIOST (ReaderT Int (ST s))). ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -435,7 +435,7 @@ test('T21851', [grep_errmsg(r'case.*w\$sf') ], multimod_compile, ['T21851', '-O # One module, T22097.hs, has OPTIONS_GHC -ddump-simpl test('T22097', [grep_errmsg(r'case.*wgoEven') ], multimod_compile, ['T22097', '-O -dno-typeable-binds -dsuppress-uniques']) -test('T13873', [ grep_errmsg(r'SPEC') ], compile, ['-O -ddump-rules']) +test('T13873', [ grep_errmsg(r'SPEC') ], compile, ['-O -ddump-rules -fpolymorphic-specialisation']) test('T22357', normal, compile, ['-O']) test('T22471', normal, compile, ['-O']) test('T22347', normal, compile, ['-O -fno-full-laziness']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/43a185ff91e162a734002911f1db411122ac27af -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/43a185ff91e162a734002911f1db411122ac27af You're receiving 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 Jun 26 09:50:02 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 26 Jun 2023 05:50:02 -0400 Subject: [Git][ghc/ghc][wip/T22010] Split #23537 workaround into new module Message-ID: <64995f4a9f827_64cc0c75d82290ad@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: be92a75c by Jaro Reinders at 2023-06-26T11:49:52+02:00 Split #23537 workaround into new module - - - - - 9 changed files: - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/Tc/Deriv/Utils.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/Tc/Utils/TcType.hs - + compiler/GHC/Utils/Unique.hs - compiler/ghc.cabal.in - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout Changes: ===================================== compiler/GHC/HsToCore/Match/Literal.hs ===================================== @@ -64,6 +64,7 @@ import GHC.Utils.Outputable as Outputable import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Utils.Panic.Plain +import GHC.Utils.Unique (same) import GHC.Data.FastString @@ -319,29 +320,29 @@ warnAboutOverflowedLiterals dflags lit , Just (i, tc) <- lit = if -- These only show up via the 'HsOverLit' route - | tc == intTyConName -> check i tc minInt maxInt - | tc == wordTyConName -> check i tc minWord maxWord - | tc == int8TyConName -> check i tc (min' @Int8) (max' @Int8) - | tc == int16TyConName -> check i tc (min' @Int16) (max' @Int16) - | tc == int32TyConName -> check i tc (min' @Int32) (max' @Int32) - | tc == int64TyConName -> check i tc (min' @Int64) (max' @Int64) - | tc == word8TyConName -> check i tc (min' @Word8) (max' @Word8) - | tc == word16TyConName -> check i tc (min' @Word16) (max' @Word16) - | tc == word32TyConName -> check i tc (min' @Word32) (max' @Word32) - | tc == word64TyConName -> check i tc (min' @Word64) (max' @Word64) - | tc == naturalTyConName -> checkPositive i tc + | same tc intTyConName -> check i tc minInt maxInt + | same tc wordTyConName -> check i tc minWord maxWord + | same tc int8TyConName -> check i tc (min' @Int8) (max' @Int8) + | same tc int16TyConName -> check i tc (min' @Int16) (max' @Int16) + | same tc int32TyConName -> check i tc (min' @Int32) (max' @Int32) + | same tc int64TyConName -> check i tc (min' @Int64) (max' @Int64) + | same tc word8TyConName -> check i tc (min' @Word8) (max' @Word8) + | same tc word16TyConName -> check i tc (min' @Word16) (max' @Word16) + | same tc word32TyConName -> check i tc (min' @Word32) (max' @Word32) + | same tc word64TyConName -> check i tc (min' @Word64) (max' @Word64) + | same tc naturalTyConName -> checkPositive i tc -- These only show up via the 'HsLit' route - | tc == intPrimTyConName -> check i tc minInt maxInt - | tc == wordPrimTyConName -> check i tc minWord maxWord - | tc == int8PrimTyConName -> check i tc (min' @Int8) (max' @Int8) - | tc == int16PrimTyConName -> check i tc (min' @Int16) (max' @Int16) - | tc == int32PrimTyConName -> check i tc (min' @Int32) (max' @Int32) - | tc == int64PrimTyConName -> check i tc (min' @Int64) (max' @Int64) - | tc == word8PrimTyConName -> check i tc (min' @Word8) (max' @Word8) - | tc == word16PrimTyConName -> check i tc (min' @Word16) (max' @Word16) - | tc == word32PrimTyConName -> check i tc (min' @Word32) (max' @Word32) - | tc == word64PrimTyConName -> check i tc (min' @Word64) (max' @Word64) + | same tc intPrimTyConName -> check i tc minInt maxInt + | same tc wordPrimTyConName -> check i tc minWord maxWord + | same tc int8PrimTyConName -> check i tc (min' @Int8) (max' @Int8) + | same tc int16PrimTyConName -> check i tc (min' @Int16) (max' @Int16) + | same tc int32PrimTyConName -> check i tc (min' @Int32) (max' @Int32) + | same tc int64PrimTyConName -> check i tc (min' @Int64) (max' @Int64) + | same tc word8PrimTyConName -> check i tc (min' @Word8) (max' @Word8) + | same tc word16PrimTyConName -> check i tc (min' @Word16) (max' @Word16) + | same tc word32PrimTyConName -> check i tc (min' @Word32) (max' @Word32) + | same tc word64PrimTyConName -> check i tc (min' @Word64) (max' @Word64) | otherwise -> return () @@ -369,10 +370,6 @@ warnAboutOverflowedLiterals dflags lit where bounds = Just (MinBound minB, MaxBound maxB) - -- Work around #23537 - {-# NOINLINE (==) #-} - (==) = (GHC.Prelude.==) - warnAboutEmptyEnumerations :: FamInstEnvs -> DynFlags -> LHsExpr GhcTc -> Maybe (LHsExpr GhcTc) -> LHsExpr GhcTc -> DsM () @@ -400,28 +397,24 @@ warnAboutEmptyEnumerations fam_envs dflags fromExpr mThnExpr toExpr to = wrap @a to' mThn = fmap (wrap @a . fst) mThn' - -- Work around #23537 - {-# NOINLINE (==) #-} - (==) = (GHC.Prelude.==) - platform <- targetPlatform <$> getDynFlags -- Be careful to use target Int/Word sizes! cf #17336 - if | tc == intTyConName -> case platformWordSize platform of - PW4 -> check @Int32 - PW8 -> check @Int64 - | tc == wordTyConName -> case platformWordSize platform of - PW4 -> check @Word32 - PW8 -> check @Word64 - | tc == int8TyConName -> check @Int8 - | tc == int16TyConName -> check @Int16 - | tc == int32TyConName -> check @Int32 - | tc == int64TyConName -> check @Int64 - | tc == word8TyConName -> check @Word8 - | tc == word16TyConName -> check @Word16 - | tc == word32TyConName -> check @Word32 - | tc == word64TyConName -> check @Word64 - | tc == integerTyConName -> check @Integer - | tc == naturalTyConName -> check @Integer + if | same tc intTyConName -> case platformWordSize platform of + PW4 -> check @Int32 + PW8 -> check @Int64 + | same tc wordTyConName -> case platformWordSize platform of + PW4 -> check @Word32 + PW8 -> check @Word64 + | same tc int8TyConName -> check @Int8 + | same tc int16TyConName -> check @Int16 + | same tc int32TyConName -> check @Int32 + | same tc int64TyConName -> check @Int64 + | same tc word8TyConName -> check @Word8 + | same tc word16TyConName -> check @Word16 + | same tc word32TyConName -> check @Word32 + | same tc word64TyConName -> check @Word64 + | same tc integerTyConName -> check @Integer + | same tc naturalTyConName -> check @Integer -- We use 'Integer' because otherwise a negative 'Natural' literal -- could cause a compile time crash (instead of a runtime one). -- See the T10930b test case for an example of where this matters. ===================================== compiler/GHC/StgToCmm/Ticky.hs ===================================== @@ -157,6 +157,7 @@ import GHC.Types.Id.Info import GHC.StgToCmm.Env (getCgInfo_maybe) import Data.Coerce (coerce) import GHC.Utils.Json +import GHC.Utils.Unique (anyOf) ----------------------------------------------------------------------------- -- @@ -884,22 +885,19 @@ showTypeCategory ty | otherwise = case tcSplitTyConApp_maybe ty of Nothing -> '.' Just (tycon, _) -> - let -- Work around #23537 - {-# NOINLINE anyOf #-} - anyOf us = getUnique tycon `elem` us in case () of - _ | anyOf [fUNTyConKey] -> '>' - | anyOf [charTyConKey] -> 'C' - | anyOf [charPrimTyConKey] -> 'c' - | anyOf [doubleTyConKey] -> 'D' - | anyOf [doublePrimTyConKey] -> 'd' - | anyOf [floatTyConKey] -> 'F' - | anyOf [floatPrimTyConKey] -> 'f' - | anyOf [intTyConKey, int8TyConKey, int16TyConKey, int32TyConKey, int64TyConKey] -> 'I' - | anyOf [intPrimTyConKey, int8PrimTyConKey, int16PrimTyConKey, int32PrimTyConKey, int64PrimTyConKey] -> 'i' - | anyOf [wordTyConKey, word8TyConKey, word16TyConKey, word32TyConKey, word64TyConKey] -> 'W' - | anyOf [wordPrimTyConKey, word8PrimTyConKey, word16PrimTyConKey, word32PrimTyConKey, word64PrimTyConKey] -> 'w' - | anyOf [listTyConKey] -> 'L' + _ | anyOf tycon [fUNTyConKey] -> '>' + | anyOf tycon [charTyConKey] -> 'C' + | anyOf tycon [charPrimTyConKey] -> 'c' + | anyOf tycon [doubleTyConKey] -> 'D' + | anyOf tycon [doublePrimTyConKey] -> 'd' + | anyOf tycon [floatTyConKey] -> 'F' + | anyOf tycon [floatPrimTyConKey] -> 'f' + | anyOf tycon [intTyConKey, int8TyConKey, int16TyConKey, int32TyConKey, int64TyConKey] -> 'I' + | anyOf tycon [intPrimTyConKey, int8PrimTyConKey, int16PrimTyConKey, int32PrimTyConKey, int64PrimTyConKey] -> 'i' + | anyOf tycon [wordTyConKey, word8TyConKey, word16TyConKey, word32TyConKey, word64TyConKey] -> 'W' + | anyOf tycon [wordPrimTyConKey, word8PrimTyConKey, word16PrimTyConKey, word32PrimTyConKey, word64PrimTyConKey] -> 'w' + | anyOf tycon [listTyConKey] -> 'L' | isUnboxedTupleTyCon tycon -> 't' | isTupleTyCon tycon -> 'T' | isPrimTyCon tycon -> 'P' ===================================== compiler/GHC/Tc/Deriv/Utils.hs ===================================== @@ -66,6 +66,7 @@ import GHC.Builtin.Names.TH (liftClassKey) import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Error +import GHC.Utils.Unique (same) import Control.Monad.Trans.Reader import Data.Foldable (traverse_) @@ -893,37 +894,37 @@ classArgsErr cls cls_tys = DerivErrNotAClass (mkClassPred cls cls_tys) -- class for which stock deriving isn't possible. stockSideConditions :: DerivContext -> Class -> Maybe Condition stockSideConditions deriv_ctxt cls - | cls_key == eqClassKey = Just (cond_std `andCond` cond_args cls) - | cls_key == ordClassKey = Just (cond_std `andCond` cond_args cls) - | cls_key == showClassKey = Just (cond_std `andCond` cond_args cls) - | cls_key == readClassKey = Just (cond_std `andCond` cond_args cls) - | cls_key == enumClassKey = Just (cond_std `andCond` cond_isEnumeration) - | cls_key == ixClassKey = Just (cond_std `andCond` cond_enumOrProduct cls) - | cls_key == boundedClassKey = Just (cond_std `andCond` cond_enumOrProduct cls) - | cls_key == dataClassKey = Just (checkFlag LangExt.DeriveDataTypeable `andCond` - cond_vanilla `andCond` - cond_args cls) - | cls_key == functorClassKey = Just (checkFlag LangExt.DeriveFunctor `andCond` - cond_vanilla `andCond` - cond_functorOK True False) - | cls_key == foldableClassKey = Just (checkFlag LangExt.DeriveFoldable `andCond` - cond_vanilla `andCond` - cond_functorOK False True) - -- Functor/Fold/Trav works ok - -- for rank-n types - | cls_key == traversableClassKey = Just (checkFlag LangExt.DeriveTraversable `andCond` - cond_vanilla `andCond` - cond_functorOK False False) - | cls_key == genClassKey = Just (checkFlag LangExt.DeriveGeneric `andCond` - cond_vanilla `andCond` - cond_RepresentableOk) - | cls_key == gen1ClassKey = Just (checkFlag LangExt.DeriveGeneric `andCond` - cond_vanilla `andCond` - cond_Representable1Ok) - | cls_key == liftClassKey = Just (checkFlag LangExt.DeriveLift `andCond` - cond_vanilla `andCond` - cond_args cls) - | otherwise = Nothing + | same cls_key eqClassKey = Just (cond_std `andCond` cond_args cls) + | same cls_key ordClassKey = Just (cond_std `andCond` cond_args cls) + | same cls_key showClassKey = Just (cond_std `andCond` cond_args cls) + | same cls_key readClassKey = Just (cond_std `andCond` cond_args cls) + | same cls_key enumClassKey = Just (cond_std `andCond` cond_isEnumeration) + | same cls_key ixClassKey = Just (cond_std `andCond` cond_enumOrProduct cls) + | same cls_key boundedClassKey = Just (cond_std `andCond` cond_enumOrProduct cls) + | same cls_key dataClassKey = Just (checkFlag LangExt.DeriveDataTypeable `andCond` + cond_vanilla `andCond` + cond_args cls) + | same cls_key functorClassKey = Just (checkFlag LangExt.DeriveFunctor `andCond` + cond_vanilla `andCond` + cond_functorOK True False) + | same cls_key foldableClassKey = Just (checkFlag LangExt.DeriveFoldable `andCond` + cond_vanilla `andCond` + cond_functorOK False True) + -- Functor/Fold/Trav works ok + -- for rank-n types + | same cls_key traversableClassKey = Just (checkFlag LangExt.DeriveTraversable `andCond` + cond_vanilla `andCond` + cond_functorOK False False) + | same cls_key genClassKey = Just (checkFlag LangExt.DeriveGeneric `andCond` + cond_vanilla `andCond` + cond_RepresentableOk) + | same cls_key gen1ClassKey = Just (checkFlag LangExt.DeriveGeneric `andCond` + cond_vanilla `andCond` + cond_Representable1Ok) + | same cls_key liftClassKey = Just (checkFlag LangExt.DeriveLift `andCond` + cond_vanilla `andCond` + cond_args cls) + | otherwise = Nothing where cls_key = getUnique cls cond_std = cond_stdOK deriv_ctxt False @@ -931,10 +932,6 @@ stockSideConditions deriv_ctxt cls cond_vanilla = cond_stdOK deriv_ctxt True -- Vanilla data constructors but allow no data cons or polytype arguments - -- Work around #23537 - {-# NOINLINE (==) #-} - (==) = (GHC.Prelude.==) - type Condition = DynFlags ===================================== compiler/GHC/Tc/Utils/Instantiate.hs ===================================== @@ -89,6 +89,7 @@ import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Utils.Panic.Plain import GHC.Utils.Outputable +import GHC.Utils.Unique (same) import GHC.Unit.State import GHC.Unit.External @@ -791,25 +792,21 @@ hasFixedRuntimeRepRes std_nm user_expr ty = mapM_ do_check mb_arity in hasFixedRuntimeRep_syntactic (FRRArrow $ ArrowFun user_expr) res_ty mb_arity :: Maybe Arity mb_arity -- arity of the arrow operation, counting type-level arguments - | std_nm == arrAName -- result used as an argument in, e.g., do_premap + | same std_nm arrAName -- result used as an argument in, e.g., do_premap = Just 3 - | std_nm == composeAName -- result used as an argument in, e.g., dsCmdStmt/BodyStmt + | same std_nm composeAName -- result used as an argument in, e.g., dsCmdStmt/BodyStmt = Just 5 - | std_nm == firstAName -- result used as an argument in, e.g., dsCmdStmt/BodyStmt + | same std_nm firstAName -- result used as an argument in, e.g., dsCmdStmt/BodyStmt = Just 4 - | std_nm == appAName -- result used as an argument in, e.g., dsCmd/HsCmdArrApp/HsHigherOrderApp + | same std_nm appAName -- result used as an argument in, e.g., dsCmd/HsCmdArrApp/HsHigherOrderApp = Just 2 - | std_nm == choiceAName -- result used as an argument in, e.g., HsCmdIf + | same std_nm choiceAName -- result used as an argument in, e.g., HsCmdIf = Just 5 - | std_nm == loopAName -- result used as an argument in, e.g., HsCmdIf + | same std_nm loopAName -- result used as an argument in, e.g., HsCmdIf = Just 4 | otherwise = Nothing - -- Work around #23537 - {-# NOINLINE (==) #-} - (==) = (GHC.Prelude.==) - {- ************************************************************************ * * ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -249,6 +249,7 @@ import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Panic.Plain import GHC.Utils.Error( Validity'(..) ) +import GHC.Utils.Unique( anyOf ) import qualified GHC.LanguageExtensions as LangExt import Data.IORef ( IORef ) @@ -2255,23 +2256,19 @@ marshalableTyCon dflags tc boxedMarshalableTyCon :: TyCon -> Validity' TypeCannotBeMarshaledReason boxedMarshalableTyCon tc - | anyOf [ intTyConKey, int8TyConKey, int16TyConKey - , int32TyConKey, int64TyConKey - , wordTyConKey, word8TyConKey, word16TyConKey - , word32TyConKey, word64TyConKey - , floatTyConKey, doubleTyConKey - , ptrTyConKey, funPtrTyConKey - , charTyConKey - , stablePtrTyConKey - , boolTyConKey - ] + | anyOf tc [ intTyConKey, int8TyConKey, int16TyConKey + , int32TyConKey, int64TyConKey + , wordTyConKey, word8TyConKey, word16TyConKey + , word32TyConKey, word64TyConKey + , floatTyConKey, doubleTyConKey + , ptrTyConKey, funPtrTyConKey + , charTyConKey + , stablePtrTyConKey + , boolTyConKey + ] = IsValid | otherwise = NotValid NotABoxedMarshalableTyCon - where - -- Work around #23537 - {-# NOINLINE anyOf #-} - anyOf x = getUnique tc `elem` x legalFIPrimArgTyCon :: DynFlags -> TyCon -> Validity' TypeCannotBeMarshaledReason -- Check args of 'foreign import prim', only allow simple unlifted types. ===================================== compiler/GHC/Utils/Unique.hs ===================================== @@ -0,0 +1,35 @@ +{-# LANGUAGE CPP #-} + +{- Work around #23537 + +On 32 bit systems, GHC's code gen around 64 bit numbers is not quite +complete. This led to panics mentioning missing cases in iselExpr64. +Now that GHC uses Word64 for its uniques, these panics have started +popping up whenever a unique is compared to many other uniques in one +function. As a work around we use these two functions which are not +inlined on 32 bit systems, thus preventing the panics. +-} + +module GHC.Utils.Unique (same, anyOf) where + +#include "MachDeps.h" + +import GHC.Prelude.Basic ( Bool, Eq((==)), Foldable(elem) ) +import GHC.Types.Unique (Unique, Uniquable (getUnique)) + + +#if WORD_SIZE_IN_BITS == 32 +{-# NOINLINE same #-} +#else +{-# INLINE same #-} +#endif +same :: Eq a => a -> a -> Bool +same = (==) + +#if WORD_SIZE_IN_BITS == 32 +{-# NOINLINE anyOf #-} +#else +{-# INLINE anyOf #-} +#endif +anyOf :: Uniquable a => a -> [Unique] -> Bool +anyOf tc xs = getUnique tc `elem` xs \ No newline at end of file ===================================== compiler/ghc.cabal.in ===================================== @@ -900,6 +900,7 @@ Library GHC.Utils.Ppr.Colour GHC.Utils.TmpFs GHC.Utils.Trace + GHC.Utils.Unique GHC.Wasm.ControlFlow GHC.Wasm.ControlFlow.FromCmm GHC.CmmToAsm.Wasm ===================================== testsuite/tests/count-deps/CountDepsAst.stdout ===================================== @@ -315,6 +315,7 @@ GHC.Utils.Ppr GHC.Utils.Ppr.Colour GHC.Utils.TmpFs GHC.Utils.Trace +GHC.Utils.Unique Language.Haskell.Syntax Language.Haskell.Syntax.Basic Language.Haskell.Syntax.Binds ===================================== testsuite/tests/count-deps/CountDepsParser.stdout ===================================== @@ -322,6 +322,7 @@ GHC.Utils.Ppr GHC.Utils.Ppr.Colour GHC.Utils.TmpFs GHC.Utils.Trace +GHC.Utils.Unique Language.Haskell.Syntax Language.Haskell.Syntax.Basic Language.Haskell.Syntax.Binds View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/be92a75cf92969cd7ca56f83b6b7d8840db8725a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/be92a75cf92969cd7ca56f83b6b7d8840db8725a You're receiving 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 Jun 26 10:02:16 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 26 Jun 2023 06:02:16 -0400 Subject: [Git][ghc/ghc][wip/T22010] Fix whitespace and allow regression on i386 Message-ID: <649962284c7e3_64cc022056dc2375f4@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 5f631a45 by Jaro Reinders at 2023-06-26T12:02:11+02:00 Fix whitespace and allow regression on i386 Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 1 changed file: - compiler/GHC/HsToCore/Match/Literal.hs Changes: ===================================== compiler/GHC/HsToCore/Match/Literal.hs ===================================== @@ -400,11 +400,11 @@ warnAboutEmptyEnumerations fam_envs dflags fromExpr mThnExpr toExpr platform <- targetPlatform <$> getDynFlags -- Be careful to use target Int/Word sizes! cf #17336 if | same tc intTyConName -> case platformWordSize platform of - PW4 -> check @Int32 - PW8 -> check @Int64 + PW4 -> check @Int32 + PW8 -> check @Int64 | same tc wordTyConName -> case platformWordSize platform of - PW4 -> check @Word32 - PW8 -> check @Word64 + PW4 -> check @Word32 + PW8 -> check @Word64 | same tc int8TyConName -> check @Int8 | same tc int16TyConName -> check @Int16 | same tc int32TyConName -> check @Int32 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5f631a45011a6c193012dc4f997fea1351f988bc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5f631a45011a6c193012dc4f997fea1351f988bc You're receiving 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 Jun 26 10:25:01 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 06:25:01 -0400 Subject: [Git][ghc/ghc][wip/romes/ghc-platform] Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Message-ID: <6499677d26a35_64cc0c76c824472d@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/ghc-platform at Glasgow Haskell Compiler / GHC Commits: 74056b8b by Rodrigo Mesquita at 2023-06-26T11:24:51+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - 8 changed files: - hadrian/src/Packages.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Default.hs - libraries/ghc-boot/ghc-boot.cabal.in - + libraries/ghc-platform/CHANGELOG.md - + libraries/ghc-platform/LICENSE - + libraries/ghc-platform/ghc-platform.cabal - libraries/ghc-boot/GHC/Platform/ArchOS.hs → libraries/ghc-platform/src/GHC/Platform/ArchOS.hs Changes: ===================================== hadrian/src/Packages.hs ===================================== @@ -4,7 +4,7 @@ module Packages ( array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, - exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, + exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, @@ -36,7 +36,7 @@ ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps , compareSizes, compiler, containers, deepseq, deriveConstants, directory - , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh + , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell @@ -52,7 +52,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, - exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, + exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, @@ -83,6 +83,7 @@ ghc = prg "ghc-bin" `setPath` "ghc" ghcBignum = lib "ghc-bignum" ghcBoot = lib "ghc-boot" ghcBootTh = lib "ghc-boot-th" +ghcPlatform = lib "ghc-platform" ghcCompact = lib "ghc-compact" ghcConfig = prg "ghc-config" `setPath` "testsuite/ghc-config" ghcHeap = lib "ghc-heap" ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -158,6 +158,7 @@ toolTargets = [ binary -- , runGhc -- # depends on ghc library , ghcBoot , ghcBootTh + , ghcPlatform , ghcHeap , ghci , ghcPkg -- # executable ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -85,6 +85,7 @@ stage0Packages = do , runGhc , ghcBoot , ghcBootTh + , ghcPlatform , ghcHeap , ghci , ghcPkg ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -51,7 +51,6 @@ Library GHC.Serialized GHC.ForeignSrcLang GHC.HandleEncoding - GHC.Platform.ArchOS GHC.Platform.Host GHC.Settings.Utils GHC.UniqueSubdir @@ -65,6 +64,10 @@ Library , GHC.ForeignSrcLang.Type , GHC.Lexeme + -- reexport platform modules from ghc-platform + reexported-modules: + GHC.Platform.ArchOS + -- but done by Hadrian autogen-modules: GHC.Version @@ -77,6 +80,7 @@ Library directory >= 1.2 && < 1.4, filepath >= 1.3 && < 1.5, deepseq >= 1.4 && < 1.5, + ghc-platform >= 0.1, ghc-boot-th == @ProjectVersionMunged@ if !os(windows) build-depends: ===================================== libraries/ghc-platform/CHANGELOG.md ===================================== @@ -0,0 +1,8 @@ +# Revision history for ghc-platform + +## 0.1.0.0 -- 2023-06-20 + +* First version. Split off the `GHC.Platform.ArchOS` module from the + non-reinstallable `ghc-boot` package into this reinstallable standalone + package which abides by the PVP, in part motivated by the ongoing work on + `ghc-toolchain` towards runtime retargetability. ===================================== libraries/ghc-platform/LICENSE ===================================== @@ -0,0 +1,30 @@ +Copyright (c) 2023, Rodrigo Mesquita + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Rodrigo Mesquita nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ===================================== libraries/ghc-platform/ghc-platform.cabal ===================================== @@ -0,0 +1,20 @@ +cabal-version: 3.0 +name: ghc-platform +version: 0.1.0.0 +synopsis: Platform information used by GHC and friends +license: BSD-3-Clause +license-file: LICENSE +author: Rodrigo Mesquita +maintainer: ghc-devs at haskell.org +build-type: Simple +extra-doc-files: CHANGELOG.md + +common warnings + ghc-options: -Wall + +library + import: warnings + exposed-modules: GHC.Platform.ArchOS + build-depends: base >=4.17.0.0 + hs-source-dirs: src + default-language: Haskell2010 ===================================== libraries/ghc-boot/GHC/Platform/ArchOS.hs → libraries/ghc-platform/src/GHC/Platform/ArchOS.hs ===================================== View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/74056b8be81ada0251a7fe2ba70ff7288be72f99 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/74056b8be81ada0251a7fe2ba70ff7288be72f99 You're receiving 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 Jun 26 10:25:15 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Mon, 26 Jun 2023 06:25:15 -0400 Subject: [Git][ghc/ghc][wip/T22010] Rename same to sameUnique & anyOf to anyOfUnique Message-ID: <6499678bdf8a_64cc0c76c82451ee@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 5da7cfaf by Jaro Reinders at 2023-06-26T12:25:06+02:00 Rename same to sameUnique & anyOf to anyOfUnique - - - - - 6 changed files: - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/Tc/Deriv/Utils.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Utils/Unique.hs Changes: ===================================== compiler/GHC/HsToCore/Match/Literal.hs ===================================== @@ -64,7 +64,7 @@ import GHC.Utils.Outputable as Outputable import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Utils.Panic.Plain -import GHC.Utils.Unique (same) +import GHC.Utils.Unique (sameUnique) import GHC.Data.FastString @@ -320,29 +320,29 @@ warnAboutOverflowedLiterals dflags lit , Just (i, tc) <- lit = if -- These only show up via the 'HsOverLit' route - | same tc intTyConName -> check i tc minInt maxInt - | same tc wordTyConName -> check i tc minWord maxWord - | same tc int8TyConName -> check i tc (min' @Int8) (max' @Int8) - | same tc int16TyConName -> check i tc (min' @Int16) (max' @Int16) - | same tc int32TyConName -> check i tc (min' @Int32) (max' @Int32) - | same tc int64TyConName -> check i tc (min' @Int64) (max' @Int64) - | same tc word8TyConName -> check i tc (min' @Word8) (max' @Word8) - | same tc word16TyConName -> check i tc (min' @Word16) (max' @Word16) - | same tc word32TyConName -> check i tc (min' @Word32) (max' @Word32) - | same tc word64TyConName -> check i tc (min' @Word64) (max' @Word64) - | same tc naturalTyConName -> checkPositive i tc + | sameUnique tc intTyConName -> check i tc minInt maxInt + | sameUnique tc wordTyConName -> check i tc minWord maxWord + | sameUnique tc int8TyConName -> check i tc (min' @Int8) (max' @Int8) + | sameUnique tc int16TyConName -> check i tc (min' @Int16) (max' @Int16) + | sameUnique tc int32TyConName -> check i tc (min' @Int32) (max' @Int32) + | sameUnique tc int64TyConName -> check i tc (min' @Int64) (max' @Int64) + | sameUnique tc word8TyConName -> check i tc (min' @Word8) (max' @Word8) + | sameUnique tc word16TyConName -> check i tc (min' @Word16) (max' @Word16) + | sameUnique tc word32TyConName -> check i tc (min' @Word32) (max' @Word32) + | sameUnique tc word64TyConName -> check i tc (min' @Word64) (max' @Word64) + | sameUnique tc naturalTyConName -> checkPositive i tc -- These only show up via the 'HsLit' route - | same tc intPrimTyConName -> check i tc minInt maxInt - | same tc wordPrimTyConName -> check i tc minWord maxWord - | same tc int8PrimTyConName -> check i tc (min' @Int8) (max' @Int8) - | same tc int16PrimTyConName -> check i tc (min' @Int16) (max' @Int16) - | same tc int32PrimTyConName -> check i tc (min' @Int32) (max' @Int32) - | same tc int64PrimTyConName -> check i tc (min' @Int64) (max' @Int64) - | same tc word8PrimTyConName -> check i tc (min' @Word8) (max' @Word8) - | same tc word16PrimTyConName -> check i tc (min' @Word16) (max' @Word16) - | same tc word32PrimTyConName -> check i tc (min' @Word32) (max' @Word32) - | same tc word64PrimTyConName -> check i tc (min' @Word64) (max' @Word64) + | sameUnique tc intPrimTyConName -> check i tc minInt maxInt + | sameUnique tc wordPrimTyConName -> check i tc minWord maxWord + | sameUnique tc int8PrimTyConName -> check i tc (min' @Int8) (max' @Int8) + | sameUnique tc int16PrimTyConName -> check i tc (min' @Int16) (max' @Int16) + | sameUnique tc int32PrimTyConName -> check i tc (min' @Int32) (max' @Int32) + | sameUnique tc int64PrimTyConName -> check i tc (min' @Int64) (max' @Int64) + | sameUnique tc word8PrimTyConName -> check i tc (min' @Word8) (max' @Word8) + | sameUnique tc word16PrimTyConName -> check i tc (min' @Word16) (max' @Word16) + | sameUnique tc word32PrimTyConName -> check i tc (min' @Word32) (max' @Word32) + | sameUnique tc word64PrimTyConName -> check i tc (min' @Word64) (max' @Word64) | otherwise -> return () @@ -399,22 +399,22 @@ warnAboutEmptyEnumerations fam_envs dflags fromExpr mThnExpr toExpr platform <- targetPlatform <$> getDynFlags -- Be careful to use target Int/Word sizes! cf #17336 - if | same tc intTyConName -> case platformWordSize platform of - PW4 -> check @Int32 - PW8 -> check @Int64 - | same tc wordTyConName -> case platformWordSize platform of - PW4 -> check @Word32 - PW8 -> check @Word64 - | same tc int8TyConName -> check @Int8 - | same tc int16TyConName -> check @Int16 - | same tc int32TyConName -> check @Int32 - | same tc int64TyConName -> check @Int64 - | same tc word8TyConName -> check @Word8 - | same tc word16TyConName -> check @Word16 - | same tc word32TyConName -> check @Word32 - | same tc word64TyConName -> check @Word64 - | same tc integerTyConName -> check @Integer - | same tc naturalTyConName -> check @Integer + if | sameUnique tc intTyConName -> case platformWordSize platform of + PW4 -> check @Int32 + PW8 -> check @Int64 + | sameUnique tc wordTyConName -> case platformWordSize platform of + PW4 -> check @Word32 + PW8 -> check @Word64 + | sameUnique tc int8TyConName -> check @Int8 + | sameUnique tc int16TyConName -> check @Int16 + | sameUnique tc int32TyConName -> check @Int32 + | sameUnique tc int64TyConName -> check @Int64 + | sameUnique tc word8TyConName -> check @Word8 + | sameUnique tc word16TyConName -> check @Word16 + | sameUnique tc word32TyConName -> check @Word32 + | sameUnique tc word64TyConName -> check @Word64 + | sameUnique tc integerTyConName -> check @Integer + | sameUnique tc naturalTyConName -> check @Integer -- We use 'Integer' because otherwise a negative 'Natural' literal -- could cause a compile time crash (instead of a runtime one). -- See the T10930b test case for an example of where this matters. ===================================== compiler/GHC/StgToCmm/Ticky.hs ===================================== @@ -157,7 +157,7 @@ import GHC.Types.Id.Info import GHC.StgToCmm.Env (getCgInfo_maybe) import Data.Coerce (coerce) import GHC.Utils.Json -import GHC.Utils.Unique (anyOf) +import GHC.Utils.Unique (anyOfUnique) ----------------------------------------------------------------------------- -- @@ -886,18 +886,18 @@ showTypeCategory ty Nothing -> '.' Just (tycon, _) -> case () of - _ | anyOf tycon [fUNTyConKey] -> '>' - | anyOf tycon [charTyConKey] -> 'C' - | anyOf tycon [charPrimTyConKey] -> 'c' - | anyOf tycon [doubleTyConKey] -> 'D' - | anyOf tycon [doublePrimTyConKey] -> 'd' - | anyOf tycon [floatTyConKey] -> 'F' - | anyOf tycon [floatPrimTyConKey] -> 'f' - | anyOf tycon [intTyConKey, int8TyConKey, int16TyConKey, int32TyConKey, int64TyConKey] -> 'I' - | anyOf tycon [intPrimTyConKey, int8PrimTyConKey, int16PrimTyConKey, int32PrimTyConKey, int64PrimTyConKey] -> 'i' - | anyOf tycon [wordTyConKey, word8TyConKey, word16TyConKey, word32TyConKey, word64TyConKey] -> 'W' - | anyOf tycon [wordPrimTyConKey, word8PrimTyConKey, word16PrimTyConKey, word32PrimTyConKey, word64PrimTyConKey] -> 'w' - | anyOf tycon [listTyConKey] -> 'L' + _ | anyOfUnique tycon [fUNTyConKey] -> '>' + | anyOfUnique tycon [charTyConKey] -> 'C' + | anyOfUnique tycon [charPrimTyConKey] -> 'c' + | anyOfUnique tycon [doubleTyConKey] -> 'D' + | anyOfUnique tycon [doublePrimTyConKey] -> 'd' + | anyOfUnique tycon [floatTyConKey] -> 'F' + | anyOfUnique tycon [floatPrimTyConKey] -> 'f' + | anyOfUnique tycon [intTyConKey, int8TyConKey, int16TyConKey, int32TyConKey, int64TyConKey] -> 'I' + | anyOfUnique tycon [intPrimTyConKey, int8PrimTyConKey, int16PrimTyConKey, int32PrimTyConKey, int64PrimTyConKey] -> 'i' + | anyOfUnique tycon [wordTyConKey, word8TyConKey, word16TyConKey, word32TyConKey, word64TyConKey] -> 'W' + | anyOfUnique tycon [wordPrimTyConKey, word8PrimTyConKey, word16PrimTyConKey, word32PrimTyConKey, word64PrimTyConKey] -> 'w' + | anyOfUnique tycon [listTyConKey] -> 'L' | isUnboxedTupleTyCon tycon -> 't' | isTupleTyCon tycon -> 'T' | isPrimTyCon tycon -> 'P' ===================================== compiler/GHC/Tc/Deriv/Utils.hs ===================================== @@ -66,7 +66,7 @@ import GHC.Builtin.Names.TH (liftClassKey) import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Error -import GHC.Utils.Unique (same) +import GHC.Utils.Unique (sameUnique) import Control.Monad.Trans.Reader import Data.Foldable (traverse_) @@ -894,36 +894,36 @@ classArgsErr cls cls_tys = DerivErrNotAClass (mkClassPred cls cls_tys) -- class for which stock deriving isn't possible. stockSideConditions :: DerivContext -> Class -> Maybe Condition stockSideConditions deriv_ctxt cls - | same cls_key eqClassKey = Just (cond_std `andCond` cond_args cls) - | same cls_key ordClassKey = Just (cond_std `andCond` cond_args cls) - | same cls_key showClassKey = Just (cond_std `andCond` cond_args cls) - | same cls_key readClassKey = Just (cond_std `andCond` cond_args cls) - | same cls_key enumClassKey = Just (cond_std `andCond` cond_isEnumeration) - | same cls_key ixClassKey = Just (cond_std `andCond` cond_enumOrProduct cls) - | same cls_key boundedClassKey = Just (cond_std `andCond` cond_enumOrProduct cls) - | same cls_key dataClassKey = Just (checkFlag LangExt.DeriveDataTypeable `andCond` - cond_vanilla `andCond` - cond_args cls) - | same cls_key functorClassKey = Just (checkFlag LangExt.DeriveFunctor `andCond` - cond_vanilla `andCond` - cond_functorOK True False) - | same cls_key foldableClassKey = Just (checkFlag LangExt.DeriveFoldable `andCond` - cond_vanilla `andCond` - cond_functorOK False True) - -- Functor/Fold/Trav works ok - -- for rank-n types - | same cls_key traversableClassKey = Just (checkFlag LangExt.DeriveTraversable `andCond` - cond_vanilla `andCond` - cond_functorOK False False) - | same cls_key genClassKey = Just (checkFlag LangExt.DeriveGeneric `andCond` - cond_vanilla `andCond` - cond_RepresentableOk) - | same cls_key gen1ClassKey = Just (checkFlag LangExt.DeriveGeneric `andCond` - cond_vanilla `andCond` - cond_Representable1Ok) - | same cls_key liftClassKey = Just (checkFlag LangExt.DeriveLift `andCond` - cond_vanilla `andCond` - cond_args cls) + | sameUnique cls_key eqClassKey = Just (cond_std `andCond` cond_args cls) + | sameUnique cls_key ordClassKey = Just (cond_std `andCond` cond_args cls) + | sameUnique cls_key showClassKey = Just (cond_std `andCond` cond_args cls) + | sameUnique cls_key readClassKey = Just (cond_std `andCond` cond_args cls) + | sameUnique cls_key enumClassKey = Just (cond_std `andCond` cond_isEnumeration) + | sameUnique cls_key ixClassKey = Just (cond_std `andCond` cond_enumOrProduct cls) + | sameUnique cls_key boundedClassKey = Just (cond_std `andCond` cond_enumOrProduct cls) + | sameUnique cls_key dataClassKey = Just (checkFlag LangExt.DeriveDataTypeable `andCond` + cond_vanilla `andCond` + cond_args cls) + | sameUnique cls_key functorClassKey = Just (checkFlag LangExt.DeriveFunctor `andCond` + cond_vanilla `andCond` + cond_functorOK True False) + | sameUnique cls_key foldableClassKey = Just (checkFlag LangExt.DeriveFoldable `andCond` + cond_vanilla `andCond` + cond_functorOK False True) + -- Functor/Fold/Trav works ok + -- for rank-n types + | sameUnique cls_key traversableClassKey = Just (checkFlag LangExt.DeriveTraversable `andCond` + cond_vanilla `andCond` + cond_functorOK False False) + | sameUnique cls_key genClassKey = Just (checkFlag LangExt.DeriveGeneric `andCond` + cond_vanilla `andCond` + cond_RepresentableOk) + | sameUnique cls_key gen1ClassKey = Just (checkFlag LangExt.DeriveGeneric `andCond` + cond_vanilla `andCond` + cond_Representable1Ok) + | sameUnique cls_key liftClassKey = Just (checkFlag LangExt.DeriveLift `andCond` + cond_vanilla `andCond` + cond_args cls) | otherwise = Nothing where cls_key = getUnique cls ===================================== compiler/GHC/Tc/Utils/Instantiate.hs ===================================== @@ -89,7 +89,7 @@ import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Utils.Panic.Plain import GHC.Utils.Outputable -import GHC.Utils.Unique (same) +import GHC.Utils.Unique (sameUnique) import GHC.Unit.State import GHC.Unit.External @@ -792,17 +792,17 @@ hasFixedRuntimeRepRes std_nm user_expr ty = mapM_ do_check mb_arity in hasFixedRuntimeRep_syntactic (FRRArrow $ ArrowFun user_expr) res_ty mb_arity :: Maybe Arity mb_arity -- arity of the arrow operation, counting type-level arguments - | same std_nm arrAName -- result used as an argument in, e.g., do_premap + | sameUnique std_nm arrAName -- result used as an argument in, e.g., do_premap = Just 3 - | same std_nm composeAName -- result used as an argument in, e.g., dsCmdStmt/BodyStmt + | sameUnique std_nm composeAName -- result used as an argument in, e.g., dsCmdStmt/BodyStmt = Just 5 - | same std_nm firstAName -- result used as an argument in, e.g., dsCmdStmt/BodyStmt + | sameUnique std_nm firstAName -- result used as an argument in, e.g., dsCmdStmt/BodyStmt = Just 4 - | same std_nm appAName -- result used as an argument in, e.g., dsCmd/HsCmdArrApp/HsHigherOrderApp + | sameUnique std_nm appAName -- result used as an argument in, e.g., dsCmd/HsCmdArrApp/HsHigherOrderApp = Just 2 - | same std_nm choiceAName -- result used as an argument in, e.g., HsCmdIf + | sameUnique std_nm choiceAName -- result used as an argument in, e.g., HsCmdIf = Just 5 - | same std_nm loopAName -- result used as an argument in, e.g., HsCmdIf + | sameUnique std_nm loopAName -- result used as an argument in, e.g., HsCmdIf = Just 4 | otherwise = Nothing ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -249,7 +249,7 @@ import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Panic.Plain import GHC.Utils.Error( Validity'(..) ) -import GHC.Utils.Unique( anyOf ) +import GHC.Utils.Unique( anyOfUnique ) import qualified GHC.LanguageExtensions as LangExt import Data.IORef ( IORef ) @@ -2256,16 +2256,16 @@ marshalableTyCon dflags tc boxedMarshalableTyCon :: TyCon -> Validity' TypeCannotBeMarshaledReason boxedMarshalableTyCon tc - | anyOf tc [ intTyConKey, int8TyConKey, int16TyConKey - , int32TyConKey, int64TyConKey - , wordTyConKey, word8TyConKey, word16TyConKey - , word32TyConKey, word64TyConKey - , floatTyConKey, doubleTyConKey - , ptrTyConKey, funPtrTyConKey - , charTyConKey - , stablePtrTyConKey - , boolTyConKey - ] + | anyOfUnique tc [ intTyConKey, int8TyConKey, int16TyConKey + , int32TyConKey, int64TyConKey + , wordTyConKey, word8TyConKey, word16TyConKey + , word32TyConKey, word64TyConKey + , floatTyConKey, doubleTyConKey + , ptrTyConKey, funPtrTyConKey + , charTyConKey + , stablePtrTyConKey + , boolTyConKey + ] = IsValid | otherwise = NotValid NotABoxedMarshalableTyCon ===================================== compiler/GHC/Utils/Unique.hs ===================================== @@ -2,34 +2,34 @@ {- Work around #23537 -On 32 bit systems, GHC's code gen around 64 bit numbers is not quite +On 32 bit systems, GHC's codegen around 64 bit numbers is not quite complete. This led to panics mentioning missing cases in iselExpr64. Now that GHC uses Word64 for its uniques, these panics have started popping up whenever a unique is compared to many other uniques in one -function. As a work around we use these two functions which are not +function. As a workaround we use these two functions which are not inlined on 32 bit systems, thus preventing the panics. -} -module GHC.Utils.Unique (same, anyOf) where +module GHC.Utils.Unique (sameUnique, anyOfUnique) where #include "MachDeps.h" -import GHC.Prelude.Basic ( Bool, Eq((==)), Foldable(elem) ) +import GHC.Prelude.Basic (Bool, Eq((==)), Foldable(elem)) import GHC.Types.Unique (Unique, Uniquable (getUnique)) #if WORD_SIZE_IN_BITS == 32 -{-# NOINLINE same #-} +{-# NOINLINE sameUnique #-} #else -{-# INLINE same #-} +{-# INLINE sameUnique #-} #endif -same :: Eq a => a -> a -> Bool -same = (==) +sameUnique :: Uniquable a => a -> a -> Bool +sameUnique x y = getUnique x == getUnique y #if WORD_SIZE_IN_BITS == 32 -{-# NOINLINE anyOf #-} +{-# NOINLINE anyOfUnique #-} #else -{-# INLINE anyOf #-} +{-# INLINE anyOfUnique #-} #endif -anyOf :: Uniquable a => a -> [Unique] -> Bool -anyOf tc xs = getUnique tc `elem` xs \ No newline at end of file +anyOfUnique :: Uniquable a => a -> [Unique] -> Bool +anyOfUnique tc xs = getUnique tc `elem` xs \ No newline at end of file View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5da7cfaf00ef229c32832597b922e49bd919b668 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5da7cfaf00ef229c32832597b922e49bd919b668 You're receiving 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 Jun 26 10:34:03 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 06:34:03 -0400 Subject: [Git][ghc/ghc][wip/romes/ghc-platform] Split GHC.Platform.ArchOS from ghc-boot into ghc-platform Message-ID: <6499699b25b95_64cc0c76a0247412@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/ghc-platform at Glasgow Haskell Compiler / GHC Commits: 51b64549 by Rodrigo Mesquita at 2023-06-26T11:33:52+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - 8 changed files: - hadrian/src/Packages.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Default.hs - libraries/ghc-boot/ghc-boot.cabal.in - + libraries/ghc-platform/CHANGELOG.md - + libraries/ghc-platform/LICENSE - + libraries/ghc-platform/ghc-platform.cabal - libraries/ghc-boot/GHC/Platform/ArchOS.hs → libraries/ghc-platform/src/GHC/Platform/ArchOS.hs Changes: ===================================== hadrian/src/Packages.hs ===================================== @@ -4,7 +4,7 @@ module Packages ( array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, - exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, + exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, @@ -36,7 +36,7 @@ ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps , compareSizes, compiler, containers, deepseq, deriveConstants, directory - , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh + , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell @@ -52,7 +52,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, - exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, + exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, @@ -83,6 +83,7 @@ ghc = prg "ghc-bin" `setPath` "ghc" ghcBignum = lib "ghc-bignum" ghcBoot = lib "ghc-boot" ghcBootTh = lib "ghc-boot-th" +ghcPlatform = lib "ghc-platform" ghcCompact = lib "ghc-compact" ghcConfig = prg "ghc-config" `setPath` "testsuite/ghc-config" ghcHeap = lib "ghc-heap" ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -158,6 +158,7 @@ toolTargets = [ binary -- , runGhc -- # depends on ghc library , ghcBoot , ghcBootTh + , ghcPlatform , ghcHeap , ghci , ghcPkg -- # executable ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -85,6 +85,7 @@ stage0Packages = do , runGhc , ghcBoot , ghcBootTh + , ghcPlatform , ghcHeap , ghci , ghcPkg ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -51,7 +51,6 @@ Library GHC.Serialized GHC.ForeignSrcLang GHC.HandleEncoding - GHC.Platform.ArchOS GHC.Platform.Host GHC.Settings.Utils GHC.UniqueSubdir @@ -65,6 +64,10 @@ Library , GHC.ForeignSrcLang.Type , GHC.Lexeme + -- reexport platform modules from ghc-platform + reexported-modules: + GHC.Platform.ArchOS + -- but done by Hadrian autogen-modules: GHC.Version @@ -77,6 +80,7 @@ Library directory >= 1.2 && < 1.4, filepath >= 1.3 && < 1.5, deepseq >= 1.4 && < 1.5, + ghc-platform >= 0.1, ghc-boot-th == @ProjectVersionMunged@ if !os(windows) build-depends: ===================================== libraries/ghc-platform/CHANGELOG.md ===================================== @@ -0,0 +1,8 @@ +# Revision history for ghc-platform + +## 0.1.0.0 -- 2023-06-20 + +* First version. Split off the `GHC.Platform.ArchOS` module from the + non-reinstallable `ghc-boot` package into this reinstallable standalone + package which abides by the PVP, in part motivated by the ongoing work on + `ghc-toolchain` towards runtime retargetability. ===================================== libraries/ghc-platform/LICENSE ===================================== @@ -0,0 +1,30 @@ +Copyright (c) 2023, Rodrigo Mesquita + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Rodrigo Mesquita nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ===================================== libraries/ghc-platform/ghc-platform.cabal ===================================== @@ -0,0 +1,20 @@ +cabal-version: 3.0 +name: ghc-platform +version: 0.1.0.0 +synopsis: Platform information used by GHC and friends +license: BSD-3-Clause +license-file: LICENSE +author: Rodrigo Mesquita +maintainer: ghc-devs at haskell.org +build-type: Simple +extra-doc-files: CHANGELOG.md + +common warnings + ghc-options: -Wall + +library + import: warnings + exposed-modules: GHC.Platform.ArchOS + build-depends: base >=4.15.0.0 + hs-source-dirs: src + default-language: Haskell2010 ===================================== libraries/ghc-boot/GHC/Platform/ArchOS.hs → libraries/ghc-platform/src/GHC/Platform/ArchOS.hs ===================================== View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/51b64549b55ab53b66b93a9a16cbcb5af76bfc0e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/51b64549b55ab53b66b93a9a16cbcb5af76bfc0e You're receiving 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 Jun 26 10:53:29 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 06:53:29 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 5 commits: Part of -Wl,--no-as-needed saga Message-ID: <64996e292a9c2_64cc0c75d82562a4@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: bd8f0e0a by Rodrigo Mesquita at 2023-06-26T11:53:18+01:00 Part of -Wl,--no-as-needed saga - - - - - 7df6961f by Rodrigo Mesquita at 2023-06-26T11:53:18+01:00 Support more targets and dont use llvmtarget - - - - - 994ffb61 by Rodrigo Mesquita at 2023-06-26T11:53:18+01:00 allow duplos in place of triples - - - - - 000d60a0 by Rodrigo Mesquita at 2023-06-26T11:53:18+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - db1e17ea by Rodrigo Mesquita at 2023-06-26T11:53:18+01:00 Use ghc-platform instead of ghc-boot del async dep - - - - - 19 changed files: - hadrian/cabal.project - hadrian/hadrian.cabal - hadrian/src/Packages.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Default.hs - hadrian/stack.yaml - libraries/ghc-boot/ghc-boot.cabal.in - + libraries/ghc-platform/CHANGELOG.md - + libraries/ghc-platform/LICENSE - + libraries/ghc-platform/ghc-platform.cabal - libraries/ghc-boot/GHC/Platform/ArchOS.hs → libraries/ghc-platform/src/GHC/Platform/ArchOS.hs - m4/fptools_set_c_ld_flags.m4 - m4/ghc_toolchain.m4 - utils/ghc-toolchain/Main.hs - + utils/ghc-toolchain/acghc-toolchain - utils/ghc-toolchain/ghc-toolchain.cabal - utils/ghc-toolchain/src/GHC/Toolchain/ParseTriple.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs Changes: ===================================== hadrian/cabal.project ===================================== @@ -1,5 +1,6 @@ packages: ./ ../utils/ghc-toolchain/ + ../libraries/ghc-platform/ -- This essentially freezes the build plan for hadrian index-state: 2023-03-30T10:00:00Z ===================================== hadrian/hadrian.cabal ===================================== @@ -166,8 +166,8 @@ executable hadrian , text >= 1.2 && < 3 , cryptohash-sha256 >= 0.11 && < 0.12 , base16-bytestring >= 0.1.1 && < 1.1.0.0 + , ghc-platform , ghc-toolchain - , ghc-boot ghc-options: -Wall -Wincomplete-record-updates -Wredundant-constraints ===================================== hadrian/src/Packages.hs ===================================== @@ -4,7 +4,7 @@ module Packages ( array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, - exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, + exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, @@ -36,7 +36,7 @@ ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps , compareSizes, compiler, containers, deepseq, deriveConstants, directory - , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh + , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell @@ -52,7 +52,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, - exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, + exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, @@ -83,6 +83,7 @@ ghc = prg "ghc-bin" `setPath` "ghc" ghcBignum = lib "ghc-bignum" ghcBoot = lib "ghc-boot" ghcBootTh = lib "ghc-boot-th" +ghcPlatform = lib "ghc-platform" ghcCompact = lib "ghc-compact" ghcConfig = prg "ghc-config" `setPath` "testsuite/ghc-config" ghcHeap = lib "ghc-heap" ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -158,6 +158,7 @@ toolTargets = [ binary -- , runGhc -- # depends on ghc library , ghcBoot , ghcBootTh + , ghcPlatform , ghcHeap , ghci , ghcPkg -- # executable ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -85,6 +85,7 @@ stage0Packages = do , runGhc , ghcBoot , ghcBootTh + , ghcPlatform , ghcHeap , ghci , ghcPkg ===================================== hadrian/stack.yaml ===================================== @@ -3,6 +3,7 @@ resolver: lts-19.8 packages: - '.' - '../utils/ghc-toolchain' +- '../libraries/ghc-platform' nix: enable: false ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -51,7 +51,6 @@ Library GHC.Serialized GHC.ForeignSrcLang GHC.HandleEncoding - GHC.Platform.ArchOS GHC.Platform.Host GHC.Settings.Utils GHC.UniqueSubdir @@ -65,6 +64,10 @@ Library , GHC.ForeignSrcLang.Type , GHC.Lexeme + -- reexport platform modules from ghc-platform + reexported-modules: + GHC.Platform.ArchOS + -- but done by Hadrian autogen-modules: GHC.Version @@ -77,6 +80,7 @@ Library directory >= 1.2 && < 1.4, filepath >= 1.3 && < 1.5, deepseq >= 1.4 && < 1.5, + ghc-platform >= 0.1, ghc-boot-th == @ProjectVersionMunged@ if !os(windows) build-depends: ===================================== libraries/ghc-platform/CHANGELOG.md ===================================== @@ -0,0 +1,8 @@ +# Revision history for ghc-platform + +## 0.1.0.0 -- 2023-06-20 + +* First version. Split off the `GHC.Platform.ArchOS` module from the + non-reinstallable `ghc-boot` package into this reinstallable standalone + package which abides by the PVP, in part motivated by the ongoing work on + `ghc-toolchain` towards runtime retargetability. ===================================== libraries/ghc-platform/LICENSE ===================================== @@ -0,0 +1,30 @@ +Copyright (c) 2023, Rodrigo Mesquita + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Rodrigo Mesquita nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ===================================== libraries/ghc-platform/ghc-platform.cabal ===================================== @@ -0,0 +1,20 @@ +cabal-version: 3.0 +name: ghc-platform +version: 0.1.0.0 +synopsis: Platform information used by GHC and friends +license: BSD-3-Clause +license-file: LICENSE +author: Rodrigo Mesquita +maintainer: ghc-devs at haskell.org +build-type: Simple +extra-doc-files: CHANGELOG.md + +common warnings + ghc-options: -Wall + +library + import: warnings + exposed-modules: GHC.Platform.ArchOS + build-depends: base >=4.15.0.0 + hs-source-dirs: src + default-language: Haskell2010 ===================================== libraries/ghc-boot/GHC/Platform/ArchOS.hs → libraries/ghc-platform/src/GHC/Platform/ArchOS.hs ===================================== ===================================== m4/fptools_set_c_ld_flags.m4 ===================================== @@ -17,8 +17,9 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS], ;; esac + -- ROMES:TODO: ELF, mention note case $$1 in - *-linux) + *-linux|*-freebsd*) FP_LINK_SUPPORTS_NO_AS_NEEDED([$3]) ;; esac ===================================== m4/ghc_toolchain.m4 ===================================== @@ -22,16 +22,15 @@ AC_DEFUN([ENABLE_GHC_TOOLCHAIN_ARG], AC_DEFUN([FIND_GHC_TOOLCHAIN], [ "$GHC" -v0 \ - -ilibraries/ghc-boot -iutils/ghc-toolchain/src \ + -ilibraries/ghc-platform/src -iutils/ghc-toolchain/src \ -XNoImplicitPrelude \ -odir actmp-ghc-toolchain -hidir actmp-ghc-toolchain \ utils/ghc-toolchain/Main.hs -o acghc-toolchain rm -f acargs - dnl TODO: LLVMTarget vs Target, which should go where? - dnl echo "--triple=$target" >> acargs - dnl For now, LlvmTarget matches the configure output. - echo "--triple=$LlvmTarget" >> acargs + + echo "--triple=$target" >> acargs + echo "--llvm-triple=$LlvmTarget" >> acargs # echo "--cc=$CC" >> acargs # ADD_GHC_TOOLCHAIN_ARG([cc-opt], [$CONF_CC_OPTS_STAGE1]) ===================================== utils/ghc-toolchain/Main.hs ===================================== @@ -5,7 +5,7 @@ module Main where import Control.Monad import Data.Char (toUpper) -import Data.Maybe (isNothing) +import Data.Maybe (isNothing,fromMaybe) import System.Exit import System.Console.GetOpt import System.Environment @@ -33,6 +33,7 @@ import GHC.Toolchain.Tools.Readelf data Opts = Opts { optTriple :: String , optTargetPrefix :: Maybe String + , optLlvmTriple :: Maybe String , optCc :: ProgOpt , optCxx :: ProgOpt , optCpp :: ProgOpt @@ -57,6 +58,7 @@ emptyOpts :: Opts emptyOpts = Opts { optTriple = "" , optTargetPrefix = Nothing + , optLlvmTriple = Nothing , optCc = po0 , optCxx = po0 , optCpp = po0 @@ -98,6 +100,9 @@ _optWindres = Lens optWindres (\x o -> o {optWindres=x}) _optTriple :: Lens Opts String _optTriple = Lens optTriple (\x o -> o {optTriple=x}) +_optLlvmTriple :: Lens Opts (Maybe String) +_optLlvmTriple = Lens optLlvmTriple (\x o -> o {optLlvmTriple=x}) + _optTargetPrefix :: Lens Opts (Maybe String) _optTargetPrefix = Lens optTargetPrefix (\x o -> o {optTargetPrefix=x}) @@ -123,6 +128,7 @@ options :: [OptDescr (Opts -> Opts)] options = [ tripleOpt , targetPrefixOpt + , llvmTripleOpt , verbosityOpt , keepTempOpt ] ++ @@ -174,6 +180,7 @@ options = ] tripleOpt = Option ['t'] ["triple"] (ReqArg (set _optTriple) "TRIPLE") "Target triple" + llvmTripleOpt = Option [] ["llvm-triple"] (ReqArg (set _optLlvmTriple . Just) "LLVMTRIPLE") "LLVM Target triple" targetPrefixOpt = Option ['T'] ["target-prefix"] (ReqArg (set _optTargetPrefix . Just) "PREFIX") "A target prefix which will be added to all tool names when searching for toolchain components" @@ -297,7 +304,8 @@ archHasNativeAdjustors = \case mkTarget :: Opts -> M Target mkTarget opts = do - let tgtLlvmTarget = optTriple opts + -- Use Llvm target if specified, otherwise use triple as llvm target + let tgtLlvmTarget = fromMaybe (optTriple opts) (optLlvmTriple opts) cc0 <- findCc tgtLlvmTarget (optCc opts) cxx <- findCxx tgtLlvmTarget (optCxx opts) cpp <- findCpp (optCpp opts) cc0 ===================================== utils/ghc-toolchain/acghc-toolchain ===================================== Binary files /dev/null and b/utils/ghc-toolchain/acghc-toolchain differ ===================================== utils/ghc-toolchain/ghc-toolchain.cabal ===================================== @@ -36,8 +36,7 @@ library filepath, process, transformers, - async, - ghc-boot + ghc-platform hs-source-dirs: src default-language: Haskell2010 @@ -50,6 +49,6 @@ executable ghc-toolchain filepath, process, transformers, - ghc-boot, + ghc-platform, ghc-toolchain default-language: Haskell2010 ===================================== utils/ghc-toolchain/src/GHC/Toolchain/ParseTriple.hs ===================================== @@ -9,17 +9,21 @@ import GHC.Toolchain.CheckArm import GHC.Toolchain.Tools.Cc -- | Parse a triple `arch-vendor-os` into an 'ArchOS' and a vendor name 'String' -parseTriple :: Cc -> String -> M (ArchOS, String) +parseTriple :: Cc -> String -> M (ArchOS, Maybe String) parseTriple cc triple + | [archName, osName] <- parts + = do arch <- parseArch cc archName + os <- parseOs osName + return (ArchOS arch os, Nothing) | [archName, vendorName, osName] <- parts = do arch <- parseArch cc archName - os <- parseOs vendorName osName - return $ (ArchOS arch os, vendorName) + os <- parseOs osName + return (ArchOS arch os, Just vendorName) | [archName, vendorName, osName, _abi] <- parts = do arch <- parseArch cc archName - os <- parseOs vendorName osName - return $ (ArchOS arch os, vendorName) + os <- parseOs osName + return (ArchOS arch os, Just vendorName) | otherwise = throwE $ "malformed triple " ++ triple @@ -38,7 +42,7 @@ parseArch cc arch = "s390x" -> pure ArchS390X "arm" -> findArmIsa cc _ | "armv" `isPrefixOf` arch -> findArmIsa cc - "arm64" -> pure ArchAArch64 -- TODO Should we support this alias or does this cause confusion? + "arm64" -> pure ArchAArch64 "aarch64" -> pure ArchAArch64 "alpha" -> pure ArchAlpha "mips" -> pure ArchMipseb @@ -46,10 +50,11 @@ parseArch cc arch = "mipsel" -> pure ArchMipsel "riscv64" -> pure ArchRISCV64 "hppa" -> pure ArchUnknown + "wasm32" -> pure ArchWasm32 _ -> throwE $ "Unknown architecture " ++ arch -parseOs :: String -> String -> M OS -parseOs vendor os = +parseOs :: String -> M OS +parseOs os = case os of "linux" -> pure OSLinux "linux-android" -> pure OSLinux @@ -68,7 +73,8 @@ parseOs vendor os = "nto-qnc" -> pure OSQNXNTO "aix" -> pure OSAIX "gnu" -> pure OSHurd - _ -> throwE $ "Unknown vendor/operating system " ++ vendor ++ "-" ++ os + "wasi" -> pure OSWasi + _ -> throwE $ "Unknown operating system " ++ os splitOn :: Char -> String -> [String] splitOn sep = go ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs ===================================== @@ -31,7 +31,7 @@ instance Show Ar where , "}" ] -findAr :: String -- ^ Vendor name from the target triple +findAr :: Maybe String -- ^ Vendor name from the target triple, if specified -> ProgOpt -> M Ar findAr vendor progOpt = checking "for 'ar'" $ do bareAr <- findProgram "ar archiver" progOpt ["ar"] @@ -48,7 +48,7 @@ findAr vendor progOpt = checking "for 'ar'" $ do -- TODO: It'd be better not to handle Apple specifically here? -- It's quite tedious to check for Apple's crazy timestamps in -- .a files, so we hardcode it. - | vendor == "apple" = True + | vendor == Just "apple" = True | mode:_ <- prgFlags mkArchive , 's' `elem` mode = False | otherwise = True ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -126,6 +126,11 @@ checkSupportsNoPie ccLink = checking "whether the cc linker supports -no-pie" $ (code, out, _err) <- readProgram ccLink ["-no-pie", "-Werror", "-x", "c", test_c, "-o", test] return (isSuccess code && not ("unrecognized" `isInfixOf` out)) +-- ROMES:TODO: This check is wrong here and in configure because with ld.gold parses "-n" "o_compact_unwind" +-- TODO: +-- * Check if compiling for darwin +-- * Then do the check +-- * Otherwise say its just not supported checkSupportsCompactUnwind :: Cc -> Program -> M Bool checkSupportsCompactUnwind cc ccLink = checking "whether the cc linker understands -no_compact_unwind" $ withTempDir $ \dir -> do @@ -155,6 +160,7 @@ checkSupportsFilelist cc ccLink = checking "whether the cc linker understands -f return (isSuccess exitCode) +-- ROMES:TODO: Move to MergeTools, don't use neither of these, check that merging works with the @args.txt checkSupportsResponseFiles :: Cc -> Program -> M Bool checkSupportsResponseFiles cc ccLink = checking "whether the cc linker supports response files" $ withTempDir $ \dir -> do View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a9a1b8bce5e980e6e953140ee1cc8c112c44d703...db1e17eaf8b7f0b61d5dfa65012a05ea4e0ccc63 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a9a1b8bce5e980e6e953140ee1cc8c112c44d703...db1e17eaf8b7f0b61d5dfa65012a05ea4e0ccc63 You're receiving 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 Jun 26 11:13:53 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Mon, 26 Jun 2023 07:13:53 -0400 Subject: [Git][ghc/ghc][wip/T18389-task-zero] 95 commits: Don't report redundant Givens from quantified constraints Message-ID: <649972f1748e_64cc0c76c82651d8@gitlab.mail> Ryan Scott pushed to branch wip/T18389-task-zero at Glasgow Haskell Compiler / GHC Commits: 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 506da29a by Ryan Scott at 2023-06-26T07:13:40-04:00 Introduce and use ConGadtSigBody (preparatory refactor for #18389) This patch removes the `con_g_args :: HsConDeclGADTDetails pass` and `con_res_ty :: LHsType pass` fields of `ConDeclGADT` in favor of a unified `con_body :: ConGadtSigBody pass` field. There are two major differences between `HsConDeclGADTDetails` and `ConGadtSigBody`: 1. `HsConDeclGADTDetails` only contains the argument type, while `ConGadtSigBody` contains both the argument and result types. 2. The `PrefixConGADT` constructor of `ConGadtSigBody` now uses a new `PrefixConGadtSigBody` data type. `PrefixConGadtSigBody` closely mirrors the structure of `HsType`, but with minor, data constructor–specific tweaks. This will become vital in a future patch which implements nested `forall`s and contexts in prefix GADT constructor types (see #18389). Besides the refactoring in the GHC API (and some minor changes in GHC AST–related test cases) this does not introduce any user-visible changes in behavior. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - HACKING.md - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Quote.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e4617b7ca1da826638bc1b1d5e475561730a79a3...506da29ac625613d869ad14b02bfff153db8521b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e4617b7ca1da826638bc1b1d5e475561730a79a3...506da29ac625613d869ad14b02bfff153db8521b You're receiving 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 Jun 26 11:29:33 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Mon, 26 Jun 2023 07:29:33 -0400 Subject: [Git][ghc/ghc][wip/polymorphic-spec] Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Message-ID: <6499769d8284_64cc0c76b427193e@gitlab.mail> Matthew Pickering pushed to branch wip/polymorphic-spec at Glasgow Haskell Compiler / GHC Commits: 9449a8df by Matthew Pickering at 2023-06-26T12:25:29+01:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - 7 changed files: - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/using-optimisation.rst - testsuite/tests/simplCore/should_compile/T8331.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -2490,6 +2490,12 @@ specArgFreeIds (SpecDict dx) = exprFreeIds dx specArgFreeIds UnspecType = emptyVarSet specArgFreeIds UnspecArg = emptyVarSet +specArgFreeVars :: SpecArg -> VarSet +specArgFreeVars (SpecType ty) = tyCoVarsOfType ty +specArgFreeVars (SpecDict dx) = exprFreeVars dx +specArgFreeVars UnspecType = emptyVarSet +specArgFreeVars UnspecArg = emptyVarSet + isSpecDict :: SpecArg -> Bool isSpecDict (SpecDict {}) = True isSpecDict _ = False @@ -2798,6 +2804,12 @@ non-dictionary bindings too. Note [Specialising polymorphic dictionaries] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Note June 2023: This has proved to be quite a tricky optimisation to get right +see (#23469, #23109, #21229, #23445) so it is now guarded by a flag +`-fpolymorphic-specialisation`. + + Consider class M a where { foo :: a -> Int } @@ -2988,14 +3000,23 @@ getTheta = fmap piTyBinderType . filter isInvisiblePiTyBinder . filter isAnonPiT ------------------------------------------------------------ -singleCall :: Id -> [SpecArg] -> UsageDetails -singleCall id args +singleCall :: SpecEnv -> Id -> [SpecArg] -> UsageDetails +singleCall spec_env id args = MkUD {ud_binds = emptyFDBs, ud_calls = unitDVarEnv id $ CIS id $ unitBag (CI { ci_key = args , ci_fvs = call_fvs }) } where - call_fvs = foldr (unionVarSet . specArgFreeIds) emptyVarSet args + call_fvs = + foldr (unionVarSet . free_var_fn) emptyVarSet args + + free_var_fn = + if gopt Opt_PolymorphicSpecialisation (se_dflags spec_env) + then specArgFreeIds + else specArgFreeVars + + + -- specArgFreeIds: we specifically look for free Ids, not TyVars -- see (MP1) in Note [Specialising polymorphic dictionaries] -- @@ -3014,7 +3035,7 @@ mkCallUDs' env f args | wantCallsFor env f -- We want it, and... , not (null ci_key) -- this call site has a useful specialisation = -- pprTrace "mkCallUDs: keeping" _trace_doc - singleCall f ci_key + singleCall env f ci_key | otherwise -- See also Note [Specialisations already covered] = -- pprTrace "mkCallUDs: discarding" _trace_doc ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -257,6 +257,7 @@ data GeneralFlag | Opt_Specialise | Opt_SpecialiseAggressively | Opt_CrossModuleSpecialise + | Opt_PolymorphicSpecialisation | Opt_InlineGenerics | Opt_InlineGenericsAggressively | Opt_StaticArgumentTransformation ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2429,6 +2429,7 @@ fFlagsDeps = [ flagSpec "specialize-aggressively" Opt_SpecialiseAggressively, flagSpec "cross-module-specialise" Opt_CrossModuleSpecialise, flagSpec "cross-module-specialize" Opt_CrossModuleSpecialise, + flagSpec "polymorphic-specialisation" Opt_PolymorphicSpecialisation, flagSpec "inline-generics" Opt_InlineGenerics, flagSpec "inline-generics-aggressively" Opt_InlineGenericsAggressively, flagSpec "static-argument-transformation" Opt_StaticArgumentTransformation, ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -174,11 +174,16 @@ Compiler D(D2) ) D = D1 | D2 - + This allows for changing the structure of a library without immediately breaking user code, but instead being able to warn the user that a change in the library interface will occur in the future. +- Guard polymorphic specialisation behind the flag :ghc-flag:`-fpolymorphic-specialisation`. + This optimisation has led to a number of incorrect runtime result bugs, so we are disabling it + by default for now whilst we consider more carefully an appropiate fix. + (See :ghc-ticket:`23469`, :ghc-ticket:`23109`, :ghc-ticket:`21229`, :ghc-ticket:`23445`) + GHCi ~~~~ @@ -241,8 +246,8 @@ Runtime system We use this functionality in GHCi to modify how some messages are displayed. - The extensions fields of constructors of ``IE`` now take ``Maybe (WarningTxt p)`` - in ``GhcPs`` and ``GhcRn`` variants of the Syntax Tree. - This represents the warning assigned to a certain export item, + in ``GhcPs`` and ``GhcRn`` variants of the Syntax Tree. + This represents the warning assigned to a certain export item, which is used for :ref:`deprecated-exports`. ``ghc-heap`` library ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -1113,6 +1113,21 @@ as such you shouldn't need to set any of them explicitly. A flag which they are called in this module. Note that specialisation must be enabled (by ``-fspecialise``) for this to have any effect. +.. ghc-flag:: -fpolymorphic-specialisation + :shortdesc: Allow specialisation to abstract over free type variables + :type: dynamic + :reverse: -fno-polymorphic-specialisation + :category: + + :default: off + + Warning, this feature is highly experimental and may lead to incorrect runtime + results. Use at your own risk (:ghc-ticket:`23469`, :ghc-ticket:`23109`, :ghc-ticket:`21229`, :ghc-ticket:`23445`). + + Enable specialisation of function calls to known dictionaries with free type variables. + The created specialisation will abstract over the type variables free in the dictionary. + + .. ghc-flag:: -flate-specialise :shortdesc: Run a late specialisation pass :type: dynamic ===================================== testsuite/tests/simplCore/should_compile/T8331.stderr ===================================== @@ -1,149 +1,5 @@ ==================== Tidy Core rules ==================== -"SPEC $c*> @(ST s) @_" - forall (@s) (@r) ($dApplicative :: Applicative (ST s)). - $fApplicativeReaderT_$c*> @(ST s) @r $dApplicative - = ($fApplicativeReaderT2 @s @r) - `cast` (forall (a :: <*>_N) (b :: <*>_N). - _R - %<'Many>_N ->_R _R - %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) - ; Sym (N:ReaderT[0] <*>_N _R _R _N) - :: Coercible - (forall {a} {b}. - ReaderT r (ST s) a -> ReaderT r (ST s) b -> r -> STRep s b) - (forall {a} {b}. - ReaderT r (ST s) a -> ReaderT r (ST s) b -> ReaderT r (ST s) b)) -"SPEC $c<$ @(ST s) @_" - forall (@s) (@r) ($dFunctor :: Functor (ST s)). - $fFunctorReaderT_$c<$ @(ST s) @r $dFunctor - = ($fApplicativeReaderT6 @s @r) - `cast` (forall (a :: <*>_N) (b :: <*>_N). - _R - %<'Many>_N ->_R _R - %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) - ; Sym (N:ReaderT[0] <*>_N _R _R _N) - :: Coercible - (forall {a} {b}. a -> ReaderT r (ST s) b -> r -> STRep s a) - (forall {a} {b}. a -> ReaderT r (ST s) b -> ReaderT r (ST s) a)) -"SPEC $c<* @(ST s) @_" - forall (@s) (@r) ($dApplicative :: Applicative (ST s)). - $fApplicativeReaderT_$c<* @(ST s) @r $dApplicative - = ($fApplicativeReaderT1 @s @r) - `cast` (forall (a :: <*>_N) (b :: <*>_N). - _R - %<'Many>_N ->_R _R - %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) - ; Sym (N:ReaderT[0] <*>_N _R _R _N) - :: Coercible - (forall {a} {b}. - ReaderT r (ST s) a -> ReaderT r (ST s) b -> r -> STRep s a) - (forall {a} {b}. - ReaderT r (ST s) a -> ReaderT r (ST s) b -> ReaderT r (ST s) a)) -"SPEC $c<*> @(ST s) @_" - forall (@s) (@r) ($dApplicative :: Applicative (ST s)). - $fApplicativeReaderT9 @(ST s) @r $dApplicative - = ($fApplicativeReaderT4 @s @r) - `cast` (forall (a :: <*>_N) (b :: <*>_N). - b)>_R - %<'Many>_N ->_R _R - %<'Many>_N ->_R _R - %<'Many>_N ->_R Sym (N:ST[0] _N _R) - :: Coercible - (forall {a} {b}. - ReaderT r (ST s) (a -> b) -> ReaderT r (ST s) a -> r -> STRep s b) - (forall {a} {b}. - ReaderT r (ST s) (a -> b) -> ReaderT r (ST s) a -> r -> ST s b)) -"SPEC $c>> @(ST s) @_" - forall (@s) (@r) ($dMonad :: Monad (ST s)). - $fMonadReaderT1 @(ST s) @r $dMonad - = $fMonadAbstractIOSTReaderT_$s$c>> @s @r -"SPEC $c>>= @(ST s) @_" - forall (@s) (@r) ($dMonad :: Monad (ST s)). - $fMonadReaderT2 @(ST s) @r $dMonad - = ($fMonadAbstractIOSTReaderT2 @s @r) - `cast` (forall (a :: <*>_N) (b :: <*>_N). - _R - %<'Many>_N ->_R ReaderT r (ST s) b>_R - %<'Many>_N ->_R _R - %<'Many>_N ->_R Sym (N:ST[0] _N _R) - :: Coercible - (forall {a} {b}. - ReaderT r (ST s) a -> (a -> ReaderT r (ST s) b) -> r -> STRep s b) - (forall {a} {b}. - ReaderT r (ST s) a -> (a -> ReaderT r (ST s) b) -> r -> ST s b)) -"SPEC $cfmap @(ST s) @_" - forall (@s) (@r) ($dFunctor :: Functor (ST s)). - $fFunctorReaderT_$cfmap @(ST s) @r $dFunctor - = ($fApplicativeReaderT7 @s @r) - `cast` (forall (a :: <*>_N) (b :: <*>_N). - b>_R - %<'Many>_N ->_R _R - %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) - ; Sym (N:ReaderT[0] <*>_N _R _R _N) - :: Coercible - (forall {a} {b}. (a -> b) -> ReaderT r (ST s) a -> r -> STRep s b) - (forall {a} {b}. - (a -> b) -> ReaderT r (ST s) a -> ReaderT r (ST s) b)) -"SPEC $cliftA2 @(ST s) @_" - forall (@s) (@r) ($dApplicative :: Applicative (ST s)). - $fApplicativeReaderT_$cliftA2 @(ST s) @r $dApplicative - = ($fApplicativeReaderT3 @s @r) - `cast` (forall (a :: <*>_N) (b :: <*>_N) (c :: <*>_N). - b -> c>_R - %<'Many>_N ->_R _R - %<'Many>_N ->_R _R - %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) - ; Sym (N:ReaderT[0] <*>_N _R _R _N) - :: Coercible - (forall {a} {b} {c}. - (a -> b -> c) - -> ReaderT r (ST s) a -> ReaderT r (ST s) b -> r -> STRep s c) - (forall {a} {b} {c}. - (a -> b -> c) - -> ReaderT r (ST s) a -> ReaderT r (ST s) b -> ReaderT r (ST s) c)) -"SPEC $cp1Applicative @(ST s) @_" - forall (@s) (@r) ($dApplicative :: Applicative (ST s)). - $fApplicativeReaderT_$cp1Applicative @(ST s) @r $dApplicative - = $fApplicativeReaderT_$s$fFunctorReaderT @s @r -"SPEC $cp1Monad @(ST s) @_" - forall (@s) (@r) ($dMonad :: Monad (ST s)). - $fMonadReaderT_$cp1Monad @(ST s) @r $dMonad - = $fApplicativeReaderT_$s$fApplicativeReaderT @s @r -"SPEC $cpure @(ST s) @_" - forall (@s) (@r) ($dApplicative :: Applicative (ST s)). - $fApplicativeReaderT_$cpure @(ST s) @r $dApplicative - = ($fApplicativeReaderT5 @s @r) - `cast` (forall (a :: <*>_N). - _R - %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) - ; Sym (N:ReaderT[0] <*>_N _R _R _N) - :: Coercible - (forall {a}. a -> r -> STRep s a) - (forall {a}. a -> ReaderT r (ST s) a)) -"SPEC $creturn @(ST s) @_" - forall (@s) (@r) ($dMonad :: Monad (ST s)). - $fMonadReaderT_$creturn @(ST s) @r $dMonad - = ($fApplicativeReaderT5 @s @r) - `cast` (forall (a :: <*>_N). - _R - %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) - ; Sym (N:ReaderT[0] <*>_N _R _R _N) - :: Coercible - (forall {a}. a -> r -> STRep s a) - (forall {a}. a -> ReaderT r (ST s) a)) -"SPEC $fApplicativeReaderT @(ST s) @_" - forall (@s) (@r) ($dApplicative :: Applicative (ST s)). - $fApplicativeReaderT @(ST s) @r $dApplicative - = $fApplicativeReaderT_$s$fApplicativeReaderT @s @r -"SPEC $fFunctorReaderT @(ST s) @_" - forall (@s) (@r) ($dFunctor :: Functor (ST s)). - $fFunctorReaderT @(ST s) @r $dFunctor - = $fApplicativeReaderT_$s$fFunctorReaderT @s @r -"SPEC $fMonadReaderT @(ST s) @_" - forall (@s) (@r) ($dMonad :: Monad (ST s)). - $fMonadReaderT @(ST s) @r $dMonad - = $fMonadAbstractIOSTReaderT_$s$fMonadReaderT @s @r "USPEC useAbstractMonad @(ReaderT Int (ST s))" forall (@s) ($dMonadAbstractIOST :: MonadAbstractIOST (ReaderT Int (ST s))). ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -435,7 +435,7 @@ test('T21851', [grep_errmsg(r'case.*w\$sf') ], multimod_compile, ['T21851', '-O # One module, T22097.hs, has OPTIONS_GHC -ddump-simpl test('T22097', [grep_errmsg(r'case.*wgoEven') ], multimod_compile, ['T22097', '-O -dno-typeable-binds -dsuppress-uniques']) -test('T13873', [ grep_errmsg(r'SPEC') ], compile, ['-O -ddump-rules']) +test('T13873', [ grep_errmsg(r'SPEC') ], compile, ['-O -ddump-rules -fpolymorphic-specialisation']) test('T22357', normal, compile, ['-O']) test('T22471', normal, compile, ['-O']) test('T22347', normal, compile, ['-O -fno-full-laziness']) @@ -443,8 +443,8 @@ test('T22347a', normal, compile, ['-O2 -fno-full-laziness']) # T17366: expecting to see a rule # Rule fired: SPEC/T17366 f @(Tagged tag) @_ (T17366) -test('T17366', normal, multimod_compile, ['T17366', '-O -v0 -ddump-rule-firings']) -test('T17366_AR', [grep_errmsg(r'SPEC')], multimod_compile, ['T17366_AR', '-O -v0 -ddump-rule-firings']) +test('T17366', normal, multimod_compile, ['T17366', '-O -v0 -ddump-rule-firings -fpolymorphic-specialisation']) +test('T17366_AR', [grep_errmsg(r'SPEC')], multimod_compile, ['T17366_AR', '-O -v0 -ddump-rule-firings -fpolymorphic-specialisation']) test('T22375', normal, compile, ['-O -ddump-simpl -dsuppress-uniques -dno-typeable-binds -dsuppress-unfoldings']) # One module, T21851_2.hs, has OPTIONS_GHC -ddump-simpl @@ -467,7 +467,7 @@ test('T22623', normal, multimod_compile, ['T22623', '-O -v0']) test('T22662', normal, compile, ['']) test('T22725', normal, compile, ['-O']) test('T22502', normal, compile, ['-O']) -test('T22611', [when(wordsize(32), skip), grep_errmsg(r'\$salterF') ], compile, ['-O -ddump-simpl -dsuppress-uniques -dsuppress-all']) +test('T22611', [when(wordsize(32), skip), grep_errmsg(r'\$salterF') ], compile, ['-O -ddump-simpl -dsuppress-uniques -dsuppress-all -fpolymorphic-specialisation']) 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/9449a8df88d5335806bb5c3ba2cddfba58008eb1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9449a8df88d5335806bb5c3ba2cddfba58008eb1 You're receiving 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 Jun 26 11:37:13 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 07:37:13 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/romes/merge-tools-supports-response-files Message-ID: <649978697260c_64cc0c7754279476@gitlab.mail> Rodrigo Mesquita pushed new branch wip/romes/merge-tools-supports-response-files at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/merge-tools-supports-response-files You're receiving 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 Jun 26 11:43:53 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 07:43:53 -0400 Subject: [Git][ghc/ghc][wip/romes/merge-tools-supports-response-files] Configure MergeObjs supports response files rather than Ld Message-ID: <649979f9e67c2_64cc0c76c8284449@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/merge-tools-supports-response-files at Glasgow Haskell Compiler / GHC Commits: 69fa79ee by Rodrigo Mesquita at 2023-06-26T12:43:44+01:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 11 changed files: - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Rules/Generate.hs - − m4/fp_ld_supports_response_files.m4 - + m4/fp_merge_objects_supports_response_files.m4 Changes: ===================================== compiler/GHC/Settings.hs ===================================== @@ -19,7 +19,7 @@ module GHC.Settings , sGlobalPackageDatabasePath , sLdSupportsCompactUnwind , sLdSupportsFilelist - , sLdSupportsResponseFiles + , sMergeObjsSupportsResponseFiles , sLdIsGnuLd , sGccSupportsNoPie , sUseInplaceMinGW @@ -88,7 +88,7 @@ data Settings = Settings data ToolSettings = ToolSettings { toolSettings_ldSupportsCompactUnwind :: Bool , toolSettings_ldSupportsFilelist :: Bool - , toolSettings_ldSupportsResponseFiles :: Bool + , toolSettings_mergeObjsSupportsResponseFiles :: Bool , toolSettings_ldIsGnuLd :: Bool , toolSettings_ccSupportsNoPie :: Bool , toolSettings_useInplaceMinGW :: Bool @@ -191,8 +191,8 @@ sLdSupportsCompactUnwind :: Settings -> Bool sLdSupportsCompactUnwind = toolSettings_ldSupportsCompactUnwind . sToolSettings sLdSupportsFilelist :: Settings -> Bool sLdSupportsFilelist = toolSettings_ldSupportsFilelist . sToolSettings -sLdSupportsResponseFiles :: Settings -> Bool -sLdSupportsResponseFiles = toolSettings_ldSupportsResponseFiles . sToolSettings +sMergeObjsSupportsResponseFiles :: Settings -> Bool +sMergeObjsSupportsResponseFiles = toolSettings_mergeObjsSupportsResponseFiles . sToolSettings sLdIsGnuLd :: Settings -> Bool sLdIsGnuLd = toolSettings_ldIsGnuLd . sToolSettings sGccSupportsNoPie :: Settings -> Bool ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -104,7 +104,7 @@ initSettings top_dir = do ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" ldSupportsFilelist <- getBooleanSetting "ld supports filelist" - ldSupportsResponseFiles <- getBooleanSetting "ld supports response files" + mergeObjsSupportsResponseFiles <- getBooleanSetting "Merge objects supports response files" ldIsGnuLd <- getBooleanSetting "ld is GNU ld" arSupportsDashL <- getBooleanSetting "ar supports -L" @@ -173,7 +173,7 @@ initSettings top_dir = do , sToolSettings = ToolSettings { toolSettings_ldSupportsCompactUnwind = ldSupportsCompactUnwind , toolSettings_ldSupportsFilelist = ldSupportsFilelist - , toolSettings_ldSupportsResponseFiles = ldSupportsResponseFiles + , toolSettings_mergeObjsSupportsResponseFiles = mergeObjsSupportsResponseFiles , toolSettings_ldIsGnuLd = ldIsGnuLd , toolSettings_ccSupportsNoPie = gccSupportsNoPie , toolSettings_useInplaceMinGW = useInplaceMinGW ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -349,7 +349,7 @@ runMergeObjects logger tmpfs dflags args = , "does not support object merging." ] optl_args = map Option (getOpts dflags opt_lm) args2 = args0 ++ args ++ optl_args - if toolSettings_ldSupportsResponseFiles (toolSettings dflags) + if toolSettings_mergeObjsSupportsResponseFiles (toolSettings dflags) then do mb_env <- getGccEnv args2 runSomethingResponseFile logger tmpfs dflags id "Merge objects" p args2 mb_env ===================================== configure.ac ===================================== @@ -649,7 +649,7 @@ 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]) -FP_LD_SUPPORTS_RESPONSE_FILES +FP_MERGE_OBJECTS_SUPPORTS_RESPONSE_FILES GHC_LLVM_TARGET_SET_VAR # we intend to pass trough --targets to llvm as is. ===================================== distrib/configure.ac.in ===================================== @@ -177,7 +177,7 @@ 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]) -FP_LD_SUPPORTS_RESPONSE_FILES +FP_MERGE_OBJECTS_SUPPORTS_RESPONSE_FILES AC_SUBST(CONF_CC_OPTS_STAGE0) AC_SUBST(CONF_CC_OPTS_STAGE1) ===================================== hadrian/bindist/Makefile ===================================== @@ -91,10 +91,10 @@ lib/settings : config.mk @echo ',("ld flags", "$(SettingsLdFlags)")' >> $@ @echo ',("ld supports compact unwind", "$(LdHasNoCompactUnwind)")' >> $@ @echo ',("ld supports filelist", "$(LdHasFilelist)")' >> $@ - @echo ',("ld supports response files", "$(LdSupportsResponseFiles)")' >> $@ @echo ',("ld is GNU ld", "$(LdIsGNULd)")' >> $@ @echo ',("Merge objects command", "$(SettingsMergeObjectsCommand)")' >> $@ @echo ',("Merge objects flags", "$(SettingsMergeObjectsFlags)")' >> $@ + @echo ',("Merge objects supports response files", "$(MergeObjsSupportsResponseFiles)")' >> $@ @echo ',("ar command", "$(SettingsArCommand)")' >> $@ @echo ',("ar flags", "$(ArArgs)")' >> $@ @echo ',("ar supports at file", "$(ArSupportsAtFile)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -235,7 +235,7 @@ GhcRtsWithLibdw=$(strip $(if $(filter $(TargetArch_CPP),i386 x86_64 s390x), at UseL # See Note [tooldir: How GHC finds mingw on Windows] LdHasFilelist = @LdHasFilelist@ -LdSupportsResponseFiles = @LdSupportsResponseFiles@ +MergeObjsSupportsResponseFiles = @MergeObjsSupportsResponseFiles@ LdHasBuildId = @LdHasBuildId@ LdHasFilelist = @LdHasFilelist@ LdIsGNULd = @LdIsGNULd@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -139,7 +139,7 @@ conf-merge-objects-args-stage3 = @MergeObjsArgs@ ld-has-no-compact-unwind = @LdHasNoCompactUnwind@ ld-has-filelist = @LdHasFilelist@ -ld-supports-response-files = @LdSupportsResponseFiles@ +merge-objs-supports-response-files = @MergeObjsSupportsResponseFiles@ ld-is-gnu-ld = @LdIsGNULd@ ar-args = @ArArgs@ ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -449,10 +449,10 @@ generateSettings = do , ("ld flags", expr $ settingsFileSetting SettingsFileSetting_LdFlags) , ("ld supports compact unwind", expr $ lookupSystemConfig "ld-has-no-compact-unwind") , ("ld supports filelist", expr $ lookupSystemConfig "ld-has-filelist") - , ("ld supports response files", expr $ lookupSystemConfig "ld-supports-response-files") , ("ld is GNU ld", expr $ lookupSystemConfig "ld-is-gnu-ld") , ("Merge objects command", expr $ settingsFileSetting SettingsFileSetting_MergeObjectsCommand) , ("Merge objects flags", expr $ settingsFileSetting SettingsFileSetting_MergeObjectsFlags) + , ("Merge objects supports response files", expr $ lookupSystemConfig "merge-objs-supports-response-files") , ("ar command", expr $ settingsFileSetting SettingsFileSetting_ArCommand) , ("ar flags", expr $ lookupSystemConfig "ar-args") , ("ar supports at file", expr $ yesNo <$> flag ArSupportsAtFile) ===================================== m4/fp_ld_supports_response_files.m4 deleted ===================================== @@ -1,19 +0,0 @@ -# FP_LD_SUPPORTS_RESPONSE_FILES -# -------------------- -# See if whether we are using a version of ld which supports response files. -AC_DEFUN([FP_LD_SUPPORTS_RESPONSE_FILES], [ - AC_MSG_CHECKING([whether $LD supports response files]) - echo 'int main(void) {return 0;}' > conftest.c - "$CC" -c -o conftest.o conftest.c > /dev/null 2>&1 - printf -- "-o\nconftest\nconftest.o\n" > args.txt - if "$LD" -shared @args.txt > /dev/null 2>&1 || "$LD" -dylib @args.txt > /dev/null 2>&1 - then - LdSupportsResponseFiles=YES - AC_MSG_RESULT([yes]) - else - LdSupportsResponseFiles=NO - AC_MSG_RESULT([no]) - fi - rm -f conftest.c conftest args.txt - AC_SUBST(LdSupportsResponseFiles) -]) ===================================== m4/fp_merge_objects_supports_response_files.m4 ===================================== @@ -0,0 +1,22 @@ +# FP_MERGE_OBJECTS_SUPPORTS_RESPONSE_FILES +# -------------------- +# See if whether we are using a version of the merge objects tool which supports response files. +AC_DEFUN([FP_MERGE_OBJECTS_SUPPORTS_RESPONSE_FILES], [ + AC_MSG_CHECKING([whether $LD supports response files]) + echo 'int funA(int x) {return x;}' > conftesta.c + echo 'int funB(int x) {return x;}' > conftestb.c + "$CC" -c -o conftesta.o conftesta.c > /dev/null 2>&1 + "$CC" -c -o conftestb.o conftestb.c > /dev/null 2>&1 + printf -- "-o\nconftest.o\nconftesta.o\nconftestb.o\n" > args.txt + "$MergeObjsCmd" "$MergeObjsArgs" @args.txt > /dev/null 2>&1 + if ("$NM" conftest.o | grep "funA" > /dev/null 2>&1) && ("$NM" conftest.o | grep "funB" > /dev/null 2>&1) + then + MergeObjsSupportsResponseFiles=YES + AC_MSG_RESULT([yes]) + else + MergeObjsSupportsResponseFiles=NO + AC_MSG_RESULT([no]) + fi + rm -f conftesta.c conftestb.c conftesta.o conftestb.o conftest.o args.txt + AC_SUBST(MergeObjsSupportsResponseFiles) +]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/69fa79eef1606af5431d987b0206f9d43b4cfe39 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/69fa79eef1606af5431d987b0206f9d43b4cfe39 You're receiving 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 Jun 26 12:04:24 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 26 Jun 2023 08:04:24 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: JS: support levity-polymorphic datatypes (#22360,#22291) Message-ID: <64997ec8e6553_64cc0c77402862fb@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 39c3fdd2 by Sylvain Henry at 2023-06-26T08:04:08-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - bc21e5d5 by Matthew Pickering at 2023-06-26T08:04:09-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - ccc139ef by Matthew Pickering at 2023-06-26T08:04:09-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - e09175c4 by Arnaud Spiwack at 2023-06-26T08:04:11-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - 25 changed files: - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - compiler/GHC/Builtin/Types.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Stg/Syntax.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/ArgRep.hs - compiler/GHC/StgToCmm/Lit.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/StgToJS/Types.hs - compiler/GHC/StgToJS/Utils.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/RepType.hs - rts/js/rts.js - rts/js/verify.js - testsuite/tests/ghci/should_run/T16096.stdout - testsuite/tests/primops/should_run/all.T - + testsuite/tests/rep-poly/T22291.hs - + testsuite/tests/rep-poly/T22291b.hs - testsuite/tests/rep-poly/all.T - testsuite/tests/unlifted-datatypes/should_compile/all.T Changes: ===================================== .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md ===================================== @@ -25,9 +25,9 @@ If you have any questions don't hesitate to open your merge request and inquire in a comment. If your patch isn't quite done yet please do add prefix your MR title with `WIP:`. -Once your change is ready please remove the `WIP:` tag and wait for review. If +Once your change is ready please remove the `WIP:` tag and wait for review. If no one has offerred review in a few days then please leave a comment mentioning - at triagers. + at triagers and apply the ~"Blocked on Review" label. [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/Builtin/Types.hs ===================================== @@ -1636,10 +1636,11 @@ boxedRepDataCon = pcSpecialDataCon boxedRepDataConName where -- See Note [Getting from RuntimeRep to PrimRep] in RepType prim_rep_fun [lev] - = case tyConPromDataConInfo (tyConAppTyCon lev) of - Levity Lifted -> [LiftedRep] - Levity Unlifted -> [UnliftedRep] - _ -> pprPanic "boxedRepDataCon" (ppr lev) + = case tyConAppTyCon_maybe lev of + Just tc -> case tyConPromDataConInfo tc of + Levity l -> [BoxedRep (Just l)] + _ -> [BoxedRep Nothing] + Nothing -> [BoxedRep Nothing] prim_rep_fun args = pprPanic "boxedRepDataCon" (ppr args) ===================================== compiler/GHC/Cmm/Utils.hs ===================================== @@ -98,8 +98,7 @@ import GHC.Cmm.Dataflow.Collections primRepCmmType :: Platform -> PrimRep -> CmmType primRepCmmType platform = \case VoidRep -> panic "primRepCmmType:VoidRep" - LiftedRep -> gcWord platform - UnliftedRep -> gcWord platform + BoxedRep _ -> gcWord platform IntRep -> bWord platform WordRep -> bWord platform Int8Rep -> b8 @@ -142,8 +141,7 @@ typeCmmType platform ty = primRepCmmType platform (typePrimRep1 ty) primRepForeignHint :: PrimRep -> ForeignHint primRepForeignHint VoidRep = panic "primRepForeignHint:VoidRep" -primRepForeignHint LiftedRep = AddrHint -primRepForeignHint UnliftedRep = AddrHint +primRepForeignHint (BoxedRep _) = AddrHint primRepForeignHint IntRep = SignedHint primRepForeignHint Int8Rep = SignedHint primRepForeignHint Int16Rep = SignedHint ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -124,7 +124,7 @@ module GHC.Core.TyCon( tyConRepModOcc, -- * Primitive representations of Types - PrimRep(..), PrimElemRep(..), + PrimRep(..), PrimElemRep(..), Levity(..), primElemRepToPrimRep, isVoidRep, isGcPtrRep, primRepSizeB, @@ -1536,8 +1536,7 @@ See Note [RuntimeRep and PrimRep] in GHC.Types.RepType. -- "GHC.Types.RepType" and Note [VoidRep] in "GHC.Types.RepType". data PrimRep = VoidRep - | LiftedRep - | UnliftedRep -- ^ Unlifted pointer + | BoxedRep {-# UNPACK #-} !(Maybe Levity) -- ^ Boxed, heap value | Int8Rep -- ^ Signed, 8-bit value | Int16Rep -- ^ Signed, 16-bit value | Int32Rep -- ^ Signed, 32-bit value @@ -1548,7 +1547,7 @@ data PrimRep | Word32Rep -- ^ Unsigned, 32 bit value | Word64Rep -- ^ Unsigned, 64 bit value | WordRep -- ^ Unsigned, word-sized value - | AddrRep -- ^ A pointer, but /not/ to a Haskell value (use '(Un)liftedRep') + | AddrRep -- ^ A pointer, but /not/ to a Haskell value (use 'BoxedRep') | FloatRep | DoubleRep | VecRep Int PrimElemRep -- ^ A vector @@ -1575,42 +1574,47 @@ instance Outputable PrimElemRep where instance Binary PrimRep where put_ bh VoidRep = putByte bh 0 - put_ bh LiftedRep = putByte bh 1 - put_ bh UnliftedRep = putByte bh 2 - put_ bh Int8Rep = putByte bh 3 - put_ bh Int16Rep = putByte bh 4 - put_ bh Int32Rep = putByte bh 5 - put_ bh Int64Rep = putByte bh 6 - put_ bh IntRep = putByte bh 7 - put_ bh Word8Rep = putByte bh 8 - put_ bh Word16Rep = putByte bh 9 - put_ bh Word32Rep = putByte bh 10 - put_ bh Word64Rep = putByte bh 11 - put_ bh WordRep = putByte bh 12 - put_ bh AddrRep = putByte bh 13 - put_ bh FloatRep = putByte bh 14 - put_ bh DoubleRep = putByte bh 15 - put_ bh (VecRep n per) = putByte bh 16 *> put_ bh n *> put_ bh per + put_ bh (BoxedRep ml) = case ml of + -- cheaper storage of the levity than using + -- the Binary (Maybe Levity) instance + Nothing -> putByte bh 1 + Just Lifted -> putByte bh 2 + Just Unlifted -> putByte bh 3 + put_ bh Int8Rep = putByte bh 4 + put_ bh Int16Rep = putByte bh 5 + put_ bh Int32Rep = putByte bh 6 + put_ bh Int64Rep = putByte bh 7 + put_ bh IntRep = putByte bh 8 + put_ bh Word8Rep = putByte bh 9 + put_ bh Word16Rep = putByte bh 10 + put_ bh Word32Rep = putByte bh 11 + put_ bh Word64Rep = putByte bh 12 + put_ bh WordRep = putByte bh 13 + put_ bh AddrRep = putByte bh 14 + put_ bh FloatRep = putByte bh 15 + put_ bh DoubleRep = putByte bh 16 + put_ bh (VecRep n per) = putByte bh 17 *> put_ bh n *> put_ bh per get bh = do h <- getByte bh case h of 0 -> pure VoidRep - 1 -> pure LiftedRep - 2 -> pure UnliftedRep - 3 -> pure Int8Rep - 4 -> pure Int16Rep - 5 -> pure Int32Rep - 6 -> pure Int64Rep - 7 -> pure IntRep - 8 -> pure Word8Rep - 9 -> pure Word16Rep - 10 -> pure Word32Rep - 11 -> pure Word64Rep - 12 -> pure WordRep - 13 -> pure AddrRep - 14 -> pure FloatRep - 15 -> pure DoubleRep - 16 -> VecRep <$> get bh <*> get bh + 1 -> pure $ BoxedRep Nothing + 2 -> pure $ BoxedRep (Just Lifted) + 3 -> pure $ BoxedRep (Just Unlifted) + 4 -> pure Int8Rep + 5 -> pure Int16Rep + 6 -> pure Int32Rep + 7 -> pure Int64Rep + 8 -> pure IntRep + 9 -> pure Word8Rep + 10 -> pure Word16Rep + 11 -> pure Word32Rep + 12 -> pure Word64Rep + 13 -> pure WordRep + 14 -> pure AddrRep + 15 -> pure FloatRep + 16 -> pure DoubleRep + 17 -> VecRep <$> get bh <*> get bh _ -> pprPanic "Binary:PrimRep" (int (fromIntegral h)) instance Binary PrimElemRep where @@ -1622,9 +1626,8 @@ isVoidRep VoidRep = True isVoidRep _other = False isGcPtrRep :: PrimRep -> Bool -isGcPtrRep LiftedRep = True -isGcPtrRep UnliftedRep = True -isGcPtrRep _ = False +isGcPtrRep (BoxedRep _) = True +isGcPtrRep _ = False -- A PrimRep is compatible with another iff one can be coerced to the other. -- See Note [Bad unsafe coercion] in GHC.Core.Lint for when are two types coercible. @@ -1665,8 +1668,7 @@ primRepSizeB platform = \case FloatRep -> fLOAT_SIZE DoubleRep -> dOUBLE_SIZE AddrRep -> platformWordSizeInBytes platform - LiftedRep -> platformWordSizeInBytes platform - UnliftedRep -> platformWordSizeInBytes platform + BoxedRep _ -> platformWordSizeInBytes platform VoidRep -> 0 (VecRep len rep) -> len * primElemRepSizeB platform rep ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -117,56 +117,10 @@ dsTopLHsBinds binds top_level_err bindsType (L loc bind) = putSrcSpanDs (locA loc) $ diagnosticDs (DsTopLevelBindsNotAllowed bindsType bind) -{- -Note [Return bindings in dependency order] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The desugarer tries to desugar a non-recursive let-binding to a collection of -one or more non-recursive let-bindings. The alternative is to generate a letrec -and wait for the occurrence analyser to sort it out later, but it is pretty easy -to arrange that the [(Id,CoreExpr)] pairs returned by dsLHsBinds are returned in -dependency order - -It's most important for linear types, where non-recursive lets can be linear -whereas recursive-let can't. Since we check the output of the desugarer for -linearity (see also Note [Linting linearity]), desugaring non-recursive lets to -recursive lets would break linearity checks. An alternative is to refine the -typing rule for recursive lets so that we don't have to care (see in particular -#23218 and #18694), but the outcome of this line of work is still unclear. In -the meantime, being a little precise in the desugarer is cheap. (paragraph -written on 2023-06-09) - -In dsLHSBinds (and dependencies), a single binding can be desugared to multiple -bindings. For instance because the source binding has the {-# SPECIALIZE #-} -pragma. In: - -f _ = … - where - {-# SPECIALIZE g :: F Int -> F Int #-} - g :: C a => F a -> F a - g _ = … - -The g binding desugars to - -let { - $sg = … } in - - g - [RULES: "SPEC g" g @Int $dC = $sg] - g = … -In order to avoid generating a letrec that will immediately be reordered, we -make sure to return the binding in dependency order [$sg, g]. - -This only matters when the source binding is non-recursive as recursive bindings -are always desugared to a single mutually recursive block. - --} -- | Desugar all other kind of bindings, Ids of strict binds are returned to -- later be forced in the binding group body, see Note [Desugar Strict binds] --- --- Invariant: the desugared bindings are returned in dependency order, --- see Note [Return bindings in dependency order] dsLHsBinds :: LHsBinds GhcTc -> DsM ([Id], [(Id,CoreExpr)]) dsLHsBinds binds = do { ds_bs <- mapBagM dsLHsBind binds @@ -180,9 +134,6 @@ dsLHsBind (L loc bind) = do dflags <- getDynFlags putSrcSpanDs (locA loc) $ dsHsBind dflags bind -- | Desugar a single binding (or group of recursive binds). --- --- Invariant: the desugared bindings are returned in dependency order, --- see Note [Return bindings in dependency order] dsHsBind :: DynFlags -> HsBind GhcTc -> DsM ([Id], [(Id,CoreExpr)]) @@ -312,7 +263,7 @@ dsAbsBinds dflags tyvars dicts exports (isDefaultMethod prags) (dictArity dicts) rhs - ; return (force_vars', fromOL spec_binds ++ [main_bind]) } } + ; return (force_vars', main_bind : fromOL spec_binds) } } -- Another common case: no tyvars, no dicts -- In this case we can have a much simpler desugaring @@ -371,7 +322,7 @@ dsAbsBinds dflags tyvars dicts exports -- Kill the INLINE pragma because it applies to -- the user written (local) function. The global -- Id is just the selector. Hmm. - ; return (fromOL spec_binds ++ [(global', rhs)]) } } + ; return ((global', rhs) : fromOL spec_binds) } } ; export_binds_s <- mapM mk_bind (exports ++ extra_exports) ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -160,20 +160,17 @@ ds_val_bind (is_rec, binds) body -- NB: bindings have a fixed RuntimeRep, so it's OK to call isUnliftedType case prs of [] -> return body - _ -> return (mkLets (mk_binds is_rec prs) body') } - -- We can make a non-recursive let because we make sure to return - -- the bindings in dependency order in dsLHsBinds, see Note [Return bindings in dependency order] - --- | Helper function. You can use the result of 'mk_binds' with 'mkLets' for --- instance. --- --- * @'mk_binds' 'Recursive' binds@ makes a single mutually-recursive --- bindings with all the rhs/lhs pairs in @binds@ --- * @'mk_binds' 'NonRecursive' binds@ makes one non-recursive binding --- for each rhs/lhs pairs in @binds@ -mk_binds :: RecFlag -> [(b, (Expr b))] -> [Bind b] -mk_binds Recursive binds = [Rec binds] -mk_binds NonRecursive binds = map (uncurry NonRec) binds + _ -> return (Let (Rec prs) body') } + -- Use a Rec regardless of is_rec. + -- Why? Because it allows the binds to be all + -- mixed up, which is what happens in one rare case + -- Namely, for an AbsBind with no tyvars and no dicts, + -- but which does have dictionary bindings. + -- See notes with GHC.Tc.Solver.inferLoop [NO TYVARS] + -- It turned out that wrapping a Rec here was the easiest solution + -- + -- NB The previous case dealt with unlifted bindings, so we + -- only have to deal with lifted ones now; so Rec is ok ------------------ dsUnliftedBind :: HsBind GhcTc -> CoreExpr -> DsM CoreExpr ===================================== compiler/GHC/Stg/Syntax.hs ===================================== @@ -174,10 +174,9 @@ isDllConApp platform ext_dyn_refs this_mod con args -- -- The coercion argument here gets VoidRep isAddrRep :: PrimRep -> Bool -isAddrRep AddrRep = True -isAddrRep LiftedRep = True -isAddrRep UnliftedRep = True -isAddrRep _ = False +isAddrRep AddrRep = True +isAddrRep (BoxedRep _) = True -- FIXME: not true for JavaScript +isAddrRep _ = False -- | Type of an @StgArg@ -- ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -1603,8 +1603,7 @@ primRepToFFIType platform r AddrRep -> FFIPointer FloatRep -> FFIFloat DoubleRep -> FFIDouble - LiftedRep -> FFIPointer - UnliftedRep -> FFIPointer + BoxedRep _ -> FFIPointer _ -> pprPanic "primRepToFFIType" (ppr r) where (signed_word, unsigned_word) = case platformWordSize platform of @@ -1629,9 +1628,8 @@ mkDummyLiteral platform pr AddrRep -> LitNullAddr DoubleRep -> LitDouble 0 FloatRep -> LitFloat 0 - LiftedRep -> LitNullAddr - UnliftedRep -> LitNullAddr - _ -> pprPanic "mkDummyLiteral" (ppr pr) + BoxedRep _ -> LitNullAddr + _ -> pprPanic "mkDummyLiteral" (ppr pr) -- Convert (eg) ===================================== compiler/GHC/StgToCmm/ArgRep.hs ===================================== @@ -69,8 +69,7 @@ argRepString V64 = "V64" toArgRep :: Platform -> PrimRep -> ArgRep toArgRep platform rep = case rep of VoidRep -> V - LiftedRep -> P - UnliftedRep -> P + BoxedRep _ -> P IntRep -> N WordRep -> N Int8Rep -> N -- Gets widened to native word width for calls ===================================== compiler/GHC/StgToCmm/Lit.hs ===================================== @@ -53,8 +53,7 @@ cgLit (LitString s) = cgLit (LitRubbish _ rep) = case expectOnly "cgLit" prim_reps of -- Note [Post-unarisation invariants] VoidRep -> panic "cgLit:VoidRep" -- ditto - LiftedRep -> idInfoToAmode <$> getCgIdInfo unitDataConId - UnliftedRep -> idInfoToAmode <$> getCgIdInfo unitDataConId + BoxedRep _ -> idInfoToAmode <$> getCgIdInfo unitDataConId AddrRep -> cgLit LitNullAddr VecRep n elem -> do platform <- getPlatform ===================================== compiler/GHC/StgToJS/Apply.hs ===================================== @@ -48,6 +48,7 @@ import GHC.Types.Literal import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.CostCentre +import GHC.Types.RepType (mightBeFunTy) import GHC.Stg.Syntax @@ -204,7 +205,7 @@ genApp ctx i args -- no args and Id can't be a function: just enter it | [] <- args , idFunRepArity i == 0 - , not (mightBeAFunction (idType i)) + , not (mightBeFunTy (idType i)) = do enter_id <- genIdArg i >>= \case ===================================== compiler/GHC/StgToJS/Expr.hs ===================================== @@ -382,7 +382,6 @@ verifyRuntimeReps xs = do go _ _ = pprPanic "verifyRuntimeReps: inconsistent sizes" (ppr xs) ver j PtrV = v "h$verify_rep_heapobj" [j] ver j IntV = v "h$verify_rep_int" [j] - ver j RtsObjV = v "h$verify_rep_rtsobj" [j] ver j DoubleV = v "h$verify_rep_double" [j] ver j ArrV = v "h$verify_rep_arr" [j] ver _ _ = mempty ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -340,7 +340,6 @@ rts' s = , TxtI "h$vt_double" ||= toJExpr IntV , TxtI "h$vt_long" ||= toJExpr LongV , TxtI "h$vt_addr" ||= toJExpr AddrV - , TxtI "h$vt_rtsobj" ||= toJExpr RtsObjV , TxtI "h$vt_obj" ||= toJExpr ObjV , TxtI "h$vt_arr" ||= toJExpr ArrV , jFun (TxtI "h$bh") (bhStats s True) ===================================== compiler/GHC/StgToJS/Types.hs ===================================== @@ -150,13 +150,13 @@ instance ToJExpr CIStatic where -- | Free variable types data VarType - = PtrV -- ^ pointer = reference to heap object (closure object) + = PtrV -- ^ pointer = reference to heap object (closure object), lifted or not. + -- Can also be some RTS object (e.g. TVar#, MVar#, MutVar#, Weak#) | VoidV -- ^ no fields | DoubleV -- ^ A Double: one field | IntV -- ^ An Int (32bit because JS): one field | LongV -- ^ A Long: two fields one for the upper 32bits, one for the lower (NB: JS is little endian) | AddrV -- ^ a pointer not to the heap: two fields, array + index - | RtsObjV -- ^ some RTS object from GHCJS (for example TVar#, MVar#, MutVar#, Weak#) | ObjV -- ^ some JS object, user supplied, be careful around these, can be anything | ArrV -- ^ boxed array deriving stock (Eq, Ord, Enum, Bounded, Show) ===================================== compiler/GHC/StgToJS/Utils.hs ===================================== @@ -38,7 +38,6 @@ module GHC.StgToJS.Utils , assocPrimReps , assocIdPrimReps , assocIdExprs - , mightBeAFunction , mkArityTag , toTypeList -- * Stg Utils @@ -147,11 +146,11 @@ assignCoerce1 _x _y = pprPanic "assignCoerce1" -- | Assign p2 to p1 with optional coercion assignCoerce :: TypedExpr -> TypedExpr -> JStat -- Coercion between StablePtr# and Addr# -assignCoerce (TypedExpr AddrRep [a_val, a_off]) (TypedExpr UnliftedRep [sptr]) = mconcat +assignCoerce (TypedExpr AddrRep [a_val, a_off]) (TypedExpr (BoxedRep (Just Unlifted)) [sptr]) = mconcat [ a_val |= var "h$stablePtrBuf" , a_off |= sptr ] -assignCoerce (TypedExpr UnliftedRep [sptr]) (TypedExpr AddrRep [_a_val, a_off]) = +assignCoerce (TypedExpr (BoxedRep (Just Unlifted)) [sptr]) (TypedExpr AddrRep [_a_val, a_off]) = sptr |= a_off assignCoerce p1 p2 = assignTypedExprs [p1] [p2] @@ -258,8 +257,7 @@ uTypeVt ut primRepVt :: HasDebugCallStack => PrimRep -> VarType primRepVt VoidRep = VoidV -primRepVt LiftedRep = PtrV -- fixme does ByteArray# ever map to this? -primRepVt UnliftedRep = RtsObjV +primRepVt (BoxedRep _) = PtrV -- fixme does ByteArray# ever map to this? primRepVt IntRep = IntV primRepVt Int8Rep = IntV primRepVt Int16Rep = IntV @@ -316,26 +314,26 @@ primTypeVt t = case tyConAppTyCon_maybe (unwrapType t) of | tc == word64PrimTyCon -> LongV | tc == addrPrimTyCon -> AddrV | tc == stablePtrPrimTyCon -> AddrV - | tc == stableNamePrimTyCon -> RtsObjV + | tc == stableNamePrimTyCon -> PtrV | tc == statePrimTyCon -> VoidV | tc == proxyPrimTyCon -> VoidV | tc == realWorldTyCon -> VoidV - | tc == threadIdPrimTyCon -> RtsObjV - | tc == weakPrimTyCon -> RtsObjV + | tc == threadIdPrimTyCon -> PtrV + | tc == weakPrimTyCon -> PtrV | tc == arrayPrimTyCon -> ArrV | tc == smallArrayPrimTyCon -> ArrV | tc == byteArrayPrimTyCon -> ObjV -- can contain any JS reference, used for JSVal | tc == mutableArrayPrimTyCon -> ArrV | tc == smallMutableArrayPrimTyCon -> ArrV | tc == mutableByteArrayPrimTyCon -> ObjV -- can contain any JS reference, used for JSVal - | tc == mutVarPrimTyCon -> RtsObjV - | tc == mVarPrimTyCon -> RtsObjV - | tc == tVarPrimTyCon -> RtsObjV - | tc == bcoPrimTyCon -> RtsObjV -- unsupported? - | tc == stackSnapshotPrimTyCon -> RtsObjV - | tc == ioPortPrimTyCon -> RtsObjV -- unsupported? + | tc == mutVarPrimTyCon -> PtrV + | tc == mVarPrimTyCon -> PtrV + | tc == tVarPrimTyCon -> PtrV + | tc == bcoPrimTyCon -> PtrV -- unsupported? + | tc == stackSnapshotPrimTyCon -> PtrV + | tc == ioPortPrimTyCon -> PtrV -- unsupported? | tc == anyTyCon -> PtrV - | tc == compactPrimTyCon -> ObjV -- unsupported? + | tc == compactPrimTyCon -> PtrV -- unsupported? | tc == eqPrimTyCon -> VoidV -- coercion token? | tc == eqReprPrimTyCon -> VoidV -- role | tc == unboxedUnitTyCon -> VoidV -- Void# @@ -392,17 +390,6 @@ assocIdPrimReps i = assocPrimReps (idPrimReps i) assocIdExprs :: Id -> [JExpr] -> [TypedExpr] assocIdExprs i es = fmap (uncurry TypedExpr) (assocIdPrimReps i es) --- | Return False only if we are *sure* it's a data type --- Look through newtypes etc as much as possible -mightBeAFunction :: HasDebugCallStack => Type -> Bool -mightBeAFunction ty - | [LiftedRep] <- typePrimRep ty - , Just tc <- tyConAppTyCon_maybe (unwrapType ty) - , isDataTyCon tc - = False - | otherwise - = True - mkArityTag :: Int -> Int -> Int mkArityTag arity registers = arity Bits..|. (registers `Bits.shiftL` 8) ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -20,6 +20,7 @@ types that {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} module GHC.Types.Basic ( LeftOrRight(..), @@ -1956,12 +1957,20 @@ isKindLevel KindLevel = True data Levity = Lifted | Unlifted - deriving Eq + deriving (Data,Eq,Ord,Show) instance Outputable Levity where ppr Lifted = text "Lifted" ppr Unlifted = text "Unlifted" +instance Binary Levity where + put_ bh = \case + Lifted -> putByte bh 0 + Unlifted -> putByte bh 1 + get bh = getByte bh >>= \case + 0 -> pure Lifted + _ -> pure Unlifted + mightBeLifted :: Maybe Levity -> Bool mightBeLifted (Just Unlifted) = False mightBeLifted _ = True ===================================== compiler/GHC/Types/RepType.hs ===================================== @@ -315,8 +315,10 @@ typeSlotTy ty = case typePrimRep ty of primRepSlot :: PrimRep -> SlotTy primRepSlot VoidRep = pprPanic "primRepSlot" (text "No slot for VoidRep") -primRepSlot LiftedRep = PtrLiftedSlot -primRepSlot UnliftedRep = PtrUnliftedSlot +primRepSlot (BoxedRep mlev) = case mlev of + Nothing -> panic "primRepSlot: levity polymorphic BoxedRep" + Just Lifted -> PtrLiftedSlot + Just Unlifted -> PtrUnliftedSlot primRepSlot IntRep = WordSlot primRepSlot Int8Rep = WordSlot primRepSlot Int16Rep = WordSlot @@ -333,8 +335,8 @@ primRepSlot DoubleRep = DoubleSlot primRepSlot (VecRep n e) = VecSlot n e slotPrimRep :: SlotTy -> PrimRep -slotPrimRep PtrLiftedSlot = LiftedRep -slotPrimRep PtrUnliftedSlot = UnliftedRep +slotPrimRep PtrLiftedSlot = BoxedRep (Just Lifted) +slotPrimRep PtrUnliftedSlot = BoxedRep (Just Unlifted) slotPrimRep Word64Slot = Word64Rep slotPrimRep WordSlot = WordRep slotPrimRep DoubleSlot = DoubleRep @@ -635,8 +637,10 @@ runtimeRepPrimRep_maybe rr_ty primRepToRuntimeRep :: PrimRep -> RuntimeRepType primRepToRuntimeRep rep = case rep of VoidRep -> zeroBitRepTy - LiftedRep -> liftedRepTy - UnliftedRep -> unliftedRepTy + BoxedRep mlev -> case mlev of + Nothing -> panic "primRepToRuntimeRep: levity polymorphic BoxedRep" + Just Lifted -> liftedRepTy + Just Unlifted -> unliftedRepTy IntRep -> intRepDataConTy Int8Rep -> int8RepDataConTy Int16Rep -> int16RepDataConTy @@ -688,7 +692,7 @@ mightBeFunTy :: Type -> Bool -- AK: It would be nice to figure out and document the difference -- between this and isFunTy at some point. mightBeFunTy ty - | [LiftedRep] <- typePrimRep ty + | [BoxedRep _] <- typePrimRep ty , Just tc <- tyConAppTyCon_maybe (unwrapType ty) , isDataTyCon tc = False ===================================== rts/js/rts.js ===================================== @@ -245,7 +245,7 @@ function h$printcl(i) { r += " "; switch(cl.i[i]) { case h$vt_ptr: - r += "[ Ptr :: " + d["d"+idx].f.n + "]"; + r += "[ Ptr :: " + d["d"+idx] + "]"; idx++; break; case h$vt_void: @@ -267,10 +267,6 @@ function h$printcl(i) { r += "(" + d["d"+idx].length + "," + d["d"+(idx+1)] + " :: ptr)"; idx+=2; break; - case h$vt_rtsobj: - r += "(" + d["d"+idx].toString() + " :: RTS object)"; - idx++; - break; default: r += "unknown field: " + cl.i[i]; } ===================================== rts/js/verify.js ===================================== @@ -113,7 +113,7 @@ function h$verify_rep_is_bytearray(o) { function h$verify_rep_heapobj(o) { // possibly an unlifted rts object // XXX: we should do a different check for these - if(h$verify_rep_is_rtsobj(o)) return; + if(h$verify_rep_is_rtsobj(o)) return h$verify_rep_rtsobj(o); // unboxed rep if(typeof o === 'number' || typeof o === 'boolean') return; // boxed rep ===================================== testsuite/tests/ghci/should_run/T16096.stdout ===================================== @@ -1,6 +1,6 @@ ==================== Desugared ==================== -let { +letrec { x :: [GHC.Types.Int] [LclId] x = let { @@ -11,7 +11,7 @@ let { x :: [GHC.Types.Int] [LclId] x = GHC.Enum.enumFrom @GHC.Types.Int $dEnum (GHC.Types.I# 1#); } in - x } in + x; } in GHC.Base.returnIO @[GHC.Types.Any] (GHC.Types.: @@ -27,7 +27,7 @@ GHC.Base.returnIO ==================== Desugared ==================== -let { +letrec { x :: [GHC.Types.Int] [LclId] x = let { @@ -38,7 +38,7 @@ let { x :: [GHC.Types.Int] [LclId] x = GHC.Enum.enumFrom @GHC.Types.Int $dEnum (GHC.Types.I# 1#); } in - x } in + x; } in GHC.Base.returnIO @[GHC.Types.Any] (GHC.Types.: ===================================== testsuite/tests/primops/should_run/all.T ===================================== @@ -8,7 +8,7 @@ test('T10481', exit_code(1), compile_and_run, ['']) test('T10678', [ collect_stats('bytes allocated',5), only_ways(['normal']), - js_broken(22360) + js_broken(22361) ], compile_and_run, ['-O']) test('T11296', normal, compile_and_run, ['']) ===================================== testsuite/tests/rep-poly/T22291.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE DataKinds #-} + +module T22291 where + +import GHC.Exts + +foo :: forall (lev :: Levity) (a :: TYPE (BoxedRep lev)). Addr# -> (# a #) +foo x = addrToAny# x ===================================== testsuite/tests/rep-poly/T22291b.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE DataKinds, MagicHash, UnboxedTuples #-} + +module T22291b where + +import GHC.Exts + +indexArray :: forall l (a :: TYPE (BoxedRep l)). Array# a -> Int# -> (# a #) +indexArray = indexArray# ===================================== testsuite/tests/rep-poly/all.T ===================================== @@ -15,7 +15,7 @@ test('T18170b', [extra_files(['T18170c.hs']), expect_broken(19893)], multimod_co # T18170b isn't actually broken, but it causes a Core Lint error # even though the program is (correctly) rejected by the typechecker test('T18481', normal, compile, ['']) -test('T18481a', js_broken(22360), compile, ['']) +test('T18481a', normal, compile, ['']) test('T18534', normal, compile_fail, ['']) test('T19615', normal, compile_fail, ['']) test('T19709a', normal, compile_fail, ['']) @@ -29,8 +29,10 @@ test('T20423b', normal, compile_fail, ['']) test('T20426', normal, compile_fail, ['']) test('T21239', normal, compile, ['']) test('T21544', normal, compile, ['-Wno-deprecated-flags']) +test('T22291', normal, compile, ['']) +test('T22291b', normal, compile, ['']) -test('EtaExpandDataCon', js_broken(22360), compile, ['-O']) +test('EtaExpandDataCon', normal, compile, ['-O']) test('EtaExpandStupid1', normal, compile, ['-Wno-deprecated-flags']) test('EtaExpandStupid2', normal, compile_fail, ['-Wno-deprecated-flags']) test('LevPolyLet', normal, compile_fail, ['']) @@ -43,7 +45,7 @@ test('RepPolyBackpack1', normal, backpack_compile_fail, ['']) test('RepPolyBackpack2', req_c, backpack_run, ['']) test('RepPolyBackpack3', normal, backpack_compile_fail, ['']) test('RepPolyBackpack4', req_c, backpack_run, ['']) -test('RepPolyBackpack5', js_broken(22360), backpack_run, ['']) +test('RepPolyBackpack5', js_broken(22361), backpack_run, ['']) test('RepPolyBinder', normal, compile_fail, ['']) test('RepPolyCase1', normal, compile_fail, ['']) test('RepPolyClassMethod', normal, compile_fail, ['']) @@ -79,8 +81,8 @@ test('RepPolySum', normal, compile_fail, ['']) test('RepPolyTuple', normal, compile_fail, ['']) test('RepPolyTupleSection', normal, compile_fail, ['']) test('RepPolyUnboxedPatterns', normal, compile_fail, ['']) -test('RepPolyUnliftedDatatype', js_broken(22360), compile, ['']) -test('RepPolyUnliftedDatatype2', js_broken(22261), compile, ['-O']) +test('RepPolyUnliftedDatatype', normal, compile, ['']) +test('RepPolyUnliftedDatatype2', normal, compile, ['-O']) test('RepPolyUnliftedNewtype', normal, compile, ['-fno-warn-partial-type-signatures -fno-warn-deprecated-flags']) test('RepPolyWildcardPattern', normal, compile_fail, ['']) ===================================== testsuite/tests/unlifted-datatypes/should_compile/all.T ===================================== @@ -1,4 +1,4 @@ test('UnlDataMonoSigs', normal, compile, ['']) -test('UnlDataPolySigs', js_broken(22360), compile, ['']) +test('UnlDataPolySigs', normal, compile, ['']) test('UnlDataFams', normal, compile, ['']) -test('UnlDataUsersGuide', js_broken(22360), compile, ['']) +test('UnlDataUsersGuide', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7f598a99ee7a2fb2bd0a0e5ee6261086e3fbbb36...e09175c47ac69b2d21d49cf7b68ab4f02dd0371d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7f598a99ee7a2fb2bd0a0e5ee6261086e3fbbb36...e09175c47ac69b2d21d49cf7b68ab4f02dd0371d You're receiving 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 Jun 26 13:13:46 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 26 Jun 2023 09:13:46 -0400 Subject: [Git][ghc/ghc][wip/tsan/fixes-2] 75 commits: Avoid desugaring non-recursive lets into recursive lets Message-ID: <64998f0a34bd2_64cc0c7740311210@gitlab.mail> Ben Gamari pushed to branch wip/tsan/fixes-2 at Glasgow Haskell Compiler / GHC Commits: 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 17a2feb2 by Ben Gamari at 2023-06-26T09:11:01-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - 6be3da22 by Ben Gamari at 2023-06-26T09:11:01-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 76c19a69 by Ben Gamari at 2023-06-26T09:11:44-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - 4aafa3b4 by Ben Gamari at 2023-06-26T09:11:45-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 2f9ba321 by Ben Gamari at 2023-06-26T09:11:45-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 7e2b9860 by Sven Tennie at 2023-06-26T09:11:45-04:00 compiler: Drop MO_ReadBarrier - - - - - cae88d65 by Ben Gamari at 2023-06-26T09:12:43-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - c798dde6 by Sven Tennie at 2023-06-26T09:13:10-04:00 Delete write_barrier function - - - - - cb514e59 by Ben Gamari at 2023-06-26T09:13:11-04:00 compiler: Style fixes - - - - - 8b6915e5 by Ben Gamari at 2023-06-26T09:13:39-04:00 rts: Fix implicit cast This ensures that Task.h can be built with a C++ compiler. - - - - - b38d96f1 by Ben Gamari at 2023-06-26T09:13:39-04:00 rts: Fix data race in threadPaused This only affects an assertion in the debug RTS, but it's a data race nevertheless. - - - - - 66716432 by Ben Gamari at 2023-06-26T09:13:39-04:00 cmm: Introduce MO_RelaxedRead In hand-written Cmm it can sometimes be necessary to atomically load from memory deep within an expression (e.g. see the `CHECK_GC` macro). This MachOp provides a convenient way to do so without breaking the expression into multiple statements. - - - - - 6328d4cf by Ben Gamari at 2023-06-26T09:13:39-04:00 rts: Silence spurious data races in ticky counters Previously we would use non-atomic accesses when bumping ticky counters, which would result in spurious data race reports from ThreadSanitizer when the threaded RTS was in use. - - - - - 4d4f8c39 by Ben Gamari at 2023-06-26T09:13:39-04:00 Improve TSAN documentation - - - - - ad231ac6 by Ben Gamari at 2023-06-26T09:13:39-04:00 rts: Fix data race in Interpreter's preemption check - - - - - a2628de0 by Ben Gamari at 2023-06-26T09:13:39-04:00 rts: Fix data race in threadStatus# - - - - - b1fd8183 by Ben Gamari at 2023-06-26T09:13:39-04:00 rts: Fix data race in CHECK_GC - - - - - 13f9cef1 by Ben Gamari at 2023-06-26T09:13:39-04:00 base: use atomic write when updating timer manager - - - - - 28043a78 by Ben Gamari at 2023-06-26T09:13:39-04:00 Use relaxed atomics to manipulate TSO status fields - - - - - fcffa3b2 by Ben Gamari at 2023-06-26T09:13:39-04:00 rts: Add necessary barriers when manipulating TSO owner - - - - - f7c7a28f by Ben Gamari at 2023-06-26T09:13:39-04:00 rts: Fix synchronization on thread blocking state - - - - - 0089491a by Ben Gamari at 2023-06-26T09:13:39-04:00 rts: Relaxed load MutVar info table - - - - - 3d5b0991 by Ben Gamari at 2023-06-26T09:13:39-04:00 hadrian: More debug information - - - - - 57027e21 by Ben Gamari at 2023-06-26T09:13:39-04:00 hadrian: More selective TSAN instrumentation - - - - - 586b29a8 by Ben Gamari at 2023-06-26T09:13:39-04:00 codeGen/tsan: Rework handling of spilling - - - - - c821034e by Ben Gamari at 2023-06-26T09:13:39-04:00 codeGen: Ensure that TSAN is aware of writeArray# write barriers - - - - - 72841699 by Ben Gamari at 2023-06-26T09:13:39-04:00 codeGen: Ensure that array reads have necessary barriers This was the cause of #23541. - - - - - 4cb38828 by Ben Gamari at 2023-06-26T09:13:39-04:00 Wordsmith TSAN Note - - - - - 16d60720 by Ben Gamari at 2023-06-26T09:13:39-04:00 codeGen: Use relaxed accesses in ticky bumping - - - - - d3374bdd by Ben Gamari at 2023-06-26T09:13:39-04:00 codeGen: Use relaxed-read in closureInfoPtr - - - - - 98e332b5 by Ben Gamari at 2023-06-26T09:13:39-04:00 Fix thunk update ordering Previously we attempted to ensure soundness of concurrent thunk update by synchronizing on the access of the thunk's info table pointer field. This was believed to be sufficient since the indirectee (which may expose a closure allocated by another core) would not be examined until the info table pointer update is complete. However, it turns out that this can result in data races in the presence of multiple threads racing a update a single thunk. For instance, consider this interleaving under the old scheme: Thread A Thread B --------- --------- t=0 Enter t 1 Push update frame 2 Begin evaluation 4 Pause thread 5 t.indirectee=tso 6 Release t.info=BLACKHOLE 7 ... (e.g. GC) 8 Resume thread 9 Finish evaluation 10 Relaxed t.indirectee=x 11 Load t.info 12 Acquire fence 13 Inspect t.indirectee 14 Release t.info=BLACKHOLE Here Thread A enters thunk `t` but is soon paused, resulting in `t` being lazily blackholed at t=6. Then, at t=10 Thread A finishes evaluation and updates `t.indirectee` with a relaxed store. Meanwhile, Thread B enters the blackhole. Under the old scheme this would introduce an acquire-fence but this would only synchronize with Thread A at t=6. Consequently, the result of the evaluation, `x`, is not visible to Thread B, introducing a data race. We fix this by treating the `indirectee` field as we do all other mutable fields. This means we must always access this field with acquire-loads and release-stores. See #23185. - - - - - 4f2d04d8 by Ben Gamari at 2023-06-26T09:13:39-04:00 STM: Use acquire loads when possible Full sequential consistency is not needed here. - - - - - b55a494a by Ubuntu at 2023-06-26T09:13:39-04:00 ghc-prim: Use C11 atomics - - - - - 80f9d775 by Ubuntu at 2023-06-26T09:13:39-04:00 Run script - - - - - 86a2119e by Ben Gamari at 2023-06-26T09:13:39-04:00 hadrian: Ensure that way-flags are passed to CC Previously the way-specific compilation flags (e.g. `-DDEBUG`, `-DTHREADED_RTS`) would not be passed to the CC invocations. This meant that C dependency files would not correctly reflect dependencies predicated on the way, resulting in the rather painful #23554. Closes #23554. - - - - - 568b514d by Ben Gamari at 2023-06-26T09:13:40-04:00 rts/Interpreter: Fix data race - - - - - efc9df57 by Ben Gamari at 2023-06-26T09:13:40-04:00 rts/Messages: Fix data race - - - - - 529fef1b by Ben Gamari at 2023-06-26T09:13:40-04:00 rts/Prof: Fix data race - - - - - b1d8443d by Ben Gamari at 2023-06-26T09:13:40-04:00 rts: Fix various data races - - - - - b06cb3bf by Ben Gamari at 2023-06-26T09:13:40-04:00 rts: Use fence rather than redundant load - - - - - acc89bfa by Ben Gamari at 2023-06-26T09:13:40-04:00 codeGen: More precise barriers for eager blackholing - - - - - 2e36d1c5 by Ben Gamari at 2023-06-26T09:13:40-04:00 testsuite: Add AtomicModifyIORef test - - - - - 7739ae27 by Ben Gamari at 2023-06-26T09:13:40-04:00 MutVar - - - - - 4fdd316f by Ben Gamari at 2023-06-26T09:13:40-04:00 Tighten up thunk update barriers - - - - - 73b1da45 by Ben Gamari at 2023-06-26T09:13:40-04:00 testsuite: Fix warning in hs_try_putmvar001 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Info.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/ThreadSanitizer.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Iface/Make.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6093adb74d77096b8053910cd81d1f2116bd47c3...73b1da45be8171ac78c6c14b1e7edfe08896b0c1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6093adb74d77096b8053910cd81d1f2116bd47c3...73b1da45be8171ac78c6c14b1e7edfe08896b0c1 You're receiving 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 Jun 26 13:26:05 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 26 Jun 2023 09:26:05 -0400 Subject: [Git][ghc/ghc][wip/tsan/fixes-2] rts: Fix warning Message-ID: <649991ed646be_64cc0c76b43168f1@gitlab.mail> Ben Gamari pushed to branch wip/tsan/fixes-2 at Glasgow Haskell Compiler / GHC Commits: 424e1e99 by Ben Gamari at 2023-06-26T09:25:57-04:00 rts: Fix warning - - - - - 1 changed file: - rts/TraverseHeap.c Changes: ===================================== rts/TraverseHeap.c ===================================== @@ -1247,6 +1247,7 @@ inner_loop: traversePushClosure(ts, tso->block_info.closure, c, sep, child_data); break; default: + break; } goto loop; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/424e1e998021639fdea8ef5a238ebc7af6abf319 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/424e1e998021639fdea8ef5a238ebc7af6abf319 You're receiving 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 Jun 26 13:38:07 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 26 Jun 2023 09:38:07 -0400 Subject: [Git][ghc/ghc][wip/expand-do] 19 commits: configure: Bump version to 9.9 Message-ID: <649994bf242c6_64cc0c7510320614@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 30ddd806 by Apoorv Ingle at 2023-06-26T08:37:54-05:00 Fixes #18324 #23147 Expands do notation before typechecking using `HsExpansion` - Adds testcases T18324, T18324b, DoubleMatch Expands - Do statements - Monadic do statements - monadic fix blocks - make sure fail is used for pattern match failures in bind statments - Makes sure unused binds generate warnings - runs the pattern match check in generated lambda exprs to avoid getting suprious pattern match failures. c.f. pmcheck/should_compile/DoubleMatch.hs - PopSrcSpan in HsExpr to pop error context - Discards default monad fail alternatives that are spuriously generated - Make sure we check for generated loc span for checking if the (>>) is user written or expanded for /do/ purposes - - - - - 73a3f528 by Apoorv Ingle at 2023-06-26T08:37:54-05:00 - Add PopSrcSpan (XXExprGhcRn) in appropriate places while expanding statements - correct source spans displayed for warnDiscardedDoBindings - use `mkExpandStmt` to store original stmts along with expanded expr for using the right context for error message printing - improves error messages for applicative do - remove special case from isMatchContextPmChecked (long distance info is now properly propogated) - set correct src spans to statement expansions - Match ctxt while type checking HsLam is different if the lambda match is due to an expression generated from a do block - call tcExpr and not tcApp in PopSrcSpan so make sure impredicativity works fine - look into XExprs in tcInferAppHead_maybe for infering the type to make T18324 typecheck and run - - - - - b8a2d456 by Apoorv Ingle at 2023-06-26T08:37:54-05:00 generate incomplete uni patterns warnings if the origin context is a generated do expansion - - - - - ec870a99 by Apoorv Ingle at 2023-06-26T08:37:54-05:00 use the correct bind operator for qualified rebindable rec do expansions - - - - - 91bf2681 by Apoorv Ingle at 2023-06-26T08:37:54-05:00 trying out changes to heralds - - - - - 7c517fe8 by Apoorv Ingle at 2023-06-26T08:37:54-05:00 add location information for last statements - - - - - c579e7ca by Apoorv Ingle at 2023-06-26T08:37:54-05:00 do not pop context while checking the second argument to expanded (>>) - - - - - e5065d42 by Apoorv Ingle at 2023-06-26T08:37:54-05:00 adjusting the generated spans for proper error messages - - - - - 77772d74 by Apoorv Ingle at 2023-06-26T08:37:54-05:00 change the addHeadCtxt to include the first statement of the do block for more precise error messages - - - - - f63a9125 by Apoorv Ingle at 2023-06-26T08:37:54-05:00 - don't add any ctxt in addExprCtxt for `XExpr(ExpandedStmt{})` as it is not very useful, the statement ctxt is already added by `tcExpr` and `addHeadCtxt` - - - - - ffbd0c86 by Apoorv Ingle at 2023-06-26T08:37:54-05:00 - addStmtCtxt to add the right statement context in the error contexts - expansion stmt to span over bind/>>= application and pattern rather than only the arguments - - - - - bcd19b1b by Apoorv Ingle at 2023-06-26T08:37:54-05:00 add stmt context in tcApp rather other places - - - - - cb2f7a31 by Apoorv Ingle at 2023-06-26T08:37:54-05:00 add the correct expression context in tcApp - - - - - 22b43f35 by Apoorv Ingle at 2023-06-26T08:37:54-05:00 disable expansion if applicative do is enabled - - - - - 7581268a by Apoorv Ingle at 2023-06-26T08:37:55-05:00 handle a special in desugaring when a do block has only one statment, the ds location should be set to that of the last statement - - - - - 53bb2c1a by Apoorv Ingle at 2023-06-26T08:37:55-05:00 do not add argument context if it is a do statement - - - - - 30 changed files: - .gitlab-ci.yml - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/TyCl/PatSyn.hs - compiler/GHC/Tc/TyCl/Utils.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Instantiate.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/SrcLoc.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e13451b4a16e0beb09a063ef2941fce9dc0a6beb...53bb2c1a3f578f278f1688b9201055168a2a53c3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e13451b4a16e0beb09a063ef2941fce9dc0a6beb...53bb2c1a3f578f278f1688b9201055168a2a53c3 You're receiving 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 Jun 26 13:51:13 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 09:51:13 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 25 commits: Configure MergeObjs supports response files rather than Ld Message-ID: <649997d1e170e_64cc0c76f032678@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 502caaa3 by Rodrigo Mesquita at 2023-06-26T14:11:03+01:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - d5791574 by Ben Gamari at 2023-06-26T14:11:03+01:00 ghc-toolchain: Initial commit - - - - - 12edf2ce by Ben Gamari at 2023-06-26T14:11:03+01:00 Rip out runtime linker/compiler checks - - - - - 816cf9d1 by Ben Gamari at 2023-06-26T14:11:27+01:00 configure: Rip out toolchain selection logic - - - - - f4a93aee by Rodrigo Mesquita at 2023-06-26T14:45:45+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b480f4ab1514ac0a4fc957db199d1a0279. Revert get_arm_isa deletion from 74f03f243d08aa910d39cdd9dadb976e9386283a As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X - - - - - 116804b8 by Rodrigo Mesquita at 2023-06-26T14:45:47+01:00 configure: Revert ripping out of toolchain selection logic - - - - - dc0a755e by Rodrigo Mesquita at 2023-06-26T14:45:47+01:00 Stop configuring into settings unused Ld command - - - - - 2cd9396b by Rodrigo Mesquita at 2023-06-26T14:45:47+01:00 configure: Create and validate toolchain target file - - - - - 42e13f7b by Rodrigo Mesquita at 2023-06-26T14:47:03+01:00 Fixes for ghc-toolchain to match configure output - - - - - d0c11f3d by Rodrigo Mesquita at 2023-06-26T14:47:05+01:00 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now - - - - - 971ecc34 by Rodrigo Mesquita at 2023-06-26T14:47:05+01:00 Tweak to prep_target_file - - - - - 49fadc4b by Rodrigo Mesquita at 2023-06-26T14:47:05+01:00 ghc-toolchain: Fix ar supports at file - - - - - 89d8997a by Rodrigo Mesquita at 2023-06-26T14:47:40+01:00 Fixes - - - - - d172a99f by Rodrigo Mesquita at 2023-06-26T14:48:14+01:00 ghc-toolchain: Fix check for gold bug - - - - - ddca75b5 by Rodrigo Mesquita at 2023-06-26T14:49:27+01:00 ghc-toolchain: set CC LD plat. dependent flags A lot to be said about this approach, we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? - - - - - 5b65d82a by Rodrigo Mesquita at 2023-06-26T14:49:28+01:00 Configure -Wl,--no-as-needed - - - - - a326b21f by Rodrigo Mesquita at 2023-06-26T14:50:21+01:00 ghc-toolchain: configure linker options correctly - - - - - 6f67a22f by Rodrigo Mesquita at 2023-06-26T14:50:23+01:00 Revert LLVMTarget deletion in mkprojectmkin - - - - - 9e26862c by Rodrigo Mesquita at 2023-06-26T14:50:23+01:00 Fix stack job - - - - - c2a56f8f by Rodrigo Mesquita at 2023-06-26T14:50:23+01:00 ghc-toolchain: Create default.target in the bindist - - - - - f066dac2 by Rodrigo Mesquita at 2023-06-26T14:51:00+01:00 Part of -Wl,--no-as-needed saga - - - - - 57bb085c by Rodrigo Mesquita at 2023-06-26T14:51:02+01:00 Support more targets and dont use llvmtarget - - - - - 064187bf by Rodrigo Mesquita at 2023-06-26T14:51:02+01:00 allow duplos in place of triples - - - - - 8000f790 by Rodrigo Mesquita at 2023-06-26T14:51:02+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - 3e17c729 by Rodrigo Mesquita at 2023-06-26T14:51:02+01:00 Use ghc-platform instead of ghc-boot del async dep - - - - - 30 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools.hs - compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - + default.target.in - distrib/configure.ac.in - ghc/Main.hs - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/db1e17eaf8b7f0b61d5dfa65012a05ea4e0ccc63...3e17c7293eb8f99bc592819bdea82a6a18357e31 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/db1e17eaf8b7f0b61d5dfa65012a05ea4e0ccc63...3e17c7293eb8f99bc592819bdea82a6a18357e31 You're receiving 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 Jun 26 14:16:51 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Mon, 26 Jun 2023 10:16:51 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/match-datatype Message-ID: <64999dd36bd4b_64cc0c76a0328969@gitlab.mail> David pushed new branch wip/match-datatype at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/match-datatype You're receiving 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 Jun 26 14:20:43 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 10:20:43 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 11 commits: ghc-toolchain: Toolchain Selection Message-ID: <64999ebb4aa26_64cc0c77403307f5@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 4351b3e7 by Rodrigo Mesquita at 2023-06-26T15:14:55+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b480f4ab1514ac0a4fc957db199d1a0279. Revert get_arm_isa deletion from 74f03f243d08aa910d39cdd9dadb976e9386283a As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples - - - - - 96496202 by Rodrigo Mesquita at 2023-06-26T15:16:16+01:00 configure: Revert ripping out of toolchain selection logic - - - - - 9c3f02df by Rodrigo Mesquita at 2023-06-26T15:16:19+01:00 Stop configuring into settings unused Ld command - - - - - bb302e46 by Rodrigo Mesquita at 2023-06-26T15:16:45+01:00 configure: Create and validate toolchain target file - - - - - 4549c2e3 by Rodrigo Mesquita at 2023-06-26T15:17:37+01:00 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now - - - - - b9873b4b by Rodrigo Mesquita at 2023-06-26T15:18:04+01:00 ghc-toolchain: set CC LD plat. dependent flags A lot to be said about this approach, we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? - - - - - 888b1096 by Rodrigo Mesquita at 2023-06-26T15:18:06+01:00 Configure -Wl,--no-as-needed - - - - - 02f4d5e3 by Rodrigo Mesquita at 2023-06-26T15:18:06+01:00 ghc-toolchain: Create default.target in the bindist - - - - - 693a9531 by Rodrigo Mesquita at 2023-06-26T15:18:06+01:00 Part of -Wl,--no-as-needed saga - - - - - 2f92eb68 by Rodrigo Mesquita at 2023-06-26T15:18:06+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - 5e3cabd7 by Rodrigo Mesquita at 2023-06-26T15:18:06+01:00 Use ghc-platform instead of ghc-boot del async dep - - - - - 30 changed files: - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/SysTools.hs - compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - + default.target.in - distrib/configure.ac.in - ghc/Main.hs - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Test.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3e17c7293eb8f99bc592819bdea82a6a18357e31...5e3cabd7f53d99ef25464bf0e5280b2f418be81b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3e17c7293eb8f99bc592819bdea82a6a18357e31...5e3cabd7f53d99ef25464bf0e5280b2f418be81b You're receiving 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 Jun 26 14:35:09 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 26 Jun 2023 10:35:09 -0400 Subject: [Git][ghc/ghc][wip/expand-do] remove applicative do expansion Message-ID: <6499a21dcc160_64cc0c76b43332cb@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 3fa99e62 by Apoorv Ingle at 2023-06-26T09:34:47-05:00 remove applicative do expansion - - - - - 3 changed files: - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Types/SrcLoc.hs Changes: ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1222,6 +1222,9 @@ expand_do_stmts _ (stmt@(L _ (ParStmt {})):_) = -- See See Note [Monad Comprehensions] pprPanic "expand_do_stmts: ParStmt" $ ppr stmt +expand_do_stmts do_or_lc (stmt@(L _ (ApplicativeStmt _ _ _)): lstmts) = + pprPanic "expand_do_stmts: Applicative Stmt" $ ppr stmt + expand_do_stmts _ [stmt@(L _ (LastStmt _ body _ ret_expr))] -- last statement of a list comprehension, needs to explicitly return it -- See `checkLastStmt` and `Syntax.Expr.StmtLR.LastStmt` @@ -1324,61 +1327,6 @@ expand_do_stmts do_or_lc -- LazyPat becuase we do not want to eagerly evaluate the pattern -- and potentially loop forever -expand_do_stmts do_or_lc ((L _ (ApplicativeStmt _ args mb_join)): lstmts) = --- See Note [Applicative BodyStmt] --- --- stmts ~~> stmts' --- ------------------------------------------------------------------------- --- [(<$>, \ x -> e1), (<*>, e2)] ; stmts ~~> (\ x -> stmts') <$> e1 <*> e2 ... --- --- Very similar to HsToCore.Expr.dsDo - --- args are [(<$>, e1), (<*>, e2), .., ] - do { expr' <- expand_do_stmts do_or_lc lstmts - -- extracts pats and arg bodies (rhss) from args - ; (pats_can_fail, rhss) <- unzip <$> mapM (do_arg . snd) args - - -- add blocks for failable patterns - ; body_with_fails <- foldrM match_args expr' pats_can_fail - - -- builds (body <$> e1 <*> e2 ...) - ; let expand_ado_expr = foldl mk_apps body_with_fails (zip (map fst args) rhss) - - -- wrap the expanded expression with a `join` if needed - ; final_expr <- case mb_join of - Nothing -> return $ expand_ado_expr - Just NoSyntaxExprRn -> return $ expand_ado_expr -- why can this happen? - Just (SyntaxExprRn join_op) -> - return $ genHsApp (wrapGenSpan join_op) (expand_ado_expr) - ; traceTc "expand_do_stmts AppStmt" (ppr final_expr) - ; return final_expr - } - where - do_arg :: ApplicativeArg GhcRn -> TcM ((LPat GhcRn, FailOperator GhcRn), LHsExpr GhcRn) - do_arg (ApplicativeArgOne - { xarg_app_arg_one = mb_fail_op - , app_arg_pattern = pat@(L loc _) - , arg_expr = rhs - }) = - return ((pat, mb_fail_op), L loc (mkExpandedStmt (L loc (BindStmt xbsn pat rhs)) rhs)) - do_arg (ApplicativeArgMany _ stmts ret pat ctxt) = - do { expr <- expand_do_stmts ctxt $ stmts ++ [wrapGenSpan $ mkLastStmt (wrapGenSpan ret)] - ; return ((pat, Nothing) - , {- wrapGenSpan $ mkExpandedExpr (HsDo noExtField ctxt (wrapGenSpan stmts)) (unLoc expr)-} expr) } - - match_args :: (LPat GhcRn, FailOperator GhcRn) -> LHsExpr GhcRn -> TcM (LHsExpr GhcRn) - match_args (pat, fail_op) body = mk_failable_lexpr_tcm pat body fail_op - - mk_apps :: LHsExpr GhcRn -> (SyntaxExprRn, LHsExpr GhcRn) -> LHsExpr GhcRn - mk_apps l_expr (op, r_expr) = - case op of - SyntaxExprRn op -> foldl genHsApp (wrapGenSpan op) [ l_expr - , r_expr ] - NoSyntaxExprRn -> pprPanic "expand_do_stmts op:" (ppr op) - - xbsn :: XBindStmtRn - xbsn = XBindStmtRn NoSyntaxExprRn Nothing - expand_do_stmts _ stmts = pprPanic "expand_do_stmts: impossible happened" $ (ppr stmts) ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -1332,10 +1332,12 @@ data ExpectedFunTyOrigin -- -- Test cases for representation-polymorphism checks: -- RepPolyApp - | ExpectedFunTyArg + | forall (p :: Pass) + . (OutputableBndrId p) + => ExpectedFunTyArg !TypedThing -- ^ function - !(HsExpr GhcRn) + !(HsExpr (GhcPass p)) -- ^ argument -- | Ensure that a function defined by equations indeed has a function type @@ -1378,19 +1380,11 @@ pprExpectedFunTyOrigin funTy_origin i = ExpectedFunTyViewPat expr -> vcat [ the_arg_of <+> text "the view pattern" , nest 2 (ppr expr) ] - ExpectedFunTyArg fun arg -> case arg of - XExpr (PopSrcSpan (L _ (XExpr (ExpandedStmt (HsExpanded {}))))) -> - -- likey an expanded statement - vcat [ sep [ the_arg_of - , text "the rebindable syntax operator" - , quotes (ppr fun) - ] - , nest 2 (text "arising from a do statement") - ] - _ -> sep [ text "The argument" - , quotes (ppr arg) - , text "of" - , quotes (ppr fun) ] + ExpectedFunTyArg fun arg -> + sep [ text "The argument" + , quotes (ppr arg) + , text "of" + , quotes (ppr fun) ] ExpectedFunTyMatches fun (MG { mg_alts = L _ alts }) | null alts -> the_arg_of <+> quotes (ppr fun) ===================================== compiler/GHC/Types/SrcLoc.hs ===================================== @@ -690,11 +690,11 @@ instance Outputable UnhelpfulSpanReason where unhelpfulSpanFS :: UnhelpfulSpanReason -> FastString unhelpfulSpanFS r = case r of - UnhelpfulOther s -> s - UnhelpfulNoLocationInfo -> fsLit "" - UnhelpfulWiredIn -> fsLit "" - UnhelpfulInteractive -> fsLit "" - UnhelpfulGenerated -> fsLit "" + UnhelpfulOther s -> s + UnhelpfulNoLocationInfo -> fsLit "" + UnhelpfulWiredIn -> fsLit "" + UnhelpfulInteractive -> fsLit "" + UnhelpfulGenerated -> fsLit "" pprUnhelpfulSpanReason :: UnhelpfulSpanReason -> SDoc pprUnhelpfulSpanReason r = ftext (unhelpfulSpanFS r) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3fa99e6210c6bd43eadbc45b8a8e72dbc8d1b7f7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3fa99e6210c6bd43eadbc45b8a8e72dbc8d1b7f7 You're receiving 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 Jun 26 14:39:34 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 26 Jun 2023 10:39:34 -0400 Subject: [Git][ghc/ghc][wip/expand-do] remove applicative do expansion Message-ID: <6499a3269013b_64cc0c75d83337f4@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: 9ad7dd6e by Apoorv Ingle at 2023-06-26T09:39:25-05:00 remove applicative do expansion - - - - - 3 changed files: - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Types/SrcLoc.hs Changes: ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -1222,6 +1222,9 @@ expand_do_stmts _ (stmt@(L _ (ParStmt {})):_) = -- See See Note [Monad Comprehensions] pprPanic "expand_do_stmts: ParStmt" $ ppr stmt +expand_do_stmts _ (stmt@(L _ (ApplicativeStmt _ _ _)): _) = + pprPanic "expand_do_stmts: Applicative Stmt" $ ppr stmt + expand_do_stmts _ [stmt@(L _ (LastStmt _ body _ ret_expr))] -- last statement of a list comprehension, needs to explicitly return it -- See `checkLastStmt` and `Syntax.Expr.StmtLR.LastStmt` @@ -1324,61 +1327,6 @@ expand_do_stmts do_or_lc -- LazyPat becuase we do not want to eagerly evaluate the pattern -- and potentially loop forever -expand_do_stmts do_or_lc ((L _ (ApplicativeStmt _ args mb_join)): lstmts) = --- See Note [Applicative BodyStmt] --- --- stmts ~~> stmts' --- ------------------------------------------------------------------------- --- [(<$>, \ x -> e1), (<*>, e2)] ; stmts ~~> (\ x -> stmts') <$> e1 <*> e2 ... --- --- Very similar to HsToCore.Expr.dsDo - --- args are [(<$>, e1), (<*>, e2), .., ] - do { expr' <- expand_do_stmts do_or_lc lstmts - -- extracts pats and arg bodies (rhss) from args - ; (pats_can_fail, rhss) <- unzip <$> mapM (do_arg . snd) args - - -- add blocks for failable patterns - ; body_with_fails <- foldrM match_args expr' pats_can_fail - - -- builds (body <$> e1 <*> e2 ...) - ; let expand_ado_expr = foldl mk_apps body_with_fails (zip (map fst args) rhss) - - -- wrap the expanded expression with a `join` if needed - ; final_expr <- case mb_join of - Nothing -> return $ expand_ado_expr - Just NoSyntaxExprRn -> return $ expand_ado_expr -- why can this happen? - Just (SyntaxExprRn join_op) -> - return $ genHsApp (wrapGenSpan join_op) (expand_ado_expr) - ; traceTc "expand_do_stmts AppStmt" (ppr final_expr) - ; return final_expr - } - where - do_arg :: ApplicativeArg GhcRn -> TcM ((LPat GhcRn, FailOperator GhcRn), LHsExpr GhcRn) - do_arg (ApplicativeArgOne - { xarg_app_arg_one = mb_fail_op - , app_arg_pattern = pat@(L loc _) - , arg_expr = rhs - }) = - return ((pat, mb_fail_op), L loc (mkExpandedStmt (L loc (BindStmt xbsn pat rhs)) rhs)) - do_arg (ApplicativeArgMany _ stmts ret pat ctxt) = - do { expr <- expand_do_stmts ctxt $ stmts ++ [wrapGenSpan $ mkLastStmt (wrapGenSpan ret)] - ; return ((pat, Nothing) - , {- wrapGenSpan $ mkExpandedExpr (HsDo noExtField ctxt (wrapGenSpan stmts)) (unLoc expr)-} expr) } - - match_args :: (LPat GhcRn, FailOperator GhcRn) -> LHsExpr GhcRn -> TcM (LHsExpr GhcRn) - match_args (pat, fail_op) body = mk_failable_lexpr_tcm pat body fail_op - - mk_apps :: LHsExpr GhcRn -> (SyntaxExprRn, LHsExpr GhcRn) -> LHsExpr GhcRn - mk_apps l_expr (op, r_expr) = - case op of - SyntaxExprRn op -> foldl genHsApp (wrapGenSpan op) [ l_expr - , r_expr ] - NoSyntaxExprRn -> pprPanic "expand_do_stmts op:" (ppr op) - - xbsn :: XBindStmtRn - xbsn = XBindStmtRn NoSyntaxExprRn Nothing - expand_do_stmts _ stmts = pprPanic "expand_do_stmts: impossible happened" $ (ppr stmts) ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -1332,10 +1332,12 @@ data ExpectedFunTyOrigin -- -- Test cases for representation-polymorphism checks: -- RepPolyApp - | ExpectedFunTyArg + | forall (p :: Pass) + . (OutputableBndrId p) + => ExpectedFunTyArg !TypedThing -- ^ function - !(HsExpr GhcRn) + !(HsExpr (GhcPass p)) -- ^ argument -- | Ensure that a function defined by equations indeed has a function type @@ -1378,19 +1380,11 @@ pprExpectedFunTyOrigin funTy_origin i = ExpectedFunTyViewPat expr -> vcat [ the_arg_of <+> text "the view pattern" , nest 2 (ppr expr) ] - ExpectedFunTyArg fun arg -> case arg of - XExpr (PopSrcSpan (L _ (XExpr (ExpandedStmt (HsExpanded {}))))) -> - -- likey an expanded statement - vcat [ sep [ the_arg_of - , text "the rebindable syntax operator" - , quotes (ppr fun) - ] - , nest 2 (text "arising from a do statement") - ] - _ -> sep [ text "The argument" - , quotes (ppr arg) - , text "of" - , quotes (ppr fun) ] + ExpectedFunTyArg fun arg -> + sep [ text "The argument" + , quotes (ppr arg) + , text "of" + , quotes (ppr fun) ] ExpectedFunTyMatches fun (MG { mg_alts = L _ alts }) | null alts -> the_arg_of <+> quotes (ppr fun) ===================================== compiler/GHC/Types/SrcLoc.hs ===================================== @@ -690,11 +690,11 @@ instance Outputable UnhelpfulSpanReason where unhelpfulSpanFS :: UnhelpfulSpanReason -> FastString unhelpfulSpanFS r = case r of - UnhelpfulOther s -> s - UnhelpfulNoLocationInfo -> fsLit "" - UnhelpfulWiredIn -> fsLit "" - UnhelpfulInteractive -> fsLit "" - UnhelpfulGenerated -> fsLit "" + UnhelpfulOther s -> s + UnhelpfulNoLocationInfo -> fsLit "" + UnhelpfulWiredIn -> fsLit "" + UnhelpfulInteractive -> fsLit "" + UnhelpfulGenerated -> fsLit "" pprUnhelpfulSpanReason :: UnhelpfulSpanReason -> SDoc pprUnhelpfulSpanReason r = ftext (unhelpfulSpanFS r) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9ad7dd6ef4d49df7b7a2b30928a19a392db10fb5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9ad7dd6ef4d49df7b7a2b30928a19a392db10fb5 You're receiving 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 Jun 26 14:52:56 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 10:52:56 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 10 commits: configure: Revert ripping out of toolchain selection logic Message-ID: <6499a648ee7a2_64cc0c76c8339331@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 5312975c by Rodrigo Mesquita at 2023-06-26T15:52:45+01:00 configure: Revert ripping out of toolchain selection logic - - - - - 5d82b556 by Rodrigo Mesquita at 2023-06-26T15:52:45+01:00 Stop configuring into settings unused Ld command - - - - - c82aff8c by Rodrigo Mesquita at 2023-06-26T15:52:45+01:00 configure: Create and validate toolchain target file - - - - - a765ff7c by Rodrigo Mesquita at 2023-06-26T15:52:45+01:00 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now - - - - - 89de6cfe by Rodrigo Mesquita at 2023-06-26T15:52:45+01:00 ghc-toolchain: set CC LD plat. dependent flags A lot to be said about this approach, we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? - - - - - e498cb2b by Rodrigo Mesquita at 2023-06-26T15:52:45+01:00 Configure -Wl,--no-as-needed - - - - - 127a083b by Rodrigo Mesquita at 2023-06-26T15:52:45+01:00 ghc-toolchain: Create default.target in the bindist - - - - - 3dd4ddf4 by Rodrigo Mesquita at 2023-06-26T15:52:45+01:00 Part of -Wl,--no-as-needed saga - - - - - aa18d4a4 by Rodrigo Mesquita at 2023-06-26T15:52:45+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - 549acef6 by Rodrigo Mesquita at 2023-06-26T15:52:45+01:00 Use ghc-platform instead of ghc-boot del async dep - - - - - 30 changed files: - configure.ac - + default.target.in - distrib/configure.ac.in - ghc/Main.hs - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/hadrian.cabal - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Default.hs - hadrian/stack.yaml - libraries/ghc-boot/ghc-boot.cabal.in - + libraries/ghc-platform/CHANGELOG.md - + libraries/ghc-platform/LICENSE - + libraries/ghc-platform/ghc-platform.cabal - libraries/ghc-boot/GHC/Platform/ArchOS.hs → libraries/ghc-platform/src/GHC/Platform/ArchOS.hs - + m4/check_for_gold_t22266.m4 - + m4/check_ld_copy_bug.m4 - + m4/find_ld.m4 - m4/fp_cpp_cmd_with_args.m4 - + m4/fp_find_nm.m4 - + m4/fp_gcc_supports_no_pie.m4 - + m4/fp_gcc_supports_via_c_flags.m4 - + m4/fp_gcc_version.m4 - m4/fp_hs_cpp_cmd_with_args.m4 - + m4/fp_link_supports_no_as_needed.m4 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5e3cabd7f53d99ef25464bf0e5280b2f418be81b...549acef6786090dc81ece120d2e0a4c52df2980d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5e3cabd7f53d99ef25464bf0e5280b2f418be81b...549acef6786090dc81ece120d2e0a4c52df2980d You're receiving 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 Jun 26 14:58:36 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 10:58:36 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/romes/remove-toolchain-runtime-config Message-ID: <6499a79c3d13_64cc0c7740341755@gitlab.mail> Rodrigo Mesquita pushed new branch wip/romes/remove-toolchain-runtime-config at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/remove-toolchain-runtime-config You're receiving 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 Jun 26 15:00:07 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 11:00:07 -0400 Subject: [Git][ghc/ghc][wip/romes/remove-toolchain-runtime-config] Configure -Wl,--no-as-needed Message-ID: <6499a7f7d94fa_64cc0c75103419d2@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/remove-toolchain-runtime-config at Glasgow Haskell Compiler / GHC Commits: 53ea4e07 by Rodrigo Mesquita at 2023-06-26T15:59:51+01:00 Configure -Wl,--no-as-needed To fixup, but this is one of the things we must now configure instead of determine at runtime Be sure to enumerate those in a bullet list - - - - - 2 changed files: - + m4/fp_link_supports_no_as_needed.m4 - m4/fptools_set_c_ld_flags.m4 Changes: ===================================== m4/fp_link_supports_no_as_needed.m4 ===================================== @@ -0,0 +1,33 @@ +# FP_LINK_SUPPORTS_NO_AS_NEEDED +# ---------------------------------- +# Set the Cc linker flag -Wl,--no-as-needed if it is supported +# $1 is the name of the linker flags variable when linking with gcc +# See also Note [ELF needed shared libs] +AC_DEFUN([FP_LINK_SUPPORTS_NO_AS_NEEDED], +[ + AC_MSG_CHECKING([whether Cc linker supports -Wl,--no-as-needed]) + echo 'int f(int a) {return 2*a;}' > conftest.a.c + echo 'int f(int a); int main(int argc, char **argv) {return f(0);}' > conftest.b.c + $CC -o conftest.a.o conftest.a.c + $CC -o conftest.b.o conftest.b.c + if "$CC" "$$1" -Wl,--no-as-needed -o conftest conftest.a.o conftest.b.o > /dev/null 2>&1 + then + $1="$$1 -Wl,--no-as-needed" + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + fi + rm -f conftest* +]) + +# Note [ELF needed shared libs] +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# Some distributions change the link editor's default handling of +# ELF DT_NEEDED tags to include only those shared objects that are +# needed to resolve undefined symbols. For Template Haskell we need +# the last temporary shared library also if it is not needed for the +# currently linked temporary shared library. We specify --no-as-needed +# to override the default. This flag exists in GNU ld and GNU gold. +# +# The flag is only needed on ELF systems. On Windows (PE) and Mac OS X +# (Mach-O) the flag is not needed. ===================================== m4/fptools_set_c_ld_flags.m4 ===================================== @@ -17,6 +17,13 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS], ;; esac + # See Note [ELF needed shared libs] + case $$1 in + *-linux|*-freebsd*) + FP_LINK_SUPPORTS_NO_AS_NEEDED([$3]) + ;; + esac + case $$1 in i386-unknown-mingw32) $2="$$2 -march=i686" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/53ea4e07001bb6cc99c7360d91f05e07484b448b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/53ea4e07001bb6cc99c7360d91f05e07484b448b You're receiving 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 Jun 26 15:10:04 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 11:10:04 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 11 commits: ghc-toolchain: Toolchain Selection Message-ID: <6499aa4c5395d_64cc01a90cc60352735@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: f821633f by Rodrigo Mesquita at 2023-06-26T16:09:54+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b480f4ab1514ac0a4fc957db199d1a0279. Revert get_arm_isa deletion from 74f03f243d08aa910d39cdd9dadb976e9386283a As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples - - - - - 1de619ef by Rodrigo Mesquita at 2023-06-26T16:09:54+01:00 configure: Revert ripping out of toolchain selection logic - - - - - d17ac0aa by Rodrigo Mesquita at 2023-06-26T16:09:54+01:00 Stop configuring into settings unused Ld command - - - - - 09c7d0ef by Rodrigo Mesquita at 2023-06-26T16:09:54+01:00 configure: Create and validate toolchain target file - - - - - 233c645b by Rodrigo Mesquita at 2023-06-26T16:09:54+01:00 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now - - - - - 6a68f9a8 by Rodrigo Mesquita at 2023-06-26T16:09:54+01:00 ghc-toolchain: set CC LD plat. dependent flags A lot to be said about this approach, we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? - - - - - 0df38739 by Rodrigo Mesquita at 2023-06-26T16:09:54+01:00 Configure -Wl,--no-as-needed - - - - - 10b06921 by Rodrigo Mesquita at 2023-06-26T16:09:54+01:00 ghc-toolchain: Create default.target in the bindist - - - - - cf622838 by Rodrigo Mesquita at 2023-06-26T16:09:54+01:00 Part of -Wl,--no-as-needed saga - - - - - e098938a by Rodrigo Mesquita at 2023-06-26T16:09:54+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - 3a14eb3b by Rodrigo Mesquita at 2023-06-26T16:09:54+01:00 Use ghc-platform instead of ghc-boot del async dep - - - - - 30 changed files: - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/SysTools.hs - compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - + default.target.in - distrib/configure.ac.in - ghc/Main.hs - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Test.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/549acef6786090dc81ece120d2e0a4c52df2980d...3a14eb3bfc99f0f2d43e0f3cd8830dab14013bd4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/549acef6786090dc81ece120d2e0a4c52df2980d...3a14eb3bfc99f0f2d43e0f3cd8830dab14013bd4 You're receiving 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 Jun 26 15:16:03 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Mon, 26 Jun 2023 11:16:03 -0400 Subject: [Git][ghc/ghc][wip/match-datatype] Update Match Datatype Message-ID: <6499abb34197f_64cc01a53a6a03560c3@gitlab.mail> David pushed to branch wip/match-datatype at Glasgow Haskell Compiler / GHC Commits: 24e374e6 by David Knothe at 2023-06-26T17:15:47+02:00 Update Match Datatype - - - - - 6 changed files: - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Utils.hs Changes: ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -207,9 +207,7 @@ dsUnliftedBind (PatBind { pat_lhs = pat, pat_rhs = grhss do { match_nablas <- pmcGRHSs PatBindGuards grhss ; rhs <- dsGuarded grhss ty match_nablas ; let upat = unLoc pat - eqn = EqnInfo { eqn_pats = [upat], - eqn_orig = FromSource, - eqn_rhs = cantFailMatchResult body } + eqn = EqnMatch upat FromSource (EqnDone $ cantFailMatchResult body) ; var <- selectMatchVar ManyTy upat -- `var` will end up in a let binder, so the multiplicity -- doesn't matter. ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -27,7 +27,6 @@ import GHC.Platform import Language.Haskell.Syntax.Basic (Boxity(..)) import {-#SOURCE#-} GHC.HsToCore.Expr (dsExpr) - import GHC.Types.Basic ( Origin(..), isGenerated ) import GHC.Types.SourceText import GHC.Driver.DynFlags @@ -192,11 +191,7 @@ match :: [MatchId] -- ^ Variables rep\'ing the exprs we\'re matching with match [] ty eqns = assertPpr (not (null eqns)) (ppr ty) $ - return (foldr1 combineMatchResults match_results) - where - match_results = [ assert (null (eqn_pats eqn)) $ - eqn_rhs eqn - | eqn <- eqns ] + combineRHSs (NEL.fromList eqns) match (v:vs) ty eqns -- Eqns *can* be empty = assertPpr (all (isInternalName . idName) vars) (ppr vars) $ @@ -239,6 +234,7 @@ match (v:vs) ty eqns -- Eqns *can* be empty PgBang -> matchBangs vars ty (dropGroup eqns) PgCo {} -> matchCoercion vars ty (dropGroup eqns) PgView {} -> matchView vars ty (dropGroup eqns) + PgDistinct-> combineRHSs (dropGroup eqns) where eqns' = NEL.toList eqns ne l = case NEL.nonEmpty l of Just nel -> nel @@ -309,8 +305,7 @@ matchView (var :| vars) ty (eqns@(eqn1 :| _)) -- decompose the first pattern and leave the rest alone decomposeFirstPat :: (Pat GhcTc -> Pat GhcTc) -> EquationInfo -> EquationInfo -decomposeFirstPat extractpat (eqn@(EqnInfo { eqn_pats = pat : pats })) - = eqn { eqn_pats = extractpat pat : pats} +decomposeFirstPat extract (EqnMatch pat orig rest) = EqnMatch (extract pat) orig rest decomposeFirstPat _ _ = panic "decomposeFirstPat" getCoPat, getBangPat, getViewPat :: Pat GhcTc -> Pat GhcTc @@ -404,12 +399,11 @@ tidyEqnInfo :: Id -> EquationInfo -- POST CONDITION: head pattern in the EqnInfo is -- one of these for which patGroup is defined. -tidyEqnInfo _ (EqnInfo { eqn_pats = [] }) - = panic "tidyEqnInfo" +tidyEqnInfo _ (EqnDone r) = return (idDsWrapper, EqnDone r) -tidyEqnInfo v eqn@(EqnInfo { eqn_pats = pat : pats, eqn_orig = orig }) - = do { (wrap, pat') <- tidy1 v orig pat - ; return (wrap, eqn { eqn_pats = pat' : pats }) } +tidyEqnInfo v (EqnMatch pat orig rest) = do + (wrap, pat') <- tidy1 v orig pat + return (wrap, EqnMatch pat' orig rest) tidy1 :: Id -- The Id being scrutinised -> Origin -- Was this a pattern the user wrote? @@ -814,9 +808,7 @@ matchWrapper ctxt scrs (MG { mg_alts = L _ matches -- from that knowledge (#18533) ; match_result <- updPmNablas pat_nablas $ dsGRHSs ctxt grhss rhs_ty rhss_nablas - ; return EqnInfo { eqn_pats = upats - , eqn_orig = FromSource - , eqn_rhs = match_result } } + ; return $ mkEqnInfo upats FromSource match_result } discard_warnings_if_generated orig = if isGenerated orig @@ -953,9 +945,9 @@ matchSinglePatVar var mb_scrut ctx pat ty match_result addCoreScrutTmCs (maybeToList mb_scrut) [var] $ pmcPatBind (DsMatchContext ctx locn) var (unLoc pat) - ; let eqn_info = EqnInfo { eqn_pats = [unLoc (decideBangHood dflags pat)] - , eqn_orig = FromSource - , eqn_rhs = match_result } + ; let eqn_info = EqnMatch (unLoc (decideBangHood dflags pat)) + FromSource + (EqnDone match_result) ; match [var] ty [eqn_info] } @@ -983,6 +975,15 @@ data PatGroup | PgView (LHsExpr GhcTc) -- view pattern (e -> p): -- the LHsExpr is the expression e Type -- the Type is the type of p (equivalently, the result type of e) + | PgDistinct -- Group equations which are Done: no further grouping can be done with them + +instance Show PatGroup where + show PgAny = "PgAny" + show (PgCon _) = "PgCon" + show (PgLit _) = "PgLit" + show (PgView _ _) = "PgView" + show PgDistinct = "PgDistinct" + show _ = "PgOther" {- Note [Don't use Literal for PgN] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1100,6 +1101,7 @@ sameGroup (PgCo t1) (PgCo t2) = t1 `eqType` t2 sameGroup (PgView e1 t1) (PgView e2 t2) = viewLExprEq (e1,t1) (e2,t2) -- ViewPats are in the same group iff the expressions -- are "equal"---conservatively, we use syntactic equality +sameGroup PgDistinct PgDistinct = True sameGroup _ _ = False -- An approximation of syntactic equality used for determining when view @@ -1226,15 +1228,19 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2 eq_list _ (_:_) [] = False eq_list eq (x:xs) (y:ys) = eq x y && eq_list eq xs ys -patGroup :: Platform -> Pat GhcTc -> PatGroup -patGroup _ (ConPat { pat_con = L _ con +patGroup :: Platform -> Maybe (Pat GhcTc) -> PatGroup +patGroup _ Nothing = PgDistinct +patGroup p (Just pat) = patGroup' p pat + +patGroup' :: Platform -> Pat GhcTc -> PatGroup +patGroup' _ (ConPat { pat_con = L _ con , pat_con_ext = ConPatTc { cpt_arg_tys = tys } }) - | RealDataCon dcon <- con = PgCon dcon - | PatSynCon psyn <- con = PgSyn psyn tys -patGroup _ (WildPat {}) = PgAny -patGroup _ (BangPat {}) = PgBang -patGroup _ (NPat _ (L _ (OverLit {ol_val=oval})) mb_neg _) = + | RealDataCon dcon <- con = PgCon dcon + | PatSynCon psyn <- con = PgSyn psyn tys +patGroup' _ (WildPat {}) = PgAny +patGroup' _ (BangPat {}) = PgBang +patGroup' _ (NPat _ (L _ (OverLit {ol_val=oval})) mb_neg _) = case (oval, isJust mb_neg) of (HsIntegral i, is_neg) -> PgN (integralFractionalLit is_neg (if is_neg then negate (il_value i) @@ -1244,16 +1250,16 @@ patGroup _ (NPat _ (L _ (OverLit {ol_val=oval})) mb_neg _) = | otherwise -> PgN f (HsIsString _ s, _) -> assert (isNothing mb_neg) $ PgOverS s -patGroup _ (NPlusKPat _ _ (L _ (OverLit {ol_val=oval})) _ _ _) = +patGroup' _ (NPlusKPat _ _ (L _ (OverLit {ol_val=oval})) _ _ _) = case oval of HsIntegral i -> PgNpK (il_value i) _ -> pprPanic "patGroup NPlusKPat" (ppr oval) -patGroup _ (ViewPat _ expr p) = PgView expr (hsPatType (unLoc p)) -patGroup platform (LitPat _ lit) = PgLit (hsLitKey platform lit) -patGroup platform (XPat ext) = case ext of +patGroup' _ (ViewPat _ expr p) = PgView expr (hsPatType (unLoc p)) +patGroup' platform (LitPat _ lit) = PgLit (hsLitKey platform lit) +patGroup' platform (XPat ext) = case ext of CoPat _ p _ -> PgCo (hsPatType p) -- Type of innelexp pattern - ExpansionPat _ p -> patGroup platform p -patGroup _ pat = pprPanic "patGroup" (ppr pat) + ExpansionPat _ p -> patGroup' platform p +patGroup' _ pat = pprPanic "patGroup" (ppr pat) {- Note [Grouping overloaded literal patterns] ===================================== compiler/GHC/HsToCore/Match/Constructor.hs ===================================== @@ -153,24 +153,22 @@ matchOneConLike vars ty mult (eqn1 :| eqns) -- All eqns for a single construct ; return $ foldr1 (.) wraps <$> match_result } - shift (_, eqn@(EqnInfo - { eqn_pats = ConPat - { pat_args = args - , pat_con_ext = ConPatTc - { cpt_tvs = tvs - , cpt_dicts = ds - , cpt_binds = bind - } - } : pats - })) + shift (_, (EqnMatch (ConPat + { pat_args = args + , pat_con_ext = ConPatTc + { cpt_tvs = tvs + , cpt_dicts = ds + , cpt_binds = bind + }}) + _ rest + )) = do dsTcEvBinds bind $ \ds_bind -> return ( wrapBinds (tvs `zip` tvs1) . wrapBinds (ds `zip` dicts1) . mkCoreLets ds_bind - , eqn { eqn_orig = Generated - , eqn_pats = conArgPats val_arg_tys args ++ pats } + , mkEqnInfo (conArgPats val_arg_tys args ++ eqn_pats rest) Generated (eqn_rhs rest) ) - shift (_, (EqnInfo { eqn_pats = ps })) = pprPanic "matchOneCon/shift" (ppr ps) + shift (_, eqn) = pprPanic "matchOneCon/shift" (ppr eqn) ; let scaled_arg_tys = map (scaleScaled mult) val_arg_tys -- The 'val_arg_tys' are taken from the data type definition, they -- do not take into account the context multiplicity, therefore we ===================================== compiler/GHC/HsToCore/Match/Literal.hs ===================================== @@ -625,10 +625,10 @@ matchLiterals (var :| vars) ty sub_groups } where match_group :: NonEmpty EquationInfo -> DsM (Literal, MatchResult CoreExpr) - match_group eqns@(firstEqn :| _) + match_group eqns = do { dflags <- getDynFlags ; let platform = targetPlatform dflags - ; let LitPat _ hs_lit = firstPat firstEqn + ; let (EqnMatch (LitPat _ hs_lit) _ _) = NEL.head eqns ; match_result <- match vars ty (NEL.toList $ shiftEqns eqns) ; return (hsLitKey platform hs_lit, match_result) } @@ -726,7 +726,7 @@ matchNPlusKPats (var :| vars) ty (eqn1 :| eqns) fmap (foldr1 (.) wraps) $ match_result) } where - shift n1 eqn@(EqnInfo { eqn_pats = NPlusKPat _ (L _ n) _ _ _ _ : pats }) - = (wrapBind n n1, eqn { eqn_pats = pats }) + shift n1 (EqnMatch (NPlusKPat _ (L _ n) _ _ _ _) _ rest) + = (wrapBind n n1, rest) -- The wrapBind is a no-op for the first equation shift _ e = pprPanic "matchNPlusKPats/shift" (ppr e) ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -48,7 +48,8 @@ module GHC.HsToCore.Monad ( -- Data types DsMatchContext(..), - EquationInfo(..), MatchResult (..), runMatchResult, DsWrapper, idDsWrapper, + EquationInfo(..), mkEqnInfo, eqn_rhs, eqn_pats, + MatchResult (..), runMatchResult, DsWrapper, idDsWrapper, -- Trace injection pprRuntimeTrace @@ -131,14 +132,15 @@ instance Outputable DsMatchContext where ppr (DsMatchContext hs_match ss) = ppr ss <+> pprMatchContext hs_match data EquationInfo - = EqnInfo { eqn_pats :: [Pat GhcTc] - -- ^ The patterns for an equation - -- - -- NB: We have /already/ applied 'decideBangHood' to - -- these patterns. See Note [decideBangHood] in "GHC.HsToCore.Utils" - - , eqn_orig :: Origin - -- ^ Was this equation present in the user source? + = EqnMatch + (Pat GhcTc) + -- ^ The first pattern of the equation + -- + -- NB: We have /already/ applied 'decideBangHood' to + -- this pattern. See Note [decideBangHood] in "GHC.HsToCore.Utils" + + Origin + -- ^ Was this equation present in the user source? -- -- This helps us avoid warnings on patterns that GHC elaborated. -- @@ -146,12 +148,26 @@ data EquationInfo -- @W# -1## :: Word@, but we shouldn't warn about an overflowed -- literal for /both/ of these cases. - , eqn_rhs :: MatchResult CoreExpr - -- ^ What to do after match - } + EquationInfo + -- ^ The rest of the equation after its first pattern + + | EqnDone -- An empty equation which has no patterns + (MatchResult CoreExpr) + -- ^ What to do after match + +mkEqnInfo :: [Pat GhcTc] -> Origin -> MatchResult CoreExpr -> EquationInfo +mkEqnInfo [] _ rhs = EqnDone rhs +mkEqnInfo (pat:pats) orig rhs = EqnMatch pat orig (mkEqnInfo pats orig rhs) + +eqn_pats :: EquationInfo -> [Pat GhcTc] +eqn_pats (EqnDone _) = [] +eqn_pats (EqnMatch pat _ rest) = pat : eqn_pats rest +eqn_rhs :: EquationInfo -> MatchResult CoreExpr +eqn_rhs (EqnDone rhs) = rhs +eqn_rhs (EqnMatch _ _ rest) = eqn_rhs rest instance Outputable EquationInfo where - ppr (EqnInfo pats _ _) = ppr pats + ppr = ppr . eqn_pats type DsWrapper = CoreExpr -> CoreExpr idDsWrapper :: DsWrapper ===================================== compiler/GHC/HsToCore/Utils.hs ===================================== @@ -15,7 +15,7 @@ This module exports some utility functions of no great interest. -- | Utility functions for constructing Core syntax, principally for desugaring module GHC.HsToCore.Utils ( EquationInfo(..), - firstPat, shiftEqns, + firstPat, maybeFirstPat, shiftEqns, combineRHSs, MatchResult (..), CaseAlt(..), cantFailMatchResult, alwaysFailMatchResult, @@ -195,11 +195,20 @@ worthy of a type synonym and a few handy functions. -} firstPat :: EquationInfo -> Pat GhcTc -firstPat eqn = assert (notNull (eqn_pats eqn)) $ head (eqn_pats eqn) +firstPat (EqnMatch pat _ _) = pat +firstPat (EqnDone _) = error "firstPat: no patterns" + +maybeFirstPat :: EquationInfo -> Maybe (Pat GhcTc) +maybeFirstPat (EqnMatch pat _ _) = Just pat +maybeFirstPat (EqnDone _) = Nothing shiftEqns :: Functor f => f EquationInfo -> f EquationInfo -- Drop the first pattern in each equation -shiftEqns = fmap $ \eqn -> eqn { eqn_pats = tail (eqn_pats eqn) } +shiftEqns = fmap $ \case (EqnMatch _ _ rest) -> rest + (EqnDone _) -> error "shiftEqn: no patterns" + +combineRHSs :: NonEmpty EquationInfo -> DsM (MatchResult CoreExpr) +combineRHSs eqns = return $ foldr1 combineMatchResults $ map eqn_rhs (NEL.toList eqns) -- Functions on MatchResult CoreExprs View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/24e374e658acbb80d6b4c70f3efb9f3cdb6ea269 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/24e374e658acbb80d6b4c70f3efb9f3cdb6ea269 You're receiving 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 Jun 26 15:25:13 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Mon, 26 Jun 2023 11:25:13 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/or-pats-amendment Message-ID: <6499add9bf61a_64cc0c77403580c8@gitlab.mail> David deleted branch wip/or-pats-amendment 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 Mon Jun 26 15:27:48 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 11:27:48 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Fixes Message-ID: <6499ae743f6ad_64cc01a90cc60358266@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: b382f2a8 by Rodrigo Mesquita at 2023-06-26T16:27:41+01:00 Fixes - - - - - 1 changed file: - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs Changes: ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -185,14 +185,7 @@ checkLinkWorks cc ccLink = withTempDir $ \dir -> do checkLinkIsGnu :: Program -> M Bool checkLinkIsGnu ccLink = do -<<<<<<< HEAD out <- readProgramStdout ccLink ["-Wl,--version"] -||||||| parent of 4a31527a36e (ghc-toolchain: set CC LD plat. dependent flags) - out <- readProgramStdout ccLink ["--version"] -======= - -- ROMES:TODO: Possibly try all these with -Wl,... - out <- readProgramStdout ccLink ["--version"] ->>>>>>> 4a31527a36e (ghc-toolchain: set CC LD plat. dependent flags) return ("GNU" `isInfixOf` out) -- | Check for binutils bug #16177 present in some versions of the bfd ld View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b382f2a82b240fed1cfb120de1d86198a8841edf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b382f2a82b240fed1cfb120de1d86198a8841edf You're receiving 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 Jun 26 15:49:10 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 11:49:10 -0400 Subject: [Git][ghc/ghc][wip/romes/remove-toolchain-runtime-config] 4 commits: Rip out runtime linker/compiler checks Message-ID: <6499b3768cd86_64cc0c75d8366953@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/remove-toolchain-runtime-config at Glasgow Haskell Compiler / GHC Commits: 9058db6a by Ben Gamari at 2023-06-26T16:11:20+01:00 Rip out runtime linker/compiler checks - - - - - 36868983 by Rodrigo Mesquita at 2023-06-26T16:48:13+01:00 Drop Note [Run-time linker info] and SysTools.Info Ultimately, this represents our change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions at configure time. The end goal is to be able to configure multiple toolchains in a single place (to then choose among them with a runtime-retargetable GHC) For now that single place where configuration happens is autoconf, but soon it will be the standalone ghc-toolchain program (see !9263) * The flag -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) - - - - - 88b89bbe by Rodrigo Mesquita at 2023-06-26T16:48:57+01:00 Configure -Wl,--no-as-needed To fixup, but this is one of the things we must now configure instead of determine at runtime Be sure to enumerate those in a bullet list - - - - - ea1e4994 by Rodrigo Mesquita at 2023-06-26T16:48:57+01:00 fstackcheck - - - - - 11 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/SysTools.hs - − compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - compiler/ghc.cabal.in - + m4/fp_link_supports_no_as_needed.m4 - m4/fptools_set_c_ld_flags.m4 Changes: ===================================== compiler/GHC/Driver/Backend.hs ===================================== @@ -58,8 +58,6 @@ module GHC.Driver.Backend , DefunctionalizedCodeOutput(..) -- *** Back-end functions for assembly , DefunctionalizedPostHscPipeline(..) - , DefunctionalizedAssemblerProg(..) - , DefunctionalizedAssemblerInfoGetter(..) -- *** Other back-end functions , DefunctionalizedCDefs(..) -- ** Names of back ends (for API clients of version 9.4 or earlier) @@ -94,8 +92,6 @@ module GHC.Driver.Backend , backendSupportsHpc , backendSupportsCImport , backendSupportsCExport - , backendAssemblerProg - , backendAssemblerInfoGetter , backendCDefs , backendCodeOutput , backendUseJSLinker @@ -348,40 +344,6 @@ data PrimitiveImplementation deriving Show --- | Names a function that runs the assembler, of this type: --- --- > Logger -> DynFlags -> Platform -> [Option] -> IO () --- --- The functions so named are defined in "GHC.Driver.Pipeline.Execute". - -data DefunctionalizedAssemblerProg - = StandardAssemblerProg - -- ^ Use the standard system assembler - | JSAssemblerProg - -- ^ JS Backend compile to JS via Stg, and so does not use any assembler - | DarwinClangAssemblerProg - -- ^ If running on Darwin, use the assembler from the @clang@ - -- toolchain. Otherwise use the standard system assembler. - - - --- | Names a function that discover from what toolchain the assembler --- is coming, of this type: --- --- > Logger -> DynFlags -> Platform -> IO CompilerInfo --- --- The functions so named are defined in "GHC.Driver.Pipeline.Execute". - -data DefunctionalizedAssemblerInfoGetter - = StandardAssemblerInfoGetter - -- ^ Interrogate the standard system assembler - | JSAssemblerInfoGetter - -- ^ If using the JS backend; return 'Emscripten' - | DarwinClangAssemblerInfoGetter - -- ^ If running on Darwin, return `Clang`; otherwise - -- interrogate the standard system assembler. - - -- | Names a function that generates code and writes the results to a -- file, of this type: -- @@ -770,45 +732,6 @@ backendSupportsCExport (Named JavaScript) = True backendSupportsCExport (Named Interpreter) = False backendSupportsCExport (Named NoBackend) = True --- | This (defunctionalized) function runs the assembler --- used on the code that is written by this back end. A --- program determined by a combination of back end, --- `DynFlags`, and `Platform` is run with the given --- `Option`s. --- --- The function's type is --- @ --- Logger -> DynFlags -> Platform -> [Option] -> IO () --- @ --- --- This field is usually defaulted. -backendAssemblerProg :: Backend -> DefunctionalizedAssemblerProg -backendAssemblerProg (Named NCG) = StandardAssemblerProg -backendAssemblerProg (Named LLVM) = DarwinClangAssemblerProg -backendAssemblerProg (Named ViaC) = StandardAssemblerProg -backendAssemblerProg (Named JavaScript) = JSAssemblerProg -backendAssemblerProg (Named Interpreter) = StandardAssemblerProg -backendAssemblerProg (Named NoBackend) = StandardAssemblerProg - --- | This (defunctionalized) function is used to retrieve --- an enumeration value that characterizes the C/assembler --- part of a toolchain. The function caches the info in a --- mutable variable that is part of the `DynFlags`. --- --- The function's type is --- @ --- Logger -> DynFlags -> Platform -> IO CompilerInfo --- @ --- --- This field is usually defaulted. -backendAssemblerInfoGetter :: Backend -> DefunctionalizedAssemblerInfoGetter -backendAssemblerInfoGetter (Named NCG) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named LLVM) = DarwinClangAssemblerInfoGetter -backendAssemblerInfoGetter (Named ViaC) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named JavaScript) = JSAssemblerInfoGetter -backendAssemblerInfoGetter (Named Interpreter) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named NoBackend) = StandardAssemblerInfoGetter - -- | When using this back end, it may be necessary or -- advisable to pass some `-D` options to a C compiler. -- This (defunctionalized) function produces those ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -420,15 +420,6 @@ data DynFlags = DynFlags { avx512pf :: Bool, -- Enable AVX-512 PreFetch Instructions. fma :: Bool, -- ^ Enable FMA instructions. - -- | Run-time linker information (what options we need, etc.) - rtldInfo :: IORef (Maybe LinkerInfo), - - -- | Run-time C compiler information - rtccInfo :: IORef (Maybe CompilerInfo), - - -- | Run-time assembler information - rtasmInfo :: IORef (Maybe CompilerInfo), - -- Constants used to control the amount of optimization done. -- | Max size, in bytes, of inline array allocations. @@ -490,9 +481,6 @@ class ContainsDynFlags t where initDynFlags :: DynFlags -> IO DynFlags initDynFlags dflags = do let - refRtldInfo <- newIORef Nothing - refRtccInfo <- newIORef Nothing - refRtasmInfo <- newIORef Nothing canUseUnicode <- do let enc = localeEncoding str = "‘’" (withCString enc str $ \cstr -> @@ -514,9 +502,6 @@ initDynFlags dflags = do useColor = useColor', canUseColor = stderrSupportsAnsiColors, colScheme = colScheme', - rtldInfo = refRtldInfo, - rtccInfo = refRtccInfo, - rtasmInfo = refRtasmInfo, tmpDir = TempDir tmp_dir } @@ -695,9 +680,6 @@ defaultDynFlags mySettings = avx512f = False, avx512pf = False, fma = False, - rtldInfo = panic "defaultDynFlags: no rtldInfo", - rtccInfo = panic "defaultDynFlags: no rtccInfo", - rtasmInfo = panic "defaultDynFlags: no rtasmInfo", maxInlineAllocSize = 128, maxInlineMemcpyInsns = 32, ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -336,41 +336,11 @@ initHscEnv mb_top_dir = do mySettings <- initSysTools top_dir dflags <- initDynFlags (defaultDynFlags mySettings) hsc_env <- newHscEnv top_dir dflags - checkBrokenTablesNextToCode (hsc_logger hsc_env) dflags setUnsafeGlobalDynFlags dflags -- c.f. DynFlags.parseDynamicFlagsFull, which -- creates DynFlags and sets the UnsafeGlobalDynFlags return hsc_env --- | The binutils linker on ARM emits unnecessary R_ARM_COPY relocations which --- breaks tables-next-to-code in dynamically linked modules. This --- check should be more selective but there is currently no released --- version where this bug is fixed. --- See https://sourceware.org/bugzilla/show_bug.cgi?id=16177 and --- https://gitlab.haskell.org/ghc/ghc/issues/4210#note_78333 -checkBrokenTablesNextToCode :: Logger -> DynFlags -> IO () -checkBrokenTablesNextToCode logger dflags = do - let invalidLdErr = "Tables-next-to-code not supported on ARM \ - \when using binutils ld (please see: \ - \https://sourceware.org/bugzilla/show_bug.cgi?id=16177)" - broken <- checkBrokenTablesNextToCode' logger dflags - when broken (panic invalidLdErr) - -checkBrokenTablesNextToCode' :: Logger -> DynFlags -> IO Bool -checkBrokenTablesNextToCode' logger dflags - | not (isARM arch) = return False - | ways dflags `hasNotWay` WayDyn = return False - | not tablesNextToCode = return False - | otherwise = do - linkerInfo <- liftIO $ GHC.SysTools.getLinkerInfo logger dflags - case linkerInfo of - GnuLD _ -> return True - _ -> return False - where platform = targetPlatform dflags - arch = platformArch platform - tablesNextToCode = platformTablesNextToCode platform - - -- ----------------------------------------------------------------------------- getDiagnostics :: Hsc (Messages GhcMessage) ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -290,10 +290,6 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do let unit_env = hsc_unit_env hsc_env let platform = ue_platform unit_env - -- LLVM from version 3.0 onwards doesn't support the OS X system - -- assembler, so we use clang as the assembler instead. (#5636) - let as_prog = applyAssemblerProg $ backendAssemblerProg (backend dflags) - let cmdline_include_paths = includePaths dflags let pic_c_flags = picCCOpts dflags @@ -310,7 +306,7 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do includePathsQuoteImplicit cmdline_include_paths] let runAssembler inputFilename outputFilename = withAtomicRename outputFilename $ \temp_outputFilename -> - as_prog + runAs logger dflags platform (local_includes ++ global_includes @@ -392,22 +388,6 @@ runForeignJsPhase pipe_env hsc_env _location input_fn = do embedJsFile logger dflags tmpfs unit_env input_fn output_fn return output_fn - -applyAssemblerProg - :: DefunctionalizedAssemblerProg - -> Logger -> DynFlags -> Platform -> [Option] -> IO () -applyAssemblerProg StandardAssemblerProg logger dflags _platform = - runAs logger dflags -applyAssemblerProg JSAssemblerProg logger dflags _platform = - runEmscripten logger dflags -applyAssemblerProg DarwinClangAssemblerProg logger dflags platform = - if platformOS platform == OSDarwin then - runClang logger dflags - else - runAs logger dflags - - - runCcPhase :: Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO FilePath runCcPhase cc_phase pipe_env hsc_env location input_fn = do let dflags = hsc_dflags hsc_env ===================================== compiler/GHC/Linker/ExtraObj.hs ===================================== @@ -12,7 +12,6 @@ module GHC.Linker.ExtraObj , mkNoteObjsToLinkIntoBinary , checkLinkInfo , getLinkInfo - , getCompilerInfo , ghcLinkInfoSectionName , ghcLinkInfoNoteName , platformSupportsSavingLinkOpts @@ -40,7 +39,6 @@ import qualified GHC.Data.ShortText as ST import GHC.SysTools.Elf import GHC.SysTools.Tasks -import GHC.SysTools.Info import GHC.Linker.Unit import Control.Monad.IO.Class @@ -52,7 +50,6 @@ mkExtraObj logger tmpfs dflags unit_state extn xs = do cFile <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule extn oFile <- newTempName logger tmpfs (tmpDir dflags) TFL_GhcSession "o" writeFile cFile xs - ccInfo <- liftIO $ getCompilerInfo logger dflags runCc Nothing logger tmpfs dflags ([Option "-c", FileOption "" cFile, @@ -60,7 +57,7 @@ mkExtraObj logger tmpfs dflags unit_state extn xs FileOption "" oFile] ++ if extn /= "s" then cOpts - else asmOpts ccInfo) + else []) return oFile where -- Pass a different set of options to the C compiler depending one whether @@ -70,14 +67,6 @@ mkExtraObj logger tmpfs dflags unit_state extn xs ++ map (FileOption "-I" . ST.unpack) (unitIncludeDirs $ unsafeLookupUnit unit_state rtsUnit) - -- When compiling assembler code, we drop the usual C options, and if the - -- compiler is Clang, we add an extra argument to tell Clang to ignore - -- unused command line options. See trac #11684. - asmOpts ccInfo = - if any (ccInfo ==) [Clang, AppleClang, AppleClang51] - then [Option "-Qunused-arguments"] - else [] - -- When linking a binary, we need to create a C main() function that -- starts everything off. This used to be compiled statically as part -- of the RTS, but that made it hard to change the -rtsopts setting, ===================================== compiler/GHC/SysTools.hs ===================================== @@ -17,7 +17,6 @@ module GHC.SysTools ( -- * Interface to system tools module GHC.SysTools.Tasks, - module GHC.SysTools.Info, -- * Fast file copy copyFile, @@ -36,7 +35,6 @@ import GHC.Utils.Panic import GHC.Driver.Session import GHC.Linker.ExtraObj -import GHC.SysTools.Info import GHC.SysTools.Tasks import GHC.SysTools.BaseDir import GHC.Settings.IO ===================================== compiler/GHC/SysTools/Info.hs deleted ===================================== @@ -1,243 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} ------------------------------------------------------------------------------ --- --- Compiler information functions --- --- (c) The GHC Team 2017 --- ------------------------------------------------------------------------------ -module GHC.SysTools.Info where - -import GHC.Utils.Exception -import GHC.Utils.Error -import GHC.Driver.Session -import GHC.Utils.Outputable -import GHC.Utils.Misc -import GHC.Utils.Logger - -import Data.List ( isInfixOf, isPrefixOf ) -import Data.IORef - -import System.IO - -import GHC.Platform -import GHC.Prelude - -import GHC.SysTools.Process - -{- Note [Run-time linker info] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~ -See also: #5240, #6063, #10110 - -Before 'runLink', we need to be sure to get the relevant information -about the linker we're using at runtime to see if we need any extra -options. - -Generally, the linker changing from what was detected at ./configure -time has always been possible using -pgml, but on Linux it can happen -'transparently' by installing packages like binutils-gold, which -change what /usr/bin/ld actually points to. - -Clang vs GCC notes: - -For gcc, 'gcc -Wl,--version' gives a bunch of output about how to -invoke the linker before the version information string. For 'clang', -the version information for 'ld' is all that's output. For this -reason, we typically need to slurp up all of the standard error output -and look through it. - -Other notes: - -We cache the LinkerInfo inside DynFlags, since clients may link -multiple times. The definition of LinkerInfo is there to avoid a -circular dependency. - --} - -{- Note [ELF needed shared libs] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Some distributions change the link editor's default handling of -ELF DT_NEEDED tags to include only those shared objects that are -needed to resolve undefined symbols. For Template Haskell we need -the last temporary shared library also if it is not needed for the -currently linked temporary shared library. We specify --no-as-needed -to override the default. This flag exists in GNU ld and GNU gold. - -The flag is only needed on ELF systems. On Windows (PE) and Mac OS X -(Mach-O) the flag is not needed. - --} - -neededLinkArgs :: LinkerInfo -> [Option] -neededLinkArgs (GnuLD o) = o -neededLinkArgs (Mold o) = o -neededLinkArgs (GnuGold o) = o -neededLinkArgs (LlvmLLD o) = o -neededLinkArgs (DarwinLD o) = o -neededLinkArgs (SolarisLD o) = o -neededLinkArgs (AixLD o) = o -neededLinkArgs UnknownLD = [] - --- Grab linker info and cache it in DynFlags. -getLinkerInfo :: Logger -> DynFlags -> IO LinkerInfo -getLinkerInfo logger dflags = do - info <- readIORef (rtldInfo dflags) - case info of - Just v -> return v - Nothing -> do - v <- getLinkerInfo' logger dflags - writeIORef (rtldInfo dflags) (Just v) - return v - --- See Note [Run-time linker info]. -getLinkerInfo' :: Logger -> DynFlags -> IO LinkerInfo -getLinkerInfo' logger dflags = do - let platform = targetPlatform dflags - os = platformOS platform - (pgm,args0) = pgm_l dflags - args1 = map Option (getOpts dflags opt_l) - args2 = args0 ++ args1 - args3 = filter notNull (map showOpt args2) - - -- Try to grab the info from the process output. - parseLinkerInfo stdo _stde _exitc - | any ("GNU ld" `isPrefixOf`) stdo = - -- Set DT_NEEDED for all shared libraries. #10110. - return (GnuLD $ map Option [-- ELF specific flag - -- 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] - return (GnuGold [Option "-Wl,--no-as-needed"]) - - | any (\line -> "LLD" `isPrefixOf` line || "LLD" `elem` words line) stdo = - return (LlvmLLD $ map Option [ --see Note [ELF needed shared libs] - "-Wl,--no-as-needed" | osElfTarget os || os == OSMinGW32 ]) - - -- Unknown linker. - | otherwise = fail "invalid --version output, or linker is unsupported" - - -- Process the executable call - catchIO ( - case os of - OSSolaris2 -> - -- Solaris uses its own Solaris linker. Even all - -- GNU C are recommended to configure with Solaris - -- linker instead of using GNU binutils linker. Also - -- all GCC distributed with Solaris follows this rule - -- precisely so we assume here, the Solaris linker is - -- used. - return $ SolarisLD [] - OSAIX -> - -- IBM AIX uses its own non-binutils linker as well - return $ AixLD [] - OSDarwin -> - -- Darwin has neither GNU Gold or GNU LD, but a strange linker - -- that doesn't support --version. We can just assume that's - -- what we're using. - return $ DarwinLD [] - OSMinGW32 -> - -- GHC doesn't support anything but GNU ld on Windows anyway. - -- Process creation is also fairly expensive on win32, so - -- we short-circuit here. - return $ GnuLD $ map Option - [ -- Emit stack checks - -- See Note [Windows stack allocations] - "-fstack-check" - ] - _ -> do - -- In practice, we use the compiler as the linker here. Pass - -- -Wl,--version to get linker version info. - (exitc, stdo, stde) <- readProcessEnvWithExitCode pgm - (["-Wl,--version"] ++ args3) - c_locale_env - -- Split the output by lines to make certain kinds - -- of processing easier. In particular, 'clang' and 'gcc' - -- have slightly different outputs for '-Wl,--version', but - -- it's still easy to figure out. - parseLinkerInfo (lines stdo) (lines stde) exitc - ) - (\err -> do - debugTraceMsg logger 2 - (text "Error (figuring out linker information):" <+> - text (show err)) - errorMsg logger $ hang (text "Warning:") 9 $ - text "Couldn't figure out linker information!" $$ - text "Make sure you're using GNU ld, GNU gold" <+> - text "or the built in OS X linker, etc." - return UnknownLD - ) - --- | Grab compiler info and cache it in DynFlags. -getCompilerInfo :: Logger -> DynFlags -> IO CompilerInfo -getCompilerInfo logger dflags = do - info <- readIORef (rtccInfo dflags) - case info of - Just v -> return v - Nothing -> do - let pgm = pgm_c dflags - v <- getCompilerInfo' logger pgm - writeIORef (rtccInfo dflags) (Just v) - return v - --- | Grab assembler info and cache it in DynFlags. -getAssemblerInfo :: Logger -> DynFlags -> IO CompilerInfo -getAssemblerInfo logger dflags = do - info <- readIORef (rtasmInfo dflags) - case info of - Just v -> return v - Nothing -> do - let (pgm, _) = pgm_a dflags - v <- getCompilerInfo' logger pgm - writeIORef (rtasmInfo dflags) (Just v) - return v - --- See Note [Run-time linker info]. -getCompilerInfo' :: Logger -> String -> IO CompilerInfo -getCompilerInfo' logger pgm = do - let -- Try to grab the info from the process output. - parseCompilerInfo _stdo stde _exitc - -- Regular GCC - | any ("gcc version" `isInfixOf`) stde = - return GCC - -- Regular clang - | any ("clang version" `isInfixOf`) stde = - return Clang - -- FreeBSD clang - | any ("FreeBSD clang version" `isInfixOf`) stde = - return Clang - -- Xcode 5.1 clang - | any ("Apple LLVM version 5.1" `isPrefixOf`) stde = - return AppleClang51 - -- Xcode 5 clang - | any ("Apple LLVM version" `isPrefixOf`) stde = - return AppleClang - -- Xcode 4.1 clang - | any ("Apple clang version" `isPrefixOf`) stde = - return AppleClang - -- Unknown compiler. - | otherwise = fail $ "invalid -v output, or compiler is unsupported (" ++ pgm ++ "): " ++ unlines stde - - -- Process the executable call - catchIO (do - (exitc, stdo, stde) <- - readProcessEnvWithExitCode pgm ["-v"] c_locale_env - -- Split the output by lines to make certain kinds - -- of processing easier. - parseCompilerInfo (lines stdo) (lines stde) exitc - ) - (\err -> do - debugTraceMsg logger 2 - (text "Error (figuring out C compiler information):" <+> - text (show err)) - errorMsg logger $ hang (text "Warning:") 9 $ - text "Couldn't figure out C compiler information!" $$ - text "Make sure you're using GNU gcc, or clang" - return UnknownCC - ) ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -19,7 +19,6 @@ import GHC.CmmToLlvm.Config (LlvmVersion, llvmVersionStr, supportedLlvmVersionUp import GHC.Settings import GHC.SysTools.Process -import GHC.SysTools.Info import GHC.Driver.Session @@ -278,15 +277,12 @@ figureLlvmVersion logger dflags = traceSystoolCommand logger "llc" $ do runLink :: Logger -> TmpFs -> DynFlags -> [Option] -> IO () runLink logger tmpfs dflags args = traceSystoolCommand logger "linker" $ do - -- See Note [Run-time linker info] - -- -- `-optl` args come at the end, so that later `-l` options -- given there manually can fill in symbols needed by -- Haskell libraries coming in via `args`. - linkargs <- neededLinkArgs `fmap` getLinkerInfo logger dflags let (p,args0) = pgm_l dflags optl_args = map Option (getOpts dflags opt_l) - args2 = args0 ++ linkargs ++ args ++ optl_args + args2 = args0 ++ args ++ optl_args mb_env <- getGccEnv args2 runSomethingResponseFile logger tmpfs dflags ld_filter "Linker" p args2 mb_env where ===================================== compiler/ghc.cabal.in ===================================== @@ -712,7 +712,6 @@ Library GHC.SysTools.BaseDir GHC.SysTools.Cpp GHC.SysTools.Elf - GHC.SysTools.Info GHC.SysTools.Process GHC.SysTools.Tasks GHC.SysTools.Terminal ===================================== m4/fp_link_supports_no_as_needed.m4 ===================================== @@ -0,0 +1,33 @@ +# FP_LINK_SUPPORTS_NO_AS_NEEDED +# ---------------------------------- +# Set the Cc linker flag -Wl,--no-as-needed if it is supported +# $1 is the name of the linker flags variable when linking with gcc +# See also Note [ELF needed shared libs] +AC_DEFUN([FP_LINK_SUPPORTS_NO_AS_NEEDED], +[ + AC_MSG_CHECKING([whether Cc linker supports -Wl,--no-as-needed]) + echo 'int f(int a) {return 2*a;}' > conftest.a.c + echo 'int f(int a); int main(int argc, char **argv) {return f(0);}' > conftest.b.c + $CC -o conftest.a.o conftest.a.c + $CC -o conftest.b.o conftest.b.c + if "$CC" "$$1" -Wl,--no-as-needed -o conftest conftest.a.o conftest.b.o > /dev/null 2>&1 + then + $1="$$1 -Wl,--no-as-needed" + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + fi + rm -f conftest* +]) + +# Note [ELF needed shared libs] +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# Some distributions change the link editor's default handling of +# ELF DT_NEEDED tags to include only those shared objects that are +# needed to resolve undefined symbols. For Template Haskell we need +# the last temporary shared library also if it is not needed for the +# currently linked temporary shared library. We specify --no-as-needed +# to override the default. This flag exists in GNU ld and GNU gold. +# +# The flag is only needed on ELF systems. On Windows (PE) and Mac OS X +# (Mach-O) the flag is not needed. ===================================== m4/fptools_set_c_ld_flags.m4 ===================================== @@ -17,9 +17,19 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS], ;; esac + # See Note [ELF needed shared libs] + case $$1 in + *-linux|*-freebsd*) + FP_LINK_SUPPORTS_NO_AS_NEEDED([$3]) + ;; + esac + case $$1 in i386-unknown-mingw32) $2="$$2 -march=i686" + # Emit stack checks + # See Note [Windows stack allocations] + $3="$$3 -fstack-check" ;; i386-portbld-freebsd*) $2="$$2 -march=i686" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/53ea4e07001bb6cc99c7360d91f05e07484b448b...ea1e4994c92d50bf4d6bd7a8ad649336fb4db1fb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/53ea4e07001bb6cc99c7360d91f05e07484b448b...ea1e4994c92d50bf4d6bd7a8ad649336fb4db1fb You're receiving 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 Jun 26 15:49:49 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 26 Jun 2023 11:49:49 -0400 Subject: [Git][ghc/ghc][wip/tsan/fixes-2] 5 commits: rts: Ensure that TSANUtils.h is included in Stg.h Message-ID: <6499b39da998d_64cc0c76f03674db@gitlab.mail> Ben Gamari pushed to branch wip/tsan/fixes-2 at Glasgow Haskell Compiler / GHC Commits: f96955a9 by Ben Gamari at 2023-06-26T10:09:33-04:00 rts: Ensure that TSANUtils.h is included in Stg.h - - - - - 05074dd5 by Ben Gamari at 2023-06-26T10:09:53-04:00 rts/STM: Fix warning - - - - - b1c82826 by Ben Gamari at 2023-06-26T10:10:04-04:00 rts: Introduce NO_WARN macro This allows fine-grained ignoring of warnings. - - - - - 53cf83bd by Ben Gamari at 2023-06-26T10:10:42-04:00 rts: Fix unsupported fence warnings with TSAN - - - - - 1b868666 by Ben Gamari at 2023-06-26T10:11:12-04:00 rts/RaiseAsync: Drop redundant release fence - - - - - 6 changed files: - rts/RaiseAsync.c - rts/STM.c - rts/include/Rts.h - rts/include/Stg.h - rts/include/rts/storage/ClosureMacros.h - rts/include/stg/SMP.h Changes: ===================================== rts/RaiseAsync.c ===================================== @@ -238,7 +238,6 @@ throwToMsg (Capability *cap, MessageThrowTo *msg) goto check_target; retry: - RELEASE_FENCE(); debugTrace(DEBUG_sched, "throwTo: retrying..."); check_target: ===================================== rts/STM.c ===================================== @@ -291,7 +291,7 @@ static StgClosure *lock_tvar(Capability *cap, StgClosure *result; TRACE("%p : lock_tvar(%p)", trec, s); do { - StgInfoTable *info; + const StgInfoTable *info; do { result = ACQUIRE_LOAD(&s->current_value); info = GET_INFO(UNTAG_CLOSURE(result)); ===================================== rts/include/Rts.h ===================================== @@ -236,7 +236,6 @@ void _warnFail(const char *filename, unsigned int linenum); /* Parallel information */ #include "rts/OSThreads.h" -#include "rts/TSANUtils.h" #include "rts/SpinLock.h" #include "rts/Messages.h" ===================================== rts/include/Stg.h ===================================== @@ -284,6 +284,17 @@ # define STG_RETURNS_NONNULL #endif +/* ----------------------------------------------------------------------------- + Suppressing C warnings + -------------------------------------------------------------------------- */ + +#define DO_PRAGMA(x) _Pragma(#x) +#define NO_WARN(warnoption, ...) \ + DO_PRAGMA(GCC diagnostic push) \ + DO_PRAGMA(GCC diagnostic ignored #warnoption) \ + __VA_ARGS__ \ + DO_PRAGMA(GCC diagnostic pop) + /* ----------------------------------------------------------------------------- Global type definitions -------------------------------------------------------------------------- */ @@ -382,6 +393,7 @@ external prototype return neither of these types to workaround #11395. #include "stg/MachRegsForHost.h" #include "stg/Regs.h" #include "stg/Ticky.h" +#include "rts/TSANUtils.h" #if IN_STG_CODE /* ===================================== rts/include/rts/storage/ClosureMacros.h ===================================== @@ -75,6 +75,7 @@ EXTERN_INLINE StgThunkInfoTable *itbl_to_thunk_itbl (const StgInfoTable *i); EXTERN_INLINE StgConInfoTable *itbl_to_con_itbl (const StgInfoTable *i); #if defined(TABLES_NEXT_TO_CODE) +NO_WARN(-Warray-bounds, EXTERN_INLINE StgInfoTable *INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgInfoTable *)info - 1;} EXTERN_INLINE StgRetInfoTable *RET_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgRetInfoTable *)info - 1;} EXTERN_INLINE StgFunInfoTable *FUN_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgFunInfoTable *)info - 1;} @@ -84,6 +85,7 @@ EXTERN_INLINE StgFunInfoTable *itbl_to_fun_itbl(const StgInfoTable *i) {return ( EXTERN_INLINE StgRetInfoTable *itbl_to_ret_itbl(const StgInfoTable *i) {return (StgRetInfoTable *)(i + 1) - 1;} EXTERN_INLINE StgThunkInfoTable *itbl_to_thunk_itbl(const StgInfoTable *i) {return (StgThunkInfoTable *)(i + 1) - 1;} EXTERN_INLINE StgConInfoTable *itbl_to_con_itbl(const StgInfoTable *i) {return (StgConInfoTable *)(i + 1) - 1;} +) #else EXTERN_INLINE StgInfoTable *INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgInfoTable *)info;} EXTERN_INLINE StgRetInfoTable *RET_INFO_PTR_TO_STRUCT(const StgInfoTable *info) {return (StgRetInfoTable *)info;} ===================================== rts/include/stg/SMP.h ===================================== @@ -585,14 +585,12 @@ busy_wait_nop(void) #define ACQUIRE_FENCE() __atomic_thread_fence(__ATOMIC_ACQUIRE) #define RELEASE_FENCE() __atomic_thread_fence(__ATOMIC_RELEASE) -#define SEQ_CST_FENCE() __atomic_thread_fence(__ATOMIC_SEQ_CST) +#define SEQ_CST_FENCE() NO_WARN(-Wtsan, __atomic_thread_fence(__ATOMIC_SEQ_CST);) #if defined(TSAN_ENABLED) -#define ACQUIRE_FENCE_ON(x) ACQUIRE_LOAD(x) -#define RELEASE_FENCE_ON(x) RELEASE_STORE() +#define ACQUIRE_FENCE_ON(x) (void)ACQUIRE_LOAD(x) #else #define ACQUIRE_FENCE_ON(x) __atomic_thread_fence(__ATOMIC_ACQUIRE) -#define RELEASE_FENCE_ON(x) __atomic_thread_fence(__ATOMIC_RELEASE) #endif /* ---------------------------------------------------------------------- */ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/424e1e998021639fdea8ef5a238ebc7af6abf319...1b868666f1213f74badd3ebbb323ab126f3f44d3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/424e1e998021639fdea8ef5a238ebc7af6abf319...1b868666f1213f74badd3ebbb323ab126f3f44d3 You're receiving 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 Jun 26 15:49:53 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 11:49:53 -0400 Subject: [Git][ghc/ghc][wip/romes/remove-toolchain-runtime-config] Fixes Message-ID: <6499b3a1c0ad2_64cc0c76f03678c8@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/remove-toolchain-runtime-config at Glasgow Haskell Compiler / GHC Commits: 0794e273 by Rodrigo Mesquita at 2023-06-26T16:49:47+01:00 Fixes - - - - - 1 changed file: - compiler/GHC/Driver/DynFlags.hs Changes: ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -116,7 +116,6 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Trans.Reader (ReaderT) import Control.Monad.Trans.Writer (WriterT) -import Data.IORef import System.IO import System.IO.Error (catchIOError) import System.Environment (lookupEnv) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0794e273f1ea4468b3bf288e4bcefa2986bc80c4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0794e273f1ea4468b3bf288e4bcefa2986bc80c4 You're receiving 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 Jun 26 15:53:50 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 11:53:50 -0400 Subject: [Git][ghc/ghc][wip/romes/remove-toolchain-runtime-config] 3 commits: Configure -Wl,--no-as-needed Message-ID: <6499b48e30b23_2402e0c75883759@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/remove-toolchain-runtime-config at Glasgow Haskell Compiler / GHC Commits: 6b16eb91 by Rodrigo Mesquita at 2023-06-26T16:53:31+01:00 Configure -Wl,--no-as-needed To fixup, but this is one of the things we must now configure instead of determine at runtime Be sure to enumerate those in a bullet list - - - - - e5e045aa by Rodrigo Mesquita at 2023-06-26T16:53:39+01:00 fstackcheck - - - - - 35a2d172 by Rodrigo Mesquita at 2023-06-26T16:53:39+01:00 Fixes - - - - - 3 changed files: - compiler/GHC/Driver/DynFlags.hs - + m4/fp_link_supports_no_as_needed.m4 - m4/fptools_set_c_ld_flags.m4 Changes: ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -116,7 +116,6 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Trans.Reader (ReaderT) import Control.Monad.Trans.Writer (WriterT) -import Data.IORef import System.IO import System.IO.Error (catchIOError) import System.Environment (lookupEnv) ===================================== m4/fp_link_supports_no_as_needed.m4 ===================================== @@ -0,0 +1,33 @@ +# FP_LINK_SUPPORTS_NO_AS_NEEDED +# ---------------------------------- +# Set the Cc linker flag -Wl,--no-as-needed if it is supported +# $1 is the name of the linker flags variable when linking with gcc +# See also Note [ELF needed shared libs] +AC_DEFUN([FP_LINK_SUPPORTS_NO_AS_NEEDED], +[ + AC_MSG_CHECKING([whether Cc linker supports -Wl,--no-as-needed]) + echo 'int f(int a) {return 2*a;}' > conftest.a.c + echo 'int f(int a); int main(int argc, char **argv) {return f(0);}' > conftest.b.c + $CC -c -o conftest.a.o conftest.a.c > /dev/null 2>&1 + $CC -c -o conftest.b.o conftest.b.c > /dev/null 2>&1 + if "$CC" "$$1" -Wl,--no-as-needed -o conftest conftest.a.o conftest.b.o > /dev/null 2>&1 + then + $1="$$1 -Wl,--no-as-needed" + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + fi + rm -f conftest* +]) + +# Note [ELF needed shared libs] +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# Some distributions change the link editor's default handling of +# ELF DT_NEEDED tags to include only those shared objects that are +# needed to resolve undefined symbols. For Template Haskell we need +# the last temporary shared library also if it is not needed for the +# currently linked temporary shared library. We specify --no-as-needed +# to override the default. This flag exists in GNU ld and GNU gold. +# +# The flag is only needed on ELF systems. On Windows (PE) and Mac OS X +# (Mach-O) the flag is not needed. ===================================== m4/fptools_set_c_ld_flags.m4 ===================================== @@ -17,9 +17,19 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS], ;; esac + # See Note [ELF needed shared libs] + case $$1 in + *-linux|*-freebsd*) + FP_LINK_SUPPORTS_NO_AS_NEEDED([$3]) + ;; + esac + case $$1 in i386-unknown-mingw32) $2="$$2 -march=i686" + # Emit stack checks + # See Note [Windows stack allocations] + $3="$$3 -fstack-check" ;; i386-portbld-freebsd*) $2="$$2 -march=i686" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0794e273f1ea4468b3bf288e4bcefa2986bc80c4...35a2d172f4366a6efce223805901c5fbc8783329 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0794e273f1ea4468b3bf288e4bcefa2986bc80c4...35a2d172f4366a6efce223805901c5fbc8783329 You're receiving 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 Jun 26 15:56:11 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 11:56:11 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Fixes Message-ID: <6499b51b57087_2402e0c75603786c@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 1ef20301 by Rodrigo Mesquita at 2023-06-26T16:55:57+01:00 Fixes - - - - - 1 changed file: - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs Changes: ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -26,18 +26,6 @@ data CcLink = CcLink { ccLinkProgram :: Program } deriving (Read, Eq, Ord) --- These instances are more suitable for diffing -instance Show CcLink where - show CcLink{..} = unlines - [ "CcLink" - , "{ ccLinkProgram = " ++ show ccLinkProgram - , ", ccLinkSupportsNoPie = " ++ show ccLinkSupportsNoPie - , ", ccLinkSupportsCompactUnwind = " ++ show ccLinkSupportsCompactUnwind - , ", ccLinkSupportsFilelist = " ++ show ccLinkSupportsFilelist - , ", ccLinkIsGnu = " ++ show ccLinkIsGnu - , "}" - ] - _ccLinkProgram :: Lens CcLink Program _ccLinkProgram = Lens ccLinkProgram (\x o -> o{ccLinkProgram=x}) @@ -185,14 +173,7 @@ checkLinkWorks cc ccLink = withTempDir $ \dir -> do checkLinkIsGnu :: Program -> M Bool checkLinkIsGnu ccLink = do -<<<<<<< HEAD out <- readProgramStdout ccLink ["-Wl,--version"] -||||||| parent of 4a31527a36e (ghc-toolchain: set CC LD plat. dependent flags) - out <- readProgramStdout ccLink ["--version"] -======= - -- ROMES:TODO: Possibly try all these with -Wl,... - out <- readProgramStdout ccLink ["--version"] ->>>>>>> 4a31527a36e (ghc-toolchain: set CC LD plat. dependent flags) return ("GNU" `isInfixOf` out) -- | Check for binutils bug #16177 present in some versions of the bfd ld View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1ef2030147c03de2546141fb3d2697e25c1aa6fb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1ef2030147c03de2546141fb3d2697e25c1aa6fb You're receiving 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 Jun 26 16:30:02 2023 From: gitlab at gitlab.haskell.org (David (@knothed)) Date: Mon, 26 Jun 2023 12:30:02 -0400 Subject: [Git][ghc/ghc][wip/or-pats] 131 commits: Output Lint errors to stderr instead of stdout Message-ID: <6499bd0a1f60b_2402e0c7510469b3@gitlab.mail> David pushed to branch wip/or-pats at Glasgow Haskell Compiler / GHC Commits: 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 740e73ff by David Knothe at 2023-06-26T18:28:32+02:00 Implement Or Patterns (Proposal 0522) This commit introduces a language extension, `OrPatterns`, as described in proposal 0522. It extends the syntax by the production `pat -> (one of pat1, ..., patk)`. The or-pattern `pat` succeeds iff one of the patterns `pat1`, ..., `patk` succeed, in this order. Currently, or-patterns cannot bind variables. They are still of great use as they discourage the use of wildcard patterns in favour of writing out all "default" cases explicitly: ``` isIrrefutableHsPat pat = case pat of ... (one of WildPat{}, VarPat{}, LazyPat{}) = True (one of PArrPat{}, ConPatIn{}, LitPat{}, NPat{}, NPlusKPat{}, ListPat{}) = False ``` This makes code safer where data types are extended now and then - just like GHC's `Pat` in the example when adding the new `OrPat` constructor. This would be catched by `-fwarn-incomplete-patterns`, but not when a wildcard pattern was used. - Update submodule haddock. stuff Implement empty one of Prohibit TyApps Remove unused update submodule haddock Update tests Parser.y - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - HACKING.md - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/Data/BooleanFormula.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Errors.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/24c5f66be3d61f3970a797d44f844571549e4c46...740e73fffeccbc94c3a6fec28ba4ec19124f7b77 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/24c5f66be3d61f3970a797d44f844571549e4c46...740e73fffeccbc94c3a6fec28ba4ec19124f7b77 You're receiving 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 Jun 26 16:31:34 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 12:31:34 -0400 Subject: [Git][ghc/ghc][wip/romes/remove-toolchain-runtime-config] Fixes Message-ID: <6499bd66c78fc_2402e0c74fc47880@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/remove-toolchain-runtime-config at Glasgow Haskell Compiler / GHC Commits: e982a545 by Rodrigo Mesquita at 2023-06-26T17:31:25+01:00 Fixes - - - - - 5 changed files: - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/SysTools.hs Changes: ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -116,7 +116,6 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Trans.Reader (ReaderT) import Control.Monad.Trans.Writer (WriterT) -import Data.IORef import System.IO import System.IO.Error (catchIOError) import System.Environment (lookupEnv) ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -109,9 +109,6 @@ module GHC.Driver.Main import GHC.Prelude -import GHC.Platform -import GHC.Platform.Ways - import GHC.Driver.Plugins import GHC.Driver.Session import GHC.Driver.Backend ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -308,7 +308,6 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do = withAtomicRename outputFilename $ \temp_outputFilename -> runAs logger dflags - platform (local_includes ++ global_includes -- See Note [-fPIC for assembler] ++ map GHC.SysTools.Option pic_c_flags ===================================== compiler/GHC/Linker/ExtraObj.hs ===================================== @@ -41,7 +41,6 @@ import GHC.SysTools.Elf import GHC.SysTools.Tasks import GHC.Linker.Unit -import Control.Monad.IO.Class import Control.Monad import Data.Maybe ===================================== compiler/GHC/SysTools.hs ===================================== @@ -34,7 +34,6 @@ import GHC.Prelude import GHC.Utils.Panic import GHC.Driver.Session -import GHC.Linker.ExtraObj import GHC.SysTools.Tasks import GHC.SysTools.BaseDir import GHC.Settings.IO View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e982a545930aa6207f7646bf785e1bb4ca8993c1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e982a545930aa6207f7646bf785e1bb4ca8993c1 You're receiving 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 Jun 26 16:43:44 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 12:43:44 -0400 Subject: [Git][ghc/ghc][wip/romes/linear-core] 2 commits: Some tweaks and note: Message-ID: <6499c04080f53_2402e0c756054785@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/linear-core at Glasgow Haskell Compiler / GHC Commits: 0c7745f9 by Rodrigo Mesquita at 2023-06-23T23:03:23+01:00 Some tweaks and note: * It seems very important that if we update the Id binding of some Id that happens in a binder we also update the Id binding of occurrences of that Id in Var expressions. Otherwise we'll fail important things like lookups on triemaps - - - - - 4dfac578 by Rodrigo Mesquita at 2023-06-26T17:42:27+01:00 Compilation fixes - - - - - 17 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match/Constructor.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Tc/Zonk/TcType.hs - compiler/GHC/Tc/Zonk/Type.hs - compiler/GHC/Types/Var.hs Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -1677,7 +1677,7 @@ mkFunResCo role id res_co = mkFunCoNoFTF role mult arg_co res_co where arg_co = mkReflCo role (varType id) -- (arg ~ arg) - mult = multToCo $ case idBinding id of + mult = multToCo $ case idBinding id of LambdaBound m -> m LetBound -> panic "mkFunResCo" -- ROMES: ===================================== compiler/GHC/Core/Opt/Simplify/Utils.hs ===================================== @@ -2539,7 +2539,7 @@ mkCase mode scrut outer_bndr alts_ty (Alt DEFAULT _ deflt_rhs : outer_alts) -- that outer_bndr is not shadowed by the inner patterns wrap_rhs rhs = Let (NonRec (toLetBound inner_bndr) (Var outer_bndr)) rhs -- IdBinding: See Note [Keeping the IdBinding up to date] - -- + -- -- The let is OK even for unboxed binders, wrapped_alts | isDeadBinder inner_bndr = inner_alts ===================================== compiler/GHC/Core/Opt/WorkWrap/Utils.hs ===================================== @@ -987,7 +987,7 @@ unbox_one_arg opts arg_var ; let wrap_arg = mkConApp dc (map Type tc_args ++ wrap_args) `mkCast` mkSymCo co -- See Note [Unboxing through unboxed tuples] ; return $ if isUnboxedTupleDataCon dc && not nested_useful - then (boringSplit, [(arg_var,NotMarkedStrict)], nop_fn, varToCoreExpr arg_var) + then (boringSplit, [(toLambdaBound arg_var,NotMarkedStrict)], nop_fn, varToCoreExpr $ toLambdaBound arg_var) else (usefulSplit, worker_args, unbox_fn . wrap_fn, wrap_arg) } -- | Tries to find a suitable absent filler to bind the given absent identifier ===================================== compiler/GHC/Core/Rules.hs ===================================== @@ -193,7 +193,7 @@ mkRule this_mod is_auto is_local name act fn bndrs args rhs = Rule { ru_name = name , ru_act = act , ru_fn = fn - , ru_bndrs = bndrs + , ru_bndrs = map toLambdaBound bndrs -- romes:todo: the issue being if we don't do this elsewhere we'll get our vars and binders out of sync (let bound vs lambda bound) , ru_args = args , ru_rhs = occurAnalyseExpr rhs -- See Note [OccInfo in unfoldings and rules] ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -35,7 +35,6 @@ import GHC.Types.Id.Info ( realUnfoldingInfo, setUnfoldingInfo, setRuleInfo, Id import GHC.Types.Var ( isNonCoVarId, toLetBound ) import GHC.Types.Var.Set import GHC.Types.Var.Env -import GHC.Core.UsageEnv import GHC.Core.DataCon import GHC.Types.Demand( etaConvertDmdSig, topSubDmd ) import GHC.Types.Tickish ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -176,12 +176,12 @@ mkLamType v body_ty | otherwise = mkFunctionType mult (varType v) body_ty where - !mult = case varMultMaybe v of - -- ROMES: Can we avoid this panic by encoding this at the type level somehow? - -- ... it could prove pretty invasive... - Nothing -> pprTrace "mkLamType: LetBound var turned to LambdaBound" (ppr v <+> ppr (idBinding v)) ManyTy - -- panic "mkLamTypes: lambda bound var (be it a big or small lambda) should be annotated with LambdaBound" - Just m -> m + mult = case varMultMaybe v of + -- ROMES: Can we avoid this panic by encoding this at the type level somehow? + -- ... it could prove pretty invasive... + Nothing -> pprTrace "mkLamType: LetBound var turned to LambdaBound" (ppr v <+> ppr (idBinding v)) ManyTy + -- panic "mkLamTypes: lambda bound var (be it a big or small lambda) should be annotated with LambdaBound" + Just m -> m mkLamTypes vs ty = foldr mkLamType ty vs @@ -523,7 +523,7 @@ bindNonRec bndr rhs body lambda_bndr = toLambdaBound bndr -- ROMES:TODO: Explain, is this the best place to do this? case_bind = mkDefaultCase rhs lambda_bndr body -- ROMES:TODO: I couldn't find the root cause, for now we simply override the idBinding here - let_bind + let_bind | isId bndr = Let (NonRec (toLetBound bndr) rhs) body | otherwise ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE Strict #-} -- See Note [Avoiding space leaks in toIface*] +{-# LANGUAGE ViewPatterns #-} -- | Functions for converting Core things to interface file things. module GHC.CoreToIface @@ -135,10 +136,11 @@ toIfaceIdBndr :: Id -> IfaceIdBndr toIfaceIdBndr = toIfaceIdBndrX emptyVarSet toIfaceIdBndrX :: VarSet -> CoVar -> IfaceIdBndr -toIfaceIdBndrX fr covar = ( toIfaceType (idMult $ toLambdaBound covar) -- idMult of coercion variable should already always be ManyTy?... - , occNameFS (getOccName covar) - , toIfaceTypeX fr (varType covar) - ) +toIfaceIdBndrX fr (toLambdaBound -> covar) + = ( toIfaceType (idMult covar) -- idMult of coercion variable should already always be ManyTy?... + , occNameFS (getOccName covar) + , toIfaceTypeX fr (varType covar) + ) toIfaceBndr :: Var -> IfaceBndr toIfaceBndr var ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -245,8 +245,9 @@ dsAbsBinds dflags tyvars dicts exports -- If there is a variable to force, it's just the -- single variable we are binding here = do { dsHsWrapper wrap $ \core_wrap -> do -- Usually the identity - { let rhs = core_wrap $ - mkLams tyvars $ mkLams (map toLambdaBound dicts) $ + { let dicts' = map toLambdaBound dicts + rhs = core_wrap $ + mkLams tyvars $ mkLams dicts' $ -- The tyvars aren't really just TyVars, right? $dEq can end up there it seems -- and -- So dicts names mention the @@ -266,7 +267,7 @@ dsAbsBinds dflags tyvars dicts exports ; let global_id' = addIdSpecialisations global_id rules main_bind = makeCorePair dflags global_id' (isDefaultMethod prags) - (dictArity dicts) rhs + (dictArity dicts') rhs ; return (force_vars', main_bind : fromOL spec_binds) } } @@ -719,8 +720,9 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl)) { this_mod <- getModule ; let fn_unf = realIdUnfolding poly_id + spec_bndrs' = map toLambdaBound spec_bndrs simpl_opts = initSimpleOpts dflags - spec_unf = specUnfolding simpl_opts (map toLambdaBound spec_bndrs) core_app rule_lhs_args fn_unf + spec_unf = specUnfolding simpl_opts spec_bndrs' core_app rule_lhs_args fn_unf spec_id = mkLocalId spec_name LetBound spec_ty `setInlinePragma` inl_prag `setIdUnfolding` spec_unf @@ -728,8 +730,8 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl)) rule = mkSpecRule dflags this_mod False rule_act (text "USPEC") poly_id rule_bndrs rule_lhs_args -- ROMES:TODO: Perhaps this kind of SetIdBinding is something that the functions actually constructing the lambda abstractions could always do by default - (mkVarApps (Var spec_id) spec_bndrs) - spec_rhs = mkLams spec_bndrs (core_app poly_rhs) + (mkVarApps (Var spec_id) spec_bndrs') + spec_rhs = mkLams spec_bndrs' (core_app poly_rhs) ; dsWarnOrphanRule rule ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -51,7 +51,6 @@ import GHC.Core.Make import GHC.Driver.Session import GHC.Types.CostCentre import GHC.Types.Id -import GHC.Types.Var (pprIdWithBinding) import GHC.Types.Id.Make import GHC.Unit.Module import GHC.Core.ConLike ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -288,7 +288,6 @@ matchCoercion (var :| vars) ty (eqns@(eqn1 :| _)) ; match_result <- match (var':vars) ty $ NEL.toList $ decomposeFirstPat getCoPat <$> eqns ; dsHsWrapper co $ \core_wrap -> do - -- romes:I don't know { let bind = NonRec (toLetBound var') (core_wrap (Var var)) ; return (mkCoLetMatchResult bind match_result) } } ===================================== compiler/GHC/HsToCore/Match/Constructor.hs ===================================== @@ -107,7 +107,7 @@ have-we-used-all-the-constructors? question; the local function -- -- case of -- C a b -> ... --- D c -> ... -- not sure about this second constructor being correct +-- D c -> ... -- not sure about this second constructor being correct -- -- Relevant notes seem to be [Match Ids] and [Localise pattern binders] matchConFamily :: NonEmpty Id ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -57,7 +57,6 @@ import GHC.Tc.Zonk.TcType import GHC.Core.Predicate ( getEqPredTys_maybe ) import GHC.Core.Reduction ( Reduction(..) ) import GHC.Core.Multiplicity -import GHC.Core.UsageEnv import GHC.Core.FamInstEnv( normaliseType ) import GHC.Core.Class ( Class ) import GHC.Core.Coercion( mkSymCo ) ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -542,7 +542,7 @@ tcLcStmt m_tc ctxt (TransStmt { trS_form = form, trS_stmts = stmts -- typically something like [(Int,Bool,Int)] -- We don't know what tuple_ty is yet, so we use a variable ; let mk_n_bndr :: Name -> TcId -> TcId - mk_n_bndr n_bndr_name bndr_id = mkLocalId n_bndr_name LetBound (n_app (idType bndr_id)) -- romes:TODO: LetBound or LambdaBound? + mk_n_bndr n_bndr_name bndr_id = mkLocalId n_bndr_name (LambdaBound ManyTy) (n_app (idType bndr_id)) -- Ensure that every old binder of type `b` is linked up with its -- new binder which should have type `n b` ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -1385,11 +1385,11 @@ deeplySkolemise skol_info ty = do { let arg_tys' = substScaledTys subst arg_tys ; ids1 <- newSysLocalIds (fsLit "dk") arg_tys' ; (subst', tvs1) <- tcInstSkolTyVarsX skol_info subst tvs - ; ev_vars1 <- newEvVars (substTheta subst' theta) + ; ev_vars1 <- map toLambdaBound <$> newEvVars (substTheta subst' theta) ; (wrap, tvs_prs2, ev_vars2, rho) <- go subst' ty' ; let tv_prs1 = map tyVarName tvs `zip` tvs1 ; return ( mkWpEta ids1 (mkWpTyLams tvs1 - <.> mkWpEvLams (map toLambdaBound ev_vars1) + <.> mkWpEvLams ev_vars1 <.> wrap) , tv_prs1 ++ tvs_prs2 , ev_vars1 ++ ev_vars2 ===================================== compiler/GHC/Tc/Zonk/TcType.hs ===================================== @@ -337,7 +337,7 @@ zonkTyCoVarBndrKind (Bndr tv flag) = -- | zonkId is used *during* typechecking just to zonk the 'Id''s type zonkId :: TcId -> ZonkM TcId -zonkId id = updateIdTypeAndMultM zonkTcType id +zonkId id = updateIdTypeAndMultsM zonkTcType id zonkCoVar :: CoVar -> ZonkM CoVar zonkCoVar = zonkId @@ -402,7 +402,7 @@ zonkImplication implic@(Implic { ic_skols = skols , ic_info = info' }) } zonkEvVar :: EvVar -> ZonkM EvVar -zonkEvVar var = updateIdTypeAndMultM zonkTcType var +zonkEvVar var = updateIdTypeAndMultsM zonkTcType var zonkWC :: WantedConstraints -> ZonkM WantedConstraints @@ -677,4 +677,4 @@ tidyFRROrigin env (FixedRuntimeRepOrigin ty orig) ---------------- tidyEvVar :: TidyEnv -> EvVar -> EvVar -tidyEvVar env var = updateIdTypeAndMult (tidyType env) var +tidyEvVar env var = updateIdTypeAndMults (tidyType env) var ===================================== compiler/GHC/Tc/Zonk/Type.hs ===================================== @@ -597,8 +597,15 @@ zonkIdBndrX v zonkIdBndr :: TcId -> ZonkTcM Id zonkIdBndr v - = do { Scaled w' ty' <- zonkScaledTcTypeToTypeX (idScaledType v) - ; return $ setIdMult (setIdType v ty') w' } + = do idBinding' <- zonkIdBinding (idBinding v) + ty' <- zonkTcTypeToTypeX (idType v) + return $ setIdBinding (setIdType v ty') idBinding' + +zonkIdBinding :: IdBinding -> ZonkTcM IdBinding +zonkIdBinding b = case b of + LambdaBound m -> LambdaBound <$> zonkTcTypeToTypeX m + -- LetBound ue -> LetBound <$> mapUEM zonkTcTypeToTypeX ue + LetBound -> pure LetBound zonkIdBndrs :: [TcId] -> ZonkTcM [Id] zonkIdBndrs ids = mapM zonkIdBndr ids @@ -626,7 +633,7 @@ zonkEvBndr :: EvVar -> ZonkTcM EvVar -- Works for dictionaries and coercions -- Does not extend the ZonkEnv zonkEvBndr var - = updateIdTypeAndMultM ({-# SCC "zonkEvBndr_zonkTcTypeToType" #-} zonkTcTypeToTypeX) var + = updateIdTypeAndMultsM ({-# SCC "zonkEvBndr_zonkTcTypeToType" #-} zonkTcTypeToTypeX) var {- zonkEvVarOcc :: EvVar -> ZonkTcM EvTerm @@ -770,7 +777,7 @@ zonk_bind (XHsBindsLR (AbsBinds { abs_tvs = tyvars, abs_ev_vars = evs , (L loc bind@(FunBind { fun_id = (L mloc mono_id) , fun_matches = ms , fun_ext = (co_fn, ticks) })) <- lbind - = do { new_mono_id <- updateIdTypeAndMultM zonkTcTypeToTypeX mono_id + = do { new_mono_id <- updateIdTypeAndMultsM zonkTcTypeToTypeX mono_id -- Specifically /not/ zonkIdBndr; we do not want to -- complain about a representation-polymorphic binder ; runZonkBndrT (zonkCoFn co_fn) $ \ new_co_fn -> ===================================== compiler/GHC/Types/Var.hs ===================================== @@ -257,7 +257,8 @@ data Var -- ^ Key for fast comparison -- Identical to the Unique in the name, -- cached here for speed - varType :: Kind -- ^ The type or kind of the 'Var' in question + varType :: Kind, -- ^ The type or kind of the 'Var' in question + idBinding :: HasCallStack => IdBinding -- Never put anything here, it's just to catch location of bugs when using field accessors } | TcTyVar { -- Used only during type inference @@ -266,7 +267,8 @@ data Var varName :: !Name, realUnique :: {-# UNPACK #-} !Int, varType :: Kind, - tc_tv_details :: TcTyVarDetails + tc_tv_details :: TcTyVarDetails, + idBinding :: HasCallStack => IdBinding -- Never put anything here, it's just to catch location of bugs when using field accessors } | Id { @@ -1215,6 +1217,7 @@ mkTyVar :: Name -> Kind -> TyVar mkTyVar name kind = TyVar { varName = name , realUnique = getKey (nameUnique name) , varType = kind + , idBinding = error "here" } mkTcTyVar :: Name -> Kind -> TcTyVarDetails -> TyVar @@ -1224,6 +1227,7 @@ mkTcTyVar name kind details realUnique = getKey (nameUnique name), varType = kind, tc_tv_details = details + , idBinding = error "here" } tcTyVarDetails :: TyVar -> TcTyVarDetails View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/28ebeed4e4da051c9ea5ce01b8805ba6d5be9152...4dfac578390d7e639bd46e66b0f01b684c4be65a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/28ebeed4e4da051c9ea5ce01b8805ba6d5be9152...4dfac578390d7e639bd46e66b0f01b684c4be65a You're receiving 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 Jun 26 16:45:17 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Mon, 26 Jun 2023 12:45:17 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/sand-witch/pattern-@a-binders Message-ID: <6499c09ded008_2402e0c74fc553c4@gitlab.mail> Andrei Borzenkov pushed new branch wip/sand-witch/pattern- at a-binders at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sand-witch/pattern- at a-binders You're receiving 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 Jun 26 16:49:26 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 12:49:26 -0400 Subject: [Git][ghc/ghc][wip/romes/remove-toolchain-runtime-config] Rip out runtime linker/compiler checks Message-ID: <6499c196ede37_2402e0c74fc5946a@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/remove-toolchain-runtime-config at Glasgow Haskell Compiler / GHC Commits: 26101e4c by Ben Gamari at 2023-06-26T17:32:15+01:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC. As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 11 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/SysTools.hs - − compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - compiler/ghc.cabal.in - + m4/fp_link_supports_no_as_needed.m4 - m4/fptools_set_c_ld_flags.m4 Changes: ===================================== compiler/GHC/Driver/Backend.hs ===================================== @@ -58,8 +58,6 @@ module GHC.Driver.Backend , DefunctionalizedCodeOutput(..) -- *** Back-end functions for assembly , DefunctionalizedPostHscPipeline(..) - , DefunctionalizedAssemblerProg(..) - , DefunctionalizedAssemblerInfoGetter(..) -- *** Other back-end functions , DefunctionalizedCDefs(..) -- ** Names of back ends (for API clients of version 9.4 or earlier) @@ -94,8 +92,6 @@ module GHC.Driver.Backend , backendSupportsHpc , backendSupportsCImport , backendSupportsCExport - , backendAssemblerProg - , backendAssemblerInfoGetter , backendCDefs , backendCodeOutput , backendUseJSLinker @@ -348,40 +344,6 @@ data PrimitiveImplementation deriving Show --- | Names a function that runs the assembler, of this type: --- --- > Logger -> DynFlags -> Platform -> [Option] -> IO () --- --- The functions so named are defined in "GHC.Driver.Pipeline.Execute". - -data DefunctionalizedAssemblerProg - = StandardAssemblerProg - -- ^ Use the standard system assembler - | JSAssemblerProg - -- ^ JS Backend compile to JS via Stg, and so does not use any assembler - | DarwinClangAssemblerProg - -- ^ If running on Darwin, use the assembler from the @clang@ - -- toolchain. Otherwise use the standard system assembler. - - - --- | Names a function that discover from what toolchain the assembler --- is coming, of this type: --- --- > Logger -> DynFlags -> Platform -> IO CompilerInfo --- --- The functions so named are defined in "GHC.Driver.Pipeline.Execute". - -data DefunctionalizedAssemblerInfoGetter - = StandardAssemblerInfoGetter - -- ^ Interrogate the standard system assembler - | JSAssemblerInfoGetter - -- ^ If using the JS backend; return 'Emscripten' - | DarwinClangAssemblerInfoGetter - -- ^ If running on Darwin, return `Clang`; otherwise - -- interrogate the standard system assembler. - - -- | Names a function that generates code and writes the results to a -- file, of this type: -- @@ -770,45 +732,6 @@ backendSupportsCExport (Named JavaScript) = True backendSupportsCExport (Named Interpreter) = False backendSupportsCExport (Named NoBackend) = True --- | This (defunctionalized) function runs the assembler --- used on the code that is written by this back end. A --- program determined by a combination of back end, --- `DynFlags`, and `Platform` is run with the given --- `Option`s. --- --- The function's type is --- @ --- Logger -> DynFlags -> Platform -> [Option] -> IO () --- @ --- --- This field is usually defaulted. -backendAssemblerProg :: Backend -> DefunctionalizedAssemblerProg -backendAssemblerProg (Named NCG) = StandardAssemblerProg -backendAssemblerProg (Named LLVM) = DarwinClangAssemblerProg -backendAssemblerProg (Named ViaC) = StandardAssemblerProg -backendAssemblerProg (Named JavaScript) = JSAssemblerProg -backendAssemblerProg (Named Interpreter) = StandardAssemblerProg -backendAssemblerProg (Named NoBackend) = StandardAssemblerProg - --- | This (defunctionalized) function is used to retrieve --- an enumeration value that characterizes the C/assembler --- part of a toolchain. The function caches the info in a --- mutable variable that is part of the `DynFlags`. --- --- The function's type is --- @ --- Logger -> DynFlags -> Platform -> IO CompilerInfo --- @ --- --- This field is usually defaulted. -backendAssemblerInfoGetter :: Backend -> DefunctionalizedAssemblerInfoGetter -backendAssemblerInfoGetter (Named NCG) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named LLVM) = DarwinClangAssemblerInfoGetter -backendAssemblerInfoGetter (Named ViaC) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named JavaScript) = JSAssemblerInfoGetter -backendAssemblerInfoGetter (Named Interpreter) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named NoBackend) = StandardAssemblerInfoGetter - -- | When using this back end, it may be necessary or -- advisable to pass some `-D` options to a C compiler. -- This (defunctionalized) function produces those ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -116,7 +116,6 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Trans.Reader (ReaderT) import Control.Monad.Trans.Writer (WriterT) -import Data.IORef import System.IO import System.IO.Error (catchIOError) import System.Environment (lookupEnv) @@ -420,15 +419,6 @@ data DynFlags = DynFlags { avx512pf :: Bool, -- Enable AVX-512 PreFetch Instructions. fma :: Bool, -- ^ Enable FMA instructions. - -- | Run-time linker information (what options we need, etc.) - rtldInfo :: IORef (Maybe LinkerInfo), - - -- | Run-time C compiler information - rtccInfo :: IORef (Maybe CompilerInfo), - - -- | Run-time assembler information - rtasmInfo :: IORef (Maybe CompilerInfo), - -- Constants used to control the amount of optimization done. -- | Max size, in bytes, of inline array allocations. @@ -490,9 +480,6 @@ class ContainsDynFlags t where initDynFlags :: DynFlags -> IO DynFlags initDynFlags dflags = do let - refRtldInfo <- newIORef Nothing - refRtccInfo <- newIORef Nothing - refRtasmInfo <- newIORef Nothing canUseUnicode <- do let enc = localeEncoding str = "‘’" (withCString enc str $ \cstr -> @@ -514,9 +501,6 @@ initDynFlags dflags = do useColor = useColor', canUseColor = stderrSupportsAnsiColors, colScheme = colScheme', - rtldInfo = refRtldInfo, - rtccInfo = refRtccInfo, - rtasmInfo = refRtasmInfo, tmpDir = TempDir tmp_dir } @@ -695,9 +679,6 @@ defaultDynFlags mySettings = avx512f = False, avx512pf = False, fma = False, - rtldInfo = panic "defaultDynFlags: no rtldInfo", - rtccInfo = panic "defaultDynFlags: no rtccInfo", - rtasmInfo = panic "defaultDynFlags: no rtasmInfo", maxInlineAllocSize = 128, maxInlineMemcpyInsns = 32, ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -109,9 +109,6 @@ module GHC.Driver.Main import GHC.Prelude -import GHC.Platform -import GHC.Platform.Ways - import GHC.Driver.Plugins import GHC.Driver.Session import GHC.Driver.Backend @@ -336,41 +333,11 @@ initHscEnv mb_top_dir = do mySettings <- initSysTools top_dir dflags <- initDynFlags (defaultDynFlags mySettings) hsc_env <- newHscEnv top_dir dflags - checkBrokenTablesNextToCode (hsc_logger hsc_env) dflags setUnsafeGlobalDynFlags dflags -- c.f. DynFlags.parseDynamicFlagsFull, which -- creates DynFlags and sets the UnsafeGlobalDynFlags return hsc_env --- | The binutils linker on ARM emits unnecessary R_ARM_COPY relocations which --- breaks tables-next-to-code in dynamically linked modules. This --- check should be more selective but there is currently no released --- version where this bug is fixed. --- See https://sourceware.org/bugzilla/show_bug.cgi?id=16177 and --- https://gitlab.haskell.org/ghc/ghc/issues/4210#note_78333 -checkBrokenTablesNextToCode :: Logger -> DynFlags -> IO () -checkBrokenTablesNextToCode logger dflags = do - let invalidLdErr = "Tables-next-to-code not supported on ARM \ - \when using binutils ld (please see: \ - \https://sourceware.org/bugzilla/show_bug.cgi?id=16177)" - broken <- checkBrokenTablesNextToCode' logger dflags - when broken (panic invalidLdErr) - -checkBrokenTablesNextToCode' :: Logger -> DynFlags -> IO Bool -checkBrokenTablesNextToCode' logger dflags - | not (isARM arch) = return False - | ways dflags `hasNotWay` WayDyn = return False - | not tablesNextToCode = return False - | otherwise = do - linkerInfo <- liftIO $ GHC.SysTools.getLinkerInfo logger dflags - case linkerInfo of - GnuLD _ -> return True - _ -> return False - where platform = targetPlatform dflags - arch = platformArch platform - tablesNextToCode = platformTablesNextToCode platform - - -- ----------------------------------------------------------------------------- getDiagnostics :: Hsc (Messages GhcMessage) ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -290,10 +290,6 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do let unit_env = hsc_unit_env hsc_env let platform = ue_platform unit_env - -- LLVM from version 3.0 onwards doesn't support the OS X system - -- assembler, so we use clang as the assembler instead. (#5636) - let as_prog = applyAssemblerProg $ backendAssemblerProg (backend dflags) - let cmdline_include_paths = includePaths dflags let pic_c_flags = picCCOpts dflags @@ -310,9 +306,8 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do includePathsQuoteImplicit cmdline_include_paths] let runAssembler inputFilename outputFilename = withAtomicRename outputFilename $ \temp_outputFilename -> - as_prog + runAs logger dflags - platform (local_includes ++ global_includes -- See Note [-fPIC for assembler] ++ map GHC.SysTools.Option pic_c_flags @@ -392,22 +387,6 @@ runForeignJsPhase pipe_env hsc_env _location input_fn = do embedJsFile logger dflags tmpfs unit_env input_fn output_fn return output_fn - -applyAssemblerProg - :: DefunctionalizedAssemblerProg - -> Logger -> DynFlags -> Platform -> [Option] -> IO () -applyAssemblerProg StandardAssemblerProg logger dflags _platform = - runAs logger dflags -applyAssemblerProg JSAssemblerProg logger dflags _platform = - runEmscripten logger dflags -applyAssemblerProg DarwinClangAssemblerProg logger dflags platform = - if platformOS platform == OSDarwin then - runClang logger dflags - else - runAs logger dflags - - - runCcPhase :: Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO FilePath runCcPhase cc_phase pipe_env hsc_env location input_fn = do let dflags = hsc_dflags hsc_env ===================================== compiler/GHC/Linker/ExtraObj.hs ===================================== @@ -12,7 +12,6 @@ module GHC.Linker.ExtraObj , mkNoteObjsToLinkIntoBinary , checkLinkInfo , getLinkInfo - , getCompilerInfo , ghcLinkInfoSectionName , ghcLinkInfoNoteName , platformSupportsSavingLinkOpts @@ -40,10 +39,8 @@ import qualified GHC.Data.ShortText as ST import GHC.SysTools.Elf import GHC.SysTools.Tasks -import GHC.SysTools.Info import GHC.Linker.Unit -import Control.Monad.IO.Class import Control.Monad import Data.Maybe @@ -52,7 +49,6 @@ mkExtraObj logger tmpfs dflags unit_state extn xs = do cFile <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule extn oFile <- newTempName logger tmpfs (tmpDir dflags) TFL_GhcSession "o" writeFile cFile xs - ccInfo <- liftIO $ getCompilerInfo logger dflags runCc Nothing logger tmpfs dflags ([Option "-c", FileOption "" cFile, @@ -60,7 +56,7 @@ mkExtraObj logger tmpfs dflags unit_state extn xs FileOption "" oFile] ++ if extn /= "s" then cOpts - else asmOpts ccInfo) + else []) return oFile where -- Pass a different set of options to the C compiler depending one whether @@ -70,14 +66,6 @@ mkExtraObj logger tmpfs dflags unit_state extn xs ++ map (FileOption "-I" . ST.unpack) (unitIncludeDirs $ unsafeLookupUnit unit_state rtsUnit) - -- When compiling assembler code, we drop the usual C options, and if the - -- compiler is Clang, we add an extra argument to tell Clang to ignore - -- unused command line options. See trac #11684. - asmOpts ccInfo = - if any (ccInfo ==) [Clang, AppleClang, AppleClang51] - then [Option "-Qunused-arguments"] - else [] - -- When linking a binary, we need to create a C main() function that -- starts everything off. This used to be compiled statically as part -- of the RTS, but that made it hard to change the -rtsopts setting, ===================================== compiler/GHC/SysTools.hs ===================================== @@ -17,7 +17,6 @@ module GHC.SysTools ( -- * Interface to system tools module GHC.SysTools.Tasks, - module GHC.SysTools.Info, -- * Fast file copy copyFile, @@ -35,8 +34,6 @@ import GHC.Prelude import GHC.Utils.Panic import GHC.Driver.Session -import GHC.Linker.ExtraObj -import GHC.SysTools.Info import GHC.SysTools.Tasks import GHC.SysTools.BaseDir import GHC.Settings.IO ===================================== compiler/GHC/SysTools/Info.hs deleted ===================================== @@ -1,243 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} ------------------------------------------------------------------------------ --- --- Compiler information functions --- --- (c) The GHC Team 2017 --- ------------------------------------------------------------------------------ -module GHC.SysTools.Info where - -import GHC.Utils.Exception -import GHC.Utils.Error -import GHC.Driver.Session -import GHC.Utils.Outputable -import GHC.Utils.Misc -import GHC.Utils.Logger - -import Data.List ( isInfixOf, isPrefixOf ) -import Data.IORef - -import System.IO - -import GHC.Platform -import GHC.Prelude - -import GHC.SysTools.Process - -{- Note [Run-time linker info] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~ -See also: #5240, #6063, #10110 - -Before 'runLink', we need to be sure to get the relevant information -about the linker we're using at runtime to see if we need any extra -options. - -Generally, the linker changing from what was detected at ./configure -time has always been possible using -pgml, but on Linux it can happen -'transparently' by installing packages like binutils-gold, which -change what /usr/bin/ld actually points to. - -Clang vs GCC notes: - -For gcc, 'gcc -Wl,--version' gives a bunch of output about how to -invoke the linker before the version information string. For 'clang', -the version information for 'ld' is all that's output. For this -reason, we typically need to slurp up all of the standard error output -and look through it. - -Other notes: - -We cache the LinkerInfo inside DynFlags, since clients may link -multiple times. The definition of LinkerInfo is there to avoid a -circular dependency. - --} - -{- Note [ELF needed shared libs] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Some distributions change the link editor's default handling of -ELF DT_NEEDED tags to include only those shared objects that are -needed to resolve undefined symbols. For Template Haskell we need -the last temporary shared library also if it is not needed for the -currently linked temporary shared library. We specify --no-as-needed -to override the default. This flag exists in GNU ld and GNU gold. - -The flag is only needed on ELF systems. On Windows (PE) and Mac OS X -(Mach-O) the flag is not needed. - --} - -neededLinkArgs :: LinkerInfo -> [Option] -neededLinkArgs (GnuLD o) = o -neededLinkArgs (Mold o) = o -neededLinkArgs (GnuGold o) = o -neededLinkArgs (LlvmLLD o) = o -neededLinkArgs (DarwinLD o) = o -neededLinkArgs (SolarisLD o) = o -neededLinkArgs (AixLD o) = o -neededLinkArgs UnknownLD = [] - --- Grab linker info and cache it in DynFlags. -getLinkerInfo :: Logger -> DynFlags -> IO LinkerInfo -getLinkerInfo logger dflags = do - info <- readIORef (rtldInfo dflags) - case info of - Just v -> return v - Nothing -> do - v <- getLinkerInfo' logger dflags - writeIORef (rtldInfo dflags) (Just v) - return v - --- See Note [Run-time linker info]. -getLinkerInfo' :: Logger -> DynFlags -> IO LinkerInfo -getLinkerInfo' logger dflags = do - let platform = targetPlatform dflags - os = platformOS platform - (pgm,args0) = pgm_l dflags - args1 = map Option (getOpts dflags opt_l) - args2 = args0 ++ args1 - args3 = filter notNull (map showOpt args2) - - -- Try to grab the info from the process output. - parseLinkerInfo stdo _stde _exitc - | any ("GNU ld" `isPrefixOf`) stdo = - -- Set DT_NEEDED for all shared libraries. #10110. - return (GnuLD $ map Option [-- ELF specific flag - -- 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] - return (GnuGold [Option "-Wl,--no-as-needed"]) - - | any (\line -> "LLD" `isPrefixOf` line || "LLD" `elem` words line) stdo = - return (LlvmLLD $ map Option [ --see Note [ELF needed shared libs] - "-Wl,--no-as-needed" | osElfTarget os || os == OSMinGW32 ]) - - -- Unknown linker. - | otherwise = fail "invalid --version output, or linker is unsupported" - - -- Process the executable call - catchIO ( - case os of - OSSolaris2 -> - -- Solaris uses its own Solaris linker. Even all - -- GNU C are recommended to configure with Solaris - -- linker instead of using GNU binutils linker. Also - -- all GCC distributed with Solaris follows this rule - -- precisely so we assume here, the Solaris linker is - -- used. - return $ SolarisLD [] - OSAIX -> - -- IBM AIX uses its own non-binutils linker as well - return $ AixLD [] - OSDarwin -> - -- Darwin has neither GNU Gold or GNU LD, but a strange linker - -- that doesn't support --version. We can just assume that's - -- what we're using. - return $ DarwinLD [] - OSMinGW32 -> - -- GHC doesn't support anything but GNU ld on Windows anyway. - -- Process creation is also fairly expensive on win32, so - -- we short-circuit here. - return $ GnuLD $ map Option - [ -- Emit stack checks - -- See Note [Windows stack allocations] - "-fstack-check" - ] - _ -> do - -- In practice, we use the compiler as the linker here. Pass - -- -Wl,--version to get linker version info. - (exitc, stdo, stde) <- readProcessEnvWithExitCode pgm - (["-Wl,--version"] ++ args3) - c_locale_env - -- Split the output by lines to make certain kinds - -- of processing easier. In particular, 'clang' and 'gcc' - -- have slightly different outputs for '-Wl,--version', but - -- it's still easy to figure out. - parseLinkerInfo (lines stdo) (lines stde) exitc - ) - (\err -> do - debugTraceMsg logger 2 - (text "Error (figuring out linker information):" <+> - text (show err)) - errorMsg logger $ hang (text "Warning:") 9 $ - text "Couldn't figure out linker information!" $$ - text "Make sure you're using GNU ld, GNU gold" <+> - text "or the built in OS X linker, etc." - return UnknownLD - ) - --- | Grab compiler info and cache it in DynFlags. -getCompilerInfo :: Logger -> DynFlags -> IO CompilerInfo -getCompilerInfo logger dflags = do - info <- readIORef (rtccInfo dflags) - case info of - Just v -> return v - Nothing -> do - let pgm = pgm_c dflags - v <- getCompilerInfo' logger pgm - writeIORef (rtccInfo dflags) (Just v) - return v - --- | Grab assembler info and cache it in DynFlags. -getAssemblerInfo :: Logger -> DynFlags -> IO CompilerInfo -getAssemblerInfo logger dflags = do - info <- readIORef (rtasmInfo dflags) - case info of - Just v -> return v - Nothing -> do - let (pgm, _) = pgm_a dflags - v <- getCompilerInfo' logger pgm - writeIORef (rtasmInfo dflags) (Just v) - return v - --- See Note [Run-time linker info]. -getCompilerInfo' :: Logger -> String -> IO CompilerInfo -getCompilerInfo' logger pgm = do - let -- Try to grab the info from the process output. - parseCompilerInfo _stdo stde _exitc - -- Regular GCC - | any ("gcc version" `isInfixOf`) stde = - return GCC - -- Regular clang - | any ("clang version" `isInfixOf`) stde = - return Clang - -- FreeBSD clang - | any ("FreeBSD clang version" `isInfixOf`) stde = - return Clang - -- Xcode 5.1 clang - | any ("Apple LLVM version 5.1" `isPrefixOf`) stde = - return AppleClang51 - -- Xcode 5 clang - | any ("Apple LLVM version" `isPrefixOf`) stde = - return AppleClang - -- Xcode 4.1 clang - | any ("Apple clang version" `isPrefixOf`) stde = - return AppleClang - -- Unknown compiler. - | otherwise = fail $ "invalid -v output, or compiler is unsupported (" ++ pgm ++ "): " ++ unlines stde - - -- Process the executable call - catchIO (do - (exitc, stdo, stde) <- - readProcessEnvWithExitCode pgm ["-v"] c_locale_env - -- Split the output by lines to make certain kinds - -- of processing easier. - parseCompilerInfo (lines stdo) (lines stde) exitc - ) - (\err -> do - debugTraceMsg logger 2 - (text "Error (figuring out C compiler information):" <+> - text (show err)) - errorMsg logger $ hang (text "Warning:") 9 $ - text "Couldn't figure out C compiler information!" $$ - text "Make sure you're using GNU gcc, or clang" - return UnknownCC - ) ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -19,7 +19,6 @@ import GHC.CmmToLlvm.Config (LlvmVersion, llvmVersionStr, supportedLlvmVersionUp import GHC.Settings import GHC.SysTools.Process -import GHC.SysTools.Info import GHC.Driver.Session @@ -278,15 +277,12 @@ figureLlvmVersion logger dflags = traceSystoolCommand logger "llc" $ do runLink :: Logger -> TmpFs -> DynFlags -> [Option] -> IO () runLink logger tmpfs dflags args = traceSystoolCommand logger "linker" $ do - -- See Note [Run-time linker info] - -- -- `-optl` args come at the end, so that later `-l` options -- given there manually can fill in symbols needed by -- Haskell libraries coming in via `args`. - linkargs <- neededLinkArgs `fmap` getLinkerInfo logger dflags let (p,args0) = pgm_l dflags optl_args = map Option (getOpts dflags opt_l) - args2 = args0 ++ linkargs ++ args ++ optl_args + args2 = args0 ++ args ++ optl_args mb_env <- getGccEnv args2 runSomethingResponseFile logger tmpfs dflags ld_filter "Linker" p args2 mb_env where ===================================== compiler/ghc.cabal.in ===================================== @@ -712,7 +712,6 @@ Library GHC.SysTools.BaseDir GHC.SysTools.Cpp GHC.SysTools.Elf - GHC.SysTools.Info GHC.SysTools.Process GHC.SysTools.Tasks GHC.SysTools.Terminal ===================================== m4/fp_link_supports_no_as_needed.m4 ===================================== @@ -0,0 +1,33 @@ +# FP_LINK_SUPPORTS_NO_AS_NEEDED +# ---------------------------------- +# Set the Cc linker flag -Wl,--no-as-needed if it is supported +# $1 is the name of the linker flags variable when linking with gcc +# See also Note [ELF needed shared libs] +AC_DEFUN([FP_LINK_SUPPORTS_NO_AS_NEEDED], +[ + AC_MSG_CHECKING([whether Cc linker supports -Wl,--no-as-needed]) + echo 'int f(int a) {return 2*a;}' > conftest.a.c + echo 'int f(int a); int main(int argc, char **argv) {return f(0);}' > conftest.b.c + $CC -c -o conftest.a.o conftest.a.c > /dev/null 2>&1 + $CC -c -o conftest.b.o conftest.b.c > /dev/null 2>&1 + if "$CC" "$$1" -Wl,--no-as-needed -o conftest conftest.a.o conftest.b.o > /dev/null 2>&1 + then + $1="$$1 -Wl,--no-as-needed" + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + fi + rm -f conftest* +]) + +# Note [ELF needed shared libs] +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# Some distributions change the link editor's default handling of +# ELF DT_NEEDED tags to include only those shared objects that are +# needed to resolve undefined symbols. For Template Haskell we need +# the last temporary shared library also if it is not needed for the +# currently linked temporary shared library. We specify --no-as-needed +# to override the default. This flag exists in GNU ld and GNU gold. +# +# The flag is only needed on ELF systems. On Windows (PE) and Mac OS X +# (Mach-O) the flag is not needed. ===================================== m4/fptools_set_c_ld_flags.m4 ===================================== @@ -17,9 +17,19 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS], ;; esac + # See Note [ELF needed shared libs] + case $$1 in + *-linux|*-freebsd*) + FP_LINK_SUPPORTS_NO_AS_NEEDED([$3]) + ;; + esac + case $$1 in i386-unknown-mingw32) $2="$$2 -march=i686" + # Emit stack checks + # See Note [Windows stack allocations] + $3="$$3 -fstack-check" ;; i386-portbld-freebsd*) $2="$$2 -march=i686" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/26101e4c7b2bacddafdc3897dcf1d60e562f8c0d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/26101e4c7b2bacddafdc3897dcf1d60e562f8c0d You're receiving 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 Jun 26 16:51:23 2023 From: gitlab at gitlab.haskell.org (Torsten Schmits (@torsten.schmits)) Date: Mon, 26 Jun 2023 12:51:23 -0400 Subject: [Git][ghc/ghc][wip/torsten.schmits/16468] Relax defaulting of RuntimeRep/Levity when printing Message-ID: <6499c20ba1fac_2402e0c754c59997@gitlab.mail> Torsten Schmits pushed to branch wip/torsten.schmits/16468 at Glasgow Haskell Compiler / GHC Commits: b4923d3e by Torsten Schmits at 2023-06-26T18:51:16+02:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 5 changed files: - compiler/GHC/Iface/Type.hs - compiler/GHC/Types/Unique/DFM.hs - + testsuite/tests/ghci/scripts/T16468.script - + testsuite/tests/ghci/scripts/T16468.stdout - testsuite/tests/ghci/scripts/all.T Changes: ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -987,7 +987,7 @@ ppr_ty ctxt_prec ty@(IfaceFunTy af w ty1 ty2) -- Should be a visible argument | isVisibleFunArg af = (pprTypeArrow af wthis <+> ppr_ty funPrec ty1) : ppr_fun_tail wnext ty2 ppr_fun_tail wthis other_ty - = [pprTypeArrow af wthis <+> pprIfaceType other_ty] + = [pprTypeArrow af wthis <+> ppr_ty topPrec other_ty] ppr_ty ctxt_prec (IfaceAppTy t ts) = if_print_coercions @@ -1044,9 +1044,11 @@ Haskell programs, so it makes little sense to make all users pay this syntactic overhead. For this reason it was decided that we would hide RuntimeRep variables -for now (see #11549). We do this by defaulting all type variables of -kind RuntimeRep to LiftedRep. -Likewise, we default all Multiplicity variables to Many. +for now (see #11549). We do this right in the pretty-printer, by pre-processing +the type we are about to print, to default any type variables of kind RuntimeRep +that are bound by toplevel invisible quantification to LiftedRep. +Likewise, we default Multiplicity variables to Many and Levity variables to +Lifted. This is done in a pass right before pretty-printing (defaultIfaceTyVarsOfKind, controlled by @@ -1073,6 +1075,22 @@ metavariables are converted, skolem variables are not. There's one exception though: TyVarTv metavariables should not be defaulted, as they appear during kind-checking of "newtype T :: TYPE r where..." (test T18357a). Therefore, we additionally test for isTyConableTyVar. + +Wrinkles: + +(W1) The loop 'go' in 'defaultIfaceTyVarsOfKind' passes a Bool flag, 'rank1', + around that indicates whether we haven't yet descended into the arguments + of a function type. + This is used to decide whether newly bound variables are eligible for + defaulting – we do not want contravariant foralls to be defaulted because + that would result in an incorrect, rather than specialized, type. + For example: + ∀ p (r1 :: RuntimeRep) . (∀ (r2 :: RuntimeRep) . p r2) -> p r1 + We want to default 'r1', but not 'r2'. + When examining the first forall, 'rank1' is True. + The toplevel function type is matched as IfaceFunTy, where we recurse into + 'go' by passing False for 'rank1'. + The forall in the first argument then skips adding a substitution for 'r2'. -} -- | Default 'RuntimeRep' variables to 'LiftedRep', @@ -1097,28 +1115,30 @@ as they appear during kind-checking of "newtype T :: TYPE r where..." defaultIfaceTyVarsOfKind :: Bool -- ^ default 'RuntimeRep'/'Levity' variables? -> Bool -- ^ default 'Multiplicity' variables? -> IfaceType -> IfaceType -defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv ty +defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv True ty where go :: FastStringEnv IfaceType -- Set of enclosing forall-ed RuntimeRep/Levity/Multiplicity variables + -> Bool -- Are we in a toplevel forall, where defaulting is allowed for RR/L? -> IfaceType -> IfaceType - go subs (IfaceForAllTy (Bndr (IfaceTvBndr (var, var_kind)) argf) ty) + go subs rank1 (IfaceForAllTy (Bndr (IfaceTvBndr (var, var_kind)) argf) ty) | isInvisibleForAllTyFlag argf -- Don't default *visible* quantification -- or we get the mess in #13963 + , rank1 , Just substituted_ty <- check_substitution var_kind = let subs' = extendFsEnv subs var substituted_ty -- Record that we should replace it with LiftedRep/Lifted/Many, -- and recurse, discarding the forall - in go subs' ty + in go subs' rank1 ty - go subs (IfaceForAllTy bndr ty) - = IfaceForAllTy (go_ifacebndr subs bndr) (go subs ty) + go subs rank1 (IfaceForAllTy bndr ty) + = IfaceForAllTy (go_ifacebndr subs rank1 bndr) (go subs rank1 ty) - go subs ty@(IfaceTyVar tv) = case lookupFsEnv subs tv of + go subs _ ty@(IfaceTyVar tv) = case lookupFsEnv subs tv of Just s -> s Nothing -> ty - go _ ty@(IfaceFreeTyVar tv) + go _ _ ty@(IfaceFreeTyVar tv) -- See Note [Defaulting RuntimeRep variables], about free vars | def_rep , GHC.Core.Type.isRuntimeRepTy (tyVarKind tv) @@ -1138,34 +1158,34 @@ defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv ty | otherwise = ty - go subs (IfaceTyConApp tc tc_args) - = IfaceTyConApp tc (go_args subs tc_args) + go subs rank1 (IfaceTyConApp tc tc_args) + = IfaceTyConApp tc (go_args subs rank1 tc_args) - go subs (IfaceTupleTy sort is_prom tc_args) - = IfaceTupleTy sort is_prom (go_args subs tc_args) + go subs rank1 (IfaceTupleTy sort is_prom tc_args) + = IfaceTupleTy sort is_prom (go_args subs rank1 tc_args) - go subs (IfaceFunTy af w arg res) - = IfaceFunTy af (go subs w) (go subs arg) (go subs res) + go subs rank1 (IfaceFunTy af w arg res) + = IfaceFunTy af (go subs rank1 w) (go subs False arg) (go subs rank1 res) - go subs (IfaceAppTy t ts) - = IfaceAppTy (go subs t) (go_args subs ts) + go subs rank1 (IfaceAppTy t ts) + = IfaceAppTy (go subs rank1 t) (go_args subs rank1 ts) - go subs (IfaceCastTy x co) - = IfaceCastTy (go subs x) co + go subs rank1 (IfaceCastTy x co) + = IfaceCastTy (go subs rank1 x) co - go _ ty@(IfaceLitTy {}) = ty - go _ ty@(IfaceCoercionTy {}) = ty + go _ _ ty@(IfaceLitTy {}) = ty + go _ _ ty@(IfaceCoercionTy {}) = ty - go_ifacebndr :: FastStringEnv IfaceType -> IfaceForAllBndr -> IfaceForAllBndr - go_ifacebndr subs (Bndr (IfaceIdBndr (w, n, t)) argf) - = Bndr (IfaceIdBndr (w, n, go subs t)) argf - go_ifacebndr subs (Bndr (IfaceTvBndr (n, t)) argf) - = Bndr (IfaceTvBndr (n, go subs t)) argf + go_ifacebndr :: FastStringEnv IfaceType -> Bool -> IfaceForAllBndr -> IfaceForAllBndr + go_ifacebndr subs rank1 (Bndr (IfaceIdBndr (w, n, t)) argf) + = Bndr (IfaceIdBndr (w, n, go subs rank1 t)) argf + go_ifacebndr subs rank1 (Bndr (IfaceTvBndr (n, t)) argf) + = Bndr (IfaceTvBndr (n, go subs rank1 t)) argf - go_args :: FastStringEnv IfaceType -> IfaceAppArgs -> IfaceAppArgs - go_args _ IA_Nil = IA_Nil - go_args subs (IA_Arg ty argf args) - = IA_Arg (go subs ty) argf (go_args subs args) + go_args :: FastStringEnv IfaceType -> Bool -> IfaceAppArgs -> IfaceAppArgs + go_args _ _ IA_Nil = IA_Nil + go_args subs rank1 (IA_Arg ty argf args) + = IA_Arg (go subs rank1 ty) argf (go_args subs rank1 args) check_substitution :: IfaceType -> Maybe IfaceType check_substitution (IfaceTyConApp tc _) @@ -1367,7 +1387,7 @@ ppr_sigma show_forall ctxt_prec iface_ty -- Then it could handle both invisible and required binders, and -- splitIfaceReqForallTy wouldn't be necessary here. in ppr_iface_forall_part show_forall invis_tvs theta $ - sep [pprIfaceForAll req_tvs, ppr tau'] + sep [pprIfaceForAll req_tvs, ppr_ty topPrec tau'] pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc pprUserIfaceForAll tvs ===================================== compiler/GHC/Types/Unique/DFM.hs ===================================== @@ -94,7 +94,7 @@ import qualified Data.IntSet as I -- order then `udfmToList` returns them in deterministic order. -- -- There is an implementation cost: each element is given a serial number --- as it is added, and `udfmToList` sorts it's result by this serial +-- as it is added, and `udfmToList` sorts its result by this serial -- number. So you should only use `UniqDFM` if you need the deterministic -- property. -- ===================================== testsuite/tests/ghci/scripts/T16468.script ===================================== @@ -0,0 +1,39 @@ +:set -XLinearTypes +import GHC.Types (RuntimeRep (..), Levity (..), TYPE, Multiplicity) +import Data.Proxy + +f :: forall p (r' :: RuntimeRep). (forall (r :: RuntimeRep). Int -> p r) -> p r'; f x = x 5 +g :: forall p. Int -> forall (r :: RuntimeRep). p r; g _ = undefined +g' :: Int -> forall p (r :: RuntimeRep). p r; g' _ = undefined +h :: Int -> forall (r :: RuntimeRep). TYPE r; h _ = undefined +i :: forall (r :: RuntimeRep). Int -> TYPE r; i _ = undefined +j :: forall p. Eq (p ('BoxedRep 'Lifted)) => Int -> forall (r :: RuntimeRep). p r; j _ = undefined +k :: forall p (r' :: RuntimeRep). Eq (p r') => (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) -> p r'; k x = x 5 +class C a where l :: forall (r :: RuntimeRep) (b :: TYPE r). a -> b +m :: (forall (m :: Multiplicity). Int %m -> Int) -> Int; m x = x 5 +n :: forall (m :: Multiplicity). Int %m -> Int; n a = a +:set -XNoLinearTypes + +:type f +:type g +:type g' +:type h +:type i +:type j +:type k +:type l +:type m +:type n + +:set -fprint-explicit-runtime-reps +:set -XLinearTypes +:type f +:type g +:type g' +:type h +:type i +:type j +:type k +:type l +:type m +:type n ===================================== testsuite/tests/ghci/scripts/T16468.stdout ===================================== @@ -0,0 +1,25 @@ +f :: (forall (r :: RuntimeRep). Int -> p r) + -> p GHC.Types.LiftedRep +g :: Int -> p GHC.Types.LiftedRep +g' :: Int -> forall (p :: RuntimeRep -> *). p GHC.Types.LiftedRep +h :: Int -> * +i :: Int -> * +j :: Eq (p GHC.Types.LiftedRep) => Int -> p GHC.Types.LiftedRep +k :: Eq (p GHC.Types.LiftedRep) => + (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) + -> p GHC.Types.LiftedRep +l :: C a => a -> b +m :: (forall (m :: Multiplicity). Int %m -> Int) -> Int +n :: Int -> Int +f :: (forall (r :: RuntimeRep). Int -> p r) -> p r' +g :: Int -> forall (r :: RuntimeRep). p r +g' :: Int -> forall (p :: RuntimeRep -> *) (r :: RuntimeRep). p r +h :: Int -> forall (r :: RuntimeRep). TYPE r +i :: Int -> TYPE r +j :: Eq (p GHC.Types.LiftedRep) => + Int -> forall (r :: RuntimeRep). p r +k :: Eq (p r') => + (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) -> p r' +l :: forall a (r :: RuntimeRep) (b :: TYPE r). C a => a -> b +m :: (forall (m :: Multiplicity). Int %m -> Int) -> Int +n :: Int %m -> Int ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -375,3 +375,4 @@ test('T22695', normal, ghci_script, ['T22695.script']) test('T22817', normal, ghci_script, ['T22817.script']) test('T22908', normal, ghci_script, ['T22908.script']) test('T23062', normal, ghci_script, ['T23062.script']) +test('T16468', normal, ghci_script, ['T16468.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b4923d3e3ce0ba4b3d3a3fb68d770ceb423b819c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b4923d3e3ce0ba4b3d3a3fb68d770ceb423b819c You're receiving 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 Jun 26 16:55:19 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 12:55:19 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 13 commits: Rip out runtime linker/compiler checks Message-ID: <6499c2f7307f3_2402e0c757460374@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 9a1e50f0 by Ben Gamari at 2023-06-26T17:54:29+01:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC. As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Co-author: Rodrigo Mesquita (@alt-romes) - - - - - c05b843f by Ben Gamari at 2023-06-26T17:54:29+01:00 configure: Rip out toolchain selection logic - - - - - a8c95c1e by Rodrigo Mesquita at 2023-06-26T17:55:04+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b480f4ab1514ac0a4fc957db199d1a0279. Revert get_arm_isa deletion from 74f03f243d08aa910d39cdd9dadb976e9386283a As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples - - - - - 708f7170 by Rodrigo Mesquita at 2023-06-26T17:55:06+01:00 configure: Revert ripping out of toolchain selection logic - - - - - 492e9ed0 by Rodrigo Mesquita at 2023-06-26T17:55:06+01:00 Stop configuring into settings unused Ld command - - - - - b994a16a by Rodrigo Mesquita at 2023-06-26T17:55:06+01:00 configure: Create and validate toolchain target file - - - - - 8c74637a by Rodrigo Mesquita at 2023-06-26T17:55:06+01:00 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now - - - - - e1dd7823 by Rodrigo Mesquita at 2023-06-26T17:55:06+01:00 ghc-toolchain: set CC LD plat. dependent flags A lot to be said about this approach, we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? - - - - - b62c7354 by Rodrigo Mesquita at 2023-06-26T17:55:06+01:00 ghc-toolchain: Create default.target in the bindist - - - - - 19aef2b4 by Rodrigo Mesquita at 2023-06-26T17:55:06+01:00 A TODO comment - - - - - 7b37c2f4 by Rodrigo Mesquita at 2023-06-26T17:55:06+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - 3b979cd0 by Rodrigo Mesquita at 2023-06-26T17:55:06+01:00 Use ghc-platform instead of ghc-boot del async dep - - - - - 4039a8d3 by Rodrigo Mesquita at 2023-06-26T17:55:06+01:00 Fixes - - - - - 30 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/SysTools.hs - − compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - compiler/ghc.cabal.in - configure.ac - + default.target.in - distrib/configure.ac.in - ghc/Main.hs - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1ef2030147c03de2546141fb3d2697e25c1aa6fb...4039a8d30c7c9e1ab41f9208c02e782486ec1dff -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1ef2030147c03de2546141fb3d2697e25c1aa6fb...4039a8d30c7c9e1ab41f9208c02e782486ec1dff You're receiving 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 Jun 26 17:04:51 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 13:04:51 -0400 Subject: [Git][ghc/ghc][wip/romes/remove-toolchain-runtime-config] Rip out runtime linker/compiler checks Message-ID: <6499c533be686_2402e0c7538629fb@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/remove-toolchain-runtime-config at Glasgow Haskell Compiler / GHC Commits: b1213d01 by Ben Gamari at 2023-06-26T18:04:36+01:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 11 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/SysTools.hs - − compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - compiler/ghc.cabal.in - + m4/fp_link_supports_no_as_needed.m4 - m4/fptools_set_c_ld_flags.m4 Changes: ===================================== compiler/GHC/Driver/Backend.hs ===================================== @@ -58,8 +58,6 @@ module GHC.Driver.Backend , DefunctionalizedCodeOutput(..) -- *** Back-end functions for assembly , DefunctionalizedPostHscPipeline(..) - , DefunctionalizedAssemblerProg(..) - , DefunctionalizedAssemblerInfoGetter(..) -- *** Other back-end functions , DefunctionalizedCDefs(..) -- ** Names of back ends (for API clients of version 9.4 or earlier) @@ -94,8 +92,6 @@ module GHC.Driver.Backend , backendSupportsHpc , backendSupportsCImport , backendSupportsCExport - , backendAssemblerProg - , backendAssemblerInfoGetter , backendCDefs , backendCodeOutput , backendUseJSLinker @@ -348,40 +344,6 @@ data PrimitiveImplementation deriving Show --- | Names a function that runs the assembler, of this type: --- --- > Logger -> DynFlags -> Platform -> [Option] -> IO () --- --- The functions so named are defined in "GHC.Driver.Pipeline.Execute". - -data DefunctionalizedAssemblerProg - = StandardAssemblerProg - -- ^ Use the standard system assembler - | JSAssemblerProg - -- ^ JS Backend compile to JS via Stg, and so does not use any assembler - | DarwinClangAssemblerProg - -- ^ If running on Darwin, use the assembler from the @clang@ - -- toolchain. Otherwise use the standard system assembler. - - - --- | Names a function that discover from what toolchain the assembler --- is coming, of this type: --- --- > Logger -> DynFlags -> Platform -> IO CompilerInfo --- --- The functions so named are defined in "GHC.Driver.Pipeline.Execute". - -data DefunctionalizedAssemblerInfoGetter - = StandardAssemblerInfoGetter - -- ^ Interrogate the standard system assembler - | JSAssemblerInfoGetter - -- ^ If using the JS backend; return 'Emscripten' - | DarwinClangAssemblerInfoGetter - -- ^ If running on Darwin, return `Clang`; otherwise - -- interrogate the standard system assembler. - - -- | Names a function that generates code and writes the results to a -- file, of this type: -- @@ -770,45 +732,6 @@ backendSupportsCExport (Named JavaScript) = True backendSupportsCExport (Named Interpreter) = False backendSupportsCExport (Named NoBackend) = True --- | This (defunctionalized) function runs the assembler --- used on the code that is written by this back end. A --- program determined by a combination of back end, --- `DynFlags`, and `Platform` is run with the given --- `Option`s. --- --- The function's type is --- @ --- Logger -> DynFlags -> Platform -> [Option] -> IO () --- @ --- --- This field is usually defaulted. -backendAssemblerProg :: Backend -> DefunctionalizedAssemblerProg -backendAssemblerProg (Named NCG) = StandardAssemblerProg -backendAssemblerProg (Named LLVM) = DarwinClangAssemblerProg -backendAssemblerProg (Named ViaC) = StandardAssemblerProg -backendAssemblerProg (Named JavaScript) = JSAssemblerProg -backendAssemblerProg (Named Interpreter) = StandardAssemblerProg -backendAssemblerProg (Named NoBackend) = StandardAssemblerProg - --- | This (defunctionalized) function is used to retrieve --- an enumeration value that characterizes the C/assembler --- part of a toolchain. The function caches the info in a --- mutable variable that is part of the `DynFlags`. --- --- The function's type is --- @ --- Logger -> DynFlags -> Platform -> IO CompilerInfo --- @ --- --- This field is usually defaulted. -backendAssemblerInfoGetter :: Backend -> DefunctionalizedAssemblerInfoGetter -backendAssemblerInfoGetter (Named NCG) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named LLVM) = DarwinClangAssemblerInfoGetter -backendAssemblerInfoGetter (Named ViaC) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named JavaScript) = JSAssemblerInfoGetter -backendAssemblerInfoGetter (Named Interpreter) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named NoBackend) = StandardAssemblerInfoGetter - -- | When using this back end, it may be necessary or -- advisable to pass some `-D` options to a C compiler. -- This (defunctionalized) function produces those ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -116,7 +116,6 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Trans.Reader (ReaderT) import Control.Monad.Trans.Writer (WriterT) -import Data.IORef import System.IO import System.IO.Error (catchIOError) import System.Environment (lookupEnv) @@ -420,15 +419,6 @@ data DynFlags = DynFlags { avx512pf :: Bool, -- Enable AVX-512 PreFetch Instructions. fma :: Bool, -- ^ Enable FMA instructions. - -- | Run-time linker information (what options we need, etc.) - rtldInfo :: IORef (Maybe LinkerInfo), - - -- | Run-time C compiler information - rtccInfo :: IORef (Maybe CompilerInfo), - - -- | Run-time assembler information - rtasmInfo :: IORef (Maybe CompilerInfo), - -- Constants used to control the amount of optimization done. -- | Max size, in bytes, of inline array allocations. @@ -490,9 +480,6 @@ class ContainsDynFlags t where initDynFlags :: DynFlags -> IO DynFlags initDynFlags dflags = do let - refRtldInfo <- newIORef Nothing - refRtccInfo <- newIORef Nothing - refRtasmInfo <- newIORef Nothing canUseUnicode <- do let enc = localeEncoding str = "‘’" (withCString enc str $ \cstr -> @@ -514,9 +501,6 @@ initDynFlags dflags = do useColor = useColor', canUseColor = stderrSupportsAnsiColors, colScheme = colScheme', - rtldInfo = refRtldInfo, - rtccInfo = refRtccInfo, - rtasmInfo = refRtasmInfo, tmpDir = TempDir tmp_dir } @@ -695,9 +679,6 @@ defaultDynFlags mySettings = avx512f = False, avx512pf = False, fma = False, - rtldInfo = panic "defaultDynFlags: no rtldInfo", - rtccInfo = panic "defaultDynFlags: no rtccInfo", - rtasmInfo = panic "defaultDynFlags: no rtasmInfo", maxInlineAllocSize = 128, maxInlineMemcpyInsns = 32, ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -109,9 +109,6 @@ module GHC.Driver.Main import GHC.Prelude -import GHC.Platform -import GHC.Platform.Ways - import GHC.Driver.Plugins import GHC.Driver.Session import GHC.Driver.Backend @@ -336,41 +333,11 @@ initHscEnv mb_top_dir = do mySettings <- initSysTools top_dir dflags <- initDynFlags (defaultDynFlags mySettings) hsc_env <- newHscEnv top_dir dflags - checkBrokenTablesNextToCode (hsc_logger hsc_env) dflags setUnsafeGlobalDynFlags dflags -- c.f. DynFlags.parseDynamicFlagsFull, which -- creates DynFlags and sets the UnsafeGlobalDynFlags return hsc_env --- | The binutils linker on ARM emits unnecessary R_ARM_COPY relocations which --- breaks tables-next-to-code in dynamically linked modules. This --- check should be more selective but there is currently no released --- version where this bug is fixed. --- See https://sourceware.org/bugzilla/show_bug.cgi?id=16177 and --- https://gitlab.haskell.org/ghc/ghc/issues/4210#note_78333 -checkBrokenTablesNextToCode :: Logger -> DynFlags -> IO () -checkBrokenTablesNextToCode logger dflags = do - let invalidLdErr = "Tables-next-to-code not supported on ARM \ - \when using binutils ld (please see: \ - \https://sourceware.org/bugzilla/show_bug.cgi?id=16177)" - broken <- checkBrokenTablesNextToCode' logger dflags - when broken (panic invalidLdErr) - -checkBrokenTablesNextToCode' :: Logger -> DynFlags -> IO Bool -checkBrokenTablesNextToCode' logger dflags - | not (isARM arch) = return False - | ways dflags `hasNotWay` WayDyn = return False - | not tablesNextToCode = return False - | otherwise = do - linkerInfo <- liftIO $ GHC.SysTools.getLinkerInfo logger dflags - case linkerInfo of - GnuLD _ -> return True - _ -> return False - where platform = targetPlatform dflags - arch = platformArch platform - tablesNextToCode = platformTablesNextToCode platform - - -- ----------------------------------------------------------------------------- getDiagnostics :: Hsc (Messages GhcMessage) ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -290,10 +290,6 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do let unit_env = hsc_unit_env hsc_env let platform = ue_platform unit_env - -- LLVM from version 3.0 onwards doesn't support the OS X system - -- assembler, so we use clang as the assembler instead. (#5636) - let as_prog = applyAssemblerProg $ backendAssemblerProg (backend dflags) - let cmdline_include_paths = includePaths dflags let pic_c_flags = picCCOpts dflags @@ -310,9 +306,8 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do includePathsQuoteImplicit cmdline_include_paths] let runAssembler inputFilename outputFilename = withAtomicRename outputFilename $ \temp_outputFilename -> - as_prog + runAs logger dflags - platform (local_includes ++ global_includes -- See Note [-fPIC for assembler] ++ map GHC.SysTools.Option pic_c_flags @@ -392,22 +387,6 @@ runForeignJsPhase pipe_env hsc_env _location input_fn = do embedJsFile logger dflags tmpfs unit_env input_fn output_fn return output_fn - -applyAssemblerProg - :: DefunctionalizedAssemblerProg - -> Logger -> DynFlags -> Platform -> [Option] -> IO () -applyAssemblerProg StandardAssemblerProg logger dflags _platform = - runAs logger dflags -applyAssemblerProg JSAssemblerProg logger dflags _platform = - runEmscripten logger dflags -applyAssemblerProg DarwinClangAssemblerProg logger dflags platform = - if platformOS platform == OSDarwin then - runClang logger dflags - else - runAs logger dflags - - - runCcPhase :: Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO FilePath runCcPhase cc_phase pipe_env hsc_env location input_fn = do let dflags = hsc_dflags hsc_env ===================================== compiler/GHC/Linker/ExtraObj.hs ===================================== @@ -12,7 +12,6 @@ module GHC.Linker.ExtraObj , mkNoteObjsToLinkIntoBinary , checkLinkInfo , getLinkInfo - , getCompilerInfo , ghcLinkInfoSectionName , ghcLinkInfoNoteName , platformSupportsSavingLinkOpts @@ -40,10 +39,8 @@ import qualified GHC.Data.ShortText as ST import GHC.SysTools.Elf import GHC.SysTools.Tasks -import GHC.SysTools.Info import GHC.Linker.Unit -import Control.Monad.IO.Class import Control.Monad import Data.Maybe @@ -52,7 +49,6 @@ mkExtraObj logger tmpfs dflags unit_state extn xs = do cFile <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule extn oFile <- newTempName logger tmpfs (tmpDir dflags) TFL_GhcSession "o" writeFile cFile xs - ccInfo <- liftIO $ getCompilerInfo logger dflags runCc Nothing logger tmpfs dflags ([Option "-c", FileOption "" cFile, @@ -60,7 +56,7 @@ mkExtraObj logger tmpfs dflags unit_state extn xs FileOption "" oFile] ++ if extn /= "s" then cOpts - else asmOpts ccInfo) + else []) return oFile where -- Pass a different set of options to the C compiler depending one whether @@ -70,14 +66,6 @@ mkExtraObj logger tmpfs dflags unit_state extn xs ++ map (FileOption "-I" . ST.unpack) (unitIncludeDirs $ unsafeLookupUnit unit_state rtsUnit) - -- When compiling assembler code, we drop the usual C options, and if the - -- compiler is Clang, we add an extra argument to tell Clang to ignore - -- unused command line options. See trac #11684. - asmOpts ccInfo = - if any (ccInfo ==) [Clang, AppleClang, AppleClang51] - then [Option "-Qunused-arguments"] - else [] - -- When linking a binary, we need to create a C main() function that -- starts everything off. This used to be compiled statically as part -- of the RTS, but that made it hard to change the -rtsopts setting, ===================================== compiler/GHC/SysTools.hs ===================================== @@ -17,7 +17,6 @@ module GHC.SysTools ( -- * Interface to system tools module GHC.SysTools.Tasks, - module GHC.SysTools.Info, -- * Fast file copy copyFile, @@ -35,8 +34,6 @@ import GHC.Prelude import GHC.Utils.Panic import GHC.Driver.Session -import GHC.Linker.ExtraObj -import GHC.SysTools.Info import GHC.SysTools.Tasks import GHC.SysTools.BaseDir import GHC.Settings.IO ===================================== compiler/GHC/SysTools/Info.hs deleted ===================================== @@ -1,243 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} ------------------------------------------------------------------------------ --- --- Compiler information functions --- --- (c) The GHC Team 2017 --- ------------------------------------------------------------------------------ -module GHC.SysTools.Info where - -import GHC.Utils.Exception -import GHC.Utils.Error -import GHC.Driver.Session -import GHC.Utils.Outputable -import GHC.Utils.Misc -import GHC.Utils.Logger - -import Data.List ( isInfixOf, isPrefixOf ) -import Data.IORef - -import System.IO - -import GHC.Platform -import GHC.Prelude - -import GHC.SysTools.Process - -{- Note [Run-time linker info] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~ -See also: #5240, #6063, #10110 - -Before 'runLink', we need to be sure to get the relevant information -about the linker we're using at runtime to see if we need any extra -options. - -Generally, the linker changing from what was detected at ./configure -time has always been possible using -pgml, but on Linux it can happen -'transparently' by installing packages like binutils-gold, which -change what /usr/bin/ld actually points to. - -Clang vs GCC notes: - -For gcc, 'gcc -Wl,--version' gives a bunch of output about how to -invoke the linker before the version information string. For 'clang', -the version information for 'ld' is all that's output. For this -reason, we typically need to slurp up all of the standard error output -and look through it. - -Other notes: - -We cache the LinkerInfo inside DynFlags, since clients may link -multiple times. The definition of LinkerInfo is there to avoid a -circular dependency. - --} - -{- Note [ELF needed shared libs] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Some distributions change the link editor's default handling of -ELF DT_NEEDED tags to include only those shared objects that are -needed to resolve undefined symbols. For Template Haskell we need -the last temporary shared library also if it is not needed for the -currently linked temporary shared library. We specify --no-as-needed -to override the default. This flag exists in GNU ld and GNU gold. - -The flag is only needed on ELF systems. On Windows (PE) and Mac OS X -(Mach-O) the flag is not needed. - --} - -neededLinkArgs :: LinkerInfo -> [Option] -neededLinkArgs (GnuLD o) = o -neededLinkArgs (Mold o) = o -neededLinkArgs (GnuGold o) = o -neededLinkArgs (LlvmLLD o) = o -neededLinkArgs (DarwinLD o) = o -neededLinkArgs (SolarisLD o) = o -neededLinkArgs (AixLD o) = o -neededLinkArgs UnknownLD = [] - --- Grab linker info and cache it in DynFlags. -getLinkerInfo :: Logger -> DynFlags -> IO LinkerInfo -getLinkerInfo logger dflags = do - info <- readIORef (rtldInfo dflags) - case info of - Just v -> return v - Nothing -> do - v <- getLinkerInfo' logger dflags - writeIORef (rtldInfo dflags) (Just v) - return v - --- See Note [Run-time linker info]. -getLinkerInfo' :: Logger -> DynFlags -> IO LinkerInfo -getLinkerInfo' logger dflags = do - let platform = targetPlatform dflags - os = platformOS platform - (pgm,args0) = pgm_l dflags - args1 = map Option (getOpts dflags opt_l) - args2 = args0 ++ args1 - args3 = filter notNull (map showOpt args2) - - -- Try to grab the info from the process output. - parseLinkerInfo stdo _stde _exitc - | any ("GNU ld" `isPrefixOf`) stdo = - -- Set DT_NEEDED for all shared libraries. #10110. - return (GnuLD $ map Option [-- ELF specific flag - -- 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] - return (GnuGold [Option "-Wl,--no-as-needed"]) - - | any (\line -> "LLD" `isPrefixOf` line || "LLD" `elem` words line) stdo = - return (LlvmLLD $ map Option [ --see Note [ELF needed shared libs] - "-Wl,--no-as-needed" | osElfTarget os || os == OSMinGW32 ]) - - -- Unknown linker. - | otherwise = fail "invalid --version output, or linker is unsupported" - - -- Process the executable call - catchIO ( - case os of - OSSolaris2 -> - -- Solaris uses its own Solaris linker. Even all - -- GNU C are recommended to configure with Solaris - -- linker instead of using GNU binutils linker. Also - -- all GCC distributed with Solaris follows this rule - -- precisely so we assume here, the Solaris linker is - -- used. - return $ SolarisLD [] - OSAIX -> - -- IBM AIX uses its own non-binutils linker as well - return $ AixLD [] - OSDarwin -> - -- Darwin has neither GNU Gold or GNU LD, but a strange linker - -- that doesn't support --version. We can just assume that's - -- what we're using. - return $ DarwinLD [] - OSMinGW32 -> - -- GHC doesn't support anything but GNU ld on Windows anyway. - -- Process creation is also fairly expensive on win32, so - -- we short-circuit here. - return $ GnuLD $ map Option - [ -- Emit stack checks - -- See Note [Windows stack allocations] - "-fstack-check" - ] - _ -> do - -- In practice, we use the compiler as the linker here. Pass - -- -Wl,--version to get linker version info. - (exitc, stdo, stde) <- readProcessEnvWithExitCode pgm - (["-Wl,--version"] ++ args3) - c_locale_env - -- Split the output by lines to make certain kinds - -- of processing easier. In particular, 'clang' and 'gcc' - -- have slightly different outputs for '-Wl,--version', but - -- it's still easy to figure out. - parseLinkerInfo (lines stdo) (lines stde) exitc - ) - (\err -> do - debugTraceMsg logger 2 - (text "Error (figuring out linker information):" <+> - text (show err)) - errorMsg logger $ hang (text "Warning:") 9 $ - text "Couldn't figure out linker information!" $$ - text "Make sure you're using GNU ld, GNU gold" <+> - text "or the built in OS X linker, etc." - return UnknownLD - ) - --- | Grab compiler info and cache it in DynFlags. -getCompilerInfo :: Logger -> DynFlags -> IO CompilerInfo -getCompilerInfo logger dflags = do - info <- readIORef (rtccInfo dflags) - case info of - Just v -> return v - Nothing -> do - let pgm = pgm_c dflags - v <- getCompilerInfo' logger pgm - writeIORef (rtccInfo dflags) (Just v) - return v - --- | Grab assembler info and cache it in DynFlags. -getAssemblerInfo :: Logger -> DynFlags -> IO CompilerInfo -getAssemblerInfo logger dflags = do - info <- readIORef (rtasmInfo dflags) - case info of - Just v -> return v - Nothing -> do - let (pgm, _) = pgm_a dflags - v <- getCompilerInfo' logger pgm - writeIORef (rtasmInfo dflags) (Just v) - return v - --- See Note [Run-time linker info]. -getCompilerInfo' :: Logger -> String -> IO CompilerInfo -getCompilerInfo' logger pgm = do - let -- Try to grab the info from the process output. - parseCompilerInfo _stdo stde _exitc - -- Regular GCC - | any ("gcc version" `isInfixOf`) stde = - return GCC - -- Regular clang - | any ("clang version" `isInfixOf`) stde = - return Clang - -- FreeBSD clang - | any ("FreeBSD clang version" `isInfixOf`) stde = - return Clang - -- Xcode 5.1 clang - | any ("Apple LLVM version 5.1" `isPrefixOf`) stde = - return AppleClang51 - -- Xcode 5 clang - | any ("Apple LLVM version" `isPrefixOf`) stde = - return AppleClang - -- Xcode 4.1 clang - | any ("Apple clang version" `isPrefixOf`) stde = - return AppleClang - -- Unknown compiler. - | otherwise = fail $ "invalid -v output, or compiler is unsupported (" ++ pgm ++ "): " ++ unlines stde - - -- Process the executable call - catchIO (do - (exitc, stdo, stde) <- - readProcessEnvWithExitCode pgm ["-v"] c_locale_env - -- Split the output by lines to make certain kinds - -- of processing easier. - parseCompilerInfo (lines stdo) (lines stde) exitc - ) - (\err -> do - debugTraceMsg logger 2 - (text "Error (figuring out C compiler information):" <+> - text (show err)) - errorMsg logger $ hang (text "Warning:") 9 $ - text "Couldn't figure out C compiler information!" $$ - text "Make sure you're using GNU gcc, or clang" - return UnknownCC - ) ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -19,7 +19,6 @@ import GHC.CmmToLlvm.Config (LlvmVersion, llvmVersionStr, supportedLlvmVersionUp import GHC.Settings import GHC.SysTools.Process -import GHC.SysTools.Info import GHC.Driver.Session @@ -278,15 +277,12 @@ figureLlvmVersion logger dflags = traceSystoolCommand logger "llc" $ do runLink :: Logger -> TmpFs -> DynFlags -> [Option] -> IO () runLink logger tmpfs dflags args = traceSystoolCommand logger "linker" $ do - -- See Note [Run-time linker info] - -- -- `-optl` args come at the end, so that later `-l` options -- given there manually can fill in symbols needed by -- Haskell libraries coming in via `args`. - linkargs <- neededLinkArgs `fmap` getLinkerInfo logger dflags let (p,args0) = pgm_l dflags optl_args = map Option (getOpts dflags opt_l) - args2 = args0 ++ linkargs ++ args ++ optl_args + args2 = args0 ++ args ++ optl_args mb_env <- getGccEnv args2 runSomethingResponseFile logger tmpfs dflags ld_filter "Linker" p args2 mb_env where ===================================== compiler/ghc.cabal.in ===================================== @@ -712,7 +712,6 @@ Library GHC.SysTools.BaseDir GHC.SysTools.Cpp GHC.SysTools.Elf - GHC.SysTools.Info GHC.SysTools.Process GHC.SysTools.Tasks GHC.SysTools.Terminal ===================================== m4/fp_link_supports_no_as_needed.m4 ===================================== @@ -0,0 +1,33 @@ +# FP_LINK_SUPPORTS_NO_AS_NEEDED +# ---------------------------------- +# Set the Cc linker flag -Wl,--no-as-needed if it is supported +# $1 is the name of the linker flags variable when linking with gcc +# See also Note [ELF needed shared libs] +AC_DEFUN([FP_LINK_SUPPORTS_NO_AS_NEEDED], +[ + AC_MSG_CHECKING([whether Cc linker supports -Wl,--no-as-needed]) + echo 'int f(int a) {return 2*a;}' > conftest.a.c + echo 'int f(int a); int main(int argc, char **argv) {return f(0);}' > conftest.b.c + $CC -c -o conftest.a.o conftest.a.c > /dev/null 2>&1 + $CC -c -o conftest.b.o conftest.b.c > /dev/null 2>&1 + if "$CC" "$$1" -Wl,--no-as-needed -o conftest conftest.a.o conftest.b.o > /dev/null 2>&1 + then + $1="$$1 -Wl,--no-as-needed" + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + fi + rm -f conftest* +]) + +# Note [ELF needed shared libs] +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# Some distributions change the link editor's default handling of +# ELF DT_NEEDED tags to include only those shared objects that are +# needed to resolve undefined symbols. For Template Haskell we need +# the last temporary shared library also if it is not needed for the +# currently linked temporary shared library. We specify --no-as-needed +# to override the default. This flag exists in GNU ld and GNU gold. +# +# The flag is only needed on ELF systems. On Windows (PE) and Mac OS X +# (Mach-O) the flag is not needed. ===================================== m4/fptools_set_c_ld_flags.m4 ===================================== @@ -17,9 +17,19 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS], ;; esac + # See Note [ELF needed shared libs] + case $$1 in + *-linux|*-freebsd*) + FP_LINK_SUPPORTS_NO_AS_NEEDED([$3]) + ;; + esac + case $$1 in i386-unknown-mingw32) $2="$$2 -march=i686" + # Emit stack checks + # See Note [Windows stack allocations] + $3="$$3 -fstack-check" ;; i386-portbld-freebsd*) $2="$$2 -march=i686" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b1213d01bcdcf63fce2613e44df3e3abe4ebc94b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b1213d01bcdcf63fce2613e44df3e3abe4ebc94b You're receiving 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 Jun 26 17:09:23 2023 From: gitlab at gitlab.haskell.org (Torsten Schmits (@torsten.schmits)) Date: Mon, 26 Jun 2023 13:09:23 -0400 Subject: [Git][ghc/ghc][wip/torsten.schmits/16468] 62 commits: Add more flags for dumping core passes (#23491) Message-ID: <6499c643ceeaa_2402e0c7574671f7@gitlab.mail> Torsten Schmits pushed to branch wip/torsten.schmits/16468 at Glasgow Haskell Compiler / GHC Commits: 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - c9beeda4 by Torsten Schmits at 2023-06-26T19:09:14+02:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/JS/Make.hs - compiler/GHC/JS/Syntax.hs - compiler/GHC/JS/Unsat/Syntax.hs - compiler/GHC/Linker/Loader.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b4923d3e3ce0ba4b3d3a3fb68d770ceb423b819c...c9beeda4e54d35fc1fe979b0f0be1a88bfd480ba -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b4923d3e3ce0ba4b3d3a3fb68d770ceb423b819c...c9beeda4e54d35fc1fe979b0f0be1a88bfd480ba You're receiving 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 Jun 26 17:15:03 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 26 Jun 2023 13:15:03 -0400 Subject: [Git][ghc/ghc][master] Support large stack frames/offsets in GHCi bytecode interpreter Message-ID: <6499c7974726d_2402e0c7510735dc@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 13 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/StgToByteCode.hs - rts/Disassembler.c - rts/Interpreter.c - + testsuite/tests/ghci/should_run/LargeBCO.hs - + testsuite/tests/ghci/should_run/LargeBCO.stdout - + testsuite/tests/ghci/should_run/LargeBCO_A.hs - + testsuite/tests/ghci/should_run/T22888.hs - testsuite/tests/ghci/should_run/all.T Changes: ===================================== compiler/GHC/ByteCode/Asm.hs ===================================== @@ -22,7 +22,7 @@ import GHC.ByteCode.InfoTable import GHC.ByteCode.Types import GHCi.RemoteTypes import GHC.Runtime.Interpreter -import GHC.Runtime.Heap.Layout hiding ( WordOff ) +import GHC.Runtime.Heap.Layout ( fromStgWord, StgWord ) import GHC.Types.Name import GHC.Types.Name.Set @@ -199,8 +199,8 @@ assembleBCO platform (ProtoBCO { protoBCOName = nm -- this BCO to be long. (n_insns0, lbl_map0) = inspectAsm platform False initial_offset asm ((n_insns, lbl_map), long_jumps) - | isLarge (fromIntegral $ Map.size lbl_map0) - || isLarge n_insns0 + | isLargeW (fromIntegral $ Map.size lbl_map0) + || isLargeW n_insns0 = (inspectAsm platform True initial_offset asm, True) | otherwise = ((n_insns0, lbl_map0), False) @@ -229,7 +229,7 @@ assembleBCO platform (ProtoBCO { protoBCOName = nm return ul_bco -mkBitmapArray :: Word16 -> [StgWord] -> UArray Int Word64 +mkBitmapArray :: Word -> [StgWord] -> UArray Int Word64 -- Here the return type must be an array of Words, not StgWords, -- because the underlying ByteArray# will end up as a component -- of a BCO object. @@ -244,9 +244,21 @@ type AsmState = (SizedSeq Word16, data Operand = Op Word + | IOp Int | SmallOp Word16 | LabelOp LocalLabel --- (unused) | LargeOp Word + +wOp :: WordOff -> Operand +wOp = Op . fromIntegral + +bOp :: ByteOff -> Operand +bOp = Op . fromIntegral + +truncHalfWord :: Platform -> HalfWord -> Operand +truncHalfWord platform w = case platformWordSize platform of + PW4 | w <= 65535 -> Op (fromIntegral w) + PW8 | w <= 4294967295 -> Op (fromIntegral w) + _ -> pprPanic "GHC.ByteCode.Asm.truncHalfWord" (ppr w) data Assembler a = AllocPtr (IO BCOPtr) (Word -> Assembler a) @@ -287,9 +299,9 @@ type LabelEnv = LocalLabel -> Word largeOp :: Bool -> Operand -> Bool largeOp long_jumps op = case op of SmallOp _ -> False - Op w -> isLarge w + Op w -> isLargeW w + IOp i -> isLargeI i LabelOp _ -> long_jumps --- LargeOp _ -> True runAsm :: Platform -> Bool -> LabelEnv -> Assembler a -> StateT AsmState IO a runAsm platform long_jumps e = go @@ -308,15 +320,15 @@ runAsm platform long_jumps e = go go $ k w go (AllocLabel _ k) = go k go (Emit w ops k) = do - let largeOps = any (largeOp long_jumps) ops + let largeArgs = any (largeOp long_jumps) ops opcode - | largeOps = largeArgInstr w + | largeArgs = largeArgInstr w | otherwise = w words = concatMap expand ops expand (SmallOp w) = [w] expand (LabelOp w) = expand (Op (e w)) - expand (Op w) = if largeOps then largeArg platform (fromIntegral w) else [fromIntegral w] --- expand (LargeOp w) = largeArg platform w + expand (Op w) = if largeArgs then largeArg platform (fromIntegral w) else [fromIntegral w] + expand (IOp i) = if largeArgs then largeArg platform (fromIntegral i) else [fromIntegral i] state $ \(st_i0,st_l0,st_p0) -> let st_i1 = addListToSS st_i0 (opcode : words) in ((), (st_i1,st_l0,st_p0)) @@ -350,7 +362,7 @@ inspectAsm platform long_jumps initial_offset count (SmallOp _) = 1 count (LabelOp _) = count (Op 0) count (Op _) = if largeOps then largeArg16s platform else 1 --- count (LargeOp _) = largeArg16s platform + count (IOp _) = if largeOps then largeArg16s platform else 1 -- Bring in all the bci_ bytecode constants. #include "Bytecodes.h" @@ -379,15 +391,15 @@ assembleI :: Platform -> Assembler () assembleI platform i = case i of STKCHECK n -> emit bci_STKCHECK [Op n] - PUSH_L o1 -> emit bci_PUSH_L [SmallOp o1] - PUSH_LL o1 o2 -> emit bci_PUSH_LL [SmallOp o1, SmallOp o2] - PUSH_LLL o1 o2 o3 -> emit bci_PUSH_LLL [SmallOp o1, SmallOp o2, SmallOp o3] - PUSH8 o1 -> emit bci_PUSH8 [SmallOp o1] - PUSH16 o1 -> emit bci_PUSH16 [SmallOp o1] - PUSH32 o1 -> emit bci_PUSH32 [SmallOp o1] - PUSH8_W o1 -> emit bci_PUSH8_W [SmallOp o1] - PUSH16_W o1 -> emit bci_PUSH16_W [SmallOp o1] - PUSH32_W o1 -> emit bci_PUSH32_W [SmallOp o1] + PUSH_L o1 -> emit bci_PUSH_L [wOp o1] + PUSH_LL o1 o2 -> emit bci_PUSH_LL [wOp o1, wOp o2] + PUSH_LLL o1 o2 o3 -> emit bci_PUSH_LLL [wOp o1, wOp o2, wOp o3] + PUSH8 o1 -> emit bci_PUSH8 [bOp o1] + PUSH16 o1 -> emit bci_PUSH16 [bOp o1] + PUSH32 o1 -> emit bci_PUSH32 [bOp o1] + PUSH8_W o1 -> emit bci_PUSH8_W [bOp o1] + PUSH16_W o1 -> emit bci_PUSH16_W [bOp o1] + PUSH32_W o1 -> emit bci_PUSH32_W [bOp o1] PUSH_G nm -> do p <- ptr (BCOPtrName nm) emit bci_PUSH_G [Op p] PUSH_PRIMOP op -> do p <- ptr (BCOPtrPrimOp op) @@ -419,7 +431,7 @@ assembleI platform i = case i of PUSH_UBX32 lit -> do np <- literal lit emit bci_PUSH_UBX32 [Op np] PUSH_UBX lit nws -> do np <- literal lit - emit bci_PUSH_UBX [Op np, SmallOp nws] + emit bci_PUSH_UBX [Op np, wOp nws] -- see Note [Generating code for top-level string literal bindings] in GHC.StgToByteCode PUSH_ADDR nm -> do np <- lit [BCONPtrAddr nm] @@ -437,15 +449,15 @@ assembleI platform i = case i of PUSH_APPLY_PPPPP -> emit bci_PUSH_APPLY_PPPPP [] PUSH_APPLY_PPPPPP -> emit bci_PUSH_APPLY_PPPPPP [] - SLIDE n by -> emit bci_SLIDE [SmallOp n, SmallOp by] - ALLOC_AP n -> emit bci_ALLOC_AP [SmallOp n] - ALLOC_AP_NOUPD n -> emit bci_ALLOC_AP_NOUPD [SmallOp n] - ALLOC_PAP arity n -> emit bci_ALLOC_PAP [SmallOp arity, SmallOp n] - MKAP off sz -> emit bci_MKAP [SmallOp off, SmallOp sz] - MKPAP off sz -> emit bci_MKPAP [SmallOp off, SmallOp sz] - UNPACK n -> emit bci_UNPACK [SmallOp n] + SLIDE n by -> emit bci_SLIDE [wOp n, wOp by] + ALLOC_AP n -> emit bci_ALLOC_AP [truncHalfWord platform n] + ALLOC_AP_NOUPD n -> emit bci_ALLOC_AP_NOUPD [truncHalfWord platform n] + ALLOC_PAP arity n -> emit bci_ALLOC_PAP [truncHalfWord platform arity, truncHalfWord platform n] + MKAP off sz -> emit bci_MKAP [wOp off, truncHalfWord platform sz] + MKPAP off sz -> emit bci_MKPAP [wOp off, truncHalfWord platform sz] + UNPACK n -> emit bci_UNPACK [wOp n] PACK dcon sz -> do itbl_no <- lit [BCONPtrItbl (getName dcon)] - emit bci_PACK [Op itbl_no, SmallOp sz] + emit bci_PACK [Op itbl_no, wOp sz] LABEL lbl -> label lbl TESTLT_I i l -> do np <- int i emit bci_TESTLT_I [Op np, LabelOp l] @@ -498,13 +510,13 @@ assembleI platform i = case i of TESTLT_P i l -> emit bci_TESTLT_P [SmallOp i, LabelOp l] TESTEQ_P i l -> emit bci_TESTEQ_P [SmallOp i, LabelOp l] CASEFAIL -> emit bci_CASEFAIL [] - SWIZZLE stkoff n -> emit bci_SWIZZLE [SmallOp stkoff, SmallOp n] + SWIZZLE stkoff n -> emit bci_SWIZZLE [wOp stkoff, IOp n] JMP l -> emit bci_JMP [LabelOp l] ENTER -> emit bci_ENTER [] RETURN rep -> emit (return_non_tuple rep) [] RETURN_TUPLE -> emit bci_RETURN_T [] CCALL off m_addr i -> do np <- addr m_addr - emit bci_CCALL [SmallOp off, Op np, SmallOp i] + emit bci_CCALL [wOp off, Op np, SmallOp i] PRIMCALL -> emit bci_PRIMCALL [] BRK_FUN index uniq cc -> do p1 <- ptr BCOPtrBreakArray q <- int (getKey uniq) @@ -556,8 +568,11 @@ assembleI platform i = case i of words ws = lit (map BCONPtrWord ws) word w = words [w] -isLarge :: Word -> Bool -isLarge n = n > 65535 +isLargeW :: Word -> Bool +isLargeW n = n > 65535 + +isLargeI :: Int -> Bool +isLargeI n = n > 32767 || n < -32768 push_alts :: ArgRep -> Word16 push_alts V = bci_PUSH_ALTS_V ===================================== compiler/GHC/ByteCode/Instr.hs ===================================== @@ -23,7 +23,7 @@ import GHC.Types.Unique import GHC.Types.Literal import GHC.Core.DataCon import GHC.Builtin.PrimOps -import GHC.Runtime.Heap.Layout +import GHC.Runtime.Heap.Layout ( StgWord ) import Data.Int import Data.Word @@ -41,7 +41,7 @@ data ProtoBCO a protoBCOInstrs :: [BCInstr], -- instrs -- arity and GC info protoBCOBitmap :: [StgWord], - protoBCOBitmapSize :: Word16, + protoBCOBitmapSize :: Word, protoBCOArity :: Int, -- what the BCO came from, for debugging only protoBCOExpr :: Either [CgStgAlt] CgStgRhs, @@ -58,18 +58,18 @@ instance Outputable LocalLabel where data BCInstr -- Messing with the stack - = STKCHECK Word + = STKCHECK !Word -- Push locals (existing bits of the stack) - | PUSH_L !Word16{-offset-} - | PUSH_LL !Word16 !Word16{-2 offsets-} - | PUSH_LLL !Word16 !Word16 !Word16{-3 offsets-} + | PUSH_L !WordOff{-offset-} + | PUSH_LL !WordOff !WordOff{-2 offsets-} + | PUSH_LLL !WordOff !WordOff !WordOff{-3 offsets-} -- Push the specified local as a 8, 16, 32 bit value onto the stack. (i.e., -- the stack will grow by 8, 16 or 32 bits) - | PUSH8 !Word16 - | PUSH16 !Word16 - | PUSH32 !Word16 + | PUSH8 !ByteOff + | PUSH16 !ByteOff + | PUSH32 !ByteOff -- Push the specified local as a 8, 16, 32 bit value onto the stack, but the -- value will take the whole word on the stack (i.e., the stack will grow by @@ -78,9 +78,9 @@ data BCInstr -- Currently we expect all values on the stack to take full words, except for -- the ones used for PACK (i.e., actually constructing new data types, in -- which case we use PUSH{8,16,32}) - | PUSH8_W !Word16 - | PUSH16_W !Word16 - | PUSH32_W !Word16 + | PUSH8_W !ByteOff + | PUSH16_W !ByteOff + | PUSH32_W !ByteOff -- Push a ptr (these all map to PUSH_G really) | PUSH_G Name @@ -102,8 +102,8 @@ data BCInstr | PUSH_UBX8 Literal | PUSH_UBX16 Literal | PUSH_UBX32 Literal - | PUSH_UBX Literal Word16 - -- push this int/float/double/addr, on the stack. Word16 + | PUSH_UBX Literal !WordOff + -- push this int/float/double/addr, on the stack. Word -- is # of words to copy from literal pool. Eitherness reflects -- the difficulty of dealing with MachAddr here, mostly due to -- the excessive (and unnecessary) restrictions imposed by the @@ -129,58 +129,61 @@ data BCInstr | PUSH_APPLY_PPPPP | PUSH_APPLY_PPPPPP - | SLIDE Word16{-this many-} Word16{-down by this much-} + | SLIDE !WordOff{-this many-} !WordOff{-down by this much-} -- To do with the heap - | ALLOC_AP !Word16 -- make an AP with this many payload words - | ALLOC_AP_NOUPD !Word16 -- make an AP_NOUPD with this many payload words - | ALLOC_PAP !Word16 !Word16 -- make a PAP with this arity / payload words - | MKAP !Word16{-ptr to AP is this far down stack-} !Word16{-number of words-} - | MKPAP !Word16{-ptr to PAP is this far down stack-} !Word16{-number of words-} - | UNPACK !Word16 -- unpack N words from t.o.s Constr - | PACK DataCon !Word16 + | ALLOC_AP !HalfWord {- make an AP with this many payload words. + HalfWord matches the size of the n_args field in StgAP, + make sure that we handle truncation when generating + bytecode using this HalfWord type here -} + | ALLOC_AP_NOUPD !HalfWord -- make an AP_NOUPD with this many payload words + | ALLOC_PAP !HalfWord !HalfWord -- make a PAP with this arity / payload words + | MKAP !WordOff{-ptr to AP is this far down stack-} !HalfWord{-number of words-} + | MKPAP !WordOff{-ptr to PAP is this far down stack-} !HalfWord{-number of words-} + | UNPACK !WordOff -- unpack N words from t.o.s Constr + | PACK DataCon !WordOff -- after assembly, the DataCon is an index into the -- itbl array -- For doing case trees | LABEL LocalLabel - | TESTLT_I Int LocalLabel - | TESTEQ_I Int LocalLabel - | TESTLT_W Word LocalLabel - | TESTEQ_W Word LocalLabel - | TESTLT_I64 Int64 LocalLabel - | TESTEQ_I64 Int64 LocalLabel - | TESTLT_I32 Int32 LocalLabel - | TESTEQ_I32 Int32 LocalLabel - | TESTLT_I16 Int16 LocalLabel - | TESTEQ_I16 Int16 LocalLabel - | TESTLT_I8 Int8 LocalLabel - | TESTEQ_I8 Int16 LocalLabel - | TESTLT_W64 Word64 LocalLabel - | TESTEQ_W64 Word64 LocalLabel - | TESTLT_W32 Word32 LocalLabel - | TESTEQ_W32 Word32 LocalLabel - | TESTLT_W16 Word16 LocalLabel - | TESTEQ_W16 Word16 LocalLabel - | TESTLT_W8 Word8 LocalLabel - | TESTEQ_W8 Word8 LocalLabel - | TESTLT_F Float LocalLabel - | TESTEQ_F Float LocalLabel - | TESTLT_D Double LocalLabel - | TESTEQ_D Double LocalLabel + | TESTLT_I !Int LocalLabel + | TESTEQ_I !Int LocalLabel + | TESTLT_W !Word LocalLabel + | TESTEQ_W !Word LocalLabel + | TESTLT_I64 !Int64 LocalLabel + | TESTEQ_I64 !Int64 LocalLabel + | TESTLT_I32 !Int32 LocalLabel + | TESTEQ_I32 !Int32 LocalLabel + | TESTLT_I16 !Int16 LocalLabel + | TESTEQ_I16 !Int16 LocalLabel + | TESTLT_I8 !Int8 LocalLabel + | TESTEQ_I8 !Int16 LocalLabel + | TESTLT_W64 !Word64 LocalLabel + | TESTEQ_W64 !Word64 LocalLabel + | TESTLT_W32 !Word32 LocalLabel + | TESTEQ_W32 !Word32 LocalLabel + | TESTLT_W16 !Word16 LocalLabel + | TESTEQ_W16 !Word16 LocalLabel + | TESTLT_W8 !Word8 LocalLabel + | TESTEQ_W8 !Word8 LocalLabel + | TESTLT_F !Float LocalLabel + | TESTEQ_F !Float LocalLabel + | TESTLT_D !Double LocalLabel + | TESTEQ_D !Double LocalLabel -- The Word16 value is a constructor number and therefore -- stored in the insn stream rather than as an offset into -- the literal pool. - | TESTLT_P Word16 LocalLabel - | TESTEQ_P Word16 LocalLabel + | TESTLT_P !Word16 LocalLabel + | TESTEQ_P !Word16 LocalLabel | CASEFAIL | JMP LocalLabel -- For doing calls to C (via glue code generated by libffi) - | CCALL Word16 -- stack frame size + | CCALL !WordOff -- stack frame size (RemotePtr C_ffi_cif) -- addr of the glue code - Word16 -- flags. + !Word16 -- flags. -- -- 0x1: call is interruptible -- 0x2: call is unsafe @@ -191,8 +194,8 @@ data BCInstr | PRIMCALL -- For doing magic ByteArray passing to foreign calls - | SWIZZLE Word16 -- to the ptr N words down the stack, - Word16 -- add M (interpreted as a signed 16-bit entity) + | SWIZZLE !WordOff -- to the ptr N words down the stack, + !Int -- add M -- To Infinity And Beyond | ENTER @@ -202,7 +205,7 @@ data BCInstr -- Note [unboxed tuple bytecodes and tuple_BCO] in GHC.StgToByteCode -- Breakpoints - | BRK_FUN Word16 Unique (RemotePtr CostCentre) + | BRK_FUN !Word16 Unique (RemotePtr CostCentre) -- ----------------------------------------------------------------------------- -- Printing bytecode instructions ===================================== compiler/GHC/ByteCode/Types.hs ===================================== @@ -11,7 +11,7 @@ module GHC.ByteCode.Types , FFIInfo(..) , RegBitmap(..) , NativeCallType(..), NativeCallInfo(..), voidTupleReturnInfo, voidPrimCallInfo - , ByteOff(..), WordOff(..) + , ByteOff(..), WordOff(..), HalfWord(..) , UnlinkedBCO(..), BCOPtr(..), BCONPtr(..) , ItblEnv, ItblPtr(..) , AddrEnv, AddrPtr(..) @@ -79,6 +79,12 @@ newtype ByteOff = ByteOff Int newtype WordOff = WordOff Int deriving (Enum, Eq, Show, Integral, Num, Ord, Real, Outputable) +-- A type for values that are half the size of a word on the target +-- platform where the interpreter runs (which may be a different +-- wordsize than the compiler). +newtype HalfWord = HalfWord Word + deriving (Enum, Eq, Show, Integral, Num, Ord, Real, Outputable) + newtype RegBitmap = RegBitmap { unRegBitmap :: Word32 } deriving (Enum, Eq, Show, Integral, Num, Ord, Real, Bits, FiniteBits, Outputable) @@ -188,7 +194,7 @@ instance NFData BCONPtr where data CgBreakInfo = CgBreakInfo { cgb_tyvars :: ![IfaceTvBndr] -- ^ Type variables in scope at the breakpoint - , cgb_vars :: ![Maybe (IfaceIdBndr, Word16)] + , cgb_vars :: ![Maybe (IfaceIdBndr, Word)] , cgb_resty :: !IfaceType } -- See Note [Syncing breakpoint info] in GHC.Runtime.Eval ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -49,8 +49,6 @@ module GHC.CoreToIface import GHC.Prelude -import Data.Word - import GHC.StgToCmm.Types import GHC.ByteCode.Types @@ -698,7 +696,7 @@ toIfaceLFInfo nm lfi = case lfi of -- Dehydrating CgBreakInfo -dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word16)] -> Type -> CgBreakInfo +dehydrateCgBreakInfo :: [TyVar] -> [Maybe (Id, Word)] -> Type -> CgBreakInfo dehydrateCgBreakInfo ty_vars idOffSets tick_ty = CgBreakInfo { cgb_tyvars = map toIfaceTvBndr ty_vars ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -35,8 +35,6 @@ import GHC.Prelude import GHC.ByteCode.Types -import Data.Word - import GHC.Driver.Env import GHC.Driver.Session import GHC.Driver.Config.Core.Lint ( initLintConfig ) @@ -2164,7 +2162,7 @@ bindIfaceTyConBinderX bind_tv (Bndr tv vis) thing_inside -- CgBreakInfo -hydrateCgBreakInfo :: CgBreakInfo -> IfL ([Maybe (Id, Word16)], Type) +hydrateCgBreakInfo :: CgBreakInfo -> IfL ([Maybe (Id, Word)], Type) hydrateCgBreakInfo CgBreakInfo{..} = do bindIfaceTyVars cgb_tyvars $ \_ -> do result_ty <- tcIfaceType cgb_resty ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -242,7 +242,7 @@ mkProtoBCO -> Either [CgStgAlt] (CgStgRhs) -- ^ original expression; for debugging only -> Int -- ^ arity - -> Word16 -- ^ bitmap size + -> WordOff -- ^ bitmap size -> [StgWord] -- ^ bitmap -> Bool -- ^ True <=> is a return point, rather than a function -> [FFIInfo] @@ -252,7 +252,7 @@ mkProtoBCO platform nm instrs_ordlist origin arity bitmap_size bitmap is_ret ffi protoBCOName = nm, protoBCOInstrs = maybe_with_stack_check, protoBCOBitmap = bitmap, - protoBCOBitmapSize = bitmap_size, + protoBCOBitmapSize = fromIntegral bitmap_size, protoBCOArity = arity, protoBCOExpr = origin, protoBCOFFIs = ffis @@ -396,7 +396,9 @@ schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_no fvs) rhs) platform <- profilePlatform <$> getProfile let idOffSets = getVarOffSets platform d p fvs ty_vars = tyCoVarsOfTypesWellScoped (tick_ty:map idType fvs) - let breakInfo = dehydrateCgBreakInfo ty_vars idOffSets tick_ty + let toWord :: Maybe (Id, WordOff) -> Maybe (Id, Word) + toWord = fmap (\(i, wo) -> (i, fromIntegral wo)) + breakInfo = dehydrateCgBreakInfo ty_vars (map toWord idOffSets) tick_ty newBreakInfo tick_no breakInfo hsc_env <- getHscEnv let cc | Just interp <- hsc_interp hsc_env @@ -407,7 +409,7 @@ schemeER_wrk d p (StgTick (Breakpoint tick_ty tick_no fvs) rhs) return $ breakInstr `consOL` code schemeER_wrk d p rhs = schemeE d 0 p rhs -getVarOffSets :: Platform -> StackDepth -> BCEnv -> [Id] -> [Maybe (Id, Word16)] +getVarOffSets :: Platform -> StackDepth -> BCEnv -> [Id] -> [Maybe (Id, WordOff)] getVarOffSets platform depth env = map getOffSet where getOffSet id = case lookupBCEnv_maybe id env of @@ -420,23 +422,9 @@ getVarOffSets platform depth env = map getOffSet -- this "adjustment" is needed due to stack manipulation for -- BRK_FUN in Interpreter.c In any case, this is used only when -- we trigger a breakpoint. - let !var_depth_ws = - trunc16W $ bytesToWords platform (depth - offset) + 2 + let !var_depth_ws = bytesToWords platform (depth - offset) + 2 in Just (id, var_depth_ws) -truncIntegral16 :: Integral a => a -> Word16 -truncIntegral16 w - | w > fromIntegral (maxBound :: Word16) - = panic "stack depth overflow" - | otherwise - = fromIntegral w - -trunc16B :: ByteOff -> Word16 -trunc16B = truncIntegral16 - -trunc16W :: WordOff -> Word16 -trunc16W = truncIntegral16 - fvsToEnv :: BCEnv -> CgStgRhs -> [Id] -- Takes the free variables of a right-hand side, and -- delivers an ordered list of the local variables that will @@ -493,7 +481,7 @@ returnUnliftedReps d s szb reps = do PUSH_BCO tuple_bco `consOL` unitOL RETURN_TUPLE return ( mkSlideB platform szb (d - s) -- clear to sequel - `appOL` ret) -- go + `consOL` ret) -- go -- construct and return an unboxed tuple returnUnboxedTuple @@ -557,7 +545,7 @@ schemeE d s p (StgLet _ext binds body) = do fvss = map (fvsToEnv p') rhss -- Sizes of free vars - size_w = trunc16W . idSizeW platform + size_w = idSizeW platform sizes = map (\rhs_fvs -> sum (map size_w rhs_fvs)) fvss -- the arity of each rhs @@ -576,13 +564,13 @@ schemeE d s p (StgLet _ext binds body) = do build_thunk :: StackDepth -> [Id] - -> Word16 + -> WordOff -> ProtoBCO Name - -> Word16 - -> Word16 + -> WordOff + -> HalfWord -> BcM BCInstrList build_thunk _ [] size bco off arity - = return (PUSH_BCO bco `consOL` unitOL (mkap (off+size) size)) + = return (PUSH_BCO bco `consOL` unitOL (mkap (off+size) (fromIntegral size))) where mkap | arity == 0 = MKAP | otherwise = MKPAP @@ -594,9 +582,9 @@ schemeE d s p (StgLet _ext binds body) = do alloc_code = toOL (zipWith mkAlloc sizes arities) where mkAlloc sz 0 - | is_tick = ALLOC_AP_NOUPD sz - | otherwise = ALLOC_AP sz - mkAlloc sz arity = ALLOC_PAP arity sz + | is_tick = ALLOC_AP_NOUPD (fromIntegral sz) + | otherwise = ALLOC_AP (fromIntegral sz) + mkAlloc sz arity = ALLOC_PAP arity (fromIntegral sz) is_tick = case binds of StgNonRec id _ -> occNameFS (getOccName id) == tickFS @@ -607,7 +595,7 @@ schemeE d s p (StgLet _ext binds body) = do build_thunk d' fvs size bco off arity compile_binds = - [ compile_bind d' fvs x rhs size arity (trunc16W n) + [ compile_bind d' fvs x rhs size arity n | (fvs, x, rhs, size, arity, n) <- zip6 fvss xs rhss sizes arities [n_binds, n_binds-1 .. 1] ] @@ -735,7 +723,7 @@ mkConAppCode orig_d _ p con args = app_code more_push_code <- do_pushery (d + arg_bytes) args return (push `appOL` more_push_code) do_pushery !d [] = do - let !n_arg_words = trunc16W $ bytesToWords platform (d - orig_d) + let !n_arg_words = bytesToWords platform (d - orig_d) return (unitOL (PACK con n_arg_words)) -- Push on the stack in the reverse order. @@ -761,7 +749,7 @@ doTailCall init_d s p fn args = do platform <- profilePlatform <$> getProfile assert (sz == wordSize platform) return () let slide = mkSlideB platform (d - init_d + wordSize platform) (init_d - s) - return (push_fn `appOL` (slide `appOL` unitOL ENTER)) + return (push_fn `appOL` (slide `consOL` unitOL ENTER)) do_pushes !d args reps = do let (push_apply, n, rest_of_reps) = findPushSeq reps (these_args, rest_of_args) = splitAt n args @@ -948,7 +936,7 @@ doCase d s p scrut bndr alts massert isAlgCase rhs_code <- schemeE stack_bot s p' rhs return (my_discr alt, - unitOL (UNPACK (trunc16W size)) `appOL` rhs_code) + unitOL (UNPACK size) `appOL` rhs_code) where real_bndrs = filterOut isTyVar bndrs @@ -1009,8 +997,9 @@ doCase d s p scrut bndr alts | ubx_tuple_frame = ([1], 2) -- call_info, tuple_BCO | otherwise = ([], 0) - bitmap_size = trunc16W $ fromIntegral extra_slots + - bytesToWords platform (d - s) + bitmap_size :: WordOff + bitmap_size = fromIntegral extra_slots + + bytesToWords platform (d - s) bitmap_size' :: Int bitmap_size' = fromIntegral bitmap_size @@ -1028,15 +1017,15 @@ doCase d s p scrut bndr alts isUnboxedSumType (idType id) = Nothing | isFollowableArg (bcIdArgRep platform id) = Just (fromIntegral rel_offset) | otherwise = Nothing - where rel_offset = trunc16W $ bytesToWords platform (d - offset) + where rel_offset = bytesToWords platform (d - offset) - bitmap = intsToReverseBitmap platform bitmap_size'{-size-} pointers + bitmap = intsToReverseBitmap platform bitmap_size' pointers alt_stuff <- mapM codeAlt alts alt_final0 <- mkMultiBranch maybe_ncons alt_stuff let alt_final - | ubx_tuple_frame = mkSlideW 0 2 `mappend` alt_final0 + | ubx_tuple_frame = SLIDE 0 2 `consOL` alt_final0 | otherwise = alt_final0 let @@ -1306,11 +1295,11 @@ mkStackBitmap -- ^ The stack layout of the arguments, where each offset is relative to the -- /bottom/ of the stack space they occupy. Their offsets must be word-aligned, -- and the list must be sorted in order of ascending offset (i.e. bottom to top). - -> (Word16, [StgWord]) + -> (WordOff, [StgWord]) mkStackBitmap platform nptrs_prefix args_info args = (bitmap_size, bitmap) where - bitmap_size = trunc16W $ nptrs_prefix + arg_bottom + bitmap_size = nptrs_prefix + arg_bottom bitmap = intsToReverseBitmap platform (fromIntegral bitmap_size) ptr_offsets arg_bottom = nativeCallSize args_info @@ -1384,7 +1373,7 @@ generatePrimCall d s p target _mb_unit _result_ty args (push_target `consOL` push_info `consOL` PUSH_BCO args_bco `consOL` - (mkSlideB platform szb (d - s) `appOL` unitOL PRIMCALL)) + (mkSlideB platform szb (d - s) `consOL` unitOL PRIMCALL)) -- ----------------------------------------------------------------------------- -- Deal with a CCall. @@ -1552,7 +1541,7 @@ generateCCall d0 s p (CCallSpec target cconv safety) result_ty args push_r = if returns_void then nilOL - else unitOL (PUSH_UBX (mkDummyLiteral platform r_rep) (trunc16W r_sizeW)) + else unitOL (PUSH_UBX (mkDummyLiteral platform r_rep) (r_sizeW)) -- generate the marshalling code we're going to call @@ -1560,7 +1549,7 @@ generateCCall d0 s p (CCallSpec target cconv safety) result_ty args -- instruction needs to describe the chunk of stack containing -- the ccall args to the GC, so it needs to know how large it -- is. See comment in Interpreter.c with the CCALL instruction. - stk_offset = trunc16W $ bytesToWords platform (d_after_r - s) + stk_offset = bytesToWords platform (d_after_r - s) conv = case cconv of CCallConv -> FFICCall @@ -1589,7 +1578,7 @@ generateCCall d0 s p (CCallSpec target cconv safety) result_ty args -- slide and return d_after_r_min_s = bytesToWords platform (d_after_r - s) - wrapup = mkSlideW (trunc16W r_sizeW) (d_after_r_min_s - r_sizeW) + wrapup = mkSlideW r_sizeW (d_after_r_min_s - r_sizeW) `snocOL` RETURN (toArgRep platform r_rep) --trace (show (arg1_offW, args_offW , (map argRepSizeW a_reps) )) $ return ( @@ -1793,8 +1782,9 @@ pushAtom d p (StgVarArg var) = do platform <- targetPlatform <$> getDynFlags let !szb = idSizeCon platform var + with_instr :: (ByteOff -> BCInstr) -> BcM (OrdList BCInstr, ByteOff) with_instr instr = do - let !off_b = trunc16B $ d - d_v + let !off_b = d - d_v return (unitOL (instr off_b), wordSize platform) case szb of @@ -1803,7 +1793,7 @@ pushAtom d p (StgVarArg var) 4 -> with_instr PUSH32_W _ -> do let !szw = bytesToWords platform szb - !off_w = trunc16W $ bytesToWords platform (d - d_v) + szw - 1 + !off_w = bytesToWords platform (d - d_v) + szw - 1 return (toOL (genericReplicate szw (PUSH_L off_w)), wordsToBytes platform szw) -- d - d_v offset from TOS to the first slot of the object @@ -1864,7 +1854,7 @@ pushLiteral padded lit = 1 -> PUSH_UBX8 lit 2 -> PUSH_UBX16 lit 4 -> PUSH_UBX32 lit - _ -> PUSH_UBX lit (trunc16W $ bytesToWords platform size_bytes) + _ -> PUSH_UBX lit (bytesToWords platform size_bytes) case lit of LitLabel {} -> code AddrRep @@ -1903,7 +1893,7 @@ pushConstrAtom d p va@(StgVarArg v) platform <- targetPlatform <$> getDynFlags let !szb = idSizeCon platform v done instr = do - let !off = trunc16B $ d - d_v + let !off = d - d_v return (unitOL (instr off), szb) case szb of 1 -> done PUSH8 @@ -2153,25 +2143,20 @@ unsupportedCConvException = throwGhcException (ProgramError ("Error: bytecode compiler can't handle some foreign calling conventions\n"++ " Workaround: use -fobject-code, or compile this module to .o separately.")) -mkSlideB :: Platform -> ByteOff -> ByteOff -> OrdList BCInstr -mkSlideB platform !nb !db = mkSlideW n d +mkSlideB :: Platform -> ByteOff -> ByteOff -> BCInstr +mkSlideB platform nb db = SLIDE n d where - !n = trunc16W $ bytesToWords platform nb + !n = bytesToWords platform nb !d = bytesToWords platform db -mkSlideW :: Word16 -> WordOff -> OrdList BCInstr +mkSlideW :: WordOff -> WordOff -> OrdList BCInstr mkSlideW !n !ws - | ws > fromIntegral limit - -- If the amount to slide doesn't fit in a Word16, generate multiple slide - -- instructions - = SLIDE n limit `consOL` mkSlideW n (ws - fromIntegral limit) | ws == 0 = nilOL | otherwise = unitOL (SLIDE n $ fromIntegral ws) - where - limit :: Word16 - limit = maxBound + + atomPrimRep :: StgArg -> PrimRep atomPrimRep (StgVarArg v) = bcIdPrimRep v ===================================== rts/Disassembler.c ===================================== @@ -28,7 +28,6 @@ int disInstr ( StgBCO *bco, int pc ) { - int i; StgWord16 instr; StgWord16* instrs = (StgWord16*)(bco->instrs->payload); @@ -75,14 +74,15 @@ disInstr ( StgBCO *bco, int pc ) debugBelch("\n"); pc += 4; break; - case bci_SWIZZLE: - debugBelch("SWIZZLE stkoff %d by %d\n", - instrs[pc], (signed int)instrs[pc+1]); - pc += 2; break; - case bci_CCALL: + case bci_SWIZZLE: { + W_ stkoff = BCO_GET_LARGE_ARG; + StgInt by = BCO_GET_LARGE_ARG; + debugBelch("SWIZZLE stkoff %" FMT_Word " by %" FMT_Int "\n", stkoff, by); + break; } + case bci_CCALL: { debugBelch("CCALL marshaller at 0x%" FMT_HexWord "\n", literals[instrs[pc]] ); - pc += 1; break; + pc += 1; break; } case bci_PRIMCALL: debugBelch("PRIMCALL\n"); break; @@ -91,34 +91,45 @@ disInstr ( StgBCO *bco, int pc ) debugBelch("STKCHECK %" FMT_Word "\n", (W_)stk_words_reqd ); break; } - case bci_PUSH_L: - debugBelch("PUSH_L %d\n", instrs[pc] ); - pc += 1; break; - case bci_PUSH_LL: - debugBelch("PUSH_LL %d %d\n", instrs[pc], instrs[pc+1] ); - pc += 2; break; - case bci_PUSH_LLL: - debugBelch("PUSH_LLL %d %d %d\n", instrs[pc], instrs[pc+1], - instrs[pc+2] ); - pc += 3; break; - case bci_PUSH8: - debugBelch("PUSH8 %d\n", instrs[pc] ); - pc += 1; break; - case bci_PUSH16: - debugBelch("PUSH16 %d\n", instrs[pc] ); - pc += 1; break; - case bci_PUSH32: - debugBelch("PUSH32 %d\n", instrs[pc] ); - pc += 1; break; - case bci_PUSH8_W: - debugBelch("PUSH8_W %d\n", instrs[pc] ); - pc += 1; break; - case bci_PUSH16_W: - debugBelch("PUSH16_W %d\n", instrs[pc] ); - pc += 1; break; - case bci_PUSH32_W: - debugBelch("PUSH32_W %d\n", instrs[pc] ); - pc += 1; break; + case bci_PUSH_L: { + W_ x1 = BCO_GET_LARGE_ARG; + debugBelch("PUSH_L %" FMT_Word "\n", x1 ); + break; } + case bci_PUSH_LL: { + W_ x1 = BCO_GET_LARGE_ARG; + W_ x2 = BCO_GET_LARGE_ARG; + debugBelch("PUSH_LL %" FMT_Word " %" FMT_Word "\n", x1, x2 ); + break; } + case bci_PUSH_LLL: { + W_ x1 = BCO_GET_LARGE_ARG; + W_ x2 = BCO_GET_LARGE_ARG; + W_ x3 = BCO_GET_LARGE_ARG; + debugBelch("PUSH_LLL %" FMT_Word " %" FMT_Word " %" FMT_Word "\n", x1, x2, x3); + break; } + case bci_PUSH8: { + W_ x1 = BCO_GET_LARGE_ARG; + debugBelch("PUSH8 %" FMT_Word "\n", x1 ); + break; } + case bci_PUSH16: { + W_ x1 = BCO_GET_LARGE_ARG; + debugBelch("PUSH16 %" FMT_Word "\n", x1 ); + break; } + case bci_PUSH32: { + W_ x1 = BCO_GET_LARGE_ARG; + debugBelch("PUSH32 %" FMT_Word "\n", x1 ); + break; } + case bci_PUSH8_W: { + W_ x1 = BCO_GET_LARGE_ARG; + debugBelch("PUSH8_W %" FMT_Word "\n", x1 ); + break; } + case bci_PUSH16_W: { + W_ x1 = BCO_GET_LARGE_ARG; + debugBelch("PUSH16_W %" FMT_Word "\n", x1 ); + break; } + case bci_PUSH32_W: { + W_ x1 = BCO_GET_LARGE_ARG; + debugBelch("PUSH32_W %" FMT_Word "\n", x1 ); + break; } case bci_PUSH_G: debugBelch("PUSH_G " ); printPtr( ptrs[instrs[pc]] ); debugBelch("\n" ); @@ -178,12 +189,14 @@ disInstr ( StgBCO *bco, int pc ) "PUSH_UBX32 0x%" FMT_HexWord32 "\n", (StgWord32) literals[instrs[pc]] ); pc += 1; break; - case bci_PUSH_UBX: + case bci_PUSH_UBX: { debugBelch("PUSH_UBX "); - for (i = 0; i < instrs[pc+1]; i++) - debugBelch("0x%" FMT_HexWord " ", literals[i + instrs[pc]] ); + W_ offset = BCO_GET_LARGE_ARG; + W_ nwords = BCO_GET_LARGE_ARG; + for (W_ i = 0; i < nwords; i++) + debugBelch("0x%" FMT_HexWord " ", literals[i + offset] ); debugBelch("\n"); - pc += 2; break; + break; } case bci_PUSH_APPLY_N: debugBelch("PUSH_APPLY_N\n"); break; @@ -217,35 +230,48 @@ disInstr ( StgBCO *bco, int pc ) case bci_PUSH_APPLY_PPPPPP: debugBelch("PUSH_APPLY_PPPPPP\n"); break; - case bci_SLIDE: - debugBelch("SLIDE %d down by %d\n", instrs[pc], instrs[pc+1] ); - pc += 2; break; - case bci_ALLOC_AP: - debugBelch("ALLOC_AP %d words\n", instrs[pc] ); - pc += 1; break; - case bci_ALLOC_AP_NOUPD: - debugBelch("ALLOC_AP_NOUPD %d words\n", instrs[pc] ); - pc += 1; break; - case bci_ALLOC_PAP: - debugBelch("ALLOC_PAP %d arity, %d words\n", - instrs[pc], instrs[pc+1] ); - pc += 2; break; - case bci_MKAP: - debugBelch("MKAP %d words, %d stkoff\n", instrs[pc+1], - instrs[pc] ); - pc += 2; break; - case bci_MKPAP: - debugBelch("MKPAP %d words, %d stkoff\n", instrs[pc+1], - instrs[pc] ); - pc += 2; break; - case bci_UNPACK: - debugBelch("UNPACK %d\n", instrs[pc] ); - pc += 1; break; - case bci_PACK: - debugBelch("PACK %d words with itbl ", instrs[pc+1] ); - printPtr( (StgPtr)literals[instrs[pc]] ); + case bci_SLIDE: { + W_ nwords = BCO_GET_LARGE_ARG; + W_ by = BCO_GET_LARGE_ARG; + debugBelch("SLIDE %" FMT_Word " down by %" FMT_Word "\n", nwords, by ); + break; } + case bci_ALLOC_AP: { + W_ nwords = BCO_GET_LARGE_ARG; + debugBelch("ALLOC_AP %" FMT_Word " words\n", nwords ); + break; } + case bci_ALLOC_AP_NOUPD: { + W_ nwords = BCO_GET_LARGE_ARG; + debugBelch("ALLOC_AP_NOUPD %" FMT_Word " words\n", nwords ); + break; } + case bci_ALLOC_PAP: { + W_ arity = BCO_GET_LARGE_ARG; + W_ nwords = BCO_GET_LARGE_ARG; + debugBelch("ALLOC_PAP %" FMT_Word " arity, %" FMT_Word " words\n", + arity, nwords ); + break; } + case bci_MKAP: { + W_ stkoff = BCO_GET_LARGE_ARG; + W_ nwords = BCO_GET_LARGE_ARG; + debugBelch("MKAP %" FMT_Word " words, %" FMT_Word " stkoff\n", nwords, + stkoff ); + break; } + case bci_MKPAP: { + W_ stkoff = BCO_GET_LARGE_ARG; + W_ nwords = BCO_GET_LARGE_ARG; + debugBelch("MKPAP %" FMT_Word " words, %" FMT_Word " stkoff\n", nwords, + stkoff ); + break; } + case bci_UNPACK: { + W_ nwords = BCO_GET_LARGE_ARG; + debugBelch("UNPACK %" FMT_Word "\n", nwords ); + break; } + case bci_PACK: { + int itbl = BCO_NEXT; + W_ nwords = BCO_GET_LARGE_ARG; + debugBelch("PACK %" FMT_Word " words with itbl ", nwords ); + printPtr( (StgPtr)literals[itbl] ); debugBelch("\n"); - pc += 2; break; + break; } case bci_TESTLT_I: { unsigned int discr = BCO_NEXT; ===================================== rts/Interpreter.c ===================================== @@ -1226,15 +1226,15 @@ run_BCO: } case bci_PUSH_L: { - int o1 = BCO_NEXT; + W_ o1 = BCO_GET_LARGE_ARG; SpW(-1) = SpW(o1); Sp_subW(1); goto nextInsn; } case bci_PUSH_LL: { - int o1 = BCO_NEXT; - int o2 = BCO_NEXT; + W_ o1 = BCO_GET_LARGE_ARG; + W_ o2 = BCO_GET_LARGE_ARG; SpW(-1) = SpW(o1); SpW(-2) = SpW(o2); Sp_subW(2); @@ -1242,9 +1242,9 @@ run_BCO: } case bci_PUSH_LLL: { - int o1 = BCO_NEXT; - int o2 = BCO_NEXT; - int o3 = BCO_NEXT; + W_ o1 = BCO_GET_LARGE_ARG; + W_ o2 = BCO_GET_LARGE_ARG; + W_ o3 = BCO_GET_LARGE_ARG; SpW(-1) = SpW(o1); SpW(-2) = SpW(o2); SpW(-3) = SpW(o3); @@ -1253,56 +1253,56 @@ run_BCO: } case bci_PUSH8: { - int off = BCO_NEXT; + W_ off = BCO_GET_LARGE_ARG; Sp_subB(1); *(StgWord8*)Sp = *(StgWord8*)(Sp_plusB(off+1)); goto nextInsn; } case bci_PUSH16: { - int off = BCO_NEXT; + W_ off = BCO_GET_LARGE_ARG; Sp_subB(2); *(StgWord16*)Sp = *(StgWord16*)(Sp_plusB(off+2)); goto nextInsn; } case bci_PUSH32: { - int off = BCO_NEXT; + W_ off = BCO_GET_LARGE_ARG; Sp_subB(4); *(StgWord32*)Sp = *(StgWord32*)(Sp_plusB(off+4)); goto nextInsn; } case bci_PUSH8_W: { - int off = BCO_NEXT; + W_ off = BCO_GET_LARGE_ARG; *(StgWord*)(Sp_minusW(1)) = *(StgWord8*)(Sp_plusB(off)); Sp_subW(1); goto nextInsn; } case bci_PUSH16_W: { - int off = BCO_NEXT; + W_ off = BCO_GET_LARGE_ARG; *(StgWord*)(Sp_minusW(1)) = *(StgWord16*)(Sp_plusB(off)); Sp_subW(1); goto nextInsn; } case bci_PUSH32_W: { - int off = BCO_NEXT; + W_ off = BCO_GET_LARGE_ARG; *(StgWord*)(Sp_minusW(1)) = *(StgWord32*)(Sp_plusB(off)); Sp_subW(1); goto nextInsn; } case bci_PUSH_G: { - int o1 = BCO_GET_LARGE_ARG; + W_ o1 = BCO_GET_LARGE_ARG; SpW(-1) = BCO_PTR(o1); Sp_subW(1); goto nextInsn; } case bci_PUSH_ALTS_P: { - int o_bco = BCO_GET_LARGE_ARG; + W_ o_bco = BCO_GET_LARGE_ARG; Sp_subW(2); SpW(1) = BCO_PTR(o_bco); SpW(0) = (W_)&stg_ctoi_R1p_info; @@ -1315,7 +1315,7 @@ run_BCO: } case bci_PUSH_ALTS_N: { - int o_bco = BCO_GET_LARGE_ARG; + W_ o_bco = BCO_GET_LARGE_ARG; SpW(-2) = (W_)&stg_ctoi_R1n_info; SpW(-1) = BCO_PTR(o_bco); Sp_subW(2); @@ -1328,7 +1328,7 @@ run_BCO: } case bci_PUSH_ALTS_F: { - int o_bco = BCO_GET_LARGE_ARG; + W_ o_bco = BCO_GET_LARGE_ARG; SpW(-2) = (W_)&stg_ctoi_F1_info; SpW(-1) = BCO_PTR(o_bco); Sp_subW(2); @@ -1341,7 +1341,7 @@ run_BCO: } case bci_PUSH_ALTS_D: { - int o_bco = BCO_GET_LARGE_ARG; + W_ o_bco = BCO_GET_LARGE_ARG; SpW(-2) = (W_)&stg_ctoi_D1_info; SpW(-1) = BCO_PTR(o_bco); Sp_subW(2); @@ -1354,7 +1354,7 @@ run_BCO: } case bci_PUSH_ALTS_L: { - int o_bco = BCO_GET_LARGE_ARG; + W_ o_bco = BCO_GET_LARGE_ARG; SpW(-2) = (W_)&stg_ctoi_L1_info; SpW(-1) = BCO_PTR(o_bco); Sp_subW(2); @@ -1367,7 +1367,7 @@ run_BCO: } case bci_PUSH_ALTS_V: { - int o_bco = BCO_GET_LARGE_ARG; + W_ o_bco = BCO_GET_LARGE_ARG; SpW(-2) = (W_)&stg_ctoi_V_info; SpW(-1) = BCO_PTR(o_bco); Sp_subW(2); @@ -1380,9 +1380,9 @@ run_BCO: } case bci_PUSH_ALTS_T: { - int o_bco = BCO_GET_LARGE_ARG; + W_ o_bco = BCO_GET_LARGE_ARG; W_ tuple_info = (W_)BCO_LIT(BCO_GET_LARGE_ARG); - int o_tuple_bco = BCO_GET_LARGE_ARG; + W_ o_tuple_bco = BCO_GET_LARGE_ARG; #if defined(PROFILING) SpW(-1) = (W_)cap->r.rCCCS; @@ -1526,30 +1526,30 @@ run_BCO: } case bci_PUSH_UBX8: { - int o_lit = BCO_GET_LARGE_ARG; + W_ o_lit = BCO_GET_LARGE_ARG; Sp_subB(1); *(StgWord8*)Sp = *(StgWord8*)(literals+o_lit); goto nextInsn; } case bci_PUSH_UBX16: { - int o_lit = BCO_GET_LARGE_ARG; + W_ o_lit = BCO_GET_LARGE_ARG; Sp_subB(2); *(StgWord16*)Sp = *(StgWord16*)(literals+o_lit); goto nextInsn; } case bci_PUSH_UBX32: { - int o_lit = BCO_GET_LARGE_ARG; + W_ o_lit = BCO_GET_LARGE_ARG; Sp_subB(4); *(StgWord32*)Sp = *(StgWord32*)(literals+o_lit); goto nextInsn; } case bci_PUSH_UBX: { - int i; - int o_lits = BCO_GET_LARGE_ARG; - int n_words = BCO_NEXT; + W_ i; + W_ o_lits = BCO_GET_LARGE_ARG; + W_ n_words = BCO_GET_LARGE_ARG; Sp_subW(n_words); for (i = 0; i < n_words; i++) { SpW(i) = (W_)BCO_LIT(o_lits+i); @@ -1558,10 +1558,10 @@ run_BCO: } case bci_SLIDE: { - int n = BCO_NEXT; - int by = BCO_NEXT; + W_ n = BCO_GET_LARGE_ARG; + W_ by = BCO_GET_LARGE_ARG; /* a_1, .. a_n, b_1, .. b_by, s => a_1, .. a_n, s */ - while(--n >= 0) { + while(n-- > 0) { SpW(n+by) = SpW(n); } Sp_addW(by); @@ -1570,7 +1570,7 @@ run_BCO: } case bci_ALLOC_AP: { - int n_payload = BCO_NEXT; + StgHalfWord n_payload = BCO_GET_LARGE_ARG; StgAP *ap = (StgAP*)allocate(cap, AP_sizeW(n_payload)); SpW(-1) = (W_)ap; ap->n_args = n_payload; @@ -1583,7 +1583,7 @@ run_BCO: } case bci_ALLOC_AP_NOUPD: { - int n_payload = BCO_NEXT; + StgHalfWord n_payload = BCO_GET_LARGE_ARG; StgAP *ap = (StgAP*)allocate(cap, AP_sizeW(n_payload)); SpW(-1) = (W_)ap; ap->n_args = n_payload; @@ -1597,8 +1597,8 @@ run_BCO: case bci_ALLOC_PAP: { StgPAP* pap; - int arity = BCO_NEXT; - int n_payload = BCO_NEXT; + StgHalfWord arity = BCO_GET_LARGE_ARG; + StgHalfWord n_payload = BCO_GET_LARGE_ARG; pap = (StgPAP*)allocate(cap, PAP_sizeW(n_payload)); SpW(-1) = (W_)pap; pap->n_args = n_payload; @@ -1611,11 +1611,11 @@ run_BCO: } case bci_MKAP: { - int i; - int stkoff = BCO_NEXT; - int n_payload = BCO_NEXT; + StgHalfWord i; + W_ stkoff = BCO_GET_LARGE_ARG; + StgHalfWord n_payload = BCO_GET_LARGE_ARG; StgAP* ap = (StgAP*)SpW(stkoff); - ASSERT((int)ap->n_args == n_payload); + ASSERT(ap->n_args == n_payload); ap->fun = (StgClosure*)SpW(0); // The function should be a BCO, and its bitmap should @@ -1635,11 +1635,11 @@ run_BCO: } case bci_MKPAP: { - int i; - int stkoff = BCO_NEXT; - int n_payload = BCO_NEXT; + StgHalfWord i; + W_ stkoff = BCO_GET_LARGE_ARG; + StgHalfWord n_payload = BCO_GET_LARGE_ARG; StgPAP* pap = (StgPAP*)SpW(stkoff); - ASSERT((int)pap->n_args == n_payload); + ASSERT(pap->n_args == n_payload); pap->fun = (StgClosure*)SpW(0); // The function should be a BCO @@ -1663,8 +1663,8 @@ run_BCO: case bci_UNPACK: { /* Unpack N ptr words from t.o.s constructor */ - int i; - int n_words = BCO_NEXT; + W_ i; + W_ n_words = BCO_GET_LARGE_ARG; StgClosure* con = UNTAG_CLOSURE((StgClosure*)SpW(0)); Sp_subW(n_words); for (i = 0; i < n_words; i++) { @@ -1674,9 +1674,9 @@ run_BCO: } case bci_PACK: { - int i; - int o_itbl = BCO_GET_LARGE_ARG; - int n_words = BCO_NEXT; + W_ i; + W_ o_itbl = BCO_GET_LARGE_ARG; + W_ n_words = BCO_GET_LARGE_ARG; StgInfoTable* itbl = INFO_PTR_TO_STRUCT((StgInfoTable *)BCO_LIT(o_itbl)); int request = CONSTR_sizeW( itbl->layout.payload.ptrs, itbl->layout.payload.nptrs ); @@ -2006,9 +2006,9 @@ run_BCO: } case bci_SWIZZLE: { - int stkoff = BCO_NEXT; - signed short n = (signed short)(BCO_NEXT); - SpW(stkoff) += (W_)n; + W_ stkoff = BCO_GET_LARGE_ARG; + StgInt n = BCO_GET_LARGE_ARG; + (*(StgInt*)(Sp_plusW(stkoff))) += n; goto nextInsn; } @@ -2020,7 +2020,7 @@ run_BCO: case bci_CCALL: { void *tok; - int stk_offset = BCO_NEXT; + W_ stk_offset = BCO_GET_LARGE_ARG; int o_itbl = BCO_GET_LARGE_ARG; int flags = BCO_NEXT; bool interruptible = flags & 0x1; @@ -2056,7 +2056,7 @@ run_BCO: uint32_t nargs = cif->nargs; uint32_t ret_size; uint32_t i; - int j; + W_ j; StgPtr p; W_ ret[2]; // max needed W_ *arguments[stk_offset]; // max needed ===================================== testsuite/tests/ghci/should_run/LargeBCO.hs ===================================== @@ -0,0 +1,32 @@ + +{- + Test for BCOs that use larger than 16 bit stack offsets. + + Using Template Haskell because loading the code directly into + GHCi produces different bytecode that does not have large stack + offsets. + + testcase from #22888 + -} + +{-# LANGUAGE TemplateHaskell #-} +module Main where + +import LargeBCO_A + +import Data.Binary.Get (runGet, Get, getWord32be) +import qualified Data.ByteString.Lazy as B +import Data.Bits (Bits(..)) +import Data.Word (Word32) + +import Language.Haskell.TH.Lib + +result :: String +result = $(let initState = SHA256S 1 2 3 4 5 6 7 8 + input = B.replicate 64 0 + output = runGet (processSHA256Block initState) input + in litE (stringL (show output)) + ) + +main :: IO () +main = putStrLn result ===================================== testsuite/tests/ghci/should_run/LargeBCO.stdout ===================================== @@ -0,0 +1 @@ +SHA256S 1251949539 2800197164 2023110800 2630081144 3831421046 3141654527 2982319529 2535435789 ===================================== testsuite/tests/ghci/should_run/LargeBCO_A.hs ===================================== @@ -0,0 +1,215 @@ +{-# LANGUAGE TemplateHaskell #-} +module LargeBCO_A (processSHA256Block, SHA256State(..)) where + +import Data.Binary.Get (runGet, Get, getWord32be) +import qualified Data.ByteString.Lazy as B +import Data.Binary.Get (Get, getWord32be) +import Data.Bits (Bits(..)) +import Data.Word (Word32) +import System.Environment + +data SHA256Sched = SHA256Sched !Word32 !Word32 !Word32 !Word32 !Word32 -- 00-04 + !Word32 !Word32 !Word32 !Word32 !Word32 -- 05-09 + !Word32 !Word32 !Word32 !Word32 !Word32 -- 10-04 + !Word32 !Word32 !Word32 !Word32 !Word32 -- 15-09 + !Word32 !Word32 !Word32 !Word32 !Word32 -- 20-04 + !Word32 !Word32 !Word32 !Word32 !Word32 -- 25-09 + !Word32 !Word32 !Word32 !Word32 !Word32 -- 30-04 + !Word32 !Word32 !Word32 !Word32 !Word32 -- 35-09 + !Word32 !Word32 !Word32 !Word32 !Word32 -- 40-04 + !Word32 !Word32 !Word32 !Word32 !Word32 -- 45-09 + !Word32 !Word32 !Word32 !Word32 !Word32 -- 50-04 + !Word32 !Word32 !Word32 !Word32 !Word32 -- 55-09 + !Word32 !Word32 !Word32 !Word32 -- 60-63 + +data SHA256State = SHA256S !Word32 !Word32 !Word32 !Word32 + !Word32 !Word32 !Word32 !Word32 + deriving (Show) + +{-# SPECIALIZE ch :: Word32 -> Word32 -> Word32 -> Word32 #-} +ch :: Bits a => a -> a -> a -> a +ch x y z = (x .&. y) `xor` (complement x .&. z) + +{-# SPECIALIZE maj :: Word32 -> Word32 -> Word32 -> Word32 #-} +maj :: Bits a => a -> a -> a -> a +maj x y z = (x .&. (y .|. z)) .|. (y .&. z) + +bsig256_0 :: Word32 -> Word32 +bsig256_0 x = rotateR x 2 `xor` rotateR x 13 `xor` rotateR x 22 + +bsig256_1 :: Word32 -> Word32 +bsig256_1 x = rotateR x 6 `xor` rotateR x 11 `xor` rotateR x 25 + +lsig256_0 :: Word32 -> Word32 +lsig256_0 x = rotateR x 7 `xor` rotateR x 18 `xor` shiftR x 3 + +lsig256_1 :: Word32 -> Word32 +lsig256_1 x = rotateR x 17 `xor` rotateR x 19 `xor` shiftR x 10 + +getSHA256Sched :: Get SHA256Sched +getSHA256Sched = do + w00 <- getWord32be + w01 <- getWord32be + w02 <- getWord32be + w03 <- getWord32be + w04 <- getWord32be + w05 <- getWord32be + w06 <- getWord32be + w07 <- getWord32be + w08 <- getWord32be + w09 <- getWord32be + w10 <- getWord32be + w11 <- getWord32be + w12 <- getWord32be + w13 <- getWord32be + w14 <- getWord32be + w15 <- getWord32be + let w16 = lsig256_1 w14 + w09 + lsig256_0 w01 + w00 + w17 = lsig256_1 w15 + w10 + lsig256_0 w02 + w01 + w18 = lsig256_1 w16 + w11 + lsig256_0 w03 + w02 + w19 = lsig256_1 w17 + w12 + lsig256_0 w04 + w03 + w20 = lsig256_1 w18 + w13 + lsig256_0 w05 + w04 + w21 = lsig256_1 w19 + w14 + lsig256_0 w06 + w05 + w22 = lsig256_1 w20 + w15 + lsig256_0 w07 + w06 + w23 = lsig256_1 w21 + w16 + lsig256_0 w08 + w07 + w24 = lsig256_1 w22 + w17 + lsig256_0 w09 + w08 + w25 = lsig256_1 w23 + w18 + lsig256_0 w10 + w09 + w26 = lsig256_1 w24 + w19 + lsig256_0 w11 + w10 + w27 = lsig256_1 w25 + w20 + lsig256_0 w12 + w11 + w28 = lsig256_1 w26 + w21 + lsig256_0 w13 + w12 + w29 = lsig256_1 w27 + w22 + lsig256_0 w14 + w13 + w30 = lsig256_1 w28 + w23 + lsig256_0 w15 + w14 + w31 = lsig256_1 w29 + w24 + lsig256_0 w16 + w15 + w32 = lsig256_1 w30 + w25 + lsig256_0 w17 + w16 + w33 = lsig256_1 w31 + w26 + lsig256_0 w18 + w17 + w34 = lsig256_1 w32 + w27 + lsig256_0 w19 + w18 + w35 = lsig256_1 w33 + w28 + lsig256_0 w20 + w19 + w36 = lsig256_1 w34 + w29 + lsig256_0 w21 + w20 + w37 = lsig256_1 w35 + w30 + lsig256_0 w22 + w21 + w38 = lsig256_1 w36 + w31 + lsig256_0 w23 + w22 + w39 = lsig256_1 w37 + w32 + lsig256_0 w24 + w23 + w40 = lsig256_1 w38 + w33 + lsig256_0 w25 + w24 + w41 = lsig256_1 w39 + w34 + lsig256_0 w26 + w25 + w42 = lsig256_1 w40 + w35 + lsig256_0 w27 + w26 + w43 = lsig256_1 w41 + w36 + lsig256_0 w28 + w27 + w44 = lsig256_1 w42 + w37 + lsig256_0 w29 + w28 + w45 = lsig256_1 w43 + w38 + lsig256_0 w30 + w29 + w46 = lsig256_1 w44 + w39 + lsig256_0 w31 + w30 + w47 = lsig256_1 w45 + w40 + lsig256_0 w32 + w31 + w48 = lsig256_1 w46 + w41 + lsig256_0 w33 + w32 + w49 = lsig256_1 w47 + w42 + lsig256_0 w34 + w33 + w50 = lsig256_1 w48 + w43 + lsig256_0 w35 + w34 + w51 = lsig256_1 w49 + w44 + lsig256_0 w36 + w35 + w52 = lsig256_1 w50 + w45 + lsig256_0 w37 + w36 + w53 = lsig256_1 w51 + w46 + lsig256_0 w38 + w37 + w54 = lsig256_1 w52 + w47 + lsig256_0 w39 + w38 + w55 = lsig256_1 w53 + w48 + lsig256_0 w40 + w39 + w56 = lsig256_1 w54 + w49 + lsig256_0 w41 + w40 + w57 = lsig256_1 w55 + w50 + lsig256_0 w42 + w41 + w58 = lsig256_1 w56 + w51 + lsig256_0 w43 + w42 + w59 = lsig256_1 w57 + w52 + lsig256_0 w44 + w43 + w60 = lsig256_1 w58 + w53 + lsig256_0 w45 + w44 + w61 = lsig256_1 w59 + w54 + lsig256_0 w46 + w45 + w62 = lsig256_1 w60 + w55 + lsig256_0 w47 + w46 + w63 = lsig256_1 w61 + w56 + lsig256_0 w48 + w47 + return $! SHA256Sched 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 + +{-# NOINLINE processSHA256Block #-} +processSHA256Block :: SHA256State -> Get SHA256State +processSHA256Block !s00@(SHA256S a00 b00 c00 d00 e00 f00 g00 h00) = do + (SHA256Sched 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) <- getSHA256Sched + let s01 = step256 s00 0x428a2f98 w00 + s02 = step256 s01 0x71374491 w01 + s03 = step256 s02 0xb5c0fbcf w02 + s04 = step256 s03 0xe9b5dba5 w03 + s05 = step256 s04 0x3956c25b w04 + s06 = step256 s05 0x59f111f1 w05 + s07 = step256 s06 0x923f82a4 w06 + s08 = step256 s07 0xab1c5ed5 w07 + s09 = step256 s08 0xd807aa98 w08 + s10 = step256 s09 0x12835b01 w09 + s11 = step256 s10 0x243185be w10 + s12 = step256 s11 0x550c7dc3 w11 + s13 = step256 s12 0x72be5d74 w12 + s14 = step256 s13 0x80deb1fe w13 + s15 = step256 s14 0x9bdc06a7 w14 + s16 = step256 s15 0xc19bf174 w15 + s17 = step256 s16 0xe49b69c1 w16 + s18 = step256 s17 0xefbe4786 w17 + s19 = step256 s18 0x0fc19dc6 w18 + s20 = step256 s19 0x240ca1cc w19 + s21 = step256 s20 0x2de92c6f w20 + s22 = step256 s21 0x4a7484aa w21 + s23 = step256 s22 0x5cb0a9dc w22 + s24 = step256 s23 0x76f988da w23 + s25 = step256 s24 0x983e5152 w24 + s26 = step256 s25 0xa831c66d w25 + s27 = step256 s26 0xb00327c8 w26 + s28 = step256 s27 0xbf597fc7 w27 + s29 = step256 s28 0xc6e00bf3 w28 + s30 = step256 s29 0xd5a79147 w29 + s31 = step256 s30 0x06ca6351 w30 + s32 = step256 s31 0x14292967 w31 + s33 = step256 s32 0x27b70a85 w32 + s34 = step256 s33 0x2e1b2138 w33 + s35 = step256 s34 0x4d2c6dfc w34 + s36 = step256 s35 0x53380d13 w35 + s37 = step256 s36 0x650a7354 w36 + s38 = step256 s37 0x766a0abb w37 + s39 = step256 s38 0x81c2c92e w38 + s40 = step256 s39 0x92722c85 w39 + s41 = step256 s40 0xa2bfe8a1 w40 + s42 = step256 s41 0xa81a664b w41 + s43 = step256 s42 0xc24b8b70 w42 + s44 = step256 s43 0xc76c51a3 w43 + s45 = step256 s44 0xd192e819 w44 + s46 = step256 s45 0xd6990624 w45 + s47 = step256 s46 0xf40e3585 w46 + s48 = step256 s47 0x106aa070 w47 + s49 = step256 s48 0x19a4c116 w48 + s50 = step256 s49 0x1e376c08 w49 + s51 = step256 s50 0x2748774c w50 + s52 = step256 s51 0x34b0bcb5 w51 + s53 = step256 s52 0x391c0cb3 w52 + s54 = step256 s53 0x4ed8aa4a w53 + s55 = step256 s54 0x5b9cca4f w54 + s56 = step256 s55 0x682e6ff3 w55 + s57 = step256 s56 0x748f82ee w56 + s58 = step256 s57 0x78a5636f w57 + s59 = step256 s58 0x84c87814 w58 + s60 = step256 s59 0x8cc70208 w59 + s61 = step256 s60 0x90befffa w60 + s62 = step256 s61 0xa4506ceb w61 + s63 = step256 s62 0xbef9a3f7 w62 + s64 = step256 s63 0xc67178f2 w63 + SHA256S a64 b64 c64 d64 e64 f64 g64 h64 = s64 + return $! SHA256S (a00 + a64) (b00 + b64) (c00 + c64) (d00 + d64) + (e00 + e64) (f00 + f64) (g00 + g64) (h00 + h64) + +{-# INLINE step256 #-} +step256 :: SHA256State -> Word32 -> Word32 -> SHA256State +step256 !(SHA256S a b c d e f g h) k w = SHA256S a' b' c' d' e' f' g' h' + where + t1 = h + bsig256_1 e + ch e f g + k + w + t2 = bsig256_0 a + maj a b c + h' = g + g' = f + f' = e + e' = d + t1 + d' = c + c' = b + b' = a + a' = t1 + t2 + ===================================== testsuite/tests/ghci/should_run/T22888.hs ===================================== @@ -0,0 +1,221 @@ +{- + + This module produced a panic when compiled with -fbyte-code-and-object-code + and optimization because it required stack offsets greater than 65535 + + See #22888 + + -} + +module Main (main, processSHA256Block) where + +import Data.Binary.Get (Get, getWord32be) +import Data.Bits (Bits(..)) +import Data.Word (Word32) + +main :: IO () +main = pure () + +data SHA256Sched = SHA256Sched !Word32 !Word32 !Word32 !Word32 !Word32 -- 00-04 + !Word32 !Word32 !Word32 !Word32 !Word32 -- 05-09 + !Word32 !Word32 !Word32 !Word32 !Word32 -- 10-04 + !Word32 !Word32 !Word32 !Word32 !Word32 -- 15-09 + !Word32 !Word32 !Word32 !Word32 !Word32 -- 20-04 + !Word32 !Word32 !Word32 !Word32 !Word32 -- 25-09 + !Word32 !Word32 !Word32 !Word32 !Word32 -- 30-04 + !Word32 !Word32 !Word32 !Word32 !Word32 -- 35-09 + !Word32 !Word32 !Word32 !Word32 !Word32 -- 40-04 + !Word32 !Word32 !Word32 !Word32 !Word32 -- 45-09 + !Word32 !Word32 !Word32 !Word32 !Word32 -- 50-04 + !Word32 !Word32 !Word32 !Word32 !Word32 -- 55-09 + !Word32 !Word32 !Word32 !Word32 -- 60-63 + +data SHA256State = SHA256S !Word32 !Word32 !Word32 !Word32 + !Word32 !Word32 !Word32 !Word32 + +{-# SPECIALIZE ch :: Word32 -> Word32 -> Word32 -> Word32 #-} +ch :: Bits a => a -> a -> a -> a +ch x y z = (x .&. y) `xor` (complement x .&. z) + +{-# SPECIALIZE maj :: Word32 -> Word32 -> Word32 -> Word32 #-} +maj :: Bits a => a -> a -> a -> a +maj x y z = (x .&. (y .|. z)) .|. (y .&. z) + +bsig256_0 :: Word32 -> Word32 +bsig256_0 x = rotateR x 2 `xor` rotateR x 13 `xor` rotateR x 22 + +bsig256_1 :: Word32 -> Word32 +bsig256_1 x = rotateR x 6 `xor` rotateR x 11 `xor` rotateR x 25 + +lsig256_0 :: Word32 -> Word32 +lsig256_0 x = rotateR x 7 `xor` rotateR x 18 `xor` shiftR x 3 + +lsig256_1 :: Word32 -> Word32 +lsig256_1 x = rotateR x 17 `xor` rotateR x 19 `xor` shiftR x 10 + +getSHA256Sched :: Get SHA256Sched +getSHA256Sched = do + w00 <- getWord32be + w01 <- getWord32be + w02 <- getWord32be + w03 <- getWord32be + w04 <- getWord32be + w05 <- getWord32be + w06 <- getWord32be + w07 <- getWord32be + w08 <- getWord32be + w09 <- getWord32be + w10 <- getWord32be + w11 <- getWord32be + w12 <- getWord32be + w13 <- getWord32be + w14 <- getWord32be + w15 <- getWord32be + let w16 = lsig256_1 w14 + w09 + lsig256_0 w01 + w00 + w17 = lsig256_1 w15 + w10 + lsig256_0 w02 + w01 + w18 = lsig256_1 w16 + w11 + lsig256_0 w03 + w02 + w19 = lsig256_1 w17 + w12 + lsig256_0 w04 + w03 + w20 = lsig256_1 w18 + w13 + lsig256_0 w05 + w04 + w21 = lsig256_1 w19 + w14 + lsig256_0 w06 + w05 + w22 = lsig256_1 w20 + w15 + lsig256_0 w07 + w06 + w23 = lsig256_1 w21 + w16 + lsig256_0 w08 + w07 + w24 = lsig256_1 w22 + w17 + lsig256_0 w09 + w08 + w25 = lsig256_1 w23 + w18 + lsig256_0 w10 + w09 + w26 = lsig256_1 w24 + w19 + lsig256_0 w11 + w10 + w27 = lsig256_1 w25 + w20 + lsig256_0 w12 + w11 + w28 = lsig256_1 w26 + w21 + lsig256_0 w13 + w12 + w29 = lsig256_1 w27 + w22 + lsig256_0 w14 + w13 + w30 = lsig256_1 w28 + w23 + lsig256_0 w15 + w14 + w31 = lsig256_1 w29 + w24 + lsig256_0 w16 + w15 + w32 = lsig256_1 w30 + w25 + lsig256_0 w17 + w16 + w33 = lsig256_1 w31 + w26 + lsig256_0 w18 + w17 + w34 = lsig256_1 w32 + w27 + lsig256_0 w19 + w18 + w35 = lsig256_1 w33 + w28 + lsig256_0 w20 + w19 + w36 = lsig256_1 w34 + w29 + lsig256_0 w21 + w20 + w37 = lsig256_1 w35 + w30 + lsig256_0 w22 + w21 + w38 = lsig256_1 w36 + w31 + lsig256_0 w23 + w22 + w39 = lsig256_1 w37 + w32 + lsig256_0 w24 + w23 + w40 = lsig256_1 w38 + w33 + lsig256_0 w25 + w24 + w41 = lsig256_1 w39 + w34 + lsig256_0 w26 + w25 + w42 = lsig256_1 w40 + w35 + lsig256_0 w27 + w26 + w43 = lsig256_1 w41 + w36 + lsig256_0 w28 + w27 + w44 = lsig256_1 w42 + w37 + lsig256_0 w29 + w28 + w45 = lsig256_1 w43 + w38 + lsig256_0 w30 + w29 + w46 = lsig256_1 w44 + w39 + lsig256_0 w31 + w30 + w47 = lsig256_1 w45 + w40 + lsig256_0 w32 + w31 + w48 = lsig256_1 w46 + w41 + lsig256_0 w33 + w32 + w49 = lsig256_1 w47 + w42 + lsig256_0 w34 + w33 + w50 = lsig256_1 w48 + w43 + lsig256_0 w35 + w34 + w51 = lsig256_1 w49 + w44 + lsig256_0 w36 + w35 + w52 = lsig256_1 w50 + w45 + lsig256_0 w37 + w36 + w53 = lsig256_1 w51 + w46 + lsig256_0 w38 + w37 + w54 = lsig256_1 w52 + w47 + lsig256_0 w39 + w38 + w55 = lsig256_1 w53 + w48 + lsig256_0 w40 + w39 + w56 = lsig256_1 w54 + w49 + lsig256_0 w41 + w40 + w57 = lsig256_1 w55 + w50 + lsig256_0 w42 + w41 + w58 = lsig256_1 w56 + w51 + lsig256_0 w43 + w42 + w59 = lsig256_1 w57 + w52 + lsig256_0 w44 + w43 + w60 = lsig256_1 w58 + w53 + lsig256_0 w45 + w44 + w61 = lsig256_1 w59 + w54 + lsig256_0 w46 + w45 + w62 = lsig256_1 w60 + w55 + lsig256_0 w47 + w46 + w63 = lsig256_1 w61 + w56 + lsig256_0 w48 + w47 + return $! SHA256Sched 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 + +processSHA256Block :: SHA256State -> Get SHA256State +processSHA256Block !s00@(SHA256S a00 b00 c00 d00 e00 f00 g00 h00) = do + (SHA256Sched 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) <- getSHA256Sched + let s01 = step256 s00 0x428a2f98 w00 + s02 = step256 s01 0x71374491 w01 + s03 = step256 s02 0xb5c0fbcf w02 + s04 = step256 s03 0xe9b5dba5 w03 + s05 = step256 s04 0x3956c25b w04 + s06 = step256 s05 0x59f111f1 w05 + s07 = step256 s06 0x923f82a4 w06 + s08 = step256 s07 0xab1c5ed5 w07 + s09 = step256 s08 0xd807aa98 w08 + s10 = step256 s09 0x12835b01 w09 + s11 = step256 s10 0x243185be w10 + s12 = step256 s11 0x550c7dc3 w11 + s13 = step256 s12 0x72be5d74 w12 + s14 = step256 s13 0x80deb1fe w13 + s15 = step256 s14 0x9bdc06a7 w14 + s16 = step256 s15 0xc19bf174 w15 + s17 = step256 s16 0xe49b69c1 w16 + s18 = step256 s17 0xefbe4786 w17 + s19 = step256 s18 0x0fc19dc6 w18 + s20 = step256 s19 0x240ca1cc w19 + s21 = step256 s20 0x2de92c6f w20 + s22 = step256 s21 0x4a7484aa w21 + s23 = step256 s22 0x5cb0a9dc w22 + s24 = step256 s23 0x76f988da w23 + s25 = step256 s24 0x983e5152 w24 + s26 = step256 s25 0xa831c66d w25 + s27 = step256 s26 0xb00327c8 w26 + s28 = step256 s27 0xbf597fc7 w27 + s29 = step256 s28 0xc6e00bf3 w28 + s30 = step256 s29 0xd5a79147 w29 + s31 = step256 s30 0x06ca6351 w30 + s32 = step256 s31 0x14292967 w31 + s33 = step256 s32 0x27b70a85 w32 + s34 = step256 s33 0x2e1b2138 w33 + s35 = step256 s34 0x4d2c6dfc w34 + s36 = step256 s35 0x53380d13 w35 + s37 = step256 s36 0x650a7354 w36 + s38 = step256 s37 0x766a0abb w37 + s39 = step256 s38 0x81c2c92e w38 + s40 = step256 s39 0x92722c85 w39 + s41 = step256 s40 0xa2bfe8a1 w40 + s42 = step256 s41 0xa81a664b w41 + s43 = step256 s42 0xc24b8b70 w42 + s44 = step256 s43 0xc76c51a3 w43 + s45 = step256 s44 0xd192e819 w44 + s46 = step256 s45 0xd6990624 w45 + s47 = step256 s46 0xf40e3585 w46 + s48 = step256 s47 0x106aa070 w47 + s49 = step256 s48 0x19a4c116 w48 + s50 = step256 s49 0x1e376c08 w49 + s51 = step256 s50 0x2748774c w50 + s52 = step256 s51 0x34b0bcb5 w51 + s53 = step256 s52 0x391c0cb3 w52 + s54 = step256 s53 0x4ed8aa4a w53 + s55 = step256 s54 0x5b9cca4f w54 + s56 = step256 s55 0x682e6ff3 w55 + s57 = step256 s56 0x748f82ee w56 + s58 = step256 s57 0x78a5636f w57 + s59 = step256 s58 0x84c87814 w58 + s60 = step256 s59 0x8cc70208 w59 + s61 = step256 s60 0x90befffa w60 + s62 = step256 s61 0xa4506ceb w61 + s63 = step256 s62 0xbef9a3f7 w62 + s64 = step256 s63 0xc67178f2 w63 + SHA256S a64 b64 c64 d64 e64 f64 g64 h64 = s64 + return $! SHA256S (a00 + a64) (b00 + b64) (c00 + c64) (d00 + d64) + (e00 + e64) (f00 + f64) (g00 + g64) (h00 + h64) + +{-# INLINE step256 #-} +step256 :: SHA256State -> Word32 -> Word32 -> SHA256State +step256 !(SHA256S a b c d e f g h) k w = SHA256S a' b' c' d' e' f' g' h' + where + t1 = h + bsig256_1 e + ch e f g + k + w + t2 = bsig256_0 a + maj a b c + h' = g + g' = f + f' = e + e' = d + t1 + d' = c + c' = b + b' = a + a' = t1 + t2 + ===================================== testsuite/tests/ghci/should_run/all.T ===================================== @@ -85,10 +85,10 @@ test('T19628', [extra_files(['T19628a.hs']), only_ways(['ghci']) ], compile_and_ test('T21052', just_ghci, ghci_script, ['T21052.script']) test('T21300', just_ghci, ghci_script, ['T21300.script']) test('UnliftedDataType2', just_ghci, compile_and_run, ['']) - test('T22829', just_ghci + [extra_hc_opts("-Wmissing-import-lists -Werror")], compile_and_run, ['']) test('T23229', just_ghci + [extra_hc_opts("-this-unit-id my-package -Wno-missing-methods T23229")], ghci_script, ['T23229.script']) test('T22958a', just_ghci, compile_and_run, ['']) test('T22958b', just_ghci, compile_and_run, ['']) test('T22958c', just_ghci, compile_and_run, ['']) test('GhciMainIs', just_ghci, compile_and_run, ['-main-is otherMain']) +test('LargeBCO', [extra_files(['LargeBCO_A.hs']), req_interp, extra_hc_opts("-O -fbyte-code-and-object-code -fprefer-byte-code")], compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/564164ef323a9f2cdeb8c69dcb2cf6df6382de4e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/564164ef323a9f2cdeb8c69dcb2cf6df6382de4e You're receiving 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 Jun 26 17:16:11 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 26 Jun 2023 13:16:11 -0400 Subject: [Git][ghc/ghc][master] JS: support levity-polymorphic datatypes (#22360,#22291) Message-ID: <6499c7dba3aa2_2402e0c74e87849c@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 21 changed files: - compiler/GHC/Builtin/Types.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Stg/Syntax.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/ArgRep.hs - compiler/GHC/StgToCmm/Lit.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/StgToJS/Types.hs - compiler/GHC/StgToJS/Utils.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/RepType.hs - rts/js/rts.js - rts/js/verify.js - testsuite/tests/primops/should_run/all.T - + testsuite/tests/rep-poly/T22291.hs - + testsuite/tests/rep-poly/T22291b.hs - testsuite/tests/rep-poly/all.T - testsuite/tests/unlifted-datatypes/should_compile/all.T Changes: ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -1636,10 +1636,11 @@ boxedRepDataCon = pcSpecialDataCon boxedRepDataConName where -- See Note [Getting from RuntimeRep to PrimRep] in RepType prim_rep_fun [lev] - = case tyConPromDataConInfo (tyConAppTyCon lev) of - Levity Lifted -> [LiftedRep] - Levity Unlifted -> [UnliftedRep] - _ -> pprPanic "boxedRepDataCon" (ppr lev) + = case tyConAppTyCon_maybe lev of + Just tc -> case tyConPromDataConInfo tc of + Levity l -> [BoxedRep (Just l)] + _ -> [BoxedRep Nothing] + Nothing -> [BoxedRep Nothing] prim_rep_fun args = pprPanic "boxedRepDataCon" (ppr args) ===================================== compiler/GHC/Cmm/Utils.hs ===================================== @@ -98,8 +98,7 @@ import GHC.Cmm.Dataflow.Collections primRepCmmType :: Platform -> PrimRep -> CmmType primRepCmmType platform = \case VoidRep -> panic "primRepCmmType:VoidRep" - LiftedRep -> gcWord platform - UnliftedRep -> gcWord platform + BoxedRep _ -> gcWord platform IntRep -> bWord platform WordRep -> bWord platform Int8Rep -> b8 @@ -142,8 +141,7 @@ typeCmmType platform ty = primRepCmmType platform (typePrimRep1 ty) primRepForeignHint :: PrimRep -> ForeignHint primRepForeignHint VoidRep = panic "primRepForeignHint:VoidRep" -primRepForeignHint LiftedRep = AddrHint -primRepForeignHint UnliftedRep = AddrHint +primRepForeignHint (BoxedRep _) = AddrHint primRepForeignHint IntRep = SignedHint primRepForeignHint Int8Rep = SignedHint primRepForeignHint Int16Rep = SignedHint ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -124,7 +124,7 @@ module GHC.Core.TyCon( tyConRepModOcc, -- * Primitive representations of Types - PrimRep(..), PrimElemRep(..), + PrimRep(..), PrimElemRep(..), Levity(..), primElemRepToPrimRep, isVoidRep, isGcPtrRep, primRepSizeB, @@ -1536,8 +1536,7 @@ See Note [RuntimeRep and PrimRep] in GHC.Types.RepType. -- "GHC.Types.RepType" and Note [VoidRep] in "GHC.Types.RepType". data PrimRep = VoidRep - | LiftedRep - | UnliftedRep -- ^ Unlifted pointer + | BoxedRep {-# UNPACK #-} !(Maybe Levity) -- ^ Boxed, heap value | Int8Rep -- ^ Signed, 8-bit value | Int16Rep -- ^ Signed, 16-bit value | Int32Rep -- ^ Signed, 32-bit value @@ -1548,7 +1547,7 @@ data PrimRep | Word32Rep -- ^ Unsigned, 32 bit value | Word64Rep -- ^ Unsigned, 64 bit value | WordRep -- ^ Unsigned, word-sized value - | AddrRep -- ^ A pointer, but /not/ to a Haskell value (use '(Un)liftedRep') + | AddrRep -- ^ A pointer, but /not/ to a Haskell value (use 'BoxedRep') | FloatRep | DoubleRep | VecRep Int PrimElemRep -- ^ A vector @@ -1575,42 +1574,47 @@ instance Outputable PrimElemRep where instance Binary PrimRep where put_ bh VoidRep = putByte bh 0 - put_ bh LiftedRep = putByte bh 1 - put_ bh UnliftedRep = putByte bh 2 - put_ bh Int8Rep = putByte bh 3 - put_ bh Int16Rep = putByte bh 4 - put_ bh Int32Rep = putByte bh 5 - put_ bh Int64Rep = putByte bh 6 - put_ bh IntRep = putByte bh 7 - put_ bh Word8Rep = putByte bh 8 - put_ bh Word16Rep = putByte bh 9 - put_ bh Word32Rep = putByte bh 10 - put_ bh Word64Rep = putByte bh 11 - put_ bh WordRep = putByte bh 12 - put_ bh AddrRep = putByte bh 13 - put_ bh FloatRep = putByte bh 14 - put_ bh DoubleRep = putByte bh 15 - put_ bh (VecRep n per) = putByte bh 16 *> put_ bh n *> put_ bh per + put_ bh (BoxedRep ml) = case ml of + -- cheaper storage of the levity than using + -- the Binary (Maybe Levity) instance + Nothing -> putByte bh 1 + Just Lifted -> putByte bh 2 + Just Unlifted -> putByte bh 3 + put_ bh Int8Rep = putByte bh 4 + put_ bh Int16Rep = putByte bh 5 + put_ bh Int32Rep = putByte bh 6 + put_ bh Int64Rep = putByte bh 7 + put_ bh IntRep = putByte bh 8 + put_ bh Word8Rep = putByte bh 9 + put_ bh Word16Rep = putByte bh 10 + put_ bh Word32Rep = putByte bh 11 + put_ bh Word64Rep = putByte bh 12 + put_ bh WordRep = putByte bh 13 + put_ bh AddrRep = putByte bh 14 + put_ bh FloatRep = putByte bh 15 + put_ bh DoubleRep = putByte bh 16 + put_ bh (VecRep n per) = putByte bh 17 *> put_ bh n *> put_ bh per get bh = do h <- getByte bh case h of 0 -> pure VoidRep - 1 -> pure LiftedRep - 2 -> pure UnliftedRep - 3 -> pure Int8Rep - 4 -> pure Int16Rep - 5 -> pure Int32Rep - 6 -> pure Int64Rep - 7 -> pure IntRep - 8 -> pure Word8Rep - 9 -> pure Word16Rep - 10 -> pure Word32Rep - 11 -> pure Word64Rep - 12 -> pure WordRep - 13 -> pure AddrRep - 14 -> pure FloatRep - 15 -> pure DoubleRep - 16 -> VecRep <$> get bh <*> get bh + 1 -> pure $ BoxedRep Nothing + 2 -> pure $ BoxedRep (Just Lifted) + 3 -> pure $ BoxedRep (Just Unlifted) + 4 -> pure Int8Rep + 5 -> pure Int16Rep + 6 -> pure Int32Rep + 7 -> pure Int64Rep + 8 -> pure IntRep + 9 -> pure Word8Rep + 10 -> pure Word16Rep + 11 -> pure Word32Rep + 12 -> pure Word64Rep + 13 -> pure WordRep + 14 -> pure AddrRep + 15 -> pure FloatRep + 16 -> pure DoubleRep + 17 -> VecRep <$> get bh <*> get bh _ -> pprPanic "Binary:PrimRep" (int (fromIntegral h)) instance Binary PrimElemRep where @@ -1622,9 +1626,8 @@ isVoidRep VoidRep = True isVoidRep _other = False isGcPtrRep :: PrimRep -> Bool -isGcPtrRep LiftedRep = True -isGcPtrRep UnliftedRep = True -isGcPtrRep _ = False +isGcPtrRep (BoxedRep _) = True +isGcPtrRep _ = False -- A PrimRep is compatible with another iff one can be coerced to the other. -- See Note [Bad unsafe coercion] in GHC.Core.Lint for when are two types coercible. @@ -1665,8 +1668,7 @@ primRepSizeB platform = \case FloatRep -> fLOAT_SIZE DoubleRep -> dOUBLE_SIZE AddrRep -> platformWordSizeInBytes platform - LiftedRep -> platformWordSizeInBytes platform - UnliftedRep -> platformWordSizeInBytes platform + BoxedRep _ -> platformWordSizeInBytes platform VoidRep -> 0 (VecRep len rep) -> len * primElemRepSizeB platform rep ===================================== compiler/GHC/Stg/Syntax.hs ===================================== @@ -174,10 +174,9 @@ isDllConApp platform ext_dyn_refs this_mod con args -- -- The coercion argument here gets VoidRep isAddrRep :: PrimRep -> Bool -isAddrRep AddrRep = True -isAddrRep LiftedRep = True -isAddrRep UnliftedRep = True -isAddrRep _ = False +isAddrRep AddrRep = True +isAddrRep (BoxedRep _) = True -- FIXME: not true for JavaScript +isAddrRep _ = False -- | Type of an @StgArg@ -- ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -1603,8 +1603,7 @@ primRepToFFIType platform r AddrRep -> FFIPointer FloatRep -> FFIFloat DoubleRep -> FFIDouble - LiftedRep -> FFIPointer - UnliftedRep -> FFIPointer + BoxedRep _ -> FFIPointer _ -> pprPanic "primRepToFFIType" (ppr r) where (signed_word, unsigned_word) = case platformWordSize platform of @@ -1629,9 +1628,8 @@ mkDummyLiteral platform pr AddrRep -> LitNullAddr DoubleRep -> LitDouble 0 FloatRep -> LitFloat 0 - LiftedRep -> LitNullAddr - UnliftedRep -> LitNullAddr - _ -> pprPanic "mkDummyLiteral" (ppr pr) + BoxedRep _ -> LitNullAddr + _ -> pprPanic "mkDummyLiteral" (ppr pr) -- Convert (eg) ===================================== compiler/GHC/StgToCmm/ArgRep.hs ===================================== @@ -69,8 +69,7 @@ argRepString V64 = "V64" toArgRep :: Platform -> PrimRep -> ArgRep toArgRep platform rep = case rep of VoidRep -> V - LiftedRep -> P - UnliftedRep -> P + BoxedRep _ -> P IntRep -> N WordRep -> N Int8Rep -> N -- Gets widened to native word width for calls ===================================== compiler/GHC/StgToCmm/Lit.hs ===================================== @@ -53,8 +53,7 @@ cgLit (LitString s) = cgLit (LitRubbish _ rep) = case expectOnly "cgLit" prim_reps of -- Note [Post-unarisation invariants] VoidRep -> panic "cgLit:VoidRep" -- ditto - LiftedRep -> idInfoToAmode <$> getCgIdInfo unitDataConId - UnliftedRep -> idInfoToAmode <$> getCgIdInfo unitDataConId + BoxedRep _ -> idInfoToAmode <$> getCgIdInfo unitDataConId AddrRep -> cgLit LitNullAddr VecRep n elem -> do platform <- getPlatform ===================================== compiler/GHC/StgToJS/Apply.hs ===================================== @@ -48,6 +48,7 @@ import GHC.Types.Literal import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.CostCentre +import GHC.Types.RepType (mightBeFunTy) import GHC.Stg.Syntax @@ -204,7 +205,7 @@ genApp ctx i args -- no args and Id can't be a function: just enter it | [] <- args , idFunRepArity i == 0 - , not (mightBeAFunction (idType i)) + , not (mightBeFunTy (idType i)) = do enter_id <- genIdArg i >>= \case ===================================== compiler/GHC/StgToJS/Expr.hs ===================================== @@ -382,7 +382,6 @@ verifyRuntimeReps xs = do go _ _ = pprPanic "verifyRuntimeReps: inconsistent sizes" (ppr xs) ver j PtrV = v "h$verify_rep_heapobj" [j] ver j IntV = v "h$verify_rep_int" [j] - ver j RtsObjV = v "h$verify_rep_rtsobj" [j] ver j DoubleV = v "h$verify_rep_double" [j] ver j ArrV = v "h$verify_rep_arr" [j] ver _ _ = mempty ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -340,7 +340,6 @@ rts' s = , TxtI "h$vt_double" ||= toJExpr IntV , TxtI "h$vt_long" ||= toJExpr LongV , TxtI "h$vt_addr" ||= toJExpr AddrV - , TxtI "h$vt_rtsobj" ||= toJExpr RtsObjV , TxtI "h$vt_obj" ||= toJExpr ObjV , TxtI "h$vt_arr" ||= toJExpr ArrV , jFun (TxtI "h$bh") (bhStats s True) ===================================== compiler/GHC/StgToJS/Types.hs ===================================== @@ -150,13 +150,13 @@ instance ToJExpr CIStatic where -- | Free variable types data VarType - = PtrV -- ^ pointer = reference to heap object (closure object) + = PtrV -- ^ pointer = reference to heap object (closure object), lifted or not. + -- Can also be some RTS object (e.g. TVar#, MVar#, MutVar#, Weak#) | VoidV -- ^ no fields | DoubleV -- ^ A Double: one field | IntV -- ^ An Int (32bit because JS): one field | LongV -- ^ A Long: two fields one for the upper 32bits, one for the lower (NB: JS is little endian) | AddrV -- ^ a pointer not to the heap: two fields, array + index - | RtsObjV -- ^ some RTS object from GHCJS (for example TVar#, MVar#, MutVar#, Weak#) | ObjV -- ^ some JS object, user supplied, be careful around these, can be anything | ArrV -- ^ boxed array deriving stock (Eq, Ord, Enum, Bounded, Show) ===================================== compiler/GHC/StgToJS/Utils.hs ===================================== @@ -38,7 +38,6 @@ module GHC.StgToJS.Utils , assocPrimReps , assocIdPrimReps , assocIdExprs - , mightBeAFunction , mkArityTag , toTypeList -- * Stg Utils @@ -147,11 +146,11 @@ assignCoerce1 _x _y = pprPanic "assignCoerce1" -- | Assign p2 to p1 with optional coercion assignCoerce :: TypedExpr -> TypedExpr -> JStat -- Coercion between StablePtr# and Addr# -assignCoerce (TypedExpr AddrRep [a_val, a_off]) (TypedExpr UnliftedRep [sptr]) = mconcat +assignCoerce (TypedExpr AddrRep [a_val, a_off]) (TypedExpr (BoxedRep (Just Unlifted)) [sptr]) = mconcat [ a_val |= var "h$stablePtrBuf" , a_off |= sptr ] -assignCoerce (TypedExpr UnliftedRep [sptr]) (TypedExpr AddrRep [_a_val, a_off]) = +assignCoerce (TypedExpr (BoxedRep (Just Unlifted)) [sptr]) (TypedExpr AddrRep [_a_val, a_off]) = sptr |= a_off assignCoerce p1 p2 = assignTypedExprs [p1] [p2] @@ -258,8 +257,7 @@ uTypeVt ut primRepVt :: HasDebugCallStack => PrimRep -> VarType primRepVt VoidRep = VoidV -primRepVt LiftedRep = PtrV -- fixme does ByteArray# ever map to this? -primRepVt UnliftedRep = RtsObjV +primRepVt (BoxedRep _) = PtrV -- fixme does ByteArray# ever map to this? primRepVt IntRep = IntV primRepVt Int8Rep = IntV primRepVt Int16Rep = IntV @@ -316,26 +314,26 @@ primTypeVt t = case tyConAppTyCon_maybe (unwrapType t) of | tc == word64PrimTyCon -> LongV | tc == addrPrimTyCon -> AddrV | tc == stablePtrPrimTyCon -> AddrV - | tc == stableNamePrimTyCon -> RtsObjV + | tc == stableNamePrimTyCon -> PtrV | tc == statePrimTyCon -> VoidV | tc == proxyPrimTyCon -> VoidV | tc == realWorldTyCon -> VoidV - | tc == threadIdPrimTyCon -> RtsObjV - | tc == weakPrimTyCon -> RtsObjV + | tc == threadIdPrimTyCon -> PtrV + | tc == weakPrimTyCon -> PtrV | tc == arrayPrimTyCon -> ArrV | tc == smallArrayPrimTyCon -> ArrV | tc == byteArrayPrimTyCon -> ObjV -- can contain any JS reference, used for JSVal | tc == mutableArrayPrimTyCon -> ArrV | tc == smallMutableArrayPrimTyCon -> ArrV | tc == mutableByteArrayPrimTyCon -> ObjV -- can contain any JS reference, used for JSVal - | tc == mutVarPrimTyCon -> RtsObjV - | tc == mVarPrimTyCon -> RtsObjV - | tc == tVarPrimTyCon -> RtsObjV - | tc == bcoPrimTyCon -> RtsObjV -- unsupported? - | tc == stackSnapshotPrimTyCon -> RtsObjV - | tc == ioPortPrimTyCon -> RtsObjV -- unsupported? + | tc == mutVarPrimTyCon -> PtrV + | tc == mVarPrimTyCon -> PtrV + | tc == tVarPrimTyCon -> PtrV + | tc == bcoPrimTyCon -> PtrV -- unsupported? + | tc == stackSnapshotPrimTyCon -> PtrV + | tc == ioPortPrimTyCon -> PtrV -- unsupported? | tc == anyTyCon -> PtrV - | tc == compactPrimTyCon -> ObjV -- unsupported? + | tc == compactPrimTyCon -> PtrV -- unsupported? | tc == eqPrimTyCon -> VoidV -- coercion token? | tc == eqReprPrimTyCon -> VoidV -- role | tc == unboxedUnitTyCon -> VoidV -- Void# @@ -392,17 +390,6 @@ assocIdPrimReps i = assocPrimReps (idPrimReps i) assocIdExprs :: Id -> [JExpr] -> [TypedExpr] assocIdExprs i es = fmap (uncurry TypedExpr) (assocIdPrimReps i es) --- | Return False only if we are *sure* it's a data type --- Look through newtypes etc as much as possible -mightBeAFunction :: HasDebugCallStack => Type -> Bool -mightBeAFunction ty - | [LiftedRep] <- typePrimRep ty - , Just tc <- tyConAppTyCon_maybe (unwrapType ty) - , isDataTyCon tc - = False - | otherwise - = True - mkArityTag :: Int -> Int -> Int mkArityTag arity registers = arity Bits..|. (registers `Bits.shiftL` 8) ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -20,6 +20,7 @@ types that {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} module GHC.Types.Basic ( LeftOrRight(..), @@ -1956,12 +1957,20 @@ isKindLevel KindLevel = True data Levity = Lifted | Unlifted - deriving Eq + deriving (Data,Eq,Ord,Show) instance Outputable Levity where ppr Lifted = text "Lifted" ppr Unlifted = text "Unlifted" +instance Binary Levity where + put_ bh = \case + Lifted -> putByte bh 0 + Unlifted -> putByte bh 1 + get bh = getByte bh >>= \case + 0 -> pure Lifted + _ -> pure Unlifted + mightBeLifted :: Maybe Levity -> Bool mightBeLifted (Just Unlifted) = False mightBeLifted _ = True ===================================== compiler/GHC/Types/RepType.hs ===================================== @@ -315,8 +315,10 @@ typeSlotTy ty = case typePrimRep ty of primRepSlot :: PrimRep -> SlotTy primRepSlot VoidRep = pprPanic "primRepSlot" (text "No slot for VoidRep") -primRepSlot LiftedRep = PtrLiftedSlot -primRepSlot UnliftedRep = PtrUnliftedSlot +primRepSlot (BoxedRep mlev) = case mlev of + Nothing -> panic "primRepSlot: levity polymorphic BoxedRep" + Just Lifted -> PtrLiftedSlot + Just Unlifted -> PtrUnliftedSlot primRepSlot IntRep = WordSlot primRepSlot Int8Rep = WordSlot primRepSlot Int16Rep = WordSlot @@ -333,8 +335,8 @@ primRepSlot DoubleRep = DoubleSlot primRepSlot (VecRep n e) = VecSlot n e slotPrimRep :: SlotTy -> PrimRep -slotPrimRep PtrLiftedSlot = LiftedRep -slotPrimRep PtrUnliftedSlot = UnliftedRep +slotPrimRep PtrLiftedSlot = BoxedRep (Just Lifted) +slotPrimRep PtrUnliftedSlot = BoxedRep (Just Unlifted) slotPrimRep Word64Slot = Word64Rep slotPrimRep WordSlot = WordRep slotPrimRep DoubleSlot = DoubleRep @@ -635,8 +637,10 @@ runtimeRepPrimRep_maybe rr_ty primRepToRuntimeRep :: PrimRep -> RuntimeRepType primRepToRuntimeRep rep = case rep of VoidRep -> zeroBitRepTy - LiftedRep -> liftedRepTy - UnliftedRep -> unliftedRepTy + BoxedRep mlev -> case mlev of + Nothing -> panic "primRepToRuntimeRep: levity polymorphic BoxedRep" + Just Lifted -> liftedRepTy + Just Unlifted -> unliftedRepTy IntRep -> intRepDataConTy Int8Rep -> int8RepDataConTy Int16Rep -> int16RepDataConTy @@ -688,7 +692,7 @@ mightBeFunTy :: Type -> Bool -- AK: It would be nice to figure out and document the difference -- between this and isFunTy at some point. mightBeFunTy ty - | [LiftedRep] <- typePrimRep ty + | [BoxedRep _] <- typePrimRep ty , Just tc <- tyConAppTyCon_maybe (unwrapType ty) , isDataTyCon tc = False ===================================== rts/js/rts.js ===================================== @@ -245,7 +245,7 @@ function h$printcl(i) { r += " "; switch(cl.i[i]) { case h$vt_ptr: - r += "[ Ptr :: " + d["d"+idx].f.n + "]"; + r += "[ Ptr :: " + d["d"+idx] + "]"; idx++; break; case h$vt_void: @@ -267,10 +267,6 @@ function h$printcl(i) { r += "(" + d["d"+idx].length + "," + d["d"+(idx+1)] + " :: ptr)"; idx+=2; break; - case h$vt_rtsobj: - r += "(" + d["d"+idx].toString() + " :: RTS object)"; - idx++; - break; default: r += "unknown field: " + cl.i[i]; } ===================================== rts/js/verify.js ===================================== @@ -113,7 +113,7 @@ function h$verify_rep_is_bytearray(o) { function h$verify_rep_heapobj(o) { // possibly an unlifted rts object // XXX: we should do a different check for these - if(h$verify_rep_is_rtsobj(o)) return; + if(h$verify_rep_is_rtsobj(o)) return h$verify_rep_rtsobj(o); // unboxed rep if(typeof o === 'number' || typeof o === 'boolean') return; // boxed rep ===================================== testsuite/tests/primops/should_run/all.T ===================================== @@ -8,7 +8,7 @@ test('T10481', exit_code(1), compile_and_run, ['']) test('T10678', [ collect_stats('bytes allocated',5), only_ways(['normal']), - js_broken(22360) + js_broken(22361) ], compile_and_run, ['-O']) test('T11296', normal, compile_and_run, ['']) ===================================== testsuite/tests/rep-poly/T22291.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE DataKinds #-} + +module T22291 where + +import GHC.Exts + +foo :: forall (lev :: Levity) (a :: TYPE (BoxedRep lev)). Addr# -> (# a #) +foo x = addrToAny# x ===================================== testsuite/tests/rep-poly/T22291b.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE DataKinds, MagicHash, UnboxedTuples #-} + +module T22291b where + +import GHC.Exts + +indexArray :: forall l (a :: TYPE (BoxedRep l)). Array# a -> Int# -> (# a #) +indexArray = indexArray# ===================================== testsuite/tests/rep-poly/all.T ===================================== @@ -15,7 +15,7 @@ test('T18170b', [extra_files(['T18170c.hs']), expect_broken(19893)], multimod_co # T18170b isn't actually broken, but it causes a Core Lint error # even though the program is (correctly) rejected by the typechecker test('T18481', normal, compile, ['']) -test('T18481a', js_broken(22360), compile, ['']) +test('T18481a', normal, compile, ['']) test('T18534', normal, compile_fail, ['']) test('T19615', normal, compile_fail, ['']) test('T19709a', normal, compile_fail, ['']) @@ -29,8 +29,10 @@ test('T20423b', normal, compile_fail, ['']) test('T20426', normal, compile_fail, ['']) test('T21239', normal, compile, ['']) test('T21544', normal, compile, ['-Wno-deprecated-flags']) +test('T22291', normal, compile, ['']) +test('T22291b', normal, compile, ['']) -test('EtaExpandDataCon', js_broken(22360), compile, ['-O']) +test('EtaExpandDataCon', normal, compile, ['-O']) test('EtaExpandStupid1', normal, compile, ['-Wno-deprecated-flags']) test('EtaExpandStupid2', normal, compile_fail, ['-Wno-deprecated-flags']) test('LevPolyLet', normal, compile_fail, ['']) @@ -43,7 +45,7 @@ test('RepPolyBackpack1', normal, backpack_compile_fail, ['']) test('RepPolyBackpack2', req_c, backpack_run, ['']) test('RepPolyBackpack3', normal, backpack_compile_fail, ['']) test('RepPolyBackpack4', req_c, backpack_run, ['']) -test('RepPolyBackpack5', js_broken(22360), backpack_run, ['']) +test('RepPolyBackpack5', js_broken(22361), backpack_run, ['']) test('RepPolyBinder', normal, compile_fail, ['']) test('RepPolyCase1', normal, compile_fail, ['']) test('RepPolyClassMethod', normal, compile_fail, ['']) @@ -79,8 +81,8 @@ test('RepPolySum', normal, compile_fail, ['']) test('RepPolyTuple', normal, compile_fail, ['']) test('RepPolyTupleSection', normal, compile_fail, ['']) test('RepPolyUnboxedPatterns', normal, compile_fail, ['']) -test('RepPolyUnliftedDatatype', js_broken(22360), compile, ['']) -test('RepPolyUnliftedDatatype2', js_broken(22261), compile, ['-O']) +test('RepPolyUnliftedDatatype', normal, compile, ['']) +test('RepPolyUnliftedDatatype2', normal, compile, ['-O']) test('RepPolyUnliftedNewtype', normal, compile, ['-fno-warn-partial-type-signatures -fno-warn-deprecated-flags']) test('RepPolyWildcardPattern', normal, compile_fail, ['']) ===================================== testsuite/tests/unlifted-datatypes/should_compile/all.T ===================================== @@ -1,4 +1,4 @@ test('UnlDataMonoSigs', normal, compile, ['']) -test('UnlDataPolySigs', js_broken(22360), compile, ['']) +test('UnlDataPolySigs', normal, compile, ['']) test('UnlDataFams', normal, compile, ['']) -test('UnlDataUsersGuide', js_broken(22360), compile, ['']) +test('UnlDataUsersGuide', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8d6574bc68cbbcabbf7c0e5700571c4746127fb8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8d6574bc68cbbcabbf7c0e5700571c4746127fb8 You're receiving 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 Jun 26 17:16:26 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 26 Jun 2023 13:16:26 -0400 Subject: [Git][ghc/ghc][master] 2 commits: MR Review Template: Mention "Blocked on Review" label Message-ID: <6499c7eae08a8_2402e0c75ec8298e@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 1 changed file: - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md Changes: ===================================== .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md ===================================== @@ -25,9 +25,9 @@ If you have any questions don't hesitate to open your merge request and inquire in a comment. If your patch isn't quite done yet please do add prefix your MR title with `WIP:`. -Once your change is ready please remove the `WIP:` tag and wait for review. If +Once your change is ready please remove the `WIP:` tag and wait for review. If no one has offerred review in a few days then please leave a comment mentioning - at triagers. + at triagers and apply the ~"Blocked on Review" label. [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/-/compare/8d6574bc68cbbcabbf7c0e5700571c4746127fb8...4427e9cfaeab5ea50796b0923960ab846216972a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8d6574bc68cbbcabbf7c0e5700571c4746127fb8...4427e9cfaeab5ea50796b0923960ab846216972a You're receiving 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 Jun 26 17:16:56 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 26 Jun 2023 13:16:56 -0400 Subject: [Git][ghc/ghc][master] Revert "Avoid desugaring non-recursive lets into recursive lets" Message-ID: <6499c808a9ce_2402e01ea848088155@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - 3 changed files: - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - testsuite/tests/ghci/should_run/T16096.stdout Changes: ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -117,56 +117,10 @@ dsTopLHsBinds binds top_level_err bindsType (L loc bind) = putSrcSpanDs (locA loc) $ diagnosticDs (DsTopLevelBindsNotAllowed bindsType bind) -{- -Note [Return bindings in dependency order] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The desugarer tries to desugar a non-recursive let-binding to a collection of -one or more non-recursive let-bindings. The alternative is to generate a letrec -and wait for the occurrence analyser to sort it out later, but it is pretty easy -to arrange that the [(Id,CoreExpr)] pairs returned by dsLHsBinds are returned in -dependency order - -It's most important for linear types, where non-recursive lets can be linear -whereas recursive-let can't. Since we check the output of the desugarer for -linearity (see also Note [Linting linearity]), desugaring non-recursive lets to -recursive lets would break linearity checks. An alternative is to refine the -typing rule for recursive lets so that we don't have to care (see in particular -#23218 and #18694), but the outcome of this line of work is still unclear. In -the meantime, being a little precise in the desugarer is cheap. (paragraph -written on 2023-06-09) - -In dsLHSBinds (and dependencies), a single binding can be desugared to multiple -bindings. For instance because the source binding has the {-# SPECIALIZE #-} -pragma. In: - -f _ = … - where - {-# SPECIALIZE g :: F Int -> F Int #-} - g :: C a => F a -> F a - g _ = … - -The g binding desugars to - -let { - $sg = … } in - - g - [RULES: "SPEC g" g @Int $dC = $sg] - g = … -In order to avoid generating a letrec that will immediately be reordered, we -make sure to return the binding in dependency order [$sg, g]. - -This only matters when the source binding is non-recursive as recursive bindings -are always desugared to a single mutually recursive block. - --} -- | Desugar all other kind of bindings, Ids of strict binds are returned to -- later be forced in the binding group body, see Note [Desugar Strict binds] --- --- Invariant: the desugared bindings are returned in dependency order, --- see Note [Return bindings in dependency order] dsLHsBinds :: LHsBinds GhcTc -> DsM ([Id], [(Id,CoreExpr)]) dsLHsBinds binds = do { ds_bs <- mapBagM dsLHsBind binds @@ -180,9 +134,6 @@ dsLHsBind (L loc bind) = do dflags <- getDynFlags putSrcSpanDs (locA loc) $ dsHsBind dflags bind -- | Desugar a single binding (or group of recursive binds). --- --- Invariant: the desugared bindings are returned in dependency order, --- see Note [Return bindings in dependency order] dsHsBind :: DynFlags -> HsBind GhcTc -> DsM ([Id], [(Id,CoreExpr)]) @@ -312,7 +263,7 @@ dsAbsBinds dflags tyvars dicts exports (isDefaultMethod prags) (dictArity dicts) rhs - ; return (force_vars', fromOL spec_binds ++ [main_bind]) } } + ; return (force_vars', main_bind : fromOL spec_binds) } } -- Another common case: no tyvars, no dicts -- In this case we can have a much simpler desugaring @@ -371,7 +322,7 @@ dsAbsBinds dflags tyvars dicts exports -- Kill the INLINE pragma because it applies to -- the user written (local) function. The global -- Id is just the selector. Hmm. - ; return (fromOL spec_binds ++ [(global', rhs)]) } } + ; return ((global', rhs) : fromOL spec_binds) } } ; export_binds_s <- mapM mk_bind (exports ++ extra_exports) ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -160,20 +160,17 @@ ds_val_bind (is_rec, binds) body -- NB: bindings have a fixed RuntimeRep, so it's OK to call isUnliftedType case prs of [] -> return body - _ -> return (mkLets (mk_binds is_rec prs) body') } - -- We can make a non-recursive let because we make sure to return - -- the bindings in dependency order in dsLHsBinds, see Note [Return bindings in dependency order] - --- | Helper function. You can use the result of 'mk_binds' with 'mkLets' for --- instance. --- --- * @'mk_binds' 'Recursive' binds@ makes a single mutually-recursive --- bindings with all the rhs/lhs pairs in @binds@ --- * @'mk_binds' 'NonRecursive' binds@ makes one non-recursive binding --- for each rhs/lhs pairs in @binds@ -mk_binds :: RecFlag -> [(b, (Expr b))] -> [Bind b] -mk_binds Recursive binds = [Rec binds] -mk_binds NonRecursive binds = map (uncurry NonRec) binds + _ -> return (Let (Rec prs) body') } + -- Use a Rec regardless of is_rec. + -- Why? Because it allows the binds to be all + -- mixed up, which is what happens in one rare case + -- Namely, for an AbsBind with no tyvars and no dicts, + -- but which does have dictionary bindings. + -- See notes with GHC.Tc.Solver.inferLoop [NO TYVARS] + -- It turned out that wrapping a Rec here was the easiest solution + -- + -- NB The previous case dealt with unlifted bindings, so we + -- only have to deal with lifted ones now; so Rec is ok ------------------ dsUnliftedBind :: HsBind GhcTc -> CoreExpr -> DsM CoreExpr ===================================== testsuite/tests/ghci/should_run/T16096.stdout ===================================== @@ -1,6 +1,6 @@ ==================== Desugared ==================== -let { +letrec { x :: [GHC.Types.Int] [LclId] x = let { @@ -11,7 +11,7 @@ let { x :: [GHC.Types.Int] [LclId] x = GHC.Enum.enumFrom @GHC.Types.Int $dEnum (GHC.Types.I# 1#); } in - x } in + x; } in GHC.Base.returnIO @[GHC.Types.Any] (GHC.Types.: @@ -27,7 +27,7 @@ GHC.Base.returnIO ==================== Desugared ==================== -let { +letrec { x :: [GHC.Types.Int] [LclId] x = let { @@ -38,7 +38,7 @@ let { x :: [GHC.Types.Int] [LclId] x = GHC.Enum.enumFrom @GHC.Types.Int $dEnum (GHC.Types.I# 1#); } in - x } in + x; } in GHC.Base.returnIO @[GHC.Types.Any] (GHC.Types.: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/522bd584f71ddeda21efdf0917606ce3d81ec6cc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/522bd584f71ddeda21efdf0917606ce3d81ec6cc You're receiving 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 Jun 26 17:48:08 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 26 Jun 2023 13:48:08 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: JS: support levity-polymorphic datatypes (#22360,#22291) Message-ID: <6499cf58b7afb_2402e03505da4101087@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - ae0402c0 by Greg Steuck at 2023-06-26T13:47:56-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - 5c050e68 by Torsten Schmits at 2023-06-26T13:47:56-04:00 Remove duplicate link label in linear types docs - - - - - 28 changed files: - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - compiler/GHC/Builtin/Types.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Stg/Syntax.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/ArgRep.hs - compiler/GHC/StgToCmm/Lit.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/StgToJS/Types.hs - compiler/GHC/StgToJS/Utils.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/RepType.hs - configure.ac - distrib/configure.ac.in - docs/users_guide/exts/linear_types.rst - rts/js/rts.js - rts/js/verify.js - testsuite/tests/ghci/should_run/T16096.stdout - testsuite/tests/primops/should_run/all.T - + testsuite/tests/rep-poly/T22291.hs - + testsuite/tests/rep-poly/T22291b.hs - testsuite/tests/rep-poly/all.T - testsuite/tests/unlifted-datatypes/should_compile/all.T Changes: ===================================== .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md ===================================== @@ -25,9 +25,9 @@ If you have any questions don't hesitate to open your merge request and inquire in a comment. If your patch isn't quite done yet please do add prefix your MR title with `WIP:`. -Once your change is ready please remove the `WIP:` tag and wait for review. If +Once your change is ready please remove the `WIP:` tag and wait for review. If no one has offerred review in a few days then please leave a comment mentioning - at triagers. + at triagers and apply the ~"Blocked on Review" label. [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/Builtin/Types.hs ===================================== @@ -1636,10 +1636,11 @@ boxedRepDataCon = pcSpecialDataCon boxedRepDataConName where -- See Note [Getting from RuntimeRep to PrimRep] in RepType prim_rep_fun [lev] - = case tyConPromDataConInfo (tyConAppTyCon lev) of - Levity Lifted -> [LiftedRep] - Levity Unlifted -> [UnliftedRep] - _ -> pprPanic "boxedRepDataCon" (ppr lev) + = case tyConAppTyCon_maybe lev of + Just tc -> case tyConPromDataConInfo tc of + Levity l -> [BoxedRep (Just l)] + _ -> [BoxedRep Nothing] + Nothing -> [BoxedRep Nothing] prim_rep_fun args = pprPanic "boxedRepDataCon" (ppr args) ===================================== compiler/GHC/Cmm/Utils.hs ===================================== @@ -98,8 +98,7 @@ import GHC.Cmm.Dataflow.Collections primRepCmmType :: Platform -> PrimRep -> CmmType primRepCmmType platform = \case VoidRep -> panic "primRepCmmType:VoidRep" - LiftedRep -> gcWord platform - UnliftedRep -> gcWord platform + BoxedRep _ -> gcWord platform IntRep -> bWord platform WordRep -> bWord platform Int8Rep -> b8 @@ -142,8 +141,7 @@ typeCmmType platform ty = primRepCmmType platform (typePrimRep1 ty) primRepForeignHint :: PrimRep -> ForeignHint primRepForeignHint VoidRep = panic "primRepForeignHint:VoidRep" -primRepForeignHint LiftedRep = AddrHint -primRepForeignHint UnliftedRep = AddrHint +primRepForeignHint (BoxedRep _) = AddrHint primRepForeignHint IntRep = SignedHint primRepForeignHint Int8Rep = SignedHint primRepForeignHint Int16Rep = SignedHint ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -124,7 +124,7 @@ module GHC.Core.TyCon( tyConRepModOcc, -- * Primitive representations of Types - PrimRep(..), PrimElemRep(..), + PrimRep(..), PrimElemRep(..), Levity(..), primElemRepToPrimRep, isVoidRep, isGcPtrRep, primRepSizeB, @@ -1536,8 +1536,7 @@ See Note [RuntimeRep and PrimRep] in GHC.Types.RepType. -- "GHC.Types.RepType" and Note [VoidRep] in "GHC.Types.RepType". data PrimRep = VoidRep - | LiftedRep - | UnliftedRep -- ^ Unlifted pointer + | BoxedRep {-# UNPACK #-} !(Maybe Levity) -- ^ Boxed, heap value | Int8Rep -- ^ Signed, 8-bit value | Int16Rep -- ^ Signed, 16-bit value | Int32Rep -- ^ Signed, 32-bit value @@ -1548,7 +1547,7 @@ data PrimRep | Word32Rep -- ^ Unsigned, 32 bit value | Word64Rep -- ^ Unsigned, 64 bit value | WordRep -- ^ Unsigned, word-sized value - | AddrRep -- ^ A pointer, but /not/ to a Haskell value (use '(Un)liftedRep') + | AddrRep -- ^ A pointer, but /not/ to a Haskell value (use 'BoxedRep') | FloatRep | DoubleRep | VecRep Int PrimElemRep -- ^ A vector @@ -1575,42 +1574,47 @@ instance Outputable PrimElemRep where instance Binary PrimRep where put_ bh VoidRep = putByte bh 0 - put_ bh LiftedRep = putByte bh 1 - put_ bh UnliftedRep = putByte bh 2 - put_ bh Int8Rep = putByte bh 3 - put_ bh Int16Rep = putByte bh 4 - put_ bh Int32Rep = putByte bh 5 - put_ bh Int64Rep = putByte bh 6 - put_ bh IntRep = putByte bh 7 - put_ bh Word8Rep = putByte bh 8 - put_ bh Word16Rep = putByte bh 9 - put_ bh Word32Rep = putByte bh 10 - put_ bh Word64Rep = putByte bh 11 - put_ bh WordRep = putByte bh 12 - put_ bh AddrRep = putByte bh 13 - put_ bh FloatRep = putByte bh 14 - put_ bh DoubleRep = putByte bh 15 - put_ bh (VecRep n per) = putByte bh 16 *> put_ bh n *> put_ bh per + put_ bh (BoxedRep ml) = case ml of + -- cheaper storage of the levity than using + -- the Binary (Maybe Levity) instance + Nothing -> putByte bh 1 + Just Lifted -> putByte bh 2 + Just Unlifted -> putByte bh 3 + put_ bh Int8Rep = putByte bh 4 + put_ bh Int16Rep = putByte bh 5 + put_ bh Int32Rep = putByte bh 6 + put_ bh Int64Rep = putByte bh 7 + put_ bh IntRep = putByte bh 8 + put_ bh Word8Rep = putByte bh 9 + put_ bh Word16Rep = putByte bh 10 + put_ bh Word32Rep = putByte bh 11 + put_ bh Word64Rep = putByte bh 12 + put_ bh WordRep = putByte bh 13 + put_ bh AddrRep = putByte bh 14 + put_ bh FloatRep = putByte bh 15 + put_ bh DoubleRep = putByte bh 16 + put_ bh (VecRep n per) = putByte bh 17 *> put_ bh n *> put_ bh per get bh = do h <- getByte bh case h of 0 -> pure VoidRep - 1 -> pure LiftedRep - 2 -> pure UnliftedRep - 3 -> pure Int8Rep - 4 -> pure Int16Rep - 5 -> pure Int32Rep - 6 -> pure Int64Rep - 7 -> pure IntRep - 8 -> pure Word8Rep - 9 -> pure Word16Rep - 10 -> pure Word32Rep - 11 -> pure Word64Rep - 12 -> pure WordRep - 13 -> pure AddrRep - 14 -> pure FloatRep - 15 -> pure DoubleRep - 16 -> VecRep <$> get bh <*> get bh + 1 -> pure $ BoxedRep Nothing + 2 -> pure $ BoxedRep (Just Lifted) + 3 -> pure $ BoxedRep (Just Unlifted) + 4 -> pure Int8Rep + 5 -> pure Int16Rep + 6 -> pure Int32Rep + 7 -> pure Int64Rep + 8 -> pure IntRep + 9 -> pure Word8Rep + 10 -> pure Word16Rep + 11 -> pure Word32Rep + 12 -> pure Word64Rep + 13 -> pure WordRep + 14 -> pure AddrRep + 15 -> pure FloatRep + 16 -> pure DoubleRep + 17 -> VecRep <$> get bh <*> get bh _ -> pprPanic "Binary:PrimRep" (int (fromIntegral h)) instance Binary PrimElemRep where @@ -1622,9 +1626,8 @@ isVoidRep VoidRep = True isVoidRep _other = False isGcPtrRep :: PrimRep -> Bool -isGcPtrRep LiftedRep = True -isGcPtrRep UnliftedRep = True -isGcPtrRep _ = False +isGcPtrRep (BoxedRep _) = True +isGcPtrRep _ = False -- A PrimRep is compatible with another iff one can be coerced to the other. -- See Note [Bad unsafe coercion] in GHC.Core.Lint for when are two types coercible. @@ -1665,8 +1668,7 @@ primRepSizeB platform = \case FloatRep -> fLOAT_SIZE DoubleRep -> dOUBLE_SIZE AddrRep -> platformWordSizeInBytes platform - LiftedRep -> platformWordSizeInBytes platform - UnliftedRep -> platformWordSizeInBytes platform + BoxedRep _ -> platformWordSizeInBytes platform VoidRep -> 0 (VecRep len rep) -> len * primElemRepSizeB platform rep ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -117,56 +117,10 @@ dsTopLHsBinds binds top_level_err bindsType (L loc bind) = putSrcSpanDs (locA loc) $ diagnosticDs (DsTopLevelBindsNotAllowed bindsType bind) -{- -Note [Return bindings in dependency order] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The desugarer tries to desugar a non-recursive let-binding to a collection of -one or more non-recursive let-bindings. The alternative is to generate a letrec -and wait for the occurrence analyser to sort it out later, but it is pretty easy -to arrange that the [(Id,CoreExpr)] pairs returned by dsLHsBinds are returned in -dependency order - -It's most important for linear types, where non-recursive lets can be linear -whereas recursive-let can't. Since we check the output of the desugarer for -linearity (see also Note [Linting linearity]), desugaring non-recursive lets to -recursive lets would break linearity checks. An alternative is to refine the -typing rule for recursive lets so that we don't have to care (see in particular -#23218 and #18694), but the outcome of this line of work is still unclear. In -the meantime, being a little precise in the desugarer is cheap. (paragraph -written on 2023-06-09) - -In dsLHSBinds (and dependencies), a single binding can be desugared to multiple -bindings. For instance because the source binding has the {-# SPECIALIZE #-} -pragma. In: - -f _ = … - where - {-# SPECIALIZE g :: F Int -> F Int #-} - g :: C a => F a -> F a - g _ = … - -The g binding desugars to - -let { - $sg = … } in - - g - [RULES: "SPEC g" g @Int $dC = $sg] - g = … -In order to avoid generating a letrec that will immediately be reordered, we -make sure to return the binding in dependency order [$sg, g]. - -This only matters when the source binding is non-recursive as recursive bindings -are always desugared to a single mutually recursive block. - --} -- | Desugar all other kind of bindings, Ids of strict binds are returned to -- later be forced in the binding group body, see Note [Desugar Strict binds] --- --- Invariant: the desugared bindings are returned in dependency order, --- see Note [Return bindings in dependency order] dsLHsBinds :: LHsBinds GhcTc -> DsM ([Id], [(Id,CoreExpr)]) dsLHsBinds binds = do { ds_bs <- mapBagM dsLHsBind binds @@ -180,9 +134,6 @@ dsLHsBind (L loc bind) = do dflags <- getDynFlags putSrcSpanDs (locA loc) $ dsHsBind dflags bind -- | Desugar a single binding (or group of recursive binds). --- --- Invariant: the desugared bindings are returned in dependency order, --- see Note [Return bindings in dependency order] dsHsBind :: DynFlags -> HsBind GhcTc -> DsM ([Id], [(Id,CoreExpr)]) @@ -312,7 +263,7 @@ dsAbsBinds dflags tyvars dicts exports (isDefaultMethod prags) (dictArity dicts) rhs - ; return (force_vars', fromOL spec_binds ++ [main_bind]) } } + ; return (force_vars', main_bind : fromOL spec_binds) } } -- Another common case: no tyvars, no dicts -- In this case we can have a much simpler desugaring @@ -371,7 +322,7 @@ dsAbsBinds dflags tyvars dicts exports -- Kill the INLINE pragma because it applies to -- the user written (local) function. The global -- Id is just the selector. Hmm. - ; return (fromOL spec_binds ++ [(global', rhs)]) } } + ; return ((global', rhs) : fromOL spec_binds) } } ; export_binds_s <- mapM mk_bind (exports ++ extra_exports) ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -160,20 +160,17 @@ ds_val_bind (is_rec, binds) body -- NB: bindings have a fixed RuntimeRep, so it's OK to call isUnliftedType case prs of [] -> return body - _ -> return (mkLets (mk_binds is_rec prs) body') } - -- We can make a non-recursive let because we make sure to return - -- the bindings in dependency order in dsLHsBinds, see Note [Return bindings in dependency order] - --- | Helper function. You can use the result of 'mk_binds' with 'mkLets' for --- instance. --- --- * @'mk_binds' 'Recursive' binds@ makes a single mutually-recursive --- bindings with all the rhs/lhs pairs in @binds@ --- * @'mk_binds' 'NonRecursive' binds@ makes one non-recursive binding --- for each rhs/lhs pairs in @binds@ -mk_binds :: RecFlag -> [(b, (Expr b))] -> [Bind b] -mk_binds Recursive binds = [Rec binds] -mk_binds NonRecursive binds = map (uncurry NonRec) binds + _ -> return (Let (Rec prs) body') } + -- Use a Rec regardless of is_rec. + -- Why? Because it allows the binds to be all + -- mixed up, which is what happens in one rare case + -- Namely, for an AbsBind with no tyvars and no dicts, + -- but which does have dictionary bindings. + -- See notes with GHC.Tc.Solver.inferLoop [NO TYVARS] + -- It turned out that wrapping a Rec here was the easiest solution + -- + -- NB The previous case dealt with unlifted bindings, so we + -- only have to deal with lifted ones now; so Rec is ok ------------------ dsUnliftedBind :: HsBind GhcTc -> CoreExpr -> DsM CoreExpr ===================================== compiler/GHC/Stg/Syntax.hs ===================================== @@ -174,10 +174,9 @@ isDllConApp platform ext_dyn_refs this_mod con args -- -- The coercion argument here gets VoidRep isAddrRep :: PrimRep -> Bool -isAddrRep AddrRep = True -isAddrRep LiftedRep = True -isAddrRep UnliftedRep = True -isAddrRep _ = False +isAddrRep AddrRep = True +isAddrRep (BoxedRep _) = True -- FIXME: not true for JavaScript +isAddrRep _ = False -- | Type of an @StgArg@ -- ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -1603,8 +1603,7 @@ primRepToFFIType platform r AddrRep -> FFIPointer FloatRep -> FFIFloat DoubleRep -> FFIDouble - LiftedRep -> FFIPointer - UnliftedRep -> FFIPointer + BoxedRep _ -> FFIPointer _ -> pprPanic "primRepToFFIType" (ppr r) where (signed_word, unsigned_word) = case platformWordSize platform of @@ -1629,9 +1628,8 @@ mkDummyLiteral platform pr AddrRep -> LitNullAddr DoubleRep -> LitDouble 0 FloatRep -> LitFloat 0 - LiftedRep -> LitNullAddr - UnliftedRep -> LitNullAddr - _ -> pprPanic "mkDummyLiteral" (ppr pr) + BoxedRep _ -> LitNullAddr + _ -> pprPanic "mkDummyLiteral" (ppr pr) -- Convert (eg) ===================================== compiler/GHC/StgToCmm/ArgRep.hs ===================================== @@ -69,8 +69,7 @@ argRepString V64 = "V64" toArgRep :: Platform -> PrimRep -> ArgRep toArgRep platform rep = case rep of VoidRep -> V - LiftedRep -> P - UnliftedRep -> P + BoxedRep _ -> P IntRep -> N WordRep -> N Int8Rep -> N -- Gets widened to native word width for calls ===================================== compiler/GHC/StgToCmm/Lit.hs ===================================== @@ -53,8 +53,7 @@ cgLit (LitString s) = cgLit (LitRubbish _ rep) = case expectOnly "cgLit" prim_reps of -- Note [Post-unarisation invariants] VoidRep -> panic "cgLit:VoidRep" -- ditto - LiftedRep -> idInfoToAmode <$> getCgIdInfo unitDataConId - UnliftedRep -> idInfoToAmode <$> getCgIdInfo unitDataConId + BoxedRep _ -> idInfoToAmode <$> getCgIdInfo unitDataConId AddrRep -> cgLit LitNullAddr VecRep n elem -> do platform <- getPlatform ===================================== compiler/GHC/StgToJS/Apply.hs ===================================== @@ -48,6 +48,7 @@ import GHC.Types.Literal import GHC.Types.Id import GHC.Types.Id.Info import GHC.Types.CostCentre +import GHC.Types.RepType (mightBeFunTy) import GHC.Stg.Syntax @@ -204,7 +205,7 @@ genApp ctx i args -- no args and Id can't be a function: just enter it | [] <- args , idFunRepArity i == 0 - , not (mightBeAFunction (idType i)) + , not (mightBeFunTy (idType i)) = do enter_id <- genIdArg i >>= \case ===================================== compiler/GHC/StgToJS/Expr.hs ===================================== @@ -382,7 +382,6 @@ verifyRuntimeReps xs = do go _ _ = pprPanic "verifyRuntimeReps: inconsistent sizes" (ppr xs) ver j PtrV = v "h$verify_rep_heapobj" [j] ver j IntV = v "h$verify_rep_int" [j] - ver j RtsObjV = v "h$verify_rep_rtsobj" [j] ver j DoubleV = v "h$verify_rep_double" [j] ver j ArrV = v "h$verify_rep_arr" [j] ver _ _ = mempty ===================================== compiler/GHC/StgToJS/Rts/Rts.hs ===================================== @@ -340,7 +340,6 @@ rts' s = , TxtI "h$vt_double" ||= toJExpr IntV , TxtI "h$vt_long" ||= toJExpr LongV , TxtI "h$vt_addr" ||= toJExpr AddrV - , TxtI "h$vt_rtsobj" ||= toJExpr RtsObjV , TxtI "h$vt_obj" ||= toJExpr ObjV , TxtI "h$vt_arr" ||= toJExpr ArrV , jFun (TxtI "h$bh") (bhStats s True) ===================================== compiler/GHC/StgToJS/Types.hs ===================================== @@ -150,13 +150,13 @@ instance ToJExpr CIStatic where -- | Free variable types data VarType - = PtrV -- ^ pointer = reference to heap object (closure object) + = PtrV -- ^ pointer = reference to heap object (closure object), lifted or not. + -- Can also be some RTS object (e.g. TVar#, MVar#, MutVar#, Weak#) | VoidV -- ^ no fields | DoubleV -- ^ A Double: one field | IntV -- ^ An Int (32bit because JS): one field | LongV -- ^ A Long: two fields one for the upper 32bits, one for the lower (NB: JS is little endian) | AddrV -- ^ a pointer not to the heap: two fields, array + index - | RtsObjV -- ^ some RTS object from GHCJS (for example TVar#, MVar#, MutVar#, Weak#) | ObjV -- ^ some JS object, user supplied, be careful around these, can be anything | ArrV -- ^ boxed array deriving stock (Eq, Ord, Enum, Bounded, Show) ===================================== compiler/GHC/StgToJS/Utils.hs ===================================== @@ -38,7 +38,6 @@ module GHC.StgToJS.Utils , assocPrimReps , assocIdPrimReps , assocIdExprs - , mightBeAFunction , mkArityTag , toTypeList -- * Stg Utils @@ -147,11 +146,11 @@ assignCoerce1 _x _y = pprPanic "assignCoerce1" -- | Assign p2 to p1 with optional coercion assignCoerce :: TypedExpr -> TypedExpr -> JStat -- Coercion between StablePtr# and Addr# -assignCoerce (TypedExpr AddrRep [a_val, a_off]) (TypedExpr UnliftedRep [sptr]) = mconcat +assignCoerce (TypedExpr AddrRep [a_val, a_off]) (TypedExpr (BoxedRep (Just Unlifted)) [sptr]) = mconcat [ a_val |= var "h$stablePtrBuf" , a_off |= sptr ] -assignCoerce (TypedExpr UnliftedRep [sptr]) (TypedExpr AddrRep [_a_val, a_off]) = +assignCoerce (TypedExpr (BoxedRep (Just Unlifted)) [sptr]) (TypedExpr AddrRep [_a_val, a_off]) = sptr |= a_off assignCoerce p1 p2 = assignTypedExprs [p1] [p2] @@ -258,8 +257,7 @@ uTypeVt ut primRepVt :: HasDebugCallStack => PrimRep -> VarType primRepVt VoidRep = VoidV -primRepVt LiftedRep = PtrV -- fixme does ByteArray# ever map to this? -primRepVt UnliftedRep = RtsObjV +primRepVt (BoxedRep _) = PtrV -- fixme does ByteArray# ever map to this? primRepVt IntRep = IntV primRepVt Int8Rep = IntV primRepVt Int16Rep = IntV @@ -316,26 +314,26 @@ primTypeVt t = case tyConAppTyCon_maybe (unwrapType t) of | tc == word64PrimTyCon -> LongV | tc == addrPrimTyCon -> AddrV | tc == stablePtrPrimTyCon -> AddrV - | tc == stableNamePrimTyCon -> RtsObjV + | tc == stableNamePrimTyCon -> PtrV | tc == statePrimTyCon -> VoidV | tc == proxyPrimTyCon -> VoidV | tc == realWorldTyCon -> VoidV - | tc == threadIdPrimTyCon -> RtsObjV - | tc == weakPrimTyCon -> RtsObjV + | tc == threadIdPrimTyCon -> PtrV + | tc == weakPrimTyCon -> PtrV | tc == arrayPrimTyCon -> ArrV | tc == smallArrayPrimTyCon -> ArrV | tc == byteArrayPrimTyCon -> ObjV -- can contain any JS reference, used for JSVal | tc == mutableArrayPrimTyCon -> ArrV | tc == smallMutableArrayPrimTyCon -> ArrV | tc == mutableByteArrayPrimTyCon -> ObjV -- can contain any JS reference, used for JSVal - | tc == mutVarPrimTyCon -> RtsObjV - | tc == mVarPrimTyCon -> RtsObjV - | tc == tVarPrimTyCon -> RtsObjV - | tc == bcoPrimTyCon -> RtsObjV -- unsupported? - | tc == stackSnapshotPrimTyCon -> RtsObjV - | tc == ioPortPrimTyCon -> RtsObjV -- unsupported? + | tc == mutVarPrimTyCon -> PtrV + | tc == mVarPrimTyCon -> PtrV + | tc == tVarPrimTyCon -> PtrV + | tc == bcoPrimTyCon -> PtrV -- unsupported? + | tc == stackSnapshotPrimTyCon -> PtrV + | tc == ioPortPrimTyCon -> PtrV -- unsupported? | tc == anyTyCon -> PtrV - | tc == compactPrimTyCon -> ObjV -- unsupported? + | tc == compactPrimTyCon -> PtrV -- unsupported? | tc == eqPrimTyCon -> VoidV -- coercion token? | tc == eqReprPrimTyCon -> VoidV -- role | tc == unboxedUnitTyCon -> VoidV -- Void# @@ -392,17 +390,6 @@ assocIdPrimReps i = assocPrimReps (idPrimReps i) assocIdExprs :: Id -> [JExpr] -> [TypedExpr] assocIdExprs i es = fmap (uncurry TypedExpr) (assocIdPrimReps i es) --- | Return False only if we are *sure* it's a data type --- Look through newtypes etc as much as possible -mightBeAFunction :: HasDebugCallStack => Type -> Bool -mightBeAFunction ty - | [LiftedRep] <- typePrimRep ty - , Just tc <- tyConAppTyCon_maybe (unwrapType ty) - , isDataTyCon tc - = False - | otherwise - = True - mkArityTag :: Int -> Int -> Int mkArityTag arity registers = arity Bits..|. (registers `Bits.shiftL` 8) ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -20,6 +20,7 @@ types that {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} module GHC.Types.Basic ( LeftOrRight(..), @@ -1956,12 +1957,20 @@ isKindLevel KindLevel = True data Levity = Lifted | Unlifted - deriving Eq + deriving (Data,Eq,Ord,Show) instance Outputable Levity where ppr Lifted = text "Lifted" ppr Unlifted = text "Unlifted" +instance Binary Levity where + put_ bh = \case + Lifted -> putByte bh 0 + Unlifted -> putByte bh 1 + get bh = getByte bh >>= \case + 0 -> pure Lifted + _ -> pure Unlifted + mightBeLifted :: Maybe Levity -> Bool mightBeLifted (Just Unlifted) = False mightBeLifted _ = True ===================================== compiler/GHC/Types/RepType.hs ===================================== @@ -315,8 +315,10 @@ typeSlotTy ty = case typePrimRep ty of primRepSlot :: PrimRep -> SlotTy primRepSlot VoidRep = pprPanic "primRepSlot" (text "No slot for VoidRep") -primRepSlot LiftedRep = PtrLiftedSlot -primRepSlot UnliftedRep = PtrUnliftedSlot +primRepSlot (BoxedRep mlev) = case mlev of + Nothing -> panic "primRepSlot: levity polymorphic BoxedRep" + Just Lifted -> PtrLiftedSlot + Just Unlifted -> PtrUnliftedSlot primRepSlot IntRep = WordSlot primRepSlot Int8Rep = WordSlot primRepSlot Int16Rep = WordSlot @@ -333,8 +335,8 @@ primRepSlot DoubleRep = DoubleSlot primRepSlot (VecRep n e) = VecSlot n e slotPrimRep :: SlotTy -> PrimRep -slotPrimRep PtrLiftedSlot = LiftedRep -slotPrimRep PtrUnliftedSlot = UnliftedRep +slotPrimRep PtrLiftedSlot = BoxedRep (Just Lifted) +slotPrimRep PtrUnliftedSlot = BoxedRep (Just Unlifted) slotPrimRep Word64Slot = Word64Rep slotPrimRep WordSlot = WordRep slotPrimRep DoubleSlot = DoubleRep @@ -635,8 +637,10 @@ runtimeRepPrimRep_maybe rr_ty primRepToRuntimeRep :: PrimRep -> RuntimeRepType primRepToRuntimeRep rep = case rep of VoidRep -> zeroBitRepTy - LiftedRep -> liftedRepTy - UnliftedRep -> unliftedRepTy + BoxedRep mlev -> case mlev of + Nothing -> panic "primRepToRuntimeRep: levity polymorphic BoxedRep" + Just Lifted -> liftedRepTy + Just Unlifted -> unliftedRepTy IntRep -> intRepDataConTy Int8Rep -> int8RepDataConTy Int16Rep -> int16RepDataConTy @@ -688,7 +692,7 @@ mightBeFunTy :: Type -> Bool -- AK: It would be nice to figure out and document the difference -- between this and isFunTy at some point. mightBeFunTy ty - | [LiftedRep] <- typePrimRep ty + | [BoxedRep _] <- typePrimRep ty , Just tc <- tyConAppTyCon_maybe (unwrapType ty) , isDataTyCon tc = False ===================================== configure.ac ===================================== @@ -487,7 +487,6 @@ CFLAGS="$CFLAGS $GccUseLdOpt" AC_SUBST([LdCmd]) FP_PROG_LD_IS_GNU -FP_PROG_LD_BUILD_ID FP_PROG_LD_NO_COMPACT_UNWIND FP_PROG_LD_FILELIST ===================================== distrib/configure.ac.in ===================================== @@ -130,7 +130,6 @@ CFLAGS="$CFLAGS $GccUseLdOpt" AC_SUBST([LdCmd]) FP_PROG_LD_IS_GNU -FP_PROG_LD_BUILD_ID FP_PROG_LD_NO_COMPACT_UNWIND FP_PROG_LD_FILELIST ===================================== docs/users_guide/exts/linear_types.rst ===================================== @@ -14,7 +14,7 @@ Linear types warts, and bad error messages; everything down to the syntax is subject to change**. See, in particular, :ref:`linear-types-limitations` below. We encourage you to experiment -with this extension and report issues in the GHC bug tracker `the GHC +with this extension and report issues in `the GHC bug tracker `__, adding the tag ``LinearTypes``. ===================================== rts/js/rts.js ===================================== @@ -245,7 +245,7 @@ function h$printcl(i) { r += " "; switch(cl.i[i]) { case h$vt_ptr: - r += "[ Ptr :: " + d["d"+idx].f.n + "]"; + r += "[ Ptr :: " + d["d"+idx] + "]"; idx++; break; case h$vt_void: @@ -267,10 +267,6 @@ function h$printcl(i) { r += "(" + d["d"+idx].length + "," + d["d"+(idx+1)] + " :: ptr)"; idx+=2; break; - case h$vt_rtsobj: - r += "(" + d["d"+idx].toString() + " :: RTS object)"; - idx++; - break; default: r += "unknown field: " + cl.i[i]; } ===================================== rts/js/verify.js ===================================== @@ -113,7 +113,7 @@ function h$verify_rep_is_bytearray(o) { function h$verify_rep_heapobj(o) { // possibly an unlifted rts object // XXX: we should do a different check for these - if(h$verify_rep_is_rtsobj(o)) return; + if(h$verify_rep_is_rtsobj(o)) return h$verify_rep_rtsobj(o); // unboxed rep if(typeof o === 'number' || typeof o === 'boolean') return; // boxed rep ===================================== testsuite/tests/ghci/should_run/T16096.stdout ===================================== @@ -1,6 +1,6 @@ ==================== Desugared ==================== -let { +letrec { x :: [GHC.Types.Int] [LclId] x = let { @@ -11,7 +11,7 @@ let { x :: [GHC.Types.Int] [LclId] x = GHC.Enum.enumFrom @GHC.Types.Int $dEnum (GHC.Types.I# 1#); } in - x } in + x; } in GHC.Base.returnIO @[GHC.Types.Any] (GHC.Types.: @@ -27,7 +27,7 @@ GHC.Base.returnIO ==================== Desugared ==================== -let { +letrec { x :: [GHC.Types.Int] [LclId] x = let { @@ -38,7 +38,7 @@ let { x :: [GHC.Types.Int] [LclId] x = GHC.Enum.enumFrom @GHC.Types.Int $dEnum (GHC.Types.I# 1#); } in - x } in + x; } in GHC.Base.returnIO @[GHC.Types.Any] (GHC.Types.: ===================================== testsuite/tests/primops/should_run/all.T ===================================== @@ -8,7 +8,7 @@ test('T10481', exit_code(1), compile_and_run, ['']) test('T10678', [ collect_stats('bytes allocated',5), only_ways(['normal']), - js_broken(22360) + js_broken(22361) ], compile_and_run, ['-O']) test('T11296', normal, compile_and_run, ['']) ===================================== testsuite/tests/rep-poly/T22291.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE DataKinds #-} + +module T22291 where + +import GHC.Exts + +foo :: forall (lev :: Levity) (a :: TYPE (BoxedRep lev)). Addr# -> (# a #) +foo x = addrToAny# x ===================================== testsuite/tests/rep-poly/T22291b.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE DataKinds, MagicHash, UnboxedTuples #-} + +module T22291b where + +import GHC.Exts + +indexArray :: forall l (a :: TYPE (BoxedRep l)). Array# a -> Int# -> (# a #) +indexArray = indexArray# ===================================== testsuite/tests/rep-poly/all.T ===================================== @@ -15,7 +15,7 @@ test('T18170b', [extra_files(['T18170c.hs']), expect_broken(19893)], multimod_co # T18170b isn't actually broken, but it causes a Core Lint error # even though the program is (correctly) rejected by the typechecker test('T18481', normal, compile, ['']) -test('T18481a', js_broken(22360), compile, ['']) +test('T18481a', normal, compile, ['']) test('T18534', normal, compile_fail, ['']) test('T19615', normal, compile_fail, ['']) test('T19709a', normal, compile_fail, ['']) @@ -29,8 +29,10 @@ test('T20423b', normal, compile_fail, ['']) test('T20426', normal, compile_fail, ['']) test('T21239', normal, compile, ['']) test('T21544', normal, compile, ['-Wno-deprecated-flags']) +test('T22291', normal, compile, ['']) +test('T22291b', normal, compile, ['']) -test('EtaExpandDataCon', js_broken(22360), compile, ['-O']) +test('EtaExpandDataCon', normal, compile, ['-O']) test('EtaExpandStupid1', normal, compile, ['-Wno-deprecated-flags']) test('EtaExpandStupid2', normal, compile_fail, ['-Wno-deprecated-flags']) test('LevPolyLet', normal, compile_fail, ['']) @@ -43,7 +45,7 @@ test('RepPolyBackpack1', normal, backpack_compile_fail, ['']) test('RepPolyBackpack2', req_c, backpack_run, ['']) test('RepPolyBackpack3', normal, backpack_compile_fail, ['']) test('RepPolyBackpack4', req_c, backpack_run, ['']) -test('RepPolyBackpack5', js_broken(22360), backpack_run, ['']) +test('RepPolyBackpack5', js_broken(22361), backpack_run, ['']) test('RepPolyBinder', normal, compile_fail, ['']) test('RepPolyCase1', normal, compile_fail, ['']) test('RepPolyClassMethod', normal, compile_fail, ['']) @@ -79,8 +81,8 @@ test('RepPolySum', normal, compile_fail, ['']) test('RepPolyTuple', normal, compile_fail, ['']) test('RepPolyTupleSection', normal, compile_fail, ['']) test('RepPolyUnboxedPatterns', normal, compile_fail, ['']) -test('RepPolyUnliftedDatatype', js_broken(22360), compile, ['']) -test('RepPolyUnliftedDatatype2', js_broken(22261), compile, ['-O']) +test('RepPolyUnliftedDatatype', normal, compile, ['']) +test('RepPolyUnliftedDatatype2', normal, compile, ['-O']) test('RepPolyUnliftedNewtype', normal, compile, ['-fno-warn-partial-type-signatures -fno-warn-deprecated-flags']) test('RepPolyWildcardPattern', normal, compile_fail, ['']) ===================================== testsuite/tests/unlifted-datatypes/should_compile/all.T ===================================== @@ -1,4 +1,4 @@ test('UnlDataMonoSigs', normal, compile, ['']) -test('UnlDataPolySigs', js_broken(22360), compile, ['']) +test('UnlDataPolySigs', normal, compile, ['']) test('UnlDataFams', normal, compile, ['']) -test('UnlDataUsersGuide', js_broken(22360), compile, ['']) +test('UnlDataUsersGuide', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e09175c47ac69b2d21d49cf7b68ab4f02dd0371d...5c050e68110c9a2b706c66dead860156778e56f6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e09175c47ac69b2d21d49cf7b68ab4f02dd0371d...5c050e68110c9a2b706c66dead860156778e56f6 You're receiving 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 Jun 26 17:56:28 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 13:56:28 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 11 commits: ghc-toolchain: Toolchain Selection Message-ID: <6499d14ce8e9c_2402e03505da4109990@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: eaf8568e by Rodrigo Mesquita at 2023-06-26T18:55:56+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b480f4ab1514ac0a4fc957db199d1a0279. Revert get_arm_isa deletion from 74f03f243d08aa910d39cdd9dadb976e9386283a As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples - - - - - a46933e1 by Rodrigo Mesquita at 2023-06-26T18:55:56+01:00 configure: Revert ripping out of toolchain selection logic - - - - - 71b5a19f by Rodrigo Mesquita at 2023-06-26T18:55:56+01:00 Stop configuring into settings unused Ld command - - - - - 9dce4c67 by Rodrigo Mesquita at 2023-06-26T18:55:56+01:00 configure: Create and validate toolchain target file - - - - - 0f004240 by Rodrigo Mesquita at 2023-06-26T18:55:56+01:00 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now - - - - - 53067d14 by Rodrigo Mesquita at 2023-06-26T18:55:56+01:00 ghc-toolchain: set CC LD plat. dependent flags A lot to be said about this approach, we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? - - - - - 838970c2 by Rodrigo Mesquita at 2023-06-26T18:55:56+01:00 ghc-toolchain: Create default.target in the bindist - - - - - bce00b92 by Rodrigo Mesquita at 2023-06-26T18:55:56+01:00 A TODO comment - - - - - cff8aa4d by Rodrigo Mesquita at 2023-06-26T18:55:56+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - e32a209a by Rodrigo Mesquita at 2023-06-26T18:55:56+01:00 Use ghc-platform instead of ghc-boot del async dep - - - - - 26b82e64 by Rodrigo Mesquita at 2023-06-26T18:55:56+01:00 Fixes - - - - - 30 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/Static.hs - configure.ac - + default.target.in - distrib/configure.ac.in - ghc/Main.hs - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Test.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Cc.hs - hadrian/src/Settings/Builders/DeriveConstants.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/HsCpp.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4039a8d30c7c9e1ab41f9208c02e782486ec1dff...26b82e647ec5b2bc8ed5dec0d867cf7132024bfe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4039a8d30c7c9e1ab41f9208c02e782486ec1dff...26b82e647ec5b2bc8ed5dec0d867cf7132024bfe You're receiving 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 Jun 26 18:10:51 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 26 Jun 2023 14:10:51 -0400 Subject: [Git][ghc/ghc][wip/tsan/no-barriers] 38 commits: Avoid desugaring non-recursive lets into recursive lets Message-ID: <6499d4abeba38_2402e0261deb8110948@gitlab.mail> Ben Gamari pushed to branch wip/tsan/no-barriers at Glasgow Haskell Compiler / GHC Commits: 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 17a2feb2 by Ben Gamari at 2023-06-26T09:11:01-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - 6be3da22 by Ben Gamari at 2023-06-26T09:11:01-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 76c19a69 by Ben Gamari at 2023-06-26T09:11:44-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - 4aafa3b4 by Ben Gamari at 2023-06-26T09:11:45-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 2f9ba321 by Ben Gamari at 2023-06-26T09:11:45-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 7e2b9860 by Sven Tennie at 2023-06-26T09:11:45-04:00 compiler: Drop MO_ReadBarrier - - - - - cae88d65 by Ben Gamari at 2023-06-26T09:12:43-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - c798dde6 by Sven Tennie at 2023-06-26T09:13:10-04:00 Delete write_barrier function - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Linker/Loader.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1e7b6cc1eab4526f77da5db219546e4a58cae70d...c798dde6efd96c797a184d2e84ff03769463b791 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1e7b6cc1eab4526f77da5db219546e4a58cae70d...c798dde6efd96c797a184d2e84ff03769463b791 You're receiving 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 Jun 26 18:11:26 2023 From: gitlab at gitlab.haskell.org (Torsten Schmits (@torsten.schmits)) Date: Mon, 26 Jun 2023 14:11:26 -0400 Subject: [Git][ghc/ghc][wip/torsten.schmits/16468] mult and fun Message-ID: <6499d4ce5a230_2402e0261deb811174@gitlab.mail> Torsten Schmits pushed to branch wip/torsten.schmits/16468 at Glasgow Haskell Compiler / GHC Commits: 726552f5 by Krzysztof Gogolewski at 2023-06-26T18:11:24+00:00 mult and fun - - - - - 1 changed file: - compiler/GHC/Iface/Type.hs Changes: ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -1165,10 +1165,10 @@ defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv True ty = IfaceTupleTy sort is_prom (go_args subs False tc_args) go subs rank1 (IfaceFunTy af w arg res) - = IfaceFunTy af (go subs rank1 w) (go subs False arg) (go subs rank1 res) + = IfaceFunTy af (go subs False w) (go subs False arg) (go subs rank1 res) go subs rank1 (IfaceAppTy t ts) - = IfaceAppTy (go subs rank1 t) (go_args subs False ts) + = IfaceAppTy (go subs False t) (go_args subs False ts) go subs rank1 (IfaceCastTy x co) = IfaceCastTy (go subs rank1 x) co View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/726552f54c349126ed0cc2fe79a8f543a01ac198 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/726552f54c349126ed0cc2fe79a8f543a01ac198 You're receiving 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 Jun 26 18:12:56 2023 From: gitlab at gitlab.haskell.org (Torsten Schmits (@torsten.schmits)) Date: Mon, 26 Jun 2023 14:12:56 -0400 Subject: [Git][ghc/ghc][wip/torsten.schmits/16468] Relax defaulting of RuntimeRep/Levity when printing Message-ID: <6499d5286249f_2402e035098f011214c@gitlab.mail> Torsten Schmits pushed to branch wip/torsten.schmits/16468 at Glasgow Haskell Compiler / GHC Commits: 873417ba by Torsten Schmits at 2023-06-26T20:12:48+02:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 5 changed files: - compiler/GHC/Iface/Type.hs - compiler/GHC/Types/Unique/DFM.hs - + testsuite/tests/ghci/scripts/T16468.script - + testsuite/tests/ghci/scripts/T16468.stdout - testsuite/tests/ghci/scripts/all.T Changes: ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -987,7 +987,7 @@ ppr_ty ctxt_prec ty@(IfaceFunTy af w ty1 ty2) -- Should be a visible argument | isVisibleFunArg af = (pprTypeArrow af wthis <+> ppr_ty funPrec ty1) : ppr_fun_tail wnext ty2 ppr_fun_tail wthis other_ty - = [pprTypeArrow af wthis <+> pprIfaceType other_ty] + = [pprTypeArrow af wthis <+> ppr_ty topPrec other_ty] ppr_ty ctxt_prec (IfaceAppTy t ts) = if_print_coercions @@ -1044,9 +1044,11 @@ Haskell programs, so it makes little sense to make all users pay this syntactic overhead. For this reason it was decided that we would hide RuntimeRep variables -for now (see #11549). We do this by defaulting all type variables of -kind RuntimeRep to LiftedRep. -Likewise, we default all Multiplicity variables to Many. +for now (see #11549). We do this right in the pretty-printer, by pre-processing +the type we are about to print, to default any type variables of kind RuntimeRep +that are bound by toplevel invisible quantification to LiftedRep. +Likewise, we default Multiplicity variables to Many and Levity variables to +Lifted. This is done in a pass right before pretty-printing (defaultIfaceTyVarsOfKind, controlled by @@ -1073,6 +1075,22 @@ metavariables are converted, skolem variables are not. There's one exception though: TyVarTv metavariables should not be defaulted, as they appear during kind-checking of "newtype T :: TYPE r where..." (test T18357a). Therefore, we additionally test for isTyConableTyVar. + +Wrinkles: + +(W1) The loop 'go' in 'defaultIfaceTyVarsOfKind' passes a Bool flag, 'rank1', + around that indicates whether we haven't yet descended into the arguments + of a function type. + This is used to decide whether newly bound variables are eligible for + defaulting – we do not want contravariant foralls to be defaulted because + that would result in an incorrect, rather than specialized, type. + For example: + ∀ p (r1 :: RuntimeRep) . (∀ (r2 :: RuntimeRep) . p r2) -> p r1 + We want to default 'r1', but not 'r2'. + When examining the first forall, 'rank1' is True. + The toplevel function type is matched as IfaceFunTy, where we recurse into + 'go' by passing False for 'rank1'. + The forall in the first argument then skips adding a substitution for 'r2'. -} -- | Default 'RuntimeRep' variables to 'LiftedRep', @@ -1097,28 +1115,30 @@ as they appear during kind-checking of "newtype T :: TYPE r where..." defaultIfaceTyVarsOfKind :: Bool -- ^ default 'RuntimeRep'/'Levity' variables? -> Bool -- ^ default 'Multiplicity' variables? -> IfaceType -> IfaceType -defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv ty +defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv True ty where go :: FastStringEnv IfaceType -- Set of enclosing forall-ed RuntimeRep/Levity/Multiplicity variables + -> Bool -- Are we in a toplevel forall, where defaulting is allowed for RR/L? -> IfaceType -> IfaceType - go subs (IfaceForAllTy (Bndr (IfaceTvBndr (var, var_kind)) argf) ty) + go subs rank1 (IfaceForAllTy (Bndr (IfaceTvBndr (var, var_kind)) argf) ty) | isInvisibleForAllTyFlag argf -- Don't default *visible* quantification -- or we get the mess in #13963 + , rank1 , Just substituted_ty <- check_substitution var_kind = let subs' = extendFsEnv subs var substituted_ty -- Record that we should replace it with LiftedRep/Lifted/Many, -- and recurse, discarding the forall - in go subs' ty + in go subs' rank1 ty - go subs (IfaceForAllTy bndr ty) - = IfaceForAllTy (go_ifacebndr subs bndr) (go subs ty) + go subs rank1 (IfaceForAllTy bndr ty) + = IfaceForAllTy (go_ifacebndr subs rank1 bndr) (go subs rank1 ty) - go subs ty@(IfaceTyVar tv) = case lookupFsEnv subs tv of + go subs _ ty@(IfaceTyVar tv) = case lookupFsEnv subs tv of Just s -> s Nothing -> ty - go _ ty@(IfaceFreeTyVar tv) + go _ _ ty@(IfaceFreeTyVar tv) -- See Note [Defaulting RuntimeRep variables], about free vars | def_rep , GHC.Core.Type.isRuntimeRepTy (tyVarKind tv) @@ -1138,34 +1158,34 @@ defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv ty | otherwise = ty - go subs (IfaceTyConApp tc tc_args) - = IfaceTyConApp tc (go_args subs tc_args) + go subs _ (IfaceTyConApp tc tc_args) + = IfaceTyConApp tc (go_args subs False tc_args) - go subs (IfaceTupleTy sort is_prom tc_args) - = IfaceTupleTy sort is_prom (go_args subs tc_args) + go subs _ (IfaceTupleTy sort is_prom tc_args) + = IfaceTupleTy sort is_prom (go_args subs False tc_args) - go subs (IfaceFunTy af w arg res) - = IfaceFunTy af (go subs w) (go subs arg) (go subs res) + go subs rank1 (IfaceFunTy af w arg res) + = IfaceFunTy af (go subs False w) (go subs False arg) (go subs rank1 res) - go subs (IfaceAppTy t ts) - = IfaceAppTy (go subs t) (go_args subs ts) + go subs rank1 (IfaceAppTy t ts) + = IfaceAppTy (go subs False t) (go_args subs False ts) - go subs (IfaceCastTy x co) - = IfaceCastTy (go subs x) co + go subs rank1 (IfaceCastTy x co) + = IfaceCastTy (go subs rank1 x) co - go _ ty@(IfaceLitTy {}) = ty - go _ ty@(IfaceCoercionTy {}) = ty + go _ _ ty@(IfaceLitTy {}) = ty + go _ _ ty@(IfaceCoercionTy {}) = ty - go_ifacebndr :: FastStringEnv IfaceType -> IfaceForAllBndr -> IfaceForAllBndr - go_ifacebndr subs (Bndr (IfaceIdBndr (w, n, t)) argf) - = Bndr (IfaceIdBndr (w, n, go subs t)) argf - go_ifacebndr subs (Bndr (IfaceTvBndr (n, t)) argf) - = Bndr (IfaceTvBndr (n, go subs t)) argf + go_ifacebndr :: FastStringEnv IfaceType -> Bool -> IfaceForAllBndr -> IfaceForAllBndr + go_ifacebndr subs rank1 (Bndr (IfaceIdBndr (w, n, t)) argf) + = Bndr (IfaceIdBndr (w, n, go subs rank1 t)) argf + go_ifacebndr subs rank1 (Bndr (IfaceTvBndr (n, t)) argf) + = Bndr (IfaceTvBndr (n, go subs rank1 t)) argf - go_args :: FastStringEnv IfaceType -> IfaceAppArgs -> IfaceAppArgs - go_args _ IA_Nil = IA_Nil - go_args subs (IA_Arg ty argf args) - = IA_Arg (go subs ty) argf (go_args subs args) + go_args :: FastStringEnv IfaceType -> Bool -> IfaceAppArgs -> IfaceAppArgs + go_args _ _ IA_Nil = IA_Nil + go_args subs rank1 (IA_Arg ty argf args) + = IA_Arg (go subs rank1 ty) argf (go_args subs rank1 args) check_substitution :: IfaceType -> Maybe IfaceType check_substitution (IfaceTyConApp tc _) @@ -1367,7 +1387,7 @@ ppr_sigma show_forall ctxt_prec iface_ty -- Then it could handle both invisible and required binders, and -- splitIfaceReqForallTy wouldn't be necessary here. in ppr_iface_forall_part show_forall invis_tvs theta $ - sep [pprIfaceForAll req_tvs, ppr tau'] + sep [pprIfaceForAll req_tvs, ppr_ty topPrec tau'] pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc pprUserIfaceForAll tvs ===================================== compiler/GHC/Types/Unique/DFM.hs ===================================== @@ -94,7 +94,7 @@ import qualified Data.IntSet as I -- order then `udfmToList` returns them in deterministic order. -- -- There is an implementation cost: each element is given a serial number --- as it is added, and `udfmToList` sorts it's result by this serial +-- as it is added, and `udfmToList` sorts its result by this serial -- number. So you should only use `UniqDFM` if you need the deterministic -- property. -- ===================================== testsuite/tests/ghci/scripts/T16468.script ===================================== @@ -0,0 +1,48 @@ +:set -XLinearTypes -XImpredicativeTypes +import GHC.Types (RuntimeRep (..), Levity (..), TYPE, Multiplicity) +import Data.Proxy + +f :: forall p (r' :: RuntimeRep). (forall (r :: RuntimeRep). Int -> p r) -> p r'; f x = x 5 +g :: forall p. Int -> forall (r :: RuntimeRep). p r; g _ = undefined +g' :: Int -> forall p (r :: RuntimeRep). p r; g' _ = undefined +h :: Int -> forall (r :: RuntimeRep). TYPE r; h _ = undefined +i :: forall (r :: RuntimeRep). Int -> TYPE r; i _ = undefined +j :: forall p. Eq (p ('BoxedRep 'Lifted)) => Int -> forall (r :: RuntimeRep). p r; j _ = undefined +k :: forall p (r' :: RuntimeRep). Eq (p r') => (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) -> p r'; k x = x 5 +class C a where l :: forall (r :: RuntimeRep) (b :: TYPE r). a -> b +m :: (forall (m :: Multiplicity). Int %m -> Int) -> Int; m x = x 5 +n :: forall (m :: Multiplicity). Int %m -> Int; n a = a +o :: Maybe (forall (r :: RuntimeRep). Proxy r); o = Nothing +p :: (forall (r :: RuntimeRep). Proxy r, Int); p = undefined +q :: p (forall (r :: RuntimeRep). Proxy r); q = undefined +:set -XNoLinearTypes + +:type f +:type g +:type g' +:type h +:type i +:type j +:type k +:type l +:type m +:type n +:type o +:type p +:type q + +:set -fprint-explicit-runtime-reps +:set -XLinearTypes +:type f +:type g +:type g' +:type h +:type i +:type j +:type k +:type l +:type m +:type n +:type o +:type p +:type q ===================================== testsuite/tests/ghci/scripts/T16468.stdout ===================================== @@ -0,0 +1,31 @@ +f :: (forall (r :: RuntimeRep). Int -> p r) + -> p GHC.Types.LiftedRep +g :: Int -> p GHC.Types.LiftedRep +g' :: Int -> forall (p :: RuntimeRep -> *). p GHC.Types.LiftedRep +h :: Int -> * +i :: Int -> * +j :: Eq (p GHC.Types.LiftedRep) => Int -> p GHC.Types.LiftedRep +k :: Eq (p GHC.Types.LiftedRep) => + (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) + -> p GHC.Types.LiftedRep +l :: C a => a -> b +m :: (forall (m :: Multiplicity). Int %m -> Int) -> Int +n :: Int -> Int +o :: Maybe (forall (r :: RuntimeRep). Proxy r) +p :: (Proxy GHC.Types.LiftedRep, Int) +q :: p (forall (r :: RuntimeRep). Proxy r) +f :: (forall (r :: RuntimeRep). Int -> p r) -> p r' +g :: Int -> forall (r :: RuntimeRep). p r +g' :: Int -> forall (p :: RuntimeRep -> *) (r :: RuntimeRep). p r +h :: Int -> forall (r :: RuntimeRep). TYPE r +i :: Int -> TYPE r +j :: Eq (p GHC.Types.LiftedRep) => + Int -> forall (r :: RuntimeRep). p r +k :: Eq (p r') => + (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) -> p r' +l :: forall a (r :: RuntimeRep) (b :: TYPE r). C a => a -> b +m :: (forall (m :: Multiplicity). Int %m -> Int) -> Int +n :: Int %m -> Int +o :: Maybe (forall (r :: RuntimeRep). Proxy r) +p :: (forall (r :: RuntimeRep). Proxy r, Int) +q :: p (forall (r :: RuntimeRep). Proxy r) ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -375,3 +375,4 @@ test('T22695', normal, ghci_script, ['T22695.script']) test('T22817', normal, ghci_script, ['T22817.script']) test('T22908', normal, ghci_script, ['T22908.script']) test('T23062', normal, ghci_script, ['T23062.script']) +test('T16468', normal, ghci_script, ['T16468.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/873417ba802fb44f26f10feae765ffefb30fd004 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/873417ba802fb44f26f10feae765ffefb30fd004 You're receiving 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 Jun 26 18:21:46 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 14:21:46 -0400 Subject: [Git][ghc/ghc][wip/romes/remove-toolchain-runtime-config] Rip out runtime linker/compiler checks Message-ID: <6499d73a56123_2402e03505da411633f@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/remove-toolchain-runtime-config at Glasgow Haskell Compiler / GHC Commits: 9732aa02 by Ben Gamari at 2023-06-26T19:21:30+01:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 11 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/SysTools.hs - − compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - compiler/ghc.cabal.in - + m4/fp_link_supports_no_as_needed.m4 - m4/fptools_set_c_ld_flags.m4 Changes: ===================================== compiler/GHC/Driver/Backend.hs ===================================== @@ -58,8 +58,6 @@ module GHC.Driver.Backend , DefunctionalizedCodeOutput(..) -- *** Back-end functions for assembly , DefunctionalizedPostHscPipeline(..) - , DefunctionalizedAssemblerProg(..) - , DefunctionalizedAssemblerInfoGetter(..) -- *** Other back-end functions , DefunctionalizedCDefs(..) -- ** Names of back ends (for API clients of version 9.4 or earlier) @@ -94,8 +92,6 @@ module GHC.Driver.Backend , backendSupportsHpc , backendSupportsCImport , backendSupportsCExport - , backendAssemblerProg - , backendAssemblerInfoGetter , backendCDefs , backendCodeOutput , backendUseJSLinker @@ -348,40 +344,6 @@ data PrimitiveImplementation deriving Show --- | Names a function that runs the assembler, of this type: --- --- > Logger -> DynFlags -> Platform -> [Option] -> IO () --- --- The functions so named are defined in "GHC.Driver.Pipeline.Execute". - -data DefunctionalizedAssemblerProg - = StandardAssemblerProg - -- ^ Use the standard system assembler - | JSAssemblerProg - -- ^ JS Backend compile to JS via Stg, and so does not use any assembler - | DarwinClangAssemblerProg - -- ^ If running on Darwin, use the assembler from the @clang@ - -- toolchain. Otherwise use the standard system assembler. - - - --- | Names a function that discover from what toolchain the assembler --- is coming, of this type: --- --- > Logger -> DynFlags -> Platform -> IO CompilerInfo --- --- The functions so named are defined in "GHC.Driver.Pipeline.Execute". - -data DefunctionalizedAssemblerInfoGetter - = StandardAssemblerInfoGetter - -- ^ Interrogate the standard system assembler - | JSAssemblerInfoGetter - -- ^ If using the JS backend; return 'Emscripten' - | DarwinClangAssemblerInfoGetter - -- ^ If running on Darwin, return `Clang`; otherwise - -- interrogate the standard system assembler. - - -- | Names a function that generates code and writes the results to a -- file, of this type: -- @@ -770,45 +732,6 @@ backendSupportsCExport (Named JavaScript) = True backendSupportsCExport (Named Interpreter) = False backendSupportsCExport (Named NoBackend) = True --- | This (defunctionalized) function runs the assembler --- used on the code that is written by this back end. A --- program determined by a combination of back end, --- `DynFlags`, and `Platform` is run with the given --- `Option`s. --- --- The function's type is --- @ --- Logger -> DynFlags -> Platform -> [Option] -> IO () --- @ --- --- This field is usually defaulted. -backendAssemblerProg :: Backend -> DefunctionalizedAssemblerProg -backendAssemblerProg (Named NCG) = StandardAssemblerProg -backendAssemblerProg (Named LLVM) = DarwinClangAssemblerProg -backendAssemblerProg (Named ViaC) = StandardAssemblerProg -backendAssemblerProg (Named JavaScript) = JSAssemblerProg -backendAssemblerProg (Named Interpreter) = StandardAssemblerProg -backendAssemblerProg (Named NoBackend) = StandardAssemblerProg - --- | This (defunctionalized) function is used to retrieve --- an enumeration value that characterizes the C/assembler --- part of a toolchain. The function caches the info in a --- mutable variable that is part of the `DynFlags`. --- --- The function's type is --- @ --- Logger -> DynFlags -> Platform -> IO CompilerInfo --- @ --- --- This field is usually defaulted. -backendAssemblerInfoGetter :: Backend -> DefunctionalizedAssemblerInfoGetter -backendAssemblerInfoGetter (Named NCG) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named LLVM) = DarwinClangAssemblerInfoGetter -backendAssemblerInfoGetter (Named ViaC) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named JavaScript) = JSAssemblerInfoGetter -backendAssemblerInfoGetter (Named Interpreter) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named NoBackend) = StandardAssemblerInfoGetter - -- | When using this back end, it may be necessary or -- advisable to pass some `-D` options to a C compiler. -- This (defunctionalized) function produces those ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -116,7 +116,6 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Trans.Reader (ReaderT) import Control.Monad.Trans.Writer (WriterT) -import Data.IORef import System.IO import System.IO.Error (catchIOError) import System.Environment (lookupEnv) @@ -420,15 +419,6 @@ data DynFlags = DynFlags { avx512pf :: Bool, -- Enable AVX-512 PreFetch Instructions. fma :: Bool, -- ^ Enable FMA instructions. - -- | Run-time linker information (what options we need, etc.) - rtldInfo :: IORef (Maybe LinkerInfo), - - -- | Run-time C compiler information - rtccInfo :: IORef (Maybe CompilerInfo), - - -- | Run-time assembler information - rtasmInfo :: IORef (Maybe CompilerInfo), - -- Constants used to control the amount of optimization done. -- | Max size, in bytes, of inline array allocations. @@ -490,9 +480,6 @@ class ContainsDynFlags t where initDynFlags :: DynFlags -> IO DynFlags initDynFlags dflags = do let - refRtldInfo <- newIORef Nothing - refRtccInfo <- newIORef Nothing - refRtasmInfo <- newIORef Nothing canUseUnicode <- do let enc = localeEncoding str = "‘’" (withCString enc str $ \cstr -> @@ -514,9 +501,6 @@ initDynFlags dflags = do useColor = useColor', canUseColor = stderrSupportsAnsiColors, colScheme = colScheme', - rtldInfo = refRtldInfo, - rtccInfo = refRtccInfo, - rtasmInfo = refRtasmInfo, tmpDir = TempDir tmp_dir } @@ -695,9 +679,6 @@ defaultDynFlags mySettings = avx512f = False, avx512pf = False, fma = False, - rtldInfo = panic "defaultDynFlags: no rtldInfo", - rtccInfo = panic "defaultDynFlags: no rtccInfo", - rtasmInfo = panic "defaultDynFlags: no rtasmInfo", maxInlineAllocSize = 128, maxInlineMemcpyInsns = 32, ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -109,9 +109,6 @@ module GHC.Driver.Main import GHC.Prelude -import GHC.Platform -import GHC.Platform.Ways - import GHC.Driver.Plugins import GHC.Driver.Session import GHC.Driver.Backend @@ -336,41 +333,11 @@ initHscEnv mb_top_dir = do mySettings <- initSysTools top_dir dflags <- initDynFlags (defaultDynFlags mySettings) hsc_env <- newHscEnv top_dir dflags - checkBrokenTablesNextToCode (hsc_logger hsc_env) dflags setUnsafeGlobalDynFlags dflags -- c.f. DynFlags.parseDynamicFlagsFull, which -- creates DynFlags and sets the UnsafeGlobalDynFlags return hsc_env --- | The binutils linker on ARM emits unnecessary R_ARM_COPY relocations which --- breaks tables-next-to-code in dynamically linked modules. This --- check should be more selective but there is currently no released --- version where this bug is fixed. --- See https://sourceware.org/bugzilla/show_bug.cgi?id=16177 and --- https://gitlab.haskell.org/ghc/ghc/issues/4210#note_78333 -checkBrokenTablesNextToCode :: Logger -> DynFlags -> IO () -checkBrokenTablesNextToCode logger dflags = do - let invalidLdErr = "Tables-next-to-code not supported on ARM \ - \when using binutils ld (please see: \ - \https://sourceware.org/bugzilla/show_bug.cgi?id=16177)" - broken <- checkBrokenTablesNextToCode' logger dflags - when broken (panic invalidLdErr) - -checkBrokenTablesNextToCode' :: Logger -> DynFlags -> IO Bool -checkBrokenTablesNextToCode' logger dflags - | not (isARM arch) = return False - | ways dflags `hasNotWay` WayDyn = return False - | not tablesNextToCode = return False - | otherwise = do - linkerInfo <- liftIO $ GHC.SysTools.getLinkerInfo logger dflags - case linkerInfo of - GnuLD _ -> return True - _ -> return False - where platform = targetPlatform dflags - arch = platformArch platform - tablesNextToCode = platformTablesNextToCode platform - - -- ----------------------------------------------------------------------------- getDiagnostics :: Hsc (Messages GhcMessage) ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -288,11 +288,6 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do let dflags = hsc_dflags hsc_env let logger = hsc_logger hsc_env let unit_env = hsc_unit_env hsc_env - let platform = ue_platform unit_env - - -- LLVM from version 3.0 onwards doesn't support the OS X system - -- assembler, so we use clang as the assembler instead. (#5636) - let as_prog = applyAssemblerProg $ backendAssemblerProg (backend dflags) let cmdline_include_paths = includePaths dflags let pic_c_flags = picCCOpts dflags @@ -310,9 +305,8 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do includePathsQuoteImplicit cmdline_include_paths] let runAssembler inputFilename outputFilename = withAtomicRename outputFilename $ \temp_outputFilename -> - as_prog + runAs logger dflags - platform (local_includes ++ global_includes -- See Note [-fPIC for assembler] ++ map GHC.SysTools.Option pic_c_flags @@ -392,22 +386,6 @@ runForeignJsPhase pipe_env hsc_env _location input_fn = do embedJsFile logger dflags tmpfs unit_env input_fn output_fn return output_fn - -applyAssemblerProg - :: DefunctionalizedAssemblerProg - -> Logger -> DynFlags -> Platform -> [Option] -> IO () -applyAssemblerProg StandardAssemblerProg logger dflags _platform = - runAs logger dflags -applyAssemblerProg JSAssemblerProg logger dflags _platform = - runEmscripten logger dflags -applyAssemblerProg DarwinClangAssemblerProg logger dflags platform = - if platformOS platform == OSDarwin then - runClang logger dflags - else - runAs logger dflags - - - runCcPhase :: Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO FilePath runCcPhase cc_phase pipe_env hsc_env location input_fn = do let dflags = hsc_dflags hsc_env ===================================== compiler/GHC/Linker/ExtraObj.hs ===================================== @@ -12,7 +12,6 @@ module GHC.Linker.ExtraObj , mkNoteObjsToLinkIntoBinary , checkLinkInfo , getLinkInfo - , getCompilerInfo , ghcLinkInfoSectionName , ghcLinkInfoNoteName , platformSupportsSavingLinkOpts @@ -40,10 +39,8 @@ import qualified GHC.Data.ShortText as ST import GHC.SysTools.Elf import GHC.SysTools.Tasks -import GHC.SysTools.Info import GHC.Linker.Unit -import Control.Monad.IO.Class import Control.Monad import Data.Maybe @@ -52,7 +49,6 @@ mkExtraObj logger tmpfs dflags unit_state extn xs = do cFile <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule extn oFile <- newTempName logger tmpfs (tmpDir dflags) TFL_GhcSession "o" writeFile cFile xs - ccInfo <- liftIO $ getCompilerInfo logger dflags runCc Nothing logger tmpfs dflags ([Option "-c", FileOption "" cFile, @@ -60,7 +56,7 @@ mkExtraObj logger tmpfs dflags unit_state extn xs FileOption "" oFile] ++ if extn /= "s" then cOpts - else asmOpts ccInfo) + else []) return oFile where -- Pass a different set of options to the C compiler depending one whether @@ -70,14 +66,6 @@ mkExtraObj logger tmpfs dflags unit_state extn xs ++ map (FileOption "-I" . ST.unpack) (unitIncludeDirs $ unsafeLookupUnit unit_state rtsUnit) - -- When compiling assembler code, we drop the usual C options, and if the - -- compiler is Clang, we add an extra argument to tell Clang to ignore - -- unused command line options. See trac #11684. - asmOpts ccInfo = - if any (ccInfo ==) [Clang, AppleClang, AppleClang51] - then [Option "-Qunused-arguments"] - else [] - -- When linking a binary, we need to create a C main() function that -- starts everything off. This used to be compiled statically as part -- of the RTS, but that made it hard to change the -rtsopts setting, ===================================== compiler/GHC/SysTools.hs ===================================== @@ -17,7 +17,6 @@ module GHC.SysTools ( -- * Interface to system tools module GHC.SysTools.Tasks, - module GHC.SysTools.Info, -- * Fast file copy copyFile, @@ -35,8 +34,6 @@ import GHC.Prelude import GHC.Utils.Panic import GHC.Driver.Session -import GHC.Linker.ExtraObj -import GHC.SysTools.Info import GHC.SysTools.Tasks import GHC.SysTools.BaseDir import GHC.Settings.IO ===================================== compiler/GHC/SysTools/Info.hs deleted ===================================== @@ -1,243 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} ------------------------------------------------------------------------------ --- --- Compiler information functions --- --- (c) The GHC Team 2017 --- ------------------------------------------------------------------------------ -module GHC.SysTools.Info where - -import GHC.Utils.Exception -import GHC.Utils.Error -import GHC.Driver.Session -import GHC.Utils.Outputable -import GHC.Utils.Misc -import GHC.Utils.Logger - -import Data.List ( isInfixOf, isPrefixOf ) -import Data.IORef - -import System.IO - -import GHC.Platform -import GHC.Prelude - -import GHC.SysTools.Process - -{- Note [Run-time linker info] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~ -See also: #5240, #6063, #10110 - -Before 'runLink', we need to be sure to get the relevant information -about the linker we're using at runtime to see if we need any extra -options. - -Generally, the linker changing from what was detected at ./configure -time has always been possible using -pgml, but on Linux it can happen -'transparently' by installing packages like binutils-gold, which -change what /usr/bin/ld actually points to. - -Clang vs GCC notes: - -For gcc, 'gcc -Wl,--version' gives a bunch of output about how to -invoke the linker before the version information string. For 'clang', -the version information for 'ld' is all that's output. For this -reason, we typically need to slurp up all of the standard error output -and look through it. - -Other notes: - -We cache the LinkerInfo inside DynFlags, since clients may link -multiple times. The definition of LinkerInfo is there to avoid a -circular dependency. - --} - -{- Note [ELF needed shared libs] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Some distributions change the link editor's default handling of -ELF DT_NEEDED tags to include only those shared objects that are -needed to resolve undefined symbols. For Template Haskell we need -the last temporary shared library also if it is not needed for the -currently linked temporary shared library. We specify --no-as-needed -to override the default. This flag exists in GNU ld and GNU gold. - -The flag is only needed on ELF systems. On Windows (PE) and Mac OS X -(Mach-O) the flag is not needed. - --} - -neededLinkArgs :: LinkerInfo -> [Option] -neededLinkArgs (GnuLD o) = o -neededLinkArgs (Mold o) = o -neededLinkArgs (GnuGold o) = o -neededLinkArgs (LlvmLLD o) = o -neededLinkArgs (DarwinLD o) = o -neededLinkArgs (SolarisLD o) = o -neededLinkArgs (AixLD o) = o -neededLinkArgs UnknownLD = [] - --- Grab linker info and cache it in DynFlags. -getLinkerInfo :: Logger -> DynFlags -> IO LinkerInfo -getLinkerInfo logger dflags = do - info <- readIORef (rtldInfo dflags) - case info of - Just v -> return v - Nothing -> do - v <- getLinkerInfo' logger dflags - writeIORef (rtldInfo dflags) (Just v) - return v - --- See Note [Run-time linker info]. -getLinkerInfo' :: Logger -> DynFlags -> IO LinkerInfo -getLinkerInfo' logger dflags = do - let platform = targetPlatform dflags - os = platformOS platform - (pgm,args0) = pgm_l dflags - args1 = map Option (getOpts dflags opt_l) - args2 = args0 ++ args1 - args3 = filter notNull (map showOpt args2) - - -- Try to grab the info from the process output. - parseLinkerInfo stdo _stde _exitc - | any ("GNU ld" `isPrefixOf`) stdo = - -- Set DT_NEEDED for all shared libraries. #10110. - return (GnuLD $ map Option [-- ELF specific flag - -- 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] - return (GnuGold [Option "-Wl,--no-as-needed"]) - - | any (\line -> "LLD" `isPrefixOf` line || "LLD" `elem` words line) stdo = - return (LlvmLLD $ map Option [ --see Note [ELF needed shared libs] - "-Wl,--no-as-needed" | osElfTarget os || os == OSMinGW32 ]) - - -- Unknown linker. - | otherwise = fail "invalid --version output, or linker is unsupported" - - -- Process the executable call - catchIO ( - case os of - OSSolaris2 -> - -- Solaris uses its own Solaris linker. Even all - -- GNU C are recommended to configure with Solaris - -- linker instead of using GNU binutils linker. Also - -- all GCC distributed with Solaris follows this rule - -- precisely so we assume here, the Solaris linker is - -- used. - return $ SolarisLD [] - OSAIX -> - -- IBM AIX uses its own non-binutils linker as well - return $ AixLD [] - OSDarwin -> - -- Darwin has neither GNU Gold or GNU LD, but a strange linker - -- that doesn't support --version. We can just assume that's - -- what we're using. - return $ DarwinLD [] - OSMinGW32 -> - -- GHC doesn't support anything but GNU ld on Windows anyway. - -- Process creation is also fairly expensive on win32, so - -- we short-circuit here. - return $ GnuLD $ map Option - [ -- Emit stack checks - -- See Note [Windows stack allocations] - "-fstack-check" - ] - _ -> do - -- In practice, we use the compiler as the linker here. Pass - -- -Wl,--version to get linker version info. - (exitc, stdo, stde) <- readProcessEnvWithExitCode pgm - (["-Wl,--version"] ++ args3) - c_locale_env - -- Split the output by lines to make certain kinds - -- of processing easier. In particular, 'clang' and 'gcc' - -- have slightly different outputs for '-Wl,--version', but - -- it's still easy to figure out. - parseLinkerInfo (lines stdo) (lines stde) exitc - ) - (\err -> do - debugTraceMsg logger 2 - (text "Error (figuring out linker information):" <+> - text (show err)) - errorMsg logger $ hang (text "Warning:") 9 $ - text "Couldn't figure out linker information!" $$ - text "Make sure you're using GNU ld, GNU gold" <+> - text "or the built in OS X linker, etc." - return UnknownLD - ) - --- | Grab compiler info and cache it in DynFlags. -getCompilerInfo :: Logger -> DynFlags -> IO CompilerInfo -getCompilerInfo logger dflags = do - info <- readIORef (rtccInfo dflags) - case info of - Just v -> return v - Nothing -> do - let pgm = pgm_c dflags - v <- getCompilerInfo' logger pgm - writeIORef (rtccInfo dflags) (Just v) - return v - --- | Grab assembler info and cache it in DynFlags. -getAssemblerInfo :: Logger -> DynFlags -> IO CompilerInfo -getAssemblerInfo logger dflags = do - info <- readIORef (rtasmInfo dflags) - case info of - Just v -> return v - Nothing -> do - let (pgm, _) = pgm_a dflags - v <- getCompilerInfo' logger pgm - writeIORef (rtasmInfo dflags) (Just v) - return v - --- See Note [Run-time linker info]. -getCompilerInfo' :: Logger -> String -> IO CompilerInfo -getCompilerInfo' logger pgm = do - let -- Try to grab the info from the process output. - parseCompilerInfo _stdo stde _exitc - -- Regular GCC - | any ("gcc version" `isInfixOf`) stde = - return GCC - -- Regular clang - | any ("clang version" `isInfixOf`) stde = - return Clang - -- FreeBSD clang - | any ("FreeBSD clang version" `isInfixOf`) stde = - return Clang - -- Xcode 5.1 clang - | any ("Apple LLVM version 5.1" `isPrefixOf`) stde = - return AppleClang51 - -- Xcode 5 clang - | any ("Apple LLVM version" `isPrefixOf`) stde = - return AppleClang - -- Xcode 4.1 clang - | any ("Apple clang version" `isPrefixOf`) stde = - return AppleClang - -- Unknown compiler. - | otherwise = fail $ "invalid -v output, or compiler is unsupported (" ++ pgm ++ "): " ++ unlines stde - - -- Process the executable call - catchIO (do - (exitc, stdo, stde) <- - readProcessEnvWithExitCode pgm ["-v"] c_locale_env - -- Split the output by lines to make certain kinds - -- of processing easier. - parseCompilerInfo (lines stdo) (lines stde) exitc - ) - (\err -> do - debugTraceMsg logger 2 - (text "Error (figuring out C compiler information):" <+> - text (show err)) - errorMsg logger $ hang (text "Warning:") 9 $ - text "Couldn't figure out C compiler information!" $$ - text "Make sure you're using GNU gcc, or clang" - return UnknownCC - ) ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -19,7 +19,6 @@ import GHC.CmmToLlvm.Config (LlvmVersion, llvmVersionStr, supportedLlvmVersionUp import GHC.Settings import GHC.SysTools.Process -import GHC.SysTools.Info import GHC.Driver.Session @@ -278,15 +277,12 @@ figureLlvmVersion logger dflags = traceSystoolCommand logger "llc" $ do runLink :: Logger -> TmpFs -> DynFlags -> [Option] -> IO () runLink logger tmpfs dflags args = traceSystoolCommand logger "linker" $ do - -- See Note [Run-time linker info] - -- -- `-optl` args come at the end, so that later `-l` options -- given there manually can fill in symbols needed by -- Haskell libraries coming in via `args`. - linkargs <- neededLinkArgs `fmap` getLinkerInfo logger dflags let (p,args0) = pgm_l dflags optl_args = map Option (getOpts dflags opt_l) - args2 = args0 ++ linkargs ++ args ++ optl_args + args2 = args0 ++ args ++ optl_args mb_env <- getGccEnv args2 runSomethingResponseFile logger tmpfs dflags ld_filter "Linker" p args2 mb_env where ===================================== compiler/ghc.cabal.in ===================================== @@ -712,7 +712,6 @@ Library GHC.SysTools.BaseDir GHC.SysTools.Cpp GHC.SysTools.Elf - GHC.SysTools.Info GHC.SysTools.Process GHC.SysTools.Tasks GHC.SysTools.Terminal ===================================== m4/fp_link_supports_no_as_needed.m4 ===================================== @@ -0,0 +1,33 @@ +# FP_LINK_SUPPORTS_NO_AS_NEEDED +# ---------------------------------- +# Set the Cc linker flag -Wl,--no-as-needed if it is supported +# $1 is the name of the linker flags variable when linking with gcc +# See also Note [ELF needed shared libs] +AC_DEFUN([FP_LINK_SUPPORTS_NO_AS_NEEDED], +[ + AC_MSG_CHECKING([whether Cc linker supports -Wl,--no-as-needed]) + echo 'int f(int a) {return 2*a;}' > conftest.a.c + echo 'int f(int a); int main(int argc, char **argv) {return f(0);}' > conftest.b.c + $CC -c -o conftest.a.o conftest.a.c > /dev/null 2>&1 + $CC -c -o conftest.b.o conftest.b.c > /dev/null 2>&1 + if "$CC" "$$1" -Wl,--no-as-needed -o conftest conftest.a.o conftest.b.o > /dev/null 2>&1 + then + $1="$$1 -Wl,--no-as-needed" + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + fi + rm -f conftest* +]) + +# Note [ELF needed shared libs] +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# Some distributions change the link editor's default handling of +# ELF DT_NEEDED tags to include only those shared objects that are +# needed to resolve undefined symbols. For Template Haskell we need +# the last temporary shared library also if it is not needed for the +# currently linked temporary shared library. We specify --no-as-needed +# to override the default. This flag exists in GNU ld and GNU gold. +# +# The flag is only needed on ELF systems. On Windows (PE) and Mac OS X +# (Mach-O) the flag is not needed. ===================================== m4/fptools_set_c_ld_flags.m4 ===================================== @@ -17,9 +17,19 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS], ;; esac + # See Note [ELF needed shared libs] + case $$1 in + *-linux|*-freebsd*) + FP_LINK_SUPPORTS_NO_AS_NEEDED([$3]) + ;; + esac + case $$1 in i386-unknown-mingw32) $2="$$2 -march=i686" + # Emit stack checks + # See Note [Windows stack allocations] + $3="$$3 -fstack-check" ;; i386-portbld-freebsd*) $2="$$2 -march=i686" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9732aa02bae74a02d23ea5a2493666cc26a454b9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9732aa02bae74a02d23ea5a2493666cc26a454b9 You're receiving 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 Jun 26 18:25:17 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 14:25:17 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/romes/delete-configure-toolchain Message-ID: <6499d80de0113_2402e02f5bc3c1170ae@gitlab.mail> Rodrigo Mesquita pushed new branch wip/romes/delete-configure-toolchain at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/romes/delete-configure-toolchain You're receiving 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 Jun 26 18:28:34 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 14:28:34 -0400 Subject: [Git][ghc/ghc][wip/romes/remove-toolchain-runtime-config] Rip out runtime linker/compiler checks Message-ID: <6499d8d29062e_2402e0261deb8120890@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/remove-toolchain-runtime-config at Glasgow Haskell Compiler / GHC Commits: 37524e25 by Ben Gamari at 2023-06-26T19:28:23+01:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 11 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/SysTools.hs - − compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - compiler/ghc.cabal.in - + m4/fp_link_supports_no_as_needed.m4 - m4/fptools_set_c_ld_flags.m4 Changes: ===================================== compiler/GHC/Driver/Backend.hs ===================================== @@ -58,8 +58,6 @@ module GHC.Driver.Backend , DefunctionalizedCodeOutput(..) -- *** Back-end functions for assembly , DefunctionalizedPostHscPipeline(..) - , DefunctionalizedAssemblerProg(..) - , DefunctionalizedAssemblerInfoGetter(..) -- *** Other back-end functions , DefunctionalizedCDefs(..) -- ** Names of back ends (for API clients of version 9.4 or earlier) @@ -94,8 +92,6 @@ module GHC.Driver.Backend , backendSupportsHpc , backendSupportsCImport , backendSupportsCExport - , backendAssemblerProg - , backendAssemblerInfoGetter , backendCDefs , backendCodeOutput , backendUseJSLinker @@ -348,40 +344,6 @@ data PrimitiveImplementation deriving Show --- | Names a function that runs the assembler, of this type: --- --- > Logger -> DynFlags -> Platform -> [Option] -> IO () --- --- The functions so named are defined in "GHC.Driver.Pipeline.Execute". - -data DefunctionalizedAssemblerProg - = StandardAssemblerProg - -- ^ Use the standard system assembler - | JSAssemblerProg - -- ^ JS Backend compile to JS via Stg, and so does not use any assembler - | DarwinClangAssemblerProg - -- ^ If running on Darwin, use the assembler from the @clang@ - -- toolchain. Otherwise use the standard system assembler. - - - --- | Names a function that discover from what toolchain the assembler --- is coming, of this type: --- --- > Logger -> DynFlags -> Platform -> IO CompilerInfo --- --- The functions so named are defined in "GHC.Driver.Pipeline.Execute". - -data DefunctionalizedAssemblerInfoGetter - = StandardAssemblerInfoGetter - -- ^ Interrogate the standard system assembler - | JSAssemblerInfoGetter - -- ^ If using the JS backend; return 'Emscripten' - | DarwinClangAssemblerInfoGetter - -- ^ If running on Darwin, return `Clang`; otherwise - -- interrogate the standard system assembler. - - -- | Names a function that generates code and writes the results to a -- file, of this type: -- @@ -770,45 +732,6 @@ backendSupportsCExport (Named JavaScript) = True backendSupportsCExport (Named Interpreter) = False backendSupportsCExport (Named NoBackend) = True --- | This (defunctionalized) function runs the assembler --- used on the code that is written by this back end. A --- program determined by a combination of back end, --- `DynFlags`, and `Platform` is run with the given --- `Option`s. --- --- The function's type is --- @ --- Logger -> DynFlags -> Platform -> [Option] -> IO () --- @ --- --- This field is usually defaulted. -backendAssemblerProg :: Backend -> DefunctionalizedAssemblerProg -backendAssemblerProg (Named NCG) = StandardAssemblerProg -backendAssemblerProg (Named LLVM) = DarwinClangAssemblerProg -backendAssemblerProg (Named ViaC) = StandardAssemblerProg -backendAssemblerProg (Named JavaScript) = JSAssemblerProg -backendAssemblerProg (Named Interpreter) = StandardAssemblerProg -backendAssemblerProg (Named NoBackend) = StandardAssemblerProg - --- | This (defunctionalized) function is used to retrieve --- an enumeration value that characterizes the C/assembler --- part of a toolchain. The function caches the info in a --- mutable variable that is part of the `DynFlags`. --- --- The function's type is --- @ --- Logger -> DynFlags -> Platform -> IO CompilerInfo --- @ --- --- This field is usually defaulted. -backendAssemblerInfoGetter :: Backend -> DefunctionalizedAssemblerInfoGetter -backendAssemblerInfoGetter (Named NCG) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named LLVM) = DarwinClangAssemblerInfoGetter -backendAssemblerInfoGetter (Named ViaC) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named JavaScript) = JSAssemblerInfoGetter -backendAssemblerInfoGetter (Named Interpreter) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named NoBackend) = StandardAssemblerInfoGetter - -- | When using this back end, it may be necessary or -- advisable to pass some `-D` options to a C compiler. -- This (defunctionalized) function produces those ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -116,7 +116,6 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Trans.Reader (ReaderT) import Control.Monad.Trans.Writer (WriterT) -import Data.IORef import System.IO import System.IO.Error (catchIOError) import System.Environment (lookupEnv) @@ -420,15 +419,6 @@ data DynFlags = DynFlags { avx512pf :: Bool, -- Enable AVX-512 PreFetch Instructions. fma :: Bool, -- ^ Enable FMA instructions. - -- | Run-time linker information (what options we need, etc.) - rtldInfo :: IORef (Maybe LinkerInfo), - - -- | Run-time C compiler information - rtccInfo :: IORef (Maybe CompilerInfo), - - -- | Run-time assembler information - rtasmInfo :: IORef (Maybe CompilerInfo), - -- Constants used to control the amount of optimization done. -- | Max size, in bytes, of inline array allocations. @@ -490,9 +480,6 @@ class ContainsDynFlags t where initDynFlags :: DynFlags -> IO DynFlags initDynFlags dflags = do let - refRtldInfo <- newIORef Nothing - refRtccInfo <- newIORef Nothing - refRtasmInfo <- newIORef Nothing canUseUnicode <- do let enc = localeEncoding str = "‘’" (withCString enc str $ \cstr -> @@ -514,9 +501,6 @@ initDynFlags dflags = do useColor = useColor', canUseColor = stderrSupportsAnsiColors, colScheme = colScheme', - rtldInfo = refRtldInfo, - rtccInfo = refRtccInfo, - rtasmInfo = refRtasmInfo, tmpDir = TempDir tmp_dir } @@ -695,9 +679,6 @@ defaultDynFlags mySettings = avx512f = False, avx512pf = False, fma = False, - rtldInfo = panic "defaultDynFlags: no rtldInfo", - rtccInfo = panic "defaultDynFlags: no rtccInfo", - rtasmInfo = panic "defaultDynFlags: no rtasmInfo", maxInlineAllocSize = 128, maxInlineMemcpyInsns = 32, ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -109,9 +109,6 @@ module GHC.Driver.Main import GHC.Prelude -import GHC.Platform -import GHC.Platform.Ways - import GHC.Driver.Plugins import GHC.Driver.Session import GHC.Driver.Backend @@ -336,41 +333,11 @@ initHscEnv mb_top_dir = do mySettings <- initSysTools top_dir dflags <- initDynFlags (defaultDynFlags mySettings) hsc_env <- newHscEnv top_dir dflags - checkBrokenTablesNextToCode (hsc_logger hsc_env) dflags setUnsafeGlobalDynFlags dflags -- c.f. DynFlags.parseDynamicFlagsFull, which -- creates DynFlags and sets the UnsafeGlobalDynFlags return hsc_env --- | The binutils linker on ARM emits unnecessary R_ARM_COPY relocations which --- breaks tables-next-to-code in dynamically linked modules. This --- check should be more selective but there is currently no released --- version where this bug is fixed. --- See https://sourceware.org/bugzilla/show_bug.cgi?id=16177 and --- https://gitlab.haskell.org/ghc/ghc/issues/4210#note_78333 -checkBrokenTablesNextToCode :: Logger -> DynFlags -> IO () -checkBrokenTablesNextToCode logger dflags = do - let invalidLdErr = "Tables-next-to-code not supported on ARM \ - \when using binutils ld (please see: \ - \https://sourceware.org/bugzilla/show_bug.cgi?id=16177)" - broken <- checkBrokenTablesNextToCode' logger dflags - when broken (panic invalidLdErr) - -checkBrokenTablesNextToCode' :: Logger -> DynFlags -> IO Bool -checkBrokenTablesNextToCode' logger dflags - | not (isARM arch) = return False - | ways dflags `hasNotWay` WayDyn = return False - | not tablesNextToCode = return False - | otherwise = do - linkerInfo <- liftIO $ GHC.SysTools.getLinkerInfo logger dflags - case linkerInfo of - GnuLD _ -> return True - _ -> return False - where platform = targetPlatform dflags - arch = platformArch platform - tablesNextToCode = platformTablesNextToCode platform - - -- ----------------------------------------------------------------------------- getDiagnostics :: Hsc (Messages GhcMessage) ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -287,12 +287,6 @@ runAsPhase :: Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO F runAsPhase with_cpp pipe_env hsc_env location input_fn = do let dflags = hsc_dflags hsc_env let logger = hsc_logger hsc_env - let unit_env = hsc_unit_env hsc_env - let platform = ue_platform unit_env - - -- LLVM from version 3.0 onwards doesn't support the OS X system - -- assembler, so we use clang as the assembler instead. (#5636) - let as_prog = applyAssemblerProg $ backendAssemblerProg (backend dflags) let cmdline_include_paths = includePaths dflags let pic_c_flags = picCCOpts dflags @@ -310,9 +304,8 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do includePathsQuoteImplicit cmdline_include_paths] let runAssembler inputFilename outputFilename = withAtomicRename outputFilename $ \temp_outputFilename -> - as_prog + runAs logger dflags - platform (local_includes ++ global_includes -- See Note [-fPIC for assembler] ++ map GHC.SysTools.Option pic_c_flags @@ -392,22 +385,6 @@ runForeignJsPhase pipe_env hsc_env _location input_fn = do embedJsFile logger dflags tmpfs unit_env input_fn output_fn return output_fn - -applyAssemblerProg - :: DefunctionalizedAssemblerProg - -> Logger -> DynFlags -> Platform -> [Option] -> IO () -applyAssemblerProg StandardAssemblerProg logger dflags _platform = - runAs logger dflags -applyAssemblerProg JSAssemblerProg logger dflags _platform = - runEmscripten logger dflags -applyAssemblerProg DarwinClangAssemblerProg logger dflags platform = - if platformOS platform == OSDarwin then - runClang logger dflags - else - runAs logger dflags - - - runCcPhase :: Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO FilePath runCcPhase cc_phase pipe_env hsc_env location input_fn = do let dflags = hsc_dflags hsc_env ===================================== compiler/GHC/Linker/ExtraObj.hs ===================================== @@ -12,7 +12,6 @@ module GHC.Linker.ExtraObj , mkNoteObjsToLinkIntoBinary , checkLinkInfo , getLinkInfo - , getCompilerInfo , ghcLinkInfoSectionName , ghcLinkInfoNoteName , platformSupportsSavingLinkOpts @@ -40,10 +39,8 @@ import qualified GHC.Data.ShortText as ST import GHC.SysTools.Elf import GHC.SysTools.Tasks -import GHC.SysTools.Info import GHC.Linker.Unit -import Control.Monad.IO.Class import Control.Monad import Data.Maybe @@ -52,7 +49,6 @@ mkExtraObj logger tmpfs dflags unit_state extn xs = do cFile <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule extn oFile <- newTempName logger tmpfs (tmpDir dflags) TFL_GhcSession "o" writeFile cFile xs - ccInfo <- liftIO $ getCompilerInfo logger dflags runCc Nothing logger tmpfs dflags ([Option "-c", FileOption "" cFile, @@ -60,7 +56,7 @@ mkExtraObj logger tmpfs dflags unit_state extn xs FileOption "" oFile] ++ if extn /= "s" then cOpts - else asmOpts ccInfo) + else []) return oFile where -- Pass a different set of options to the C compiler depending one whether @@ -70,14 +66,6 @@ mkExtraObj logger tmpfs dflags unit_state extn xs ++ map (FileOption "-I" . ST.unpack) (unitIncludeDirs $ unsafeLookupUnit unit_state rtsUnit) - -- When compiling assembler code, we drop the usual C options, and if the - -- compiler is Clang, we add an extra argument to tell Clang to ignore - -- unused command line options. See trac #11684. - asmOpts ccInfo = - if any (ccInfo ==) [Clang, AppleClang, AppleClang51] - then [Option "-Qunused-arguments"] - else [] - -- When linking a binary, we need to create a C main() function that -- starts everything off. This used to be compiled statically as part -- of the RTS, but that made it hard to change the -rtsopts setting, ===================================== compiler/GHC/SysTools.hs ===================================== @@ -17,7 +17,6 @@ module GHC.SysTools ( -- * Interface to system tools module GHC.SysTools.Tasks, - module GHC.SysTools.Info, -- * Fast file copy copyFile, @@ -35,8 +34,6 @@ import GHC.Prelude import GHC.Utils.Panic import GHC.Driver.Session -import GHC.Linker.ExtraObj -import GHC.SysTools.Info import GHC.SysTools.Tasks import GHC.SysTools.BaseDir import GHC.Settings.IO ===================================== compiler/GHC/SysTools/Info.hs deleted ===================================== @@ -1,243 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} ------------------------------------------------------------------------------ --- --- Compiler information functions --- --- (c) The GHC Team 2017 --- ------------------------------------------------------------------------------ -module GHC.SysTools.Info where - -import GHC.Utils.Exception -import GHC.Utils.Error -import GHC.Driver.Session -import GHC.Utils.Outputable -import GHC.Utils.Misc -import GHC.Utils.Logger - -import Data.List ( isInfixOf, isPrefixOf ) -import Data.IORef - -import System.IO - -import GHC.Platform -import GHC.Prelude - -import GHC.SysTools.Process - -{- Note [Run-time linker info] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~ -See also: #5240, #6063, #10110 - -Before 'runLink', we need to be sure to get the relevant information -about the linker we're using at runtime to see if we need any extra -options. - -Generally, the linker changing from what was detected at ./configure -time has always been possible using -pgml, but on Linux it can happen -'transparently' by installing packages like binutils-gold, which -change what /usr/bin/ld actually points to. - -Clang vs GCC notes: - -For gcc, 'gcc -Wl,--version' gives a bunch of output about how to -invoke the linker before the version information string. For 'clang', -the version information for 'ld' is all that's output. For this -reason, we typically need to slurp up all of the standard error output -and look through it. - -Other notes: - -We cache the LinkerInfo inside DynFlags, since clients may link -multiple times. The definition of LinkerInfo is there to avoid a -circular dependency. - --} - -{- Note [ELF needed shared libs] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Some distributions change the link editor's default handling of -ELF DT_NEEDED tags to include only those shared objects that are -needed to resolve undefined symbols. For Template Haskell we need -the last temporary shared library also if it is not needed for the -currently linked temporary shared library. We specify --no-as-needed -to override the default. This flag exists in GNU ld and GNU gold. - -The flag is only needed on ELF systems. On Windows (PE) and Mac OS X -(Mach-O) the flag is not needed. - --} - -neededLinkArgs :: LinkerInfo -> [Option] -neededLinkArgs (GnuLD o) = o -neededLinkArgs (Mold o) = o -neededLinkArgs (GnuGold o) = o -neededLinkArgs (LlvmLLD o) = o -neededLinkArgs (DarwinLD o) = o -neededLinkArgs (SolarisLD o) = o -neededLinkArgs (AixLD o) = o -neededLinkArgs UnknownLD = [] - --- Grab linker info and cache it in DynFlags. -getLinkerInfo :: Logger -> DynFlags -> IO LinkerInfo -getLinkerInfo logger dflags = do - info <- readIORef (rtldInfo dflags) - case info of - Just v -> return v - Nothing -> do - v <- getLinkerInfo' logger dflags - writeIORef (rtldInfo dflags) (Just v) - return v - --- See Note [Run-time linker info]. -getLinkerInfo' :: Logger -> DynFlags -> IO LinkerInfo -getLinkerInfo' logger dflags = do - let platform = targetPlatform dflags - os = platformOS platform - (pgm,args0) = pgm_l dflags - args1 = map Option (getOpts dflags opt_l) - args2 = args0 ++ args1 - args3 = filter notNull (map showOpt args2) - - -- Try to grab the info from the process output. - parseLinkerInfo stdo _stde _exitc - | any ("GNU ld" `isPrefixOf`) stdo = - -- Set DT_NEEDED for all shared libraries. #10110. - return (GnuLD $ map Option [-- ELF specific flag - -- 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] - return (GnuGold [Option "-Wl,--no-as-needed"]) - - | any (\line -> "LLD" `isPrefixOf` line || "LLD" `elem` words line) stdo = - return (LlvmLLD $ map Option [ --see Note [ELF needed shared libs] - "-Wl,--no-as-needed" | osElfTarget os || os == OSMinGW32 ]) - - -- Unknown linker. - | otherwise = fail "invalid --version output, or linker is unsupported" - - -- Process the executable call - catchIO ( - case os of - OSSolaris2 -> - -- Solaris uses its own Solaris linker. Even all - -- GNU C are recommended to configure with Solaris - -- linker instead of using GNU binutils linker. Also - -- all GCC distributed with Solaris follows this rule - -- precisely so we assume here, the Solaris linker is - -- used. - return $ SolarisLD [] - OSAIX -> - -- IBM AIX uses its own non-binutils linker as well - return $ AixLD [] - OSDarwin -> - -- Darwin has neither GNU Gold or GNU LD, but a strange linker - -- that doesn't support --version. We can just assume that's - -- what we're using. - return $ DarwinLD [] - OSMinGW32 -> - -- GHC doesn't support anything but GNU ld on Windows anyway. - -- Process creation is also fairly expensive on win32, so - -- we short-circuit here. - return $ GnuLD $ map Option - [ -- Emit stack checks - -- See Note [Windows stack allocations] - "-fstack-check" - ] - _ -> do - -- In practice, we use the compiler as the linker here. Pass - -- -Wl,--version to get linker version info. - (exitc, stdo, stde) <- readProcessEnvWithExitCode pgm - (["-Wl,--version"] ++ args3) - c_locale_env - -- Split the output by lines to make certain kinds - -- of processing easier. In particular, 'clang' and 'gcc' - -- have slightly different outputs for '-Wl,--version', but - -- it's still easy to figure out. - parseLinkerInfo (lines stdo) (lines stde) exitc - ) - (\err -> do - debugTraceMsg logger 2 - (text "Error (figuring out linker information):" <+> - text (show err)) - errorMsg logger $ hang (text "Warning:") 9 $ - text "Couldn't figure out linker information!" $$ - text "Make sure you're using GNU ld, GNU gold" <+> - text "or the built in OS X linker, etc." - return UnknownLD - ) - --- | Grab compiler info and cache it in DynFlags. -getCompilerInfo :: Logger -> DynFlags -> IO CompilerInfo -getCompilerInfo logger dflags = do - info <- readIORef (rtccInfo dflags) - case info of - Just v -> return v - Nothing -> do - let pgm = pgm_c dflags - v <- getCompilerInfo' logger pgm - writeIORef (rtccInfo dflags) (Just v) - return v - --- | Grab assembler info and cache it in DynFlags. -getAssemblerInfo :: Logger -> DynFlags -> IO CompilerInfo -getAssemblerInfo logger dflags = do - info <- readIORef (rtasmInfo dflags) - case info of - Just v -> return v - Nothing -> do - let (pgm, _) = pgm_a dflags - v <- getCompilerInfo' logger pgm - writeIORef (rtasmInfo dflags) (Just v) - return v - --- See Note [Run-time linker info]. -getCompilerInfo' :: Logger -> String -> IO CompilerInfo -getCompilerInfo' logger pgm = do - let -- Try to grab the info from the process output. - parseCompilerInfo _stdo stde _exitc - -- Regular GCC - | any ("gcc version" `isInfixOf`) stde = - return GCC - -- Regular clang - | any ("clang version" `isInfixOf`) stde = - return Clang - -- FreeBSD clang - | any ("FreeBSD clang version" `isInfixOf`) stde = - return Clang - -- Xcode 5.1 clang - | any ("Apple LLVM version 5.1" `isPrefixOf`) stde = - return AppleClang51 - -- Xcode 5 clang - | any ("Apple LLVM version" `isPrefixOf`) stde = - return AppleClang - -- Xcode 4.1 clang - | any ("Apple clang version" `isPrefixOf`) stde = - return AppleClang - -- Unknown compiler. - | otherwise = fail $ "invalid -v output, or compiler is unsupported (" ++ pgm ++ "): " ++ unlines stde - - -- Process the executable call - catchIO (do - (exitc, stdo, stde) <- - readProcessEnvWithExitCode pgm ["-v"] c_locale_env - -- Split the output by lines to make certain kinds - -- of processing easier. - parseCompilerInfo (lines stdo) (lines stde) exitc - ) - (\err -> do - debugTraceMsg logger 2 - (text "Error (figuring out C compiler information):" <+> - text (show err)) - errorMsg logger $ hang (text "Warning:") 9 $ - text "Couldn't figure out C compiler information!" $$ - text "Make sure you're using GNU gcc, or clang" - return UnknownCC - ) ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -19,7 +19,6 @@ import GHC.CmmToLlvm.Config (LlvmVersion, llvmVersionStr, supportedLlvmVersionUp import GHC.Settings import GHC.SysTools.Process -import GHC.SysTools.Info import GHC.Driver.Session @@ -278,15 +277,12 @@ figureLlvmVersion logger dflags = traceSystoolCommand logger "llc" $ do runLink :: Logger -> TmpFs -> DynFlags -> [Option] -> IO () runLink logger tmpfs dflags args = traceSystoolCommand logger "linker" $ do - -- See Note [Run-time linker info] - -- -- `-optl` args come at the end, so that later `-l` options -- given there manually can fill in symbols needed by -- Haskell libraries coming in via `args`. - linkargs <- neededLinkArgs `fmap` getLinkerInfo logger dflags let (p,args0) = pgm_l dflags optl_args = map Option (getOpts dflags opt_l) - args2 = args0 ++ linkargs ++ args ++ optl_args + args2 = args0 ++ args ++ optl_args mb_env <- getGccEnv args2 runSomethingResponseFile logger tmpfs dflags ld_filter "Linker" p args2 mb_env where ===================================== compiler/ghc.cabal.in ===================================== @@ -712,7 +712,6 @@ Library GHC.SysTools.BaseDir GHC.SysTools.Cpp GHC.SysTools.Elf - GHC.SysTools.Info GHC.SysTools.Process GHC.SysTools.Tasks GHC.SysTools.Terminal ===================================== m4/fp_link_supports_no_as_needed.m4 ===================================== @@ -0,0 +1,33 @@ +# FP_LINK_SUPPORTS_NO_AS_NEEDED +# ---------------------------------- +# Set the Cc linker flag -Wl,--no-as-needed if it is supported +# $1 is the name of the linker flags variable when linking with gcc +# See also Note [ELF needed shared libs] +AC_DEFUN([FP_LINK_SUPPORTS_NO_AS_NEEDED], +[ + AC_MSG_CHECKING([whether Cc linker supports -Wl,--no-as-needed]) + echo 'int f(int a) {return 2*a;}' > conftest.a.c + echo 'int f(int a); int main(int argc, char **argv) {return f(0);}' > conftest.b.c + $CC -c -o conftest.a.o conftest.a.c > /dev/null 2>&1 + $CC -c -o conftest.b.o conftest.b.c > /dev/null 2>&1 + if "$CC" "$$1" -Wl,--no-as-needed -o conftest conftest.a.o conftest.b.o > /dev/null 2>&1 + then + $1="$$1 -Wl,--no-as-needed" + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + fi + rm -f conftest* +]) + +# Note [ELF needed shared libs] +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# Some distributions change the link editor's default handling of +# ELF DT_NEEDED tags to include only those shared objects that are +# needed to resolve undefined symbols. For Template Haskell we need +# the last temporary shared library also if it is not needed for the +# currently linked temporary shared library. We specify --no-as-needed +# to override the default. This flag exists in GNU ld and GNU gold. +# +# The flag is only needed on ELF systems. On Windows (PE) and Mac OS X +# (Mach-O) the flag is not needed. ===================================== m4/fptools_set_c_ld_flags.m4 ===================================== @@ -17,9 +17,19 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS], ;; esac + # See Note [ELF needed shared libs] + case $$1 in + *-linux|*-freebsd*) + FP_LINK_SUPPORTS_NO_AS_NEEDED([$3]) + ;; + esac + case $$1 in i386-unknown-mingw32) $2="$$2 -march=i686" + # Emit stack checks + # See Note [Windows stack allocations] + $3="$$3 -fstack-check" ;; i386-portbld-freebsd*) $2="$$2 -march=i686" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/37524e25181041681ab13ba6c3686b3de7df89b2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/37524e25181041681ab13ba6c3686b3de7df89b2 You're receiving 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 Jun 26 18:53:01 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Mon, 26 Jun 2023 14:53:01 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/pattern-@a-binders] Draft: Type patterns (22478, 18986) Message-ID: <6499de8d27f14_2402e02d7e1d0123658@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/pattern- at a-binders at Glasgow Haskell Compiler / GHC Commits: 532c915d by Andrei Borzenkov at 2023-06-26T22:52:48+04:00 Draft: Type patterns (22478, 18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - 30 changed files: - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/Types.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Splice.hs-boot - compiler/GHC/Rename/Utils.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/Utils/TcMType.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Name/Reader.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/Pat.hs - compiler/Language/Haskell/Syntax/Type.hs - testsuite/tests/gadt/T18191.stderr - + testsuite/tests/rename/should_compile/T22478a.hs - testsuite/tests/rename/should_compile/all.T - + testsuite/tests/rename/should_fail/T22478b.hs - + testsuite/tests/rename/should_fail/T22478b.stderr - + testsuite/tests/rename/should_fail/T22478d.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/532c915d2b462780e1811ac31c3b78cdca7328a3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/532c915d2b462780e1811ac31c3b78cdca7328a3 You're receiving 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 Jun 26 19:01:39 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 15:01:39 -0400 Subject: [Git][ghc/ghc][wip/romes/remove-toolchain-runtime-config] configure: Rip out toolchain selection logic Message-ID: <6499e09366a50_2402e0261deb81245de@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/remove-toolchain-runtime-config at Glasgow Haskell Compiler / GHC Commits: 33dd1804 by Rodrigo Mesquita at 2023-06-26T20:01:26+01:00 configure: Rip out toolchain selection logic - - - - - 23 changed files: - configure.ac - distrib/configure.ac.in - − m4/check_for_gold_t22266.m4 - − m4/check_ld_copy_bug.m4 - − m4/find_ld.m4 - − m4/find_merge_objects.m4 - − m4/fp_find_nm.m4 - − m4/fp_gcc_supports_no_pie.m4 - − m4/fp_gcc_version.m4 - − m4/fp_prog_ar.m4 - − m4/fp_prog_ar_args.m4 - − m4/fp_prog_ar_is_gnu.m4 - − m4/fp_prog_ar_needs_ranlib.m4 - − m4/fp_prog_ar_supports_atfile.m4 - − m4/fp_prog_ar_supports_dash_l.m4 - − m4/fp_prog_ld_filelist.m4 - − m4/fp_prog_ld_flag.m4 - − m4/fp_prog_ld_is_gnu.m4 - − m4/fp_prog_ld_no_compact_unwind.m4 - m4/fp_setup_windows_toolchain.m4 - − m4/get_arm_isa.m4 - − m4/ghc_tables_next_to_code.m4 - m4/ghc_unregisterised.m4 Changes: ===================================== configure.ac ===================================== @@ -319,16 +319,6 @@ dnl ** Do an unregisterised build? dnl -------------------------------------------------------------- GHC_UNREGISTERISED -AC_SUBST(Unregisterised) - -dnl ** Do a build with tables next to code? -dnl -------------------------------------------------------------- - -GHC_TABLES_NEXT_TO_CODE -if test x"$TablesNextToCode" = xYES; then - AC_DEFINE([TABLES_NEXT_TO_CODE], [1], [Define to 1 if info tables are laid out next to code]) -fi -AC_SUBST(TablesNextToCode) # Requires FPTOOLS_SET_PLATFORMS_VARS to be run first. FP_FIND_ROOT @@ -362,15 +352,6 @@ else fi fi -if test "$HostOS" = "mingw32"; then - DllWrapCmd="$DllWrap" - WindresCmd="$Windres" - AC_SUBST([DllWrapCmd]) - AC_SUBST([WindresCmd]) - AC_SUBST([GenlibCmd]) - AC_SUBST([HAVE_GENLIB]) -fi - FP_ICONV FP_GMP FP_CURSES @@ -478,22 +459,6 @@ FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE2],[CONF_CPP_OPTS_STAGE2]) dnl ** Which ld to use dnl -------------------------------------------------------------- AC_ARG_VAR(LD,[Use as the path to ld. See also --disable-ld-override.]) -FIND_LD([$target],[GccUseLdOpt]) -FIND_MERGE_OBJECTS() -CONF_GCC_LINKER_OPTS_STAGE1="$CONF_GCC_LINKER_OPTS_STAGE1 $GccUseLdOpt" -CONF_GCC_LINKER_OPTS_STAGE2="$CONF_GCC_LINKER_OPTS_STAGE2 $GccUseLdOpt" -LdCmd="$LD" -CFLAGS="$CFLAGS $GccUseLdOpt" -AC_SUBST([LdCmd]) - -FP_PROG_LD_IS_GNU -FP_PROG_LD_BUILD_ID -FP_PROG_LD_NO_COMPACT_UNWIND -FP_PROG_LD_FILELIST - -dnl ** Which nm to use? -dnl -------------------------------------------------------------- -FP_FIND_NM dnl ** Which objdump to use? dnl -------------------------------------------------------------- @@ -508,15 +473,6 @@ esac ObjdumpCmd="$OBJDUMP" AC_SUBST([ObjdumpCmd]) -dnl ** Which ranlib to use? -dnl -------------------------------------------------------------- -AC_PROG_RANLIB -if test "$RANLIB" = ":"; then - AC_MSG_ERROR([cannot find ranlib in your PATH]) -fi -RanlibCmd="$RANLIB" -AC_SUBST([RanlibCmd]) - dnl ** which strip to use? dnl -------------------------------------------------------------- AC_CHECK_TARGET_TOOL([STRIP], [strip]) @@ -638,31 +594,7 @@ AS_IF([test x"$CcLlvmBackend" = x"YES"], [AC_DEFINE([CC_LLVM_BACKEND], [1], [Define (to 1) if C compiler has an LLVM back end])]) AC_SUBST(CcLlvmBackend) -FPTOOLS_SET_C_LD_FLAGS([target],[CFLAGS],[LDFLAGS],[IGNORE_LINKER_LD_FLAGS],[CPPFLAGS]) -FPTOOLS_SET_C_LD_FLAGS([build],[CONF_CC_OPTS_STAGE0],[CONF_GCC_LINKER_OPTS_STAGE0],[CONF_LD_LINKER_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) -FPTOOLS_SET_C_LD_FLAGS([target],[CONF_CC_OPTS_STAGE1],[CONF_GCC_LINKER_OPTS_STAGE1],[CONF_LD_LINKER_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) -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]) - -FP_LD_SUPPORTS_RESPONSE_FILES - -GHC_LLVM_TARGET_SET_VAR -# we intend to pass trough --targets to llvm as is. -LLVMTarget_CPP=` echo "$LlvmTarget"` -AC_SUBST(LLVMTarget_CPP) -# The target is substituted into the distrib/configure.ac file -AC_SUBST(LlvmTarget) - -dnl ** See whether cc supports --target= and set -dnl CONF_CC_OPTS_STAGE[012] accordingly. -FP_CC_SUPPORTS_TARGET([$CC_STAGE0], [CONF_CC_OPTS_STAGE0], [CONF_CXX_OPTS_STAGE0], [CONF_GCC_LINKER_OPTS_STAGE0]) -FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINKER_OPTS_STAGE1]) -FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINKER_OPTS_STAGE2]) +FIND_GHC_TOOLCHAIN dnl Pass -Qunused-arguments or otherwise GHC will have very noisy invocations of Clang dnl TODO: Do we need -Qunused-arguments in CXX and GCC linker too? @@ -670,58 +602,20 @@ FP_CC_IGNORE_UNUSED_ARGS([$CC_STAGE0], [CONF_CC_OPTS_STAGE0]) FP_CC_IGNORE_UNUSED_ARGS([$CC], [CONF_CC_OPTS_STAGE1]) FP_CC_IGNORE_UNUSED_ARGS([$CC], [CONF_CC_OPTS_STAGE2]) -# See rules/distdir-way-opts.mk for details. -# Flags passed to the C compiler -AC_SUBST(CONF_CC_OPTS_STAGE0) -AC_SUBST(CONF_CC_OPTS_STAGE1) -AC_SUBST(CONF_CC_OPTS_STAGE2) -# Flags passed to the C compiler when we ask it to link -AC_SUBST(CONF_GCC_LINKER_OPTS_STAGE0) -AC_SUBST(CONF_GCC_LINKER_OPTS_STAGE1) -AC_SUBST(CONF_GCC_LINKER_OPTS_STAGE2) -# Flags passed to the linker when we ask it to link -AC_SUBST(CONF_LD_LINKER_OPTS_STAGE0) -AC_SUBST(CONF_LD_LINKER_OPTS_STAGE1) -AC_SUBST(CONF_LD_LINKER_OPTS_STAGE2) -# Flags passed to the C preprocessor -AC_SUBST(CONF_CPP_OPTS_STAGE0) -AC_SUBST(CONF_CPP_OPTS_STAGE1) -AC_SUBST(CONF_CPP_OPTS_STAGE2) -# Flags passed to the Haskell compiler -AC_SUBST(CONF_HC_OPTS_STAGE0) -AC_SUBST(CONF_HC_OPTS_STAGE1) -AC_SUBST(CONF_HC_OPTS_STAGE2) - -dnl Identify C++ standard library flavour and location only when _not_ compiling -dnl the JS backend. The JS backend uses emscripten to wrap c++ utilities which -dnl fails this check, so we avoid it when compiling to JS. -if test "$TargetOS" != "ghcjs"; then - FP_FIND_CXX_STD_LIB -fi +# CPP, CPPFLAGS +# --with-cpp/-with-cpp-flags +dnl Note that we must do this after setting and using the C99 CPPFLAGS, or +dnl otherwise risk trying to configure the C99 and LD flags using -E as a CPPFLAG +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + +dnl Identify C++ standard library flavour and location +FP_FIND_CXX_STD_LIB AC_CONFIG_FILES([mk/system-cxx-std-lib-1.0.conf]) -dnl ** Set up the variables for the platform in the settings file. -dnl May need to use gcc to find platform details. -dnl -------------------------------------------------------------- -FPTOOLS_SET_HASKELL_PLATFORM_VARS([Build]) - -FPTOOLS_SET_HASKELL_PLATFORM_VARS([Host]) -AC_SUBST(HaskellHostArch) -AC_SUBST(HaskellHostOs) - -FPTOOLS_SET_HASKELL_PLATFORM_VARS([Target]) -AC_SUBST(HaskellTargetArch) -AC_SUBST(HaskellTargetOs) - -GHC_SUBSECTIONS_VIA_SYMBOLS -AC_SUBST(TargetHasSubsectionsViaSymbols) - -GHC_IDENT_DIRECTIVE -AC_SUBST(TargetHasIdentDirective) - -GHC_GNU_NONEXEC_STACK -AC_SUBST(TargetHasGnuNonexecStack) - dnl ** figure out how to do context diffs FP_PROG_CONTEXT_DIFF @@ -731,11 +625,6 @@ chmod +x install-sh dnl ** figure out how to do a BSD-ish install AC_PROG_INSTALL -dnl ** how to invoke `ar' and `ranlib' -FP_PROG_AR_SUPPORTS_ATFILE -FP_PROG_AR_SUPPORTS_DASH_L -FP_PROG_AR_NEEDS_RANLIB - dnl ** Check to see whether ln -s works AC_PROG_LN_S ===================================== distrib/configure.ac.in ===================================== @@ -119,21 +119,6 @@ dnl FP_SET_CFLAGS_C99([CC_STAGE0],[CONF_CC_OPTS_STAGE0],[CONF_CPP_OPTS_STAGE0]) FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE1],[CONF_CPP_OPTS_STAGE1]) FP_SET_CFLAGS_C99([CC],[CONF_CC_OPTS_STAGE2],[CONF_CPP_OPTS_STAGE2]) -dnl ** Which ld to use? -dnl -------------------------------------------------------------- -FIND_LD([$target],[GccUseLdOpt]) -FIND_MERGE_OBJECTS() -CONF_GCC_LINKER_OPTS_STAGE1="$CONF_GCC_LINKER_OPTS_STAGE1 $GccUseLdOpt" -CONF_GCC_LINKER_OPTS_STAGE2="$CONF_GCC_LINKER_OPTS_STAGE2 $GccUseLdOpt" -LdCmd="$LD" -CFLAGS="$CFLAGS $GccUseLdOpt" -AC_SUBST([LdCmd]) - -FP_PROG_LD_IS_GNU -FP_PROG_LD_BUILD_ID -FP_PROG_LD_NO_COMPACT_UNWIND -FP_PROG_LD_FILELIST - dnl ** which strip to use? dnl -------------------------------------------------------------- AC_CHECK_TARGET_TOOL([STRIP], [strip]) @@ -253,15 +238,6 @@ if test "x$TargetWordBigEndian" != "x at TargetWordBigEndian@"; then fi AC_SUBST(TargetWordBigEndian) -# -dnl ** how to invoke `ar' and `ranlib' -# -FP_PROG_AR_SUPPORTS_ATFILE -FP_PROG_AR_SUPPORTS_DASH_L -FP_PROG_AR_NEEDS_RANLIB -RanlibCmd="$RANLIB" -AC_SUBST([RanlibCmd]) - dnl ** Have libdw? dnl -------------------------------------------------------------- dnl Check for a usable version of libdw/elfutils ===================================== m4/check_for_gold_t22266.m4 deleted ===================================== @@ -1,89 +0,0 @@ -# CHECK_FOR_GOLD_T22266 -# ---------------------- -# -# Test for binutils #22266. This bug manifested as GHC bug #14328 (see also: -# #14675, #14291). -# Uses test from -# https://sourceware.org/git/gitweb.cgi?p=binutils-gdb.git;h=033bfb739b525703bfe23f151d09e9beee3a2afe -# -# $1 = linker to test -# Sets $result to 0 if not affected, 1 otherwise -AC_DEFUN([CHECK_FOR_GOLD_T22266],[ - AC_MSG_CHECKING([for ld.gold object merging bug (binutils 22266)]) - if ! $1 --version | grep -q "GNU gold" 2>/dev/null; then - # Not gold - result=0 - elif test "$cross_compiling" = "yes"; then - AC_MSG_RESULT([cross-compiling, assuming LD can merge objects correctly.]) - result=0 - else - FPTOOLS_WRITE_FILE([conftest.a.c], [ - __attribute__((section(".data.a"))) - static int int_from_a_1 = 0x11223344; - - __attribute__((section(".data.rel.ro.a"))) - int *p_int_from_a_2 = &int_from_a_1; - - const char *hello (void); - - const char * - hello (void) - { - return "XXXHello, world!" + 3; - } - ]) - - FPTOOLS_WRITE_FILE([conftest.main.c], [ - #include - #include - - extern int *p_int_from_a_2; - extern const char *hello (void); - - int main (void) { - if (*p_int_from_a_2 != 0x11223344) - abort (); - if (strcmp(hello(), "Hello, world!") != 0) - abort (); - return 0; - } - ]) - - FPTOOLS_WRITE_FILE([conftest.t], [ - SECTIONS - { - .text : { - *(.text*) - } - .rodata : - { - *(.rodata .rodata.* .gnu.linkonce.r.*) - } - .data.rel.ro : { - *(.data.rel.ro*) - } - .data : { - *(.data*) - } - .bss : { - *(.bss*) - } - } - ]) - - $CC -c -o conftest.a.o conftest.a.c || AC_MSG_ERROR([Failed to compile test]) - $MergeObjsCmd $MergeObjsArgs -T conftest.t conftest.a.o -o conftest.ar.o || AC_MSG_ERROR([Failed to merge test object]) - - $CC -c -o conftest.main.o conftest.main.c || AC_MSG_ERROR([Failed to compile test driver]) - $CC conftest.ar.o conftest.main.o -o conftest || AC_MSG_ERROR([Failed to link test driver]) - - if ./conftest; then - AC_MSG_RESULT([not affected]) - result=0 - else - AC_MSG_RESULT([affected]) - result=1 - fi - rm -f conftest.a.o conftest.a.c conttest.ar.o conftest.main.c conftest.main.o conftest - fi -]) ===================================== m4/check_ld_copy_bug.m4 deleted ===================================== @@ -1,61 +0,0 @@ -# CHECK_LD_COPY_BUG() -# ------------------- -# Check for binutils bug #16177 present in some versions of the bfd ld -# implementation affecting ARM relocations. -# https://sourceware.org/bugzilla/show_bug.cgi?id=16177 -# -# $1 = the platform -# -AC_DEFUN([CHECK_LD_COPY_BUG],[ - case $1 in - arm*linux*) - AC_CHECK_TARGET_TOOL([READELF], [readelf]) - AC_CHECK_TARGET_TOOL([AS], [as]) - AC_MSG_CHECKING([for ld bug 16177]) - cat >actest.s <<-EOF - .globl _start - .p2align 4 - _start: - bkpt - - .data - .globl data_object - object_reference: - .long data_object - .size object_reference, 4 -EOF - - cat >aclib.s <<-EOF - .data - .globl data_object - .type data_object, %object - .size data_object, 4 - data_object: - .long 123 -EOF - - $AS -o aclib.o aclib.s - $LD -shared -o aclib.so aclib.o - - $AS -o actest.o actest.s - $LD -o actest actest.o aclib.so - - if $READELF -r actest | grep R_ARM_COPY > /dev/null; then - AC_MSG_RESULT([affected]) - AC_MSG_ERROR( - [Your linker is affected by binutils #16177, which - critically breaks linkage of GHC objects. Please either upgrade - binutils or supply a different linker with the LD environment - variable.]) - else - AC_MSG_RESULT([unaffected]) - fi - - rm -f aclib.s aclib.o aclib.so actest.s actest.o actest - ;; - *) - ;; - esac -]) - - ===================================== m4/find_ld.m4 deleted ===================================== @@ -1,79 +0,0 @@ -# FIND_LD -# --------- -# Find the version of `ld` to use and figure out how to get gcc to use it for -# linking (if --enable-ld-override is enabled). This is used in both in the top -# level configure.ac and in distrib/configure.ac.in. -# -# $1 = the platform -# $2 = the variable to set with GHC options to configure gcc to use the chosen linker -# -AC_DEFUN([FIND_LD],[ - AC_ARG_ENABLE(ld-override, - [AS_HELP_STRING([--disable-ld-override], - [Prevent GHC from overriding the default linker used by gcc. If ld-override is enabled GHC will try to tell gcc to use whichever linker is selected by the LD environment variable. [default=override enabled]])], - [], - [enable_ld_override=yes]) - - find_ld() { - # Make sure the user didn't specify LD manually. - if test "z$LD" != "z"; then - AC_CHECK_TARGET_TOOL([LD], [ld]) - return - fi - - # Manually iterate over possible names since we want to ensure that, e.g., - # if ld.lld is installed but gcc doesn't support -fuse-ld=lld, that we - # then still try ld.gold and -fuse-ld=gold. - for possible_ld in ld.lld ld.gold ld; do - TmpLd="" # In case the user set LD - AC_CHECK_TARGET_TOOL([TmpLd], [$possible_ld]) - if test "x$TmpLd" = "x"; then continue; fi - - out=`$TmpLd --version` - case $out in - "GNU ld"*) - FP_CC_LINKER_FLAG_TRY(bfd, $2) ;; - "GNU gold"*) - FP_CC_LINKER_FLAG_TRY(gold, $2) - if test "$cross_compiling" = "yes"; then - AC_MSG_NOTICE([Using ld.gold and assuming that it is not affected by binutils issue 22266]); - fi - ;; - "LLD"*) - FP_CC_LINKER_FLAG_TRY(lld, $2) ;; - *" LLD "*) - FP_CC_LINKER_FLAG_TRY(lld, $2) ;; - *) AC_MSG_NOTICE([unknown linker version $out]) ;; - esac - if test "z$$2" = "z"; then - AC_MSG_NOTICE([unable to convince '$CC' to use linker '$TmpLd']) - # a terrible hack to prevent autoconf from caching the previous - # AC_CHECK_TARGET_TOOL result since next time we'll be looking - # for another ld variant. - $as_unset ac_cv_prog_ac_ct_TmpLd - else - LD="$TmpLd" - return - fi - done - - # Fallback - AC_CHECK_TARGET_TOOL([LD], [ld]) - } - - if test "$ghc_host_os" = "darwin" ; then - dnl N.B. Don't even try to find a more efficient linker on Darwin where - dnl broken setups (e.g. unholy mixtures of Homebrew and the native - dnl toolchain) are far too easy to come across. - dnl - dnl See #21712. - AC_CHECK_TARGET_TOOL([LD], [ld]) - elif test "x$enable_ld_override" = "xyes"; then - find_ld - else - AC_CHECK_TARGET_TOOL([LD], [ld]) - fi - - CHECK_LD_COPY_BUG([$1]) -]) - ===================================== m4/find_merge_objects.m4 deleted ===================================== @@ -1,29 +0,0 @@ -# FIND_MERGE_OBJECTS -# ------------------ -# Find which linker to use to merge object files. -# -# See Note [Merging object files for GHCi] in GHC.Driver.Pipeline. -AC_DEFUN([FIND_MERGE_OBJECTS],[ - AC_REQUIRE([FIND_LD]) - - if test -z "$MergeObjsCmd"; then - MergeObjsCmd="$LD" - fi - if test -z "$MergeObjsArgs"; then - MergeObjsArgs="-r" - fi - - CHECK_FOR_GOLD_T22266($MergeObjsCmd) - if test "$result" = "1"; then - AC_MSG_NOTICE([$MergeObjsCmd is broken due to binutils 22266, looking for another linker...]) - MergeObjsCmd="" - AC_CHECK_TARGET_TOOL([MergeObjsCmd], [ld]) - CHECK_FOR_GOLD_T22266($MergeObjsCmd) - if test "$result" = "1"; then - AC_MSG_ERROR([Linker is affected by binutils 22266 but couldn't find another unaffected linker. Please set the MergeObjsCmd variable to a functional linker.]) - fi - fi - - AC_SUBST([MergeObjsCmd]) - AC_SUBST([MergeObjsArgs]) -]) ===================================== m4/fp_find_nm.m4 deleted ===================================== @@ -1,40 +0,0 @@ -# FP_FIND_NM -# --------------------- -# Find nm and verify that it works. -AC_DEFUN([FP_FIND_NM], -[ - if test "$HostOS" != "mingw32"; then - AC_CHECK_TARGET_TOOL([NM], [nm]) - if test "$NM" = ":"; then - AC_MSG_ERROR([cannot find nm in your PATH]) - fi - fi - NmCmd="$NM" - AC_SUBST([NmCmd]) - - if test "$TargetOS_CPP" = "darwin" - then - AC_MSG_CHECKING(whether nm program is broken) - # Some versions of Xcode ship a broken version of `nm`. Detect and work - # around this issue. See : https://gitlab.haskell.org/ghc/ghc/issues/11744 - nmver=$(${NM} --version | grep version | sed 's/ //g') - case "$nmver" in - LLVMversion7.3.0|LLVMversion7.3.1) - AC_MSG_RESULT(yes) - echo "The detected nm program is broken." - echo - echo "See: https://gitlab.haskell.org/ghc/ghc/issues/11744" - echo - echo "Try re-running configure with:" - echo - echo ' NM=$(xcrun --find nm-classic) ./configure' - echo - exit 1 - ;; - *) - AC_MSG_RESULT(no) - ;; - esac - fi -]) - ===================================== m4/fp_gcc_supports_no_pie.m4 deleted ===================================== @@ -1,19 +0,0 @@ -# FP_GCC_SUPPORTS_NO_PIE -# ---------------------- -# Does gcc support the -no-pie option? If so we should pass it to gcc when -# joining objects since -pie may be enabled by default. -AC_DEFUN([FP_GCC_SUPPORTS_NO_PIE], -[ - AC_REQUIRE([AC_PROG_CC]) - AC_MSG_CHECKING([whether CC supports -no-pie]) - echo 'int main() { return 0; }' > conftest.c - # Some GCC versions only warn when passed an unrecognized flag. - if $CC -no-pie -Werror -x c conftest.c -o conftest > conftest.txt 2>&1 && ! grep -i unrecognized conftest.txt > /dev/null 2>&1; then - CONF_GCC_SUPPORTS_NO_PIE=YES - AC_MSG_RESULT([yes]) - else - CONF_GCC_SUPPORTS_NO_PIE=NO - AC_MSG_RESULT([no]) - fi - rm -f conftest.c conftest.o conftest -]) ===================================== m4/fp_gcc_version.m4 deleted ===================================== @@ -1,27 +0,0 @@ -# FP_GCC_VERSION -# ----------- -# Extra testing of the result AC_PROG_CC, testing the gcc version no. Sets the -# (unsubstituted) output variable GccVersion. -AC_DEFUN([FP_GCC_VERSION], [ - AC_REQUIRE([AC_PROG_CC]) - if test -z "$CC"; then - AC_MSG_ERROR([C compiler is required]) - fi - - if $CC --version | grep -q gcc; then - AC_CACHE_CHECK([version of gcc], [fp_cv_gcc_version], - [ - # Be sure only to look at the first occurrence of the "version " string; - # Some Apple compilers emit multiple messages containing this string. - AC_MSG_CHECKING([version of gcc]) - fp_cv_gcc_version="`$CC -v 2>&1 | sed -n -e '1,/version /s/.*version [[^0-9]]*\([[0-9.]]*\).*/\1/p'`" - AC_MSG_RESULT([$fp_cv_gcc_version]) - # 4.7 is needed for __atomic_ builtins. - FP_COMPARE_VERSIONS([$fp_cv_gcc_version], [-lt], [4.7], - [AC_MSG_ERROR([Need at least gcc version 4.7 (newer recommended)])]) - ]) - AC_SUBST([GccVersion], [$fp_cv_gcc_version]) - else - AC_MSG_NOTICE([\$CC is not gcc; assuming it's a reasonably new C compiler]) - fi -])# FP_GCC_VERSION ===================================== m4/fp_prog_ar.m4 deleted ===================================== @@ -1,24 +0,0 @@ -# FP_PROG_AR -# ---------- -# Sets fp_prog_ar to a path to ar. Exits if no ar can be found -# The host normalization on Windows breaks autoconf, it no longer -# thinks that target == host so it never checks the unqualified -# tools for Windows. See #14274. -AC_DEFUN([FP_PROG_AR], -[AC_SUBST(fp_prog_ar,$AR) -if test -z "$fp_prog_ar"; then - if test "$HostOS" = "mingw32" - then - AC_PATH_PROG([fp_prog_ar], [ar]) - if test -n "$fp_prog_ar"; then - fp_prog_ar=$(cygpath -m $fp_prog_ar) - fi - else - AC_CHECK_TARGET_TOOL([AR], [ar]) - fp_prog_ar="$AR" - fi -fi -if test -z "$fp_prog_ar"; then - AC_MSG_ERROR([cannot find ar in your PATH, no idea how to make a library]) -fi -])# FP_PROG_AR ===================================== m4/fp_prog_ar_args.m4 deleted ===================================== @@ -1,36 +0,0 @@ -# FP_PROG_AR_ARGS -# --------------- -# Sets fp_prog_ar_args to the arguments for ar and the output variable ArCmd -# to an invocation of ar including these arguments. -AC_DEFUN([FP_PROG_AR_ARGS], -[AC_REQUIRE([FP_PROG_AR_IS_GNU]) -AC_CACHE_CHECK([for ar arguments], [fp_cv_prog_ar_args], -[ -# GNU ar needs special treatment: it appears to have problems with -# object files with the same name if you use the 's' modifier, but -# simple 'ar q' works fine, and doesn't need a separate ranlib. -if test $fp_prog_ar_is_gnu = yes; then - fp_cv_prog_ar_args="q" -else - touch conftest.dummy - for fp_var in qclsZ qcls qcs qcl qc ; do - rm -f conftest.a - if "$fp_prog_ar" $fp_var conftest.a conftest.dummy > /dev/null 2> /dev/null ; then - # Also check that a result was created; it seems some llvm-ar versions - # exit with code zero even if they fail to parse the command line. - if test -f conftest.a ; then - fp_cv_prog_ar_args=$fp_var - break - fi - fi - done - rm -f conftest* - if test -z "$fp_cv_prog_ar_args"; then - AC_MSG_ERROR([cannot figure out how to use your $fp_prog_ar]) - fi -fi]) -fp_prog_ar_args=$fp_cv_prog_ar_args -AC_SUBST([ArCmd], ["$fp_prog_ar"]) -AC_SUBST([ArArgs], ["$fp_prog_ar_args"]) - -])# FP_PROG_AR_ARGS ===================================== m4/fp_prog_ar_is_gnu.m4 deleted ===================================== @@ -1,14 +0,0 @@ -# FP_PROG_AR_IS_GNU -# ----------------- -# Sets fp_prog_ar_is_gnu to yes or no, depending on whether it is GNU ar or not. -AC_DEFUN([FP_PROG_AR_IS_GNU], -[AC_REQUIRE([FP_PROG_AR]) -AC_CACHE_CHECK([whether $fp_prog_ar is GNU ar], [fp_cv_prog_ar_is_gnu], -[if "$fp_prog_ar" --version 2> /dev/null | grep "GNU" > /dev/null 2>&1; then - fp_cv_prog_ar_is_gnu=yes -else - fp_cv_prog_ar_is_gnu=no -fi]) -fp_prog_ar_is_gnu=$fp_cv_prog_ar_is_gnu -AC_SUBST([ArIsGNUAr], [`echo $fp_prog_ar_is_gnu | tr 'a-z' 'A-Z'`]) -])# FP_PROG_AR_IS_GNU ===================================== m4/fp_prog_ar_needs_ranlib.m4 deleted ===================================== @@ -1,49 +0,0 @@ -# FP_PROG_AR_NEEDS_RANLIB -# ----------------------- -# Sets the output variable RANLIB_CMD to "ranlib" if it is needed and -# found, to "true" otherwise. Sets REAL_RANLIB_CMD to the ranlib program, -# even if we don't need ranlib (libffi might still need it). -AC_DEFUN([FP_PROG_AR_NEEDS_RANLIB],[ - AC_REQUIRE([FP_PROG_AR_IS_GNU]) - AC_REQUIRE([FP_PROG_AR_ARGS]) - AC_REQUIRE([AC_PROG_CC]) - - AC_PROG_RANLIB - - if test $fp_prog_ar_is_gnu = yes - then - fp_cv_prog_ar_needs_ranlib=no - elif test "$TargetVendor_CPP" = "apple" - then - # It's quite tedious to check for Apple's crazy timestamps in - # .a files, so we hardcode it. - fp_cv_prog_ar_needs_ranlib=yes - else - case $fp_prog_ar_args in - *s*) - fp_cv_prog_ar_needs_ranlib=no;; - *) - fp_cv_prog_ar_needs_ranlib=yes;; - esac - fi - - # workaround for AC_PROG_RANLIB which sets RANLIB to `:' when - # ranlib is missing on the target OS. The problem is that - # ghc-cabal cannot execute `:' which is a shell built-in but can - # execute `true' which is usually simple program supported by the - # OS. - # Fixes #8795 - if test "$RANLIB" = ":" - then - RANLIB="true" - fi - REAL_RANLIB_CMD="$RANLIB" - if test $fp_cv_prog_ar_needs_ranlib = yes - then - RANLIB_CMD="$RANLIB" - else - RANLIB_CMD="true" - fi - AC_SUBST([REAL_RANLIB_CMD]) - AC_SUBST([RANLIB_CMD]) -])# FP_PROG_AR_NEEDS_RANLIB ===================================== m4/fp_prog_ar_supports_atfile.m4 deleted ===================================== @@ -1,26 +0,0 @@ -# FP_PROG_AR_SUPPORTS_ATFILE -# ----------------- -# Sets fp_prog_ar_supports_atfile to yes or no, depending on whether -# or not it supports the @file syntax -AC_DEFUN([FP_PROG_AR_SUPPORTS_ATFILE], -[AC_REQUIRE([FP_PROG_AR]) - AC_REQUIRE([FP_PROG_AR_ARGS]) -AC_CACHE_CHECK([whether $fp_prog_ar supports @file], [fp_cv_prog_ar_supports_atfile], -[ -rm -f conftest* -touch conftest.file -echo conftest.file > conftest.atfile -echo conftest.file >> conftest.atfile -"$fp_prog_ar" $fp_prog_ar_args conftest.a @conftest.atfile > /dev/null 2>&1 -fp_prog_ar_supports_atfile_tmp=`"$fp_prog_ar" t conftest.a 2> /dev/null | grep -c conftest.file` -rm -f conftest* -if test "$fp_prog_ar_supports_atfile_tmp" -eq 2 -then - fp_cv_prog_ar_supports_atfile=yes -else - fp_cv_prog_ar_supports_atfile=no -fi]) -fp_prog_ar_supports_atfile=$fp_cv_prog_ar_supports_atfile -AC_SUBST([ArSupportsAtFile], [`echo $fp_prog_ar_supports_atfile | tr 'a-z' 'A-Z'`]) -])# FP_PROG_AR_SUPPORTS_ATFILE - ===================================== m4/fp_prog_ar_supports_dash_l.m4 deleted ===================================== @@ -1,30 +0,0 @@ -# FP_PROG_AR_SUPPORTS_DASH_L -# ----------------- -# Sets fp_prog_ar_supports_dash_l to yes or no, depending on whether -# or not it supports the llvm-ar's -L flag to merge archives. -AC_DEFUN([FP_PROG_AR_SUPPORTS_DASH_L], -[ - AC_REQUIRE([FP_PROG_AR]) - AC_REQUIRE([FP_PROG_AR_ARGS]) - AC_CACHE_CHECK([whether $fp_prog_ar supports -L], [fp_cv_prog_ar_supports_dash_l], - [ - rm -f conftest* - touch conftest.file - touch conftest.a0 conftest.a1 conftest.b0 conftest.b1 - dnl Build two archives, merge them, and check that the result contains the - dnl original files not the two archives. - "$fp_prog_ar" qc conftest-a.a conftest.a0 conftest.a1 - "$fp_prog_ar" qc conftest-b.a conftest.b0 conftest.b1 - "$fp_prog_ar" qcL conftest.a conftest-a.a conftest-b.a 2>/dev/null - if "$fp_prog_ar" t conftest.a | grep -s "conftest.a1" > /dev/null - then - fp_cv_prog_ar_supports_dash_l=yes - else - fp_cv_prog_ar_supports_dash_l=no - fi - rm -f conftest* - ]) - fp_prog_ar_supports_dash_l=$fp_cv_prog_ar_supports_dash_l - AC_SUBST([ArSupportsDashL], [`echo $fp_prog_ar_supports_dash_l | tr 'a-z' 'A-Z'`]) -])# FP_PROG_AR_SUPPORTS_DASH_L - ===================================== m4/fp_prog_ld_filelist.m4 deleted ===================================== @@ -1,25 +0,0 @@ -# FP_PROG_LD_FILELIST -# ------------------- -# Sets the output variable LdHasFilelist to YES if ld supports -# -filelist, or NO otherwise. -AC_DEFUN([FP_PROG_LD_FILELIST], -[ -AC_CACHE_CHECK([whether ld understands -filelist], [fp_cv_ld_has_filelist], -[ - echo 'int foo() { return 0; }' > conftest1.c - echo 'int bar() { return 0; }' > conftest2.c - ${CC-cc} -c conftest1.c - ${CC-cc} -c conftest2.c - echo conftest1.o > conftest.o-files - echo conftest2.o >> conftest.o-files - if ${LdCmd} -r -filelist conftest.o-files -o conftest.o > /dev/null 2>&1 - then - fp_cv_ld_has_filelist=yes - else - fp_cv_ld_has_filelist=no - fi - rm -rf conftest* -]) -FP_CAPITALIZE_YES_NO(["$fp_cv_ld_has_filelist"], [LdHasFilelist]) -AC_SUBST([LdHasFilelist]) -])# FP_PROG_LD_FILELIST ===================================== m4/fp_prog_ld_flag.m4 deleted ===================================== @@ -1,17 +0,0 @@ -# FP_PROG_LD_FLAG -# --------------- -# Sets the output variable $2 to $1 if ld supports the $1 flag. -# Otherwise the variable's value is empty. -AC_DEFUN([FP_PROG_LD_FLAG], -[ -AC_CACHE_CHECK([whether ld understands $1], [fp_cv_$2], -[echo 'int foo() { return 0; }' > conftest.c -${CC-cc} -c conftest.c -if ${LdCmd} -r $1 -o conftest2.o conftest.o > /dev/null 2>&1; then - fp_cv_$2=$1 -else - fp_cv_$2= -fi -rm -rf conftest*]) -$2=$fp_cv_$2 -])# FP_PROG_LD_FLAG ===================================== m4/fp_prog_ld_is_gnu.m4 deleted ===================================== @@ -1,13 +0,0 @@ -# FP_PROG_LD_IS_GNU -# ----------------- -# Sets the output variable LdIsGNULd to YES or NO, depending on whether it is -# GNU ld or not. -AC_DEFUN([FP_PROG_LD_IS_GNU],[ -AC_CACHE_CHECK([whether ld is GNU ld], [fp_cv_gnu_ld], -[[if ${LdCmd} --version 2> /dev/null | grep "GNU" > /dev/null 2>&1; then - fp_cv_gnu_ld=YES -else - fp_cv_gnu_ld=NO -fi]]) -AC_SUBST([LdIsGNULd],["$fp_cv_gnu_ld"]) -])# FP_PROG_LD_IS_GNU ===================================== m4/fp_prog_ld_no_compact_unwind.m4 deleted ===================================== @@ -1,18 +0,0 @@ -# FP_PROG_LD_NO_COMPACT_UNWIND -# ---------------------------- -# Sets the output variable LdHasNoCompactUnwind to YES if ld supports -# -no_compact_unwind, or NO otherwise. -AC_DEFUN([FP_PROG_LD_NO_COMPACT_UNWIND], -[ -AC_CACHE_CHECK([whether ld understands -no_compact_unwind], [fp_cv_ld_no_compact_unwind], -[echo 'int foo() { return 0; }' > conftest.c -${CC-cc} -c conftest.c -if ${LdCmd} -r -no_compact_unwind -o conftest2.o conftest.o > /dev/null 2>&1; then - fp_cv_ld_no_compact_unwind=yes -else - fp_cv_ld_no_compact_unwind=no -fi -rm -rf conftest*]) -FP_CAPITALIZE_YES_NO(["$fp_cv_ld_no_compact_unwind"], [LdHasNoCompactUnwind]) -AC_SUBST([LdHasNoCompactUnwind]) -])# FP_PROG_LD_NO_COMPACT_UNWIND ===================================== m4/fp_setup_windows_toolchain.m4 ===================================== @@ -80,6 +80,7 @@ AC_DEFUN([FP_SETUP_WINDOWS_TOOLCHAIN],[ mingwbin="$hardtop/inplace/mingw/bin/" mingwlib="$hardtop/inplace/mingw/lib/" + # TODO CC="${mingwbin}clang.exe" CXX="${mingwbin}clang++.exe" ===================================== m4/get_arm_isa.m4 deleted ===================================== @@ -1,117 +0,0 @@ -# GET_ARM_ISA -# ---------------------------------- -# Get info about the ISA on the ARM arch -AC_DEFUN([GET_ARM_ISA], -[ - AC_COMPILE_IFELSE([ - AC_LANG_PROGRAM( - [], - [#if defined(__ARM_ARCH_2__) || \ - defined(__ARM_ARCH_3__) || \ - defined(__ARM_ARCH_3M__) || \ - defined(__ARM_ARCH_4__) || \ - defined(__ARM_ARCH_4T__) || \ - defined(__ARM_ARCH_5__) || \ - defined(__ARM_ARCH_5T__) || \ - defined(__ARM_ARCH_5E__) || \ - defined(__ARM_ARCH_5TE__) - return 0; - #else - not pre arm v6 - #endif] - )], - [AC_DEFINE(arm_HOST_ARCH_PRE_ARMv6, 1, [ARM pre v6]) - AC_DEFINE(arm_HOST_ARCH_PRE_ARMv7, 1, [ARM pre v7]) - changequote(, )dnl - ARM_ISA=ARMv5 - ARM_ISA_EXT="[]" - changequote([, ])dnl - ], - [ - AC_COMPILE_IFELSE([ - AC_LANG_PROGRAM( - [], - [#if defined(__ARM_ARCH_6__) || \ - defined(__ARM_ARCH_6J__) || \ - defined(__ARM_ARCH_6T2__) || \ - defined(__ARM_ARCH_6Z__) || \ - defined(__ARM_ARCH_6ZK__) || \ - defined(__ARM_ARCH_6K__) || \ - defined(__ARM_ARCH_6KZ__) || \ - defined(__ARM_ARCH_6M__) - return 0; - #else - not pre arm v7 - #endif] - )], - [AC_DEFINE(arm_HOST_ARCH_PRE_ARMv7, 1, [ARM pre v7]) - if grep -q Raspbian /etc/issue && uname -m | grep -q armv7; then - # Raspbian unfortunately makes some extremely questionable - # packaging decisions, configuring gcc to compile for ARMv6 - # despite the fact that the RPi4 is ARMv8. As ARMv8 doesn't - # support all instructions supported by ARMv6 this can - # break. Work around this by checking uname to verify - # that we aren't running on armv7. - # See #17856. - AC_MSG_NOTICE([Found compiler which claims to target ARMv6 running on ARMv7, assuming this is ARMv7 on Raspbian (see T17856)]) - ARM_ISA=ARMv7 - changequote(, )dnl - ARM_ISA_EXT="[VFPv2]" - changequote([, ])dnl - else - ARM_ISA=ARMv6 - AC_COMPILE_IFELSE([ - AC_LANG_PROGRAM( - [], - [#if defined(__VFP_FP__) - return 0; - #else - no vfp - #endif] - )], - [changequote(, )dnl - ARM_ISA_EXT="[VFPv2]" - changequote([, ])dnl - ], - [changequote(, )dnl - ARM_ISA_EXT="[]" - changequote([, ])dnl - ] - ) - fi], - [changequote(, )dnl - ARM_ISA=ARMv7 - ARM_ISA_EXT="[VFPv3,NEON]" - changequote([, ])dnl - ]) - ]) - - AC_COMPILE_IFELSE( - [AC_LANG_PROGRAM( - [], - [#if defined(__SOFTFP__) - return 0; - #else - not softfp - #endif] - )], - [changequote(, )dnl - ARM_ABI="SOFT" - changequote([, ])dnl - ], - [AC_COMPILE_IFELSE( - [AC_LANG_PROGRAM( - [], - [#if defined(__ARM_PCS_VFP) - return 0; - #else - no hard float ABI - #endif] - )], - [ARM_ABI="HARD"], - [ARM_ABI="SOFTFP"] - )] - ) - - AC_SUBST(ARM_ISA) -]) ===================================== m4/ghc_tables_next_to_code.m4 deleted ===================================== @@ -1,41 +0,0 @@ -# GHC_TABLES_NEXT_TO_CODE -# -------------------------------- -# Do a build with tables next to code? -# -# Whether the target architecture supports placing info tables -# directly before the entry code (see TABLES_NEXT_TO_CODE in the RTS). -# Whether we actually compile for TABLES_NEXT_TO_CODE depends on -# whether we're building unregisterised code or not, which may be -# decided by options to the compiler later. -# -# See https://gitlab.haskell.org/ghc/ghc/wikis/commentary/rts/storage/heap-objects#tables_next_to_code -# -AC_DEFUN([GHC_TABLES_NEXT_TO_CODE], -[ - AC_REQUIRE([GHC_UNREGISTERISED]) - AC_MSG_CHECKING(whether target supports tables next to code) - case "$Unregisterised" in - NO) - case "$TargetArch" in - ia64|powerpc64|powerpc64le|s390x|wasm32) - TablesNextToCodeDefault=NO - AC_MSG_RESULT([no]) - ;; - *) - TablesNextToCodeDefault=YES - AC_MSG_RESULT([yes]) - ;; - esac - ;; - YES) - TablesNextToCodeDefault=NO - AC_MSG_RESULT([no]) - ;; - esac - FP_DEFAULT_CHOICE_OVERRIDE_CHECK( - [tables-next-to-code], - [tables next to code], - [tables apart from code], - [TablesNextToCode], - [Build a tool chain with info tables laid out next to code (enabled by default when using the registerised ABI, on platforms that support it)]) -]) ===================================== m4/ghc_unregisterised.m4 ===================================== @@ -3,17 +3,6 @@ # Do an unregisterised build? 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|javascript|loongarch64) - UnregisterisedDefault=NO - AC_MSG_RESULT([yes]) - ;; - *) - UnregisterisedDefault=YES - AC_MSG_RESULT([no]) - ;; - esac FP_DEFAULT_CHOICE_OVERRIDE_CHECK( [unregisterised], [unregisterised], View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/33dd1804a554e40311cd20400d1bea645177cf09 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/33dd1804a554e40311cd20400d1bea645177cf09 You're receiving 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 Jun 26 19:09:10 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 15:09:10 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 11 commits: Create ghc_toolchain.m4 Message-ID: <6499e25679bf5_2402e0261deb81252d5@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 1be6218a by Rodrigo Mesquita at 2023-06-26T20:07:00+01:00 Create ghc_toolchain.m4 - - - - - ef7be497 by Rodrigo Mesquita at 2023-06-26T20:07:19+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b480f4ab1514ac0a4fc957db199d1a0279. Revert get_arm_isa deletion from 74f03f243d08aa910d39cdd9dadb976e9386283a As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples - - - - - 2ddd9c4a by Rodrigo Mesquita at 2023-06-26T20:07:19+01:00 Stop configuring into settings unused Ld command - - - - - 2e68de36 by Rodrigo Mesquita at 2023-06-26T20:07:19+01:00 configure: Create and validate toolchain target file - - - - - ba907a11 by Rodrigo Mesquita at 2023-06-26T20:07:19+01:00 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now - - - - - 623dabb0 by Rodrigo Mesquita at 2023-06-26T20:07:19+01:00 ghc-toolchain: set CC LD plat. dependent flags A lot to be said about this approach, we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? - - - - - 751f0d58 by Rodrigo Mesquita at 2023-06-26T20:07:19+01:00 ghc-toolchain: Create default.target in the bindist - - - - - ce91fdbc by Rodrigo Mesquita at 2023-06-26T20:07:19+01:00 A TODO comment - - - - - 6b973333 by Rodrigo Mesquita at 2023-06-26T20:07:19+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - 297a8376 by Rodrigo Mesquita at 2023-06-26T20:07:19+01:00 Use ghc-platform instead of ghc-boot del async dep - - - - - 4317acee by Rodrigo Mesquita at 2023-06-26T20:08:54+01:00 Fixes and Clean up history (remove all configure deletions too!) - - - - - 30 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/Static.hs - configure.ac - + default.target.in - distrib/configure.ac.in - ghc/Main.hs - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Test.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Cc.hs - hadrian/src/Settings/Builders/DeriveConstants.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/HsCpp.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/26b82e647ec5b2bc8ed5dec0d867cf7132024bfe...4317aceec60ad4986181c10e71c79d46b15f49f6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/26b82e647ec5b2bc8ed5dec0d867cf7132024bfe...4317aceec60ad4986181c10e71c79d46b15f49f6 You're receiving 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 Jun 26 20:09:12 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 16:09:12 -0400 Subject: [Git][ghc/ghc][wip/romes/remove-toolchain-runtime-config] Rip out runtime linker/compiler checks Message-ID: <6499f068761d2_2402e02d7e1d0134521@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/remove-toolchain-runtime-config at Glasgow Haskell Compiler / GHC Commits: 37524e25 by Ben Gamari at 2023-06-26T19:28:23+01:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 11 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/SysTools.hs - − compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - compiler/ghc.cabal.in - + m4/fp_link_supports_no_as_needed.m4 - m4/fptools_set_c_ld_flags.m4 Changes: ===================================== compiler/GHC/Driver/Backend.hs ===================================== @@ -58,8 +58,6 @@ module GHC.Driver.Backend , DefunctionalizedCodeOutput(..) -- *** Back-end functions for assembly , DefunctionalizedPostHscPipeline(..) - , DefunctionalizedAssemblerProg(..) - , DefunctionalizedAssemblerInfoGetter(..) -- *** Other back-end functions , DefunctionalizedCDefs(..) -- ** Names of back ends (for API clients of version 9.4 or earlier) @@ -94,8 +92,6 @@ module GHC.Driver.Backend , backendSupportsHpc , backendSupportsCImport , backendSupportsCExport - , backendAssemblerProg - , backendAssemblerInfoGetter , backendCDefs , backendCodeOutput , backendUseJSLinker @@ -348,40 +344,6 @@ data PrimitiveImplementation deriving Show --- | Names a function that runs the assembler, of this type: --- --- > Logger -> DynFlags -> Platform -> [Option] -> IO () --- --- The functions so named are defined in "GHC.Driver.Pipeline.Execute". - -data DefunctionalizedAssemblerProg - = StandardAssemblerProg - -- ^ Use the standard system assembler - | JSAssemblerProg - -- ^ JS Backend compile to JS via Stg, and so does not use any assembler - | DarwinClangAssemblerProg - -- ^ If running on Darwin, use the assembler from the @clang@ - -- toolchain. Otherwise use the standard system assembler. - - - --- | Names a function that discover from what toolchain the assembler --- is coming, of this type: --- --- > Logger -> DynFlags -> Platform -> IO CompilerInfo --- --- The functions so named are defined in "GHC.Driver.Pipeline.Execute". - -data DefunctionalizedAssemblerInfoGetter - = StandardAssemblerInfoGetter - -- ^ Interrogate the standard system assembler - | JSAssemblerInfoGetter - -- ^ If using the JS backend; return 'Emscripten' - | DarwinClangAssemblerInfoGetter - -- ^ If running on Darwin, return `Clang`; otherwise - -- interrogate the standard system assembler. - - -- | Names a function that generates code and writes the results to a -- file, of this type: -- @@ -770,45 +732,6 @@ backendSupportsCExport (Named JavaScript) = True backendSupportsCExport (Named Interpreter) = False backendSupportsCExport (Named NoBackend) = True --- | This (defunctionalized) function runs the assembler --- used on the code that is written by this back end. A --- program determined by a combination of back end, --- `DynFlags`, and `Platform` is run with the given --- `Option`s. --- --- The function's type is --- @ --- Logger -> DynFlags -> Platform -> [Option] -> IO () --- @ --- --- This field is usually defaulted. -backendAssemblerProg :: Backend -> DefunctionalizedAssemblerProg -backendAssemblerProg (Named NCG) = StandardAssemblerProg -backendAssemblerProg (Named LLVM) = DarwinClangAssemblerProg -backendAssemblerProg (Named ViaC) = StandardAssemblerProg -backendAssemblerProg (Named JavaScript) = JSAssemblerProg -backendAssemblerProg (Named Interpreter) = StandardAssemblerProg -backendAssemblerProg (Named NoBackend) = StandardAssemblerProg - --- | This (defunctionalized) function is used to retrieve --- an enumeration value that characterizes the C/assembler --- part of a toolchain. The function caches the info in a --- mutable variable that is part of the `DynFlags`. --- --- The function's type is --- @ --- Logger -> DynFlags -> Platform -> IO CompilerInfo --- @ --- --- This field is usually defaulted. -backendAssemblerInfoGetter :: Backend -> DefunctionalizedAssemblerInfoGetter -backendAssemblerInfoGetter (Named NCG) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named LLVM) = DarwinClangAssemblerInfoGetter -backendAssemblerInfoGetter (Named ViaC) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named JavaScript) = JSAssemblerInfoGetter -backendAssemblerInfoGetter (Named Interpreter) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named NoBackend) = StandardAssemblerInfoGetter - -- | When using this back end, it may be necessary or -- advisable to pass some `-D` options to a C compiler. -- This (defunctionalized) function produces those ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -116,7 +116,6 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Trans.Reader (ReaderT) import Control.Monad.Trans.Writer (WriterT) -import Data.IORef import System.IO import System.IO.Error (catchIOError) import System.Environment (lookupEnv) @@ -420,15 +419,6 @@ data DynFlags = DynFlags { avx512pf :: Bool, -- Enable AVX-512 PreFetch Instructions. fma :: Bool, -- ^ Enable FMA instructions. - -- | Run-time linker information (what options we need, etc.) - rtldInfo :: IORef (Maybe LinkerInfo), - - -- | Run-time C compiler information - rtccInfo :: IORef (Maybe CompilerInfo), - - -- | Run-time assembler information - rtasmInfo :: IORef (Maybe CompilerInfo), - -- Constants used to control the amount of optimization done. -- | Max size, in bytes, of inline array allocations. @@ -490,9 +480,6 @@ class ContainsDynFlags t where initDynFlags :: DynFlags -> IO DynFlags initDynFlags dflags = do let - refRtldInfo <- newIORef Nothing - refRtccInfo <- newIORef Nothing - refRtasmInfo <- newIORef Nothing canUseUnicode <- do let enc = localeEncoding str = "‘’" (withCString enc str $ \cstr -> @@ -514,9 +501,6 @@ initDynFlags dflags = do useColor = useColor', canUseColor = stderrSupportsAnsiColors, colScheme = colScheme', - rtldInfo = refRtldInfo, - rtccInfo = refRtccInfo, - rtasmInfo = refRtasmInfo, tmpDir = TempDir tmp_dir } @@ -695,9 +679,6 @@ defaultDynFlags mySettings = avx512f = False, avx512pf = False, fma = False, - rtldInfo = panic "defaultDynFlags: no rtldInfo", - rtccInfo = panic "defaultDynFlags: no rtccInfo", - rtasmInfo = panic "defaultDynFlags: no rtasmInfo", maxInlineAllocSize = 128, maxInlineMemcpyInsns = 32, ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -109,9 +109,6 @@ module GHC.Driver.Main import GHC.Prelude -import GHC.Platform -import GHC.Platform.Ways - import GHC.Driver.Plugins import GHC.Driver.Session import GHC.Driver.Backend @@ -336,41 +333,11 @@ initHscEnv mb_top_dir = do mySettings <- initSysTools top_dir dflags <- initDynFlags (defaultDynFlags mySettings) hsc_env <- newHscEnv top_dir dflags - checkBrokenTablesNextToCode (hsc_logger hsc_env) dflags setUnsafeGlobalDynFlags dflags -- c.f. DynFlags.parseDynamicFlagsFull, which -- creates DynFlags and sets the UnsafeGlobalDynFlags return hsc_env --- | The binutils linker on ARM emits unnecessary R_ARM_COPY relocations which --- breaks tables-next-to-code in dynamically linked modules. This --- check should be more selective but there is currently no released --- version where this bug is fixed. --- See https://sourceware.org/bugzilla/show_bug.cgi?id=16177 and --- https://gitlab.haskell.org/ghc/ghc/issues/4210#note_78333 -checkBrokenTablesNextToCode :: Logger -> DynFlags -> IO () -checkBrokenTablesNextToCode logger dflags = do - let invalidLdErr = "Tables-next-to-code not supported on ARM \ - \when using binutils ld (please see: \ - \https://sourceware.org/bugzilla/show_bug.cgi?id=16177)" - broken <- checkBrokenTablesNextToCode' logger dflags - when broken (panic invalidLdErr) - -checkBrokenTablesNextToCode' :: Logger -> DynFlags -> IO Bool -checkBrokenTablesNextToCode' logger dflags - | not (isARM arch) = return False - | ways dflags `hasNotWay` WayDyn = return False - | not tablesNextToCode = return False - | otherwise = do - linkerInfo <- liftIO $ GHC.SysTools.getLinkerInfo logger dflags - case linkerInfo of - GnuLD _ -> return True - _ -> return False - where platform = targetPlatform dflags - arch = platformArch platform - tablesNextToCode = platformTablesNextToCode platform - - -- ----------------------------------------------------------------------------- getDiagnostics :: Hsc (Messages GhcMessage) ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -287,12 +287,6 @@ runAsPhase :: Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO F runAsPhase with_cpp pipe_env hsc_env location input_fn = do let dflags = hsc_dflags hsc_env let logger = hsc_logger hsc_env - let unit_env = hsc_unit_env hsc_env - let platform = ue_platform unit_env - - -- LLVM from version 3.0 onwards doesn't support the OS X system - -- assembler, so we use clang as the assembler instead. (#5636) - let as_prog = applyAssemblerProg $ backendAssemblerProg (backend dflags) let cmdline_include_paths = includePaths dflags let pic_c_flags = picCCOpts dflags @@ -310,9 +304,8 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do includePathsQuoteImplicit cmdline_include_paths] let runAssembler inputFilename outputFilename = withAtomicRename outputFilename $ \temp_outputFilename -> - as_prog + runAs logger dflags - platform (local_includes ++ global_includes -- See Note [-fPIC for assembler] ++ map GHC.SysTools.Option pic_c_flags @@ -392,22 +385,6 @@ runForeignJsPhase pipe_env hsc_env _location input_fn = do embedJsFile logger dflags tmpfs unit_env input_fn output_fn return output_fn - -applyAssemblerProg - :: DefunctionalizedAssemblerProg - -> Logger -> DynFlags -> Platform -> [Option] -> IO () -applyAssemblerProg StandardAssemblerProg logger dflags _platform = - runAs logger dflags -applyAssemblerProg JSAssemblerProg logger dflags _platform = - runEmscripten logger dflags -applyAssemblerProg DarwinClangAssemblerProg logger dflags platform = - if platformOS platform == OSDarwin then - runClang logger dflags - else - runAs logger dflags - - - runCcPhase :: Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO FilePath runCcPhase cc_phase pipe_env hsc_env location input_fn = do let dflags = hsc_dflags hsc_env ===================================== compiler/GHC/Linker/ExtraObj.hs ===================================== @@ -12,7 +12,6 @@ module GHC.Linker.ExtraObj , mkNoteObjsToLinkIntoBinary , checkLinkInfo , getLinkInfo - , getCompilerInfo , ghcLinkInfoSectionName , ghcLinkInfoNoteName , platformSupportsSavingLinkOpts @@ -40,10 +39,8 @@ import qualified GHC.Data.ShortText as ST import GHC.SysTools.Elf import GHC.SysTools.Tasks -import GHC.SysTools.Info import GHC.Linker.Unit -import Control.Monad.IO.Class import Control.Monad import Data.Maybe @@ -52,7 +49,6 @@ mkExtraObj logger tmpfs dflags unit_state extn xs = do cFile <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule extn oFile <- newTempName logger tmpfs (tmpDir dflags) TFL_GhcSession "o" writeFile cFile xs - ccInfo <- liftIO $ getCompilerInfo logger dflags runCc Nothing logger tmpfs dflags ([Option "-c", FileOption "" cFile, @@ -60,7 +56,7 @@ mkExtraObj logger tmpfs dflags unit_state extn xs FileOption "" oFile] ++ if extn /= "s" then cOpts - else asmOpts ccInfo) + else []) return oFile where -- Pass a different set of options to the C compiler depending one whether @@ -70,14 +66,6 @@ mkExtraObj logger tmpfs dflags unit_state extn xs ++ map (FileOption "-I" . ST.unpack) (unitIncludeDirs $ unsafeLookupUnit unit_state rtsUnit) - -- When compiling assembler code, we drop the usual C options, and if the - -- compiler is Clang, we add an extra argument to tell Clang to ignore - -- unused command line options. See trac #11684. - asmOpts ccInfo = - if any (ccInfo ==) [Clang, AppleClang, AppleClang51] - then [Option "-Qunused-arguments"] - else [] - -- When linking a binary, we need to create a C main() function that -- starts everything off. This used to be compiled statically as part -- of the RTS, but that made it hard to change the -rtsopts setting, ===================================== compiler/GHC/SysTools.hs ===================================== @@ -17,7 +17,6 @@ module GHC.SysTools ( -- * Interface to system tools module GHC.SysTools.Tasks, - module GHC.SysTools.Info, -- * Fast file copy copyFile, @@ -35,8 +34,6 @@ import GHC.Prelude import GHC.Utils.Panic import GHC.Driver.Session -import GHC.Linker.ExtraObj -import GHC.SysTools.Info import GHC.SysTools.Tasks import GHC.SysTools.BaseDir import GHC.Settings.IO ===================================== compiler/GHC/SysTools/Info.hs deleted ===================================== @@ -1,243 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} ------------------------------------------------------------------------------ --- --- Compiler information functions --- --- (c) The GHC Team 2017 --- ------------------------------------------------------------------------------ -module GHC.SysTools.Info where - -import GHC.Utils.Exception -import GHC.Utils.Error -import GHC.Driver.Session -import GHC.Utils.Outputable -import GHC.Utils.Misc -import GHC.Utils.Logger - -import Data.List ( isInfixOf, isPrefixOf ) -import Data.IORef - -import System.IO - -import GHC.Platform -import GHC.Prelude - -import GHC.SysTools.Process - -{- Note [Run-time linker info] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~ -See also: #5240, #6063, #10110 - -Before 'runLink', we need to be sure to get the relevant information -about the linker we're using at runtime to see if we need any extra -options. - -Generally, the linker changing from what was detected at ./configure -time has always been possible using -pgml, but on Linux it can happen -'transparently' by installing packages like binutils-gold, which -change what /usr/bin/ld actually points to. - -Clang vs GCC notes: - -For gcc, 'gcc -Wl,--version' gives a bunch of output about how to -invoke the linker before the version information string. For 'clang', -the version information for 'ld' is all that's output. For this -reason, we typically need to slurp up all of the standard error output -and look through it. - -Other notes: - -We cache the LinkerInfo inside DynFlags, since clients may link -multiple times. The definition of LinkerInfo is there to avoid a -circular dependency. - --} - -{- Note [ELF needed shared libs] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Some distributions change the link editor's default handling of -ELF DT_NEEDED tags to include only those shared objects that are -needed to resolve undefined symbols. For Template Haskell we need -the last temporary shared library also if it is not needed for the -currently linked temporary shared library. We specify --no-as-needed -to override the default. This flag exists in GNU ld and GNU gold. - -The flag is only needed on ELF systems. On Windows (PE) and Mac OS X -(Mach-O) the flag is not needed. - --} - -neededLinkArgs :: LinkerInfo -> [Option] -neededLinkArgs (GnuLD o) = o -neededLinkArgs (Mold o) = o -neededLinkArgs (GnuGold o) = o -neededLinkArgs (LlvmLLD o) = o -neededLinkArgs (DarwinLD o) = o -neededLinkArgs (SolarisLD o) = o -neededLinkArgs (AixLD o) = o -neededLinkArgs UnknownLD = [] - --- Grab linker info and cache it in DynFlags. -getLinkerInfo :: Logger -> DynFlags -> IO LinkerInfo -getLinkerInfo logger dflags = do - info <- readIORef (rtldInfo dflags) - case info of - Just v -> return v - Nothing -> do - v <- getLinkerInfo' logger dflags - writeIORef (rtldInfo dflags) (Just v) - return v - --- See Note [Run-time linker info]. -getLinkerInfo' :: Logger -> DynFlags -> IO LinkerInfo -getLinkerInfo' logger dflags = do - let platform = targetPlatform dflags - os = platformOS platform - (pgm,args0) = pgm_l dflags - args1 = map Option (getOpts dflags opt_l) - args2 = args0 ++ args1 - args3 = filter notNull (map showOpt args2) - - -- Try to grab the info from the process output. - parseLinkerInfo stdo _stde _exitc - | any ("GNU ld" `isPrefixOf`) stdo = - -- Set DT_NEEDED for all shared libraries. #10110. - return (GnuLD $ map Option [-- ELF specific flag - -- 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] - return (GnuGold [Option "-Wl,--no-as-needed"]) - - | any (\line -> "LLD" `isPrefixOf` line || "LLD" `elem` words line) stdo = - return (LlvmLLD $ map Option [ --see Note [ELF needed shared libs] - "-Wl,--no-as-needed" | osElfTarget os || os == OSMinGW32 ]) - - -- Unknown linker. - | otherwise = fail "invalid --version output, or linker is unsupported" - - -- Process the executable call - catchIO ( - case os of - OSSolaris2 -> - -- Solaris uses its own Solaris linker. Even all - -- GNU C are recommended to configure with Solaris - -- linker instead of using GNU binutils linker. Also - -- all GCC distributed with Solaris follows this rule - -- precisely so we assume here, the Solaris linker is - -- used. - return $ SolarisLD [] - OSAIX -> - -- IBM AIX uses its own non-binutils linker as well - return $ AixLD [] - OSDarwin -> - -- Darwin has neither GNU Gold or GNU LD, but a strange linker - -- that doesn't support --version. We can just assume that's - -- what we're using. - return $ DarwinLD [] - OSMinGW32 -> - -- GHC doesn't support anything but GNU ld on Windows anyway. - -- Process creation is also fairly expensive on win32, so - -- we short-circuit here. - return $ GnuLD $ map Option - [ -- Emit stack checks - -- See Note [Windows stack allocations] - "-fstack-check" - ] - _ -> do - -- In practice, we use the compiler as the linker here. Pass - -- -Wl,--version to get linker version info. - (exitc, stdo, stde) <- readProcessEnvWithExitCode pgm - (["-Wl,--version"] ++ args3) - c_locale_env - -- Split the output by lines to make certain kinds - -- of processing easier. In particular, 'clang' and 'gcc' - -- have slightly different outputs for '-Wl,--version', but - -- it's still easy to figure out. - parseLinkerInfo (lines stdo) (lines stde) exitc - ) - (\err -> do - debugTraceMsg logger 2 - (text "Error (figuring out linker information):" <+> - text (show err)) - errorMsg logger $ hang (text "Warning:") 9 $ - text "Couldn't figure out linker information!" $$ - text "Make sure you're using GNU ld, GNU gold" <+> - text "or the built in OS X linker, etc." - return UnknownLD - ) - --- | Grab compiler info and cache it in DynFlags. -getCompilerInfo :: Logger -> DynFlags -> IO CompilerInfo -getCompilerInfo logger dflags = do - info <- readIORef (rtccInfo dflags) - case info of - Just v -> return v - Nothing -> do - let pgm = pgm_c dflags - v <- getCompilerInfo' logger pgm - writeIORef (rtccInfo dflags) (Just v) - return v - --- | Grab assembler info and cache it in DynFlags. -getAssemblerInfo :: Logger -> DynFlags -> IO CompilerInfo -getAssemblerInfo logger dflags = do - info <- readIORef (rtasmInfo dflags) - case info of - Just v -> return v - Nothing -> do - let (pgm, _) = pgm_a dflags - v <- getCompilerInfo' logger pgm - writeIORef (rtasmInfo dflags) (Just v) - return v - --- See Note [Run-time linker info]. -getCompilerInfo' :: Logger -> String -> IO CompilerInfo -getCompilerInfo' logger pgm = do - let -- Try to grab the info from the process output. - parseCompilerInfo _stdo stde _exitc - -- Regular GCC - | any ("gcc version" `isInfixOf`) stde = - return GCC - -- Regular clang - | any ("clang version" `isInfixOf`) stde = - return Clang - -- FreeBSD clang - | any ("FreeBSD clang version" `isInfixOf`) stde = - return Clang - -- Xcode 5.1 clang - | any ("Apple LLVM version 5.1" `isPrefixOf`) stde = - return AppleClang51 - -- Xcode 5 clang - | any ("Apple LLVM version" `isPrefixOf`) stde = - return AppleClang - -- Xcode 4.1 clang - | any ("Apple clang version" `isPrefixOf`) stde = - return AppleClang - -- Unknown compiler. - | otherwise = fail $ "invalid -v output, or compiler is unsupported (" ++ pgm ++ "): " ++ unlines stde - - -- Process the executable call - catchIO (do - (exitc, stdo, stde) <- - readProcessEnvWithExitCode pgm ["-v"] c_locale_env - -- Split the output by lines to make certain kinds - -- of processing easier. - parseCompilerInfo (lines stdo) (lines stde) exitc - ) - (\err -> do - debugTraceMsg logger 2 - (text "Error (figuring out C compiler information):" <+> - text (show err)) - errorMsg logger $ hang (text "Warning:") 9 $ - text "Couldn't figure out C compiler information!" $$ - text "Make sure you're using GNU gcc, or clang" - return UnknownCC - ) ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -19,7 +19,6 @@ import GHC.CmmToLlvm.Config (LlvmVersion, llvmVersionStr, supportedLlvmVersionUp import GHC.Settings import GHC.SysTools.Process -import GHC.SysTools.Info import GHC.Driver.Session @@ -278,15 +277,12 @@ figureLlvmVersion logger dflags = traceSystoolCommand logger "llc" $ do runLink :: Logger -> TmpFs -> DynFlags -> [Option] -> IO () runLink logger tmpfs dflags args = traceSystoolCommand logger "linker" $ do - -- See Note [Run-time linker info] - -- -- `-optl` args come at the end, so that later `-l` options -- given there manually can fill in symbols needed by -- Haskell libraries coming in via `args`. - linkargs <- neededLinkArgs `fmap` getLinkerInfo logger dflags let (p,args0) = pgm_l dflags optl_args = map Option (getOpts dflags opt_l) - args2 = args0 ++ linkargs ++ args ++ optl_args + args2 = args0 ++ args ++ optl_args mb_env <- getGccEnv args2 runSomethingResponseFile logger tmpfs dflags ld_filter "Linker" p args2 mb_env where ===================================== compiler/ghc.cabal.in ===================================== @@ -712,7 +712,6 @@ Library GHC.SysTools.BaseDir GHC.SysTools.Cpp GHC.SysTools.Elf - GHC.SysTools.Info GHC.SysTools.Process GHC.SysTools.Tasks GHC.SysTools.Terminal ===================================== m4/fp_link_supports_no_as_needed.m4 ===================================== @@ -0,0 +1,33 @@ +# FP_LINK_SUPPORTS_NO_AS_NEEDED +# ---------------------------------- +# Set the Cc linker flag -Wl,--no-as-needed if it is supported +# $1 is the name of the linker flags variable when linking with gcc +# See also Note [ELF needed shared libs] +AC_DEFUN([FP_LINK_SUPPORTS_NO_AS_NEEDED], +[ + AC_MSG_CHECKING([whether Cc linker supports -Wl,--no-as-needed]) + echo 'int f(int a) {return 2*a;}' > conftest.a.c + echo 'int f(int a); int main(int argc, char **argv) {return f(0);}' > conftest.b.c + $CC -c -o conftest.a.o conftest.a.c > /dev/null 2>&1 + $CC -c -o conftest.b.o conftest.b.c > /dev/null 2>&1 + if "$CC" "$$1" -Wl,--no-as-needed -o conftest conftest.a.o conftest.b.o > /dev/null 2>&1 + then + $1="$$1 -Wl,--no-as-needed" + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + fi + rm -f conftest* +]) + +# Note [ELF needed shared libs] +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# Some distributions change the link editor's default handling of +# ELF DT_NEEDED tags to include only those shared objects that are +# needed to resolve undefined symbols. For Template Haskell we need +# the last temporary shared library also if it is not needed for the +# currently linked temporary shared library. We specify --no-as-needed +# to override the default. This flag exists in GNU ld and GNU gold. +# +# The flag is only needed on ELF systems. On Windows (PE) and Mac OS X +# (Mach-O) the flag is not needed. ===================================== m4/fptools_set_c_ld_flags.m4 ===================================== @@ -17,9 +17,19 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS], ;; esac + # See Note [ELF needed shared libs] + case $$1 in + *-linux|*-freebsd*) + FP_LINK_SUPPORTS_NO_AS_NEEDED([$3]) + ;; + esac + case $$1 in i386-unknown-mingw32) $2="$$2 -march=i686" + # Emit stack checks + # See Note [Windows stack allocations] + $3="$$3 -fstack-check" ;; i386-portbld-freebsd*) $2="$$2 -march=i686" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/37524e25181041681ab13ba6c3686b3de7df89b2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/37524e25181041681ab13ba6c3686b3de7df89b2 You're receiving 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 Jun 26 20:16:05 2023 From: gitlab at gitlab.haskell.org (Torsten Schmits (@torsten.schmits)) Date: Mon, 26 Jun 2023 16:16:05 -0400 Subject: [Git][ghc/ghc][wip/torsten.schmits/16468] Relax defaulting of RuntimeRep/Levity when printing Message-ID: <6499f205e2c46_2402e03505da41350f6@gitlab.mail> Torsten Schmits pushed to branch wip/torsten.schmits/16468 at Glasgow Haskell Compiler / GHC Commits: 9958c33a by Torsten Schmits at 2023-06-26T22:15:55+02:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 5 changed files: - compiler/GHC/Iface/Type.hs - compiler/GHC/Types/Unique/DFM.hs - + testsuite/tests/ghci/scripts/T16468.script - + testsuite/tests/ghci/scripts/T16468.stdout - testsuite/tests/ghci/scripts/all.T Changes: ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -821,7 +821,7 @@ pprIfaceLamBndr (b, IfaceNoOneShot) = ppr b pprIfaceLamBndr (b, IfaceOneShot) = ppr b <> text "[OneShot]" pprIfaceIdBndr :: IfaceIdBndr -> SDoc -pprIfaceIdBndr (w, name, ty) = parens (ppr name <> brackets (ppr w) <+> dcolon <+> ppr ty) +pprIfaceIdBndr (w, name, ty) = parens (ppr name <> brackets (ppr_ty_nested w) <+> dcolon <+> ppr_ty_nested ty) {- Note [Suppressing binder signatures] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -881,7 +881,7 @@ pprIfaceTvBndr :: IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc pprIfaceTvBndr (tv, ki) (SuppressBndrSig suppress_sig) (UseBndrParens use_parens) | suppress_sig = ppr tv | isIfaceLiftedTypeKind ki = ppr tv - | otherwise = maybe_parens (ppr tv <+> dcolon <+> ppr ki) + | otherwise = maybe_parens (ppr tv <+> dcolon <+> ppr_ty_nested ki) where maybe_parens | use_parens = parens | otherwise = id @@ -933,9 +933,13 @@ instance Binary IfaceOneShot where instance Outputable IfaceType where ppr ty = pprIfaceType ty -pprIfaceType, pprParendIfaceType :: IfaceType -> SDoc +-- The purpose of 'ppr_ty_nested' is to distinguish calls that should not +-- trigger 'hideNonStandardTypes', see Note [Defaulting RuntimeRep variables] +-- wrinkle (W2). +pprIfaceType, pprParendIfaceType, ppr_ty_nested :: IfaceType -> SDoc pprIfaceType = pprPrecIfaceType topPrec pprParendIfaceType = pprPrecIfaceType appPrec +ppr_ty_nested = ppr_ty topPrec pprPrecIfaceType :: PprPrec -> IfaceType -> SDoc -- We still need `hideNonStandardTypes`, since the `pprPrecIfaceType` may be @@ -987,7 +991,7 @@ ppr_ty ctxt_prec ty@(IfaceFunTy af w ty1 ty2) -- Should be a visible argument | isVisibleFunArg af = (pprTypeArrow af wthis <+> ppr_ty funPrec ty1) : ppr_fun_tail wnext ty2 ppr_fun_tail wthis other_ty - = [pprTypeArrow af wthis <+> pprIfaceType other_ty] + = [pprTypeArrow af wthis <+> ppr_ty_nested other_ty] ppr_ty ctxt_prec (IfaceAppTy t ts) = if_print_coercions @@ -1044,9 +1048,11 @@ Haskell programs, so it makes little sense to make all users pay this syntactic overhead. For this reason it was decided that we would hide RuntimeRep variables -for now (see #11549). We do this by defaulting all type variables of -kind RuntimeRep to LiftedRep. -Likewise, we default all Multiplicity variables to Many. +for now (see #11549). We do this right in the pretty-printer, by pre-processing +the type we are about to print, to default any type variables of kind RuntimeRep +that are bound by toplevel invisible quantification to LiftedRep. +Likewise, we default Multiplicity variables to Many and Levity variables to +Lifted. This is done in a pass right before pretty-printing (defaultIfaceTyVarsOfKind, controlled by @@ -1073,6 +1079,32 @@ metavariables are converted, skolem variables are not. There's one exception though: TyVarTv metavariables should not be defaulted, as they appear during kind-checking of "newtype T :: TYPE r where..." (test T18357a). Therefore, we additionally test for isTyConableTyVar. + +Wrinkles: + +(W1) The loop 'go' in 'defaultIfaceTyVarsOfKind' passes a Bool flag, 'rank1', + around that indicates whether we haven't yet descended into the arguments + of a function type. + This is used to decide whether newly bound variables are eligible for + defaulting – we do not want contravariant foralls to be defaulted because + that would result in an incorrect, rather than specialized, type. + For example: + ∀ p (r1 :: RuntimeRep) . (∀ (r2 :: RuntimeRep) . p r2) -> p r1 + We want to default 'r1', but not 'r2'. + When examining the first forall, 'rank1' is True. + The toplevel function type is matched as IfaceFunTy, where we recurse into + 'go' by passing False for 'rank1'. + The forall in the first argument then skips adding a substitution for 'r2'. + +(W2) 'defaultIfaceTyVarsOfKind' ought to be called only once when printing a + type. + A few components of the printing machinery used to invoke 'ppr' on types + nested in secondary structures like IfaceBndr, which would repeat the + defaulting process, but treating the type as if it were top-level, causing + unwanted defaulting. + In order to prevent future developers from using 'ppr' again or being + confused that @ppr_ty topPrec@ is used, we introduced a marker function, + 'ppr_ty_nested'. -} -- | Default 'RuntimeRep' variables to 'LiftedRep', @@ -1097,28 +1129,29 @@ as they appear during kind-checking of "newtype T :: TYPE r where..." defaultIfaceTyVarsOfKind :: Bool -- ^ default 'RuntimeRep'/'Levity' variables? -> Bool -- ^ default 'Multiplicity' variables? -> IfaceType -> IfaceType -defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv ty +defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv True ty where go :: FastStringEnv IfaceType -- Set of enclosing forall-ed RuntimeRep/Levity/Multiplicity variables + -> Bool -- Are we in a toplevel forall, where defaulting is allowed? -> IfaceType -> IfaceType - go subs (IfaceForAllTy (Bndr (IfaceTvBndr (var, var_kind)) argf) ty) + go subs True (IfaceForAllTy (Bndr (IfaceTvBndr (var, var_kind)) argf) ty) | isInvisibleForAllTyFlag argf -- Don't default *visible* quantification -- or we get the mess in #13963 , Just substituted_ty <- check_substitution var_kind = let subs' = extendFsEnv subs var substituted_ty -- Record that we should replace it with LiftedRep/Lifted/Many, -- and recurse, discarding the forall - in go subs' ty + in go subs' True ty - go subs (IfaceForAllTy bndr ty) - = IfaceForAllTy (go_ifacebndr subs bndr) (go subs ty) + go subs rank1 (IfaceForAllTy bndr ty) + = IfaceForAllTy (go_ifacebndr subs bndr) (go subs rank1 ty) - go subs ty@(IfaceTyVar tv) = case lookupFsEnv subs tv of + go subs _ ty@(IfaceTyVar tv) = case lookupFsEnv subs tv of Just s -> s Nothing -> ty - go _ ty@(IfaceFreeTyVar tv) + go _ _ ty@(IfaceFreeTyVar tv) -- See Note [Defaulting RuntimeRep variables], about free vars | def_rep , GHC.Core.Type.isRuntimeRepTy (tyVarKind tv) @@ -1138,34 +1171,34 @@ defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv ty | otherwise = ty - go subs (IfaceTyConApp tc tc_args) - = IfaceTyConApp tc (go_args subs tc_args) + go subs _ (IfaceTyConApp tc tc_args) + = IfaceTyConApp tc (go_args subs False tc_args) - go subs (IfaceTupleTy sort is_prom tc_args) - = IfaceTupleTy sort is_prom (go_args subs tc_args) + go subs _ (IfaceTupleTy sort is_prom tc_args) + = IfaceTupleTy sort is_prom (go_args subs False tc_args) - go subs (IfaceFunTy af w arg res) - = IfaceFunTy af (go subs w) (go subs arg) (go subs res) + go subs rank1 (IfaceFunTy af w arg res) + = IfaceFunTy af (go subs False w) (go subs False arg) (go subs rank1 res) - go subs (IfaceAppTy t ts) - = IfaceAppTy (go subs t) (go_args subs ts) + go subs _ (IfaceAppTy t ts) + = IfaceAppTy (go subs False t) (go_args subs False ts) - go subs (IfaceCastTy x co) - = IfaceCastTy (go subs x) co + go subs rank1 (IfaceCastTy x co) + = IfaceCastTy (go subs rank1 x) co - go _ ty@(IfaceLitTy {}) = ty - go _ ty@(IfaceCoercionTy {}) = ty + go _ _ ty@(IfaceLitTy {}) = ty + go _ _ ty@(IfaceCoercionTy {}) = ty go_ifacebndr :: FastStringEnv IfaceType -> IfaceForAllBndr -> IfaceForAllBndr go_ifacebndr subs (Bndr (IfaceIdBndr (w, n, t)) argf) - = Bndr (IfaceIdBndr (w, n, go subs t)) argf + = Bndr (IfaceIdBndr (w, n, go subs False t)) argf go_ifacebndr subs (Bndr (IfaceTvBndr (n, t)) argf) - = Bndr (IfaceTvBndr (n, go subs t)) argf + = Bndr (IfaceTvBndr (n, go subs False t)) argf - go_args :: FastStringEnv IfaceType -> IfaceAppArgs -> IfaceAppArgs - go_args _ IA_Nil = IA_Nil - go_args subs (IA_Arg ty argf args) - = IA_Arg (go subs ty) argf (go_args subs args) + go_args :: FastStringEnv IfaceType -> Bool -> IfaceAppArgs -> IfaceAppArgs + go_args _ _ IA_Nil = IA_Nil + go_args subs rank1 (IA_Arg ty argf args) + = IA_Arg (go subs rank1 ty) argf (go_args subs rank1 args) check_substitution :: IfaceType -> Maybe IfaceType check_substitution (IfaceTyConApp tc _) @@ -1236,7 +1269,7 @@ ppr_app_arg ctx_prec (t, argf) = Specified | print_kinds -> char '@' <> ppr_ty appPrec t Inferred | print_kinds - -> char '@' <> braces (ppr_ty topPrec t) + -> char '@' <> braces (ppr_ty_nested t) _ -> empty ------------------- @@ -1367,7 +1400,7 @@ ppr_sigma show_forall ctxt_prec iface_ty -- Then it could handle both invisible and required binders, and -- splitIfaceReqForallTy wouldn't be necessary here. in ppr_iface_forall_part show_forall invis_tvs theta $ - sep [pprIfaceForAll req_tvs, ppr tau'] + sep [pprIfaceForAll req_tvs, ppr_ty_nested tau'] pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc pprUserIfaceForAll tvs ===================================== compiler/GHC/Types/Unique/DFM.hs ===================================== @@ -94,7 +94,7 @@ import qualified Data.IntSet as I -- order then `udfmToList` returns them in deterministic order. -- -- There is an implementation cost: each element is given a serial number --- as it is added, and `udfmToList` sorts it's result by this serial +-- as it is added, and `udfmToList` sorts its result by this serial -- number. So you should only use `UniqDFM` if you need the deterministic -- property. -- ===================================== testsuite/tests/ghci/scripts/T16468.script ===================================== @@ -0,0 +1,52 @@ +:set -XLinearTypes -XImpredicativeTypes +import GHC.Types (RuntimeRep (..), Levity (..), TYPE, Multiplicity, Type, LiftedRep) +import Data.Proxy + +f :: forall p (r' :: RuntimeRep). (forall (r :: RuntimeRep). Int -> p r) -> p r'; f x = x 5 +g :: forall p. Int -> forall (r :: RuntimeRep). p r; g _ = undefined +g' :: Int -> forall p (r :: RuntimeRep). p r; g' _ = undefined +h :: Int -> forall (r :: RuntimeRep). TYPE r; h _ = undefined +i :: forall (r :: RuntimeRep). Int -> TYPE r; i _ = undefined +j :: forall p. Eq (p ('BoxedRep 'Lifted)) => Int -> forall (r :: RuntimeRep). p r; j _ = undefined +k :: forall p (r' :: RuntimeRep). Eq (p r') => (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) -> p r'; k x = x 5 +class C a where l :: forall (r :: RuntimeRep) (b :: TYPE r). a -> b +m :: (forall (m :: Multiplicity). Int %m -> Int) -> Int; m x = x 5 +n :: forall (m :: Multiplicity). Int %m -> Int; n a = a +o :: Maybe (forall (r :: RuntimeRep). Proxy r); o = Nothing +p :: (forall (r :: RuntimeRep). Proxy r, Int); p = undefined +q :: p (forall (r :: RuntimeRep). Proxy r); q = undefined +r :: forall (a :: (forall (r :: RuntimeRep). TYPE r)) (p :: (forall (r :: RuntimeRep). TYPE r) -> Type). p a; r = r + +:set -XNoLinearTypes + +:type f +:type g +:type g' +:type h +:type i +:type j +:type k +:type l +:type m +:type n +:type o +:type p +:type q +:type r + +:set -fprint-explicit-runtime-reps +:set -XLinearTypes +:type f +:type g +:type g' +:type h +:type i +:type j +:type k +:type l +:type m +:type n +:type o +:type p +:type q +:type r ===================================== testsuite/tests/ghci/scripts/T16468.stdout ===================================== @@ -0,0 +1,34 @@ +f :: (forall (r :: RuntimeRep). Int -> p r) -> p LiftedRep +g :: Int -> p LiftedRep +g' :: Int -> forall (p :: RuntimeRep -> *). p LiftedRep +h :: Int -> * +i :: Int -> * +j :: Eq (p LiftedRep) => Int -> p LiftedRep +k :: Eq (p LiftedRep) => + (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) -> p LiftedRep +l :: C a => a -> b +m :: (forall (m :: Multiplicity). Int %m -> Int) -> Int +n :: Int -> Int +o :: Maybe (forall (r :: RuntimeRep). Proxy r) +p :: (Proxy LiftedRep, Int) +q :: p (forall (r :: RuntimeRep). Proxy r) +r :: forall (a :: forall (r :: RuntimeRep). TYPE r) + (p :: (forall (r :: RuntimeRep). TYPE r) -> *). + p a +f :: (forall (r :: RuntimeRep). Int -> p r) -> p r' +g :: Int -> forall (r :: RuntimeRep). p r +g' :: Int -> forall (p :: RuntimeRep -> *) (r :: RuntimeRep). p r +h :: Int -> forall (r :: RuntimeRep). TYPE r +i :: Int -> TYPE r +j :: Eq (p LiftedRep) => Int -> forall (r :: RuntimeRep). p r +k :: Eq (p r') => + (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) -> p r' +l :: forall a (r :: RuntimeRep) (b :: TYPE r). C a => a -> b +m :: (forall (m :: Multiplicity). Int %m -> Int) -> Int +n :: Int %m -> Int +o :: Maybe (forall (r :: RuntimeRep). Proxy r) +p :: (forall (r :: RuntimeRep). Proxy r, Int) +q :: p (forall (r :: RuntimeRep). Proxy r) +r :: forall (a :: forall (r :: RuntimeRep). TYPE r) + (p :: (forall (r :: RuntimeRep). TYPE r) -> *). + p a ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -375,3 +375,4 @@ test('T22695', normal, ghci_script, ['T22695.script']) test('T22817', normal, ghci_script, ['T22817.script']) test('T22908', normal, ghci_script, ['T22908.script']) test('T23062', normal, ghci_script, ['T23062.script']) +test('T16468', normal, ghci_script, ['T16468.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9958c33a78e789820790f471ce650680dee75787 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9958c33a78e789820790f471ce650680dee75787 You're receiving 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 Jun 26 20:28:11 2023 From: gitlab at gitlab.haskell.org (Torsten Schmits (@torsten.schmits)) Date: Mon, 26 Jun 2023 16:28:11 -0400 Subject: [Git][ghc/ghc][wip/torsten.schmits/16468] Relax defaulting of RuntimeRep/Levity when printing Message-ID: <6499f4dbd484a_2402e0c74e813922f@gitlab.mail> Torsten Schmits pushed to branch wip/torsten.schmits/16468 at Glasgow Haskell Compiler / GHC Commits: 5305ee3f by Torsten Schmits at 2023-06-26T22:28:03+02:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 5 changed files: - compiler/GHC/Iface/Type.hs - compiler/GHC/Types/Unique/DFM.hs - + testsuite/tests/ghci/scripts/T16468.script - + testsuite/tests/ghci/scripts/T16468.stdout - testsuite/tests/ghci/scripts/all.T Changes: ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -821,7 +821,7 @@ pprIfaceLamBndr (b, IfaceNoOneShot) = ppr b pprIfaceLamBndr (b, IfaceOneShot) = ppr b <> text "[OneShot]" pprIfaceIdBndr :: IfaceIdBndr -> SDoc -pprIfaceIdBndr (w, name, ty) = parens (ppr name <> brackets (ppr w) <+> dcolon <+> ppr ty) +pprIfaceIdBndr (w, name, ty) = parens (ppr name <> brackets (ppr_ty_nested w) <+> dcolon <+> ppr_ty_nested ty) {- Note [Suppressing binder signatures] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -881,7 +881,7 @@ pprIfaceTvBndr :: IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc pprIfaceTvBndr (tv, ki) (SuppressBndrSig suppress_sig) (UseBndrParens use_parens) | suppress_sig = ppr tv | isIfaceLiftedTypeKind ki = ppr tv - | otherwise = maybe_parens (ppr tv <+> dcolon <+> ppr ki) + | otherwise = maybe_parens (ppr tv <+> dcolon <+> ppr_ty_nested ki) where maybe_parens | use_parens = parens | otherwise = id @@ -933,9 +933,13 @@ instance Binary IfaceOneShot where instance Outputable IfaceType where ppr ty = pprIfaceType ty -pprIfaceType, pprParendIfaceType :: IfaceType -> SDoc +-- The purpose of 'ppr_ty_nested' is to distinguish calls that should not +-- trigger 'hideNonStandardTypes', see Note [Defaulting RuntimeRep variables] +-- wrinkle (W2). +pprIfaceType, pprParendIfaceType, ppr_ty_nested :: IfaceType -> SDoc pprIfaceType = pprPrecIfaceType topPrec pprParendIfaceType = pprPrecIfaceType appPrec +ppr_ty_nested = ppr_ty topPrec pprPrecIfaceType :: PprPrec -> IfaceType -> SDoc -- We still need `hideNonStandardTypes`, since the `pprPrecIfaceType` may be @@ -987,7 +991,7 @@ ppr_ty ctxt_prec ty@(IfaceFunTy af w ty1 ty2) -- Should be a visible argument | isVisibleFunArg af = (pprTypeArrow af wthis <+> ppr_ty funPrec ty1) : ppr_fun_tail wnext ty2 ppr_fun_tail wthis other_ty - = [pprTypeArrow af wthis <+> pprIfaceType other_ty] + = [pprTypeArrow af wthis <+> ppr_ty_nested other_ty] ppr_ty ctxt_prec (IfaceAppTy t ts) = if_print_coercions @@ -1044,9 +1048,11 @@ Haskell programs, so it makes little sense to make all users pay this syntactic overhead. For this reason it was decided that we would hide RuntimeRep variables -for now (see #11549). We do this by defaulting all type variables of -kind RuntimeRep to LiftedRep. -Likewise, we default all Multiplicity variables to Many. +for now (see #11549). We do this right in the pretty-printer, by pre-processing +the type we are about to print, to default any type variables of kind RuntimeRep +that are bound by toplevel invisible quantification to LiftedRep. +Likewise, we default Multiplicity variables to Many and Levity variables to +Lifted. This is done in a pass right before pretty-printing (defaultIfaceTyVarsOfKind, controlled by @@ -1073,6 +1079,32 @@ metavariables are converted, skolem variables are not. There's one exception though: TyVarTv metavariables should not be defaulted, as they appear during kind-checking of "newtype T :: TYPE r where..." (test T18357a). Therefore, we additionally test for isTyConableTyVar. + +Wrinkles: + +(W1) The loop 'go' in 'defaultIfaceTyVarsOfKind' passes a Bool flag, 'rank1', + around that indicates whether we haven't yet descended into the arguments + of a function type. + This is used to decide whether newly bound variables are eligible for + defaulting – we do not want contravariant foralls to be defaulted because + that would result in an incorrect, rather than specialized, type. + For example: + ∀ p (r1 :: RuntimeRep) . (∀ (r2 :: RuntimeRep) . p r2) -> p r1 + We want to default 'r1', but not 'r2'. + When examining the first forall, 'rank1' is True. + The toplevel function type is matched as IfaceFunTy, where we recurse into + 'go' by passing False for 'rank1'. + The forall in the first argument then skips adding a substitution for 'r2'. + +(W2) 'defaultIfaceTyVarsOfKind' ought to be called only once when printing a + type. + A few components of the printing machinery used to invoke 'ppr' on types + nested in secondary structures like IfaceBndr, which would repeat the + defaulting process, but treating the type as if it were top-level, causing + unwanted defaulting. + In order to prevent future developers from using 'ppr' again or being + confused that @ppr_ty topPrec@ is used, we introduced a marker function, + 'ppr_ty_nested'. -} -- | Default 'RuntimeRep' variables to 'LiftedRep', @@ -1097,28 +1129,29 @@ as they appear during kind-checking of "newtype T :: TYPE r where..." defaultIfaceTyVarsOfKind :: Bool -- ^ default 'RuntimeRep'/'Levity' variables? -> Bool -- ^ default 'Multiplicity' variables? -> IfaceType -> IfaceType -defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv ty +defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv True ty where go :: FastStringEnv IfaceType -- Set of enclosing forall-ed RuntimeRep/Levity/Multiplicity variables + -> Bool -- Are we in a toplevel forall, where defaulting is allowed? -> IfaceType -> IfaceType - go subs (IfaceForAllTy (Bndr (IfaceTvBndr (var, var_kind)) argf) ty) + go subs True (IfaceForAllTy (Bndr (IfaceTvBndr (var, var_kind)) argf) ty) | isInvisibleForAllTyFlag argf -- Don't default *visible* quantification -- or we get the mess in #13963 , Just substituted_ty <- check_substitution var_kind = let subs' = extendFsEnv subs var substituted_ty -- Record that we should replace it with LiftedRep/Lifted/Many, -- and recurse, discarding the forall - in go subs' ty + in go subs' True ty - go subs (IfaceForAllTy bndr ty) - = IfaceForAllTy (go_ifacebndr subs bndr) (go subs ty) + go subs rank1 (IfaceForAllTy bndr ty) + = IfaceForAllTy (go_ifacebndr subs bndr) (go subs rank1 ty) - go subs ty@(IfaceTyVar tv) = case lookupFsEnv subs tv of + go subs _ ty@(IfaceTyVar tv) = case lookupFsEnv subs tv of Just s -> s Nothing -> ty - go _ ty@(IfaceFreeTyVar tv) + go _ _ ty@(IfaceFreeTyVar tv) -- See Note [Defaulting RuntimeRep variables], about free vars | def_rep , GHC.Core.Type.isRuntimeRepTy (tyVarKind tv) @@ -1138,34 +1171,34 @@ defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv ty | otherwise = ty - go subs (IfaceTyConApp tc tc_args) + go subs _ (IfaceTyConApp tc tc_args) = IfaceTyConApp tc (go_args subs tc_args) - go subs (IfaceTupleTy sort is_prom tc_args) + go subs _ (IfaceTupleTy sort is_prom tc_args) = IfaceTupleTy sort is_prom (go_args subs tc_args) - go subs (IfaceFunTy af w arg res) - = IfaceFunTy af (go subs w) (go subs arg) (go subs res) + go subs rank1 (IfaceFunTy af w arg res) + = IfaceFunTy af (go subs False w) (go subs False arg) (go subs rank1 res) - go subs (IfaceAppTy t ts) - = IfaceAppTy (go subs t) (go_args subs ts) + go subs _ (IfaceAppTy t ts) + = IfaceAppTy (go subs False t) (go_args subs ts) - go subs (IfaceCastTy x co) - = IfaceCastTy (go subs x) co + go subs rank1 (IfaceCastTy x co) + = IfaceCastTy (go subs rank1 x) co - go _ ty@(IfaceLitTy {}) = ty - go _ ty@(IfaceCoercionTy {}) = ty + go _ _ ty@(IfaceLitTy {}) = ty + go _ _ ty@(IfaceCoercionTy {}) = ty go_ifacebndr :: FastStringEnv IfaceType -> IfaceForAllBndr -> IfaceForAllBndr go_ifacebndr subs (Bndr (IfaceIdBndr (w, n, t)) argf) - = Bndr (IfaceIdBndr (w, n, go subs t)) argf + = Bndr (IfaceIdBndr (w, n, go subs False t)) argf go_ifacebndr subs (Bndr (IfaceTvBndr (n, t)) argf) - = Bndr (IfaceTvBndr (n, go subs t)) argf + = Bndr (IfaceTvBndr (n, go subs False t)) argf go_args :: FastStringEnv IfaceType -> IfaceAppArgs -> IfaceAppArgs go_args _ IA_Nil = IA_Nil go_args subs (IA_Arg ty argf args) - = IA_Arg (go subs ty) argf (go_args subs args) + = IA_Arg (go subs False ty) argf (go_args subs args) check_substitution :: IfaceType -> Maybe IfaceType check_substitution (IfaceTyConApp tc _) @@ -1236,7 +1269,7 @@ ppr_app_arg ctx_prec (t, argf) = Specified | print_kinds -> char '@' <> ppr_ty appPrec t Inferred | print_kinds - -> char '@' <> braces (ppr_ty topPrec t) + -> char '@' <> braces (ppr_ty_nested t) _ -> empty ------------------- @@ -1367,7 +1400,7 @@ ppr_sigma show_forall ctxt_prec iface_ty -- Then it could handle both invisible and required binders, and -- splitIfaceReqForallTy wouldn't be necessary here. in ppr_iface_forall_part show_forall invis_tvs theta $ - sep [pprIfaceForAll req_tvs, ppr tau'] + sep [pprIfaceForAll req_tvs, ppr_ty_nested tau'] pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc pprUserIfaceForAll tvs ===================================== compiler/GHC/Types/Unique/DFM.hs ===================================== @@ -94,7 +94,7 @@ import qualified Data.IntSet as I -- order then `udfmToList` returns them in deterministic order. -- -- There is an implementation cost: each element is given a serial number --- as it is added, and `udfmToList` sorts it's result by this serial +-- as it is added, and `udfmToList` sorts its result by this serial -- number. So you should only use `UniqDFM` if you need the deterministic -- property. -- ===================================== testsuite/tests/ghci/scripts/T16468.script ===================================== @@ -0,0 +1,52 @@ +:set -XLinearTypes -XImpredicativeTypes +import GHC.Types (RuntimeRep (..), Levity (..), TYPE, Multiplicity, Type, LiftedRep) +import Data.Proxy + +f :: forall p (r' :: RuntimeRep). (forall (r :: RuntimeRep). Int -> p r) -> p r'; f x = x 5 +g :: forall p. Int -> forall (r :: RuntimeRep). p r; g _ = undefined +g' :: Int -> forall p (r :: RuntimeRep). p r; g' _ = undefined +h :: Int -> forall (r :: RuntimeRep). TYPE r; h _ = undefined +i :: forall (r :: RuntimeRep). Int -> TYPE r; i _ = undefined +j :: forall p. Eq (p ('BoxedRep 'Lifted)) => Int -> forall (r :: RuntimeRep). p r; j _ = undefined +k :: forall p (r' :: RuntimeRep). Eq (p r') => (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) -> p r'; k x = x 5 +class C a where l :: forall (r :: RuntimeRep) (b :: TYPE r). a -> b +m :: (forall (m :: Multiplicity). Int %m -> Int) -> Int; m x = x 5 +n :: forall (m :: Multiplicity). Int %m -> Int; n a = a +o :: Maybe (forall (r :: RuntimeRep). Proxy r); o = Nothing +p :: (forall (r :: RuntimeRep). Proxy r, Int); p = undefined +q :: p (forall (r :: RuntimeRep). Proxy r); q = undefined +r :: forall (a :: (forall (r :: RuntimeRep). TYPE r)) (p :: (forall (r :: RuntimeRep). TYPE r) -> Type). p a; r = r + +:set -XNoLinearTypes + +:type f +:type g +:type g' +:type h +:type i +:type j +:type k +:type l +:type m +:type n +:type o +:type p +:type q +:type r + +:set -fprint-explicit-runtime-reps +:set -XLinearTypes +:type f +:type g +:type g' +:type h +:type i +:type j +:type k +:type l +:type m +:type n +:type o +:type p +:type q +:type r ===================================== testsuite/tests/ghci/scripts/T16468.stdout ===================================== @@ -0,0 +1,34 @@ +f :: (forall (r :: RuntimeRep). Int -> p r) -> p LiftedRep +g :: Int -> p LiftedRep +g' :: Int -> forall (p :: RuntimeRep -> *). p LiftedRep +h :: Int -> * +i :: Int -> * +j :: Eq (p LiftedRep) => Int -> p LiftedRep +k :: Eq (p LiftedRep) => + (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) -> p LiftedRep +l :: C a => a -> b +m :: (forall (m :: Multiplicity). Int %m -> Int) -> Int +n :: Int -> Int +o :: Maybe (forall (r :: RuntimeRep). Proxy r) +p :: (Proxy LiftedRep, Int) +q :: p (forall (r :: RuntimeRep). Proxy r) +r :: forall (a :: forall (r :: RuntimeRep). TYPE r) + (p :: (forall (r :: RuntimeRep). TYPE r) -> *). + p a +f :: (forall (r :: RuntimeRep). Int -> p r) -> p r' +g :: Int -> forall (r :: RuntimeRep). p r +g' :: Int -> forall (p :: RuntimeRep -> *) (r :: RuntimeRep). p r +h :: Int -> forall (r :: RuntimeRep). TYPE r +i :: Int -> TYPE r +j :: Eq (p LiftedRep) => Int -> forall (r :: RuntimeRep). p r +k :: Eq (p r') => + (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) -> p r' +l :: forall a (r :: RuntimeRep) (b :: TYPE r). C a => a -> b +m :: (forall (m :: Multiplicity). Int %m -> Int) -> Int +n :: Int %m -> Int +o :: Maybe (forall (r :: RuntimeRep). Proxy r) +p :: (forall (r :: RuntimeRep). Proxy r, Int) +q :: p (forall (r :: RuntimeRep). Proxy r) +r :: forall (a :: forall (r :: RuntimeRep). TYPE r) + (p :: (forall (r :: RuntimeRep). TYPE r) -> *). + p a ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -375,3 +375,4 @@ test('T22695', normal, ghci_script, ['T22695.script']) test('T22817', normal, ghci_script, ['T22817.script']) test('T22908', normal, ghci_script, ['T22908.script']) test('T23062', normal, ghci_script, ['T23062.script']) +test('T16468', normal, ghci_script, ['T16468.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5305ee3f1147fce7d4846341e4d9f19d055cba00 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5305ee3f1147fce7d4846341e4d9f19d055cba00 You're receiving 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 Jun 26 20:38:27 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 16:38:27 -0400 Subject: [Git][ghc/ghc][wip/romes/delete-configure-toolchain] configure: Rip out toolchain selection logic Message-ID: <6499f74354a59_2402e02f5be44141123@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/delete-configure-toolchain at Glasgow Haskell Compiler / GHC Commits: d97c967d by Ben Gamari at 2023-06-26T21:38:09+01:00 configure: Rip out toolchain selection logic - - - - - 30 changed files: - configure.ac - distrib/configure.ac.in - − m4/check_for_gold_t22266.m4 - − m4/check_ld_copy_bug.m4 - − m4/find_ld.m4 - − m4/find_merge_objects.m4 - m4/fp_cpp_cmd_with_args.m4 - − m4/fp_find_nm.m4 - − m4/fp_gcc_supports_no_pie.m4 - − m4/fp_gcc_supports_via_c_flags.m4 - − m4/fp_gcc_version.m4 - + m4/fp_hs_cpp_cmd_with_args.m4 - − m4/fp_prog_ar.m4 - − m4/fp_prog_ar_args.m4 - − m4/fp_prog_ar_is_gnu.m4 - − m4/fp_prog_ar_needs_ranlib.m4 - − m4/fp_prog_ar_supports_atfile.m4 - − m4/fp_prog_ar_supports_dash_l.m4 - − m4/fp_prog_ld_filelist.m4 - − m4/fp_prog_ld_flag.m4 - − m4/fp_prog_ld_is_gnu.m4 - − m4/fp_prog_ld_no_compact_unwind.m4 - m4/fp_settings.m4 - m4/fp_setup_windows_toolchain.m4 - m4/fptools_set_haskell_platform_vars.m4 - m4/fptools_set_platform_vars.m4 - − m4/get_arm_isa.m4 - − m4/ghc_adjustors_method.m4 - − m4/ghc_tables_next_to_code.m4 - + m4/ghc_toolchain.m4 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d97c967d36effd6810566bcf0eaedcc7f35a3e8d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d97c967d36effd6810566bcf0eaedcc7f35a3e8d You're receiving 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 Jun 26 20:39:27 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 16:39:27 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 11 commits: Create ghc_toolchain.m4 Message-ID: <6499f77f8a5fc_2402e0261deb814141e@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 592f643e by Rodrigo Mesquita at 2023-06-26T21:30:22+01:00 Create ghc_toolchain.m4 - - - - - 152f3e34 by Rodrigo Mesquita at 2023-06-26T21:38:42+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b4. Revert get_arm_isa deletion from 74f03f24 As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples - - - - - f8d3d881 by Rodrigo Mesquita at 2023-06-26T21:38:42+01:00 Stop configuring into settings unused Ld command - - - - - 2ed2955d by Rodrigo Mesquita at 2023-06-26T21:38:42+01:00 configure: Create and validate toolchain target file - - - - - 5a2c2c7c by Rodrigo Mesquita at 2023-06-26T21:38:42+01:00 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now - - - - - ed35ac2e by Rodrigo Mesquita at 2023-06-26T21:38:42+01:00 ghc-toolchain: set CC LD plat. dependent flags A lot to be said about this approach, we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? - - - - - 0d4f78e2 by Rodrigo Mesquita at 2023-06-26T21:38:43+01:00 ghc-toolchain: Create default.target in the bindist - - - - - 61d8b905 by Rodrigo Mesquita at 2023-06-26T21:38:43+01:00 A TODO comment - - - - - 7dc47169 by Rodrigo Mesquita at 2023-06-26T21:38:43+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - e792a3b3 by Rodrigo Mesquita at 2023-06-26T21:38:43+01:00 Use ghc-platform instead of ghc-boot del async dep - - - - - 9c150e9b by Rodrigo Mesquita at 2023-06-26T21:38:43+01:00 Fixes and Clean up history (remove all configure deletions too!) - - - - - 30 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/Static.hs - configure.ac - + default.target.in - distrib/configure.ac.in - ghc/Main.hs - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Test.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Cc.hs - hadrian/src/Settings/Builders/DeriveConstants.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/HsCpp.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4317aceec60ad4986181c10e71c79d46b15f49f6...9c150e9b3e90e22c3b9c76c7da04be500e30c55a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4317aceec60ad4986181c10e71c79d46b15f49f6...9c150e9b3e90e22c3b9c76c7da04be500e30c55a You're receiving 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 Jun 26 21:03:48 2023 From: gitlab at gitlab.haskell.org (Apoorv Ingle (@ani)) Date: Mon, 26 Jun 2023 17:03:48 -0400 Subject: [Git][ghc/ghc][wip/expand-do] add context of first do statement in addArgCtxt, somehow it goes missing Message-ID: <6499fd3439833_2402e02f5bc3c1457f5@gitlab.mail> Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC Commits: fb923fa2 by Apoorv Ingle at 2023-06-26T16:03:34-05:00 add context of first do statement in addArgCtxt, somehow it goes missing - - - - - 2 changed files: - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/Tc/Gen/App.hs Changes: ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -228,7 +228,10 @@ dsHsBind dflags b@(FunBind { fun_id = L loc fun = [id] | otherwise = [] - ; return (force_var, [core_binds]) } } + ; --pprTrace "dsHsBind" (vcat [ ppr fun <+> ppr (idInlinePragma fun) + -- , ppr (mg_alts matches) + -- , ppr args, ppr core_binds, ppr body']) $ + return (force_var, [core_binds]) } } dsHsBind dflags (PatBind { pat_lhs = pat, pat_rhs = grhss , pat_ext = (ty, (rhs_tick, var_ticks)) ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -554,7 +554,7 @@ tcInstFun do_ql inst_final (rn_fun, fun_ctxt) fun_sigma rn_args maybeSetCtxt :: HsExpr GhcRn -> TcM a -> TcM a maybeSetCtxt (XExpr (ExpandedStmt (HsExpanded stmt@(L loc _) _))) thing_inside - = do traceTc "tcInstFun" (text "set stmt ctxt" <+> ppr stmt) + = do traceTc "tcInstFun" (text "set stmt ctxt" <+> ppr stmt <+> ppr loc) setSrcSpanA loc $ addStmtCtxt stmt thing_inside maybeSetCtxt _ thing_inside = thing_inside @@ -738,6 +738,22 @@ addArgCtxt ctxt (L arg_loc arg) thing_inside -> do traceTc "addArgCtxt 2b" empty -- Skip setting "In the expression..." -- We have already set the context "In the stmt" thing_inside + VACall (XExpr (ExpandedStmt (HsExpanded stmt@(L loc _) _))) _ _ + -> do traceTc "addArgCtxt 2c" empty -- Set the context "In the stmt .." + setSrcSpanA loc $ + addStmtCtxt stmt $ + thing_inside + VAExpansion (HsDo _ _ (L _ ((stmt@(L loc _)) : _))) _ + -> do traceTc "addArgCtxt 2d" empty -- Set the context as the first statement of do block + setSrcSpanA loc $ + addStmtCtxt stmt $ + thing_inside + VAExpansion _ _ + -> do traceTc "addArgCtxt 2e" empty -- Skip setting "In the expression..." + -- as the arg will be an generated expanded stmt + -- setSrcSpan loc $ + -- addExprCtxt orig $ + thing_inside _ -> do traceTc "addArgCtxt 3" empty setSrcSpanA arg_loc $ addExprCtxt arg $ -- Auto-suppressed if arg_loc is generated View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fb923fa2cd34e2ba6525e7375fb613d819cf5758 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fb923fa2cd34e2ba6525e7375fb613d819cf5758 You're receiving 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 Jun 26 21:13:26 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 17:13:26 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 7 commits: Create ghc_toolchain.m4 Message-ID: <6499ff76628fb_2402e03515b28148715@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 0831c9cf by Rodrigo Mesquita at 2023-06-26T21:48:11+01:00 Create ghc_toolchain.m4 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now - - - - - 997db2c9 by Rodrigo Mesquita at 2023-06-26T22:08:33+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b4. Revert get_arm_isa deletion from 74f03f24 As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples A TODO comment - - - - - 87c676c8 by Rodrigo Mesquita at 2023-06-26T22:08:36+01:00 Stop configuring into settings unused Ld command - - - - - 4425ac21 by Rodrigo Mesquita at 2023-06-26T22:09:34+01:00 configure: Create and validate toolchain target file - - - - - 866a4c63 by Rodrigo Mesquita at 2023-06-26T22:13:06+01:00 ghc-toolchain: set CC LD plat. dependent flags A lot to be said about this approach, we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? - - - - - f54cf671 by Rodrigo Mesquita at 2023-06-26T22:13:11+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - ce4566e5 by Rodrigo Mesquita at 2023-06-26T22:13:11+01:00 Use ghc-platform instead of ghc-boot - - - - - 30 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/Static.hs - configure.ac - + default.target.in - distrib/configure.ac.in - ghc/Main.hs - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Test.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Cc.hs - hadrian/src/Settings/Builders/DeriveConstants.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/HsCpp.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9c150e9b3e90e22c3b9c76c7da04be500e30c55a...ce4566e51239a15a0df67d8de79ad0e37bf7af7f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9c150e9b3e90e22c3b9c76c7da04be500e30c55a...ce4566e51239a15a0df67d8de79ad0e37bf7af7f You're receiving 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 Jun 26 21:18:34 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 26 Jun 2023 17:18:34 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] 3 commits: Add support for deprecating exported items (proposal #134) Message-ID: <649a00aae2e25_2402e0372d0f0149234@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: 95152283 by Ben Gamari at 2023-06-21T12:04:59-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - cc2f3ecf by Ben Gamari at 2023-06-21T12:04:59-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 1b541c1f by Ben Gamari at 2023-06-26T17:18:25-04:00 base: Bump version to 4.19 Updates all boot library submodules. - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Utils/Backpack.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Error/Codes.hs - compiler/GHC/Types/Hint/Ppr.hs - compiler/GHC/Types/Name/Env.hs - compiler/GHC/Types/Name/Reader.hs - compiler/GHC/Unit/Module/ModIface.hs - compiler/GHC/Unit/Module/Warnings.hs - compiler/ghc.cabal.in The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c18658545ce45254a4679c13de5dcc56a4c8373f...1b541c1f4f270347cc8843558515e6fe9cb631a9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c18658545ce45254a4679c13de5dcc56a4c8373f...1b541c1f4f270347cc8843558515e6fe9cb631a9 You're receiving 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 Jun 26 21:19:11 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 17:19:11 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 10 commits: Stop configuring into settings unused Ld command Message-ID: <649a00cf3bff_2402e02f5bc3c149411@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 9ee6d789 by Rodrigo Mesquita at 2023-06-26T22:16:11+01:00 Stop configuring into settings unused Ld command - - - - - cf389a6d by Rodrigo Mesquita at 2023-06-26T22:16:11+01:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 625ad17c by Ben Gamari at 2023-06-26T22:16:11+01:00 ghc-toolchain: Initial commit - - - - - 99752b0c by Ben Gamari at 2023-06-26T22:16:11+01:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC. As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Co-author: Rodrigo Mesquita (@alt-romes) - - - - - c84b6ab9 by Rodrigo Mesquita at 2023-06-26T22:16:11+01:00 Create ghc_toolchain.m4 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now - - - - - eba07800 by Rodrigo Mesquita at 2023-06-26T22:18:32+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b4. Revert get_arm_isa deletion from 74f03f24 As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples A TODO comment - - - - - 60e19d57 by Rodrigo Mesquita at 2023-06-26T22:18:46+01:00 configure: Create and validate toolchain target file - - - - - b2d1c0ee by Rodrigo Mesquita at 2023-06-26T22:18:46+01:00 ghc-toolchain: set CC LD plat. dependent flags A lot to be said about this approach, we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? - - - - - 5d5b7a45 by Rodrigo Mesquita at 2023-06-26T22:18:46+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - 81ff5187 by Rodrigo Mesquita at 2023-06-26T22:18:46+01:00 Use ghc-platform instead of ghc-boot - - - - - 30 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools.hs - − compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - compiler/ghc.cabal.in - configure.ac - + default.target.in - distrib/configure.ac.in - ghc/Main.hs - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ce4566e51239a15a0df67d8de79ad0e37bf7af7f...81ff5187eee4aad09067c721c26763c010b49999 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ce4566e51239a15a0df67d8de79ad0e37bf7af7f...81ff5187eee4aad09067c721c26763c010b49999 You're receiving 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 Jun 26 21:19:57 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 17:19:57 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 8 commits: Rip out runtime linker/compiler checks Message-ID: <649a00fd695cd_2402e02d7e1d01517d8@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 0736ae45 by Ben Gamari at 2023-06-26T22:19:45+01:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC. As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8d6817c3 by Ben Gamari at 2023-06-26T22:19:45+01:00 ghc-toolchain: Initial commit - - - - - 215846d8 by Rodrigo Mesquita at 2023-06-26T22:19:45+01:00 Create ghc_toolchain.m4 Don't pass options to ghc-toolchain, it should arrive at the same conclusion as configure for now - - - - - 762496f7 by Rodrigo Mesquita at 2023-06-26T22:19:45+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b4. Revert get_arm_isa deletion from 74f03f24 As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples A TODO comment - - - - - 859648ed by Rodrigo Mesquita at 2023-06-26T22:19:45+01:00 configure: Create and validate toolchain target file - - - - - 1429c290 by Rodrigo Mesquita at 2023-06-26T22:19:45+01:00 ghc-toolchain: set CC LD plat. dependent flags A lot to be said about this approach, we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? - - - - - 702c2cf3 by Rodrigo Mesquita at 2023-06-26T22:19:45+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - 90e11458 by Rodrigo Mesquita at 2023-06-26T22:19:45+01:00 Use ghc-platform instead of ghc-boot - - - - - 30 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/SysTools.hs - − compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - compiler/ghc.cabal.in - configure.ac - + default.target.in - distrib/configure.ac.in - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Test.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/81ff5187eee4aad09067c721c26763c010b49999...90e11458518dbd6ff81c5680276f3c9c318325de -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/81ff5187eee4aad09067c721c26763c010b49999...90e11458518dbd6ff81c5680276f3c9c318325de You're receiving 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 Jun 26 21:25:27 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 26 Jun 2023 17:25:27 -0400 Subject: [Git][ghc/ghc][wip/tsan/no-barriers] 13 commits: Support large stack frames/offsets in GHCi bytecode interpreter Message-ID: <649a0247a3562_2402e07b199801556a9@gitlab.mail> Ben Gamari pushed to branch wip/tsan/no-barriers at Glasgow Haskell Compiler / GHC Commits: 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - 24efa3bc by Ben Gamari at 2023-06-26T17:25:13-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - 93e3b89a by Ben Gamari at 2023-06-26T17:25:13-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 76305a5c by Ben Gamari at 2023-06-26T17:25:13-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - f750d138 by Ben Gamari at 2023-06-26T17:25:13-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 90dabd2e by Ben Gamari at 2023-06-26T17:25:21-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 8c7fa772 by Sven Tennie at 2023-06-26T17:25:22-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a8a2008 by Ben Gamari at 2023-06-26T17:25:22-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 35999b16 by Sven Tennie at 2023-06-26T17:25:22-04:00 Delete write_barrier function - - - - - 30 changed files: - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - compiler/GHC/Builtin/Types.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Stg/Syntax.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/ArgRep.hs - compiler/GHC/StgToCmm/Lit.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/StgToJS/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c798dde6efd96c797a184d2e84ff03769463b791...35999b161f48f072a7b9e4b7f34a387145eb5263 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c798dde6efd96c797a184d2e84ff03769463b791...35999b161f48f072a7b9e4b7f34a387145eb5263 You're receiving 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 Jun 26 21:28:23 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Mon, 26 Jun 2023 17:28:23 -0400 Subject: [Git][ghc/ghc][wip/less-defaulting] 37 commits: Avoid desugaring non-recursive lets into recursive lets Message-ID: <649a02f793357_2402e07b199801583f6@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/less-defaulting at Glasgow Haskell Compiler / GHC Commits: 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - dbc253e6 by Krzysztof Gogolewski at 2023-06-26T23:27:44+02:00 Change the defaulting rules in commitFlexi - Multiplicity isn't special, default to Any - RuntimeRep and Levity are special only when concrete - - - - - 7da09819 by Krzysztof Gogolewski at 2023-06-26T23:27:44+02:00 Workaround 23380 Without it, fails on f :: Bool -> Bool f x = case x of True -> True a -> a - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Env.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1d8bf940d135737acf4d030a8b746221a2a5cbbb...7da098191b661cb9385e297bf49fdc348f8f4b22 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1d8bf940d135737acf4d030a8b746221a2a5cbbb...7da098191b661cb9385e297bf49fdc348f8f4b22 You're receiving 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 Jun 26 21:38:35 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Mon, 26 Jun 2023 17:38:35 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 4 commits: ghc-toolchain: Toolchain Selection Message-ID: <649a055bcf87e_2402e0c74e81587c0@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 7dc3ae9f by Rodrigo Mesquita at 2023-06-26T22:37:10+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b4. Revert get_arm_isa deletion from 74f03f24 As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples A TODO comment ghc-toolchain: set CC LD plat. dependent flags A lot to be said about the approach of configuring linker flags (what used to be SET CC LD platform dependent flags in configure), we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? Move osElfTarget from GHC.Platform to GHC.Platform.ArchOS, to use it in Toolchain.Tools.Link to correctly determine if -Wl,--no-as-needed is required - - - - - 86bbd3ec by Rodrigo Mesquita at 2023-06-26T22:38:14+01:00 configure: Create and validate toolchain target file - - - - - 422fb6dc by Rodrigo Mesquita at 2023-06-26T22:38:14+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - caa3aa7a by Rodrigo Mesquita at 2023-06-26T22:38:14+01:00 Use ghc-platform instead of ghc-boot - - - - - 30 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - configure.ac - + default.target.in - distrib/configure.ac.in - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Test.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Cc.hs - hadrian/src/Settings/Builders/DeriveConstants.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/HsCpp.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/90e11458518dbd6ff81c5680276f3c9c318325de...caa3aa7a0c4a93ac0a330386ea88e2eaf48968ac -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/90e11458518dbd6ff81c5680276f3c9c318325de...caa3aa7a0c4a93ac0a330386ea88e2eaf48968ac You're receiving 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 Jun 26 21:46:25 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Mon, 26 Jun 2023 17:46:25 -0400 Subject: [Git][ghc/ghc][wip/tsan/fixes-2] 2 commits: warnings Message-ID: <649a0731dd22_2402e02d7e1d016079a@gitlab.mail> Ben Gamari pushed to branch wip/tsan/fixes-2 at Glasgow Haskell Compiler / GHC Commits: e8030d79 by Ben Gamari at 2023-06-26T17:45:50-04:00 warnings - - - - - 757ac787 by Ben Gamari at 2023-06-26T17:46:02-04:00 rts: Fixes profiling timer races - - - - - 4 changed files: - rts/Proftimer.c - rts/Schedule.c - rts/include/stg/SMP.h - rts/sm/GC.c Changes: ===================================== rts/Proftimer.c ===================================== @@ -101,7 +101,7 @@ requestHeapCensus( void ){ void initProfTimer( void ) { - performHeapProfile = false; + RELAXED_STORE_ALWAYS(&performHeapProfile = false); ticks_to_heap_profile = RtsFlags.ProfFlags.heapProfileIntervalTicks; @@ -136,7 +136,7 @@ handleProfTick(void) ticks_to_ticky_sample--; if (ticks_to_ticky_sample <= 0) { ticks_to_ticky_sample = RtsFlags.ProfFlags.heapProfileIntervalTicks; - performTickySample = true; + RELAXED_STORE_ALWAYS(&performTickySample, true); } } #endif @@ -145,7 +145,7 @@ handleProfTick(void) ticks_to_heap_profile--; if (ticks_to_heap_profile <= 0) { ticks_to_heap_profile = RtsFlags.ProfFlags.heapProfileIntervalTicks; - performHeapProfile = true; + RELAXED_STORE_ALWAYS(&performHeapProfile, true); } } } ===================================== rts/Schedule.c ===================================== @@ -1382,7 +1382,7 @@ scheduleNeedHeapProfile( bool ready_to_gc ) { // When we have +RTS -i0 and we're heap profiling, do a census at // every GC. This lets us get repeatable runs for debugging. - if (performHeapProfile || + if (RELAXED_LOAD(&performHeapProfile) || (RtsFlags.ProfFlags.heapProfileInterval==0 && RtsFlags.ProfFlags.doHeapProfile && ready_to_gc)) { return true; @@ -1943,7 +1943,7 @@ delete_threads_and_gc: // The heap census itself is done during GarbageCollect(). if (heap_census) { - performHeapProfile = false; + RELAXED_STORE(&performHeapProfile, false); } #if defined(THREADED_RTS) ===================================== rts/include/stg/SMP.h ===================================== @@ -585,9 +585,12 @@ busy_wait_nop(void) #define ACQUIRE_FENCE() __atomic_thread_fence(__ATOMIC_ACQUIRE) #define RELEASE_FENCE() __atomic_thread_fence(__ATOMIC_RELEASE) -#define SEQ_CST_FENCE() NO_WARN(-Wtsan, __atomic_thread_fence(__ATOMIC_SEQ_CST);) +#define SEQ_CST_FENCE() __atomic_thread_fence(__ATOMIC_SEQ_CST) #if defined(TSAN_ENABLED) +#define ACQUIRE_FENCE() NO_WARN(-Wtsan, __atomic_thread_fence(__ATOMIC_ACQUIRE);) +#define RELEASE_FENCE() NO_WARN(-Wtsan, __atomic_thread_fence(__ATOMIC_RELEASE);) +#define SEQ_CST_FENCE() NO_WARN(-Wtsan, __atomic_thread_fence(__ATOMIC_SEQ_CST);) #define ACQUIRE_FENCE_ON(x) (void)ACQUIRE_LOAD(x) #else #define ACQUIRE_FENCE_ON(x) __atomic_thread_fence(__ATOMIC_ACQUIRE) ===================================== rts/sm/GC.c ===================================== @@ -977,9 +977,9 @@ GarbageCollect (struct GcConfig config, // Post ticky counter sample. // We do this at the end of execution since tickers are registered in the // course of program execution. - if (performTickySample) { + if (RELAXED_LOAD(&performTickySample)) { emitTickyCounterSamples(); - performTickySample = false; + RELAXED_STORE(&performTickySample, false); } #endif View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1b868666f1213f74badd3ebbb323ab126f3f44d3...757ac787b39c30cb97e6cd28e3231909bd146adf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1b868666f1213f74badd3ebbb323ab126f3f44d3...757ac787b39c30cb97e6cd28e3231909bd146adf You're receiving 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 Jun 26 22:29:06 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Mon, 26 Jun 2023 18:29:06 -0400 Subject: [Git][ghc/ghc][wip/az/locateda-epa-improve-2023-03-27] 346 commits: JS: Fix h$base_access implementation (issue 22576) Message-ID: <649a11329ea_2402e0261deb816435b@gitlab.mail> Alan Zimmerman pushed to branch wip/az/locateda-epa-improve-2023-03-27 at Glasgow Haskell Compiler / GHC Commits: 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04: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. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04: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> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+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. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 3fab1d38 by Alan Zimmerman at 2023-06-25T13:06:43+01:00 Put BufSpan into RealSrcSpan This has been superseded by !9473, which moved BufSpan into EpaSpan in EpaLocation Start on making LocatedN more direct Using EpaLocation instead of Anchor Via a synonym initially, to prove the concept Variants of AnnSortKey For future, just a list of which type comes next. Example for ValBinds EPA: Explicitly capture EOF Location in AnnsModule And also get rid of EpaEofComment. - - - - - e19878c7 by Alan Zimmerman at 2023-06-25T13:07:59+01:00 [EPA] Simplify noAnnSrcSpanDP0 - - - - - 63f324ae by Alan Zimmerman at 2023-06-25T13:08:02+01:00 EPA: Provide correct annotation span for ImportDecl Use the whole declaration, rather than just the span of the 'import' keyword. - - - - - 3f2ced80 by Alan Zimmerman at 2023-06-25T13:08:02+01:00 EPA: Fix span for GRHS - - - - - 5b89cf45 by Alan Zimmerman at 2023-06-25T13:08:02+01:00 EPA: Fix span for Located Context - - - - - f40a9e4a by Alan Zimmerman at 2023-06-25T13:08:02+01:00 EPA: Widen anchor when adding a trailingAnn - - - - - 7f17454f by Alan Zimmerman at 2023-06-25T13:08:02+01:00 EPA: widen more TrailingAnn usages - - - - - 4e04df42 by Alan Zimmerman at 2023-06-25T13:08:02+01:00 EPA: Capture full range for a CaseAlt Match - - - - - f503edf8 by Alan Zimmerman at 2023-06-25T13:08:02+01:00 Clean up addTrailingCommaN Remove unused parameter - - - - - eb2f6b57 by Alan Zimmerman at 2023-06-25T13:08:02+01:00 WIP - - - - - 383cbdfe by Alan Zimmerman at 2023-06-26T19:03:50+01:00 Fixup after rebase - - - - - addc2a14 by Alan Zimmerman at 2023-06-26T23:28:04+01:00 [EPA] Introduce HasTrailing in ExactPrint Just plumbed through, not being used yet - - - - - 26 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - .gitlab/rel_eng/upload_ghc_libs.py - CODEOWNERS - HACKING.md - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a13e2b7f192edbac6e28074a323b7dd84b3fc9f6...addc2a14cb442bd9b9a00274c9d6547653d18b96 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a13e2b7f192edbac6e28074a323b7dd84b3fc9f6...addc2a14cb442bd9b9a00274c9d6547653d18b96 You're receiving 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 Jun 26 23:08:34 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Mon, 26 Jun 2023 19:08:34 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's Message-ID: <649a1a7295d3f_2402e084dff781716a8@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 92861772 by Greg Steuck at 2023-06-26T19:08:30-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e2cc89be by Torsten Schmits at 2023-06-26T19:08:30-04:00 Remove duplicate link label in linear types docs - - - - - 3 changed files: - configure.ac - distrib/configure.ac.in - docs/users_guide/exts/linear_types.rst Changes: ===================================== configure.ac ===================================== @@ -487,7 +487,6 @@ CFLAGS="$CFLAGS $GccUseLdOpt" AC_SUBST([LdCmd]) FP_PROG_LD_IS_GNU -FP_PROG_LD_BUILD_ID FP_PROG_LD_NO_COMPACT_UNWIND FP_PROG_LD_FILELIST ===================================== distrib/configure.ac.in ===================================== @@ -130,7 +130,6 @@ CFLAGS="$CFLAGS $GccUseLdOpt" AC_SUBST([LdCmd]) FP_PROG_LD_IS_GNU -FP_PROG_LD_BUILD_ID FP_PROG_LD_NO_COMPACT_UNWIND FP_PROG_LD_FILELIST ===================================== docs/users_guide/exts/linear_types.rst ===================================== @@ -14,7 +14,7 @@ Linear types warts, and bad error messages; everything down to the syntax is subject to change**. See, in particular, :ref:`linear-types-limitations` below. We encourage you to experiment -with this extension and report issues in the GHC bug tracker `the GHC +with this extension and report issues in `the GHC bug tracker `__, adding the tag ``LinearTypes``. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5c050e68110c9a2b706c66dead860156778e56f6...e2cc89bea091028db32fecaa2707ffd36824c599 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5c050e68110c9a2b706c66dead860156778e56f6...e2cc89bea091028db32fecaa2707ffd36824c599 You're receiving 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 Jun 27 05:19:52 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 27 Jun 2023 01:19:52 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Propagate breakpoint information when inlining across modules Message-ID: <649a71789d13d_2402e02d7e1d01964eb@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 0b7a239f by Greg Steuck at 2023-06-27T01:19:48-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - 371541b3 by Torsten Schmits at 2023-06-27T01:19:48-04:00 Remove duplicate link label in linear types docs - - - - - 30 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/HsToCore/Breakpoints.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Stg/BcPrep.hs - compiler/GHC/Stg/FVs.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/Types/Tickish.hs - configure.ac The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e2cc89bea091028db32fecaa2707ffd36824c599...371541b35cb8b625aef0cc67c82940f124e335c5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e2cc89bea091028db32fecaa2707ffd36824c599...371541b35cb8b625aef0cc67c82940f124e335c5 You're receiving 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 Jun 27 08:10:22 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 27 Jun 2023 04:10:22 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's Message-ID: <649a996eaa14e_2402e0c74e823013c@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 9d854d9a by Greg Steuck at 2023-06-27T04:10:19-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - f46f93d4 by Torsten Schmits at 2023-06-27T04:10:20-04:00 Remove duplicate link label in linear types docs - - - - - 3 changed files: - configure.ac - distrib/configure.ac.in - docs/users_guide/exts/linear_types.rst Changes: ===================================== configure.ac ===================================== @@ -487,7 +487,6 @@ CFLAGS="$CFLAGS $GccUseLdOpt" AC_SUBST([LdCmd]) FP_PROG_LD_IS_GNU -FP_PROG_LD_BUILD_ID FP_PROG_LD_NO_COMPACT_UNWIND FP_PROG_LD_FILELIST ===================================== distrib/configure.ac.in ===================================== @@ -130,7 +130,6 @@ CFLAGS="$CFLAGS $GccUseLdOpt" AC_SUBST([LdCmd]) FP_PROG_LD_IS_GNU -FP_PROG_LD_BUILD_ID FP_PROG_LD_NO_COMPACT_UNWIND FP_PROG_LD_FILELIST ===================================== docs/users_guide/exts/linear_types.rst ===================================== @@ -14,7 +14,7 @@ Linear types warts, and bad error messages; everything down to the syntax is subject to change**. See, in particular, :ref:`linear-types-limitations` below. We encourage you to experiment -with this extension and report issues in the GHC bug tracker `the GHC +with this extension and report issues in `the GHC bug tracker `__, adding the tag ``LinearTypes``. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/371541b35cb8b625aef0cc67c82940f124e335c5...f46f93d4c2e41da9e8ac525f2a3f327623012b8f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/371541b35cb8b625aef0cc67c82940f124e335c5...f46f93d4c2e41da9e8ac525f2a3f327623012b8f You're receiving 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 Jun 27 09:44:20 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 27 Jun 2023 05:44:20 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 4 commits: ghc-toolchain: Toolchain Selection Message-ID: <649aaf7483a0e_2402e0261deb8254842@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: f353cb8b by Rodrigo Mesquita at 2023-06-27T10:41:39+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b4. Revert get_arm_isa deletion from 74f03f24 As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples A TODO comment ghc-toolchain: set CC LD plat. dependent flags A lot to be said about the approach of configuring linker flags (what used to be SET CC LD platform dependent flags in configure), we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? Move osElfTarget from GHC.Platform to GHC.Platform.ArchOS, to use it in Toolchain.Tools.Link to correctly determine if -Wl,--no-as-needed is required - - - - - 040ef04b by Rodrigo Mesquita at 2023-06-27T10:41:39+01:00 configure: Create and validate toolchain target file - - - - - 9ea6c677 by Rodrigo Mesquita at 2023-06-27T10:41:39+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - 39060908 by Rodrigo Mesquita at 2023-06-27T10:41:39+01:00 Use ghc-platform instead of ghc-boot - - - - - 30 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - configure.ac - + default.target.in - distrib/configure.ac.in - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Test.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Cc.hs - hadrian/src/Settings/Builders/DeriveConstants.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/HsCpp.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/caa3aa7a0c4a93ac0a330386ea88e2eaf48968ac...39060908a77fd8cb971571fb53c1c0e67dd73482 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/caa3aa7a0c4a93ac0a330386ea88e2eaf48968ac...39060908a77fd8cb971571fb53c1c0e67dd73482 You're receiving 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 Jun 27 10:06:52 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Tue, 27 Jun 2023 06:06:52 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/DIB-INSTANCES] 6 commits: Support large stack frames/offsets in GHCi bytecode interpreter Message-ID: <649ab4bceb903_2402e02d7e1d026441e@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/DIB-INSTANCES at Glasgow Haskell Compiler / GHC Commits: 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - ac542d9f by Andrei Borzenkov at 2023-06-27T14:06:43+04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 30 changed files: - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - compiler/GHC/Builtin/Types.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Stg/Syntax.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/ArgRep.hs - compiler/GHC/StgToCmm/Lit.hs - compiler/GHC/StgToJS/Apply.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/Rts/Rts.hs - compiler/GHC/StgToJS/Types.hs - compiler/GHC/StgToJS/Utils.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Types/Basic.hs - compiler/GHC/Types/RepType.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - libraries/template-haskell/changelog.md - rts/Disassembler.c - rts/Interpreter.c - rts/js/rts.js The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e8532729f8f77fd99863715c26e9846865a96c30...ac542d9f77867a5b50b5abc40faa6dba1eb9f8f8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e8532729f8f77fd99863715c26e9846865a96c30...ac542d9f77867a5b50b5abc40faa6dba1eb9f8f8 You're receiving 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 Jun 27 11:17:09 2023 From: gitlab at gitlab.haskell.org (Bryan R (@chreekat)) Date: Tue, 27 Jun 2023 07:17:09 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/bashed Message-ID: <649ac535939d1_2402e084dff78297166@gitlab.mail> Bryan R pushed new branch wip/bashed at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/bashed You're receiving 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 Jun 27 11:21:17 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 27 Jun 2023 07:21:17 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's Message-ID: <649ac62dd72d3_2402e07b199803005e3@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 364868c5 by Greg Steuck at 2023-06-27T07:21:09-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - ff62c374 by Torsten Schmits at 2023-06-27T07:21:10-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 931860b8 by Torsten Schmits at 2023-06-27T07:21:10-04:00 Remove duplicate link label in linear types docs - - - - - 8 changed files: - compiler/GHC/Iface/Type.hs - compiler/GHC/Types/Unique/DFM.hs - configure.ac - distrib/configure.ac.in - docs/users_guide/exts/linear_types.rst - + testsuite/tests/ghci/scripts/T16468.script - + testsuite/tests/ghci/scripts/T16468.stdout - testsuite/tests/ghci/scripts/all.T Changes: ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -821,7 +821,7 @@ pprIfaceLamBndr (b, IfaceNoOneShot) = ppr b pprIfaceLamBndr (b, IfaceOneShot) = ppr b <> text "[OneShot]" pprIfaceIdBndr :: IfaceIdBndr -> SDoc -pprIfaceIdBndr (w, name, ty) = parens (ppr name <> brackets (ppr w) <+> dcolon <+> ppr ty) +pprIfaceIdBndr (w, name, ty) = parens (ppr name <> brackets (ppr_ty_nested w) <+> dcolon <+> ppr_ty_nested ty) {- Note [Suppressing binder signatures] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -881,7 +881,7 @@ pprIfaceTvBndr :: IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc pprIfaceTvBndr (tv, ki) (SuppressBndrSig suppress_sig) (UseBndrParens use_parens) | suppress_sig = ppr tv | isIfaceLiftedTypeKind ki = ppr tv - | otherwise = maybe_parens (ppr tv <+> dcolon <+> ppr ki) + | otherwise = maybe_parens (ppr tv <+> dcolon <+> ppr_ty_nested ki) where maybe_parens | use_parens = parens | otherwise = id @@ -933,9 +933,13 @@ instance Binary IfaceOneShot where instance Outputable IfaceType where ppr ty = pprIfaceType ty -pprIfaceType, pprParendIfaceType :: IfaceType -> SDoc +-- The purpose of 'ppr_ty_nested' is to distinguish calls that should not +-- trigger 'hideNonStandardTypes', see Note [Defaulting RuntimeRep variables] +-- wrinkle (W2). +pprIfaceType, pprParendIfaceType, ppr_ty_nested :: IfaceType -> SDoc pprIfaceType = pprPrecIfaceType topPrec pprParendIfaceType = pprPrecIfaceType appPrec +ppr_ty_nested = ppr_ty topPrec pprPrecIfaceType :: PprPrec -> IfaceType -> SDoc -- We still need `hideNonStandardTypes`, since the `pprPrecIfaceType` may be @@ -987,7 +991,7 @@ ppr_ty ctxt_prec ty@(IfaceFunTy af w ty1 ty2) -- Should be a visible argument | isVisibleFunArg af = (pprTypeArrow af wthis <+> ppr_ty funPrec ty1) : ppr_fun_tail wnext ty2 ppr_fun_tail wthis other_ty - = [pprTypeArrow af wthis <+> pprIfaceType other_ty] + = [pprTypeArrow af wthis <+> ppr_ty_nested other_ty] ppr_ty ctxt_prec (IfaceAppTy t ts) = if_print_coercions @@ -1044,9 +1048,11 @@ Haskell programs, so it makes little sense to make all users pay this syntactic overhead. For this reason it was decided that we would hide RuntimeRep variables -for now (see #11549). We do this by defaulting all type variables of -kind RuntimeRep to LiftedRep. -Likewise, we default all Multiplicity variables to Many. +for now (see #11549). We do this right in the pretty-printer, by pre-processing +the type we are about to print, to default any type variables of kind RuntimeRep +that are bound by toplevel invisible quantification to LiftedRep. +Likewise, we default Multiplicity variables to Many and Levity variables to +Lifted. This is done in a pass right before pretty-printing (defaultIfaceTyVarsOfKind, controlled by @@ -1073,6 +1079,32 @@ metavariables are converted, skolem variables are not. There's one exception though: TyVarTv metavariables should not be defaulted, as they appear during kind-checking of "newtype T :: TYPE r where..." (test T18357a). Therefore, we additionally test for isTyConableTyVar. + +Wrinkles: + +(W1) The loop 'go' in 'defaultIfaceTyVarsOfKind' passes a Bool flag, 'rank1', + around that indicates whether we haven't yet descended into the arguments + of a function type. + This is used to decide whether newly bound variables are eligible for + defaulting – we do not want contravariant foralls to be defaulted because + that would result in an incorrect, rather than specialized, type. + For example: + ∀ p (r1 :: RuntimeRep) . (∀ (r2 :: RuntimeRep) . p r2) -> p r1 + We want to default 'r1', but not 'r2'. + When examining the first forall, 'rank1' is True. + The toplevel function type is matched as IfaceFunTy, where we recurse into + 'go' by passing False for 'rank1'. + The forall in the first argument then skips adding a substitution for 'r2'. + +(W2) 'defaultIfaceTyVarsOfKind' ought to be called only once when printing a + type. + A few components of the printing machinery used to invoke 'ppr' on types + nested in secondary structures like IfaceBndr, which would repeat the + defaulting process, but treating the type as if it were top-level, causing + unwanted defaulting. + In order to prevent future developers from using 'ppr' again or being + confused that @ppr_ty topPrec@ is used, we introduced a marker function, + 'ppr_ty_nested'. -} -- | Default 'RuntimeRep' variables to 'LiftedRep', @@ -1097,28 +1129,29 @@ as they appear during kind-checking of "newtype T :: TYPE r where..." defaultIfaceTyVarsOfKind :: Bool -- ^ default 'RuntimeRep'/'Levity' variables? -> Bool -- ^ default 'Multiplicity' variables? -> IfaceType -> IfaceType -defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv ty +defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv True ty where go :: FastStringEnv IfaceType -- Set of enclosing forall-ed RuntimeRep/Levity/Multiplicity variables + -> Bool -- Are we in a toplevel forall, where defaulting is allowed? -> IfaceType -> IfaceType - go subs (IfaceForAllTy (Bndr (IfaceTvBndr (var, var_kind)) argf) ty) + go subs True (IfaceForAllTy (Bndr (IfaceTvBndr (var, var_kind)) argf) ty) | isInvisibleForAllTyFlag argf -- Don't default *visible* quantification -- or we get the mess in #13963 , Just substituted_ty <- check_substitution var_kind = let subs' = extendFsEnv subs var substituted_ty -- Record that we should replace it with LiftedRep/Lifted/Many, -- and recurse, discarding the forall - in go subs' ty + in go subs' True ty - go subs (IfaceForAllTy bndr ty) - = IfaceForAllTy (go_ifacebndr subs bndr) (go subs ty) + go subs rank1 (IfaceForAllTy bndr ty) + = IfaceForAllTy (go_ifacebndr subs bndr) (go subs rank1 ty) - go subs ty@(IfaceTyVar tv) = case lookupFsEnv subs tv of + go subs _ ty@(IfaceTyVar tv) = case lookupFsEnv subs tv of Just s -> s Nothing -> ty - go _ ty@(IfaceFreeTyVar tv) + go _ _ ty@(IfaceFreeTyVar tv) -- See Note [Defaulting RuntimeRep variables], about free vars | def_rep , GHC.Core.Type.isRuntimeRepTy (tyVarKind tv) @@ -1138,34 +1171,34 @@ defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv ty | otherwise = ty - go subs (IfaceTyConApp tc tc_args) + go subs _ (IfaceTyConApp tc tc_args) = IfaceTyConApp tc (go_args subs tc_args) - go subs (IfaceTupleTy sort is_prom tc_args) + go subs _ (IfaceTupleTy sort is_prom tc_args) = IfaceTupleTy sort is_prom (go_args subs tc_args) - go subs (IfaceFunTy af w arg res) - = IfaceFunTy af (go subs w) (go subs arg) (go subs res) + go subs rank1 (IfaceFunTy af w arg res) + = IfaceFunTy af (go subs False w) (go subs False arg) (go subs rank1 res) - go subs (IfaceAppTy t ts) - = IfaceAppTy (go subs t) (go_args subs ts) + go subs _ (IfaceAppTy t ts) + = IfaceAppTy (go subs False t) (go_args subs ts) - go subs (IfaceCastTy x co) - = IfaceCastTy (go subs x) co + go subs rank1 (IfaceCastTy x co) + = IfaceCastTy (go subs rank1 x) co - go _ ty@(IfaceLitTy {}) = ty - go _ ty@(IfaceCoercionTy {}) = ty + go _ _ ty@(IfaceLitTy {}) = ty + go _ _ ty@(IfaceCoercionTy {}) = ty go_ifacebndr :: FastStringEnv IfaceType -> IfaceForAllBndr -> IfaceForAllBndr go_ifacebndr subs (Bndr (IfaceIdBndr (w, n, t)) argf) - = Bndr (IfaceIdBndr (w, n, go subs t)) argf + = Bndr (IfaceIdBndr (w, n, go subs False t)) argf go_ifacebndr subs (Bndr (IfaceTvBndr (n, t)) argf) - = Bndr (IfaceTvBndr (n, go subs t)) argf + = Bndr (IfaceTvBndr (n, go subs False t)) argf go_args :: FastStringEnv IfaceType -> IfaceAppArgs -> IfaceAppArgs go_args _ IA_Nil = IA_Nil go_args subs (IA_Arg ty argf args) - = IA_Arg (go subs ty) argf (go_args subs args) + = IA_Arg (go subs False ty) argf (go_args subs args) check_substitution :: IfaceType -> Maybe IfaceType check_substitution (IfaceTyConApp tc _) @@ -1236,7 +1269,7 @@ ppr_app_arg ctx_prec (t, argf) = Specified | print_kinds -> char '@' <> ppr_ty appPrec t Inferred | print_kinds - -> char '@' <> braces (ppr_ty topPrec t) + -> char '@' <> braces (ppr_ty_nested t) _ -> empty ------------------- @@ -1367,7 +1400,7 @@ ppr_sigma show_forall ctxt_prec iface_ty -- Then it could handle both invisible and required binders, and -- splitIfaceReqForallTy wouldn't be necessary here. in ppr_iface_forall_part show_forall invis_tvs theta $ - sep [pprIfaceForAll req_tvs, ppr tau'] + sep [pprIfaceForAll req_tvs, ppr_ty_nested tau'] pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc pprUserIfaceForAll tvs ===================================== compiler/GHC/Types/Unique/DFM.hs ===================================== @@ -94,7 +94,7 @@ import qualified Data.IntSet as I -- order then `udfmToList` returns them in deterministic order. -- -- There is an implementation cost: each element is given a serial number --- as it is added, and `udfmToList` sorts it's result by this serial +-- as it is added, and `udfmToList` sorts its result by this serial -- number. So you should only use `UniqDFM` if you need the deterministic -- property. -- ===================================== configure.ac ===================================== @@ -487,7 +487,6 @@ CFLAGS="$CFLAGS $GccUseLdOpt" AC_SUBST([LdCmd]) FP_PROG_LD_IS_GNU -FP_PROG_LD_BUILD_ID FP_PROG_LD_NO_COMPACT_UNWIND FP_PROG_LD_FILELIST ===================================== distrib/configure.ac.in ===================================== @@ -130,7 +130,6 @@ CFLAGS="$CFLAGS $GccUseLdOpt" AC_SUBST([LdCmd]) FP_PROG_LD_IS_GNU -FP_PROG_LD_BUILD_ID FP_PROG_LD_NO_COMPACT_UNWIND FP_PROG_LD_FILELIST ===================================== docs/users_guide/exts/linear_types.rst ===================================== @@ -14,7 +14,7 @@ Linear types warts, and bad error messages; everything down to the syntax is subject to change**. See, in particular, :ref:`linear-types-limitations` below. We encourage you to experiment -with this extension and report issues in the GHC bug tracker `the GHC +with this extension and report issues in `the GHC bug tracker `__, adding the tag ``LinearTypes``. ===================================== testsuite/tests/ghci/scripts/T16468.script ===================================== @@ -0,0 +1,52 @@ +:set -XLinearTypes -XImpredicativeTypes +import GHC.Types (RuntimeRep (..), Levity (..), TYPE, Multiplicity, Type, LiftedRep) +import Data.Proxy + +f :: forall p (r' :: RuntimeRep). (forall (r :: RuntimeRep). Int -> p r) -> p r'; f x = x 5 +g :: forall p. Int -> forall (r :: RuntimeRep). p r; g _ = undefined +g' :: Int -> forall p (r :: RuntimeRep). p r; g' _ = undefined +h :: Int -> forall (r :: RuntimeRep). TYPE r; h _ = undefined +i :: forall (r :: RuntimeRep). Int -> TYPE r; i _ = undefined +j :: forall p. Eq (p ('BoxedRep 'Lifted)) => Int -> forall (r :: RuntimeRep). p r; j _ = undefined +k :: forall p (r' :: RuntimeRep). Eq (p r') => (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) -> p r'; k x = x 5 +class C a where l :: forall (r :: RuntimeRep) (b :: TYPE r). a -> b +m :: (forall (m :: Multiplicity). Int %m -> Int) -> Int; m x = x 5 +n :: forall (m :: Multiplicity). Int %m -> Int; n a = a +o :: Maybe (forall (r :: RuntimeRep). Proxy r); o = Nothing +p :: (forall (r :: RuntimeRep). Proxy r, Int); p = undefined +q :: p (forall (r :: RuntimeRep). Proxy r); q = undefined +r :: forall (a :: (forall (r :: RuntimeRep). TYPE r)) (p :: (forall (r :: RuntimeRep). TYPE r) -> Type). p a; r = r + +:set -XNoLinearTypes + +:type f +:type g +:type g' +:type h +:type i +:type j +:type k +:type l +:type m +:type n +:type o +:type p +:type q +:type r + +:set -fprint-explicit-runtime-reps +:set -XLinearTypes +:type f +:type g +:type g' +:type h +:type i +:type j +:type k +:type l +:type m +:type n +:type o +:type p +:type q +:type r ===================================== testsuite/tests/ghci/scripts/T16468.stdout ===================================== @@ -0,0 +1,34 @@ +f :: (forall (r :: RuntimeRep). Int -> p r) -> p LiftedRep +g :: Int -> p LiftedRep +g' :: Int -> forall (p :: RuntimeRep -> *). p LiftedRep +h :: Int -> * +i :: Int -> * +j :: Eq (p LiftedRep) => Int -> p LiftedRep +k :: Eq (p LiftedRep) => + (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) -> p LiftedRep +l :: C a => a -> b +m :: (forall (m :: Multiplicity). Int %m -> Int) -> Int +n :: Int -> Int +o :: Maybe (forall (r :: RuntimeRep). Proxy r) +p :: (Proxy LiftedRep, Int) +q :: p (forall (r :: RuntimeRep). Proxy r) +r :: forall (a :: forall (r :: RuntimeRep). TYPE r) + (p :: (forall (r :: RuntimeRep). TYPE r) -> *). + p a +f :: (forall (r :: RuntimeRep). Int -> p r) -> p r' +g :: Int -> forall (r :: RuntimeRep). p r +g' :: Int -> forall (p :: RuntimeRep -> *) (r :: RuntimeRep). p r +h :: Int -> forall (r :: RuntimeRep). TYPE r +i :: Int -> TYPE r +j :: Eq (p LiftedRep) => Int -> forall (r :: RuntimeRep). p r +k :: Eq (p r') => + (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) -> p r' +l :: forall a (r :: RuntimeRep) (b :: TYPE r). C a => a -> b +m :: (forall (m :: Multiplicity). Int %m -> Int) -> Int +n :: Int %m -> Int +o :: Maybe (forall (r :: RuntimeRep). Proxy r) +p :: (forall (r :: RuntimeRep). Proxy r, Int) +q :: p (forall (r :: RuntimeRep). Proxy r) +r :: forall (a :: forall (r :: RuntimeRep). TYPE r) + (p :: (forall (r :: RuntimeRep). TYPE r) -> *). + p a ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -375,3 +375,4 @@ test('T22695', normal, ghci_script, ['T22695.script']) test('T22817', normal, ghci_script, ['T22817.script']) test('T22908', normal, ghci_script, ['T22908.script']) test('T23062', normal, ghci_script, ['T23062.script']) +test('T16468', normal, ghci_script, ['T16468.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f46f93d4c2e41da9e8ac525f2a3f327623012b8f...931860b8aa7a3e7a9d5d7450b5fb2c58f89532fd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f46f93d4c2e41da9e8ac525f2a3f327623012b8f...931860b8aa7a3e7a9d5d7450b5fb2c58f89532fd You're receiving 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 Jun 27 11:30:39 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Tue, 27 Jun 2023 07:30:39 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23496 Message-ID: <649ac85f8c937_2402e07b1998030965b@gitlab.mail> Ryan Scott pushed new branch wip/T23496 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23496 You're receiving 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 Jun 27 11:51:40 2023 From: gitlab at gitlab.haskell.org (Bryan R (@chreekat)) Date: Tue, 27 Jun 2023 07:51:40 -0400 Subject: [Git][ghc/ghc][wip/bashed] Handle unset value in -e context Message-ID: <649acd4cdf751_2402e09f1249032375b@gitlab.mail> Bryan R pushed to branch wip/bashed at Glasgow Haskell Compiler / GHC Commits: b359cf1c by Bryan Richter at 2023-06-27T14:51:31+03:00 Handle unset value in -e context - - - - - 1 changed file: - .gitlab/darwin/toolchain.nix Changes: ===================================== .gitlab/darwin/toolchain.nix ===================================== @@ -113,6 +113,8 @@ pkgs.writeTextFile { export CABAL="$CABAL_INSTALL" sdk_path="$(xcrun --sdk macosx --show-sdk-path)" - export CONFIGURE_ARGS="$CONFIGURE_ARGS --with-ffi-libraries=$sdk_path/usr/lib --with-ffi-includes=$sdk_path/usr/include/ffi --build=${targetTriple}" + : ''${CONFIGURE_ARGS:=} + CONFIGURE_ARGS+="''${CONFIGURE_ARGS:+ }--with-ffi-libraries=$sdk_path/usr/lib --with-ffi-includes=$sdk_path/usr/include/ffi --build=${targetTriple}" + export CONFIGURE_ARGS ''; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b359cf1cc85efddc1277e23f7636b6158b20c735 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b359cf1cc85efddc1277e23f7636b6158b20c735 You're receiving 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 Jun 27 12:57:47 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 27 Jun 2023 08:57:47 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 4 commits: ghc-toolchain: Toolchain Selection Message-ID: <649adccb609d8_2402e018cc720834204f@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 63b5bcd8 by Rodrigo Mesquita at 2023-06-27T12:12:57+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b4. Revert get_arm_isa deletion from 74f03f24 As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples A TODO comment ghc-toolchain: set CC LD plat. dependent flags A lot to be said about the approach of configuring linker flags (what used to be SET CC LD platform dependent flags in configure), we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? Move osElfTarget from GHC.Platform to GHC.Platform.ArchOS, to use it in Toolchain.Tools.Link to correctly determine if -Wl,--no-as-needed is required - - - - - 0fc49348 by Rodrigo Mesquita at 2023-06-27T12:12:57+01:00 configure: Create and validate toolchain target file - - - - - 97204200 by Rodrigo Mesquita at 2023-06-27T12:12:57+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - 984709e1 by Rodrigo Mesquita at 2023-06-27T12:12:57+01:00 Use ghc-platform instead of ghc-boot - - - - - 30 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - configure.ac - + default.target.in - distrib/configure.ac.in - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Test.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Cc.hs - hadrian/src/Settings/Builders/DeriveConstants.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/HsCpp.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/39060908a77fd8cb971571fb53c1c0e67dd73482...984709e1fdca34fd4d8b620778bbdbc24205efbc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/39060908a77fd8cb971571fb53c1c0e67dd73482...984709e1fdca34fd4d8b620778bbdbc24205efbc You're receiving 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 Jun 27 13:02:35 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 27 Jun 2023 09:02:35 -0400 Subject: [Git][ghc/ghc][wip/tsan/no-barriers] rts: Make collectFreshWeakPtrs definition a prototype Message-ID: <649addeb345c_2402e01635f9c4347655@gitlab.mail> Ben Gamari pushed to branch wip/tsan/no-barriers at Glasgow Haskell Compiler / GHC Commits: 8088aa2a by Ben Gamari at 2023-06-27T09:01:29-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - 1 changed file: - rts/sm/MarkWeak.c Changes: ===================================== rts/sm/MarkWeak.c ===================================== @@ -457,7 +457,7 @@ static void checkWeakPtrSanity(StgWeak *hd, StgWeak *tl) * 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() +void collectFreshWeakPtrs( void ) { uint32_t i; // move recently allocated weak_ptr_list to the old list as well View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8088aa2a4e91da80d05b615275cc93eaaa7d26fe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8088aa2a4e91da80d05b615275cc93eaaa7d26fe You're receiving 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 Jun 27 13:48:17 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 27 Jun 2023 09:48:17 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/mr-templates Message-ID: <649ae8a19ea08_2402e03505da436641b@gitlab.mail> Ben Gamari pushed new branch wip/mr-templates at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/mr-templates You're receiving 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 Jun 27 14:04:17 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 27 Jun 2023 10:04:17 -0400 Subject: [Git][ghc/ghc][wip/romes/remove-toolchain-runtime-config] Rip out runtime linker/compiler checks Message-ID: <649aec617074c_2402e03505da437698b@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/remove-toolchain-runtime-config at Glasgow Haskell Compiler / GHC Commits: 7afcb5db by Ben Gamari at 2023-06-27T15:04:04+01:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 11 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/SysTools.hs - − compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - compiler/ghc.cabal.in - + m4/fp_link_supports_no_as_needed.m4 - m4/fptools_set_c_ld_flags.m4 Changes: ===================================== compiler/GHC/Driver/Backend.hs ===================================== @@ -58,8 +58,6 @@ module GHC.Driver.Backend , DefunctionalizedCodeOutput(..) -- *** Back-end functions for assembly , DefunctionalizedPostHscPipeline(..) - , DefunctionalizedAssemblerProg(..) - , DefunctionalizedAssemblerInfoGetter(..) -- *** Other back-end functions , DefunctionalizedCDefs(..) -- ** Names of back ends (for API clients of version 9.4 or earlier) @@ -94,8 +92,6 @@ module GHC.Driver.Backend , backendSupportsHpc , backendSupportsCImport , backendSupportsCExport - , backendAssemblerProg - , backendAssemblerInfoGetter , backendCDefs , backendCodeOutput , backendUseJSLinker @@ -348,40 +344,6 @@ data PrimitiveImplementation deriving Show --- | Names a function that runs the assembler, of this type: --- --- > Logger -> DynFlags -> Platform -> [Option] -> IO () --- --- The functions so named are defined in "GHC.Driver.Pipeline.Execute". - -data DefunctionalizedAssemblerProg - = StandardAssemblerProg - -- ^ Use the standard system assembler - | JSAssemblerProg - -- ^ JS Backend compile to JS via Stg, and so does not use any assembler - | DarwinClangAssemblerProg - -- ^ If running on Darwin, use the assembler from the @clang@ - -- toolchain. Otherwise use the standard system assembler. - - - --- | Names a function that discover from what toolchain the assembler --- is coming, of this type: --- --- > Logger -> DynFlags -> Platform -> IO CompilerInfo --- --- The functions so named are defined in "GHC.Driver.Pipeline.Execute". - -data DefunctionalizedAssemblerInfoGetter - = StandardAssemblerInfoGetter - -- ^ Interrogate the standard system assembler - | JSAssemblerInfoGetter - -- ^ If using the JS backend; return 'Emscripten' - | DarwinClangAssemblerInfoGetter - -- ^ If running on Darwin, return `Clang`; otherwise - -- interrogate the standard system assembler. - - -- | Names a function that generates code and writes the results to a -- file, of this type: -- @@ -770,45 +732,6 @@ backendSupportsCExport (Named JavaScript) = True backendSupportsCExport (Named Interpreter) = False backendSupportsCExport (Named NoBackend) = True --- | This (defunctionalized) function runs the assembler --- used on the code that is written by this back end. A --- program determined by a combination of back end, --- `DynFlags`, and `Platform` is run with the given --- `Option`s. --- --- The function's type is --- @ --- Logger -> DynFlags -> Platform -> [Option] -> IO () --- @ --- --- This field is usually defaulted. -backendAssemblerProg :: Backend -> DefunctionalizedAssemblerProg -backendAssemblerProg (Named NCG) = StandardAssemblerProg -backendAssemblerProg (Named LLVM) = DarwinClangAssemblerProg -backendAssemblerProg (Named ViaC) = StandardAssemblerProg -backendAssemblerProg (Named JavaScript) = JSAssemblerProg -backendAssemblerProg (Named Interpreter) = StandardAssemblerProg -backendAssemblerProg (Named NoBackend) = StandardAssemblerProg - --- | This (defunctionalized) function is used to retrieve --- an enumeration value that characterizes the C/assembler --- part of a toolchain. The function caches the info in a --- mutable variable that is part of the `DynFlags`. --- --- The function's type is --- @ --- Logger -> DynFlags -> Platform -> IO CompilerInfo --- @ --- --- This field is usually defaulted. -backendAssemblerInfoGetter :: Backend -> DefunctionalizedAssemblerInfoGetter -backendAssemblerInfoGetter (Named NCG) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named LLVM) = DarwinClangAssemblerInfoGetter -backendAssemblerInfoGetter (Named ViaC) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named JavaScript) = JSAssemblerInfoGetter -backendAssemblerInfoGetter (Named Interpreter) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named NoBackend) = StandardAssemblerInfoGetter - -- | When using this back end, it may be necessary or -- advisable to pass some `-D` options to a C compiler. -- This (defunctionalized) function produces those ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -116,7 +116,6 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Trans.Reader (ReaderT) import Control.Monad.Trans.Writer (WriterT) -import Data.IORef import System.IO import System.IO.Error (catchIOError) import System.Environment (lookupEnv) @@ -420,15 +419,6 @@ data DynFlags = DynFlags { avx512pf :: Bool, -- Enable AVX-512 PreFetch Instructions. fma :: Bool, -- ^ Enable FMA instructions. - -- | Run-time linker information (what options we need, etc.) - rtldInfo :: IORef (Maybe LinkerInfo), - - -- | Run-time C compiler information - rtccInfo :: IORef (Maybe CompilerInfo), - - -- | Run-time assembler information - rtasmInfo :: IORef (Maybe CompilerInfo), - -- Constants used to control the amount of optimization done. -- | Max size, in bytes, of inline array allocations. @@ -490,9 +480,6 @@ class ContainsDynFlags t where initDynFlags :: DynFlags -> IO DynFlags initDynFlags dflags = do let - refRtldInfo <- newIORef Nothing - refRtccInfo <- newIORef Nothing - refRtasmInfo <- newIORef Nothing canUseUnicode <- do let enc = localeEncoding str = "‘’" (withCString enc str $ \cstr -> @@ -514,9 +501,6 @@ initDynFlags dflags = do useColor = useColor', canUseColor = stderrSupportsAnsiColors, colScheme = colScheme', - rtldInfo = refRtldInfo, - rtccInfo = refRtccInfo, - rtasmInfo = refRtasmInfo, tmpDir = TempDir tmp_dir } @@ -695,9 +679,6 @@ defaultDynFlags mySettings = avx512f = False, avx512pf = False, fma = False, - rtldInfo = panic "defaultDynFlags: no rtldInfo", - rtccInfo = panic "defaultDynFlags: no rtccInfo", - rtasmInfo = panic "defaultDynFlags: no rtasmInfo", maxInlineAllocSize = 128, maxInlineMemcpyInsns = 32, ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -109,9 +109,6 @@ module GHC.Driver.Main import GHC.Prelude -import GHC.Platform -import GHC.Platform.Ways - import GHC.Driver.Plugins import GHC.Driver.Session import GHC.Driver.Backend @@ -336,41 +333,11 @@ initHscEnv mb_top_dir = do mySettings <- initSysTools top_dir dflags <- initDynFlags (defaultDynFlags mySettings) hsc_env <- newHscEnv top_dir dflags - checkBrokenTablesNextToCode (hsc_logger hsc_env) dflags setUnsafeGlobalDynFlags dflags -- c.f. DynFlags.parseDynamicFlagsFull, which -- creates DynFlags and sets the UnsafeGlobalDynFlags return hsc_env --- | The binutils linker on ARM emits unnecessary R_ARM_COPY relocations which --- breaks tables-next-to-code in dynamically linked modules. This --- check should be more selective but there is currently no released --- version where this bug is fixed. --- See https://sourceware.org/bugzilla/show_bug.cgi?id=16177 and --- https://gitlab.haskell.org/ghc/ghc/issues/4210#note_78333 -checkBrokenTablesNextToCode :: Logger -> DynFlags -> IO () -checkBrokenTablesNextToCode logger dflags = do - let invalidLdErr = "Tables-next-to-code not supported on ARM \ - \when using binutils ld (please see: \ - \https://sourceware.org/bugzilla/show_bug.cgi?id=16177)" - broken <- checkBrokenTablesNextToCode' logger dflags - when broken (panic invalidLdErr) - -checkBrokenTablesNextToCode' :: Logger -> DynFlags -> IO Bool -checkBrokenTablesNextToCode' logger dflags - | not (isARM arch) = return False - | ways dflags `hasNotWay` WayDyn = return False - | not tablesNextToCode = return False - | otherwise = do - linkerInfo <- liftIO $ GHC.SysTools.getLinkerInfo logger dflags - case linkerInfo of - GnuLD _ -> return True - _ -> return False - where platform = targetPlatform dflags - arch = platformArch platform - tablesNextToCode = platformTablesNextToCode platform - - -- ----------------------------------------------------------------------------- getDiagnostics :: Hsc (Messages GhcMessage) ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -287,12 +287,6 @@ runAsPhase :: Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO F runAsPhase with_cpp pipe_env hsc_env location input_fn = do let dflags = hsc_dflags hsc_env let logger = hsc_logger hsc_env - let unit_env = hsc_unit_env hsc_env - let platform = ue_platform unit_env - - -- LLVM from version 3.0 onwards doesn't support the OS X system - -- assembler, so we use clang as the assembler instead. (#5636) - let as_prog = applyAssemblerProg $ backendAssemblerProg (backend dflags) let cmdline_include_paths = includePaths dflags let pic_c_flags = picCCOpts dflags @@ -310,9 +304,8 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do includePathsQuoteImplicit cmdline_include_paths] let runAssembler inputFilename outputFilename = withAtomicRename outputFilename $ \temp_outputFilename -> - as_prog + runAs logger dflags - platform (local_includes ++ global_includes -- See Note [-fPIC for assembler] ++ map GHC.SysTools.Option pic_c_flags @@ -392,22 +385,6 @@ runForeignJsPhase pipe_env hsc_env _location input_fn = do embedJsFile logger dflags tmpfs unit_env input_fn output_fn return output_fn - -applyAssemblerProg - :: DefunctionalizedAssemblerProg - -> Logger -> DynFlags -> Platform -> [Option] -> IO () -applyAssemblerProg StandardAssemblerProg logger dflags _platform = - runAs logger dflags -applyAssemblerProg JSAssemblerProg logger dflags _platform = - runEmscripten logger dflags -applyAssemblerProg DarwinClangAssemblerProg logger dflags platform = - if platformOS platform == OSDarwin then - runClang logger dflags - else - runAs logger dflags - - - runCcPhase :: Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO FilePath runCcPhase cc_phase pipe_env hsc_env location input_fn = do let dflags = hsc_dflags hsc_env ===================================== compiler/GHC/Linker/ExtraObj.hs ===================================== @@ -12,7 +12,6 @@ module GHC.Linker.ExtraObj , mkNoteObjsToLinkIntoBinary , checkLinkInfo , getLinkInfo - , getCompilerInfo , ghcLinkInfoSectionName , ghcLinkInfoNoteName , platformSupportsSavingLinkOpts @@ -40,10 +39,8 @@ import qualified GHC.Data.ShortText as ST import GHC.SysTools.Elf import GHC.SysTools.Tasks -import GHC.SysTools.Info import GHC.Linker.Unit -import Control.Monad.IO.Class import Control.Monad import Data.Maybe @@ -52,7 +49,6 @@ mkExtraObj logger tmpfs dflags unit_state extn xs = do cFile <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule extn oFile <- newTempName logger tmpfs (tmpDir dflags) TFL_GhcSession "o" writeFile cFile xs - ccInfo <- liftIO $ getCompilerInfo logger dflags runCc Nothing logger tmpfs dflags ([Option "-c", FileOption "" cFile, @@ -60,7 +56,7 @@ mkExtraObj logger tmpfs dflags unit_state extn xs FileOption "" oFile] ++ if extn /= "s" then cOpts - else asmOpts ccInfo) + else []) return oFile where -- Pass a different set of options to the C compiler depending one whether @@ -70,14 +66,6 @@ mkExtraObj logger tmpfs dflags unit_state extn xs ++ map (FileOption "-I" . ST.unpack) (unitIncludeDirs $ unsafeLookupUnit unit_state rtsUnit) - -- When compiling assembler code, we drop the usual C options, and if the - -- compiler is Clang, we add an extra argument to tell Clang to ignore - -- unused command line options. See trac #11684. - asmOpts ccInfo = - if any (ccInfo ==) [Clang, AppleClang, AppleClang51] - then [Option "-Qunused-arguments"] - else [] - -- When linking a binary, we need to create a C main() function that -- starts everything off. This used to be compiled statically as part -- of the RTS, but that made it hard to change the -rtsopts setting, ===================================== compiler/GHC/SysTools.hs ===================================== @@ -17,7 +17,6 @@ module GHC.SysTools ( -- * Interface to system tools module GHC.SysTools.Tasks, - module GHC.SysTools.Info, -- * Fast file copy copyFile, @@ -35,8 +34,6 @@ import GHC.Prelude import GHC.Utils.Panic import GHC.Driver.Session -import GHC.Linker.ExtraObj -import GHC.SysTools.Info import GHC.SysTools.Tasks import GHC.SysTools.BaseDir import GHC.Settings.IO ===================================== compiler/GHC/SysTools/Info.hs deleted ===================================== @@ -1,243 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} ------------------------------------------------------------------------------ --- --- Compiler information functions --- --- (c) The GHC Team 2017 --- ------------------------------------------------------------------------------ -module GHC.SysTools.Info where - -import GHC.Utils.Exception -import GHC.Utils.Error -import GHC.Driver.Session -import GHC.Utils.Outputable -import GHC.Utils.Misc -import GHC.Utils.Logger - -import Data.List ( isInfixOf, isPrefixOf ) -import Data.IORef - -import System.IO - -import GHC.Platform -import GHC.Prelude - -import GHC.SysTools.Process - -{- Note [Run-time linker info] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~ -See also: #5240, #6063, #10110 - -Before 'runLink', we need to be sure to get the relevant information -about the linker we're using at runtime to see if we need any extra -options. - -Generally, the linker changing from what was detected at ./configure -time has always been possible using -pgml, but on Linux it can happen -'transparently' by installing packages like binutils-gold, which -change what /usr/bin/ld actually points to. - -Clang vs GCC notes: - -For gcc, 'gcc -Wl,--version' gives a bunch of output about how to -invoke the linker before the version information string. For 'clang', -the version information for 'ld' is all that's output. For this -reason, we typically need to slurp up all of the standard error output -and look through it. - -Other notes: - -We cache the LinkerInfo inside DynFlags, since clients may link -multiple times. The definition of LinkerInfo is there to avoid a -circular dependency. - --} - -{- Note [ELF needed shared libs] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Some distributions change the link editor's default handling of -ELF DT_NEEDED tags to include only those shared objects that are -needed to resolve undefined symbols. For Template Haskell we need -the last temporary shared library also if it is not needed for the -currently linked temporary shared library. We specify --no-as-needed -to override the default. This flag exists in GNU ld and GNU gold. - -The flag is only needed on ELF systems. On Windows (PE) and Mac OS X -(Mach-O) the flag is not needed. - --} - -neededLinkArgs :: LinkerInfo -> [Option] -neededLinkArgs (GnuLD o) = o -neededLinkArgs (Mold o) = o -neededLinkArgs (GnuGold o) = o -neededLinkArgs (LlvmLLD o) = o -neededLinkArgs (DarwinLD o) = o -neededLinkArgs (SolarisLD o) = o -neededLinkArgs (AixLD o) = o -neededLinkArgs UnknownLD = [] - --- Grab linker info and cache it in DynFlags. -getLinkerInfo :: Logger -> DynFlags -> IO LinkerInfo -getLinkerInfo logger dflags = do - info <- readIORef (rtldInfo dflags) - case info of - Just v -> return v - Nothing -> do - v <- getLinkerInfo' logger dflags - writeIORef (rtldInfo dflags) (Just v) - return v - --- See Note [Run-time linker info]. -getLinkerInfo' :: Logger -> DynFlags -> IO LinkerInfo -getLinkerInfo' logger dflags = do - let platform = targetPlatform dflags - os = platformOS platform - (pgm,args0) = pgm_l dflags - args1 = map Option (getOpts dflags opt_l) - args2 = args0 ++ args1 - args3 = filter notNull (map showOpt args2) - - -- Try to grab the info from the process output. - parseLinkerInfo stdo _stde _exitc - | any ("GNU ld" `isPrefixOf`) stdo = - -- Set DT_NEEDED for all shared libraries. #10110. - return (GnuLD $ map Option [-- ELF specific flag - -- 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] - return (GnuGold [Option "-Wl,--no-as-needed"]) - - | any (\line -> "LLD" `isPrefixOf` line || "LLD" `elem` words line) stdo = - return (LlvmLLD $ map Option [ --see Note [ELF needed shared libs] - "-Wl,--no-as-needed" | osElfTarget os || os == OSMinGW32 ]) - - -- Unknown linker. - | otherwise = fail "invalid --version output, or linker is unsupported" - - -- Process the executable call - catchIO ( - case os of - OSSolaris2 -> - -- Solaris uses its own Solaris linker. Even all - -- GNU C are recommended to configure with Solaris - -- linker instead of using GNU binutils linker. Also - -- all GCC distributed with Solaris follows this rule - -- precisely so we assume here, the Solaris linker is - -- used. - return $ SolarisLD [] - OSAIX -> - -- IBM AIX uses its own non-binutils linker as well - return $ AixLD [] - OSDarwin -> - -- Darwin has neither GNU Gold or GNU LD, but a strange linker - -- that doesn't support --version. We can just assume that's - -- what we're using. - return $ DarwinLD [] - OSMinGW32 -> - -- GHC doesn't support anything but GNU ld on Windows anyway. - -- Process creation is also fairly expensive on win32, so - -- we short-circuit here. - return $ GnuLD $ map Option - [ -- Emit stack checks - -- See Note [Windows stack allocations] - "-fstack-check" - ] - _ -> do - -- In practice, we use the compiler as the linker here. Pass - -- -Wl,--version to get linker version info. - (exitc, stdo, stde) <- readProcessEnvWithExitCode pgm - (["-Wl,--version"] ++ args3) - c_locale_env - -- Split the output by lines to make certain kinds - -- of processing easier. In particular, 'clang' and 'gcc' - -- have slightly different outputs for '-Wl,--version', but - -- it's still easy to figure out. - parseLinkerInfo (lines stdo) (lines stde) exitc - ) - (\err -> do - debugTraceMsg logger 2 - (text "Error (figuring out linker information):" <+> - text (show err)) - errorMsg logger $ hang (text "Warning:") 9 $ - text "Couldn't figure out linker information!" $$ - text "Make sure you're using GNU ld, GNU gold" <+> - text "or the built in OS X linker, etc." - return UnknownLD - ) - --- | Grab compiler info and cache it in DynFlags. -getCompilerInfo :: Logger -> DynFlags -> IO CompilerInfo -getCompilerInfo logger dflags = do - info <- readIORef (rtccInfo dflags) - case info of - Just v -> return v - Nothing -> do - let pgm = pgm_c dflags - v <- getCompilerInfo' logger pgm - writeIORef (rtccInfo dflags) (Just v) - return v - --- | Grab assembler info and cache it in DynFlags. -getAssemblerInfo :: Logger -> DynFlags -> IO CompilerInfo -getAssemblerInfo logger dflags = do - info <- readIORef (rtasmInfo dflags) - case info of - Just v -> return v - Nothing -> do - let (pgm, _) = pgm_a dflags - v <- getCompilerInfo' logger pgm - writeIORef (rtasmInfo dflags) (Just v) - return v - --- See Note [Run-time linker info]. -getCompilerInfo' :: Logger -> String -> IO CompilerInfo -getCompilerInfo' logger pgm = do - let -- Try to grab the info from the process output. - parseCompilerInfo _stdo stde _exitc - -- Regular GCC - | any ("gcc version" `isInfixOf`) stde = - return GCC - -- Regular clang - | any ("clang version" `isInfixOf`) stde = - return Clang - -- FreeBSD clang - | any ("FreeBSD clang version" `isInfixOf`) stde = - return Clang - -- Xcode 5.1 clang - | any ("Apple LLVM version 5.1" `isPrefixOf`) stde = - return AppleClang51 - -- Xcode 5 clang - | any ("Apple LLVM version" `isPrefixOf`) stde = - return AppleClang - -- Xcode 4.1 clang - | any ("Apple clang version" `isPrefixOf`) stde = - return AppleClang - -- Unknown compiler. - | otherwise = fail $ "invalid -v output, or compiler is unsupported (" ++ pgm ++ "): " ++ unlines stde - - -- Process the executable call - catchIO (do - (exitc, stdo, stde) <- - readProcessEnvWithExitCode pgm ["-v"] c_locale_env - -- Split the output by lines to make certain kinds - -- of processing easier. - parseCompilerInfo (lines stdo) (lines stde) exitc - ) - (\err -> do - debugTraceMsg logger 2 - (text "Error (figuring out C compiler information):" <+> - text (show err)) - errorMsg logger $ hang (text "Warning:") 9 $ - text "Couldn't figure out C compiler information!" $$ - text "Make sure you're using GNU gcc, or clang" - return UnknownCC - ) ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -19,7 +19,6 @@ import GHC.CmmToLlvm.Config (LlvmVersion, llvmVersionStr, supportedLlvmVersionUp import GHC.Settings import GHC.SysTools.Process -import GHC.SysTools.Info import GHC.Driver.Session @@ -278,15 +277,12 @@ figureLlvmVersion logger dflags = traceSystoolCommand logger "llc" $ do runLink :: Logger -> TmpFs -> DynFlags -> [Option] -> IO () runLink logger tmpfs dflags args = traceSystoolCommand logger "linker" $ do - -- See Note [Run-time linker info] - -- -- `-optl` args come at the end, so that later `-l` options -- given there manually can fill in symbols needed by -- Haskell libraries coming in via `args`. - linkargs <- neededLinkArgs `fmap` getLinkerInfo logger dflags let (p,args0) = pgm_l dflags optl_args = map Option (getOpts dflags opt_l) - args2 = args0 ++ linkargs ++ args ++ optl_args + args2 = args0 ++ args ++ optl_args mb_env <- getGccEnv args2 runSomethingResponseFile logger tmpfs dflags ld_filter "Linker" p args2 mb_env where ===================================== compiler/ghc.cabal.in ===================================== @@ -712,7 +712,6 @@ Library GHC.SysTools.BaseDir GHC.SysTools.Cpp GHC.SysTools.Elf - GHC.SysTools.Info GHC.SysTools.Process GHC.SysTools.Tasks GHC.SysTools.Terminal ===================================== m4/fp_link_supports_no_as_needed.m4 ===================================== @@ -0,0 +1,33 @@ +# FP_LINK_SUPPORTS_NO_AS_NEEDED +# ---------------------------------- +# Set the Cc linker flag -Wl,--no-as-needed if it is supported +# $1 is the name of the linker flags variable when linking with gcc +# See also Note [ELF needed shared libs] +AC_DEFUN([FP_LINK_SUPPORTS_NO_AS_NEEDED], +[ + AC_MSG_CHECKING([whether Cc linker supports -Wl,--no-as-needed]) + echo 'int f(int a) {return 2*a;}' > conftest.a.c + echo 'int f(int a); int main(int argc, char **argv) {return f(0);}' > conftest.b.c + $CC -c -o conftest.a.o conftest.a.c > /dev/null 2>&1 + $CC -c -o conftest.b.o conftest.b.c > /dev/null 2>&1 + if "$CC" "$$1" -Wl,--no-as-needed -o conftest conftest.a.o conftest.b.o > /dev/null 2>&1 + then + $1="$$1 -Wl,--no-as-needed" + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + fi + rm -f conftest* +]) + +# Note [ELF needed shared libs] +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# Some distributions change the link editor's default handling of +# ELF DT_NEEDED tags to include only those shared objects that are +# needed to resolve undefined symbols. For Template Haskell we need +# the last temporary shared library also if it is not needed for the +# currently linked temporary shared library. We specify --no-as-needed +# to override the default. This flag exists in GNU ld and GNU gold. +# +# The flag is only needed on ELF systems. On Windows (PE) and Mac OS X +# (Mach-O) the flag is not needed. ===================================== m4/fptools_set_c_ld_flags.m4 ===================================== @@ -17,6 +17,21 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS], ;; esac + # See Note [ELF needed shared libs] + case $$1 in + *-linux|*-freebsd*) + FP_LINK_SUPPORTS_NO_AS_NEEDED([$3]) + ;; + esac + + # Emit stack checks + # See Note [Windows stack allocations] + case $$1 in + *-mingw32*) + $3="$$3 -fstack-check" + ;; + esac + case $$1 in i386-unknown-mingw32) $2="$$2 -march=i686" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7afcb5db5a27ddd62c45536c7e1d68e30fe4753a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7afcb5db5a27ddd62c45536c7e1d68e30fe4753a You're receiving 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 Jun 27 14:52:27 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 27 Jun 2023 10:52:27 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's Message-ID: <649af7ab10c74_2402e09f124904285ee@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: d95cb595 by Greg Steuck at 2023-06-27T10:52:11-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - 6f4e01d3 by Andrei Borzenkov at 2023-06-27T10:52:12-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - a11624a5 by Torsten Schmits at 2023-06-27T10:52:12-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 771e6f62 by Torsten Schmits at 2023-06-27T10:52:13-04:00 Remove duplicate link label in linear types docs - - - - - 29 changed files: - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Types/Unique/DFM.hs - configure.ac - distrib/configure.ac.in - docs/users_guide/exts/linear_types.rst - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - libraries/template-haskell/changelog.md - + testsuite/tests/ghci/scripts/T16468.script - + testsuite/tests/ghci/scripts/T16468.stdout - testsuite/tests/ghci/scripts/all.T - testsuite/tests/perf/compiler/CoOpt_Singletons.hs - testsuite/tests/saks/should_compile/T16724.stdout - testsuite/tests/saks/should_compile/saks030.hs - testsuite/tests/saks/should_compile/saks032.hs - + testsuite/tests/th/CodeQ_HKD.hs - testsuite/tests/th/all.T - + testsuite/tests/typecheck/should_compile/T23514b.hs - + testsuite/tests/typecheck/should_compile/T23514c.hs - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_fail/T18640a.hs - testsuite/tests/typecheck/should_fail/T18640a.stderr - testsuite/tests/typecheck/should_fail/T18640c.hs - testsuite/tests/typecheck/should_fail/T18640c.stderr - + testsuite/tests/typecheck/should_fail/T23514a.hs - + testsuite/tests/typecheck/should_fail/T23514a.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -920,12 +920,7 @@ pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype, cons = visibleIfConDecls condecls pp_where = ppWhen (gadt && not (null cons)) $ text "where" pp_cons = ppr_trim (map show_con cons) :: [SDoc] - pp_kind = ppUnless (if ki_sig_printable - then isIfaceRhoType kind - -- Even in the presence of a standalone kind signature, a non-tau - -- result kind annotation cannot be discarded as it determines the arity. - -- See Note [Arity inference in kcCheckDeclHeader_sig] in GHC.Tc.Gen.HsType - else isIfaceLiftedTypeKind kind) + pp_kind = ppUnless (ki_sig_printable || isIfaceLiftedTypeKind kind) (dcolon <+> ppr kind) pp_lhs = case parent of ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -821,7 +821,7 @@ pprIfaceLamBndr (b, IfaceNoOneShot) = ppr b pprIfaceLamBndr (b, IfaceOneShot) = ppr b <> text "[OneShot]" pprIfaceIdBndr :: IfaceIdBndr -> SDoc -pprIfaceIdBndr (w, name, ty) = parens (ppr name <> brackets (ppr w) <+> dcolon <+> ppr ty) +pprIfaceIdBndr (w, name, ty) = parens (ppr name <> brackets (ppr_ty_nested w) <+> dcolon <+> ppr_ty_nested ty) {- Note [Suppressing binder signatures] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -881,7 +881,7 @@ pprIfaceTvBndr :: IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc pprIfaceTvBndr (tv, ki) (SuppressBndrSig suppress_sig) (UseBndrParens use_parens) | suppress_sig = ppr tv | isIfaceLiftedTypeKind ki = ppr tv - | otherwise = maybe_parens (ppr tv <+> dcolon <+> ppr ki) + | otherwise = maybe_parens (ppr tv <+> dcolon <+> ppr_ty_nested ki) where maybe_parens | use_parens = parens | otherwise = id @@ -933,9 +933,13 @@ instance Binary IfaceOneShot where instance Outputable IfaceType where ppr ty = pprIfaceType ty -pprIfaceType, pprParendIfaceType :: IfaceType -> SDoc +-- The purpose of 'ppr_ty_nested' is to distinguish calls that should not +-- trigger 'hideNonStandardTypes', see Note [Defaulting RuntimeRep variables] +-- wrinkle (W2). +pprIfaceType, pprParendIfaceType, ppr_ty_nested :: IfaceType -> SDoc pprIfaceType = pprPrecIfaceType topPrec pprParendIfaceType = pprPrecIfaceType appPrec +ppr_ty_nested = ppr_ty topPrec pprPrecIfaceType :: PprPrec -> IfaceType -> SDoc -- We still need `hideNonStandardTypes`, since the `pprPrecIfaceType` may be @@ -987,7 +991,7 @@ ppr_ty ctxt_prec ty@(IfaceFunTy af w ty1 ty2) -- Should be a visible argument | isVisibleFunArg af = (pprTypeArrow af wthis <+> ppr_ty funPrec ty1) : ppr_fun_tail wnext ty2 ppr_fun_tail wthis other_ty - = [pprTypeArrow af wthis <+> pprIfaceType other_ty] + = [pprTypeArrow af wthis <+> ppr_ty_nested other_ty] ppr_ty ctxt_prec (IfaceAppTy t ts) = if_print_coercions @@ -1044,9 +1048,11 @@ Haskell programs, so it makes little sense to make all users pay this syntactic overhead. For this reason it was decided that we would hide RuntimeRep variables -for now (see #11549). We do this by defaulting all type variables of -kind RuntimeRep to LiftedRep. -Likewise, we default all Multiplicity variables to Many. +for now (see #11549). We do this right in the pretty-printer, by pre-processing +the type we are about to print, to default any type variables of kind RuntimeRep +that are bound by toplevel invisible quantification to LiftedRep. +Likewise, we default Multiplicity variables to Many and Levity variables to +Lifted. This is done in a pass right before pretty-printing (defaultIfaceTyVarsOfKind, controlled by @@ -1073,6 +1079,32 @@ metavariables are converted, skolem variables are not. There's one exception though: TyVarTv metavariables should not be defaulted, as they appear during kind-checking of "newtype T :: TYPE r where..." (test T18357a). Therefore, we additionally test for isTyConableTyVar. + +Wrinkles: + +(W1) The loop 'go' in 'defaultIfaceTyVarsOfKind' passes a Bool flag, 'rank1', + around that indicates whether we haven't yet descended into the arguments + of a function type. + This is used to decide whether newly bound variables are eligible for + defaulting – we do not want contravariant foralls to be defaulted because + that would result in an incorrect, rather than specialized, type. + For example: + ∀ p (r1 :: RuntimeRep) . (∀ (r2 :: RuntimeRep) . p r2) -> p r1 + We want to default 'r1', but not 'r2'. + When examining the first forall, 'rank1' is True. + The toplevel function type is matched as IfaceFunTy, where we recurse into + 'go' by passing False for 'rank1'. + The forall in the first argument then skips adding a substitution for 'r2'. + +(W2) 'defaultIfaceTyVarsOfKind' ought to be called only once when printing a + type. + A few components of the printing machinery used to invoke 'ppr' on types + nested in secondary structures like IfaceBndr, which would repeat the + defaulting process, but treating the type as if it were top-level, causing + unwanted defaulting. + In order to prevent future developers from using 'ppr' again or being + confused that @ppr_ty topPrec@ is used, we introduced a marker function, + 'ppr_ty_nested'. -} -- | Default 'RuntimeRep' variables to 'LiftedRep', @@ -1097,28 +1129,29 @@ as they appear during kind-checking of "newtype T :: TYPE r where..." defaultIfaceTyVarsOfKind :: Bool -- ^ default 'RuntimeRep'/'Levity' variables? -> Bool -- ^ default 'Multiplicity' variables? -> IfaceType -> IfaceType -defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv ty +defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv True ty where go :: FastStringEnv IfaceType -- Set of enclosing forall-ed RuntimeRep/Levity/Multiplicity variables + -> Bool -- Are we in a toplevel forall, where defaulting is allowed? -> IfaceType -> IfaceType - go subs (IfaceForAllTy (Bndr (IfaceTvBndr (var, var_kind)) argf) ty) + go subs True (IfaceForAllTy (Bndr (IfaceTvBndr (var, var_kind)) argf) ty) | isInvisibleForAllTyFlag argf -- Don't default *visible* quantification -- or we get the mess in #13963 , Just substituted_ty <- check_substitution var_kind = let subs' = extendFsEnv subs var substituted_ty -- Record that we should replace it with LiftedRep/Lifted/Many, -- and recurse, discarding the forall - in go subs' ty + in go subs' True ty - go subs (IfaceForAllTy bndr ty) - = IfaceForAllTy (go_ifacebndr subs bndr) (go subs ty) + go subs rank1 (IfaceForAllTy bndr ty) + = IfaceForAllTy (go_ifacebndr subs bndr) (go subs rank1 ty) - go subs ty@(IfaceTyVar tv) = case lookupFsEnv subs tv of + go subs _ ty@(IfaceTyVar tv) = case lookupFsEnv subs tv of Just s -> s Nothing -> ty - go _ ty@(IfaceFreeTyVar tv) + go _ _ ty@(IfaceFreeTyVar tv) -- See Note [Defaulting RuntimeRep variables], about free vars | def_rep , GHC.Core.Type.isRuntimeRepTy (tyVarKind tv) @@ -1138,34 +1171,34 @@ defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv ty | otherwise = ty - go subs (IfaceTyConApp tc tc_args) + go subs _ (IfaceTyConApp tc tc_args) = IfaceTyConApp tc (go_args subs tc_args) - go subs (IfaceTupleTy sort is_prom tc_args) + go subs _ (IfaceTupleTy sort is_prom tc_args) = IfaceTupleTy sort is_prom (go_args subs tc_args) - go subs (IfaceFunTy af w arg res) - = IfaceFunTy af (go subs w) (go subs arg) (go subs res) + go subs rank1 (IfaceFunTy af w arg res) + = IfaceFunTy af (go subs False w) (go subs False arg) (go subs rank1 res) - go subs (IfaceAppTy t ts) - = IfaceAppTy (go subs t) (go_args subs ts) + go subs _ (IfaceAppTy t ts) + = IfaceAppTy (go subs False t) (go_args subs ts) - go subs (IfaceCastTy x co) - = IfaceCastTy (go subs x) co + go subs rank1 (IfaceCastTy x co) + = IfaceCastTy (go subs rank1 x) co - go _ ty@(IfaceLitTy {}) = ty - go _ ty@(IfaceCoercionTy {}) = ty + go _ _ ty@(IfaceLitTy {}) = ty + go _ _ ty@(IfaceCoercionTy {}) = ty go_ifacebndr :: FastStringEnv IfaceType -> IfaceForAllBndr -> IfaceForAllBndr go_ifacebndr subs (Bndr (IfaceIdBndr (w, n, t)) argf) - = Bndr (IfaceIdBndr (w, n, go subs t)) argf + = Bndr (IfaceIdBndr (w, n, go subs False t)) argf go_ifacebndr subs (Bndr (IfaceTvBndr (n, t)) argf) - = Bndr (IfaceTvBndr (n, go subs t)) argf + = Bndr (IfaceTvBndr (n, go subs False t)) argf go_args :: FastStringEnv IfaceType -> IfaceAppArgs -> IfaceAppArgs go_args _ IA_Nil = IA_Nil go_args subs (IA_Arg ty argf args) - = IA_Arg (go subs ty) argf (go_args subs args) + = IA_Arg (go subs False ty) argf (go_args subs args) check_substitution :: IfaceType -> Maybe IfaceType check_substitution (IfaceTyConApp tc _) @@ -1236,7 +1269,7 @@ ppr_app_arg ctx_prec (t, argf) = Specified | print_kinds -> char '@' <> ppr_ty appPrec t Inferred | print_kinds - -> char '@' <> braces (ppr_ty topPrec t) + -> char '@' <> braces (ppr_ty_nested t) _ -> empty ------------------- @@ -1367,7 +1400,7 @@ ppr_sigma show_forall ctxt_prec iface_ty -- Then it could handle both invisible and required binders, and -- splitIfaceReqForallTy wouldn't be necessary here. in ppr_iface_forall_part show_forall invis_tvs theta $ - sep [pprIfaceForAll req_tvs, ppr tau'] + sep [pprIfaceForAll req_tvs, ppr_ty_nested tau'] pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc pprUserIfaceForAll tvs ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -2556,37 +2556,30 @@ kcCheckDeclHeader_sig sig_kind name flav -- ^^^^^^^^^ -- We do it here because at this point the environment has been -- extended with both 'implicit_tcv_prs' and 'explicit_tv_prs'. + -- + -- Also see Note [Arity of type families and type synonyms] ; ctx_k <- kc_res_ki - -- Work out extra_arity, the number of extra invisible binders from - -- the kind signature that should be part of the TyCon's arity. - -- See Note [Arity inference in kcCheckDeclHeader_sig] - ; let n_invis_tcbs = countWhile isInvisibleTyConBinder excess_sig_tcbs - invis_arity = case ctx_k of - AnyKind -> n_invis_tcbs -- No kind signature, so make all the invisible binders - -- the signature into part of the arity of the TyCon - OpenKind -> n_invis_tcbs -- Result kind is (TYPE rr), so again make all the - -- invisible binders part of the arity of the TyCon - TheKind ki -> 0 `max` (n_invis_tcbs - invisibleTyBndrCount ki) + ; let sig_res_kind' = mkTyConKind excess_sig_tcbs sig_res_kind - ; let (invis_tcbs, resid_tcbs) = splitAt invis_arity excess_sig_tcbs - ; let sig_res_kind' = mkTyConKind resid_tcbs sig_res_kind - - ; traceTc "kcCheckDeclHeader_sig 2" $ vcat [ ppr excess_sig_tcbs - , ppr invis_arity, ppr invis_tcbs - , ppr n_invis_tcbs ] + ; traceTc "kcCheckDeclHeader_sig 2" $ + vcat [ text "excess_sig_tcbs" <+> ppr excess_sig_tcbs + , text "ctx_k" <+> ppr ctx_k + , text "sig_res_kind'" <+> ppr sig_res_kind' + ] -- Unify res_ki (from the type declaration) with the residual kind from -- the kind signature. Don't forget to apply the skolemising 'subst' first. ; case ctx_k of AnyKind -> return () -- No signature - _ -> do { res_ki <- newExpectedKind ctx_k - ; discardResult (unifyKind Nothing sig_res_kind' res_ki) } + _ -> do + res_ki <- newExpectedKind ctx_k + check_exp_res_ki sig_res_kind' res_ki -- Add more binders for data/newtype, so the result kind has no arrows -- See Note [Datatype return kinds] - ; if null resid_tcbs || not (needsEtaExpansion flav) - then return (invis_tcbs, sig_res_kind') + ; if null excess_sig_tcbs || not (needsEtaExpansion flav) + then return ([], sig_res_kind') else return (excess_sig_tcbs, sig_res_kind) } @@ -2642,6 +2635,22 @@ kcCheckDeclHeader_sig sig_kind name flav ] ; return tc } +-- | Check the result kind annotation on a type constructor against +-- the corresponding section of the standalone kind signature. +-- Drops invisible binders that interfere with unification. +check_exp_res_ki :: TcKind -- ^ the actual kind + -> TcKind -- ^ the expected kind + -> TcM () +check_exp_res_ki act_kind exp_kind + = discardResult $ unifyKind Nothing act_kind' exp_kind + where + (_, act_kind') = splitInvisPiTysN n_to_inst act_kind + + -- by analogy with checkExpectedKind + n_exp_invis_bndrs = invisibleTyBndrCount exp_kind + n_act_invis_bndrs = invisibleTyBndrCount act_kind + n_to_inst = n_act_invis_bndrs - n_exp_invis_bndrs + matchUpSigWithDecl :: Name -- Name of the type constructor for error messages -> [TcTyConBinder] -- TcTyConBinders (with skolem TcTyVars) from the separate kind signature @@ -2739,8 +2748,8 @@ swizzleTcb swizzle_env subst (Bndr tv vis) -- See Note [Source locations for implicitly bound type variables] -- in GHC.Tc.Rename.HsType -{- See Note [kcCheckDeclHeader_sig] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [kcCheckDeclHeader_sig] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Given a kind signature 'sig_kind' and a declaration header, kcCheckDeclHeader_sig verifies that the declaration conforms to the signature. The end result is a PolyTcTyCon 'tc' such that: @@ -2781,85 +2790,43 @@ Basic plan is this: part of the signature (k -> Type) with the kind signature of the decl, (j -> Type). This unification, done in kcCheckDeclHeader, needs TcTyVars. - * The tricky extra_arity part is described in - Note [Arity inference in kcCheckDeclHeader_sig] - -Note [Arity inference in kcCheckDeclHeader_sig] +Note [Arity of type families and type synonyms] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider these declarations: - type family S1 :: forall k2. k1 -> k2 -> Type - type family S2 (a :: k1) (b :: k2) :: Type - -Both S1 and S2 can be given the same standalone kind signature: - type S1 :: forall k1 k2. k1 -> k2 -> Type - type S2 :: forall k1 k2. k1 -> k2 -> Type - -And, indeed, tyConKind S1 == tyConKind S2. However, -tyConBinders and tyConResKind for S1 and S2 are different: - - tyConBinders S1 == [spec k1] - tyConResKind S1 == forall k2. k1 -> k2 -> Type - tyConKind S1 == forall k1 k2. k1 -> k2 -> Type - - tyConBinders S2 == [spec k1, spec k2, anon-vis (a :: k1), anon-vis (b :: k2)] - tyConResKind S2 == Type - tyConKind S1 == forall k1 k2. k1 -> k2 -> Type - -This difference determines the /arity/: - tyConArity tc == length (tyConBinders tc) -That is, the arity of S1 is 1, while the arity of S2 is 4. - -'kcCheckDeclHeader_sig' needs to infer the desired arity, to split the -standalone kind signature into binders and the result kind. It does so -in two rounds: - -1. matchUpSigWithDecl matches up - - the [TyConBinder] from (applying splitTyConKind to) the kind signature - - with the [LHsTyVarBndr] from the type declaration. - That may leave some excess TyConBinder: in the case of S2 there are - no excess TyConBinders, but in the case of S1 there are two (since - there are no LHsTYVarBndrs. - -2. Split off further TyConBinders (in the case of S1, one more) to - make it possible to unify the residual return kind with the - signature in the type declaration. More precisely, split off such - enough invisible that the remainder of the standalone kind - signature and the user-written result kind signature have the same - number of invisible quantifiers. - -As another example consider the following declarations: +Consider - type F :: Type -> forall j. j -> forall k1 k2. (k1, k2) -> Type - type family F a b + type F0 :: forall k. k -> k -> Type + type family F0 - type G :: Type -> forall j. j -> forall k1 k2. (k1, k2) -> Type - type family G a b :: forall r2. (r1, r2) -> Type + type F1 :: forall k. k -> k -> Type + type family F1 @k -For both F and G, the signature (after splitTyConKind) has - sig_tcbs :: [TyConBinder] - = [ anon-vis (@a_aBq), spec (@j_auA), anon-vis (@(b_aBr :: j_auA)) - , spec (@k1_auB), spec (@k2_auC) - , anon-vis (@(c_aBs :: (k1_auB, k2_auC)))] + type F2a :: forall k. k -> k -> Type + type family F2a @k a -matchUpSigWithDecl will consume the first three of these, passing on - excess_sig_tcbs - = [ spec (@k1_auB), spec (@k2_auC) - , anon-vis (@(c_aBs :: (k1_auB, k2_auC)))] + type F2b :: forall k. k -> k -> Type + type family F2b a -For F, there is no result kind signature in the declaration for F, so -we absorb all invisible binders into F's arity. The resulting arity of -F is 3+2=5. + type F3 :: forall k. k -> k -> Type + type family F3 a b -Now, in the case of G, we have a result kind sig 'forall r2. (r2,r2)->Type'. -This has one invisible binder, so we split of enough extra binders from -our excess_sig_tcbs to leave just one to match 'r2'. +All five have the same /kind/, but what /arity/ do they have? +For a type family, the arity is critical: +* A type family must always appear saturated (up to its arity) +* A type family can match only on `arity` arguments, not further ones +* The arity is recorded by `tyConArity`, and is equal to the number of + `TyConBinders` in the `TyCon`. +* In this context "arity" includes both kind and type arguments. - res_ki = forall r2. (r1, r2) -> Type - kisig = forall k1 k2. (k1, k2) -> Type - ^^^ - split off this one. +The arity is not determined by the kind signature (all five have the same signature). +Rather, it is determined by the declaration of the family: +* `F0` has arity 0. +* `F1` has arity 1. +* `F2a` has arity 2. +* `F2b` also has arity 2: the kind argument is invisible. +* `F3` has arity 3; again the kind argument is invisible. -The resulting arity of G is 3+1=4. +The matching-up of kind signature with the declaration itself is done by +`matchUpWithSigDecl`. Note [discardResult in kcCheckDeclHeader_sig] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2950,6 +2917,12 @@ data ContextKind = TheKind TcKind -- ^ a specific kind | AnyKind -- ^ any kind will do | OpenKind -- ^ something of the form @TYPE _@ +-- debug only +instance Outputable ContextKind where + ppr AnyKind = text "AnyKind" + ppr OpenKind = text "OpenKind" + ppr (TheKind k) = text "TheKind" <+> ppr k + ----------------------- newExpectedKind :: ContextKind -> TcM TcKind newExpectedKind (TheKind k) = return k ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -797,7 +797,7 @@ tcTExpTy m_ty exp_ty TcRnTHError $ TypedTHError $ TypedTHWithPolyType exp_ty ; codeCon <- tcLookupTyCon codeTyConName ; let rep = getRuntimeRep exp_ty - ; return (mkTyConApp codeCon [rep, m_ty, exp_ty]) } + ; return (mkTyConApp codeCon [m_ty, rep, exp_ty]) } quotationCtxtDoc :: LHsExpr GhcRn -> SDoc quotationCtxtDoc br_body ===================================== compiler/GHC/Types/Unique/DFM.hs ===================================== @@ -94,7 +94,7 @@ import qualified Data.IntSet as I -- order then `udfmToList` returns them in deterministic order. -- -- There is an implementation cost: each element is given a serial number --- as it is added, and `udfmToList` sorts it's result by this serial +-- as it is added, and `udfmToList` sorts its result by this serial -- number. So you should only use `UniqDFM` if you need the deterministic -- property. -- ===================================== configure.ac ===================================== @@ -487,7 +487,6 @@ CFLAGS="$CFLAGS $GccUseLdOpt" AC_SUBST([LdCmd]) FP_PROG_LD_IS_GNU -FP_PROG_LD_BUILD_ID FP_PROG_LD_NO_COMPACT_UNWIND FP_PROG_LD_FILELIST ===================================== distrib/configure.ac.in ===================================== @@ -130,7 +130,6 @@ CFLAGS="$CFLAGS $GccUseLdOpt" AC_SUBST([LdCmd]) FP_PROG_LD_IS_GNU -FP_PROG_LD_BUILD_ID FP_PROG_LD_NO_COMPACT_UNWIND FP_PROG_LD_FILELIST ===================================== docs/users_guide/exts/linear_types.rst ===================================== @@ -14,7 +14,7 @@ Linear types warts, and bad error messages; everything down to the syntax is subject to change**. See, in particular, :ref:`linear-types-limitations` below. We encourage you to experiment -with this extension and report issues in the GHC bug tracker `the GHC +with this extension and report issues in `the GHC bug tracker `__, adding the tag ``LinearTypes``. ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -378,8 +378,13 @@ The splice will evaluate to (MkAge 3) and you can't add that to 4::Int. So you can't coerce a (Code Q Age) to a (Code Q Int). -} -- Code constructor - +#if __GLASGOW_HASKELL__ >= 909 +type Code :: (Kind.Type -> Kind.Type) -> forall r. TYPE r -> Kind.Type + -- The nested `forall` makes it possible to assign the arity of 0 to + -- type CodeQ = Code Q +#else type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type +#endif type role Code representational nominal -- See Note [Role of TExp] newtype Code m a = Code { examineCode :: m (TExp a) -- ^ Underlying monadic value ===================================== libraries/template-haskell/changelog.md ===================================== @@ -1,10 +1,15 @@ # Changelog for [`template-haskell` package](http://hackage.haskell.org/package/template-haskell) +## 2.22.0.0 + + * The kind of `Code` was changed from `forall r. (Type -> Type) -> TYPE r -> Type` + to `(Type -> Type) -> forall r. TYPE r -> Type`. This enables higher-kinded usage. + ## 2.21.0.0 * Record fields now belong to separate `NameSpace`s, keyed by the parent of the record field. This is the name of the first constructor of the parent type, - even if this constructor does not have the field in question. + even if this constructor does not have the field in question. This change enables TemplateHaskell support for `DuplicateRecordFields`. @@ -21,7 +26,7 @@ ## 2.20.0.0 - * The `Ppr.pprInfixT` function has gained a `Precedence` argument. + * The `Ppr.pprInfixT` function has gained a `Precedence` argument. * The values of named precedence levels like `Ppr.appPrec` have changed. * Add `TypeDataD` constructor to the `Dec` type for `type data` ===================================== testsuite/tests/ghci/scripts/T16468.script ===================================== @@ -0,0 +1,52 @@ +:set -XLinearTypes -XImpredicativeTypes +import GHC.Types (RuntimeRep (..), Levity (..), TYPE, Multiplicity, Type, LiftedRep) +import Data.Proxy + +f :: forall p (r' :: RuntimeRep). (forall (r :: RuntimeRep). Int -> p r) -> p r'; f x = x 5 +g :: forall p. Int -> forall (r :: RuntimeRep). p r; g _ = undefined +g' :: Int -> forall p (r :: RuntimeRep). p r; g' _ = undefined +h :: Int -> forall (r :: RuntimeRep). TYPE r; h _ = undefined +i :: forall (r :: RuntimeRep). Int -> TYPE r; i _ = undefined +j :: forall p. Eq (p ('BoxedRep 'Lifted)) => Int -> forall (r :: RuntimeRep). p r; j _ = undefined +k :: forall p (r' :: RuntimeRep). Eq (p r') => (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) -> p r'; k x = x 5 +class C a where l :: forall (r :: RuntimeRep) (b :: TYPE r). a -> b +m :: (forall (m :: Multiplicity). Int %m -> Int) -> Int; m x = x 5 +n :: forall (m :: Multiplicity). Int %m -> Int; n a = a +o :: Maybe (forall (r :: RuntimeRep). Proxy r); o = Nothing +p :: (forall (r :: RuntimeRep). Proxy r, Int); p = undefined +q :: p (forall (r :: RuntimeRep). Proxy r); q = undefined +r :: forall (a :: (forall (r :: RuntimeRep). TYPE r)) (p :: (forall (r :: RuntimeRep). TYPE r) -> Type). p a; r = r + +:set -XNoLinearTypes + +:type f +:type g +:type g' +:type h +:type i +:type j +:type k +:type l +:type m +:type n +:type o +:type p +:type q +:type r + +:set -fprint-explicit-runtime-reps +:set -XLinearTypes +:type f +:type g +:type g' +:type h +:type i +:type j +:type k +:type l +:type m +:type n +:type o +:type p +:type q +:type r ===================================== testsuite/tests/ghci/scripts/T16468.stdout ===================================== @@ -0,0 +1,34 @@ +f :: (forall (r :: RuntimeRep). Int -> p r) -> p LiftedRep +g :: Int -> p LiftedRep +g' :: Int -> forall (p :: RuntimeRep -> *). p LiftedRep +h :: Int -> * +i :: Int -> * +j :: Eq (p LiftedRep) => Int -> p LiftedRep +k :: Eq (p LiftedRep) => + (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) -> p LiftedRep +l :: C a => a -> b +m :: (forall (m :: Multiplicity). Int %m -> Int) -> Int +n :: Int -> Int +o :: Maybe (forall (r :: RuntimeRep). Proxy r) +p :: (Proxy LiftedRep, Int) +q :: p (forall (r :: RuntimeRep). Proxy r) +r :: forall (a :: forall (r :: RuntimeRep). TYPE r) + (p :: (forall (r :: RuntimeRep). TYPE r) -> *). + p a +f :: (forall (r :: RuntimeRep). Int -> p r) -> p r' +g :: Int -> forall (r :: RuntimeRep). p r +g' :: Int -> forall (p :: RuntimeRep -> *) (r :: RuntimeRep). p r +h :: Int -> forall (r :: RuntimeRep). TYPE r +i :: Int -> TYPE r +j :: Eq (p LiftedRep) => Int -> forall (r :: RuntimeRep). p r +k :: Eq (p r') => + (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) -> p r' +l :: forall a (r :: RuntimeRep) (b :: TYPE r). C a => a -> b +m :: (forall (m :: Multiplicity). Int %m -> Int) -> Int +n :: Int %m -> Int +o :: Maybe (forall (r :: RuntimeRep). Proxy r) +p :: (forall (r :: RuntimeRep). Proxy r, Int) +q :: p (forall (r :: RuntimeRep). Proxy r) +r :: forall (a :: forall (r :: RuntimeRep). TYPE r) + (p :: (forall (r :: RuntimeRep). TYPE r) -> *). + p a ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -375,3 +375,4 @@ test('T22695', normal, ghci_script, ['T22695.script']) test('T22817', normal, ghci_script, ['T22817.script']) test('T22908', normal, ghci_script, ['T22908.script']) test('T23062', normal, ghci_script, ['T23062.script']) +test('T16468', normal, ghci_script, ['T16468.script']) ===================================== testsuite/tests/perf/compiler/CoOpt_Singletons.hs ===================================== @@ -52,7 +52,7 @@ type SameKind :: k -> k -> Constraint type SameKind (a :: k) (b :: k) = (() :: Constraint) type Sing :: k -> Type -type family Sing :: k -> Type +type family Sing @k :: k -> Type type SLambda :: (k1 ~> k2) -> Type newtype SLambda (f :: k1 ~> k2) = @@ -386,7 +386,7 @@ type family (<>@#@$$$) (a6989586621679047054 :: a_a9GJ) (a6989586621679047055 :: class PSemigroup a_a9GJ where type family (<>) (arg_a9GX :: a_a9GJ) (arg_a9GY :: a_a9GJ) :: a_a9GJ type MemptySym0 :: forall a_a9GK. a_a9GK -type family MemptySym0 :: a_a9GK where +type family MemptySym0 @a_a9GK :: a_a9GK where MemptySym0 = Mempty type MappendSym0 :: forall a_a9GK. (~>) a_a9GK ((~>) a_a9GK a_a9GK) data MappendSym0 :: (~>) a_a9GK ((~>) a_a9GK a_a9GK) @@ -450,10 +450,10 @@ type family TFHelper_6989586621679047079Sym2 (a6989586621679047084 :: Dual a_a9G instance PSemigroup (Dual a_a9GL) where type (<>) a_a9Hn a_a9Ho = Apply (Apply TFHelper_6989586621679047079Sym0 a_a9Hn) a_a9Ho type Mempty_6989586621679047088 :: Dual a_a9GO -type family Mempty_6989586621679047088 :: Dual a_a9GO where +type family Mempty_6989586621679047088 @a_a9GO :: Dual a_a9GO where Mempty_6989586621679047088 = Apply DualSym0 MemptySym0 type Mempty_6989586621679047088Sym0 :: Dual a_a9GO -type family Mempty_6989586621679047088Sym0 :: Dual a_a9GO where +type family Mempty_6989586621679047088Sym0 @a_a9GO :: Dual a_a9GO where Mempty_6989586621679047088Sym0 = Mempty_6989586621679047088 instance PMonoid (Dual a_a9GO) where type Mempty = Mempty_6989586621679047088Sym0 @@ -549,10 +549,10 @@ type family TFHelper_6989586621679075091Sym2 (a6989586621679075096 :: Endo a_agC instance PSemigroup (Endo a_agCk) where type (<>) a_agZb a_agZc = Apply (Apply TFHelper_6989586621679075091Sym0 a_agZb) a_agZc type Mempty_6989586621679075313 :: Endo a_agCn -type family Mempty_6989586621679075313 :: Endo a_agCn where +type family Mempty_6989586621679075313 @a_agCn :: Endo a_agCn where Mempty_6989586621679075313 = Apply EndoSym0 IdSym0 type Mempty_6989586621679075313Sym0 :: Endo a_agCn -type family Mempty_6989586621679075313Sym0 :: Endo a_agCn where +type family Mempty_6989586621679075313Sym0 @a_agCn :: Endo a_agCn where Mempty_6989586621679075313Sym0 = Mempty_6989586621679075313 instance PMonoid (Endo a_agCn) where type Mempty = Mempty_6989586621679075313Sym0 ===================================== testsuite/tests/saks/should_compile/T16724.stdout ===================================== @@ -1,6 +1,6 @@ type T1 :: forall k (a :: k). Type -type family T1 @k @a +type family T1 -- Defined at T16724.hs:11:1 type T2 :: forall {k} (a :: k). Type -type family T2 @{k} @a +type family T2 -- Defined at T16724.hs:15:1 ===================================== testsuite/tests/saks/should_compile/saks030.hs ===================================== @@ -10,7 +10,7 @@ import Data.Type.Equality type T1 :: forall k (a :: k). Bool type T2 :: k -> Bool -type family T1 where +type family T1 @k @a where T1 @Bool @True = False T1 @Bool @False = True ===================================== testsuite/tests/saks/should_compile/saks032.hs ===================================== @@ -18,4 +18,4 @@ type F1 :: Type -> forall j. j -> forall k1 k2. (k1, k2) -> Type type family F1 a b type F2 :: Type -> forall j. j -> forall k1 k2. (k1, k2) -> Type -type family F2 a b :: forall r2. (r1, r2) -> Type +type family F2 a b @r1 :: forall r2. (r1, r2) -> Type ===================================== testsuite/tests/th/CodeQ_HKD.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE TemplateHaskell #-} + +module CodeQ_HKD where +import GHC.Exts +import Data.Kind +import Language.Haskell.TH hiding (Type) + +data T (f :: forall r . (TYPE r) -> Type) = MkT (f Int) (f Int#) + + +tcodeq :: T CodeQ +tcodeq = MkT [||5||] [||5#||] ===================================== testsuite/tests/th/all.T ===================================== @@ -579,3 +579,4 @@ test('T22559a', normal, compile_fail, ['']) test('T22559b', normal, compile_fail, ['']) test('T22559c', normal, compile_fail, ['']) test('T23525', normal, compile, ['']) +test('CodeQ_HKD', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_compile/T23514b.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies, DataKinds #-} +module T23514b where + +import GHC.Types + +type F :: Type -> forall k. Maybe k +type family F x @k where + F Int @Type = Just Bool + F Int = Just Either ===================================== testsuite/tests/typecheck/should_compile/T23514c.hs ===================================== @@ -0,0 +1,21 @@ +module T23514c where +import Data.Kind + + +type P1 :: forall k (a :: k) . k -> Type +data P1 :: k -> Type + +type P2 :: forall k (a :: k) . k -> Type +data P2 @k :: k -> Type + +type P3 :: forall k (a :: k) . k -> Type +data P3 @k @a :: k -> Type + +type P4 :: forall k (a :: k) . k -> Type +data P4 :: forall k (a :: k) . k -> Type + +type P5 :: forall k (a :: k) . k -> Type +data P5 :: forall a . k -> Type + +type P6 :: forall k (a :: k) . k -> Type +data P6 @k :: forall a . k -> Type ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -880,3 +880,5 @@ test('T22560b', normal, compile, ['']) test('T22560c', normal, compile, ['']) test('T22560d', extra_files(['T22560d.hs']), ghci_script, ['T22560d.script']) test('T22560e', normal, compile, ['']) +test('T23514b', normal, compile, ['']) +test('T23514c', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/T18640a.hs ===================================== @@ -8,4 +8,4 @@ module T18640a where import Data.Kind type F2 :: forall a b. Type -> a -type family F2 :: forall b. Type -> Type where +type family F2 @a :: forall b. Type -> Type where ===================================== testsuite/tests/typecheck/should_fail/T18640a.stderr ===================================== @@ -5,5 +5,5 @@ T18640a.hs:11:1: error: [GHC-25897] Actual: forall (b :: k). * -> a ‘a’ is a rigid type variable bound by the type family declaration for ‘F2’ - at T18640a.hs:10:19 + at T18640a.hs:11:17 • In the type family declaration for ‘F2’ ===================================== testsuite/tests/typecheck/should_fail/T18640c.hs ===================================== @@ -11,4 +11,4 @@ type F1 :: forall k -> Type type family F1 k :: Type type F2 :: forall x. forall k -> x -type F2 = F1 +type F2 k = F1 k ===================================== testsuite/tests/typecheck/should_fail/T18640c.stderr ===================================== @@ -1,10 +1,8 @@ -T18640c.hs:14:11: error: [GHC-25897] - • Couldn't match kind ‘x’ with ‘*’ - Expected kind ‘forall (k1 :: k) -> x’, - but ‘F1’ has kind ‘forall (k1 :: k) -> *’ +T18640c.hs:14:13: error: [GHC-25897] + • Expected kind ‘x’, but ‘F1 k’ has kind ‘*’ ‘x’ is a rigid type variable bound by the type synonym declaration for ‘F2’ at T18640c.hs:13:19 - • In the type ‘F1’ + • In the type ‘F1 k’ In the type declaration for ‘F2’ ===================================== testsuite/tests/typecheck/should_fail/T23514a.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies, DataKinds #-} +module T23514a where + +import GHC.Types + +type F :: Type -> forall k. Maybe k +type family F x where + F Int @Type = Just Bool + F Int = Just Either ===================================== testsuite/tests/typecheck/should_fail/T23514a.stderr ===================================== @@ -0,0 +1,6 @@ + +T23514a.hs:9:17: error: [GHC-83865] + • Expected kind ‘forall k. Maybe k’, + but ‘Just Either’ has kind ‘Maybe (* -> * -> *)’ + • In the type ‘Just Either’ + In the type family declaration for ‘F’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -696,3 +696,4 @@ test('VisFlag2', normal, compile_fail, ['']) test('VisFlag3', normal, compile_fail, ['']) test('VisFlag4', normal, compile_fail, ['']) test('VisFlag5', normal, compile_fail, ['']) +test('T23514a', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/931860b8aa7a3e7a9d5d7450b5fb2c58f89532fd...771e6f62d3c9df8fd8ab3362495aad091463ce6b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/931860b8aa7a3e7a9d5d7450b5fb2c58f89532fd...771e6f62d3c9df8fd8ab3362495aad091463ce6b You're receiving 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 Jun 27 15:09:01 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 27 Jun 2023 11:09:01 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Use ghc-platform instead of ghc-boot Message-ID: <649afb8db1374_2402e084dff78453052@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 35b3cc75 by Rodrigo Mesquita at 2023-06-27T16:08:53+01:00 Use ghc-platform instead of ghc-boot - - - - - 5 changed files: - hadrian/cabal.project - hadrian/hadrian.cabal - hadrian/stack.yaml - m4/ghc_toolchain.m4 - utils/ghc-toolchain/ghc-toolchain.cabal Changes: ===================================== hadrian/cabal.project ===================================== @@ -1,5 +1,6 @@ packages: ./ ../utils/ghc-toolchain/ + ../libraries/ghc-platform/ -- This essentially freezes the build plan for hadrian index-state: 2023-03-30T10:00:00Z ===================================== hadrian/hadrian.cabal ===================================== @@ -166,8 +166,8 @@ executable hadrian , text >= 1.2 && < 3 , cryptohash-sha256 >= 0.11 && < 0.12 , base16-bytestring >= 0.1.1 && < 1.1.0.0 + , ghc-platform , ghc-toolchain - , ghc-boot ghc-options: -Wall -Wincomplete-record-updates -Wredundant-constraints ===================================== hadrian/stack.yaml ===================================== @@ -3,6 +3,7 @@ resolver: lts-19.8 packages: - '.' - '../utils/ghc-toolchain' +- '../libraries/ghc-platform' nix: enable: false ===================================== m4/ghc_toolchain.m4 ===================================== @@ -22,7 +22,7 @@ AC_DEFUN([ENABLE_GHC_TOOLCHAIN_ARG], AC_DEFUN([FIND_GHC_TOOLCHAIN], [ "$GHC" -v0 \ - -ilibraries/ghc-boot -iutils/ghc-toolchain/src \ + -ilibraries/ghc-platform/src -iutils/ghc-toolchain/src \ -XNoImplicitPrelude \ -odir actmp-ghc-toolchain -hidir actmp-ghc-toolchain \ utils/ghc-toolchain/Main.hs -o acghc-toolchain ===================================== utils/ghc-toolchain/ghc-toolchain.cabal ===================================== @@ -36,8 +36,7 @@ library filepath, process, transformers, - async, - ghc-boot + ghc-platform hs-source-dirs: src default-language: Haskell2010 @@ -50,6 +49,6 @@ executable ghc-toolchain filepath, process, transformers, - ghc-boot, + ghc-platform, ghc-toolchain default-language: Haskell2010 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/35b3cc75b726c94451ec7f61223e0d8df66f2388 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/35b3cc75b726c94451ec7f61223e0d8df66f2388 You're receiving 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 Jun 27 15:40:13 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 27 Jun 2023 11:40:13 -0400 Subject: [Git][ghc/ghc][wip/romes/configure-cpp] 194 commits: Migrate errors in GHC.Tc.Validity Message-ID: <649b02dd7fef0_2402e01635f9c446164a@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/configure-cpp at Glasgow Haskell Compiler / GHC Commits: 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - 371c911e by Rodrigo Mesquita at 2023-06-27T16:39:42+01:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - HACKING.md - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToLlvm.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/LateCC.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/417c37e0d648ddc8420df19dd449adb17f845bf0...371c911eb41bcb5b05280dbcb81ca5f4a991cd45 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/417c37e0d648ddc8420df19dd449adb17f845bf0...371c911eb41bcb5b05280dbcb81ca5f4a991cd45 You're receiving 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 Jun 27 15:43:05 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 27 Jun 2023 11:43:05 -0400 Subject: [Git][ghc/ghc][wip/romes/drop-ld] 159 commits: Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) Message-ID: <649b0389f2e4b_2402e03515b284623a2@gitlab.mail> Ben Gamari pushed to branch wip/romes/drop-ld at Glasgow Haskell Compiler / GHC Commits: 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - cdc6d6b7 by Rodrigo Mesquita at 2023-06-27T11:39:22-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - HACKING.md - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/CallerCC.hs - − compiler/GHC/Core/Opt/CallerCC.hs-boot - + compiler/GHC/Core/Opt/CallerCC/Types.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/CoreToIface.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e7703d1d5003427312ff9278683b72ac9409444f...cdc6d6b711a4b802fd6faa578dae5ae029ca3c22 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e7703d1d5003427312ff9278683b72ac9409444f...cdc6d6b711a4b802fd6faa578dae5ae029ca3c22 You're receiving 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 Jun 27 15:45:33 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 27 Jun 2023 11:45:33 -0400 Subject: [Git][ghc/ghc][wip/romes/drop-ld] Stop configuring unused Ld command in `settings` Message-ID: <649b041d11d84_2402e03515b284679c5@gitlab.mail> Ben Gamari pushed to branch wip/romes/drop-ld at Glasgow Haskell Compiler / GHC Commits: 4120a0ea by Rodrigo Mesquita at 2023-06-27T11:45:19-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - 13 changed files: - configure.ac - distrib/configure.ac.in - ghc/Main.hs - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - m4/fp_prog_ld_filelist.m4 - m4/fp_prog_ld_flag.m4 - m4/fp_prog_ld_is_gnu.m4 - m4/fp_prog_ld_no_compact_unwind.m4 - m4/fp_settings.m4 Changes: ===================================== configure.ac ===================================== @@ -482,9 +482,7 @@ FIND_LD([$target],[GccUseLdOpt]) FIND_MERGE_OBJECTS() CONF_GCC_LINKER_OPTS_STAGE1="$CONF_GCC_LINKER_OPTS_STAGE1 $GccUseLdOpt" CONF_GCC_LINKER_OPTS_STAGE2="$CONF_GCC_LINKER_OPTS_STAGE2 $GccUseLdOpt" -LdCmd="$LD" CFLAGS="$CFLAGS $GccUseLdOpt" -AC_SUBST([LdCmd]) FP_PROG_LD_IS_GNU FP_PROG_LD_BUILD_ID @@ -1247,7 +1245,6 @@ echo "\ hs-cpp : $HaskellCPPCmd hs-cpp-flags : $HaskellCPPArgs ar : $ArCmd - ld : $LdCmd nm : $NmCmd objdump : $ObjdumpCmd ranlib : $RanlibCmd ===================================== distrib/configure.ac.in ===================================== @@ -125,9 +125,7 @@ FIND_LD([$target],[GccUseLdOpt]) FIND_MERGE_OBJECTS() CONF_GCC_LINKER_OPTS_STAGE1="$CONF_GCC_LINKER_OPTS_STAGE1 $GccUseLdOpt" CONF_GCC_LINKER_OPTS_STAGE2="$CONF_GCC_LINKER_OPTS_STAGE2 $GccUseLdOpt" -LdCmd="$LD" CFLAGS="$CFLAGS $GccUseLdOpt" -AC_SUBST([LdCmd]) FP_PROG_LD_IS_GNU FP_PROG_LD_BUILD_ID ===================================== ghc/Main.hs ===================================== @@ -627,8 +627,8 @@ mode_flags = "LibDir", "Global Package DB", "C compiler flags", - "C compiler link flags", - "ld flags"], + "C compiler link flags" + ], let k' = "-print-" ++ map (replaceSpace . toLower) k replaceSpace ' ' = '-' replaceSpace c = c ===================================== hadrian/bindist/Makefile ===================================== @@ -87,8 +87,6 @@ lib/settings : config.mk @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ - @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ - @echo ',("ld flags", "$(SettingsLdFlags)")' >> $@ @echo ',("ld supports compact unwind", "$(LdHasNoCompactUnwind)")' >> $@ @echo ',("ld supports filelist", "$(LdHasFilelist)")' >> $@ @echo ',("ld supports response files", "$(LdSupportsResponseFiles)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -263,8 +263,6 @@ SettingsCCompilerFlags = @SettingsCCompilerFlags@ SettingsCxxCompilerFlags = @SettingsCxxCompilerFlags@ SettingsCCompilerLinkFlags = @SettingsCCompilerLinkFlags@ SettingsCCompilerSupportsNoPie = @SettingsCCompilerSupportsNoPie@ -SettingsLdCommand = @SettingsLdCommand@ -SettingsLdFlags = @SettingsLdFlags@ SettingsMergeObjectsCommand = @SettingsMergeObjectsCommand@ SettingsMergeObjectsFlags = @SettingsMergeObjectsFlags@ SettingsArCommand = @SettingsArCommand@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -11,7 +11,7 @@ autoreconf = @AutoreconfCmd@ cc = @CC@ happy = @HappyCmd@ hs-cpp = @HaskellCPPCmd@ -ld = @LdCmd@ +ld = @LD@ make = @MakeCmd@ nm = @NmCmd@ merge-objects = @MergeObjsCmd@ @@ -151,8 +151,6 @@ settings-c-compiler-flags = @SettingsCCompilerFlags@ settings-cxx-compiler-flags = @SettingsCxxCompilerFlags@ settings-c-compiler-link-flags = @SettingsCCompilerLinkFlags@ settings-c-compiler-supports-no-pie = @SettingsCCompilerSupportsNoPie@ -settings-ld-command = @SettingsLdCommand@ -settings-ld-flags = @SettingsLdFlags@ settings-merge-objects-command = @SettingsMergeObjectsCommand@ settings-merge-objects-flags = @SettingsMergeObjectsFlags@ settings-ar-command = @SettingsArCommand@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -115,8 +115,6 @@ data SettingsFileSetting | SettingsFileSetting_CxxCompilerFlags | SettingsFileSetting_CCompilerLinkFlags | SettingsFileSetting_CCompilerSupportsNoPie - | SettingsFileSetting_LdCommand - | SettingsFileSetting_LdFlags | SettingsFileSetting_MergeObjectsCommand | SettingsFileSetting_MergeObjectsFlags | SettingsFileSetting_ArCommand @@ -214,8 +212,6 @@ settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_CxxCompilerFlags -> "settings-cxx-compiler-flags" SettingsFileSetting_CCompilerLinkFlags -> "settings-c-compiler-link-flags" SettingsFileSetting_CCompilerSupportsNoPie -> "settings-c-compiler-supports-no-pie" - SettingsFileSetting_LdCommand -> "settings-ld-command" - SettingsFileSetting_LdFlags -> "settings-ld-flags" SettingsFileSetting_MergeObjectsCommand -> "settings-merge-objects-command" SettingsFileSetting_MergeObjectsFlags -> "settings-merge-objects-flags" SettingsFileSetting_ArCommand -> "settings-ar-command" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -446,8 +446,6 @@ generateSettings = do , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags) - , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand) - , ("ld flags", expr $ settingsFileSetting SettingsFileSetting_LdFlags) , ("ld supports compact unwind", expr $ lookupSystemConfig "ld-has-no-compact-unwind") , ("ld supports filelist", expr $ lookupSystemConfig "ld-has-filelist") , ("ld supports response files", expr $ lookupSystemConfig "ld-supports-response-files") ===================================== m4/fp_prog_ld_filelist.m4 ===================================== @@ -12,7 +12,7 @@ AC_CACHE_CHECK([whether ld understands -filelist], [fp_cv_ld_has_filelist], ${CC-cc} -c conftest2.c echo conftest1.o > conftest.o-files echo conftest2.o >> conftest.o-files - if ${LdCmd} -r -filelist conftest.o-files -o conftest.o > /dev/null 2>&1 + if $LD -r -filelist conftest.o-files -o conftest.o > /dev/null 2>&1 then fp_cv_ld_has_filelist=yes else ===================================== m4/fp_prog_ld_flag.m4 ===================================== @@ -7,7 +7,7 @@ AC_DEFUN([FP_PROG_LD_FLAG], AC_CACHE_CHECK([whether ld understands $1], [fp_cv_$2], [echo 'int foo() { return 0; }' > conftest.c ${CC-cc} -c conftest.c -if ${LdCmd} -r $1 -o conftest2.o conftest.o > /dev/null 2>&1; then +if $LD -r $1 -o conftest2.o conftest.o > /dev/null 2>&1; then fp_cv_$2=$1 else fp_cv_$2= ===================================== m4/fp_prog_ld_is_gnu.m4 ===================================== @@ -4,7 +4,7 @@ # GNU ld or not. AC_DEFUN([FP_PROG_LD_IS_GNU],[ AC_CACHE_CHECK([whether ld is GNU ld], [fp_cv_gnu_ld], -[[if ${LdCmd} --version 2> /dev/null | grep "GNU" > /dev/null 2>&1; then +[[if $LD --version 2> /dev/null | grep "GNU" > /dev/null 2>&1; then fp_cv_gnu_ld=YES else fp_cv_gnu_ld=NO ===================================== m4/fp_prog_ld_no_compact_unwind.m4 ===================================== @@ -7,7 +7,7 @@ AC_DEFUN([FP_PROG_LD_NO_COMPACT_UNWIND], AC_CACHE_CHECK([whether ld understands -no_compact_unwind], [fp_cv_ld_no_compact_unwind], [echo 'int foo() { return 0; }' > conftest.c ${CC-cc} -c conftest.c -if ${LdCmd} -r -no_compact_unwind -o conftest2.o conftest.o > /dev/null 2>&1; then +if $LD -r -no_compact_unwind -o conftest2.o conftest.o > /dev/null 2>&1; then fp_cv_ld_no_compact_unwind=yes else fp_cv_ld_no_compact_unwind=no ===================================== m4/fp_settings.m4 ===================================== @@ -16,8 +16,6 @@ AC_DEFUN([FP_SETTINGS], SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2 -L\$\$tooldir/mingw/lib -L\$\$tooldir/mingw/x86_64-w64-mingw32/lib" SettingsHaskellCPPCommand="${mingw_bin_prefix}clang.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs -I\$\$tooldir/mingw/include" - SettingsLdCommand="${mingw_bin_prefix}ld.lld.exe" - SettingsLdFlags="" # LLD does not support object merging (#21068) SettingsMergeObjectsCommand="" SettingsMergeObjectsFlags="" @@ -38,8 +36,6 @@ AC_DEFUN([FP_SETTINGS], SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" - SettingsLdCommand="$LdCmd" - SettingsLdFlags="$CONF_LD_LINKER_OPTS_STAGE2" SettingsArCommand="$ArCmd" SettingsRanlibCommand="$RanlibCmd" SettingsMergeObjectsCommand="$MergeObjsCmd" @@ -113,8 +109,6 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCxxCompilerFlags) AC_SUBST(SettingsCCompilerLinkFlags) AC_SUBST(SettingsCCompilerSupportsNoPie) - AC_SUBST(SettingsLdCommand) - AC_SUBST(SettingsLdFlags) AC_SUBST(SettingsMergeObjectsCommand) AC_SUBST(SettingsMergeObjectsFlags) AC_SUBST(SettingsArCommand) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4120a0eabe2de91c7b84080daa625b5b5bfb0a0e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4120a0eabe2de91c7b84080daa625b5b5bfb0a0e You're receiving 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 Jun 27 17:16:23 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Tue, 27 Jun 2023 13:16:23 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/sand-witch/dep-anal Message-ID: <649b19678ab4c_12d3acc76644219@gitlab.mail> Andrei Borzenkov pushed new branch wip/sand-witch/dep-anal at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/sand-witch/dep-anal You're receiving 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 Jun 27 18:06:25 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 27 Jun 2023 14:06:25 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] Interpolate LeadingUnderscore in distrib/configure.ac.in Message-ID: <649b252157023_12d3acc761451960@gitlab.mail> Ben Gamari pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 537b9c4d by Ben Gamari at 2023-06-27T14:05:56-04:00 Interpolate LeadingUnderscore in distrib/configure.ac.in - - - - - 3 changed files: - distrib/configure.ac.in - hadrian/bindist/Makefile - mk/project.mk.in Changes: ===================================== distrib/configure.ac.in ===================================== @@ -57,10 +57,12 @@ if test "$target" != "$host" ; then # configure: error: cannot run C compiled programs. # If you meant to cross compile, use `--host'. fi +LeadingUnderscore="@LeadingUnderscore@" CrossCompilePrefix="@CrossCompilePrefix@" TargetPlatformFull="${target}" TablesNextToCode="@TablesNextToCode@" +AC_SUBST(LeadingUnderscore) AC_SUBST(CrossCompiling) AC_SUBST(CrossCompilePrefix) AC_SUBST(TargetPlatformFull) ===================================== hadrian/bindist/Makefile ===================================== @@ -1,7 +1,10 @@ MAKEFLAGS += --no-builtin-rules .SUFFIXES: +# Configuration from the source distribution's configure script. include ./mk/project.mk + +# Configuration from the binary distribution's configure script. include ./config.mk .PHONY: default ===================================== mk/project.mk.in ===================================== @@ -123,11 +123,6 @@ BuildVendor_CPP = @BuildVendor_CPP@ # ################################################################################ -# Leading underscores on symbol names in object files -# Valid options: YES/NO -# -LeadingUnderscore=@LeadingUnderscore@ - # Pin a suffix on executables? If so, what (Windows only). exeext0=@exeext_host@ exeext1=@exeext_target@ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/537b9c4d285cfdcfe7c9ec5e525edbf744426ddb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/537b9c4d285cfdcfe7c9ec5e525edbf744426ddb You're receiving 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 Jun 27 18:13:09 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 27 Jun 2023 14:13:09 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 3 commits: configure: Create and validate toolchain target file Message-ID: <649b26b5527df_12d3acc7614543d1@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: e28c75cf by Rodrigo Mesquita at 2023-06-27T19:12:48+01:00 configure: Create and validate toolchain target file Interpolate LeadingUnderscore in distrib/configure.ac.in - - - - - 8b8d1341 by Rodrigo Mesquita at 2023-06-27T19:12:51+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - 60765db6 by Rodrigo Mesquita at 2023-06-27T19:12:51+01:00 Use ghc-platform instead of ghc-boot - - - - - 26 changed files: - configure.ac - + default.target.in - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/hadrian.cabal - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Default.hs - hadrian/stack.yaml - libraries/ghc-boot/ghc-boot.cabal.in - + libraries/ghc-platform/CHANGELOG.md - + libraries/ghc-platform/LICENSE - + libraries/ghc-platform/ghc-platform.cabal - libraries/ghc-boot/GHC/Platform/ArchOS.hs → libraries/ghc-platform/src/GHC/Platform/ArchOS.hs - m4/fp_prog_ar_needs_ranlib.m4 - m4/ghc_toolchain.m4 - + m4/prep_target_file.m4 - mk/project.mk.in - utils/ghc-toolchain/Main.hs - utils/ghc-toolchain/ghc-toolchain.cabal - utils/ghc-toolchain/src/GHC/Toolchain/Target.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs - utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs Changes: ===================================== configure.ac ===================================== @@ -644,7 +644,6 @@ dnl CONF_CC_OPTS_STAGE[012] accordingly. FP_CC_SUPPORTS_TARGET([$CC_STAGE0], [CONF_CC_OPTS_STAGE0], [CONF_CXX_OPTS_STAGE0], [CONF_GCC_LINKER_OPTS_STAGE0]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE1], [CONF_CXX_OPTS_STAGE1], [CONF_GCC_LINKER_OPTS_STAGE1]) FP_CC_SUPPORTS_TARGET([$CC], [CONF_CC_OPTS_STAGE2], [CONF_CXX_OPTS_STAGE2], [CONF_GCC_LINKER_OPTS_STAGE2]) -FIND_GHC_TOOLCHAIN dnl Pass -Qunused-arguments or otherwise GHC will have very noisy invocations of Clang dnl TODO: Do we need -Qunused-arguments in CXX and GCC linker too? @@ -1177,6 +1176,10 @@ checkMake380() { checkMake380 make checkMake380 gmake +# Toolchain target files +PREP_TARGET_FILE +FIND_GHC_TOOLCHAIN + AC_CONFIG_FILES( [ mk/project.mk hadrian/cfg/system.config @@ -1185,6 +1188,7 @@ AC_CONFIG_FILES( hadrian/ghci-stack docs/users_guide/ghc_config.py distrib/configure.ac + default.target ]) dnl Create the VERSION file, satisfying #22322. @@ -1285,3 +1289,6 @@ mk/build.mk.sample to mk/build.mk, and edit the settings in there. For more information on how to configure your GHC build, see https://gitlab.haskell.org/ghc/ghc/wikis/building "] + +VALIDATE_GHC_TOOLCHAIN + ===================================== default.target.in ===================================== @@ -0,0 +1,39 @@ +Target +{ tgtArchOs = ArchOS {archOS_arch = @HaskellHostArch@, archOS_OS = @HaskellHostOs@} +, tgtVendor = "@HostVendor_CPP@" +, tgtSupportsGnuNonexecStack = @TargetHasGnuNonexecStackBool@ +, tgtSupportsSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbolsBool@ +, tgtSupportsIdentDirective = @TargetHasIdentDirectiveBool@ +, tgtWordSize = WS at TargetWordSize@ +, tgtEndianness = @TargetEndianness@ +, tgtSymbolsHaveLeadingUnderscore = @LeadingUnderscoreBool@ +, tgtLlvmTarget = "@LlvmTarget@" +, tgtUnregisterised = @UnregisterisedBool@ +, tgtTablesNextToCode = @TablesNextToCodeBool@ +, tgtUseLibffiForAdjustors = @UseLibffiForAdjustorsBool@ +, tgtCCompiler = Cc {ccProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @SettingsCCompilerFlagsList@}} +, tgtCxxCompiler = Cxx {cxxProgram = Program {prgPath = "@SettingsCxxCompilerCommand@", prgFlags = @SettingsCxxCompilerFlagsList@}} +, tgtCPreprocessor = Cpp {cppProgram = Program {prgPath = "@CPPCmd@", prgFlags = @CONF_CPP_OPTS_STAGE1List@}} +, tgtHsCPreprocessor = HsCpp {hsCppProgram = Program {prgPath = "@HaskellCPPCmd@", prgFlags = @HaskellCPPArgsList@}} +, tgtCCompilerLink = CcLink +{ ccLinkProgram = Program {prgPath = "@SettingsCCompilerCommand@", prgFlags = @SettingsCCompilerLinkFlagsList@} +, ccLinkSupportsNoPie = @SettingsCCompilerSupportsNoPieBool@ +, ccLinkSupportsCompactUnwind = @LdHasNoCompactUnwindBool@ +, ccLinkSupportsFilelist = @LdHasFilelistBool@ +, ccLinkIsGnu = @LdIsGNULdBool@ +} + +, tgtAr = Ar +{ arMkArchive = Program {prgPath = "@AR@", prgFlags = @ArArgsList@} +, arIsGnu = @ArIsGNUArBool@ +, arSupportsAtFile = @ArSupportsAtFileBool@ +, arSupportsDashL = @ArSupportsDashLBool@ +, arNeedsRanlib = @ArNeedsRanLibBool@ +} + +, tgtRanlib = Just (Ranlib {ranlibProgram = Program {prgPath = "@REAL_RANLIB_CMD@", prgFlags = []}}) +, tgtNm = Nm {nmProgram = Program {prgPath = "@NmCmd@", prgFlags = []}} +, tgtMergeObjs = Just (MergeObjs {mergeObjsProgram = Program {prgPath = "@SettingsMergeObjectsCommand@", prgFlags = @SettingsMergeObjectsFlagsList@}, mergeObjsSupportsResponseFiles = @MergeObjsSupportsResponseFilesBool@}) +, tgtDllwrap = @DllWrapCmdMaybeProg@ +, tgtWindres = @WindresCmdMaybeProg@ +} ===================================== distrib/configure.ac.in ===================================== @@ -57,10 +57,12 @@ if test "$target" != "$host" ; then # configure: error: cannot run C compiled programs. # If you meant to cross compile, use `--host'. fi +LeadingUnderscore="@LeadingUnderscore@" CrossCompilePrefix="@CrossCompilePrefix@" TargetPlatformFull="${target}" TablesNextToCode="@TablesNextToCode@" +AC_SUBST(LeadingUnderscore) AC_SUBST(CrossCompiling) AC_SUBST(CrossCompilePrefix) AC_SUBST(TargetPlatformFull) @@ -286,6 +288,7 @@ AC_SUBST(UseLibdw) FP_SETTINGS AC_CONFIG_FILES([config.mk]) +AC_CONFIG_FILES([default.target]) AC_OUTPUT # We get caught by @@ -307,6 +310,11 @@ checkMake380() { checkMake380 make checkMake380 gmake +# Toolchain target files +PREP_TARGET_FILE +FIND_GHC_TOOLCHAIN +VALIDATE_GHC_TOOLCHAIN + echo "****************************************************" echo "Configuration done, ready to 'make install'" echo "(see README and INSTALL files for more info.)" ===================================== hadrian/bindist/Makefile ===================================== @@ -1,7 +1,10 @@ MAKEFLAGS += --no-builtin-rules .SUFFIXES: +# Configuration from the source distribution's configure script. include ./mk/project.mk + +# Configuration from the binary distribution's configure script. include ./config.mk .PHONY: default ===================================== hadrian/bindist/config.mk.in ===================================== @@ -254,6 +254,8 @@ TargetHasIdentDirective = @TargetHasIdentDirective@ TargetHasSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbols@ TargetHasLibm = @TargetHasLibm@ TablesNextToCode = @TablesNextToCode@ +LeadingUnderscore = @LeadingUnderscore@ +LlvmTarget = @LlvmTarget@ SettingsCCompilerCommand = @SettingsCCompilerCommand@ SettingsCxxCompilerCommand = @SettingsCxxCompilerCommand@ ===================================== hadrian/cabal.project ===================================== @@ -1,5 +1,6 @@ packages: ./ ../utils/ghc-toolchain/ + ../libraries/ghc-platform/ -- This essentially freezes the build plan for hadrian index-state: 2023-03-30T10:00:00Z ===================================== hadrian/hadrian.cabal ===================================== @@ -166,8 +166,8 @@ executable hadrian , text >= 1.2 && < 3 , cryptohash-sha256 >= 0.11 && < 0.12 , base16-bytestring >= 0.1.1 && < 1.1.0.0 + , ghc-platform , ghc-toolchain - , ghc-boot ghc-options: -Wall -Wincomplete-record-updates -Wredundant-constraints ===================================== hadrian/src/Packages.hs ===================================== @@ -4,7 +4,7 @@ module Packages ( array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, - exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, + exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, @@ -36,7 +36,7 @@ ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps , compareSizes, compiler, containers, deepseq, deriveConstants, directory - , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh + , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell @@ -52,7 +52,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, - exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, + exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, @@ -83,6 +83,7 @@ ghc = prg "ghc-bin" `setPath` "ghc" ghcBignum = lib "ghc-bignum" ghcBoot = lib "ghc-boot" ghcBootTh = lib "ghc-boot-th" +ghcPlatform = lib "ghc-platform" ghcCompact = lib "ghc-compact" ghcConfig = prg "ghc-config" `setPath` "testsuite/ghc-config" ghcHeap = lib "ghc-heap" ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -258,6 +258,7 @@ bindistRules = do need $ map (bindistFilesDir -/-) (["configure", "Makefile"] ++ bindistInstallFiles) copyFile ("hadrian" -/- "bindist" -/- "config.mk.in") (bindistFilesDir -/- "config.mk.in") + copyFile ("default.target.in") (bindistFilesDir -/- "default.target.in") forM_ bin_targets $ \(pkg, _) -> do needed_wrappers <- pkgToWrappers pkg forM_ needed_wrappers $ \wrapper_name -> do ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -158,6 +158,7 @@ toolTargets = [ binary -- , runGhc -- # depends on ghc library , ghcBoot , ghcBootTh + , ghcPlatform , ghcHeap , ghci , ghcPkg -- # executable ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -85,6 +85,7 @@ stage0Packages = do , runGhc , ghcBoot , ghcBootTh + , ghcPlatform , ghcHeap , ghci , ghcPkg ===================================== hadrian/stack.yaml ===================================== @@ -3,6 +3,7 @@ resolver: lts-19.8 packages: - '.' - '../utils/ghc-toolchain' +- '../libraries/ghc-platform' nix: enable: false ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -51,7 +51,6 @@ Library GHC.Serialized GHC.ForeignSrcLang GHC.HandleEncoding - GHC.Platform.ArchOS GHC.Platform.Host GHC.Settings.Utils GHC.UniqueSubdir @@ -65,6 +64,10 @@ Library , GHC.ForeignSrcLang.Type , GHC.Lexeme + -- reexport platform modules from ghc-platform + reexported-modules: + GHC.Platform.ArchOS + -- but done by Hadrian autogen-modules: GHC.Version @@ -77,6 +80,7 @@ Library directory >= 1.2 && < 1.4, filepath >= 1.3 && < 1.5, deepseq >= 1.4 && < 1.5, + ghc-platform >= 0.1, ghc-boot-th == @ProjectVersionMunged@ if !os(windows) build-depends: ===================================== libraries/ghc-platform/CHANGELOG.md ===================================== @@ -0,0 +1,8 @@ +# Revision history for ghc-platform + +## 0.1.0.0 -- 2023-06-20 + +* First version. Split off the `GHC.Platform.ArchOS` module from the + non-reinstallable `ghc-boot` package into this reinstallable standalone + package which abides by the PVP, in part motivated by the ongoing work on + `ghc-toolchain` towards runtime retargetability. ===================================== libraries/ghc-platform/LICENSE ===================================== @@ -0,0 +1,30 @@ +Copyright (c) 2023, Rodrigo Mesquita + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Rodrigo Mesquita nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ===================================== libraries/ghc-platform/ghc-platform.cabal ===================================== @@ -0,0 +1,20 @@ +cabal-version: 3.0 +name: ghc-platform +version: 0.1.0.0 +synopsis: Platform information used by GHC and friends +license: BSD-3-Clause +license-file: LICENSE +author: Rodrigo Mesquita +maintainer: ghc-devs at haskell.org +build-type: Simple +extra-doc-files: CHANGELOG.md + +common warnings + ghc-options: -Wall + +library + import: warnings + exposed-modules: GHC.Platform.ArchOS + build-depends: base >=4.15.0.0 + hs-source-dirs: src + default-language: Haskell2010 ===================================== libraries/ghc-boot/GHC/Platform/ArchOS.hs → libraries/ghc-platform/src/GHC/Platform/ArchOS.hs ===================================== ===================================== m4/fp_prog_ar_needs_ranlib.m4 ===================================== @@ -46,4 +46,5 @@ AC_DEFUN([FP_PROG_AR_NEEDS_RANLIB],[ fi AC_SUBST([REAL_RANLIB_CMD]) AC_SUBST([RANLIB_CMD]) + AC_SUBST([ArNeedsRanLib],[`echo $fp_cv_prog_ar_needs_ranlib | tr 'a-z' 'A-Z'`]) ])# FP_PROG_AR_NEEDS_RANLIB ===================================== m4/ghc_toolchain.m4 ===================================== @@ -22,7 +22,7 @@ AC_DEFUN([ENABLE_GHC_TOOLCHAIN_ARG], AC_DEFUN([FIND_GHC_TOOLCHAIN], [ "$GHC" -v0 \ - -ilibraries/ghc-boot -iutils/ghc-toolchain/src \ + -ilibraries/ghc-platform/src -iutils/ghc-toolchain/src \ -XNoImplicitPrelude \ -odir actmp-ghc-toolchain -hidir actmp-ghc-toolchain \ utils/ghc-toolchain/Main.hs -o acghc-toolchain @@ -67,8 +67,19 @@ AC_DEFUN([FIND_GHC_TOOLCHAIN], ) &1` + if test -z "$diff_output"; then + true + else + AC_MSG_WARN([Differences found between $A and $B: $diff_output]) + fi +]) ===================================== m4/prep_target_file.m4 ===================================== @@ -0,0 +1,114 @@ +# PREP_MAYBE_SIMPLE_PROGRAM +# ========================= +# +# Issue a substitution of [$1MaybeProg] with +# * Nothing, if $1 is empty +# * Just (Program {prgPath = "$$1", prgFlags = []}), otherwise +# +# $1 = optional value +AC_DEFUN([PREP_MAYBE_SIMPLE_PROGRAM],[ + if test -z "[$]$1"; then + $1MaybeProg='Nothing' + else + $1MaybeProg='Just (Program {prgPath = "$$1", prgFlags = @<:@@:>@})' + fi + AC_SUBST([$1MaybeProg]) +]) + +# PREP_BOOLEAN +# ============ +# +# Issue a substitution with True/False of [$1Bool] when $1 has YES/NO value +# $1 = boolean variable to substitute +AC_DEFUN([PREP_BOOLEAN],[ + case "$$1" in + YES) + $1Bool=True + ;; + NO) + $1Bool=False + ;; + *) + AC_MSG_ERROR([Expecting YES/NO but got $$1 in $1]) + ;; + esac + AC_SUBST([$1Bool]) +]) + +# PREP_LIST +# ============ +# +# Issue a substitution with ["list","of","args"] of [$1List] when $1 is a +# space-separated list of args +# i.e. +# "arg1 arg2 arg3" +# ==> +# ["arg1","arg2","arg3"] +# +# $1 = list variable to substitute +dnl In autoconf, '@<:@' stands for '[', and '@:>@' for ']'. +AC_DEFUN([PREP_LIST],[ + # shell array + set -- $$1 + $1List="@<:@" + if test "[$]#" -eq 0; then + # no arguments + true + else + $1List="${$1List}\"[$]1\"" + shift # drop first elem + for arg in "[$]@" + do + $1List="${$1List},\"$arg\"" + done + fi + $1List="${$1List}@:>@" + + AC_SUBST([$1List]) +]) + +# Eventually: PREP_BUILD_TARGET_FILE, PREP_HOST_TARGET_FILE, PREP_TARGET_TARGET_FILE +# Prepares required substitutions to generate the target file +AC_DEFUN([PREP_TARGET_FILE],[ + PREP_BOOLEAN([MergeObjsSupportsResponseFiles]) + PREP_BOOLEAN([TargetHasGnuNonexecStack]) + PREP_BOOLEAN([LeadingUnderscore]) + PREP_BOOLEAN([ArSupportsAtFile]) + PREP_BOOLEAN([ArSupportsDashL]) + PREP_BOOLEAN([TargetHasIdentDirective]) + PREP_BOOLEAN([SettingsCCompilerSupportsNoPie]) + PREP_BOOLEAN([LdHasFilelist]) + PREP_BOOLEAN([LdIsGNULd]) + PREP_BOOLEAN([LdHasNoCompactUnwind]) + PREP_BOOLEAN([TargetHasSubsectionsViaSymbols]) + PREP_BOOLEAN([Unregisterised]) + PREP_BOOLEAN([TablesNextToCode]) + PREP_BOOLEAN([UseLibffiForAdjustors]) + PREP_BOOLEAN([ArIsGNUAr]) + PREP_BOOLEAN([ArNeedsRanLib]) + PREP_LIST([SettingsMergeObjectsFlags]) + PREP_LIST([ArArgs]) + PREP_LIST([SettingsCCompilerLinkFlags]) + PREP_LIST([HaskellCPPArgs]) + PREP_LIST([CONF_CPP_OPTS_STAGE1]) + PREP_LIST([SettingsCxxCompilerFlags]) + PREP_LIST([SettingsCCompilerFlags]) + PREP_MAYBE_SIMPLE_PROGRAM([DllWrapCmd]) + PREP_MAYBE_SIMPLE_PROGRAM([WindresCmd]) + + dnl PREP_ENDIANNESS + case "$TargetWordBigEndian" in + YES) + TargetEndianness=BigEndian + ;; + NO) + TargetEndianness=LittleEndian + ;; + *) + AC_MSG_ERROR([Expecting YES/NO but got $TargetWordBigEndian in TargetWordBigEndian]) + ;; + esac + AC_SUBST([TargetEndianness]) +]) + +AC_DEFUN() ===================================== mk/project.mk.in ===================================== @@ -123,11 +123,6 @@ BuildVendor_CPP = @BuildVendor_CPP@ # ################################################################################ -# Leading underscores on symbol names in object files -# Valid options: YES/NO -# -LeadingUnderscore=@LeadingUnderscore@ - # Pin a suffix on executables? If so, what (Windows only). exeext0=@exeext_host@ exeext1=@exeext_target@ ===================================== utils/ghc-toolchain/Main.hs ===================================== @@ -225,7 +225,8 @@ run :: Opts -> M () run opts = do tgt <- mkTarget opts logDebug $ "Final Target: " ++ show tgt - writeFile "default.target" (show tgt) + let file = "default.ghc-toolchain.target" + writeFile file (show tgt) optional :: M a -> M (Maybe a) optional k = fmap Just k <|> pure Nothing ===================================== utils/ghc-toolchain/ghc-toolchain.cabal ===================================== @@ -36,8 +36,7 @@ library filepath, process, transformers, - async, - ghc-boot + ghc-platform hs-source-dirs: src default-language: Haskell2010 @@ -50,6 +49,6 @@ executable ghc-toolchain filepath, process, transformers, - ghc-boot, + ghc-platform, ghc-toolchain default-language: Haskell2010 ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Target.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE RecordWildCards #-} module GHC.Toolchain.Target where import GHC.Platform.ArchOS @@ -60,7 +61,36 @@ data Target = Target , tgtDllwrap :: Maybe Program , tgtWindres :: Maybe Program } - deriving (Show, Read, Eq, Ord) + deriving (Read, Eq, Ord) + +instance Show Target where + show Target{..} = unlines + [ "Target" + , "{ tgtArchOs = " ++ show tgtArchOs + , ", tgtVendor = " ++ show tgtVendor + , ", tgtSupportsGnuNonexecStack = " ++ show tgtSupportsGnuNonexecStack + , ", tgtSupportsSubsectionsViaSymbols = " ++ show tgtSupportsSubsectionsViaSymbols + , ", tgtSupportsIdentDirective = " ++ show tgtSupportsIdentDirective + , ", tgtWordSize = " ++ show tgtWordSize + , ", tgtEndianness = " ++ show tgtEndianness + , ", tgtSymbolsHaveLeadingUnderscore = " ++ show tgtSymbolsHaveLeadingUnderscore + , ", tgtLlvmTarget = " ++ show tgtLlvmTarget + , ", tgtUnregisterised = " ++ show tgtUnregisterised + , ", tgtTablesNextToCode = " ++ show tgtTablesNextToCode + , ", tgtUseLibffiForAdjustors = " ++ show tgtUseLibffiForAdjustors + , ", tgtCCompiler = " ++ show tgtCCompiler + , ", tgtCxxCompiler = " ++ show tgtCxxCompiler + , ", tgtCPreprocessor = " ++ show tgtCPreprocessor + , ", tgtHsCPreprocessor = " ++ show tgtHsCPreprocessor + , ", tgtCCompilerLink = " ++ show tgtCCompilerLink + , ", tgtAr = " ++ show tgtAr + , ", tgtRanlib = " ++ show tgtRanlib + , ", tgtNm = " ++ show tgtNm + , ", tgtMergeObjs = " ++ show tgtMergeObjs + , ", tgtDllwrap = " ++ show tgtDllwrap + , ", tgtWindres = " ++ show tgtDllwrap + , "}" + ] -- | The word size as an integer representing the number of bytes wordSize2Bytes :: WordSize -> Int ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Ar.hs ===================================== @@ -17,7 +17,19 @@ data Ar = Ar { arMkArchive :: Program , arSupportsDashL :: Bool , arNeedsRanlib :: Bool } - deriving (Show, Read, Eq, Ord) + deriving (Read, Eq, Ord) + +-- These instances are more suitable for diffing +instance Show Ar where + show Ar{..} = unlines + [ "Ar" + , "{ arMkArchive = " ++ show arMkArchive + , ", arIsGnu = " ++ show arIsGnu + , ", arSupportsAtFile = " ++ show arSupportsAtFile + , ", arSupportsDashL = " ++ show arSupportsDashL + , ", arNeedsRanlib = " ++ show arNeedsRanlib + , "}" + ] findAr :: Maybe String -- ^ Vendor name from the target triple, if specified -> ProgOpt -> M Ar ===================================== utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs ===================================== @@ -1,5 +1,6 @@ {-# OPTIONS_GHC -Wno-name-shadowing #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE CPP #-} module GHC.Toolchain.Tools.Link ( CcLink(..), findCcLink ) where @@ -23,7 +24,19 @@ data CcLink = CcLink { ccLinkProgram :: Program , ccLinkSupportsFilelist :: Bool -- This too , ccLinkIsGnu :: Bool -- We once thought this could instead be LdSupportsGcSections, but then realized it couldn't IIRC } - deriving (Show, Read, Eq, Ord) + deriving (Read, Eq, Ord) + +-- These instances are more suitable for diffing +instance Show CcLink where + show CcLink{..} = unlines + [ "CcLink" + , "{ ccLinkProgram = " ++ show ccLinkProgram + , ", ccLinkSupportsNoPie = " ++ show ccLinkSupportsNoPie + , ", ccLinkSupportsCompactUnwind = " ++ show ccLinkSupportsCompactUnwind + , ", ccLinkSupportsFilelist = " ++ show ccLinkSupportsFilelist + , ", ccLinkIsGnu = " ++ show ccLinkIsGnu + , "}" + ] _ccLinkProgram :: Lens CcLink Program _ccLinkProgram = Lens ccLinkProgram (\x o -> o{ccLinkProgram=x}) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/537b9c4d285cfdcfe7c9ec5e525edbf744426ddb...60765db6db883b658feb087ddddcb796882d1323 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/537b9c4d285cfdcfe7c9ec5e525edbf744426ddb...60765db6db883b658feb087ddddcb796882d1323 You're receiving 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 Jun 27 18:13:50 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 27 Jun 2023 14:13:50 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 2 commits: Use ghc-platform instead of ghc-boot Message-ID: <649b26deb51f5_12d3acc7600547f4@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 1b43f522 by Rodrigo Mesquita at 2023-06-27T19:13:38+01:00 Use ghc-platform instead of ghc-boot - - - - - eaea989e by Rodrigo Mesquita at 2023-06-27T19:13:38+01:00 Revert "Use ghc-platform instead of ghc-boot" This reverts commit 60765db6db883b658feb087ddddcb796882d1323. - - - - - 0 changed files: Changes: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/60765db6db883b658feb087ddddcb796882d1323...eaea989ed52cb920da990470a9c86f76747dc683 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/60765db6db883b658feb087ddddcb796882d1323...eaea989ed52cb920da990470a9c86f76747dc683 You're receiving 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 Jun 27 19:09:31 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Tue, 27 Jun 2023 15:09:31 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/dep-anal] Put DeclHeaderRn in StandaloneKindSig Message-ID: <649b33ebac11e_12d3acc76006554c@gitlab.mail> Vladislav Zavialov pushed to branch wip/sand-witch/dep-anal at Glasgow Haskell Compiler / GHC Commits: 1ff06bcc by Vladislav Zavialov at 2023-06-27T21:09:16+02:00 Put DeclHeaderRn in StandaloneKindSig - - - - - 3 changed files: - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Rename/Module.hs Changes: ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -26,6 +26,7 @@ module GHC.Hs.Decls ( HsDerivingClause(..), LHsDerivingClause, DerivClauseTys(..), LDerivClauseTys, NewOrData, newOrDataToFlavour, anyLConIsGadt, StandaloneKindSig(..), LStandaloneKindSig, standaloneKindSigName, + DeclHeaderRn(..), LDeclHeaderRn, -- ** Class or type declarations TyClDecl(..), LTyClDecl, DataDeclRn(..), @@ -652,14 +653,52 @@ instance OutputableBndrId p => Outputable (DerivClauseTys (GhcPass p)) where ppr (DctSingle _ ty) = ppr ty ppr (DctMulti _ tys) = parens (interpp'SP tys) +type LDeclHeaderRn = LocatedA DeclHeaderRn + +-- | Renamed declaration header (left-hand side of a declaration): +-- +-- 1. data T a b = MkT (a -> b) +-- ^^^^^^^^^^ +-- +-- 2. class C a where +-- ^^^^^^^^^ +-- +-- 3. type family F a b :: r where +-- ^^^^^^^^^^^^^^^^^^^^^^ +-- +-- Supplies arity and flavor information not covered by a standalone kind +-- signature. +-- +data DeclHeaderRn + = DeclHeaderRn + { decl_header_flav :: TyConFlavour GhcRn, + decl_header_name :: Name, + decl_header_cusk :: Bool, + decl_header_bndrs :: LHsQTyVars GhcRn, + decl_header_res_sig :: Maybe (LHsType GhcRn) + } + +instance Outputable DeclHeaderRn where + ppr (DeclHeaderRn flav name cusk bndrs res_sig) = + ppr flav <+> + ppr name <+> + ppr bndrs <+> + maybe empty ((text "::" <+>) . ppr) res_sig <+> + if cusk then text "{- CUSK -}" else empty + type instance XStandaloneKindSig GhcPs = EpAnn [AddEpAnn] -type instance XStandaloneKindSig GhcRn = NoExtField +type instance XStandaloneKindSig GhcRn = LDeclHeaderRn type instance XStandaloneKindSig GhcTc = NoExtField -type instance XXStandaloneKindSig (GhcPass p) = DataConCantHappen +type instance XXStandaloneKindSig GhcPs = DataConCantHappen +type instance XXStandaloneKindSig GhcRn = LDeclHeaderRn -- CUSK +type instance XXStandaloneKindSig GhcTc = DataConCantHappen -standaloneKindSigName :: StandaloneKindSig (GhcPass p) -> IdP (GhcPass p) +standaloneKindSigName :: forall p. IsPass p => StandaloneKindSig (GhcPass p) -> IdP (GhcPass p) standaloneKindSigName (StandaloneKindSig _ lname _) = unLoc lname +standaloneKindSigName (XStandaloneKindSig x) = + case ghcPass @p of + GhcRn -> decl_header_name (unLoc x) type instance XConDeclGADT (GhcPass _) = EpAnn [AddEpAnn] type instance XConDeclH98 (GhcPass _) = EpAnn [AddEpAnn] @@ -732,6 +771,10 @@ instance OutputableBndrId p => Outputable (StandaloneKindSig (GhcPass p)) where ppr (StandaloneKindSig _ v ki) = text "type" <+> pprPrefixOcc (unLoc v) <+> text "::" <+> ppr ki + ppr (XStandaloneKindSig x) = + case ghcPass @p of + GhcRn -> whenPprDebug $ + text "CUSK:" <+> ppr (decl_header_name (unLoc x)) pp_condecls :: forall p. OutputableBndrId p => [LConDecl (GhcPass p)] -> SDoc pp_condecls cs ===================================== compiler/GHC/Hs/Instances.hs ===================================== @@ -98,6 +98,8 @@ deriving instance Data (FixitySig GhcPs) deriving instance Data (FixitySig GhcRn) deriving instance Data (FixitySig GhcTc) +deriving instance Data DeclHeaderRn + -- deriving instance (DataId p) => Data (StandaloneKindSig p) deriving instance Data (StandaloneKindSig GhcPs) deriving instance Data (StandaloneKindSig GhcRn) ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -1418,10 +1418,15 @@ rnTyClDecls tycl_ds tycls_w_fvs = map (\(L l (t, fv1), fv2) -> (L l t, fv1 `plusFV` fv2)) tycls_w_fvs' tycls_w_fvs_new = map (\(L l (t, fv1), fv2) -> ((L l t, fv1), fv2)) tycls_w_fvs' ; let tc_names = mkNameSet (map (tcdName . unLoc . fst) tycls_w_fvs) + ; let decl_headers = mkNameEnv (map mk_pair tycls_w_fvs_new) + where + mk_pair = \((L l t, _fv1), fv2)-> + let hdr = mkDeclHeaderRn t + in (decl_header_name hdr, (L l hdr, fv2)) ; traceRn "rnTyClDecls" $ vcat [ text "tyClGroupTyClDecls:" <+> ppr tycls_w_fvs , text "tc_names:" <+> ppr tc_names ] - ; kisigs_w_fvs <- rnStandaloneKindSignatures tc_names (tyClGroupKindSigs tycl_ds) + ; kisigs_w_fvs <- rnStandaloneKindSignatures tc_names decl_headers (tyClGroupKindSigs tycl_ds) ; instds_w_fvs <- mapM (wrapLocFstMA rnSrcInstDecl) (tyClGroupInstDecls tycl_ds) ; role_annots <- rnRoleAnnots tc_names (tyClGroupRoleDecls tycl_ds) @@ -1508,26 +1513,31 @@ getKindSigs bndrs kisig_env = mapMaybe (lookupNameEnv kisig_env) bndrs rnStandaloneKindSignatures :: NameSet -- names of types and classes in the current TyClGroup + -> NameEnv (LDeclHeaderRn, FreeVars) -- headers of types and classes in the current HsGroup -> [LStandaloneKindSig GhcPs] -> RnM [(LStandaloneKindSig GhcRn, FreeVars)] -rnStandaloneKindSignatures tc_names kisigs +rnStandaloneKindSignatures tc_names decl_headers 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 + ; mapM (wrapLocFstMA (rnStandaloneKindSignature tc_names decl_headers)) no_dups } rnStandaloneKindSignature :: NameSet -- names of types and classes in the current TyClGroup + -> NameEnv (LDeclHeaderRn, FreeVars) -- headers of types and classes in the current HsGroup -> StandaloneKindSig GhcPs -> RnM (StandaloneKindSig GhcRn, FreeVars) -rnStandaloneKindSignature tc_names (StandaloneKindSig _ v ki) +rnStandaloneKindSignature tc_names decl_headers (StandaloneKindSig _ v ki) = do { standalone_ki_sig_ok <- xoptM LangExt.StandaloneKindSignatures ; unless standalone_ki_sig_ok $ addErr TcRnUnexpectedStandaloneKindSig ; new_v <- lookupSigCtxtOccRn (TopSigCtxt tc_names) (text "standalone kind signature") v ; let doc = StandaloneKindSigCtx (ppr v) ; (new_ki, fvs) <- rnHsSigType doc KindLevel ki - ; return (StandaloneKindSig noExtField new_v new_ki, fvs) + ; let (hdr, hdr_fvs) = case lookupNameEnv decl_headers (unLoc new_v) of + Nothing -> panic "SPANK SPANK SPANK!\nTHE KIND SIGNATURE HAS NO ASSOCIATED DECLARATION" + Just a -> a + ; return (StandaloneKindSig hdr new_v new_ki, fvs `plusFV` hdr_fvs) } depAnalTyClDecls :: GlobalRdrEnv @@ -2718,40 +2728,6 @@ add_sig :: LSig (GhcPass a) -> HsValBinds (GhcPass a) -> HsValBinds (GhcPass a) add_sig s (ValBinds x bs sigs) = ValBinds x bs (s:sigs) add_sig _ (XValBindsLR {}) = panic "GHC.Rename.Module.add_sig" - -type LDeclHeaderRn = Located DeclHeaderRn - --- | Renamed declaration header (left-hand side of a declaration): --- --- 1. data T a b = MkT (a -> b) --- ^^^^^^^^^^ --- --- 2. class C a where --- ^^^^^^^^^ --- --- 3. type family F a b :: r where --- ^^^^^^^^^^^^^^^^^^^^^^ --- --- Supplies arity and flavor information not covered by a standalone kind --- signature. --- -data DeclHeaderRn - = DeclHeaderRn - { decl_header_flav :: TyConFlavour GhcRn, - decl_header_name :: Name, - decl_header_cusk :: Bool, - decl_header_bndrs :: LHsQTyVars GhcRn, - decl_header_res_sig :: Maybe (LHsType GhcRn) - } - -instance Outputable DeclHeaderRn where - ppr (DeclHeaderRn flav name cusk bndrs res_sig) = - ppr flav <+> - ppr name <+> - ppr bndrs <+> - maybe empty ((text "::" <+>) . ppr) res_sig <+> - if cusk then text "{- CUSK -}" else empty - data DAKey = DAInst Name | DASig Name | DADef Name deriving (Eq, Ord) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1ff06bcc4e40e1d90fcd2c2bac0e35e9f388facc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1ff06bcc4e40e1d90fcd2c2bac0e35e9f388facc You're receiving 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 Jun 27 19:11:53 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 27 Jun 2023 15:11:53 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 2 commits: ghc-toolchain: Toolchain Selection Message-ID: <649b34792618f_12d3acc767870540@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 51b159d8 by Rodrigo Mesquita at 2023-06-27T20:11:43+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b4. Revert get_arm_isa deletion from 74f03f24 As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples A TODO comment ghc-toolchain: set CC LD plat. dependent flags A lot to be said about the approach of configuring linker flags (what used to be SET CC LD platform dependent flags in configure), we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? Move osElfTarget from GHC.Platform to GHC.Platform.ArchOS, to use it in Toolchain.Tools.Link to correctly determine if -Wl,--no-as-needed is required - - - - - 241b416f by Rodrigo Mesquita at 2023-06-27T20:11:43+01:00 configure: Create and validate toolchain target file Interpolate LeadingUnderscore in distrib/configure.ac.in - - - - - 30 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - configure.ac - + default.target.in - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Cc.hs - hadrian/src/Settings/Builders/DeriveConstants.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/HsCpp.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - hadrian/src/Settings/Builders/Ld.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eaea989ed52cb920da990470a9c86f76747dc683...241b416f5b7d2a87f602e6a2dacb8653c9b69c36 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/eaea989ed52cb920da990470a9c86f76747dc683...241b416f5b7d2a87f602e6a2dacb8653c9b69c36 You're receiving 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 Jun 27 19:16:48 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Tue, 27 Jun 2023 15:16:48 -0400 Subject: [Git][ghc/ghc][wip/toolchain-selection] 4 commits: ghc-toolchain: Toolchain Selection Message-ID: <649b35a0e51c8_12d3acc7614747e4@gitlab.mail> Rodrigo Mesquita pushed to branch wip/toolchain-selection at Glasgow Haskell Compiler / GHC Commits: 0f91e795 by Rodrigo Mesquita at 2023-06-27T20:16:31+01:00 ghc-toolchain: Toolchain Selection ghc-toolchain: Rename readProcess to readProcessStdout Fixes bugs regarding a translation from the original autconf program that failed to account for the exit code. The longer name reenforces that we really only care about the stdout, and the exit code and stderr of the program are irrelevant for the case. Fixes Re-introduce ld-override option ghc-toolchain library and usage in hadrian flags Re-introduce flags in hadrian config ghc-toolchain: UseLibFFI, LdCompactUnwind, LdFileList A more complete ghc-toolchain. Added configuration of: * Use libffi for adjustors * Supports compact unwind * Supports filelist Handle passing CPP cmd and flags from configure to ghc-toolchain Rip more of configure that is no longer being used Remove configure checks of GNUnoexecStack and ident directive And fix bug in ghc-toolchain respective code Rip out more from hadrians system.config.in Configure CLink supports response files Read deleted keys from host and target's target Delete CMD_OPTS_STAGEX Instead of having configure configure different options for different programs depend on the stage, we delete this completely and have hadrian select the correct target toolchain configuration file depending on the stage, from which it can read those options. Fix [host|target]-[os|arch] vs [host|target]-haskell-[os|arch] Handle unspecified vs specified flags and commands better Configure Cpp and HsCpp separately Fixes for compilation Link is GNU linkerg Revert "Rip more of configure that is no longer being used" I realized we still need this function in rts/configure.ac This reverts commit 01f5d4b4. Revert get_arm_isa deletion from 74f03f24 As in the previous commit, we still need this info from the rts configure script. I suppose it could be useful for the rts to also read somehow the toolchain information... helper AC function for enable/disable Delete unused imports of SysTools.Info Drop PROG_CPP in distrib/autoconf too Get rid of MonadCatch instances and dependencies ghc-toolchain: Check Cc supports extra-via-c-flags Consider empty programs as non-specified programs Cpp and HsCpp cleanup Add comment from check for gold t22266 Remove more settings bits from hadrian/cfg Use llvm target from ghc-toolchain Print default.target Fix bugs in MergeTool and Ar Add check and log errors on error X Revert LLVMTarget deletion in mkprojectmkin Fix stack job Fixes for ghc-toolchain to match configure output ghc-toolchain: Fix ar supports at file Fixes ghc-toolchain: Fix check for gold bug ghc-toolchain: configure linker options correctly Support more targets and dont use llvmtarget allow duplos in place of triples A TODO comment ghc-toolchain: set CC LD plat. dependent flags A lot to be said about the approach of configuring linker flags (what used to be SET CC LD platform dependent flags in configure), we might want to re-do this all eventually... Perhaps I ought to add a TODO at the top level of these functions? We might also not do it altogether, some of these might be outdated? Move osElfTarget from GHC.Platform to GHC.Platform.ArchOS, to use it in Toolchain.Tools.Link to correctly determine if -Wl,--no-as-needed is required - - - - - 6b6ac850 by Rodrigo Mesquita at 2023-06-27T20:16:36+01:00 configure: Create and validate toolchain target file Interpolate LeadingUnderscore in distrib/configure.ac.in - - - - - 56e4a4ba by Rodrigo Mesquita at 2023-06-27T20:16:36+01:00 Split GHC.Platform.ArchOS from ghc-boot into ghc-platform - - - - - 5c555310 by Rodrigo Mesquita at 2023-06-27T20:16:36+01:00 Use ghc-platform instead of ghc-boot - - - - - 30 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Platform.hs - configure.ac - + default.target.in - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cabal.project - hadrian/cfg/system.config.in - hadrian/hadrian.cabal - hadrian/src/Base.hs - hadrian/src/Builder.hs - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Hash.hs - hadrian/src/Hadrian/Oracles/TextFile.hs - hadrian/src/Oracles/Flag.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Gmp.hs - hadrian/src/Rules/Libffi.hs - hadrian/src/Rules/Test.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Builders/Cabal.hs - hadrian/src/Settings/Builders/Cc.hs - hadrian/src/Settings/Builders/DeriveConstants.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/HsCpp.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/241b416f5b7d2a87f602e6a2dacb8653c9b69c36...5c555310e9d6d80010220202252aeadc4a0b7f30 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/241b416f5b7d2a87f602e6a2dacb8653c9b69c36...5c555310e9d6d80010220202252aeadc4a0b7f30 You're receiving 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 Jun 27 19:45:33 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Tue, 27 Jun 2023 15:45:33 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/dep-anal] 2 commits: Simplify DANodeSig Message-ID: <649b3c5d82af1_12d3acc761478281@gitlab.mail> Vladislav Zavialov pushed to branch wip/sand-witch/dep-anal at Glasgow Haskell Compiler / GHC Commits: a9a8f5c1 by Vladislav Zavialov at 2023-06-27T21:26:04+02:00 Simplify DANodeSig - - - - - 828d60d0 by Vladislav Zavialov at 2023-06-27T21:45:21+02:00 doDepAnal: return TyClGroups - - - - - 2 changed files: - compiler/GHC/Hs/Decls.hs - compiler/GHC/Rename/Module.hs Changes: ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -773,8 +773,7 @@ instance OutputableBndrId p = text "type" <+> pprPrefixOcc (unLoc v) <+> text "::" <+> ppr ki ppr (XStandaloneKindSig x) = case ghcPass @p of - GhcRn -> whenPprDebug $ - text "CUSK:" <+> ppr (decl_header_name (unLoc x)) + GhcRn -> ppr x pp_condecls :: forall p. OutputableBndrId p => [LConDecl (GhcPass p)] -> SDoc pp_condecls cs ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -58,7 +58,7 @@ import GHC.Types.Basic ( TypeOrKind(..), TyConFlavour (..) ) import GHC.Data.FastString import GHC.Types.SrcLoc as SrcLoc import GHC.Driver.DynFlags -import GHC.Utils.Misc ( lengthExceeds, partitionWith ) +import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Driver.Env ( HscEnv(..), hsc_home_unit) import GHC.Data.List.SetOps ( findDupsEq, removeDupsOn, equivClasses ) @@ -2735,18 +2735,13 @@ data DAPayload = DAPhantom Name | DAInsts [LInstDecl GhcRn] | DATyClDecl (LTyClDecl GhcRn) - | DANodeSig - (Maybe (LStandaloneKindSig GhcRn)) - DeclHeaderRn + | DANodeSig (LStandaloneKindSig GhcRn) instance Outputable DAPayload where ppr (DAPhantom n) = text "{- No sig for" <+> ppr n <+> text "-}" ppr (DAInsts insts) = ppr insts ppr (DATyClDecl decl) = ppr decl - ppr (DANodeSig msig decl_header) = vcat - [ maybe empty ppr msig, - ppr decl_header - ] + ppr (DANodeSig sig) = ppr sig type DANode = Node DAKey DAPayload @@ -2755,7 +2750,7 @@ doDepAnal :: [(LInstDecl GhcRn,FreeVars)] -> [((LTyClDecl GhcRn, FreeVars), FreeVars)] -> GlobalRdrEnv -> - [SCC DAPayload] -- Inv: no DAPhantom + [TyClGroup GhcRn] doDepAnal sigs insts decls rdr_env = let -- FIXME: do not discard orphans @@ -2769,8 +2764,9 @@ doDepAnal sigs insts decls rdr_env = sigNodeKey = DASig name defNodeKey = DADef name sigNode = case msig of - Nothing | not cusk -> DigraphNode (DAPhantom name) sigNodeKey [defNodeKey] - _ -> DigraphNode (DANodeSig msig decl_header) sigNodeKey (getDeps (fvs_lhs `plusFV` sig_fvs)) + Nothing | cusk -> DigraphNode (DANodeSig (noLocA (XStandaloneKindSig (noLocA decl_header))) ) sigNodeKey (getDeps (fvs_lhs `plusFV` sig_fvs)) + | otherwise -> DigraphNode (DAPhantom name) sigNodeKey [defNodeKey] + Just sig -> DigraphNode (DANodeSig sig) sigNodeKey (getDeps (fvs_lhs `plusFV` sig_fvs)) sigNode : case decl of FamDecl{} | OpenFamilyFlavour{} <- flav -> do @@ -2785,7 +2781,7 @@ doDepAnal sigs insts decls rdr_env = [defNode, instNode] _ -> pure (DigraphNode (DATyClDecl ldecl) defNodeKey (sigNodeKey : getDeps (fvs_lhs `plusFV` fvs_rhs))) - in (stronglyConnCompFromEdgedVerticesOrd declNodes) + in filterOut isEmptyTyClGroup $ map mk_group (stronglyConnCompFromEdgedVerticesOrd declNodes) where -- decl_headers = [mkDeclHeaderRn decl | (((L _ decl), _), _) <- decls] @@ -2820,6 +2816,18 @@ doDepAnal sigs insts decls rdr_env = _ -> panic "doDepAnal: getDep" Just _ -> [DASig name] Nothing -> [] + + mk_group :: SCC DAPayload -> TyClGroup GhcRn + mk_group = foldr f (TyClGroup noExtField [] [] [] []) . flattenSCC + where + f :: DAPayload -> TyClGroup GhcRn -> TyClGroup GhcRn + f (DAPhantom _) = id + f (DAInsts insts) = \g -> g { group_instds = insts ++ group_instds g } + f (DATyClDecl decl) = \g -> g { group_tyclds = decl : group_tyclds g } + f (DANodeSig sig) = \g -> g { group_kisigs = sig : group_kisigs g } + + isEmptyTyClGroup (TyClGroup _ [] [] [] []) = True + isEmptyTyClGroup _ = False {- data GREInfo -- | No particular information... e.g. a function View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1ff06bcc4e40e1d90fcd2c2bac0e35e9f388facc...828d60d0facb0d69149ad89bf62c5d99f1a1d82a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1ff06bcc4e40e1d90fcd2c2bac0e35e9f388facc...828d60d0facb0d69149ad89bf62c5d99f1a1d82a You're receiving 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 Jun 27 20:36:44 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Tue, 27 Jun 2023 16:36:44 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/dep-anal] Progress: ghc panics with out-of-scope sigs Message-ID: <649b485c762a5_12d3acc7650838ea@gitlab.mail> Vladislav Zavialov pushed to branch wip/sand-witch/dep-anal at Glasgow Haskell Compiler / GHC Commits: b492edf0 by Vladislav Zavialov at 2023-06-27T22:36:35+02:00 Progress: ghc panics with out-of-scope sigs - - - - - 4 changed files: - compiler/GHC/Hs/Decls.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/TyCl.hs Changes: ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -132,6 +132,7 @@ import GHC.Data.Bag import GHC.Data.Maybe import Data.Data (Data) import Data.Foldable (toList) +import Data.Void {- ************************************************************************ @@ -671,7 +672,7 @@ type LDeclHeaderRn = LocatedA DeclHeaderRn -- data DeclHeaderRn = DeclHeaderRn - { decl_header_flav :: TyConFlavour GhcRn, + { decl_header_flav :: TyConFlavour Void, decl_header_name :: Name, decl_header_cusk :: Bool, decl_header_bndrs :: LHsQTyVars GhcRn, ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -62,7 +62,7 @@ import GHC.Utils.Misc import GHC.Utils.Panic import GHC.Driver.Env ( HscEnv(..), hsc_home_unit) import GHC.Data.List.SetOps ( findDupsEq, removeDupsOn, equivClasses ) -import GHC.Data.Graph.Directed ( SCC, flattenSCC, flattenSCCs, Node(..) +import GHC.Data.Graph.Directed ( SCC, flattenSCC, Node(..) , stronglyConnCompFromEdgedVerticesUniq, stronglyConnCompFromEdgedVerticesOrd ) import GHC.Types.Unique.Set import GHC.Data.OrdList @@ -1414,13 +1414,11 @@ rnTyClDecls :: [TyClGroup GhcPs] rnTyClDecls tycl_ds = do { -- Rename the type/class, instance, and role declarations ; tycls_w_fvs' <- mapM (wrapLocFstMA rnTyClDecl) (tyClGroupTyClDecls tycl_ds) - ; let - tycls_w_fvs = map (\(L l (t, fv1), fv2) -> (L l t, fv1 `plusFV` fv2)) tycls_w_fvs' - tycls_w_fvs_new = map (\(L l (t, fv1), fv2) -> ((L l t, fv1), fv2)) tycls_w_fvs' - ; let tc_names = mkNameSet (map (tcdName . unLoc . fst) tycls_w_fvs) - ; let decl_headers = mkNameEnv (map mk_pair tycls_w_fvs_new) + ; let tycls_w_fvs = map (\(L l (t, fv1), fv2) -> ((L l t, fv1), fv2)) tycls_w_fvs' + ; let tc_names = mkNameSet (map (tcdName . unLoc . fst . fst) tycls_w_fvs) + ; let decl_headers = mkNameEnv (map mk_pair tycls_w_fvs) where - mk_pair = \((L l t, _fv1), fv2)-> + mk_pair ((L l t, _fv1), fv2) = let hdr = mkDeclHeaderRn t in (decl_header_name hdr, (L l hdr, fv2)) ; traceRn "rnTyClDecls" $ @@ -1428,67 +1426,21 @@ rnTyClDecls tycl_ds , text "tc_names:" <+> ppr tc_names ] ; kisigs_w_fvs <- rnStandaloneKindSignatures tc_names decl_headers (tyClGroupKindSigs tycl_ds) ; instds_w_fvs <- mapM (wrapLocFstMA rnSrcInstDecl) (tyClGroupInstDecls tycl_ds) - ; role_annots <- rnRoleAnnots tc_names (tyClGroupRoleDecls tycl_ds) + -- ; role_annots <- rnRoleAnnots tc_names (tyClGroupRoleDecls tycl_ds) -- Do SCC analysis on the type/class decls ; rdr_env <- getGlobalRdrEnv ; traceRn "rnTyClDecls SCC analysis" $ vcat [ text "rdr_env:" <+> ppr rdr_env ] - ; let tycl_sccs = depAnalTyClDecls rdr_env kisig_fv_env tycls_w_fvs - role_annot_env = mkRoleAnnotEnv role_annots - (kisig_env, kisig_fv_env) = mkKindSig_fv_env kisigs_w_fvs - - inst_ds_map = mkInstDeclFreeVarsMap rdr_env tc_names instds_w_fvs - (init_inst_ds, rest_inst_ds) = getInsts [] inst_ds_map - - first_group - | null init_inst_ds = [] - | otherwise = [TyClGroup { group_ext = noExtField - , group_tyclds = [] - , group_kisigs = [] - , group_roles = [] - , group_instds = init_inst_ds }] - - (final_inst_ds, groups) - = mapAccumL (mk_group role_annot_env kisig_env) rest_inst_ds tycl_sccs - - all_fvs = foldr (plusFV . snd) emptyFVs tycls_w_fvs `plusFV` + ; let all_fvs = foldr (plusFV . snd) emptyFVs tycls_w_fvs `plusFV` foldr (plusFV . snd) emptyFVs instds_w_fvs `plusFV` foldr (plusFV . snd) emptyFVs kisigs_w_fvs + ; let all_groups = doDepAnal kisigs_w_fvs instds_w_fvs tycls_w_fvs rdr_env - all_groups = first_group ++ groups - - ; massertPpr (null final_inst_ds) - (ppr instds_w_fvs - $$ ppr inst_ds_map - $$ ppr (flattenSCCs tycl_sccs) - $$ ppr final_inst_ds) - - ; traceRn "rnTycl dependency analysis made groups" (ppr all_groups) - - ; traceRn "rnTyClDecls NEW SCC anal could have made groups" $ - (ppr (doDepAnal kisigs_w_fvs instds_w_fvs tycls_w_fvs_new rdr_env)) + ; traceRn "rnTyClDecls made groups" $ + (ppr all_groups) ; return (all_groups, all_fvs) } - where - mk_group :: RoleAnnotEnv - -> KindSigEnv - -> InstDeclFreeVarsMap - -> SCC (LTyClDecl GhcRn) - -> (InstDeclFreeVarsMap, TyClGroup GhcRn) - mk_group role_env kisig_env inst_map scc - = (inst_map', group) - where - tycl_ds = flattenSCC scc - bndrs = map (tcdName . unLoc) tycl_ds - roles = getRoleAnnots bndrs role_env - kisigs = getKindSigs bndrs kisig_env - (inst_ds, inst_map') = getInsts bndrs inst_map - group = TyClGroup { group_ext = noExtField - , group_tyclds = tycl_ds - , group_kisigs = kisigs - , group_roles = roles - , group_instds = inst_ds } -- | Free variables of standalone kind signatures. newtype KindSig_FV_Env = KindSig_FV_Env (NameEnv FreeVars) ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -580,14 +580,16 @@ top level of a signature. -} -- Does validity checking and zonking. -tcStandaloneKindSig :: LStandaloneKindSig GhcRn -> TcM (Name, Kind) +tcStandaloneKindSig :: LStandaloneKindSig GhcRn -> TcM (Name, SAKS_or_CUSK) tcStandaloneKindSig (L _ (StandaloneKindSig _ (L _ name) ksig)) = addSigCtxt ctxt ksig $ do { kind <- tc_top_lhs_type KindLevel ctxt ksig ; checkValidType ctxt kind - ; return (name, kind) } + ; return (name, SAKS kind) } where ctxt = StandaloneKindSigCtxt name +tcStandaloneKindSig (L _ (XStandaloneKindSig hdr)) = + return (decl_header_name (unLoc hdr), CUSK) tcTopLHsType :: UserTypeCtxt -> LHsSigType GhcRn -> TcM Type tcTopLHsType ctxt lsig_ty ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -115,6 +115,7 @@ import Data.List ( partition) import Data.List.NonEmpty ( NonEmpty(..) ) import qualified Data.List.NonEmpty as NE import Data.Tuple( swap ) +import Data.Void {- ************************************************************************ @@ -201,8 +202,29 @@ tcTyClGroup (TyClGroup { group_tyclds = tyclds ; traceTc "Decls for" (ppr (map (tcdName . unLoc) tyclds)) ; (tyclss, data_deriv_info, kindless) <- tcExtendKindEnv (mkPromotionErrorEnv tyclds) $ -- See Note [Type environment evolution] - do { kisig_env <- mkNameEnv <$> traverse tcStandaloneKindSig kisigs - ; tcTyClDecls tyclds kisig_env role_annots } + do { checked_tcs <- + tcExtendKindEnv (mkSigPromotionErrorEnv kisigs) $ + mapM tcDeclSig kisigs + -- FIXME: false positives because there might be signatures/cusks + -- in previous declaration groups + ; let is_kinded_decl name = any (\tctc -> tyConName tctc == name) checked_tcs + ; tcExtendKindEnvWithTyCons checked_tcs $ + tcTyClDecls tyclds is_kinded_decl role_annots } +{- + do { checked_tcs <- + tcExtendKindEnv (mkSigPromotionErrorEnv kisigs) $ + mapMaybeM tcDeclSig kisigs + ; let extended_inter_group_env = extendInterGroupEnv checked_tcs inter_group_env + is_kinded_decl = interGroupElem extended_inter_group_env + ; (tyclss, data_deriv_info) <- + tcExtendKindEnvWithTyCons (interGroupEnvTyCons extended_inter_group_env) $ + tcTyClDecls tyclds is_kinded_decl role_annots + ; let purged_inter_group_env = purgeInterGroupEnv tyclss extended_inter_group_env + ; return (purged_inter_group_env, tyclss, data_deriv_info) + } +-} + + -- Step 1.5: Make sure we don't have any type synonym cycles ; traceTc "Starting synonym cycle check" (ppr tyclss) @@ -238,20 +260,83 @@ tcTyClGroup (TyClGroup { group_tyclds = tyclds ; return (gbl_env'', inst_info, deriv_info, th_bndrs' `plusNameEnv` th_bndrs) } --- Gives the kind for every TyCon that has a standalone kind signature -type KindSigEnv = NameEnv Kind +mkSigPromotionErrorEnv :: [LStandaloneKindSig GhcRn] -> TcTypeEnv +mkSigPromotionErrorEnv = + foldr (plusNameEnv . mk_sig_prom_err_env . unLoc) emptyNameEnv + +mk_sig_prom_err_env :: StandaloneKindSig GhcRn -> TcTypeEnv +mk_sig_prom_err_env sig = + unitNameEnv (decl_header_name hdr) + (case decl_header_flav hdr of + ClassFlavour -> APromotionErr ClassPE + _ -> APromotionErr TyConPE) + where + (L _ hdr) = case sig of + StandaloneKindSig hdr _ _ -> hdr + XStandaloneKindSig hdr -> hdr + +tcDeclSig :: LStandaloneKindSig GhcRn -> TcM TcTyCon +tcDeclSig kisig = do + (_, ki) <- tcStandaloneKindSig kisig + tc <- check_decl_sig ki hdr + return tc + where + (L _ hdr) = case unLoc kisig of + StandaloneKindSig hdr _ _ -> hdr + XStandaloneKindSig hdr -> hdr + +check_decl_sig :: SAKS_or_CUSK -> DeclHeaderRn -> TcM TcTyCon +check_decl_sig msig hdr = + kcDeclHeader strategy name flav (decl_header_bndrs hdr) $ + if | flav == ClassFlavour + -> return (TheKind constraintKind) + + | flav == DataTypeFlavour + -> case res_sig of + Just ksig -> TheKind <$> tcLHsKindSig (DataKindCtxt name) ksig + Nothing -> return $ dataDeclDefaultResultKind strategy DataType + + | flav == NewtypeFlavour + -> case res_sig of + Just ksig -> TheKind <$> tcLHsKindSig (DataKindCtxt name) ksig + Nothing -> return $ dataDeclDefaultResultKind strategy NewType + + | is_fam_flav flav + -> case res_sig of + Just ksig -> TheKind <$> tcLHsKindSig (TyFamResKindCtxt name) ksig + Nothing -> + case msig of + CUSK -> return (TheKind liftedTypeKind) + SAKS _ -> return AnyKind + + | flav == TypeSynonymFlavour + -> case res_sig of + Just rhs_sig -> TheKind <$> tcLHsKindSig (TySynKindCtxt name) rhs_sig + Nothing -> return AnyKind + + | otherwise -> return AnyKind + where + name = decl_header_name hdr + flav = fmap absurd (decl_header_flav hdr) + res_sig = decl_header_res_sig hdr + strategy = InitialKindCheck msig + +is_fam_flav :: TyConFlavour tc -> Bool +is_fam_flav OpenFamilyFlavour{} = True +is_fam_flav ClosedTypeFamilyFlavour = True +is_fam_flav _ = False tcTyClDecls :: [LTyClDecl GhcRn] - -> KindSigEnv + -> (Name -> Bool) -- Does this declaration have a SAKS or a CUSK? -> RoleAnnotEnv -> TcM ([TyCon], [DerivInfo], NameSet) -tcTyClDecls tyclds kisig_env role_annots +tcTyClDecls tyclds is_kinded_decl role_annots = do { -- Step 1: kind-check this group and returns the final -- (possibly-polymorphic) kind of each TyCon and Class -- See Note [Kind checking for type and class decls] (tc_tycons, kindless) <- checkNoErrs $ - kcTyClGroup kisig_env tyclds + kcTyClGroup is_kinded_decl tyclds -- checkNoErrs: If the TyCons are ill-kinded, stop now. Else we -- can get follow-on errors. Example: #23252, where the TyCon -- had an ill-scoped kind forall (d::k) k (a::k). blah @@ -857,7 +942,7 @@ been generalized. -} -kcTyClGroup :: KindSigEnv -> [LTyClDecl GhcRn] -> TcM ([PolyTcTyCon], NameSet) +kcTyClGroup :: (Name -> Bool) -> [LTyClDecl GhcRn] -> TcM ([PolyTcTyCon], NameSet) -- Kind check this group, kind generalize, and return the resulting local env -- This binds the TyCons and Classes of the group, but not the DataCons @@ -865,7 +950,7 @@ kcTyClGroup :: KindSigEnv -> [LTyClDecl GhcRn] -> TcM ([PolyTcTyCon], NameSet) -- and Note [Inferring kinds for type declarations] -- -- The NameSet returned contains kindless tycon names, without CUSK or SAKS. -kcTyClGroup kisig_env decls +kcTyClGroup is_kinded_decl decls = do { mod <- getModule ; traceTc "---- kcTyClGroup ---- {" (text "module" <+> ppr mod $$ vcat (map ppr decls)) @@ -876,31 +961,36 @@ kcTyClGroup kisig_env decls -- 3. Generalise the inferred kinds -- See Note [Kind checking for type and class decls] - ; cusks_enabled <- xoptM LangExt.CUSKs <&&> xoptM LangExt.PolyKinds - -- See Note [CUSKs and PolyKinds] - ; let (kindless_decls, kinded_decls) = partitionWith get_kind decls - kindless_names = mkNameSet $ map get_name kindless_decls + -- ; cusks_enabled <- xoptM LangExt.CUSKs <&&> xoptM LangExt.PolyKinds + -- -- See Note [CUSKs and PolyKinds] + -- ; let (kindless_decls, kinded_decls) = partitionWith get_kind decls + -- kindless_names = mkNameSet $ map get_name kindless_decls - get_name d = tcdName (unLoc d) + -- get_name d = tcdName (unLoc d) - get_kind d - | Just ki <- lookupNameEnv kisig_env (get_name d) - = Right (d, SAKS ki) + -- get_kind d + -- | Just ki <- lookupNameEnv kisig_env (get_name d) + -- = Right (d, SAKS ki) - | cusks_enabled && hsDeclHasCusk (unLoc d) - = Right (d, CUSK) + -- | cusks_enabled && hsDeclHasCusk (unLoc d) + -- = Right (d, CUSK) - | otherwise = Left d + -- | otherwise = Left d + ; let (kinded_decls, kindless_decls) = partition (is_kinded_decl . tcdName . unLoc) decls + kindless_names = mkNameSet $ map get_name kindless_decls + get_name d = tcdName (unLoc d) + ; (checked_tcs, concat -> checked_assoc_tcs) <- + mapAndUnzipM checkKindedDecl kinded_decls - ; checked_tcs <- checkNoErrs $ - checkInitialKinds kinded_decls - -- checkNoErrs because we are about to extend - -- the envt with these tycons, and we get - -- knock-on errors if we have tycons with - -- malformed kinds + -- ; checked_tcs <- checkNoErrs $ + -- checkInitialKinds kinded_decls + -- -- checkNoErrs because we are about to extend + -- -- the envt with these tycons, and we get + -- -- knock-on errors if we have tycons with + -- -- malformed kinds ; inferred_tcs - <- tcExtendKindEnvWithTyCons checked_tcs $ + <- tcExtendKindEnvWithTyCons checked_assoc_tcs $ pushLevelAndSolveEqualities unkSkolAnon [] $ -- We are going to kind-generalise, so unification -- variables in here must be one level in @@ -929,13 +1019,25 @@ kcTyClGroup kisig_env decls ; generalized_tcs <- concatMapM (generaliseTyClDecl inferred_tc_env) kindless_decls - ; let poly_tcs = checked_tcs ++ generalized_tcs + ; let poly_tcs = checked_tcs ++ checked_assoc_tcs ++ generalized_tcs ; traceTc "---- kcTyClGroup end ---- }" (ppr_tc_kinds poly_tcs) ; return (poly_tcs, kindless_names) } where ppr_tc_kinds tcs = vcat (map pp_tc tcs) pp_tc tc = ppr (tyConName tc) <+> dcolon <+> ppr (tyConKind tc) +checkKindedDecl :: LTyClDecl GhcRn -> TcM (TcTyCon, [TcTyCon]) +checkKindedDecl (L _ (ClassDecl { tcdLName = L _ name , tcdATs = ats })) + = do { cls <- tcLookupTcTyCon name + ; let parent_tv_prs = tcTyConScopedTyVars cls + ; inner_tcs <- + tcExtendNameTyVarEnv parent_tv_prs $ + mapM (addLocMA (check_initial_kind_assoc_fam cls)) ats + ; return (cls, inner_tcs) } +checkKindedDecl (L _ d) + = do { tc <- tcLookupTcTyCon (tcdName d) + ; return (tc, []) } + type ScopedPairs = [(Name, TcTyVar)] -- The ScopedPairs for a TcTyCon are precisely -- specified-tvs ++ required-tvs @@ -1510,17 +1612,17 @@ inferInitialKinds decls where infer_initial_kind = addLocMA (getInitialKind InitialKindInfer) --- Check type/class declarations against their standalone kind signatures or --- CUSKs, producing a generalized TcTyCon for each. -checkInitialKinds :: [(LTyClDecl GhcRn, SAKS_or_CUSK)] -> TcM [PolyTcTyCon] -checkInitialKinds decls - = do { traceTc "checkInitialKinds {" $ ppr (mapFst (tcdName . unLoc) decls) - ; tcs <- concatMapM check_initial_kind decls - ; traceTc "checkInitialKinds done }" empty - ; return tcs } - where - check_initial_kind (ldecl, msig) = - addLocMA (getInitialKind (InitialKindCheck msig)) ldecl +-- -- Check type/class declarations against their standalone kind signatures or +-- -- CUSKs, producing a generalized TcTyCon for each. +-- checkInitialKinds :: [(LTyClDecl GhcRn, SAKS_or_CUSK)] -> TcM [PolyTcTyCon] +-- checkInitialKinds decls +-- = do { traceTc "checkInitialKinds {" $ ppr (mapFst (tcdName . unLoc) decls) +-- ; tcs <- concatMapM check_initial_kind decls +-- ; traceTc "checkInitialKinds done }" empty +-- ; return tcs } +-- where +-- check_initial_kind (ldecl, msig) = +-- addLocMA (getInitialKind (InitialKindCheck msig)) ldecl -- | Get the initial kind of a TyClDecl, either generalized or non-generalized, -- depending on the 'InitialKindStrategy'. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b492edf08f2e4047ee9cd6b7b101c3f7a47f21bc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b492edf08f2e4047ee9cd6b7b101c3f7a47f21bc You're receiving 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 Jun 27 20:52:46 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 27 Jun 2023 16:52:46 -0400 Subject: [Git][ghc/ghc][master] Propagate breakpoint information when inlining across modules Message-ID: <649b4c1ed898f_12d3acc76009002e@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 30 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/HsToCore/Breakpoints.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Stg/BcPrep.hs - compiler/GHC/Stg/FVs.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/Types/Tickish.hs - libraries/ghci/GHCi/Message.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c59fbb0b93a41636c5d78b9c042e7c7507e58e03 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c59fbb0b93a41636c5d78b9c042e7c7507e58e03 You're receiving 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 Jun 27 20:53:24 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 27 Jun 2023 16:53:24 -0400 Subject: [Git][ghc/ghc][master] Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's Message-ID: <649b4c448e7f7_12d3ac5f6f2709385a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - 2 changed files: - configure.ac - distrib/configure.ac.in Changes: ===================================== configure.ac ===================================== @@ -487,7 +487,6 @@ CFLAGS="$CFLAGS $GccUseLdOpt" AC_SUBST([LdCmd]) FP_PROG_LD_IS_GNU -FP_PROG_LD_BUILD_ID FP_PROG_LD_NO_COMPACT_UNWIND FP_PROG_LD_FILELIST ===================================== distrib/configure.ac.in ===================================== @@ -130,7 +130,6 @@ CFLAGS="$CFLAGS $GccUseLdOpt" AC_SUBST([LdCmd]) FP_PROG_LD_IS_GNU -FP_PROG_LD_BUILD_ID FP_PROG_LD_NO_COMPACT_UNWIND FP_PROG_LD_FILELIST View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6f904808c925991bbaf4068c9a12b584675c6209 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6f904808c925991bbaf4068c9a12b584675c6209 You're receiving 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 Jun 27 20:54:24 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 27 Jun 2023 16:54:24 -0400 Subject: [Git][ghc/ghc][master] Remove arity inference in type declarations (#23514) Message-ID: <649b4c80e2650_12d3acc767897748@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 21 changed files: - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Splice.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - libraries/template-haskell/changelog.md - testsuite/tests/perf/compiler/CoOpt_Singletons.hs - testsuite/tests/saks/should_compile/T16724.stdout - testsuite/tests/saks/should_compile/saks030.hs - testsuite/tests/saks/should_compile/saks032.hs - + testsuite/tests/th/CodeQ_HKD.hs - testsuite/tests/th/all.T - + testsuite/tests/typecheck/should_compile/T23514b.hs - + testsuite/tests/typecheck/should_compile/T23514c.hs - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_fail/T18640a.hs - testsuite/tests/typecheck/should_fail/T18640a.stderr - testsuite/tests/typecheck/should_fail/T18640c.hs - testsuite/tests/typecheck/should_fail/T18640c.stderr - + testsuite/tests/typecheck/should_fail/T23514a.hs - + testsuite/tests/typecheck/should_fail/T23514a.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -920,12 +920,7 @@ pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype, cons = visibleIfConDecls condecls pp_where = ppWhen (gadt && not (null cons)) $ text "where" pp_cons = ppr_trim (map show_con cons) :: [SDoc] - pp_kind = ppUnless (if ki_sig_printable - then isIfaceRhoType kind - -- Even in the presence of a standalone kind signature, a non-tau - -- result kind annotation cannot be discarded as it determines the arity. - -- See Note [Arity inference in kcCheckDeclHeader_sig] in GHC.Tc.Gen.HsType - else isIfaceLiftedTypeKind kind) + pp_kind = ppUnless (ki_sig_printable || isIfaceLiftedTypeKind kind) (dcolon <+> ppr kind) pp_lhs = case parent of ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -2556,37 +2556,30 @@ kcCheckDeclHeader_sig sig_kind name flav -- ^^^^^^^^^ -- We do it here because at this point the environment has been -- extended with both 'implicit_tcv_prs' and 'explicit_tv_prs'. + -- + -- Also see Note [Arity of type families and type synonyms] ; ctx_k <- kc_res_ki - -- Work out extra_arity, the number of extra invisible binders from - -- the kind signature that should be part of the TyCon's arity. - -- See Note [Arity inference in kcCheckDeclHeader_sig] - ; let n_invis_tcbs = countWhile isInvisibleTyConBinder excess_sig_tcbs - invis_arity = case ctx_k of - AnyKind -> n_invis_tcbs -- No kind signature, so make all the invisible binders - -- the signature into part of the arity of the TyCon - OpenKind -> n_invis_tcbs -- Result kind is (TYPE rr), so again make all the - -- invisible binders part of the arity of the TyCon - TheKind ki -> 0 `max` (n_invis_tcbs - invisibleTyBndrCount ki) + ; let sig_res_kind' = mkTyConKind excess_sig_tcbs sig_res_kind - ; let (invis_tcbs, resid_tcbs) = splitAt invis_arity excess_sig_tcbs - ; let sig_res_kind' = mkTyConKind resid_tcbs sig_res_kind - - ; traceTc "kcCheckDeclHeader_sig 2" $ vcat [ ppr excess_sig_tcbs - , ppr invis_arity, ppr invis_tcbs - , ppr n_invis_tcbs ] + ; traceTc "kcCheckDeclHeader_sig 2" $ + vcat [ text "excess_sig_tcbs" <+> ppr excess_sig_tcbs + , text "ctx_k" <+> ppr ctx_k + , text "sig_res_kind'" <+> ppr sig_res_kind' + ] -- Unify res_ki (from the type declaration) with the residual kind from -- the kind signature. Don't forget to apply the skolemising 'subst' first. ; case ctx_k of AnyKind -> return () -- No signature - _ -> do { res_ki <- newExpectedKind ctx_k - ; discardResult (unifyKind Nothing sig_res_kind' res_ki) } + _ -> do + res_ki <- newExpectedKind ctx_k + check_exp_res_ki sig_res_kind' res_ki -- Add more binders for data/newtype, so the result kind has no arrows -- See Note [Datatype return kinds] - ; if null resid_tcbs || not (needsEtaExpansion flav) - then return (invis_tcbs, sig_res_kind') + ; if null excess_sig_tcbs || not (needsEtaExpansion flav) + then return ([], sig_res_kind') else return (excess_sig_tcbs, sig_res_kind) } @@ -2642,6 +2635,22 @@ kcCheckDeclHeader_sig sig_kind name flav ] ; return tc } +-- | Check the result kind annotation on a type constructor against +-- the corresponding section of the standalone kind signature. +-- Drops invisible binders that interfere with unification. +check_exp_res_ki :: TcKind -- ^ the actual kind + -> TcKind -- ^ the expected kind + -> TcM () +check_exp_res_ki act_kind exp_kind + = discardResult $ unifyKind Nothing act_kind' exp_kind + where + (_, act_kind') = splitInvisPiTysN n_to_inst act_kind + + -- by analogy with checkExpectedKind + n_exp_invis_bndrs = invisibleTyBndrCount exp_kind + n_act_invis_bndrs = invisibleTyBndrCount act_kind + n_to_inst = n_act_invis_bndrs - n_exp_invis_bndrs + matchUpSigWithDecl :: Name -- Name of the type constructor for error messages -> [TcTyConBinder] -- TcTyConBinders (with skolem TcTyVars) from the separate kind signature @@ -2739,8 +2748,8 @@ swizzleTcb swizzle_env subst (Bndr tv vis) -- See Note [Source locations for implicitly bound type variables] -- in GHC.Tc.Rename.HsType -{- See Note [kcCheckDeclHeader_sig] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +{- Note [kcCheckDeclHeader_sig] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Given a kind signature 'sig_kind' and a declaration header, kcCheckDeclHeader_sig verifies that the declaration conforms to the signature. The end result is a PolyTcTyCon 'tc' such that: @@ -2781,85 +2790,43 @@ Basic plan is this: part of the signature (k -> Type) with the kind signature of the decl, (j -> Type). This unification, done in kcCheckDeclHeader, needs TcTyVars. - * The tricky extra_arity part is described in - Note [Arity inference in kcCheckDeclHeader_sig] - -Note [Arity inference in kcCheckDeclHeader_sig] +Note [Arity of type families and type synonyms] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider these declarations: - type family S1 :: forall k2. k1 -> k2 -> Type - type family S2 (a :: k1) (b :: k2) :: Type - -Both S1 and S2 can be given the same standalone kind signature: - type S1 :: forall k1 k2. k1 -> k2 -> Type - type S2 :: forall k1 k2. k1 -> k2 -> Type - -And, indeed, tyConKind S1 == tyConKind S2. However, -tyConBinders and tyConResKind for S1 and S2 are different: - - tyConBinders S1 == [spec k1] - tyConResKind S1 == forall k2. k1 -> k2 -> Type - tyConKind S1 == forall k1 k2. k1 -> k2 -> Type - - tyConBinders S2 == [spec k1, spec k2, anon-vis (a :: k1), anon-vis (b :: k2)] - tyConResKind S2 == Type - tyConKind S1 == forall k1 k2. k1 -> k2 -> Type - -This difference determines the /arity/: - tyConArity tc == length (tyConBinders tc) -That is, the arity of S1 is 1, while the arity of S2 is 4. - -'kcCheckDeclHeader_sig' needs to infer the desired arity, to split the -standalone kind signature into binders and the result kind. It does so -in two rounds: - -1. matchUpSigWithDecl matches up - - the [TyConBinder] from (applying splitTyConKind to) the kind signature - - with the [LHsTyVarBndr] from the type declaration. - That may leave some excess TyConBinder: in the case of S2 there are - no excess TyConBinders, but in the case of S1 there are two (since - there are no LHsTYVarBndrs. - -2. Split off further TyConBinders (in the case of S1, one more) to - make it possible to unify the residual return kind with the - signature in the type declaration. More precisely, split off such - enough invisible that the remainder of the standalone kind - signature and the user-written result kind signature have the same - number of invisible quantifiers. - -As another example consider the following declarations: +Consider - type F :: Type -> forall j. j -> forall k1 k2. (k1, k2) -> Type - type family F a b + type F0 :: forall k. k -> k -> Type + type family F0 - type G :: Type -> forall j. j -> forall k1 k2. (k1, k2) -> Type - type family G a b :: forall r2. (r1, r2) -> Type + type F1 :: forall k. k -> k -> Type + type family F1 @k -For both F and G, the signature (after splitTyConKind) has - sig_tcbs :: [TyConBinder] - = [ anon-vis (@a_aBq), spec (@j_auA), anon-vis (@(b_aBr :: j_auA)) - , spec (@k1_auB), spec (@k2_auC) - , anon-vis (@(c_aBs :: (k1_auB, k2_auC)))] + type F2a :: forall k. k -> k -> Type + type family F2a @k a -matchUpSigWithDecl will consume the first three of these, passing on - excess_sig_tcbs - = [ spec (@k1_auB), spec (@k2_auC) - , anon-vis (@(c_aBs :: (k1_auB, k2_auC)))] + type F2b :: forall k. k -> k -> Type + type family F2b a -For F, there is no result kind signature in the declaration for F, so -we absorb all invisible binders into F's arity. The resulting arity of -F is 3+2=5. + type F3 :: forall k. k -> k -> Type + type family F3 a b -Now, in the case of G, we have a result kind sig 'forall r2. (r2,r2)->Type'. -This has one invisible binder, so we split of enough extra binders from -our excess_sig_tcbs to leave just one to match 'r2'. +All five have the same /kind/, but what /arity/ do they have? +For a type family, the arity is critical: +* A type family must always appear saturated (up to its arity) +* A type family can match only on `arity` arguments, not further ones +* The arity is recorded by `tyConArity`, and is equal to the number of + `TyConBinders` in the `TyCon`. +* In this context "arity" includes both kind and type arguments. - res_ki = forall r2. (r1, r2) -> Type - kisig = forall k1 k2. (k1, k2) -> Type - ^^^ - split off this one. +The arity is not determined by the kind signature (all five have the same signature). +Rather, it is determined by the declaration of the family: +* `F0` has arity 0. +* `F1` has arity 1. +* `F2a` has arity 2. +* `F2b` also has arity 2: the kind argument is invisible. +* `F3` has arity 3; again the kind argument is invisible. -The resulting arity of G is 3+1=4. +The matching-up of kind signature with the declaration itself is done by +`matchUpWithSigDecl`. Note [discardResult in kcCheckDeclHeader_sig] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2950,6 +2917,12 @@ data ContextKind = TheKind TcKind -- ^ a specific kind | AnyKind -- ^ any kind will do | OpenKind -- ^ something of the form @TYPE _@ +-- debug only +instance Outputable ContextKind where + ppr AnyKind = text "AnyKind" + ppr OpenKind = text "OpenKind" + ppr (TheKind k) = text "TheKind" <+> ppr k + ----------------------- newExpectedKind :: ContextKind -> TcM TcKind newExpectedKind (TheKind k) = return k ===================================== compiler/GHC/Tc/Gen/Splice.hs ===================================== @@ -797,7 +797,7 @@ tcTExpTy m_ty exp_ty TcRnTHError $ TypedTHError $ TypedTHWithPolyType exp_ty ; codeCon <- tcLookupTyCon codeTyConName ; let rep = getRuntimeRep exp_ty - ; return (mkTyConApp codeCon [rep, m_ty, exp_ty]) } + ; return (mkTyConApp codeCon [m_ty, rep, exp_ty]) } quotationCtxtDoc :: LHsExpr GhcRn -> SDoc quotationCtxtDoc br_body ===================================== libraries/template-haskell/Language/Haskell/TH/Syntax.hs ===================================== @@ -378,8 +378,13 @@ The splice will evaluate to (MkAge 3) and you can't add that to 4::Int. So you can't coerce a (Code Q Age) to a (Code Q Int). -} -- Code constructor - +#if __GLASGOW_HASKELL__ >= 909 +type Code :: (Kind.Type -> Kind.Type) -> forall r. TYPE r -> Kind.Type + -- The nested `forall` makes it possible to assign the arity of 0 to + -- type CodeQ = Code Q +#else type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type +#endif type role Code representational nominal -- See Note [Role of TExp] newtype Code m a = Code { examineCode :: m (TExp a) -- ^ Underlying monadic value ===================================== libraries/template-haskell/changelog.md ===================================== @@ -1,10 +1,15 @@ # Changelog for [`template-haskell` package](http://hackage.haskell.org/package/template-haskell) +## 2.22.0.0 + + * The kind of `Code` was changed from `forall r. (Type -> Type) -> TYPE r -> Type` + to `(Type -> Type) -> forall r. TYPE r -> Type`. This enables higher-kinded usage. + ## 2.21.0.0 * Record fields now belong to separate `NameSpace`s, keyed by the parent of the record field. This is the name of the first constructor of the parent type, - even if this constructor does not have the field in question. + even if this constructor does not have the field in question. This change enables TemplateHaskell support for `DuplicateRecordFields`. @@ -21,7 +26,7 @@ ## 2.20.0.0 - * The `Ppr.pprInfixT` function has gained a `Precedence` argument. + * The `Ppr.pprInfixT` function has gained a `Precedence` argument. * The values of named precedence levels like `Ppr.appPrec` have changed. * Add `TypeDataD` constructor to the `Dec` type for `type data` ===================================== testsuite/tests/perf/compiler/CoOpt_Singletons.hs ===================================== @@ -52,7 +52,7 @@ type SameKind :: k -> k -> Constraint type SameKind (a :: k) (b :: k) = (() :: Constraint) type Sing :: k -> Type -type family Sing :: k -> Type +type family Sing @k :: k -> Type type SLambda :: (k1 ~> k2) -> Type newtype SLambda (f :: k1 ~> k2) = @@ -386,7 +386,7 @@ type family (<>@#@$$$) (a6989586621679047054 :: a_a9GJ) (a6989586621679047055 :: class PSemigroup a_a9GJ where type family (<>) (arg_a9GX :: a_a9GJ) (arg_a9GY :: a_a9GJ) :: a_a9GJ type MemptySym0 :: forall a_a9GK. a_a9GK -type family MemptySym0 :: a_a9GK where +type family MemptySym0 @a_a9GK :: a_a9GK where MemptySym0 = Mempty type MappendSym0 :: forall a_a9GK. (~>) a_a9GK ((~>) a_a9GK a_a9GK) data MappendSym0 :: (~>) a_a9GK ((~>) a_a9GK a_a9GK) @@ -450,10 +450,10 @@ type family TFHelper_6989586621679047079Sym2 (a6989586621679047084 :: Dual a_a9G instance PSemigroup (Dual a_a9GL) where type (<>) a_a9Hn a_a9Ho = Apply (Apply TFHelper_6989586621679047079Sym0 a_a9Hn) a_a9Ho type Mempty_6989586621679047088 :: Dual a_a9GO -type family Mempty_6989586621679047088 :: Dual a_a9GO where +type family Mempty_6989586621679047088 @a_a9GO :: Dual a_a9GO where Mempty_6989586621679047088 = Apply DualSym0 MemptySym0 type Mempty_6989586621679047088Sym0 :: Dual a_a9GO -type family Mempty_6989586621679047088Sym0 :: Dual a_a9GO where +type family Mempty_6989586621679047088Sym0 @a_a9GO :: Dual a_a9GO where Mempty_6989586621679047088Sym0 = Mempty_6989586621679047088 instance PMonoid (Dual a_a9GO) where type Mempty = Mempty_6989586621679047088Sym0 @@ -549,10 +549,10 @@ type family TFHelper_6989586621679075091Sym2 (a6989586621679075096 :: Endo a_agC instance PSemigroup (Endo a_agCk) where type (<>) a_agZb a_agZc = Apply (Apply TFHelper_6989586621679075091Sym0 a_agZb) a_agZc type Mempty_6989586621679075313 :: Endo a_agCn -type family Mempty_6989586621679075313 :: Endo a_agCn where +type family Mempty_6989586621679075313 @a_agCn :: Endo a_agCn where Mempty_6989586621679075313 = Apply EndoSym0 IdSym0 type Mempty_6989586621679075313Sym0 :: Endo a_agCn -type family Mempty_6989586621679075313Sym0 :: Endo a_agCn where +type family Mempty_6989586621679075313Sym0 @a_agCn :: Endo a_agCn where Mempty_6989586621679075313Sym0 = Mempty_6989586621679075313 instance PMonoid (Endo a_agCn) where type Mempty = Mempty_6989586621679075313Sym0 ===================================== testsuite/tests/saks/should_compile/T16724.stdout ===================================== @@ -1,6 +1,6 @@ type T1 :: forall k (a :: k). Type -type family T1 @k @a +type family T1 -- Defined at T16724.hs:11:1 type T2 :: forall {k} (a :: k). Type -type family T2 @{k} @a +type family T2 -- Defined at T16724.hs:15:1 ===================================== testsuite/tests/saks/should_compile/saks030.hs ===================================== @@ -10,7 +10,7 @@ import Data.Type.Equality type T1 :: forall k (a :: k). Bool type T2 :: k -> Bool -type family T1 where +type family T1 @k @a where T1 @Bool @True = False T1 @Bool @False = True ===================================== testsuite/tests/saks/should_compile/saks032.hs ===================================== @@ -18,4 +18,4 @@ type F1 :: Type -> forall j. j -> forall k1 k2. (k1, k2) -> Type type family F1 a b type F2 :: Type -> forall j. j -> forall k1 k2. (k1, k2) -> Type -type family F2 a b :: forall r2. (r1, r2) -> Type +type family F2 a b @r1 :: forall r2. (r1, r2) -> Type ===================================== testsuite/tests/th/CodeQ_HKD.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE TemplateHaskell #-} + +module CodeQ_HKD where +import GHC.Exts +import Data.Kind +import Language.Haskell.TH hiding (Type) + +data T (f :: forall r . (TYPE r) -> Type) = MkT (f Int) (f Int#) + + +tcodeq :: T CodeQ +tcodeq = MkT [||5||] [||5#||] ===================================== testsuite/tests/th/all.T ===================================== @@ -579,3 +579,4 @@ test('T22559a', normal, compile_fail, ['']) test('T22559b', normal, compile_fail, ['']) test('T22559c', normal, compile_fail, ['']) test('T23525', normal, compile, ['']) +test('CodeQ_HKD', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_compile/T23514b.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies, DataKinds #-} +module T23514b where + +import GHC.Types + +type F :: Type -> forall k. Maybe k +type family F x @k where + F Int @Type = Just Bool + F Int = Just Either ===================================== testsuite/tests/typecheck/should_compile/T23514c.hs ===================================== @@ -0,0 +1,21 @@ +module T23514c where +import Data.Kind + + +type P1 :: forall k (a :: k) . k -> Type +data P1 :: k -> Type + +type P2 :: forall k (a :: k) . k -> Type +data P2 @k :: k -> Type + +type P3 :: forall k (a :: k) . k -> Type +data P3 @k @a :: k -> Type + +type P4 :: forall k (a :: k) . k -> Type +data P4 :: forall k (a :: k) . k -> Type + +type P5 :: forall k (a :: k) . k -> Type +data P5 :: forall a . k -> Type + +type P6 :: forall k (a :: k) . k -> Type +data P6 @k :: forall a . k -> Type ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -880,3 +880,5 @@ test('T22560b', normal, compile, ['']) test('T22560c', normal, compile, ['']) test('T22560d', extra_files(['T22560d.hs']), ghci_script, ['T22560d.script']) test('T22560e', normal, compile, ['']) +test('T23514b', normal, compile, ['']) +test('T23514c', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/T18640a.hs ===================================== @@ -8,4 +8,4 @@ module T18640a where import Data.Kind type F2 :: forall a b. Type -> a -type family F2 :: forall b. Type -> Type where +type family F2 @a :: forall b. Type -> Type where ===================================== testsuite/tests/typecheck/should_fail/T18640a.stderr ===================================== @@ -5,5 +5,5 @@ T18640a.hs:11:1: error: [GHC-25897] Actual: forall (b :: k). * -> a ‘a’ is a rigid type variable bound by the type family declaration for ‘F2’ - at T18640a.hs:10:19 + at T18640a.hs:11:17 • In the type family declaration for ‘F2’ ===================================== testsuite/tests/typecheck/should_fail/T18640c.hs ===================================== @@ -11,4 +11,4 @@ type F1 :: forall k -> Type type family F1 k :: Type type F2 :: forall x. forall k -> x -type F2 = F1 +type F2 k = F1 k ===================================== testsuite/tests/typecheck/should_fail/T18640c.stderr ===================================== @@ -1,10 +1,8 @@ -T18640c.hs:14:11: error: [GHC-25897] - • Couldn't match kind ‘x’ with ‘*’ - Expected kind ‘forall (k1 :: k) -> x’, - but ‘F1’ has kind ‘forall (k1 :: k) -> *’ +T18640c.hs:14:13: error: [GHC-25897] + • Expected kind ‘x’, but ‘F1 k’ has kind ‘*’ ‘x’ is a rigid type variable bound by the type synonym declaration for ‘F2’ at T18640c.hs:13:19 - • In the type ‘F1’ + • In the type ‘F1 k’ In the type declaration for ‘F2’ ===================================== testsuite/tests/typecheck/should_fail/T23514a.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE TypeFamilies, DataKinds #-} +module T23514a where + +import GHC.Types + +type F :: Type -> forall k. Maybe k +type family F x where + F Int @Type = Just Bool + F Int = Just Either ===================================== testsuite/tests/typecheck/should_fail/T23514a.stderr ===================================== @@ -0,0 +1,6 @@ + +T23514a.hs:9:17: error: [GHC-83865] + • Expected kind ‘forall k. Maybe k’, + but ‘Just Either’ has kind ‘Maybe (* -> * -> *)’ + • In the type ‘Just Either’ + In the type family declaration for ‘F’ ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -696,3 +696,4 @@ test('VisFlag2', normal, compile_fail, ['']) test('VisFlag3', normal, compile_fail, ['']) test('VisFlag4', normal, compile_fail, ['']) test('VisFlag5', normal, compile_fail, ['']) +test('T23514a', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e89aa0721ca5c594f6811f2108d49cd051488ce1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e89aa0721ca5c594f6811f2108d49cd051488ce1 You're receiving 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 Jun 27 20:55:04 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 27 Jun 2023 16:55:04 -0400 Subject: [Git][ghc/ghc][master] Relax defaulting of RuntimeRep/Levity when printing Message-ID: <649b4ca840748_12d3acc7628106374@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 5 changed files: - compiler/GHC/Iface/Type.hs - compiler/GHC/Types/Unique/DFM.hs - + testsuite/tests/ghci/scripts/T16468.script - + testsuite/tests/ghci/scripts/T16468.stdout - testsuite/tests/ghci/scripts/all.T Changes: ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -821,7 +821,7 @@ pprIfaceLamBndr (b, IfaceNoOneShot) = ppr b pprIfaceLamBndr (b, IfaceOneShot) = ppr b <> text "[OneShot]" pprIfaceIdBndr :: IfaceIdBndr -> SDoc -pprIfaceIdBndr (w, name, ty) = parens (ppr name <> brackets (ppr w) <+> dcolon <+> ppr ty) +pprIfaceIdBndr (w, name, ty) = parens (ppr name <> brackets (ppr_ty_nested w) <+> dcolon <+> ppr_ty_nested ty) {- Note [Suppressing binder signatures] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -881,7 +881,7 @@ pprIfaceTvBndr :: IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc pprIfaceTvBndr (tv, ki) (SuppressBndrSig suppress_sig) (UseBndrParens use_parens) | suppress_sig = ppr tv | isIfaceLiftedTypeKind ki = ppr tv - | otherwise = maybe_parens (ppr tv <+> dcolon <+> ppr ki) + | otherwise = maybe_parens (ppr tv <+> dcolon <+> ppr_ty_nested ki) where maybe_parens | use_parens = parens | otherwise = id @@ -933,9 +933,13 @@ instance Binary IfaceOneShot where instance Outputable IfaceType where ppr ty = pprIfaceType ty -pprIfaceType, pprParendIfaceType :: IfaceType -> SDoc +-- The purpose of 'ppr_ty_nested' is to distinguish calls that should not +-- trigger 'hideNonStandardTypes', see Note [Defaulting RuntimeRep variables] +-- wrinkle (W2). +pprIfaceType, pprParendIfaceType, ppr_ty_nested :: IfaceType -> SDoc pprIfaceType = pprPrecIfaceType topPrec pprParendIfaceType = pprPrecIfaceType appPrec +ppr_ty_nested = ppr_ty topPrec pprPrecIfaceType :: PprPrec -> IfaceType -> SDoc -- We still need `hideNonStandardTypes`, since the `pprPrecIfaceType` may be @@ -987,7 +991,7 @@ ppr_ty ctxt_prec ty@(IfaceFunTy af w ty1 ty2) -- Should be a visible argument | isVisibleFunArg af = (pprTypeArrow af wthis <+> ppr_ty funPrec ty1) : ppr_fun_tail wnext ty2 ppr_fun_tail wthis other_ty - = [pprTypeArrow af wthis <+> pprIfaceType other_ty] + = [pprTypeArrow af wthis <+> ppr_ty_nested other_ty] ppr_ty ctxt_prec (IfaceAppTy t ts) = if_print_coercions @@ -1044,9 +1048,11 @@ Haskell programs, so it makes little sense to make all users pay this syntactic overhead. For this reason it was decided that we would hide RuntimeRep variables -for now (see #11549). We do this by defaulting all type variables of -kind RuntimeRep to LiftedRep. -Likewise, we default all Multiplicity variables to Many. +for now (see #11549). We do this right in the pretty-printer, by pre-processing +the type we are about to print, to default any type variables of kind RuntimeRep +that are bound by toplevel invisible quantification to LiftedRep. +Likewise, we default Multiplicity variables to Many and Levity variables to +Lifted. This is done in a pass right before pretty-printing (defaultIfaceTyVarsOfKind, controlled by @@ -1073,6 +1079,32 @@ metavariables are converted, skolem variables are not. There's one exception though: TyVarTv metavariables should not be defaulted, as they appear during kind-checking of "newtype T :: TYPE r where..." (test T18357a). Therefore, we additionally test for isTyConableTyVar. + +Wrinkles: + +(W1) The loop 'go' in 'defaultIfaceTyVarsOfKind' passes a Bool flag, 'rank1', + around that indicates whether we haven't yet descended into the arguments + of a function type. + This is used to decide whether newly bound variables are eligible for + defaulting – we do not want contravariant foralls to be defaulted because + that would result in an incorrect, rather than specialized, type. + For example: + ∀ p (r1 :: RuntimeRep) . (∀ (r2 :: RuntimeRep) . p r2) -> p r1 + We want to default 'r1', but not 'r2'. + When examining the first forall, 'rank1' is True. + The toplevel function type is matched as IfaceFunTy, where we recurse into + 'go' by passing False for 'rank1'. + The forall in the first argument then skips adding a substitution for 'r2'. + +(W2) 'defaultIfaceTyVarsOfKind' ought to be called only once when printing a + type. + A few components of the printing machinery used to invoke 'ppr' on types + nested in secondary structures like IfaceBndr, which would repeat the + defaulting process, but treating the type as if it were top-level, causing + unwanted defaulting. + In order to prevent future developers from using 'ppr' again or being + confused that @ppr_ty topPrec@ is used, we introduced a marker function, + 'ppr_ty_nested'. -} -- | Default 'RuntimeRep' variables to 'LiftedRep', @@ -1097,28 +1129,29 @@ as they appear during kind-checking of "newtype T :: TYPE r where..." defaultIfaceTyVarsOfKind :: Bool -- ^ default 'RuntimeRep'/'Levity' variables? -> Bool -- ^ default 'Multiplicity' variables? -> IfaceType -> IfaceType -defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv ty +defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv True ty where go :: FastStringEnv IfaceType -- Set of enclosing forall-ed RuntimeRep/Levity/Multiplicity variables + -> Bool -- Are we in a toplevel forall, where defaulting is allowed? -> IfaceType -> IfaceType - go subs (IfaceForAllTy (Bndr (IfaceTvBndr (var, var_kind)) argf) ty) + go subs True (IfaceForAllTy (Bndr (IfaceTvBndr (var, var_kind)) argf) ty) | isInvisibleForAllTyFlag argf -- Don't default *visible* quantification -- or we get the mess in #13963 , Just substituted_ty <- check_substitution var_kind = let subs' = extendFsEnv subs var substituted_ty -- Record that we should replace it with LiftedRep/Lifted/Many, -- and recurse, discarding the forall - in go subs' ty + in go subs' True ty - go subs (IfaceForAllTy bndr ty) - = IfaceForAllTy (go_ifacebndr subs bndr) (go subs ty) + go subs rank1 (IfaceForAllTy bndr ty) + = IfaceForAllTy (go_ifacebndr subs bndr) (go subs rank1 ty) - go subs ty@(IfaceTyVar tv) = case lookupFsEnv subs tv of + go subs _ ty@(IfaceTyVar tv) = case lookupFsEnv subs tv of Just s -> s Nothing -> ty - go _ ty@(IfaceFreeTyVar tv) + go _ _ ty@(IfaceFreeTyVar tv) -- See Note [Defaulting RuntimeRep variables], about free vars | def_rep , GHC.Core.Type.isRuntimeRepTy (tyVarKind tv) @@ -1138,34 +1171,34 @@ defaultIfaceTyVarsOfKind def_rep def_mult ty = go emptyFsEnv ty | otherwise = ty - go subs (IfaceTyConApp tc tc_args) + go subs _ (IfaceTyConApp tc tc_args) = IfaceTyConApp tc (go_args subs tc_args) - go subs (IfaceTupleTy sort is_prom tc_args) + go subs _ (IfaceTupleTy sort is_prom tc_args) = IfaceTupleTy sort is_prom (go_args subs tc_args) - go subs (IfaceFunTy af w arg res) - = IfaceFunTy af (go subs w) (go subs arg) (go subs res) + go subs rank1 (IfaceFunTy af w arg res) + = IfaceFunTy af (go subs False w) (go subs False arg) (go subs rank1 res) - go subs (IfaceAppTy t ts) - = IfaceAppTy (go subs t) (go_args subs ts) + go subs _ (IfaceAppTy t ts) + = IfaceAppTy (go subs False t) (go_args subs ts) - go subs (IfaceCastTy x co) - = IfaceCastTy (go subs x) co + go subs rank1 (IfaceCastTy x co) + = IfaceCastTy (go subs rank1 x) co - go _ ty@(IfaceLitTy {}) = ty - go _ ty@(IfaceCoercionTy {}) = ty + go _ _ ty@(IfaceLitTy {}) = ty + go _ _ ty@(IfaceCoercionTy {}) = ty go_ifacebndr :: FastStringEnv IfaceType -> IfaceForAllBndr -> IfaceForAllBndr go_ifacebndr subs (Bndr (IfaceIdBndr (w, n, t)) argf) - = Bndr (IfaceIdBndr (w, n, go subs t)) argf + = Bndr (IfaceIdBndr (w, n, go subs False t)) argf go_ifacebndr subs (Bndr (IfaceTvBndr (n, t)) argf) - = Bndr (IfaceTvBndr (n, go subs t)) argf + = Bndr (IfaceTvBndr (n, go subs False t)) argf go_args :: FastStringEnv IfaceType -> IfaceAppArgs -> IfaceAppArgs go_args _ IA_Nil = IA_Nil go_args subs (IA_Arg ty argf args) - = IA_Arg (go subs ty) argf (go_args subs args) + = IA_Arg (go subs False ty) argf (go_args subs args) check_substitution :: IfaceType -> Maybe IfaceType check_substitution (IfaceTyConApp tc _) @@ -1236,7 +1269,7 @@ ppr_app_arg ctx_prec (t, argf) = Specified | print_kinds -> char '@' <> ppr_ty appPrec t Inferred | print_kinds - -> char '@' <> braces (ppr_ty topPrec t) + -> char '@' <> braces (ppr_ty_nested t) _ -> empty ------------------- @@ -1367,7 +1400,7 @@ ppr_sigma show_forall ctxt_prec iface_ty -- Then it could handle both invisible and required binders, and -- splitIfaceReqForallTy wouldn't be necessary here. in ppr_iface_forall_part show_forall invis_tvs theta $ - sep [pprIfaceForAll req_tvs, ppr tau'] + sep [pprIfaceForAll req_tvs, ppr_ty_nested tau'] pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc pprUserIfaceForAll tvs ===================================== compiler/GHC/Types/Unique/DFM.hs ===================================== @@ -94,7 +94,7 @@ import qualified Data.IntSet as I -- order then `udfmToList` returns them in deterministic order. -- -- There is an implementation cost: each element is given a serial number --- as it is added, and `udfmToList` sorts it's result by this serial +-- as it is added, and `udfmToList` sorts its result by this serial -- number. So you should only use `UniqDFM` if you need the deterministic -- property. -- ===================================== testsuite/tests/ghci/scripts/T16468.script ===================================== @@ -0,0 +1,52 @@ +:set -XLinearTypes -XImpredicativeTypes +import GHC.Types (RuntimeRep (..), Levity (..), TYPE, Multiplicity, Type, LiftedRep) +import Data.Proxy + +f :: forall p (r' :: RuntimeRep). (forall (r :: RuntimeRep). Int -> p r) -> p r'; f x = x 5 +g :: forall p. Int -> forall (r :: RuntimeRep). p r; g _ = undefined +g' :: Int -> forall p (r :: RuntimeRep). p r; g' _ = undefined +h :: Int -> forall (r :: RuntimeRep). TYPE r; h _ = undefined +i :: forall (r :: RuntimeRep). Int -> TYPE r; i _ = undefined +j :: forall p. Eq (p ('BoxedRep 'Lifted)) => Int -> forall (r :: RuntimeRep). p r; j _ = undefined +k :: forall p (r' :: RuntimeRep). Eq (p r') => (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) -> p r'; k x = x 5 +class C a where l :: forall (r :: RuntimeRep) (b :: TYPE r). a -> b +m :: (forall (m :: Multiplicity). Int %m -> Int) -> Int; m x = x 5 +n :: forall (m :: Multiplicity). Int %m -> Int; n a = a +o :: Maybe (forall (r :: RuntimeRep). Proxy r); o = Nothing +p :: (forall (r :: RuntimeRep). Proxy r, Int); p = undefined +q :: p (forall (r :: RuntimeRep). Proxy r); q = undefined +r :: forall (a :: (forall (r :: RuntimeRep). TYPE r)) (p :: (forall (r :: RuntimeRep). TYPE r) -> Type). p a; r = r + +:set -XNoLinearTypes + +:type f +:type g +:type g' +:type h +:type i +:type j +:type k +:type l +:type m +:type n +:type o +:type p +:type q +:type r + +:set -fprint-explicit-runtime-reps +:set -XLinearTypes +:type f +:type g +:type g' +:type h +:type i +:type j +:type k +:type l +:type m +:type n +:type o +:type p +:type q +:type r ===================================== testsuite/tests/ghci/scripts/T16468.stdout ===================================== @@ -0,0 +1,34 @@ +f :: (forall (r :: RuntimeRep). Int -> p r) -> p LiftedRep +g :: Int -> p LiftedRep +g' :: Int -> forall (p :: RuntimeRep -> *). p LiftedRep +h :: Int -> * +i :: Int -> * +j :: Eq (p LiftedRep) => Int -> p LiftedRep +k :: Eq (p LiftedRep) => + (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) -> p LiftedRep +l :: C a => a -> b +m :: (forall (m :: Multiplicity). Int %m -> Int) -> Int +n :: Int -> Int +o :: Maybe (forall (r :: RuntimeRep). Proxy r) +p :: (Proxy LiftedRep, Int) +q :: p (forall (r :: RuntimeRep). Proxy r) +r :: forall (a :: forall (r :: RuntimeRep). TYPE r) + (p :: (forall (r :: RuntimeRep). TYPE r) -> *). + p a +f :: (forall (r :: RuntimeRep). Int -> p r) -> p r' +g :: Int -> forall (r :: RuntimeRep). p r +g' :: Int -> forall (p :: RuntimeRep -> *) (r :: RuntimeRep). p r +h :: Int -> forall (r :: RuntimeRep). TYPE r +i :: Int -> TYPE r +j :: Eq (p LiftedRep) => Int -> forall (r :: RuntimeRep). p r +k :: Eq (p r') => + (forall (r :: RuntimeRep). Eq (p r) => Int -> p r) -> p r' +l :: forall a (r :: RuntimeRep) (b :: TYPE r). C a => a -> b +m :: (forall (m :: Multiplicity). Int %m -> Int) -> Int +n :: Int %m -> Int +o :: Maybe (forall (r :: RuntimeRep). Proxy r) +p :: (forall (r :: RuntimeRep). Proxy r, Int) +q :: p (forall (r :: RuntimeRep). Proxy r) +r :: forall (a :: forall (r :: RuntimeRep). TYPE r) + (p :: (forall (r :: RuntimeRep). TYPE r) -> *). + p a ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -375,3 +375,4 @@ test('T22695', normal, ghci_script, ['T22695.script']) test('T22817', normal, ghci_script, ['T22817.script']) test('T22908', normal, ghci_script, ['T22908.script']) test('T23062', normal, ghci_script, ['T23062.script']) +test('T16468', normal, ghci_script, ['T16468.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/459dee1b671958bcd5857a676afaf92f944a0af4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/459dee1b671958bcd5857a676afaf92f944a0af4 You're receiving 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 Jun 27 20:55:25 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 27 Jun 2023 16:55:25 -0400 Subject: [Git][ghc/ghc][master] Remove duplicate link label in linear types docs Message-ID: <649b4cbd4eee3_12d3acc76781098bb@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - 1 changed file: - docs/users_guide/exts/linear_types.rst Changes: ===================================== docs/users_guide/exts/linear_types.rst ===================================== @@ -14,7 +14,7 @@ Linear types warts, and bad error messages; everything down to the syntax is subject to change**. See, in particular, :ref:`linear-types-limitations` below. We encourage you to experiment -with this extension and report issues in the GHC bug tracker `the GHC +with this extension and report issues in `the GHC bug tracker `__, adding the tag ``LinearTypes``. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/151f8f18dd5e404019f62767f923cdb22959c6ea -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/151f8f18dd5e404019f62767f923cdb22959c6ea You're receiving 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 Jun 27 21:26:15 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 27 Jun 2023 17:26:15 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's Message-ID: <649b53f7d3155_12d3ac61f0a08113899@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - 1b5f265e by aadaa_fgtaa at 2023-06-27T17:26:08-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 5b9ef023 by Rodrigo Mesquita at 2023-06-27T17:26:09-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - a4d21106 by Ben Gamari at 2023-06-27T17:26:10-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 30 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools.hs - − compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Types/Unique/DFM.hs - compiler/ghc.cabal.in - configure.ac - distrib/configure.ac.in - docs/users_guide/exts/linear_types.rst - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Rules/Generate.hs - libraries/template-haskell/Language/Haskell/TH/Syntax.hs - libraries/template-haskell/changelog.md - − m4/fp_ld_supports_response_files.m4 - + m4/fp_link_supports_no_as_needed.m4 - + m4/fp_merge_objects_supports_response_files.m4 - m4/fptools_set_c_ld_flags.m4 - rts/Linker.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/771e6f62d3c9df8fd8ab3362495aad091463ce6b...a4d21106da0864fb79fe8c99eaa7a6c2c8d7ca78 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/771e6f62d3c9df8fd8ab3362495aad091463ce6b...a4d21106da0864fb79fe8c99eaa7a6c2c8d7ca78 You're receiving 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 Jun 27 22:10:41 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Tue, 27 Jun 2023 18:10:41 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/az/epa-simpler-comb2 Message-ID: <649b5e617e39b_12d3ac5ff341c126782@gitlab.mail> Alan Zimmerman pushed new branch wip/az/epa-simpler-comb2 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/az/epa-simpler-comb2 You're receiving 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 Jun 27 22:49:45 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Tue, 27 Jun 2023 18:49:45 -0400 Subject: [Git][ghc/ghc][wip/T23543] 11 commits: Support large stack frames/offsets in GHCi bytecode interpreter Message-ID: <649b678961c9_12d3ac71545a81356e1@gitlab.mail> Ryan Scott pushed to branch wip/T23543 at Glasgow Haskell Compiler / GHC Commits: 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - 43918aa4 by Ryan Scott at 2023-06-27T18:49:29-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - 30 changed files: - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - compiler/GHC/Builtin/Types.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Breakpoints.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Linker/Loader.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/005f5d348d60413541c078ca2932f3d7d8e2b9de...43918aa43f9d0ff10adabf37eddaa2b1754d2bcb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/005f5d348d60413541c078ca2932f3d7d8e2b9de...43918aa43f9d0ff10adabf37eddaa2b1754d2bcb You're receiving 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 Jun 27 22:52:03 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Tue, 27 Jun 2023 18:52:03 -0400 Subject: [Git][ghc/ghc][wip/testsuite-no-cusks-transitional] 11 commits: Support large stack frames/offsets in GHCi bytecode interpreter Message-ID: <649b6813749e2_12d3ac6f5fb80136066@gitlab.mail> Vladislav Zavialov pushed to branch wip/testsuite-no-cusks-transitional at Glasgow Haskell Compiler / GHC Commits: 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - d30d7803 by Vladislav Zavialov at 2023-06-28T01:51:50+03:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 30 changed files: - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - compiler/GHC/Builtin/Types.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Breakpoints.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Linker/Loader.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/efd04954aa2d51ab95057327ae4c986f553f43a9...d30d7803ed6cf53bac4876b9270f527a8658d4e1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/efd04954aa2d51ab95057327ae4c986f553f43a9...d30d7803ed6cf53bac4876b9270f527a8658d4e1 You're receiving 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 Jun 27 23:57:21 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 27 Jun 2023 19:57:21 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Optimise ELF linker (#23464) Message-ID: <649b77615aa1b_12d3ac5ff341c153658@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 315ccd6d by aadaa_fgtaa at 2023-06-27T19:57:05-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - a7e3278e by Rodrigo Mesquita at 2023-06-27T19:57:06-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 12f0fb5a by Ben Gamari at 2023-06-27T19:57:07-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 24 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools.hs - − compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - compiler/ghc.cabal.in - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Rules/Generate.hs - − m4/fp_ld_supports_response_files.m4 - + m4/fp_link_supports_no_as_needed.m4 - + m4/fp_merge_objects_supports_response_files.m4 - m4/fptools_set_c_ld_flags.m4 - rts/Linker.c - rts/LinkerInternals.h - rts/linker/Elf.c Changes: ===================================== compiler/GHC/Driver/Backend.hs ===================================== @@ -58,8 +58,6 @@ module GHC.Driver.Backend , DefunctionalizedCodeOutput(..) -- *** Back-end functions for assembly , DefunctionalizedPostHscPipeline(..) - , DefunctionalizedAssemblerProg(..) - , DefunctionalizedAssemblerInfoGetter(..) -- *** Other back-end functions , DefunctionalizedCDefs(..) -- ** Names of back ends (for API clients of version 9.4 or earlier) @@ -94,8 +92,6 @@ module GHC.Driver.Backend , backendSupportsHpc , backendSupportsCImport , backendSupportsCExport - , backendAssemblerProg - , backendAssemblerInfoGetter , backendCDefs , backendCodeOutput , backendUseJSLinker @@ -348,40 +344,6 @@ data PrimitiveImplementation deriving Show --- | Names a function that runs the assembler, of this type: --- --- > Logger -> DynFlags -> Platform -> [Option] -> IO () --- --- The functions so named are defined in "GHC.Driver.Pipeline.Execute". - -data DefunctionalizedAssemblerProg - = StandardAssemblerProg - -- ^ Use the standard system assembler - | JSAssemblerProg - -- ^ JS Backend compile to JS via Stg, and so does not use any assembler - | DarwinClangAssemblerProg - -- ^ If running on Darwin, use the assembler from the @clang@ - -- toolchain. Otherwise use the standard system assembler. - - - --- | Names a function that discover from what toolchain the assembler --- is coming, of this type: --- --- > Logger -> DynFlags -> Platform -> IO CompilerInfo --- --- The functions so named are defined in "GHC.Driver.Pipeline.Execute". - -data DefunctionalizedAssemblerInfoGetter - = StandardAssemblerInfoGetter - -- ^ Interrogate the standard system assembler - | JSAssemblerInfoGetter - -- ^ If using the JS backend; return 'Emscripten' - | DarwinClangAssemblerInfoGetter - -- ^ If running on Darwin, return `Clang`; otherwise - -- interrogate the standard system assembler. - - -- | Names a function that generates code and writes the results to a -- file, of this type: -- @@ -767,45 +729,6 @@ backendSupportsCExport (Named JavaScript) = True backendSupportsCExport (Named Interpreter) = False backendSupportsCExport (Named NoBackend) = True --- | This (defunctionalized) function runs the assembler --- used on the code that is written by this back end. A --- program determined by a combination of back end, --- `DynFlags`, and `Platform` is run with the given --- `Option`s. --- --- The function's type is --- @ --- Logger -> DynFlags -> Platform -> [Option] -> IO () --- @ --- --- This field is usually defaulted. -backendAssemblerProg :: Backend -> DefunctionalizedAssemblerProg -backendAssemblerProg (Named NCG) = StandardAssemblerProg -backendAssemblerProg (Named LLVM) = DarwinClangAssemblerProg -backendAssemblerProg (Named ViaC) = StandardAssemblerProg -backendAssemblerProg (Named JavaScript) = JSAssemblerProg -backendAssemblerProg (Named Interpreter) = StandardAssemblerProg -backendAssemblerProg (Named NoBackend) = StandardAssemblerProg - --- | This (defunctionalized) function is used to retrieve --- an enumeration value that characterizes the C/assembler --- part of a toolchain. The function caches the info in a --- mutable variable that is part of the `DynFlags`. --- --- The function's type is --- @ --- Logger -> DynFlags -> Platform -> IO CompilerInfo --- @ --- --- This field is usually defaulted. -backendAssemblerInfoGetter :: Backend -> DefunctionalizedAssemblerInfoGetter -backendAssemblerInfoGetter (Named NCG) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named LLVM) = DarwinClangAssemblerInfoGetter -backendAssemblerInfoGetter (Named ViaC) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named JavaScript) = JSAssemblerInfoGetter -backendAssemblerInfoGetter (Named Interpreter) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named NoBackend) = StandardAssemblerInfoGetter - -- | When using this back end, it may be necessary or -- advisable to pass some `-D` options to a C compiler. -- This (defunctionalized) function produces those ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -116,7 +116,6 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Trans.Reader (ReaderT) import Control.Monad.Trans.Writer (WriterT) -import Data.IORef import System.IO import System.IO.Error (catchIOError) import System.Environment (lookupEnv) @@ -420,15 +419,6 @@ data DynFlags = DynFlags { avx512pf :: Bool, -- Enable AVX-512 PreFetch Instructions. fma :: Bool, -- ^ Enable FMA instructions. - -- | Run-time linker information (what options we need, etc.) - rtldInfo :: IORef (Maybe LinkerInfo), - - -- | Run-time C compiler information - rtccInfo :: IORef (Maybe CompilerInfo), - - -- | Run-time assembler information - rtasmInfo :: IORef (Maybe CompilerInfo), - -- Constants used to control the amount of optimization done. -- | Max size, in bytes, of inline array allocations. @@ -490,9 +480,6 @@ class ContainsDynFlags t where initDynFlags :: DynFlags -> IO DynFlags initDynFlags dflags = do let - refRtldInfo <- newIORef Nothing - refRtccInfo <- newIORef Nothing - refRtasmInfo <- newIORef Nothing canUseUnicode <- do let enc = localeEncoding str = "‘’" (withCString enc str $ \cstr -> @@ -514,9 +501,6 @@ initDynFlags dflags = do useColor = useColor', canUseColor = stderrSupportsAnsiColors, colScheme = colScheme', - rtldInfo = refRtldInfo, - rtccInfo = refRtccInfo, - rtasmInfo = refRtasmInfo, tmpDir = TempDir tmp_dir } @@ -695,9 +679,6 @@ defaultDynFlags mySettings = avx512f = False, avx512pf = False, fma = False, - rtldInfo = panic "defaultDynFlags: no rtldInfo", - rtccInfo = panic "defaultDynFlags: no rtccInfo", - rtasmInfo = panic "defaultDynFlags: no rtasmInfo", maxInlineAllocSize = 128, maxInlineMemcpyInsns = 32, ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -109,9 +109,6 @@ module GHC.Driver.Main import GHC.Prelude -import GHC.Platform -import GHC.Platform.Ways - import GHC.Driver.Plugins import GHC.Driver.Session import GHC.Driver.Backend @@ -345,41 +342,11 @@ initHscEnv mb_top_dir = do mySettings <- initSysTools top_dir dflags <- initDynFlags (defaultDynFlags mySettings) hsc_env <- newHscEnv top_dir dflags - checkBrokenTablesNextToCode (hsc_logger hsc_env) dflags setUnsafeGlobalDynFlags dflags -- c.f. DynFlags.parseDynamicFlagsFull, which -- creates DynFlags and sets the UnsafeGlobalDynFlags return hsc_env --- | The binutils linker on ARM emits unnecessary R_ARM_COPY relocations which --- breaks tables-next-to-code in dynamically linked modules. This --- check should be more selective but there is currently no released --- version where this bug is fixed. --- See https://sourceware.org/bugzilla/show_bug.cgi?id=16177 and --- https://gitlab.haskell.org/ghc/ghc/issues/4210#note_78333 -checkBrokenTablesNextToCode :: Logger -> DynFlags -> IO () -checkBrokenTablesNextToCode logger dflags = do - let invalidLdErr = "Tables-next-to-code not supported on ARM \ - \when using binutils ld (please see: \ - \https://sourceware.org/bugzilla/show_bug.cgi?id=16177)" - broken <- checkBrokenTablesNextToCode' logger dflags - when broken (panic invalidLdErr) - -checkBrokenTablesNextToCode' :: Logger -> DynFlags -> IO Bool -checkBrokenTablesNextToCode' logger dflags - | not (isARM arch) = return False - | ways dflags `hasNotWay` WayDyn = return False - | not tablesNextToCode = return False - | otherwise = do - linkerInfo <- liftIO $ GHC.SysTools.getLinkerInfo logger dflags - case linkerInfo of - GnuLD _ -> return True - _ -> return False - where platform = targetPlatform dflags - arch = platformArch platform - tablesNextToCode = platformTablesNextToCode platform - - -- ----------------------------------------------------------------------------- getDiagnostics :: Hsc (Messages GhcMessage) ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -287,12 +287,6 @@ runAsPhase :: Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO F runAsPhase with_cpp pipe_env hsc_env location input_fn = do let dflags = hsc_dflags hsc_env let logger = hsc_logger hsc_env - let unit_env = hsc_unit_env hsc_env - let platform = ue_platform unit_env - - -- LLVM from version 3.0 onwards doesn't support the OS X system - -- assembler, so we use clang as the assembler instead. (#5636) - let as_prog = applyAssemblerProg $ backendAssemblerProg (backend dflags) let cmdline_include_paths = includePaths dflags let pic_c_flags = picCCOpts dflags @@ -310,9 +304,8 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do includePathsQuoteImplicit cmdline_include_paths] let runAssembler inputFilename outputFilename = withAtomicRename outputFilename $ \temp_outputFilename -> - as_prog + runAs logger dflags - platform (local_includes ++ global_includes -- See Note [-fPIC for assembler] ++ map GHC.SysTools.Option pic_c_flags @@ -392,22 +385,6 @@ runForeignJsPhase pipe_env hsc_env _location input_fn = do embedJsFile logger dflags tmpfs unit_env input_fn output_fn return output_fn - -applyAssemblerProg - :: DefunctionalizedAssemblerProg - -> Logger -> DynFlags -> Platform -> [Option] -> IO () -applyAssemblerProg StandardAssemblerProg logger dflags _platform = - runAs logger dflags -applyAssemblerProg JSAssemblerProg logger dflags _platform = - runEmscripten logger dflags -applyAssemblerProg DarwinClangAssemblerProg logger dflags platform = - if platformOS platform == OSDarwin then - runClang logger dflags - else - runAs logger dflags - - - runCcPhase :: Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO FilePath runCcPhase cc_phase pipe_env hsc_env location input_fn = do let dflags = hsc_dflags hsc_env ===================================== compiler/GHC/Linker/ExtraObj.hs ===================================== @@ -12,7 +12,6 @@ module GHC.Linker.ExtraObj , mkNoteObjsToLinkIntoBinary , checkLinkInfo , getLinkInfo - , getCompilerInfo , ghcLinkInfoSectionName , ghcLinkInfoNoteName , platformSupportsSavingLinkOpts @@ -40,10 +39,8 @@ import qualified GHC.Data.ShortText as ST import GHC.SysTools.Elf import GHC.SysTools.Tasks -import GHC.SysTools.Info import GHC.Linker.Unit -import Control.Monad.IO.Class import Control.Monad import Data.Maybe @@ -52,7 +49,6 @@ mkExtraObj logger tmpfs dflags unit_state extn xs = do cFile <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule extn oFile <- newTempName logger tmpfs (tmpDir dflags) TFL_GhcSession "o" writeFile cFile xs - ccInfo <- liftIO $ getCompilerInfo logger dflags runCc Nothing logger tmpfs dflags ([Option "-c", FileOption "" cFile, @@ -60,7 +56,7 @@ mkExtraObj logger tmpfs dflags unit_state extn xs FileOption "" oFile] ++ if extn /= "s" then cOpts - else asmOpts ccInfo) + else []) return oFile where -- Pass a different set of options to the C compiler depending one whether @@ -70,14 +66,6 @@ mkExtraObj logger tmpfs dflags unit_state extn xs ++ map (FileOption "-I" . ST.unpack) (unitIncludeDirs $ unsafeLookupUnit unit_state rtsUnit) - -- When compiling assembler code, we drop the usual C options, and if the - -- compiler is Clang, we add an extra argument to tell Clang to ignore - -- unused command line options. See trac #11684. - asmOpts ccInfo = - if any (ccInfo ==) [Clang, AppleClang, AppleClang51] - then [Option "-Qunused-arguments"] - else [] - -- When linking a binary, we need to create a C main() function that -- starts everything off. This used to be compiled statically as part -- of the RTS, but that made it hard to change the -rtsopts setting, ===================================== compiler/GHC/Settings.hs ===================================== @@ -19,7 +19,7 @@ module GHC.Settings , sGlobalPackageDatabasePath , sLdSupportsCompactUnwind , sLdSupportsFilelist - , sLdSupportsResponseFiles + , sMergeObjsSupportsResponseFiles , sLdIsGnuLd , sGccSupportsNoPie , sUseInplaceMinGW @@ -88,7 +88,7 @@ data Settings = Settings data ToolSettings = ToolSettings { toolSettings_ldSupportsCompactUnwind :: Bool , toolSettings_ldSupportsFilelist :: Bool - , toolSettings_ldSupportsResponseFiles :: Bool + , toolSettings_mergeObjsSupportsResponseFiles :: Bool , toolSettings_ldIsGnuLd :: Bool , toolSettings_ccSupportsNoPie :: Bool , toolSettings_useInplaceMinGW :: Bool @@ -191,8 +191,8 @@ sLdSupportsCompactUnwind :: Settings -> Bool sLdSupportsCompactUnwind = toolSettings_ldSupportsCompactUnwind . sToolSettings sLdSupportsFilelist :: Settings -> Bool sLdSupportsFilelist = toolSettings_ldSupportsFilelist . sToolSettings -sLdSupportsResponseFiles :: Settings -> Bool -sLdSupportsResponseFiles = toolSettings_ldSupportsResponseFiles . sToolSettings +sMergeObjsSupportsResponseFiles :: Settings -> Bool +sMergeObjsSupportsResponseFiles = toolSettings_mergeObjsSupportsResponseFiles . sToolSettings sLdIsGnuLd :: Settings -> Bool sLdIsGnuLd = toolSettings_ldIsGnuLd . sToolSettings sGccSupportsNoPie :: Settings -> Bool ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -104,7 +104,7 @@ initSettings top_dir = do ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" ldSupportsFilelist <- getBooleanSetting "ld supports filelist" - ldSupportsResponseFiles <- getBooleanSetting "ld supports response files" + mergeObjsSupportsResponseFiles <- getBooleanSetting "Merge objects supports response files" ldIsGnuLd <- getBooleanSetting "ld is GNU ld" arSupportsDashL <- getBooleanSetting "ar supports -L" @@ -173,7 +173,7 @@ initSettings top_dir = do , sToolSettings = ToolSettings { toolSettings_ldSupportsCompactUnwind = ldSupportsCompactUnwind , toolSettings_ldSupportsFilelist = ldSupportsFilelist - , toolSettings_ldSupportsResponseFiles = ldSupportsResponseFiles + , toolSettings_mergeObjsSupportsResponseFiles = mergeObjsSupportsResponseFiles , toolSettings_ldIsGnuLd = ldIsGnuLd , toolSettings_ccSupportsNoPie = gccSupportsNoPie , toolSettings_useInplaceMinGW = useInplaceMinGW ===================================== compiler/GHC/SysTools.hs ===================================== @@ -17,7 +17,6 @@ module GHC.SysTools ( -- * Interface to system tools module GHC.SysTools.Tasks, - module GHC.SysTools.Info, -- * Fast file copy copyFile, @@ -35,8 +34,6 @@ import GHC.Prelude import GHC.Utils.Panic import GHC.Driver.Session -import GHC.Linker.ExtraObj -import GHC.SysTools.Info import GHC.SysTools.Tasks import GHC.SysTools.BaseDir import GHC.Settings.IO ===================================== compiler/GHC/SysTools/Info.hs deleted ===================================== @@ -1,243 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} ------------------------------------------------------------------------------ --- --- Compiler information functions --- --- (c) The GHC Team 2017 --- ------------------------------------------------------------------------------ -module GHC.SysTools.Info where - -import GHC.Utils.Exception -import GHC.Utils.Error -import GHC.Driver.Session -import GHC.Utils.Outputable -import GHC.Utils.Misc -import GHC.Utils.Logger - -import Data.List ( isInfixOf, isPrefixOf ) -import Data.IORef - -import System.IO - -import GHC.Platform -import GHC.Prelude - -import GHC.SysTools.Process - -{- Note [Run-time linker info] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~ -See also: #5240, #6063, #10110 - -Before 'runLink', we need to be sure to get the relevant information -about the linker we're using at runtime to see if we need any extra -options. - -Generally, the linker changing from what was detected at ./configure -time has always been possible using -pgml, but on Linux it can happen -'transparently' by installing packages like binutils-gold, which -change what /usr/bin/ld actually points to. - -Clang vs GCC notes: - -For gcc, 'gcc -Wl,--version' gives a bunch of output about how to -invoke the linker before the version information string. For 'clang', -the version information for 'ld' is all that's output. For this -reason, we typically need to slurp up all of the standard error output -and look through it. - -Other notes: - -We cache the LinkerInfo inside DynFlags, since clients may link -multiple times. The definition of LinkerInfo is there to avoid a -circular dependency. - --} - -{- Note [ELF needed shared libs] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Some distributions change the link editor's default handling of -ELF DT_NEEDED tags to include only those shared objects that are -needed to resolve undefined symbols. For Template Haskell we need -the last temporary shared library also if it is not needed for the -currently linked temporary shared library. We specify --no-as-needed -to override the default. This flag exists in GNU ld and GNU gold. - -The flag is only needed on ELF systems. On Windows (PE) and Mac OS X -(Mach-O) the flag is not needed. - --} - -neededLinkArgs :: LinkerInfo -> [Option] -neededLinkArgs (GnuLD o) = o -neededLinkArgs (Mold o) = o -neededLinkArgs (GnuGold o) = o -neededLinkArgs (LlvmLLD o) = o -neededLinkArgs (DarwinLD o) = o -neededLinkArgs (SolarisLD o) = o -neededLinkArgs (AixLD o) = o -neededLinkArgs UnknownLD = [] - --- Grab linker info and cache it in DynFlags. -getLinkerInfo :: Logger -> DynFlags -> IO LinkerInfo -getLinkerInfo logger dflags = do - info <- readIORef (rtldInfo dflags) - case info of - Just v -> return v - Nothing -> do - v <- getLinkerInfo' logger dflags - writeIORef (rtldInfo dflags) (Just v) - return v - --- See Note [Run-time linker info]. -getLinkerInfo' :: Logger -> DynFlags -> IO LinkerInfo -getLinkerInfo' logger dflags = do - let platform = targetPlatform dflags - os = platformOS platform - (pgm,args0) = pgm_l dflags - args1 = map Option (getOpts dflags opt_l) - args2 = args0 ++ args1 - args3 = filter notNull (map showOpt args2) - - -- Try to grab the info from the process output. - parseLinkerInfo stdo _stde _exitc - | any ("GNU ld" `isPrefixOf`) stdo = - -- Set DT_NEEDED for all shared libraries. #10110. - return (GnuLD $ map Option [-- ELF specific flag - -- 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] - return (GnuGold [Option "-Wl,--no-as-needed"]) - - | any (\line -> "LLD" `isPrefixOf` line || "LLD" `elem` words line) stdo = - return (LlvmLLD $ map Option [ --see Note [ELF needed shared libs] - "-Wl,--no-as-needed" | osElfTarget os || os == OSMinGW32 ]) - - -- Unknown linker. - | otherwise = fail "invalid --version output, or linker is unsupported" - - -- Process the executable call - catchIO ( - case os of - OSSolaris2 -> - -- Solaris uses its own Solaris linker. Even all - -- GNU C are recommended to configure with Solaris - -- linker instead of using GNU binutils linker. Also - -- all GCC distributed with Solaris follows this rule - -- precisely so we assume here, the Solaris linker is - -- used. - return $ SolarisLD [] - OSAIX -> - -- IBM AIX uses its own non-binutils linker as well - return $ AixLD [] - OSDarwin -> - -- Darwin has neither GNU Gold or GNU LD, but a strange linker - -- that doesn't support --version. We can just assume that's - -- what we're using. - return $ DarwinLD [] - OSMinGW32 -> - -- GHC doesn't support anything but GNU ld on Windows anyway. - -- Process creation is also fairly expensive on win32, so - -- we short-circuit here. - return $ GnuLD $ map Option - [ -- Emit stack checks - -- See Note [Windows stack allocations] - "-fstack-check" - ] - _ -> do - -- In practice, we use the compiler as the linker here. Pass - -- -Wl,--version to get linker version info. - (exitc, stdo, stde) <- readProcessEnvWithExitCode pgm - (["-Wl,--version"] ++ args3) - c_locale_env - -- Split the output by lines to make certain kinds - -- of processing easier. In particular, 'clang' and 'gcc' - -- have slightly different outputs for '-Wl,--version', but - -- it's still easy to figure out. - parseLinkerInfo (lines stdo) (lines stde) exitc - ) - (\err -> do - debugTraceMsg logger 2 - (text "Error (figuring out linker information):" <+> - text (show err)) - errorMsg logger $ hang (text "Warning:") 9 $ - text "Couldn't figure out linker information!" $$ - text "Make sure you're using GNU ld, GNU gold" <+> - text "or the built in OS X linker, etc." - return UnknownLD - ) - --- | Grab compiler info and cache it in DynFlags. -getCompilerInfo :: Logger -> DynFlags -> IO CompilerInfo -getCompilerInfo logger dflags = do - info <- readIORef (rtccInfo dflags) - case info of - Just v -> return v - Nothing -> do - let pgm = pgm_c dflags - v <- getCompilerInfo' logger pgm - writeIORef (rtccInfo dflags) (Just v) - return v - --- | Grab assembler info and cache it in DynFlags. -getAssemblerInfo :: Logger -> DynFlags -> IO CompilerInfo -getAssemblerInfo logger dflags = do - info <- readIORef (rtasmInfo dflags) - case info of - Just v -> return v - Nothing -> do - let (pgm, _) = pgm_a dflags - v <- getCompilerInfo' logger pgm - writeIORef (rtasmInfo dflags) (Just v) - return v - --- See Note [Run-time linker info]. -getCompilerInfo' :: Logger -> String -> IO CompilerInfo -getCompilerInfo' logger pgm = do - let -- Try to grab the info from the process output. - parseCompilerInfo _stdo stde _exitc - -- Regular GCC - | any ("gcc version" `isInfixOf`) stde = - return GCC - -- Regular clang - | any ("clang version" `isInfixOf`) stde = - return Clang - -- FreeBSD clang - | any ("FreeBSD clang version" `isInfixOf`) stde = - return Clang - -- Xcode 5.1 clang - | any ("Apple LLVM version 5.1" `isPrefixOf`) stde = - return AppleClang51 - -- Xcode 5 clang - | any ("Apple LLVM version" `isPrefixOf`) stde = - return AppleClang - -- Xcode 4.1 clang - | any ("Apple clang version" `isPrefixOf`) stde = - return AppleClang - -- Unknown compiler. - | otherwise = fail $ "invalid -v output, or compiler is unsupported (" ++ pgm ++ "): " ++ unlines stde - - -- Process the executable call - catchIO (do - (exitc, stdo, stde) <- - readProcessEnvWithExitCode pgm ["-v"] c_locale_env - -- Split the output by lines to make certain kinds - -- of processing easier. - parseCompilerInfo (lines stdo) (lines stde) exitc - ) - (\err -> do - debugTraceMsg logger 2 - (text "Error (figuring out C compiler information):" <+> - text (show err)) - errorMsg logger $ hang (text "Warning:") 9 $ - text "Couldn't figure out C compiler information!" $$ - text "Make sure you're using GNU gcc, or clang" - return UnknownCC - ) ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -19,7 +19,6 @@ import GHC.CmmToLlvm.Config (LlvmVersion, llvmVersionStr, supportedLlvmVersionUp import GHC.Settings import GHC.SysTools.Process -import GHC.SysTools.Info import GHC.Driver.Session @@ -278,15 +277,12 @@ figureLlvmVersion logger dflags = traceSystoolCommand logger "llc" $ do runLink :: Logger -> TmpFs -> DynFlags -> [Option] -> IO () runLink logger tmpfs dflags args = traceSystoolCommand logger "linker" $ do - -- See Note [Run-time linker info] - -- -- `-optl` args come at the end, so that later `-l` options -- given there manually can fill in symbols needed by -- Haskell libraries coming in via `args`. - linkargs <- neededLinkArgs `fmap` getLinkerInfo logger dflags let (p,args0) = pgm_l dflags optl_args = map Option (getOpts dflags opt_l) - args2 = args0 ++ linkargs ++ args ++ optl_args + args2 = args0 ++ args ++ optl_args mb_env <- getGccEnv args2 runSomethingResponseFile logger tmpfs dflags ld_filter "Linker" p args2 mb_env where @@ -349,7 +345,7 @@ runMergeObjects logger tmpfs dflags args = , "does not support object merging." ] optl_args = map Option (getOpts dflags opt_lm) args2 = args0 ++ args ++ optl_args - if toolSettings_ldSupportsResponseFiles (toolSettings dflags) + if toolSettings_mergeObjsSupportsResponseFiles (toolSettings dflags) then do mb_env <- getGccEnv args2 runSomethingResponseFile logger tmpfs dflags id "Merge objects" p args2 mb_env ===================================== compiler/ghc.cabal.in ===================================== @@ -715,7 +715,6 @@ Library GHC.SysTools.BaseDir GHC.SysTools.Cpp GHC.SysTools.Elf - GHC.SysTools.Info GHC.SysTools.Process GHC.SysTools.Tasks GHC.SysTools.Terminal ===================================== configure.ac ===================================== @@ -648,7 +648,7 @@ 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]) -FP_LD_SUPPORTS_RESPONSE_FILES +FP_MERGE_OBJECTS_SUPPORTS_RESPONSE_FILES GHC_LLVM_TARGET_SET_VAR # we intend to pass trough --targets to llvm as is. ===================================== distrib/configure.ac.in ===================================== @@ -176,7 +176,7 @@ 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]) -FP_LD_SUPPORTS_RESPONSE_FILES +FP_MERGE_OBJECTS_SUPPORTS_RESPONSE_FILES AC_SUBST(CONF_CC_OPTS_STAGE0) AC_SUBST(CONF_CC_OPTS_STAGE1) ===================================== hadrian/bindist/Makefile ===================================== @@ -91,10 +91,10 @@ lib/settings : config.mk @echo ',("ld flags", "$(SettingsLdFlags)")' >> $@ @echo ',("ld supports compact unwind", "$(LdHasNoCompactUnwind)")' >> $@ @echo ',("ld supports filelist", "$(LdHasFilelist)")' >> $@ - @echo ',("ld supports response files", "$(LdSupportsResponseFiles)")' >> $@ @echo ',("ld is GNU ld", "$(LdIsGNULd)")' >> $@ @echo ',("Merge objects command", "$(SettingsMergeObjectsCommand)")' >> $@ @echo ',("Merge objects flags", "$(SettingsMergeObjectsFlags)")' >> $@ + @echo ',("Merge objects supports response files", "$(MergeObjsSupportsResponseFiles)")' >> $@ @echo ',("ar command", "$(SettingsArCommand)")' >> $@ @echo ',("ar flags", "$(ArArgs)")' >> $@ @echo ',("ar supports at file", "$(ArSupportsAtFile)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -235,7 +235,7 @@ GhcRtsWithLibdw=$(strip $(if $(filter $(TargetArch_CPP),i386 x86_64 s390x), at UseL # See Note [tooldir: How GHC finds mingw on Windows] LdHasFilelist = @LdHasFilelist@ -LdSupportsResponseFiles = @LdSupportsResponseFiles@ +MergeObjsSupportsResponseFiles = @MergeObjsSupportsResponseFiles@ LdHasBuildId = @LdHasBuildId@ LdHasFilelist = @LdHasFilelist@ LdIsGNULd = @LdIsGNULd@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -139,7 +139,7 @@ conf-merge-objects-args-stage3 = @MergeObjsArgs@ ld-has-no-compact-unwind = @LdHasNoCompactUnwind@ ld-has-filelist = @LdHasFilelist@ -ld-supports-response-files = @LdSupportsResponseFiles@ +merge-objs-supports-response-files = @MergeObjsSupportsResponseFiles@ ld-is-gnu-ld = @LdIsGNULd@ ar-args = @ArArgs@ ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -450,10 +450,10 @@ generateSettings = do , ("ld flags", expr $ settingsFileSetting SettingsFileSetting_LdFlags) , ("ld supports compact unwind", expr $ lookupSystemConfig "ld-has-no-compact-unwind") , ("ld supports filelist", expr $ lookupSystemConfig "ld-has-filelist") - , ("ld supports response files", expr $ lookupSystemConfig "ld-supports-response-files") , ("ld is GNU ld", expr $ lookupSystemConfig "ld-is-gnu-ld") , ("Merge objects command", expr $ settingsFileSetting SettingsFileSetting_MergeObjectsCommand) , ("Merge objects flags", expr $ settingsFileSetting SettingsFileSetting_MergeObjectsFlags) + , ("Merge objects supports response files", expr $ lookupSystemConfig "merge-objs-supports-response-files") , ("ar command", expr $ settingsFileSetting SettingsFileSetting_ArCommand) , ("ar flags", expr $ lookupSystemConfig "ar-args") , ("ar supports at file", expr $ yesNo <$> flag ArSupportsAtFile) ===================================== m4/fp_ld_supports_response_files.m4 deleted ===================================== @@ -1,19 +0,0 @@ -# FP_LD_SUPPORTS_RESPONSE_FILES -# -------------------- -# See if whether we are using a version of ld which supports response files. -AC_DEFUN([FP_LD_SUPPORTS_RESPONSE_FILES], [ - AC_MSG_CHECKING([whether $LD supports response files]) - echo 'int main(void) {return 0;}' > conftest.c - "$CC" -c -o conftest.o conftest.c > /dev/null 2>&1 - printf -- "-o\nconftest\nconftest.o\n" > args.txt - if "$LD" -shared @args.txt > /dev/null 2>&1 || "$LD" -dylib @args.txt > /dev/null 2>&1 - then - LdSupportsResponseFiles=YES - AC_MSG_RESULT([yes]) - else - LdSupportsResponseFiles=NO - AC_MSG_RESULT([no]) - fi - rm -f conftest.c conftest args.txt - AC_SUBST(LdSupportsResponseFiles) -]) ===================================== m4/fp_link_supports_no_as_needed.m4 ===================================== @@ -0,0 +1,33 @@ +# FP_LINK_SUPPORTS_NO_AS_NEEDED +# ---------------------------------- +# Set the Cc linker flag -Wl,--no-as-needed if it is supported +# $1 is the name of the linker flags variable when linking with gcc +# See also Note [ELF needed shared libs] +AC_DEFUN([FP_LINK_SUPPORTS_NO_AS_NEEDED], +[ + AC_MSG_CHECKING([whether Cc linker supports -Wl,--no-as-needed]) + echo 'int f(int a) {return 2*a;}' > conftest.a.c + echo 'int f(int a); int main(int argc, char **argv) {return f(0);}' > conftest.b.c + $CC -c -o conftest.a.o conftest.a.c > /dev/null 2>&1 + $CC -c -o conftest.b.o conftest.b.c > /dev/null 2>&1 + if "$CC" "$$1" -Wl,--no-as-needed -o conftest conftest.a.o conftest.b.o > /dev/null 2>&1 + then + $1="$$1 -Wl,--no-as-needed" + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + fi + rm -f conftest* +]) + +# Note [ELF needed shared libs] +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# Some distributions change the link editor's default handling of +# ELF DT_NEEDED tags to include only those shared objects that are +# needed to resolve undefined symbols. For Template Haskell we need +# the last temporary shared library also if it is not needed for the +# currently linked temporary shared library. We specify --no-as-needed +# to override the default. This flag exists in GNU ld and GNU gold. +# +# The flag is only needed on ELF systems. On Windows (PE) and Mac OS X +# (Mach-O) the flag is not needed. ===================================== m4/fp_merge_objects_supports_response_files.m4 ===================================== @@ -0,0 +1,22 @@ +# FP_MERGE_OBJECTS_SUPPORTS_RESPONSE_FILES +# -------------------- +# See if whether we are using a version of the merge objects tool which supports response files. +AC_DEFUN([FP_MERGE_OBJECTS_SUPPORTS_RESPONSE_FILES], [ + AC_MSG_CHECKING([whether $LD supports response files]) + echo 'int funA(int x) {return x;}' > conftesta.c + echo 'int funB(int x) {return x;}' > conftestb.c + "$CC" -c -o conftesta.o conftesta.c > /dev/null 2>&1 + "$CC" -c -o conftestb.o conftestb.c > /dev/null 2>&1 + printf -- "-o\nconftest.o\nconftesta.o\nconftestb.o\n" > args.txt + "$MergeObjsCmd" "$MergeObjsArgs" @args.txt > /dev/null 2>&1 + if ("$NM" conftest.o | grep "funA" > /dev/null 2>&1) && ("$NM" conftest.o | grep "funB" > /dev/null 2>&1) + then + MergeObjsSupportsResponseFiles=YES + AC_MSG_RESULT([yes]) + else + MergeObjsSupportsResponseFiles=NO + AC_MSG_RESULT([no]) + fi + rm -f conftesta.c conftestb.c conftesta.o conftestb.o conftest.o args.txt + AC_SUBST(MergeObjsSupportsResponseFiles) +]) ===================================== m4/fptools_set_c_ld_flags.m4 ===================================== @@ -17,6 +17,21 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS], ;; esac + # See Note [ELF needed shared libs] + case $$1 in + *-linux|*-freebsd*) + FP_LINK_SUPPORTS_NO_AS_NEEDED([$3]) + ;; + esac + + # Emit stack checks + # See Note [Windows stack allocations] + case $$1 in + *-mingw32*) + $3="$$3 -fstack-check" + ;; + esac + case $$1 in i386-unknown-mingw32) $2="$$2 -march=i686" ===================================== rts/Linker.c ===================================== @@ -1379,6 +1379,10 @@ mkOc( ObjectType type, pathchar *path, char *image, int imageSize, oc->rx_m32 = m32_allocator_new(true); #endif +#if defined(OBJFORMAT_ELF) && defined(SHN_XINDEX) + oc->shndx_table = SHNDX_TABLE_UNINIT; +#endif + oc->nc_ranges = NULL; oc->dlopen_handle = NULL; ===================================== rts/LinkerInternals.h ===================================== @@ -360,6 +360,15 @@ struct _ObjectCode { m32_allocator *rw_m32, *rx_m32; #endif +#if defined(OBJFORMAT_ELF) && defined(SHN_XINDEX) + /* Cached address of ELF's shndx table, or SHNDX_TABLE_UNINIT if not + * initialized yet. It would be better to put it info ELF-specific + * ObjectCodeFormatInfo, but unfortunately shndx table is needed in + * ocVerifyImage_ELF which runs before ObjectCodeFormatInfo is + * initialized by ocInit_ELF. */ + Elf_Word *shndx_table; +#endif + /* * The following are only valid if .type == DYNAMIC_OBJECT */ @@ -371,6 +380,15 @@ struct _ObjectCode { NativeCodeRange *nc_ranges; }; +#if defined(OBJFORMAT_ELF) && defined(SHN_XINDEX) +/* We cannot simply use NULL to signal uninitialised shndx_table because NULL + * is valid return value of get_shndx_table. Thus SHNDX_TABLE_UNINIT is defined + * as the address of global variable shndx_table_uninit_label, defined in + * rts/linker/Elf.c, which is definitely unequal to any heap-allocated address */ +extern Elf_Word shndx_table_uninit_label; +#define SHNDX_TABLE_UNINIT (&shndx_table_uninit_label) +#endif + #define OC_INFORMATIVE_FILENAME(OC) \ ( (OC)->archiveMemberName ? \ (OC)->archiveMemberName : \ ===================================== rts/linker/Elf.c ===================================== @@ -132,6 +132,11 @@ */ +#if defined(SHN_XINDEX) +/* global variable which address is used to signal an uninitialised shndx_table */ +Elf_Word shndx_table_uninit_label = 0; +#endif + static Elf_Word elf_shnum(Elf_Ehdr* ehdr) { Elf_Shdr* shdr = (Elf_Shdr*) ((char*)ehdr + ehdr->e_shoff); @@ -154,16 +159,22 @@ static Elf_Word elf_shstrndx(Elf_Ehdr* ehdr) #if defined(SHN_XINDEX) static Elf_Word* -get_shndx_table(Elf_Ehdr* ehdr) +get_shndx_table(ObjectCode* oc) { + if (RTS_LIKELY(oc->shndx_table != SHNDX_TABLE_UNINIT)) { + return oc->shndx_table; + } + Elf_Word i; - char* ehdrC = (char*)ehdr; + char* ehdrC = oc->image; + Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC; Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); const Elf_Word shnum = elf_shnum(ehdr); for (i = 0; i < shnum; i++) { if (shdr[i].sh_type == SHT_SYMTAB_SHNDX) { - return (Elf32_Word*)(ehdrC + shdr[i].sh_offset); + oc->shndx_table = (Elf32_Word*)(ehdrC + shdr[i].sh_offset); + return oc->shndx_table; } } return NULL; @@ -193,6 +204,10 @@ ocInit_ELF(ObjectCode * oc) oc->n_sections = elf_shnum(oc->info->elfHeader); + ElfRelocationTable *relTableLast = NULL; + ElfRelocationATable *relaTableLast = NULL; + ElfSymbolTable *symbolTablesLast = NULL; + /* get the symbol table(s) */ for(int i=0; i < oc->n_sections; i++) { if(SHT_REL == oc->info->sectionHeader[i].sh_type) { @@ -210,12 +225,12 @@ ocInit_ELF(ObjectCode * oc) relTab->sectionHeader = &oc->info->sectionHeader[i]; - if(oc->info->relTable == NULL) { + if(relTableLast == NULL) { oc->info->relTable = relTab; + relTableLast = relTab; } else { - ElfRelocationTable * tail = oc->info->relTable; - while(tail->next != NULL) tail = tail->next; - tail->next = relTab; + relTableLast->next = relTab; + relTableLast = relTab; } } else if(SHT_RELA == oc->info->sectionHeader[i].sh_type) { @@ -233,12 +248,12 @@ ocInit_ELF(ObjectCode * oc) relTab->sectionHeader = &oc->info->sectionHeader[i]; - if(oc->info->relaTable == NULL) { + if(relaTableLast == NULL) { oc->info->relaTable = relTab; + relaTableLast = relTab; } else { - ElfRelocationATable * tail = oc->info->relaTable; - while(tail->next != NULL) tail = tail->next; - tail->next = relTab; + relaTableLast->next = relTab; + relaTableLast = relTab; } } else if(SHT_SYMTAB == oc->info->sectionHeader[i].sh_type) { @@ -279,12 +294,12 @@ ocInit_ELF(ObjectCode * oc) } /* append the ElfSymbolTable */ - if(oc->info->symbolTables == NULL) { + if(symbolTablesLast == NULL) { oc->info->symbolTables = symTab; + symbolTablesLast = symTab; } else { - ElfSymbolTable * tail = oc->info->symbolTables; - while(tail->next != NULL) tail = tail->next; - tail->next = symTab; + symbolTablesLast->next = symTab; + symbolTablesLast = symTab; } } } @@ -329,6 +344,9 @@ ocDeinit_ELF(ObjectCode * oc) stgFree(oc->info); oc->info = NULL; +#if defined(SHN_XINDEX) + oc->shndx_table = SHNDX_TABLE_UNINIT; +#endif } } @@ -532,7 +550,7 @@ ocVerifyImage_ELF ( ObjectCode* oc ) IF_DEBUG(linker_verbose,debugBelch(" no normal string tables (potentially, but not necessarily a problem)\n")); } #if defined(SHN_XINDEX) - Elf_Word* shndxTable = get_shndx_table(ehdr); + Elf_Word* shndxTable = get_shndx_table(oc); #endif nsymtabs = 0; IF_DEBUG(linker_verbose,debugBelch( "Symbol tables\n" )); @@ -683,7 +701,7 @@ ocGetNames_ELF ( ObjectCode* oc ) Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); Section * sections; #if defined(SHN_XINDEX) - Elf_Word* shndxTable = get_shndx_table(ehdr); + Elf_Word* shndxTable = get_shndx_table(oc); #endif const Elf_Word shnum = elf_shnum(ehdr); @@ -1251,7 +1269,11 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC, IF_DEBUG(linker_verbose, debugBelch("Reloc: P = %p S = %p A = %p type=%d\n", (void*)P, (void*)S, (void*)A, reloc_type )); +#if defined(DEBUG) checkProddableBlock ( oc, pP, sizeof(Elf_Word) ); +#else + (void) pP; /* suppress unused varialbe warning in non-debug build */ +#endif #if defined(i386_HOST_ARCH) value = S + A; @@ -1555,7 +1577,7 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, int strtab_shndx = shdr[symtab_shndx].sh_link; int target_shndx = shdr[shnum].sh_info; #if defined(SHN_XINDEX) - Elf_Word* shndx_table = get_shndx_table((Elf_Ehdr*)ehdrC); + Elf_Word* shndx_table = get_shndx_table(oc); #endif #if defined(DEBUG) || defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH) /* This #if def only serves to avoid unused-var warnings. */ @@ -1657,7 +1679,7 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, IF_DEBUG(linker_verbose,debugBelch("`%s' resolves to %p\n", symbol, (void*)S)); } -#if defined(DEBUG) || defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH) +#if defined(DEBUG) IF_DEBUG(linker_verbose,debugBelch("Reloc: P = %p S = %p A = %p\n", (void*)P, (void*)S, (void*)A )); checkProddableBlock(oc, (void*)P, sizeof(Elf_Word)); @@ -1920,7 +1942,7 @@ ocResolve_ELF ( ObjectCode* oc ) const Elf_Word shnum = elf_shnum(ehdr); #if defined(SHN_XINDEX) - Elf_Word* shndxTable = get_shndx_table(ehdr); + Elf_Word* shndxTable = get_shndx_table(oc); #endif /* resolve section symbols View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a4d21106da0864fb79fe8c99eaa7a6c2c8d7ca78...12f0fb5afa382e1da45d4e8dd3b3a10c353fde24 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a4d21106da0864fb79fe8c99eaa7a6c2c8d7ca78...12f0fb5afa382e1da45d4e8dd3b3a10c353fde24 You're receiving 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 Jun 28 01:48:19 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Tue, 27 Jun 2023 21:48:19 -0400 Subject: [Git][ghc/ghc][wip/ghc-9.8] base: Bump version to 4.19 Message-ID: <649b9163adf0c_12d3ac712cc60173152@gitlab.mail> Ben Gamari pushed to branch wip/ghc-9.8 at Glasgow Haskell Compiler / GHC Commits: c4162591 by Ben Gamari at 2023-06-27T21:48:02-04:00 base: Bump version to 4.19 Updates all boot library submodules. - - - - - 23 changed files: - compiler/ghc.cabal.in - libraries/array - libraries/base/base.cabal - libraries/deepseq - libraries/directory - libraries/filepath - libraries/ghc-boot-th/ghc-boot-th.cabal.in - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghc-compact/ghc-compact.cabal - libraries/ghci/ghci.cabal.in - libraries/haskeline - libraries/hpc - libraries/parsec - libraries/process - libraries/semaphore-compat - libraries/stm - libraries/template-haskell/template-haskell.cabal.in - libraries/terminfo - libraries/unix - testsuite/tests/backpack/cabal/bkpcabal08/bkpcabal08.stdout - testsuite/tests/gadt/T19847a.stderr - utils/haddock - utils/hsc2hs Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -94,7 +94,7 @@ Library extra-libraries: zstd CPP-Options: -DHAVE_LIBZSTD - Build-Depends: base >= 4.11 && < 4.19, + Build-Depends: base >= 4.11 && < 4.20, deepseq >= 1.4 && < 1.5, directory >= 1 && < 1.4, process >= 1 && < 1.7, ===================================== libraries/array ===================================== @@ -1 +1 @@ -Subproject commit f487b8de85f2b271a3831c14ab6439b9bc9b8343 +Subproject commit 734dfe636914bd43b110543282a9ff8a8265b0a5 ===================================== libraries/base/base.cabal ===================================== @@ -1,6 +1,6 @@ cabal-version: 3.0 name: base -version: 4.18.0.0 +version: 4.19.0.0 -- NOTE: Don't forget to update ./changelog.md license: BSD-3-Clause ===================================== libraries/deepseq ===================================== @@ -1 +1 @@ -Subproject commit 0bfe57809f8ecaf1921b82a6791d1ecc317d1998 +Subproject commit 74517d416a47a6523491a5b6af4d909260c84d19 ===================================== libraries/directory ===================================== @@ -1 +1 @@ -Subproject commit 3ae36d84e44737fa9800d74d55ae1e30b75628cf +Subproject commit a0c9361817db13917df7777f669a97c4d787f44e ===================================== libraries/filepath ===================================== @@ -1 +1 @@ -Subproject commit bb0e5cd49655b41bd3209b100f7a5a74698cbe83 +Subproject commit 6da411d1bdc4a0731bc8135f11ad16181f9e2d6d ===================================== libraries/ghc-boot-th/ghc-boot-th.cabal.in ===================================== @@ -36,4 +36,4 @@ Library GHC.ForeignSrcLang.Type GHC.Lexeme - build-depends: base >= 4.7 && < 4.19 + build-depends: base >= 4.7 && < 4.20 ===================================== libraries/ghc-boot/ghc-boot.cabal.in ===================================== @@ -70,7 +70,7 @@ Library GHC.Version GHC.Platform.Host - build-depends: base >= 4.7 && < 4.19, + build-depends: base >= 4.7 && < 4.20, binary == 0.8.*, bytestring >= 0.10 && < 0.12, containers >= 0.5 && < 0.7, ===================================== libraries/ghc-compact/ghc-compact.cabal ===================================== @@ -40,7 +40,7 @@ library CPP build-depends: ghc-prim >= 0.5.3 && < 0.11, - base >= 4.9.0 && < 4.19, + base >= 4.9.0 && < 4.20, bytestring >= 0.10.6.0 && <0.12 ghc-options: -Wall ===================================== libraries/ghci/ghci.cabal.in ===================================== @@ -75,7 +75,7 @@ library Build-Depends: rts, array == 0.5.*, - base >= 4.8 && < 4.19, + base >= 4.8 && < 4.20, ghc-prim >= 0.5.0 && < 0.11, binary == 0.8.*, bytestring >= 0.10 && < 0.12, ===================================== libraries/haskeline ===================================== @@ -1 +1 @@ -Subproject commit 1c2ad91edc936a9836d1ad80a26f8be03a7d8bb0 +Subproject commit 0ea07e223685787893dccbcbb67f1720ef4cf80e ===================================== libraries/hpc ===================================== @@ -1 +1 @@ -Subproject commit efd3826085953f618a1626b6c701c0314ba8b9bc +Subproject commit 7b13cd13653dbc7caefd4abb4f982279963bac15 ===================================== libraries/parsec ===================================== @@ -1 +1 @@ -Subproject commit 1f542120d9adc5e22f8791a6d595210e93c6c389 +Subproject commit ddcd0cbafe7637b15fda48f1c7cf735f3ccfd8c9 ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit 6092a13f6bf2ef76105683c7f9e278c0dcadceec +Subproject commit 8a73bb03c0550bd5c3221c399043d3f760c213f3 ===================================== libraries/semaphore-compat ===================================== @@ -1 +1 @@ -Subproject commit 663ef75467995acf41c51d3e21d03347e85b844e +Subproject commit 776ce7d242f2561c064820406d647699ed826a33 ===================================== libraries/stm ===================================== @@ -1 +1 @@ -Subproject commit 86172e75bd4f5c400b3a6f0cd3945bdb7c03bcdd +Subproject commit f8582bd6e31df73b4f18f676650ae183624d8eb2 ===================================== libraries/template-haskell/template-haskell.cabal.in ===================================== @@ -55,7 +55,7 @@ Library Language.Haskell.TH.Lib.Map build-depends: - base >= 4.11 && < 4.19, + base >= 4.11 && < 4.20, ghc-boot-th == @ProjectVersionMunged@, ghc-prim, pretty == 1.1.* ===================================== libraries/terminfo ===================================== @@ -1 +1 @@ -Subproject commit 98100776edcf33796ddf2e752233e6ef179b876d +Subproject commit 4d26c55fb2f4af9649c318ef17abba13fbb214a4 ===================================== libraries/unix ===================================== @@ -1 +1 @@ -Subproject commit 720debbf5b89366007bac473e8d7fd18e4114f1a +Subproject commit 5c3f316cf13b1c5a2c8622065cccd8eb81a81b89 ===================================== testsuite/tests/backpack/cabal/bkpcabal08/bkpcabal08.stdout ===================================== @@ -1,25 +1,25 @@ -Preprocessing library 'p' for bkpcabal08-0.1.0.0.. +Preprocessing library 'impl' for bkpcabal08-0.1.0.0... +Building library 'impl' for bkpcabal08-0.1.0.0... +Preprocessing library 'p' for bkpcabal08-0.1.0.0... Building library 'p' instantiated with A = B = -for bkpcabal08-0.1.0.0.. +for bkpcabal08-0.1.0.0... [2 of 2] Compiling B[sig] ( p/B.hsig, nothing ) -Preprocessing library 'q' for bkpcabal08-0.1.0.0.. +Preprocessing library 'q' for bkpcabal08-0.1.0.0... Building library 'q' instantiated with A = B = -for bkpcabal08-0.1.0.0.. +for bkpcabal08-0.1.0.0... [2 of 4] Compiling B[sig] ( q/B.hsig, nothing ) [3 of 4] Compiling M ( q/M.hs, nothing ) [A changed] -[4 of 4] Instantiating bkpcabal08-0.1.0.0-EyPgBicvfbiC7dE1n4Leie-p -Preprocessing library 'impl' for bkpcabal08-0.1.0.0.. -Building library 'impl' for bkpcabal08-0.1.0.0.. -Preprocessing library 'q' for bkpcabal08-0.1.0.0.. +[4 of 4] Instantiating bkpcabal08-0.1.0.0-5O1mUtZZLBeDZEqqtwJcCj-p +Preprocessing library 'q' for bkpcabal08-0.1.0.0... Building library 'q' instantiated with - A = bkpcabal08-0.1.0.0-7fVENJzzGcJGpTFnmRtPuV-impl:A - B = bkpcabal08-0.1.0.0-7fVENJzzGcJGpTFnmRtPuV-impl:B -for bkpcabal08-0.1.0.0.. -[1 of 3] Compiling A[sig] ( q/A.hsig, dist/build/bkpcabal08-0.1.0.0-ECOfUnn43H71QBN16LasXC-q+GMGlyMx4Le5H1wfFVpXzYJ/A.o ) [Prelude package changed] -[2 of 3] Compiling B[sig] ( q/B.hsig, dist/build/bkpcabal08-0.1.0.0-ECOfUnn43H71QBN16LasXC-q+GMGlyMx4Le5H1wfFVpXzYJ/B.o ) [Prelude package changed] -Preprocessing library 'r' for bkpcabal08-0.1.0.0.. -Building library 'r' for bkpcabal08-0.1.0.0.. + A = bkpcabal08-0.1.0.0-DlVb5PcmUolGCHYbfTL7EP-impl:A + B = bkpcabal08-0.1.0.0-DlVb5PcmUolGCHYbfTL7EP-impl:B +for bkpcabal08-0.1.0.0... +[1 of 3] Compiling A[sig] ( q/A.hsig, dist/build/bkpcabal08-0.1.0.0-LFiTKyjPqyn9yyuysCoVKg-q+5IA1jA4bEzCFcXtraqAC38/A.o ) [Prelude package changed] +[2 of 3] Compiling B[sig] ( q/B.hsig, dist/build/bkpcabal08-0.1.0.0-LFiTKyjPqyn9yyuysCoVKg-q+5IA1jA4bEzCFcXtraqAC38/B.o ) [Prelude package changed] +Preprocessing library 'r' for bkpcabal08-0.1.0.0... +Building library 'r' for bkpcabal08-0.1.0.0... ===================================== testsuite/tests/gadt/T19847a.stderr ===================================== @@ -9,4 +9,4 @@ DATA CONSTRUCTORS (x ~ y, c ~ [x], Ord x) => x -> y -> T (x, y) b c Dependent modules: [] -Dependent packages: [base-4.18.0.0] +Dependent packages: [base-4.19.0.0] ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 1d83a51e6e78b123f039c7d506d8139e936c02b7 +Subproject commit 98c285fd9c6057b34341f91c2261d00df803735a ===================================== utils/hsc2hs ===================================== @@ -1 +1 @@ -Subproject commit f70b360b295298e4da10afe02ebf022b21342008 +Subproject commit 1ee25e923b769c8df310f7e8690ad7622eb4d446 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c4162591821d661929db3d54d119b2d4ca15e834 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c4162591821d661929db3d54d119b2d4ca15e834 You're receiving 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 Jun 28 02:27:46 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Tue, 27 Jun 2023 22:27:46 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Configure CPP into settings Message-ID: <649b9aa2e40ef_12d3ac7129218182696@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 7cb6b12a by Rodrigo Mesquita at 2023-06-27T22:27:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 799f4b71 by aadaa_fgtaa at 2023-06-27T22:27:39-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - b7fd9d0f by Rodrigo Mesquita at 2023-06-27T22:27:40-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - bb0eb710 by Ben Gamari at 2023-06-27T22:27:41-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 30 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools.hs - compiler/GHC/SysTools/Cpp.hs - − compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - compiler/ghc.cabal.in - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - m4/fp_cpp_cmd_with_args.m4 - + m4/fp_hs_cpp_cmd_with_args.m4 - − m4/fp_ld_supports_response_files.m4 - + m4/fp_link_supports_no_as_needed.m4 - + m4/fp_merge_objects_supports_response_files.m4 - m4/fp_settings.m4 - m4/fptools_set_c_ld_flags.m4 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/12f0fb5afa382e1da45d4e8dd3b3a10c353fde24...bb0eb7104298be878567bd9f15919f538fff2bc1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/12f0fb5afa382e1da45d4e8dd3b3a10c353fde24...bb0eb7104298be878567bd9f15919f538fff2bc1 You're receiving 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 Jun 28 03:35:17 2023 From: gitlab at gitlab.haskell.org (=?UTF-8?B?R2VyZ8WRIMOJcmRpIChAY2FjdHVzKQ==?=) Date: Tue, 27 Jun 2023 23:35:17 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/incoherent-spec-flag Message-ID: <649baa7560261_12d3ac6cb7c48193434@gitlab.mail> Gergő Érdi pushed new branch wip/incoherent-spec-flag at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/incoherent-spec-flag You're receiving 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 Jun 28 04:58:50 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 28 Jun 2023 00:58:50 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: Configure CPP into settings Message-ID: <649bbe0a5d55b_12d3ac712cc60202869@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 54006049 by Rodrigo Mesquita at 2023-06-28T00:58:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 49a5ac17 by Rodrigo Mesquita at 2023-06-28T00:58:36-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - 9a88d36f by aadaa_fgtaa at 2023-06-28T00:58:39-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - f73f6b9a by Rodrigo Mesquita at 2023-06-28T00:58:40-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 75304ec6 by Ben Gamari at 2023-06-28T00:58:41-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 3bfe3eb3 by Bryan Richter at 2023-06-28T00:58:42-04:00 Remove extraneous debug output - - - - - c6d884fa by Bryan Richter at 2023-06-28T00:58:42-04:00 Work with unset vars in -e mode - - - - - 7581def0 by Bryan Richter at 2023-06-28T00:58:42-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 800c1fe5 by Bryan Richter at 2023-06-28T00:58:42-04:00 Handle unset value in -e context - - - - - 30 changed files: - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools.hs - compiler/GHC/SysTools/Cpp.hs - − compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - compiler/ghc.cabal.in - configure.ac - distrib/configure.ac.in - ghc/Main.hs - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - m4/fp_cpp_cmd_with_args.m4 - + m4/fp_hs_cpp_cmd_with_args.m4 - − m4/fp_ld_supports_response_files.m4 - + m4/fp_link_supports_no_as_needed.m4 The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bb0eb7104298be878567bd9f15919f538fff2bc1...800c1fe5549335097cd77797e716e99cacce08b4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bb0eb7104298be878567bd9f15919f538fff2bc1...800c1fe5549335097cd77797e716e99cacce08b4 You're receiving 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 Jun 28 05:33:30 2023 From: gitlab at gitlab.haskell.org (Bryan R (@chreekat)) Date: Wed, 28 Jun 2023 01:33:30 -0400 Subject: [Git][ghc/ghc][wip/romes/configure-cpp] 6 commits: Propagate breakpoint information when inlining across modules Message-ID: <649bc62a708e5_3b5ae2c76146732f@gitlab.mail> Bryan R pushed to branch wip/romes/configure-cpp at Glasgow Haskell Compiler / GHC Commits: c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - cf6700ce by Rodrigo Mesquita at 2023-06-28T05:33:28+00:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 30 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Breakpoints.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/371c911eb41bcb5b05280dbcb81ca5f4a991cd45...cf6700ce517012972489c61b48e59cabfef72994 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/371c911eb41bcb5b05280dbcb81ca5f4a991cd45...cf6700ce517012972489c61b48e59cabfef72994 You're receiving 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 Jun 28 05:33:51 2023 From: gitlab at gitlab.haskell.org (Bryan R (@chreekat)) Date: Wed, 28 Jun 2023 01:33:51 -0400 Subject: [Git][ghc/ghc][wip/romes/merge-tools-supports-response-files] 41 commits: Avoid desugaring non-recursive lets into recursive lets Message-ID: <649bc63f9e61c_3b5ae2cb4f86808c@gitlab.mail> Bryan R pushed to branch wip/romes/merge-tools-supports-response-files at Glasgow Haskell Compiler / GHC Commits: 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ffcbce34 by Rodrigo Mesquita at 2023-06-28T05:33:45+00:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/69fa79eef1606af5431d987b0206f9d43b4cfe39...ffcbce340303e9143519bd812ea0e000c531661c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/69fa79eef1606af5431d987b0206f9d43b4cfe39...ffcbce340303e9143519bd812ea0e000c531661c You're receiving 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 Jun 28 05:33:55 2023 From: gitlab at gitlab.haskell.org (Bryan R (@chreekat)) Date: Wed, 28 Jun 2023 01:33:55 -0400 Subject: [Git][ghc/ghc][wip/romes/remove-toolchain-runtime-config] 41 commits: Avoid desugaring non-recursive lets into recursive lets Message-ID: <649bc643aaaef_3b5ae2d276c686df@gitlab.mail> Bryan R pushed to branch wip/romes/remove-toolchain-runtime-config at Glasgow Haskell Compiler / GHC Commits: 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - 35640060 by Ben Gamari at 2023-06-28T05:33:49+00:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7afcb5db5a27ddd62c45536c7e1d68e30fe4753a...356400604a75d3b5c581604c0c6559c113e1478d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7afcb5db5a27ddd62c45536c7e1d68e30fe4753a...356400604a75d3b5c581604c0c6559c113e1478d You're receiving 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 Jun 28 05:44:48 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 28 Jun 2023 01:44:48 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Stop configuring unused Ld command in `settings` Message-ID: <649bc8d0c6f73_3b5ae2d1420741fa@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: d2878c39 by Rodrigo Mesquita at 2023-06-28T01:44:41-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - 4e01a645 by Bryan Richter at 2023-06-28T01:44:42-04:00 Remove extraneous debug output - - - - - 322846ad by Bryan Richter at 2023-06-28T01:44:42-04:00 Work with unset vars in -e mode - - - - - 26ec7c6e by Bryan Richter at 2023-06-28T01:44:42-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 05cb2e56 by Bryan Richter at 2023-06-28T01:44:42-04:00 Handle unset value in -e context - - - - - 15 changed files: - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - configure.ac - distrib/configure.ac.in - ghc/Main.hs - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - m4/fp_prog_ld_filelist.m4 - m4/fp_prog_ld_flag.m4 - m4/fp_prog_ld_is_gnu.m4 - m4/fp_prog_ld_no_compact_unwind.m4 - m4/fp_settings.m4 Changes: ===================================== .gitlab/ci.sh ===================================== @@ -211,7 +211,6 @@ function set_toolchain_paths() { esac info "Building toolchain for $NIX_SYSTEM" nix-build --quiet .gitlab/darwin/toolchain.nix --argstr system "$NIX_SYSTEM" -o toolchain.sh - cat toolchain.sh fi source toolchain.sh ;; @@ -219,10 +218,10 @@ function set_toolchain_paths() { # These are generally set by the Docker image but # we provide these handy fallbacks in case the # script isn't run from within a GHC CI docker image. - if [ -z "$GHC" ]; then GHC="$(which ghc)"; fi - if [ -z "$CABAL" ]; then CABAL="$(which cabal)"; fi - if [ -z "$HAPPY" ]; then HAPPY="$(which happy)"; fi - if [ -z "$ALEX" ]; then ALEX="$(which alex)"; fi + : ${GHC:=$(which ghc)} + : ${CABAL:=$(which cabal)} + : ${HAPPY:=$(which happy)} + : ${ALEX:=$(which alex)} ;; *) fail "bad toolchain_source" esac @@ -806,7 +805,7 @@ function shell() { if [ -z "$cmd" ]; then cmd="bash -i" fi - run "$cmd" + run $cmd } function lint_author(){ @@ -915,8 +914,8 @@ determine_metric_baseline set_toolchain_paths -case $1 in - usage) usage ;; +case ${1:-help} in + help|usage) usage ;; setup) setup && cleanup_submodules ;; configure) time_it "configure" configure ;; build_hadrian) time_it "build" build_hadrian ;; ===================================== .gitlab/darwin/toolchain.nix ===================================== @@ -113,6 +113,8 @@ pkgs.writeTextFile { export CABAL="$CABAL_INSTALL" sdk_path="$(xcrun --sdk macosx --show-sdk-path)" - export CONFIGURE_ARGS="$CONFIGURE_ARGS --with-ffi-libraries=$sdk_path/usr/lib --with-ffi-includes=$sdk_path/usr/include/ffi --build=${targetTriple}" + : ''${CONFIGURE_ARGS:=} + CONFIGURE_ARGS+="''${CONFIGURE_ARGS:+ }--with-ffi-libraries=$sdk_path/usr/lib --with-ffi-includes=$sdk_path/usr/include/ffi --build=${targetTriple}" + export CONFIGURE_ARGS ''; } ===================================== configure.ac ===================================== @@ -482,9 +482,7 @@ FIND_LD([$target],[GccUseLdOpt]) FIND_MERGE_OBJECTS() CONF_GCC_LINKER_OPTS_STAGE1="$CONF_GCC_LINKER_OPTS_STAGE1 $GccUseLdOpt" CONF_GCC_LINKER_OPTS_STAGE2="$CONF_GCC_LINKER_OPTS_STAGE2 $GccUseLdOpt" -LdCmd="$LD" CFLAGS="$CFLAGS $GccUseLdOpt" -AC_SUBST([LdCmd]) FP_PROG_LD_IS_GNU FP_PROG_LD_NO_COMPACT_UNWIND @@ -1246,7 +1244,6 @@ echo "\ hs-cpp : $HaskellCPPCmd hs-cpp-flags : $HaskellCPPArgs ar : $ArCmd - ld : $LdCmd nm : $NmCmd objdump : $ObjdumpCmd ranlib : $RanlibCmd ===================================== distrib/configure.ac.in ===================================== @@ -125,9 +125,7 @@ FIND_LD([$target],[GccUseLdOpt]) FIND_MERGE_OBJECTS() CONF_GCC_LINKER_OPTS_STAGE1="$CONF_GCC_LINKER_OPTS_STAGE1 $GccUseLdOpt" CONF_GCC_LINKER_OPTS_STAGE2="$CONF_GCC_LINKER_OPTS_STAGE2 $GccUseLdOpt" -LdCmd="$LD" CFLAGS="$CFLAGS $GccUseLdOpt" -AC_SUBST([LdCmd]) FP_PROG_LD_IS_GNU FP_PROG_LD_NO_COMPACT_UNWIND ===================================== ghc/Main.hs ===================================== @@ -627,8 +627,8 @@ mode_flags = "LibDir", "Global Package DB", "C compiler flags", - "C compiler link flags", - "ld flags"], + "C compiler link flags" + ], let k' = "-print-" ++ map (replaceSpace . toLower) k replaceSpace ' ' = '-' replaceSpace c = c ===================================== hadrian/bindist/Makefile ===================================== @@ -87,8 +87,6 @@ lib/settings : config.mk @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ - @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ - @echo ',("ld flags", "$(SettingsLdFlags)")' >> $@ @echo ',("ld supports compact unwind", "$(LdHasNoCompactUnwind)")' >> $@ @echo ',("ld supports filelist", "$(LdHasFilelist)")' >> $@ @echo ',("ld supports response files", "$(LdSupportsResponseFiles)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -263,8 +263,6 @@ SettingsCCompilerFlags = @SettingsCCompilerFlags@ SettingsCxxCompilerFlags = @SettingsCxxCompilerFlags@ SettingsCCompilerLinkFlags = @SettingsCCompilerLinkFlags@ SettingsCCompilerSupportsNoPie = @SettingsCCompilerSupportsNoPie@ -SettingsLdCommand = @SettingsLdCommand@ -SettingsLdFlags = @SettingsLdFlags@ SettingsMergeObjectsCommand = @SettingsMergeObjectsCommand@ SettingsMergeObjectsFlags = @SettingsMergeObjectsFlags@ SettingsArCommand = @SettingsArCommand@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -11,7 +11,7 @@ autoreconf = @AutoreconfCmd@ cc = @CC@ happy = @HappyCmd@ hs-cpp = @HaskellCPPCmd@ -ld = @LdCmd@ +ld = @LD@ make = @MakeCmd@ nm = @NmCmd@ merge-objects = @MergeObjsCmd@ @@ -151,8 +151,6 @@ settings-c-compiler-flags = @SettingsCCompilerFlags@ settings-cxx-compiler-flags = @SettingsCxxCompilerFlags@ settings-c-compiler-link-flags = @SettingsCCompilerLinkFlags@ settings-c-compiler-supports-no-pie = @SettingsCCompilerSupportsNoPie@ -settings-ld-command = @SettingsLdCommand@ -settings-ld-flags = @SettingsLdFlags@ settings-merge-objects-command = @SettingsMergeObjectsCommand@ settings-merge-objects-flags = @SettingsMergeObjectsFlags@ settings-ar-command = @SettingsArCommand@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -115,8 +115,6 @@ data SettingsFileSetting | SettingsFileSetting_CxxCompilerFlags | SettingsFileSetting_CCompilerLinkFlags | SettingsFileSetting_CCompilerSupportsNoPie - | SettingsFileSetting_LdCommand - | SettingsFileSetting_LdFlags | SettingsFileSetting_MergeObjectsCommand | SettingsFileSetting_MergeObjectsFlags | SettingsFileSetting_ArCommand @@ -214,8 +212,6 @@ settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_CxxCompilerFlags -> "settings-cxx-compiler-flags" SettingsFileSetting_CCompilerLinkFlags -> "settings-c-compiler-link-flags" SettingsFileSetting_CCompilerSupportsNoPie -> "settings-c-compiler-supports-no-pie" - SettingsFileSetting_LdCommand -> "settings-ld-command" - SettingsFileSetting_LdFlags -> "settings-ld-flags" SettingsFileSetting_MergeObjectsCommand -> "settings-merge-objects-command" SettingsFileSetting_MergeObjectsFlags -> "settings-merge-objects-flags" SettingsFileSetting_ArCommand -> "settings-ar-command" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -446,8 +446,6 @@ generateSettings = do , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags) - , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand) - , ("ld flags", expr $ settingsFileSetting SettingsFileSetting_LdFlags) , ("ld supports compact unwind", expr $ lookupSystemConfig "ld-has-no-compact-unwind") , ("ld supports filelist", expr $ lookupSystemConfig "ld-has-filelist") , ("ld supports response files", expr $ lookupSystemConfig "ld-supports-response-files") ===================================== m4/fp_prog_ld_filelist.m4 ===================================== @@ -12,7 +12,7 @@ AC_CACHE_CHECK([whether ld understands -filelist], [fp_cv_ld_has_filelist], ${CC-cc} -c conftest2.c echo conftest1.o > conftest.o-files echo conftest2.o >> conftest.o-files - if ${LdCmd} -r -filelist conftest.o-files -o conftest.o > /dev/null 2>&1 + if $LD -r -filelist conftest.o-files -o conftest.o > /dev/null 2>&1 then fp_cv_ld_has_filelist=yes else ===================================== m4/fp_prog_ld_flag.m4 ===================================== @@ -7,7 +7,7 @@ AC_DEFUN([FP_PROG_LD_FLAG], AC_CACHE_CHECK([whether ld understands $1], [fp_cv_$2], [echo 'int foo() { return 0; }' > conftest.c ${CC-cc} -c conftest.c -if ${LdCmd} -r $1 -o conftest2.o conftest.o > /dev/null 2>&1; then +if $LD -r $1 -o conftest2.o conftest.o > /dev/null 2>&1; then fp_cv_$2=$1 else fp_cv_$2= ===================================== m4/fp_prog_ld_is_gnu.m4 ===================================== @@ -4,7 +4,7 @@ # GNU ld or not. AC_DEFUN([FP_PROG_LD_IS_GNU],[ AC_CACHE_CHECK([whether ld is GNU ld], [fp_cv_gnu_ld], -[[if ${LdCmd} --version 2> /dev/null | grep "GNU" > /dev/null 2>&1; then +[[if $LD --version 2> /dev/null | grep "GNU" > /dev/null 2>&1; then fp_cv_gnu_ld=YES else fp_cv_gnu_ld=NO ===================================== m4/fp_prog_ld_no_compact_unwind.m4 ===================================== @@ -7,7 +7,7 @@ AC_DEFUN([FP_PROG_LD_NO_COMPACT_UNWIND], AC_CACHE_CHECK([whether ld understands -no_compact_unwind], [fp_cv_ld_no_compact_unwind], [echo 'int foo() { return 0; }' > conftest.c ${CC-cc} -c conftest.c -if ${LdCmd} -r -no_compact_unwind -o conftest2.o conftest.o > /dev/null 2>&1; then +if $LD -r -no_compact_unwind -o conftest2.o conftest.o > /dev/null 2>&1; then fp_cv_ld_no_compact_unwind=yes else fp_cv_ld_no_compact_unwind=no ===================================== m4/fp_settings.m4 ===================================== @@ -16,8 +16,6 @@ AC_DEFUN([FP_SETTINGS], SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2 -L\$\$tooldir/mingw/lib -L\$\$tooldir/mingw/x86_64-w64-mingw32/lib" SettingsHaskellCPPCommand="${mingw_bin_prefix}clang.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs -I\$\$tooldir/mingw/include" - SettingsLdCommand="${mingw_bin_prefix}ld.lld.exe" - SettingsLdFlags="" # LLD does not support object merging (#21068) SettingsMergeObjectsCommand="" SettingsMergeObjectsFlags="" @@ -38,8 +36,6 @@ AC_DEFUN([FP_SETTINGS], SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" - SettingsLdCommand="$LdCmd" - SettingsLdFlags="$CONF_LD_LINKER_OPTS_STAGE2" SettingsArCommand="$ArCmd" SettingsRanlibCommand="$RanlibCmd" SettingsMergeObjectsCommand="$MergeObjsCmd" @@ -113,8 +109,6 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCxxCompilerFlags) AC_SUBST(SettingsCCompilerLinkFlags) AC_SUBST(SettingsCCompilerSupportsNoPie) - AC_SUBST(SettingsLdCommand) - AC_SUBST(SettingsLdFlags) AC_SUBST(SettingsMergeObjectsCommand) AC_SUBST(SettingsMergeObjectsFlags) AC_SUBST(SettingsArCommand) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/800c1fe5549335097cd77797e716e99cacce08b4...05cb2e565d33919a3f0af371011ff90805be8e8b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/800c1fe5549335097cd77797e716e99cacce08b4...05cb2e565d33919a3f0af371011ff90805be8e8b You're receiving 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 Jun 28 05:55:53 2023 From: gitlab at gitlab.haskell.org (=?UTF-8?B?R2VyZ8WRIMOJcmRpIChAY2FjdHVzKQ==?=) Date: Wed, 28 Jun 2023 01:55:53 -0400 Subject: [Git][ghc/ghc][wip/incoherent-spec-flag] 2 commits: Add flag to enable/disable incoherent instances Message-ID: <649bcb695025e_3b5ae2cd0c88355@gitlab.mail> Gergő Érdi pushed to branch wip/incoherent-spec-flag at Glasgow Haskell Compiler / GHC Commits: 2922712e by Gergő Érdi at 2023-06-28T06:54:51+01:00 Add flag to enable/disable incoherent instances Fixes #23287 - - - - - d61f806e by Gergő Érdi at 2023-06-28T06:55:34+01:00 Desugar bindings in the context of their evidence Closes #23172 - - - - - 9 changed files: - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Types.hs - compiler/GHC/Tc/Instance/Class.hs - testsuite/tests/simplCore/should_run/T22448.hs Changes: ===================================== compiler/GHC/Core/InstEnv.hs ===================================== @@ -955,7 +955,7 @@ data LookupInstanceErrReason = LookupInstErrNotFound deriving (Generic) -data Coherence = IsCoherent | IsIncoherent +data Coherence = IsCoherent | IsIncoherent | IsNoncanonical -- See Note [Recording coherence information in `PotentialUnifiers`] data PotentialUnifiers = NoUnifiers Coherence @@ -983,6 +983,7 @@ potential unifiers is otherwise empty. instance Outputable Coherence where ppr IsCoherent = text "coherent" ppr IsIncoherent = text "incoherent" + ppr IsNoncanonical = text "non-canonical" instance Outputable PotentialUnifiers where ppr (NoUnifiers c) = text "NoUnifiers" <+> ppr c @@ -990,6 +991,8 @@ instance Outputable PotentialUnifiers where instance Semigroup Coherence where IsCoherent <> IsCoherent = IsCoherent + IsNoncanonical <> _ = IsNoncanonical + _ <> IsNoncanonical = IsNoncanonical _ <> _ = IsIncoherent instance Semigroup PotentialUnifiers where ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -1187,7 +1187,8 @@ defaultFlags settings Opt_CompactUnwind, Opt_ShowErrorContext, Opt_SuppressStgReps, - Opt_UnoptimizedCoreForInterpreter + Opt_UnoptimizedCoreForInterpreter, + Opt_SpecIncoherents ] ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -266,6 +266,7 @@ data GeneralFlag | Opt_LiberateCase | Opt_SpecConstr | Opt_SpecConstrKeen + | Opt_SpecIncoherents | Opt_DoLambdaEtaExpansion | Opt_IgnoreAsserts | Opt_DoEtaReduction ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2429,6 +2429,7 @@ fFlagsDeps = [ flagSpec "specialize-aggressively" Opt_SpecialiseAggressively, flagSpec "cross-module-specialise" Opt_CrossModuleSpecialise, flagSpec "cross-module-specialize" Opt_CrossModuleSpecialise, + flagSpec "spec-incoherents" Opt_SpecIncoherents, flagSpec "inline-generics" Opt_InlineGenerics, flagSpec "inline-generics-aggressively" Opt_InlineGenericsAggressively, flagSpec "static-argument-transformation" Opt_StaticArgumentTransformation, ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -205,16 +205,15 @@ dsHsBind , abs_exports = exports , abs_ev_binds = ev_binds , abs_binds = binds, abs_sig = has_sig })) - = do { ds_binds <- addTyCs FromSource (listToBag dicts) $ - dsLHsBinds binds - -- addTyCs: push type constraints deeper - -- for inner pattern match check - -- See Check, Note [Long-distance information] + = dsTcEvBinds_s ev_binds $ \ds_ev_binds -> do + { ds_binds <- addTyCs FromSource (listToBag dicts) $ + dsLHsBinds binds + -- addTyCs: push type constraints deeper + -- for inner pattern match check + -- See Check, Note [Long-distance information] - ; dsTcEvBinds_s ev_binds $ \ds_ev_binds -> do - - -- dsAbsBinds does the hard work - { dsAbsBinds dflags tyvars dicts exports ds_ev_binds ds_binds has_sig } } + -- dsAbsBinds does the hard work + ; dsAbsBinds dflags tyvars dicts exports ds_ev_binds ds_binds has_sig } dsHsBind _ (PatSynBind{}) = panic "dsHsBind: PatSynBind" @@ -1202,20 +1201,24 @@ dsHsWrapper (WpFun c1 c2 (Scaled w t1)) k -- See Note [Desugaring WpFun] dsHsWrapper (WpCast co) k = assert (coercionRole co == Representational) $ k $ \e -> mkCastDs e co dsHsWrapper (WpEvApp tm) k = do { core_tm <- dsEvTerm tm - ; incoherents <- getIncoherents + ; unspecables <- getUnspecables + -- ; spec_incoherents <- getSpecIncoherents ; let vs = exprFreeVarsList core_tm - is_incoherent_var v = v `S.member` incoherents - is_coherent = all (not . is_incoherent_var) vs -- See Note [Desugaring incoherent evidence] - ; k (\e -> app_ev is_coherent e core_tm) } + is_unspecable_var v = v `S.member` unspecables + is_specable = not $ any (is_unspecable_var) vs -- See Note [Desugaring incoherent evidence] + ; k (\e -> app_ev is_specable e core_tm) } -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify. dsHsWrapper (WpMultCoercion co) k = do { unless (isReflexiveCo co) $ diagnosticDs DsMultiplicityCoercionsNotSupported ; k $ \e -> e } app_ev :: Bool -> CoreExpr -> CoreExpr -> CoreExpr -app_ev is_coherent k core_tm - | is_coherent = k `App` core_tm - | otherwise = Var nospecId `App` Type (exprType k) `App` k `App` core_tm +app_ev is_specable k core_tm + | not is_specable + = Var nospecId `App` Type (exprType k) `App` k `App` core_tm + + | otherwise + = k `App` core_tm dsHsWrappers :: [HsWrapper] -> ([CoreExpr -> CoreExpr] -> DsM a) -> DsM a dsHsWrappers (wp:wps) k = dsHsWrapper wp $ \wrap -> dsHsWrappers wps $ \wraps -> k (wrap:wraps) @@ -1237,40 +1240,46 @@ dsTcEvBinds (EvBinds bs) = dsEvBinds bs -- for each binder in ev_binds, before invoking thing_inside dsEvBinds :: Bag EvBind -> ([CoreBind] -> DsM a) -> DsM a dsEvBinds ev_binds thing_inside + = do { spec_incoherents <- getSpecIncoherents + ; ds_ev_binds spec_incoherents ev_binds thing_inside } + +ds_ev_binds :: Bool -> Bag EvBind -> ([CoreBind] -> DsM a) -> DsM a +ds_ev_binds spec_incoherents ev_binds thing_inside = do { ds_binds <- mapBagM dsEvBind ev_binds ; let comps = sort_ev_binds ds_binds ; go comps thing_inside } where go ::[SCC (Node EvVar (Coherence, CoreExpr))] -> ([CoreBind] -> DsM a) -> DsM a go (comp:comps) thing_inside - = do { incoherents <- getIncoherents - ; let (core_bind, new_incoherents) = ds_component incoherents comp - ; addIncoherents new_incoherents $ go comps $ \ core_binds -> thing_inside (core_bind:core_binds) } + = do { unspecables <- getUnspecables + ; let (core_bind, new_unspecables) = ds_component unspecables comp + ; addUnspecables new_unspecables $ go comps $ \ core_binds -> thing_inside (core_bind:core_binds) } go [] thing_inside = thing_inside [] - is_coherent IsCoherent = True - is_coherent IsIncoherent = False + is_specable IsCoherent = True + is_specable IsIncoherent = spec_incoherents + is_specable IsNoncanonical = False - ds_component incoherents (AcyclicSCC node) = (NonRec v rhs, new_incoherents) + ds_component unspecables (AcyclicSCC node) = (NonRec v rhs, new_unspecables) where ((v, rhs), (this_coherence, deps)) = unpack_node node - transitively_incoherent = not (is_coherent this_coherence) || any is_incoherent deps - is_incoherent dep = dep `S.member` incoherents - new_incoherents - | transitively_incoherent = S.singleton v + transitively_unspecable = not (is_specable this_coherence) || any is_unspecable deps + is_unspecable dep = dep `S.member` unspecables + new_unspecables + | transitively_unspecable = S.singleton v | otherwise = mempty - ds_component incoherents (CyclicSCC nodes) = (Rec pairs, new_incoherents) + ds_component unspecables (CyclicSCC nodes) = (Rec pairs, new_unspecables) where (pairs, direct_coherence) = unzip $ map unpack_node nodes - is_incoherent_remote dep = dep `S.member` incoherents - transitively_incoherent = or [ not (is_coherent this_coherence) || any is_incoherent_remote deps | (this_coherence, deps) <- direct_coherence ] - -- Bindings from a given SCC are transitively coherent if - -- all are coherent and all their remote dependencies are - -- also coherent; see Note [Desugaring incoherent evidence] + is_unspecable_remote dep = dep `S.member` unspecables + transitively_unspecable = or [ not (is_specable this_coherence) || any is_unspecable_remote deps | (this_coherence, deps) <- direct_coherence ] + -- Bindings from a given SCC are transitively specialisable if + -- all are specialisable and all their remote dependencies are + -- also specialisable; see Note [Desugaring incoherent evidence] - new_incoherents - | transitively_incoherent = S.fromList [ v | (v, _) <- pairs] + new_unspecables + | transitively_unspecable = S.fromList [ v | (v, _) <- pairs] | otherwise = mempty unpack_node DigraphNode { node_key = v, node_payload = (coherence, rhs), node_dependencies = deps } = ((v, rhs), (coherence, deps)) ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -37,7 +37,7 @@ module GHC.HsToCore.Monad ( getPmNablas, updPmNablas, -- Tracking evidence variable coherence - addIncoherents, getIncoherents, + getSpecIncoherents, addUnspecables, getUnspecables, -- Get COMPLETE sets of a TyCon dsGetCompleteMatches, @@ -248,8 +248,10 @@ mkDsEnvsFromTcGbl hsc_env msg_var tcg_env ++ eps_complete_matches eps -- from imports -- re-use existing next_wrapper_num to ensure uniqueness next_wrapper_num_var = tcg_next_wrapper_num tcg_env + spec_incoherents = gopt Opt_SpecIncoherents (hsc_dflags hsc_env) ; return $ mkDsEnvs unit_env this_mod rdr_env type_env fam_inst_env ptc msg_var cc_st_var next_wrapper_num_var complete_matches + spec_incoherents } runDs :: HscEnv -> (DsGblEnv, DsLclEnv) -> DsM a -> IO (Messages DsMessage, Maybe a) @@ -282,6 +284,7 @@ initDsWithModGuts hsc_env (ModGuts { mg_module = this_mod, mg_binds = binds complete_matches = hptCompleteSigs hsc_env -- from the home package ++ local_complete_matches -- from the current module ++ eps_complete_matches eps -- from imports + spec_incoherents = gopt Opt_SpecIncoherents (hsc_dflags hsc_env) bindsToIds (NonRec v _) = [v] bindsToIds (Rec binds) = map fst binds @@ -290,6 +293,7 @@ initDsWithModGuts hsc_env (ModGuts { mg_module = this_mod, mg_binds = binds envs = mkDsEnvs unit_env this_mod rdr_env type_env fam_inst_env ptc msg_var cc_st_var next_wrapper_num complete_matches + spec_incoherents ; runDs hsc_env envs thing_inside } @@ -330,9 +334,10 @@ mkDsEnvs :: UnitEnv -> Module -> GlobalRdrEnv -> TypeEnv -> FamInstEnv -> PromotionTickContext -> IORef (Messages DsMessage) -> IORef CostCentreState -> IORef (ModuleEnv Int) -> CompleteMatches + -> Bool -> (DsGblEnv, DsLclEnv) mkDsEnvs unit_env mod rdr_env type_env fam_inst_env ptc msg_var cc_st_var - next_wrapper_num complete_matches + next_wrapper_num complete_matches spec_incoherents = let if_genv = IfGblEnv { if_doc = text "mkDsEnvs" -- Failing tests here are `ghci` and `T11985` if you get this wrong. -- this is very very "at a distance" because the reason for this check is that the type_env in interactive @@ -353,11 +358,12 @@ mkDsEnvs unit_env mod rdr_env type_env fam_inst_env ptc msg_var cc_st_var , ds_complete_matches = complete_matches , ds_cc_st = cc_st_var , ds_next_wrapper_num = next_wrapper_num + , ds_spec_incoherents = spec_incoherents } lcl_env = DsLclEnv { dsl_meta = emptyNameEnv , dsl_loc = real_span , dsl_nablas = initNablas - , dsl_incoherents = mempty + , dsl_unspecables = mempty } in (gbl_env, lcl_env) @@ -413,11 +419,11 @@ getPmNablas = do { env <- getLclEnv; return (dsl_nablas env) } updPmNablas :: Nablas -> DsM a -> DsM a updPmNablas nablas = updLclEnv (\env -> env { dsl_nablas = nablas }) -addIncoherents :: S.Set EvId -> DsM a -> DsM a -addIncoherents incoherents = updLclEnv (\env -> env{ dsl_incoherents = incoherents `mappend` dsl_incoherents env }) +addUnspecables :: S.Set EvId -> DsM a -> DsM a +addUnspecables unspecables = updLclEnv (\env -> env{ dsl_unspecables = unspecables `mappend` dsl_unspecables env }) -getIncoherents :: DsM (S.Set EvId) -getIncoherents = dsl_incoherents <$> getLclEnv +getUnspecables :: DsM (S.Set EvId) +getUnspecables = dsl_unspecables <$> getLclEnv getSrcSpanDs :: DsM SrcSpan getSrcSpanDs = do { env <- getLclEnv @@ -523,6 +529,9 @@ discardWarningsDs thing_inside ; return result } +getSpecIncoherents :: DsM Bool +getSpecIncoherents = ds_spec_incoherents <$> getGblEnv + -- | Inject a trace message into the compiled program. Whereas -- pprTrace prints out information *while compiling*, pprRuntimeTrace -- captures that information and causes it to be printed *at runtime* ===================================== compiler/GHC/HsToCore/Types.hs ===================================== @@ -11,7 +11,7 @@ module GHC.HsToCore.Types ( DsMetaEnv, DsMetaVal(..), CompleteMatches ) where -import GHC.Prelude (Int) +import GHC.Prelude (Int, Bool) import Data.IORef import qualified Data.Set as S @@ -65,6 +65,8 @@ data DsGblEnv -- Tracking indices for cost centre annotations , ds_next_wrapper_num :: IORef (ModuleEnv Int) -- ^ See Note [Generating fresh names for FFI wrappers] + + , ds_spec_incoherents :: Bool } instance ContainsModule DsGblEnv where @@ -79,9 +81,9 @@ data DsLclEnv -- ^ See Note [Long-distance information] in "GHC.HsToCore.Pmc". -- The set of reaching values Nablas is augmented as we walk inwards, refined -- through each pattern match in turn - , dsl_incoherents :: S.Set EvVar + , dsl_unspecables :: S.Set EvVar -- ^ See Note [Desugaring incoherent evidence]: this field collects - -- all incoherent evidence variables in scope. + -- all un-specialisable evidence variables in scope. } -- Inside [| |] brackets, the desugarer looks ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -448,7 +448,7 @@ matchWithDict [cls, mty] ; return $ OneInst { cir_new_theta = [mkPrimEqPred mty inst_meth_ty] , cir_mk_ev = mk_ev - , cir_coherence = IsIncoherent -- See (WD6) in Note [withDict] + , cir_coherence = IsNoncanonical -- See (WD6) in Note [withDict] , cir_what = BuiltinInstance } } ===================================== testsuite/tests/simplCore/should_run/T22448.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE MonoLocalBinds #-} +{-# OPTIONS_GHC -fno-spec-incoherents #-} class C a where op :: a -> String View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/74306ea72b3a0e42a48409c73517b626543370a9...d61f806e74f823dbc577d0e702d7bf601be7f10c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/74306ea72b3a0e42a48409c73517b626543370a9...d61f806e74f823dbc577d0e702d7bf601be7f10c You're receiving 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 Jun 28 05:59:42 2023 From: gitlab at gitlab.haskell.org (Bryan R (@chreekat)) Date: Wed, 28 Jun 2023 01:59:42 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/b/missing-prototypes Message-ID: <649bcc4eed33e_3b5ae2d276c8745d@gitlab.mail> Bryan R pushed new branch wip/b/missing-prototypes at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/b/missing-prototypes You're receiving 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 Jun 28 06:24:09 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 28 Jun 2023 02:24:09 -0400 Subject: [Git][ghc/ghc][wip/romes/remove-toolchain-runtime-config] Rip out runtime linker/compiler checks Message-ID: <649bd20927b8d_3b5ae2cd0c889577@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/remove-toolchain-runtime-config at Glasgow Haskell Compiler / GHC Commits: 01542cb7 by Ben Gamari at 2023-06-28T07:23:56+01:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 11 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/SysTools.hs - − compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - compiler/ghc.cabal.in - + m4/fp_link_supports_no_as_needed.m4 - m4/fptools_set_c_ld_flags.m4 Changes: ===================================== compiler/GHC/Driver/Backend.hs ===================================== @@ -58,8 +58,6 @@ module GHC.Driver.Backend , DefunctionalizedCodeOutput(..) -- *** Back-end functions for assembly , DefunctionalizedPostHscPipeline(..) - , DefunctionalizedAssemblerProg(..) - , DefunctionalizedAssemblerInfoGetter(..) -- *** Other back-end functions , DefunctionalizedCDefs(..) -- ** Names of back ends (for API clients of version 9.4 or earlier) @@ -94,8 +92,6 @@ module GHC.Driver.Backend , backendSupportsHpc , backendSupportsCImport , backendSupportsCExport - , backendAssemblerProg - , backendAssemblerInfoGetter , backendCDefs , backendCodeOutput , backendUseJSLinker @@ -348,40 +344,6 @@ data PrimitiveImplementation deriving Show --- | Names a function that runs the assembler, of this type: --- --- > Logger -> DynFlags -> Platform -> [Option] -> IO () --- --- The functions so named are defined in "GHC.Driver.Pipeline.Execute". - -data DefunctionalizedAssemblerProg - = StandardAssemblerProg - -- ^ Use the standard system assembler - | JSAssemblerProg - -- ^ JS Backend compile to JS via Stg, and so does not use any assembler - | DarwinClangAssemblerProg - -- ^ If running on Darwin, use the assembler from the @clang@ - -- toolchain. Otherwise use the standard system assembler. - - - --- | Names a function that discover from what toolchain the assembler --- is coming, of this type: --- --- > Logger -> DynFlags -> Platform -> IO CompilerInfo --- --- The functions so named are defined in "GHC.Driver.Pipeline.Execute". - -data DefunctionalizedAssemblerInfoGetter - = StandardAssemblerInfoGetter - -- ^ Interrogate the standard system assembler - | JSAssemblerInfoGetter - -- ^ If using the JS backend; return 'Emscripten' - | DarwinClangAssemblerInfoGetter - -- ^ If running on Darwin, return `Clang`; otherwise - -- interrogate the standard system assembler. - - -- | Names a function that generates code and writes the results to a -- file, of this type: -- @@ -767,45 +729,6 @@ backendSupportsCExport (Named JavaScript) = True backendSupportsCExport (Named Interpreter) = False backendSupportsCExport (Named NoBackend) = True --- | This (defunctionalized) function runs the assembler --- used on the code that is written by this back end. A --- program determined by a combination of back end, --- `DynFlags`, and `Platform` is run with the given --- `Option`s. --- --- The function's type is --- @ --- Logger -> DynFlags -> Platform -> [Option] -> IO () --- @ --- --- This field is usually defaulted. -backendAssemblerProg :: Backend -> DefunctionalizedAssemblerProg -backendAssemblerProg (Named NCG) = StandardAssemblerProg -backendAssemblerProg (Named LLVM) = DarwinClangAssemblerProg -backendAssemblerProg (Named ViaC) = StandardAssemblerProg -backendAssemblerProg (Named JavaScript) = JSAssemblerProg -backendAssemblerProg (Named Interpreter) = StandardAssemblerProg -backendAssemblerProg (Named NoBackend) = StandardAssemblerProg - --- | This (defunctionalized) function is used to retrieve --- an enumeration value that characterizes the C/assembler --- part of a toolchain. The function caches the info in a --- mutable variable that is part of the `DynFlags`. --- --- The function's type is --- @ --- Logger -> DynFlags -> Platform -> IO CompilerInfo --- @ --- --- This field is usually defaulted. -backendAssemblerInfoGetter :: Backend -> DefunctionalizedAssemblerInfoGetter -backendAssemblerInfoGetter (Named NCG) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named LLVM) = DarwinClangAssemblerInfoGetter -backendAssemblerInfoGetter (Named ViaC) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named JavaScript) = JSAssemblerInfoGetter -backendAssemblerInfoGetter (Named Interpreter) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named NoBackend) = StandardAssemblerInfoGetter - -- | When using this back end, it may be necessary or -- advisable to pass some `-D` options to a C compiler. -- This (defunctionalized) function produces those ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -116,7 +116,6 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Trans.Reader (ReaderT) import Control.Monad.Trans.Writer (WriterT) -import Data.IORef import System.IO import System.IO.Error (catchIOError) import System.Environment (lookupEnv) @@ -420,15 +419,6 @@ data DynFlags = DynFlags { avx512pf :: Bool, -- Enable AVX-512 PreFetch Instructions. fma :: Bool, -- ^ Enable FMA instructions. - -- | Run-time linker information (what options we need, etc.) - rtldInfo :: IORef (Maybe LinkerInfo), - - -- | Run-time C compiler information - rtccInfo :: IORef (Maybe CompilerInfo), - - -- | Run-time assembler information - rtasmInfo :: IORef (Maybe CompilerInfo), - -- Constants used to control the amount of optimization done. -- | Max size, in bytes, of inline array allocations. @@ -490,9 +480,6 @@ class ContainsDynFlags t where initDynFlags :: DynFlags -> IO DynFlags initDynFlags dflags = do let - refRtldInfo <- newIORef Nothing - refRtccInfo <- newIORef Nothing - refRtasmInfo <- newIORef Nothing canUseUnicode <- do let enc = localeEncoding str = "‘’" (withCString enc str $ \cstr -> @@ -514,9 +501,6 @@ initDynFlags dflags = do useColor = useColor', canUseColor = stderrSupportsAnsiColors, colScheme = colScheme', - rtldInfo = refRtldInfo, - rtccInfo = refRtccInfo, - rtasmInfo = refRtasmInfo, tmpDir = TempDir tmp_dir } @@ -695,9 +679,6 @@ defaultDynFlags mySettings = avx512f = False, avx512pf = False, fma = False, - rtldInfo = panic "defaultDynFlags: no rtldInfo", - rtccInfo = panic "defaultDynFlags: no rtccInfo", - rtasmInfo = panic "defaultDynFlags: no rtasmInfo", maxInlineAllocSize = 128, maxInlineMemcpyInsns = 32, ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -110,7 +110,6 @@ module GHC.Driver.Main import GHC.Prelude import GHC.Platform -import GHC.Platform.Ways import GHC.Driver.Plugins import GHC.Driver.Session @@ -345,41 +344,11 @@ initHscEnv mb_top_dir = do mySettings <- initSysTools top_dir dflags <- initDynFlags (defaultDynFlags mySettings) hsc_env <- newHscEnv top_dir dflags - checkBrokenTablesNextToCode (hsc_logger hsc_env) dflags setUnsafeGlobalDynFlags dflags -- c.f. DynFlags.parseDynamicFlagsFull, which -- creates DynFlags and sets the UnsafeGlobalDynFlags return hsc_env --- | The binutils linker on ARM emits unnecessary R_ARM_COPY relocations which --- breaks tables-next-to-code in dynamically linked modules. This --- check should be more selective but there is currently no released --- version where this bug is fixed. --- See https://sourceware.org/bugzilla/show_bug.cgi?id=16177 and --- https://gitlab.haskell.org/ghc/ghc/issues/4210#note_78333 -checkBrokenTablesNextToCode :: Logger -> DynFlags -> IO () -checkBrokenTablesNextToCode logger dflags = do - let invalidLdErr = "Tables-next-to-code not supported on ARM \ - \when using binutils ld (please see: \ - \https://sourceware.org/bugzilla/show_bug.cgi?id=16177)" - broken <- checkBrokenTablesNextToCode' logger dflags - when broken (panic invalidLdErr) - -checkBrokenTablesNextToCode' :: Logger -> DynFlags -> IO Bool -checkBrokenTablesNextToCode' logger dflags - | not (isARM arch) = return False - | ways dflags `hasNotWay` WayDyn = return False - | not tablesNextToCode = return False - | otherwise = do - linkerInfo <- liftIO $ GHC.SysTools.getLinkerInfo logger dflags - case linkerInfo of - GnuLD _ -> return True - _ -> return False - where platform = targetPlatform dflags - arch = platformArch platform - tablesNextToCode = platformTablesNextToCode platform - - -- ----------------------------------------------------------------------------- getDiagnostics :: Hsc (Messages GhcMessage) ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -287,12 +287,6 @@ runAsPhase :: Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO F runAsPhase with_cpp pipe_env hsc_env location input_fn = do let dflags = hsc_dflags hsc_env let logger = hsc_logger hsc_env - let unit_env = hsc_unit_env hsc_env - let platform = ue_platform unit_env - - -- LLVM from version 3.0 onwards doesn't support the OS X system - -- assembler, so we use clang as the assembler instead. (#5636) - let as_prog = applyAssemblerProg $ backendAssemblerProg (backend dflags) let cmdline_include_paths = includePaths dflags let pic_c_flags = picCCOpts dflags @@ -310,9 +304,8 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do includePathsQuoteImplicit cmdline_include_paths] let runAssembler inputFilename outputFilename = withAtomicRename outputFilename $ \temp_outputFilename -> - as_prog + runAs logger dflags - platform (local_includes ++ global_includes -- See Note [-fPIC for assembler] ++ map GHC.SysTools.Option pic_c_flags @@ -392,22 +385,6 @@ runForeignJsPhase pipe_env hsc_env _location input_fn = do embedJsFile logger dflags tmpfs unit_env input_fn output_fn return output_fn - -applyAssemblerProg - :: DefunctionalizedAssemblerProg - -> Logger -> DynFlags -> Platform -> [Option] -> IO () -applyAssemblerProg StandardAssemblerProg logger dflags _platform = - runAs logger dflags -applyAssemblerProg JSAssemblerProg logger dflags _platform = - runEmscripten logger dflags -applyAssemblerProg DarwinClangAssemblerProg logger dflags platform = - if platformOS platform == OSDarwin then - runClang logger dflags - else - runAs logger dflags - - - runCcPhase :: Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO FilePath runCcPhase cc_phase pipe_env hsc_env location input_fn = do let dflags = hsc_dflags hsc_env ===================================== compiler/GHC/Linker/ExtraObj.hs ===================================== @@ -12,7 +12,6 @@ module GHC.Linker.ExtraObj , mkNoteObjsToLinkIntoBinary , checkLinkInfo , getLinkInfo - , getCompilerInfo , ghcLinkInfoSectionName , ghcLinkInfoNoteName , platformSupportsSavingLinkOpts @@ -40,10 +39,8 @@ import qualified GHC.Data.ShortText as ST import GHC.SysTools.Elf import GHC.SysTools.Tasks -import GHC.SysTools.Info import GHC.Linker.Unit -import Control.Monad.IO.Class import Control.Monad import Data.Maybe @@ -52,7 +49,6 @@ mkExtraObj logger tmpfs dflags unit_state extn xs = do cFile <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule extn oFile <- newTempName logger tmpfs (tmpDir dflags) TFL_GhcSession "o" writeFile cFile xs - ccInfo <- liftIO $ getCompilerInfo logger dflags runCc Nothing logger tmpfs dflags ([Option "-c", FileOption "" cFile, @@ -60,7 +56,7 @@ mkExtraObj logger tmpfs dflags unit_state extn xs FileOption "" oFile] ++ if extn /= "s" then cOpts - else asmOpts ccInfo) + else []) return oFile where -- Pass a different set of options to the C compiler depending one whether @@ -70,14 +66,6 @@ mkExtraObj logger tmpfs dflags unit_state extn xs ++ map (FileOption "-I" . ST.unpack) (unitIncludeDirs $ unsafeLookupUnit unit_state rtsUnit) - -- When compiling assembler code, we drop the usual C options, and if the - -- compiler is Clang, we add an extra argument to tell Clang to ignore - -- unused command line options. See trac #11684. - asmOpts ccInfo = - if any (ccInfo ==) [Clang, AppleClang, AppleClang51] - then [Option "-Qunused-arguments"] - else [] - -- When linking a binary, we need to create a C main() function that -- starts everything off. This used to be compiled statically as part -- of the RTS, but that made it hard to change the -rtsopts setting, ===================================== compiler/GHC/SysTools.hs ===================================== @@ -17,7 +17,6 @@ module GHC.SysTools ( -- * Interface to system tools module GHC.SysTools.Tasks, - module GHC.SysTools.Info, -- * Fast file copy copyFile, @@ -35,8 +34,6 @@ import GHC.Prelude import GHC.Utils.Panic import GHC.Driver.Session -import GHC.Linker.ExtraObj -import GHC.SysTools.Info import GHC.SysTools.Tasks import GHC.SysTools.BaseDir import GHC.Settings.IO ===================================== compiler/GHC/SysTools/Info.hs deleted ===================================== @@ -1,243 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} ------------------------------------------------------------------------------ --- --- Compiler information functions --- --- (c) The GHC Team 2017 --- ------------------------------------------------------------------------------ -module GHC.SysTools.Info where - -import GHC.Utils.Exception -import GHC.Utils.Error -import GHC.Driver.Session -import GHC.Utils.Outputable -import GHC.Utils.Misc -import GHC.Utils.Logger - -import Data.List ( isInfixOf, isPrefixOf ) -import Data.IORef - -import System.IO - -import GHC.Platform -import GHC.Prelude - -import GHC.SysTools.Process - -{- Note [Run-time linker info] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~ -See also: #5240, #6063, #10110 - -Before 'runLink', we need to be sure to get the relevant information -about the linker we're using at runtime to see if we need any extra -options. - -Generally, the linker changing from what was detected at ./configure -time has always been possible using -pgml, but on Linux it can happen -'transparently' by installing packages like binutils-gold, which -change what /usr/bin/ld actually points to. - -Clang vs GCC notes: - -For gcc, 'gcc -Wl,--version' gives a bunch of output about how to -invoke the linker before the version information string. For 'clang', -the version information for 'ld' is all that's output. For this -reason, we typically need to slurp up all of the standard error output -and look through it. - -Other notes: - -We cache the LinkerInfo inside DynFlags, since clients may link -multiple times. The definition of LinkerInfo is there to avoid a -circular dependency. - --} - -{- Note [ELF needed shared libs] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Some distributions change the link editor's default handling of -ELF DT_NEEDED tags to include only those shared objects that are -needed to resolve undefined symbols. For Template Haskell we need -the last temporary shared library also if it is not needed for the -currently linked temporary shared library. We specify --no-as-needed -to override the default. This flag exists in GNU ld and GNU gold. - -The flag is only needed on ELF systems. On Windows (PE) and Mac OS X -(Mach-O) the flag is not needed. - --} - -neededLinkArgs :: LinkerInfo -> [Option] -neededLinkArgs (GnuLD o) = o -neededLinkArgs (Mold o) = o -neededLinkArgs (GnuGold o) = o -neededLinkArgs (LlvmLLD o) = o -neededLinkArgs (DarwinLD o) = o -neededLinkArgs (SolarisLD o) = o -neededLinkArgs (AixLD o) = o -neededLinkArgs UnknownLD = [] - --- Grab linker info and cache it in DynFlags. -getLinkerInfo :: Logger -> DynFlags -> IO LinkerInfo -getLinkerInfo logger dflags = do - info <- readIORef (rtldInfo dflags) - case info of - Just v -> return v - Nothing -> do - v <- getLinkerInfo' logger dflags - writeIORef (rtldInfo dflags) (Just v) - return v - --- See Note [Run-time linker info]. -getLinkerInfo' :: Logger -> DynFlags -> IO LinkerInfo -getLinkerInfo' logger dflags = do - let platform = targetPlatform dflags - os = platformOS platform - (pgm,args0) = pgm_l dflags - args1 = map Option (getOpts dflags opt_l) - args2 = args0 ++ args1 - args3 = filter notNull (map showOpt args2) - - -- Try to grab the info from the process output. - parseLinkerInfo stdo _stde _exitc - | any ("GNU ld" `isPrefixOf`) stdo = - -- Set DT_NEEDED for all shared libraries. #10110. - return (GnuLD $ map Option [-- ELF specific flag - -- 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] - return (GnuGold [Option "-Wl,--no-as-needed"]) - - | any (\line -> "LLD" `isPrefixOf` line || "LLD" `elem` words line) stdo = - return (LlvmLLD $ map Option [ --see Note [ELF needed shared libs] - "-Wl,--no-as-needed" | osElfTarget os || os == OSMinGW32 ]) - - -- Unknown linker. - | otherwise = fail "invalid --version output, or linker is unsupported" - - -- Process the executable call - catchIO ( - case os of - OSSolaris2 -> - -- Solaris uses its own Solaris linker. Even all - -- GNU C are recommended to configure with Solaris - -- linker instead of using GNU binutils linker. Also - -- all GCC distributed with Solaris follows this rule - -- precisely so we assume here, the Solaris linker is - -- used. - return $ SolarisLD [] - OSAIX -> - -- IBM AIX uses its own non-binutils linker as well - return $ AixLD [] - OSDarwin -> - -- Darwin has neither GNU Gold or GNU LD, but a strange linker - -- that doesn't support --version. We can just assume that's - -- what we're using. - return $ DarwinLD [] - OSMinGW32 -> - -- GHC doesn't support anything but GNU ld on Windows anyway. - -- Process creation is also fairly expensive on win32, so - -- we short-circuit here. - return $ GnuLD $ map Option - [ -- Emit stack checks - -- See Note [Windows stack allocations] - "-fstack-check" - ] - _ -> do - -- In practice, we use the compiler as the linker here. Pass - -- -Wl,--version to get linker version info. - (exitc, stdo, stde) <- readProcessEnvWithExitCode pgm - (["-Wl,--version"] ++ args3) - c_locale_env - -- Split the output by lines to make certain kinds - -- of processing easier. In particular, 'clang' and 'gcc' - -- have slightly different outputs for '-Wl,--version', but - -- it's still easy to figure out. - parseLinkerInfo (lines stdo) (lines stde) exitc - ) - (\err -> do - debugTraceMsg logger 2 - (text "Error (figuring out linker information):" <+> - text (show err)) - errorMsg logger $ hang (text "Warning:") 9 $ - text "Couldn't figure out linker information!" $$ - text "Make sure you're using GNU ld, GNU gold" <+> - text "or the built in OS X linker, etc." - return UnknownLD - ) - --- | Grab compiler info and cache it in DynFlags. -getCompilerInfo :: Logger -> DynFlags -> IO CompilerInfo -getCompilerInfo logger dflags = do - info <- readIORef (rtccInfo dflags) - case info of - Just v -> return v - Nothing -> do - let pgm = pgm_c dflags - v <- getCompilerInfo' logger pgm - writeIORef (rtccInfo dflags) (Just v) - return v - --- | Grab assembler info and cache it in DynFlags. -getAssemblerInfo :: Logger -> DynFlags -> IO CompilerInfo -getAssemblerInfo logger dflags = do - info <- readIORef (rtasmInfo dflags) - case info of - Just v -> return v - Nothing -> do - let (pgm, _) = pgm_a dflags - v <- getCompilerInfo' logger pgm - writeIORef (rtasmInfo dflags) (Just v) - return v - --- See Note [Run-time linker info]. -getCompilerInfo' :: Logger -> String -> IO CompilerInfo -getCompilerInfo' logger pgm = do - let -- Try to grab the info from the process output. - parseCompilerInfo _stdo stde _exitc - -- Regular GCC - | any ("gcc version" `isInfixOf`) stde = - return GCC - -- Regular clang - | any ("clang version" `isInfixOf`) stde = - return Clang - -- FreeBSD clang - | any ("FreeBSD clang version" `isInfixOf`) stde = - return Clang - -- Xcode 5.1 clang - | any ("Apple LLVM version 5.1" `isPrefixOf`) stde = - return AppleClang51 - -- Xcode 5 clang - | any ("Apple LLVM version" `isPrefixOf`) stde = - return AppleClang - -- Xcode 4.1 clang - | any ("Apple clang version" `isPrefixOf`) stde = - return AppleClang - -- Unknown compiler. - | otherwise = fail $ "invalid -v output, or compiler is unsupported (" ++ pgm ++ "): " ++ unlines stde - - -- Process the executable call - catchIO (do - (exitc, stdo, stde) <- - readProcessEnvWithExitCode pgm ["-v"] c_locale_env - -- Split the output by lines to make certain kinds - -- of processing easier. - parseCompilerInfo (lines stdo) (lines stde) exitc - ) - (\err -> do - debugTraceMsg logger 2 - (text "Error (figuring out C compiler information):" <+> - text (show err)) - errorMsg logger $ hang (text "Warning:") 9 $ - text "Couldn't figure out C compiler information!" $$ - text "Make sure you're using GNU gcc, or clang" - return UnknownCC - ) ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -19,7 +19,6 @@ import GHC.CmmToLlvm.Config (LlvmVersion, llvmVersionStr, supportedLlvmVersionUp import GHC.Settings import GHC.SysTools.Process -import GHC.SysTools.Info import GHC.Driver.Session @@ -278,15 +277,12 @@ figureLlvmVersion logger dflags = traceSystoolCommand logger "llc" $ do runLink :: Logger -> TmpFs -> DynFlags -> [Option] -> IO () runLink logger tmpfs dflags args = traceSystoolCommand logger "linker" $ do - -- See Note [Run-time linker info] - -- -- `-optl` args come at the end, so that later `-l` options -- given there manually can fill in symbols needed by -- Haskell libraries coming in via `args`. - linkargs <- neededLinkArgs `fmap` getLinkerInfo logger dflags let (p,args0) = pgm_l dflags optl_args = map Option (getOpts dflags opt_l) - args2 = args0 ++ linkargs ++ args ++ optl_args + args2 = args0 ++ args ++ optl_args mb_env <- getGccEnv args2 runSomethingResponseFile logger tmpfs dflags ld_filter "Linker" p args2 mb_env where ===================================== compiler/ghc.cabal.in ===================================== @@ -715,7 +715,6 @@ Library GHC.SysTools.BaseDir GHC.SysTools.Cpp GHC.SysTools.Elf - GHC.SysTools.Info GHC.SysTools.Process GHC.SysTools.Tasks GHC.SysTools.Terminal ===================================== m4/fp_link_supports_no_as_needed.m4 ===================================== @@ -0,0 +1,33 @@ +# FP_LINK_SUPPORTS_NO_AS_NEEDED +# ---------------------------------- +# Set the Cc linker flag -Wl,--no-as-needed if it is supported +# $1 is the name of the linker flags variable when linking with gcc +# See also Note [ELF needed shared libs] +AC_DEFUN([FP_LINK_SUPPORTS_NO_AS_NEEDED], +[ + AC_MSG_CHECKING([whether Cc linker supports -Wl,--no-as-needed]) + echo 'int f(int a) {return 2*a;}' > conftest.a.c + echo 'int f(int a); int main(int argc, char **argv) {return f(0);}' > conftest.b.c + $CC -c -o conftest.a.o conftest.a.c > /dev/null 2>&1 + $CC -c -o conftest.b.o conftest.b.c > /dev/null 2>&1 + if "$CC" "$$1" -Wl,--no-as-needed -o conftest conftest.a.o conftest.b.o > /dev/null 2>&1 + then + $1="$$1 -Wl,--no-as-needed" + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + fi + rm -f conftest* +]) + +# Note [ELF needed shared libs] +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# Some distributions change the link editor's default handling of +# ELF DT_NEEDED tags to include only those shared objects that are +# needed to resolve undefined symbols. For Template Haskell we need +# the last temporary shared library also if it is not needed for the +# currently linked temporary shared library. We specify --no-as-needed +# to override the default. This flag exists in GNU ld and GNU gold. +# +# The flag is only needed on ELF systems. On Windows (PE) and Mac OS X +# (Mach-O) the flag is not needed. ===================================== m4/fptools_set_c_ld_flags.m4 ===================================== @@ -17,6 +17,21 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS], ;; esac + # See Note [ELF needed shared libs] + case $$1 in + *-linux|*-freebsd*) + FP_LINK_SUPPORTS_NO_AS_NEEDED([$3]) + ;; + esac + + # Emit stack checks + # See Note [Windows stack allocations] + case $$1 in + *-mingw32*) + $3="$$3 -fstack-check" + ;; + esac + case $$1 in i386-unknown-mingw32) $2="$$2 -march=i686" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/01542cb7227614a93508b97ecad5b16dddeb6486 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/01542cb7227614a93508b97ecad5b16dddeb6486 You're receiving 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 Jun 28 09:56:39 2023 From: gitlab at gitlab.haskell.org (Bryan R (@chreekat)) Date: Wed, 28 Jun 2023 05:56:39 -0400 Subject: [Git][ghc/ghc][wip/b/missing-prototypes] Add missing void prototypes to rts functions Message-ID: <649c03d76aff5_3b5ae2c763c144348@gitlab.mail> Bryan R pushed to branch wip/b/missing-prototypes at Glasgow Haskell Compiler / GHC Commits: a4ef4e64 by Bryan Richter at 2023-06-28T12:54:36+03:00 Add missing void prototypes to rts functions See #23561. - - - - - 29 changed files: - rts/ExecPage.c - rts/IPE.c - rts/Libdw.c - rts/Linker.c - rts/ReportMemoryMap.c - rts/StaticPtrTable.c - rts/adjustor/LibffiAdjustor.c - rts/adjustor/NativeAmd64.c - rts/adjustor/NativeAmd64Mingw.c - rts/adjustor/NativeIA64.c - rts/adjustor/NativePowerPC.c - rts/adjustor/Nativei386.c - rts/eventlog/EventLog.c - rts/linker/PEi386.c - rts/posix/GetTime.c - rts/sm/BlockAlloc.c - rts/sm/GC.c - rts/sm/MarkWeak.c - rts/sm/NonMoving.c - rts/sm/NonMovingCensus.c - rts/sm/NonMovingMark.c - rts/sm/NonMovingSweep.c - rts/wasm/GetTime.c - rts/win32/AsyncMIO.c - rts/win32/AsyncWinIO.c - rts/win32/ConsoleHandler.c - rts/win32/GetTime.c - rts/win32/OSThreads.c - rts/win32/WorkQueue.c Changes: ===================================== rts/ExecPage.c ===================================== @@ -9,7 +9,7 @@ #include "sm/OSMem.h" #include "linker/MMap.h" -ExecPage *allocateExecPage() { +ExecPage *allocateExecPage(void) { ExecPage *page = (ExecPage *) mmapAnonForLinker(getPageSize()); return page; } ===================================== rts/IPE.c ===================================== @@ -173,7 +173,7 @@ InfoProvEnt *lookupIPE(const StgInfoTable *info) { return lookupHashTable(ipeMap, (StgWord)info); } -void updateIpeMap() { +void updateIpeMap(void) { // Check if there's any work at all. If not so, we can circumvent locking, // which decreases performance. IpeBufferListNode *pending = xchg_ptr((void **) &ipeBufferList, NULL); ===================================== rts/Libdw.c ===================================== @@ -75,7 +75,7 @@ void libdwFree(LibdwSession *session) { } // Create a libdw session with DWARF information for all loaded modules -LibdwSession *libdwInit() { +LibdwSession *libdwInit(void) { LibdwSession *session = stgCallocBytes(1, sizeof(LibdwSession), "libdwInit"); // Initialize ELF library ===================================== rts/Linker.c ===================================== @@ -1032,7 +1032,7 @@ SymbolAddr* loadSymbol(SymbolName *lbl, RtsSymbolInfo *pinfo) { } void -printLoadedObjects() { +printLoadedObjects(void) { ObjectCode* oc; for (oc = objects; oc; oc = oc->next) { if (oc->sections != NULL) { ===================================== rts/ReportMemoryMap.c ===================================== @@ -25,7 +25,7 @@ #if defined(mingw32_HOST_OS) -void reportMemoryMap() { +void reportMemoryMap(void) { debugBelch("\nMemory map:\n"); uint8_t *addr = NULL; while (true) { @@ -74,7 +74,7 @@ void reportMemoryMap() { #elif defined(darwin_HOST_OS) -void reportMemoryMap() { +void reportMemoryMap(void) { // Inspired by MacFUSE /proc implementation debugBelch("\nMemory map:\n"); while (true) { @@ -112,7 +112,7 @@ void reportMemoryMap() { #else // Linux et al. -void reportMemoryMap() { +void reportMemoryMap(void) { debugBelch("\nMemory map:\n"); FILE *f = fopen("/proc/self/maps", "r"); if (f == NULL) { ===================================== rts/StaticPtrTable.c ===================================== @@ -99,11 +99,11 @@ int hs_spt_keys(StgPtr keys[], int szKeys) { return 0; } -int hs_spt_key_count() { +int hs_spt_key_count(void) { return spt ? keyCountHashTable(spt) : 0; } -void exitStaticPtrTable() { +void exitStaticPtrTable(void) { if (spt) { freeHashTable(spt, freeSptEntry); spt = NULL; ===================================== rts/adjustor/LibffiAdjustor.c ===================================== @@ -31,7 +31,7 @@ static ffi_status ffi_alloc_prep_closure(ffi_closure **pclosure, ffi_cif *cif, /* Maps AdjustorExecutable* to AdjustorWritable*. */ static HashTable* allocatedExecs; -void initAdjustors() { +void initAdjustors(void) { allocatedExecs = allocHashTable(); } ===================================== rts/adjustor/NativeAmd64.c ===================================== @@ -28,7 +28,7 @@ static struct AdjustorPool *simple_ccall_pool; DECLARE_ADJUSTOR_TEMPLATE(complex_ccall); static struct AdjustorPool *complex_ccall_pool; -void initAdjustors() +void initAdjustors(void) { simple_ccall_pool = new_adjustor_pool_from_template(&simple_ccall_adjustor_template); complex_ccall_pool = new_adjustor_pool_from_template(&complex_ccall_adjustor_template); ===================================== rts/adjustor/NativeAmd64Mingw.c ===================================== @@ -34,7 +34,7 @@ static struct AdjustorPool *complex_float_ccall_pool; DECLARE_ADJUSTOR_TEMPLATE(complex_nofloat_ccall); static struct AdjustorPool *complex_nofloat_ccall_pool; -void initAdjustors() +void initAdjustors(void) { simple_ccall_pool = new_adjustor_pool_from_template(&simple_ccall_adjustor_template); complex_float_ccall_pool = new_adjustor_pool_from_template(&complex_float_ccall_adjustor_template); ===================================== rts/adjustor/NativeIA64.c ===================================== @@ -35,7 +35,7 @@ stgAllocStable(size_t size_in_bytes, StgStablePtr *stable) return(&(arr->payload)); } -void initAdjustors() { } +void initAdjustors(void) { } void* createAdjustor(int cconv, StgStablePtr hptr, ===================================== rts/adjustor/NativePowerPC.c ===================================== @@ -53,7 +53,7 @@ typedef struct AdjustorStub { #endif /* !(defined(powerpc_HOST_ARCH) && defined(linux_HOST_OS)) */ #endif /* defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) */ -void initAdjustors() { } +void initAdjustors(void) { } void* createAdjustor(int cconv, StgStablePtr hptr, ===================================== rts/adjustor/Nativei386.c ===================================== @@ -92,7 +92,7 @@ static void mk_stdcall_adjustor(uint8_t *code, const void *context, void *user_d static struct AdjustorPool *stdcall_pool; #endif -void initAdjustors() { +void initAdjustors(void) { ccall_pool = new_adjustor_pool(sizeof(struct CCallContext), CCALL_ADJUSTOR_LEN, mk_ccall_adjustor, NULL); #if !defined(darwin_HOST_OS) stdcall_pool = new_adjustor_pool(sizeof(struct AdjustorContext), STDCALL_ADJUSTOR_LEN, mk_stdcall_adjustor, NULL); ===================================== rts/eventlog/EventLog.c ===================================== @@ -359,7 +359,7 @@ get_n_capabilities(void) } void -initEventLogging() +initEventLogging(void) { /* * Allocate buffer(s) to store events. @@ -1561,7 +1561,7 @@ void flushLocalEventsBuf(Capability *cap) // Flush all capabilities' event buffers when we already hold all capabilities. // Used during forkProcess. -void flushAllCapsEventsBufs() +void flushAllCapsEventsBufs(void) { if (!event_log_writer) { return; ===================================== rts/linker/PEi386.c ===================================== @@ -433,7 +433,7 @@ const int default_alignment = 8; the pointer as a redirect. Essentially it's a DATA DLL reference. */ const void* __rts_iob_func = (void*)&__acrt_iob_func; -void initLinker_PEi386() +void initLinker_PEi386(void) { if (!ghciInsertSymbolTable(WSTR("(GHCi/Ld special symbols)"), symhash, "__image_base__", @@ -452,7 +452,7 @@ void initLinker_PEi386() atexit (exitLinker_PEi386); } -void exitLinker_PEi386() +void exitLinker_PEi386(void) { } ===================================== rts/posix/GetTime.c ===================================== @@ -45,7 +45,7 @@ static uint64_t timer_scaling_factor_numer = 0; static uint64_t timer_scaling_factor_denom = 0; #endif -void initializeTimer() +void initializeTimer(void) { #if defined(darwin_HOST_OS) mach_timebase_info_data_t info; ===================================== rts/sm/BlockAlloc.c ===================================== @@ -1138,14 +1138,14 @@ static void sortDeferredList(bdescr** head) { } } -void deferMBlockFreeing() { +void deferMBlockFreeing(void) { if(defer_mblock_frees) { barf("MBlock freeing is already deferred"); } defer_mblock_frees = true; } -void commitMBlockFreeing() { +void commitMBlockFreeing(void) { if(! defer_mblock_frees) { barf("MBlock freeing was never deferred"); } ===================================== rts/sm/GC.c ===================================== @@ -184,7 +184,7 @@ uint32_t n_gc_threads; static uint32_t n_gc_idle_threads; bool work_stealing; -static bool is_par_gc() { +static bool is_par_gc(void) { #if defined(THREADED_RTS) if(n_gc_threads == 1) { return false; } ASSERT(n_gc_threads > n_gc_idle_threads); ===================================== rts/sm/MarkWeak.c ===================================== @@ -457,7 +457,7 @@ static void checkWeakPtrSanity(StgWeak *hd, StgWeak *tl) * 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() +void collectFreshWeakPtrs(void) { uint32_t i; // move recently allocated weak_ptr_list to the old list as well ===================================== rts/sm/NonMoving.c ===================================== @@ -1338,7 +1338,7 @@ void locate_object(P_ obj) #endif } -void nonmovingPrintSweepList() +void nonmovingPrintSweepList(void) { debugBelch("==== SWEEP LIST =====\n"); int i = 0; ===================================== rts/sm/NonMovingCensus.c ===================================== @@ -141,7 +141,7 @@ void nonmovingPrintAllocatorCensus(bool collect_live_words) } } -void nonmovingTraceAllocatorCensus() +void nonmovingTraceAllocatorCensus(void) { #if defined(TRACING) if (!RtsFlags.GcFlags.useNonmoving && !TRACE_nonmoving_gc) ===================================== rts/sm/NonMovingMark.c ===================================== @@ -260,7 +260,7 @@ StgWord nonmoving_write_barrier_enabled = false; MarkQueue *current_mark_queue = NULL; /* Initialise update remembered set data structures */ -void nonmovingMarkInit() { +void nonmovingMarkInit(void) { #if defined(THREADED_RTS) initMutex(&upd_rem_set_lock); initCondition(&upd_rem_set_flushed_cond); @@ -367,7 +367,7 @@ void nonmovingBeginFlush(Task *task) /* Wait until a capability has flushed its update remembered set. Returns true * if all capabilities have flushed. */ -bool nonmovingWaitForFlush() +bool nonmovingWaitForFlush(void) { ACQUIRE_LOCK(&upd_rem_set_lock); debugTrace(DEBUG_nonmoving_gc, "Flush count %d", upd_rem_set_flush_count); @@ -2062,7 +2062,7 @@ void nonmovingMarkDeadWeaks (struct MarkQueue_ *queue, StgWeak **dead_weaks) } // Non-moving heap variant of `tidyThreadList` -void nonmovingTidyThreads () +void nonmovingTidyThreads (void) { StgTSO *next; StgTSO **prev = &nonmoving_old_threads; ===================================== rts/sm/NonMovingSweep.c ===================================== @@ -74,7 +74,7 @@ nonmovingSweepSegment(struct NonmovingSegment *seg) #if defined(DEBUG) -void nonmovingGcCafs() +void nonmovingGcCafs(void) { uint32_t i = 0; StgIndStatic *next; @@ -279,7 +279,7 @@ dirty_BLOCKING_QUEUE: } /* N.B. This happens during the pause so we own all capabilities. */ -void nonmovingSweepMutLists() +void nonmovingSweepMutLists(void) { for (uint32_t n = 0; n < getNumCapabilities(); n++) { Capability *cap = getCapability(n); @@ -324,7 +324,7 @@ static void freeChain_lock_max(bdescr *bd, int max_dur) RELEASE_SM_LOCK; } -void nonmovingSweepLargeObjects() +void nonmovingSweepLargeObjects(void) { freeChain_lock_max(nonmoving_large_objects, 10000); nonmoving_large_objects = nonmoving_marked_large_objects; @@ -333,7 +333,7 @@ void nonmovingSweepLargeObjects() n_nonmoving_marked_large_blocks = 0; } -void nonmovingSweepCompactObjects() +void nonmovingSweepCompactObjects(void) { bdescr *next; ACQUIRE_SM_LOCK; @@ -367,7 +367,7 @@ static bool is_alive(StgClosure *p) } } -void nonmovingSweepStableNameTable() +void nonmovingSweepStableNameTable(void) { // See comments in gcStableTables ===================================== rts/wasm/GetTime.c ===================================== @@ -15,7 +15,7 @@ #include #include -void initializeTimer() +void initializeTimer(void) { } ===================================== rts/win32/AsyncMIO.c ===================================== @@ -150,7 +150,7 @@ addDoProcRequest(void* proc, void* param) int -startupAsyncIO() +startupAsyncIO(void) { if (!StartIOManager()) { return 0; ===================================== rts/win32/AsyncWinIO.c ===================================== @@ -435,7 +435,7 @@ static void notifyScheduler(uint32_t num) { processRemoteCompletion queued. IO runner thread blocked until processRemoteCompletion has run. */ -bool queueIOThread() +bool queueIOThread(void) { bool result = false; #if !defined(THREADED_RTS) ===================================== rts/win32/ConsoleHandler.c ===================================== @@ -332,7 +332,7 @@ rts_ConsoleHandlerDone (int ev USED_IF_NOT_THREADS) * up as part Ctrl-C delivery. */ int -rts_waitConsoleHandlerCompletion() +rts_waitConsoleHandlerCompletion(void) { /* As long as the worker doesn't need to do a multiple wait, * let's keep this HANDLE private to this 'module'. ===================================== rts/win32/GetTime.c ===================================== @@ -66,7 +66,7 @@ static LARGE_INTEGER qpc_frequency = {.QuadPart = 0}; // Initialize qpc_frequency. This function should be called before any call to // getMonotonicNSec. If QPC is not supported on this system, qpc_frequency is // set to 0. -void initializeTimer() +void initializeTimer(void) { BOOL qpc_supported = QueryPerformanceFrequency(&qpc_frequency); if (!qpc_supported) @@ -76,7 +76,7 @@ void initializeTimer() } HsWord64 -getMonotonicNSec() +getMonotonicNSec(void) { if (qpc_frequency.QuadPart) { ===================================== rts/win32/OSThreads.c ===================================== @@ -28,14 +28,14 @@ static uint32_t* cpuGroupCumulativeCache = NULL; static uint8_t* cpuGroupDistCache = NULL; void -yieldThread() +yieldThread(void) { SwitchToThread(); return; } void -shutdownThread() +shutdownThread(void) { ExitThread(0); barf("ExitThread() returned"); // avoid gcc warning @@ -65,7 +65,7 @@ createOSThread (OSThreadId* pId, const char *name STG_UNUSED, } OSThreadId -osThreadId() +osThreadId(void) { return GetCurrentThreadId(); } ===================================== rts/win32/WorkQueue.c ===================================== @@ -40,7 +40,7 @@ newSemaphore(int initCount, int max) * */ WorkQueue* -NewWorkQueue() +NewWorkQueue(void) { WorkQueue* wq = (WorkQueue*)stgMallocBytes(sizeof(WorkQueue), "NewWorkQueue"); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a4ef4e64432834f7da225154555d1a2955934de9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a4ef4e64432834f7da225154555d1a2955934de9 You're receiving 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 Jun 28 10:31:17 2023 From: gitlab at gitlab.haskell.org (Bryan R (@chreekat)) Date: Wed, 28 Jun 2023 06:31:17 -0400 Subject: [Git][ghc/ghc][wip/b/missing-prototypes] Add missing void prototypes to rts functions Message-ID: <649c0bf591e8a_3b5ae2d276c1530f7@gitlab.mail> Bryan R pushed to branch wip/b/missing-prototypes at Glasgow Haskell Compiler / GHC Commits: 8c8c2786 by Bryan Richter at 2023-06-28T13:31:02+03:00 Add missing void prototypes to rts functions See #23561. - - - - - 30 changed files: - rts/CheckUnload.c - rts/ExecPage.c - rts/ForeignExports.c - rts/IPE.c - rts/Libdw.c - rts/Linker.c - rts/OldARMAtomic.c - rts/Printer.c - rts/ReportMemoryMap.c - rts/RtsAPI.c - rts/RtsMessages.c - rts/Schedule.c - rts/StaticPtrTable.c - rts/Stats.c - rts/Ticky.c - rts/Trace.c - rts/adjustor/LibffiAdjustor.c - rts/adjustor/NativeAmd64.c - rts/adjustor/NativeAmd64Mingw.c - rts/adjustor/NativeIA64.c - rts/adjustor/NativePowerPC.c - rts/adjustor/Nativei386.c - rts/eventlog/EventLog.c - rts/linker/PEi386.c - rts/posix/GetTime.c - rts/sm/BlockAlloc.c - rts/sm/GC.c - rts/sm/MarkWeak.c - rts/sm/NonMoving.c - rts/sm/NonMovingCensus.c The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8c8c27863c6ff9d0eefefcbc956bbfd102d09992 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8c8c27863c6ff9d0eefefcbc956bbfd102d09992 You're receiving 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 Jun 28 11:37:16 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Wed, 28 Jun 2023 07:37:16 -0400 Subject: [Git][ghc/ghc][wip/T22010] Make uses of fromIntegral safer Message-ID: <649c1b6c8f80f_3b5ae2d1420181584@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 3bfe5e88 by Jaro Reinders at 2023-06-28T13:37:07+02:00 Make uses of fromIntegral safer - - - - - 10 changed files: - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/StgToJS/Symbols.hs - compiler/GHC/Types/Unique.hs - compiler/GHC/Types/Unique/Supply.hs - compiler/GHC/Utils/Outputable.hs Changes: ===================================== compiler/GHC/Builtin/Uniques.hs ===================================== @@ -1,4 +1,4 @@ - +{-# LANGUAGE TypeApplications #-} -- | This is where we define a mapping from Uniques to their associated -- known-key Names for things associated with tuples and sums. We use this @@ -66,8 +66,10 @@ import GHC.Data.FastString import GHC.Utils.Outputable import GHC.Utils.Panic +import GHC.Utils.Panic.Plain (assert) import Data.Maybe +import Data.Word (Word64) -- | Get the 'Name' associated with a known-key 'Unique'. knownUniqueName :: Unique -> Maybe Name @@ -84,8 +86,8 @@ knownUniqueName u = _ -> Nothing where (tag, n') = unpkUnique u - -- Known unique names are guaranteed to fit in 'Int', so we don't need the whole 'Word64'. - n = fromIntegral n' + -- Known unique names are guaranteed to fit in Int, so we don't need the whole Word64. + n = assert (isValidKnownKeyUnique u) (fromIntegral @Word64 @Int n') {- Note [Unique layout for unboxed sums] @@ -281,7 +283,9 @@ isTupleTyConUnique u = where (tag, n) = unpkUnique u (arity', i) = quotRem n 2 - arity = fromIntegral arity' + arity = + assert (arity' <= fromIntegral @Int @Word64 (maxBound :: Int)) + (fromIntegral @Word64 @Int arity') getTupleTyConName :: Boxity -> Int -> Name getTupleTyConName boxity n = ===================================== compiler/GHC/Cmm/CommonBlockElim.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE GADTs, BangPatterns, ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} module GHC.Cmm.CommonBlockElim ( elimCommonBlocks @@ -182,8 +183,10 @@ hash_block block = cvt = fromInteger . toInteger + -- Since we are hashing, we can savely downcast Word64 to Word32 here. + -- Although a different hashing function may be more effective. hash_unique :: Uniquable a => a -> Word32 - hash_unique = fromIntegral . getKey . getUnique + hash_unique = fromIntegral @Word64 @Word32 . getKey . getUnique -- | Ignore these node types for equality dont_care :: CmmNode O x -> Bool ===================================== compiler/GHC/Cmm/Dominators.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeApplications #-} module GHC.Cmm.Dominators ( @@ -40,8 +41,6 @@ import GHC.Cmm import GHC.Utils.Outputable( Outputable(..), text, int, hcat, (<+>)) import GHC.Utils.Misc import GHC.Utils.Panic -import GHC.Data.Word64Map (Word64Map) -import GHC.Data.Word64Set (Word64Set) import qualified GHC.Data.Word64Map as WM import qualified GHC.Data.Word64Set as WS @@ -132,6 +131,9 @@ graphWithDominators :: forall node . -- The implementation uses the Lengauer-Tarjan algorithm from the x86 -- back end. +-- Technically, we do not need Word64 here, however the dominators code +-- has to accomodate Word64 for other uses. + graphWithDominators g = GraphWithDominators (reachable rpblocks g) dmap rpmap where rpblocks = revPostorderFrom (graphMap g) (g_entry g) rplabels' = map entryLabel rpblocks @@ -149,9 +151,9 @@ graphWithDominators g = GraphWithDominators (reachable rpblocks g) dmap rpmap blockIndex = labelIndex . entryLabel bounds :: (Word64, Word64) - bounds = (0, fromIntegral (length rpblocks - 1)) + bounds = (0, fromIntegral @Int @Word64 (length rpblocks - 1)) - ltGraph :: [Block node C C] -> Word64Map Word64Set + ltGraph :: [Block node C C] -> LT.Graph ltGraph [] = WM.empty ltGraph (block:blocks) = WM.insert @@ -159,7 +161,7 @@ graphWithDominators g = GraphWithDominators (reachable rpblocks g) dmap rpmap (WS.fromList $ map labelIndex $ successors block) (ltGraph blocks) - idom_array :: Array Word64 Word64 + idom_array :: Array Word64 LT.Node idom_array = array bounds $ LT.idom (0, ltGraph rpblocks) domSet 0 = EntryNode ===================================== compiler/GHC/HsToCore/Foreign/JavaScript.hs ===================================== @@ -156,7 +156,7 @@ mkFExportJSBits platform c_nm maybe_target arg_htys res_hty is_IO_res_ty _cconv header_bits = maybe mempty idTag maybe_target idTag i = let (tag, u) = unpkUnique (getUnique i) - in CHeader (char tag <> word (fromIntegral u)) + in CHeader (char tag <> word64 u) fun_args | null arg_info = empty -- text "void" ===================================== compiler/GHC/Runtime/Eval.hs ===================================== @@ -333,7 +333,7 @@ handleRunStatus step expr bindings final_ids status history let dflags = hsc_dflags hsc_env let hmi = expectJust "handleRunStatus" $ lookupHptDirectly (hsc_HPT hsc_env) - (mkUniqueGrimily (fromIntegral mod_uniq)) + (mkUniqueIntGrimily mod_uniq) modl = mi_module (hm_iface hmi) breaks = getModBreaks hmi @@ -366,7 +366,7 @@ handleRunStatus step expr bindings final_ids status history apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref let hmi = expectJust "handleRunStatus" $ lookupHptDirectly (hsc_HPT hsc_env) - (mkUniqueGrimily (fromIntegral mod_uniq)) + (mkUniqueIntGrimily mod_uniq) modl = mi_module (hm_iface hmi) bp | is_exception = Nothing | otherwise = Just (BreakInfo modl ix) ===================================== compiler/GHC/Runtime/Interpreter.hs ===================================== @@ -398,7 +398,7 @@ handleSeqHValueStatus interp unit_env eval_status = resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt let hmi = expectJust "handleRunStatus" $ lookupHptDirectly (ue_hpt unit_env) - (mkUniqueGrimily (fromIntegral mod_uniq)) + (mkUniqueIntGrimily mod_uniq) modl = mi_module (hm_iface hmi) bp | is_exception = Nothing | otherwise = Just (BreakInfo modl ix) ===================================== compiler/GHC/StgToJS/Symbols.hs ===================================== @@ -1,3 +1,4 @@ +{-# LANGUAGE TypeApplications #-} -- | JS symbol generation module GHC.StgToJS.Symbols @@ -25,7 +26,7 @@ import qualified Data.ByteString.Lazy as BSL -- -- Used for the sub indices. intBS :: Int -> ByteString -intBS = word64BS . fromIntegral +intBS = word64BS . fromIntegral @Int @Word64 -- | Hexadecimal representation of a 64-bit word -- ===================================== compiler/GHC/Types/Unique.hs ===================================== @@ -19,6 +19,7 @@ Haskell). {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns, MagicHash #-} +{-# LANGUAGE TypeApplications #-} module GHC.Types.Unique ( -- * Main data types @@ -30,7 +31,9 @@ module GHC.Types.Unique ( pprUniqueAlways, + mkTag, mkUniqueGrimily, + mkUniqueIntGrimily, getKey, mkUnique, unpkUnique, mkUniqueInt, @@ -96,7 +99,7 @@ newtype Unique = MkUnique Word64 {-# INLINE uNIQUE_BITS #-} uNIQUE_BITS :: Int -uNIQUE_BITS = finiteBitSize (0 :: Word64) - UNIQUE_TAG_BITS +uNIQUE_BITS = 64 - UNIQUE_TAG_BITS {- Now come the functions which construct uniques from their pieces, and vice versa. @@ -137,6 +140,13 @@ newTagUnique u c = mkUnique c i where (_,i) = unpkUnique u uniqueMask :: Word64 uniqueMask = (1 `shiftL` uNIQUE_BITS) - 1 +-- | Put the character in the highest bits of the Word64. +-- This may truncate the character to UNIQUE_TAG_BITS. +-- This function is used in @`mkSplitUniqSupply`@ so that it can +-- precompute and share the tag part of the uniques it generates. +mkTag :: Char -> Word64 +mkTag c = fromIntegral @Int @Word64 (ord c) `shiftL` uNIQUE_BITS + -- pop the Char in the top 8 bits of the Unique(Supply) -- No 64-bit bugs here, as long as we have at least 32 bits. --JSM @@ -148,17 +158,20 @@ mkUnique :: Char -> Word64 -> Unique -- Builds a unique from pieces mkUnique c i = MkUnique (tag .|. bits) where - tag = fromIntegral (ord c) `shiftL` uNIQUE_BITS - bits = fromIntegral i .&. uniqueMask + tag = mkTag c + bits = i .&. uniqueMask mkUniqueInt :: Char -> Int -> Unique -mkUniqueInt c i = mkUnique c (fromIntegral i) +mkUniqueInt c i = mkUnique c (fromIntegral @Int @Word64 i) + +mkUniqueIntGrimily :: Int -> Unique +mkUniqueIntGrimily = MkUnique . fromIntegral @Int @Word64 unpkUnique (MkUnique u) = let - -- as long as the Char may have its eighth bit set, we - -- really do need the logical right-shift here! - tag = chr (fromIntegral (u `shiftR` uNIQUE_BITS)) + -- The potentially truncating use of fromIntegral here is safe + -- because the argument is just the tag bits after shifting. + tag = chr (fromIntegral @Word64 @Int (u `shiftR` uNIQUE_BITS)) i = u .&. uniqueMask in (tag, i) @@ -188,10 +201,10 @@ hasKey :: Uniquable a => a -> Unique -> Bool x `hasKey` k = getUnique x == k instance Uniquable FastString where - getUnique fs = mkUniqueGrimily (fromIntegral (uniqueOfFS fs)) + getUnique fs = mkUniqueIntGrimily (uniqueOfFS fs) instance Uniquable Int where - getUnique i = mkUniqueGrimily (fromIntegral i) + getUnique i = mkUniqueIntGrimily i instance Uniquable Word64 where getUnique i = MkUnique i @@ -319,11 +332,13 @@ Code stolen from Lennart. w64ToBase62 :: Word64 -> String w64ToBase62 n_ = go n_ "" where + -- The uses of potentially truncating uses fromIntegral here are safe + -- because the argument is guaranteed to be less than 62 in both cases. go n cs | n < 62 - = let !c = chooseChar62 (fromIntegral n) in c : cs + = let !c = chooseChar62 (fromIntegral @Word64 @Int n) in c : cs | otherwise = go q (c : cs) where (!q, r) = quotRem n 62 - !c = chooseChar62 (fromIntegral r) + !c = chooseChar62 (fromIntegral @Word64 @Int r) chooseChar62 :: Int -> Char {-# INLINE chooseChar62 #-} ===================================== compiler/GHC/Types/Unique/Supply.hs ===================================== @@ -39,7 +39,6 @@ import GHC.IO import GHC.Utils.Monad import Control.Monad -import Data.Char import Data.Word import GHC.Exts( Ptr(..), noDuplicate#, oneShot ) import Foreign.Storable @@ -214,7 +213,7 @@ mkSplitUniqSupply c = unsafeDupableInterleaveIO (IO mk_supply) where - !mask = fromIntegral (ord c) `unsafeShiftL` uNIQUE_BITS + !mask = mkTag c -- Here comes THE MAGIC: see Note [How the unique supply works] -- This is one of the most hammered bits in the whole compiler ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -37,7 +37,7 @@ module GHC.Utils.Outputable ( spaceIfSingleQuote, isEmpty, nest, ptext, - int, intWithCommas, integer, word, float, double, rational, doublePrec, + int, intWithCommas, integer, word64, word, float, double, rational, doublePrec, parens, cparen, brackets, braces, quotes, quote, doubleQuotes, angleBrackets, semi, comma, colon, dcolon, space, equals, dot, vbar, @@ -681,6 +681,7 @@ ptext :: PtrString -> SDoc int :: IsLine doc => Int -> doc integer :: IsLine doc => Integer -> doc word :: Integer -> SDoc +word64 :: IsLine doc => Word64 -> doc float :: IsLine doc => Float -> doc double :: IsLine doc => Double -> doc rational :: Rational -> SDoc @@ -698,6 +699,8 @@ double n = text $ show n {-# INLINE CONLIKE rational #-} rational n = text $ show n -- See Note [Print Hexadecimal Literals] in GHC.Utils.Ppr +{-# INLINE CONLIKE word64 #-} +word64 n = text $ show n {-# INLINE CONLIKE word #-} word n = sdocOption sdocHexWordLiterals $ \case True -> docToSDoc $ Pretty.hex n View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3bfe5e88eca197c7a9d9f9c46717a1c31c13aaaf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3bfe5e88eca197c7a9d9f9c46717a1c31c13aaaf You're receiving 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 Jun 28 12:20:06 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Wed, 28 Jun 2023 08:20:06 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/pattern-@a-binders] 12 commits: Support large stack frames/offsets in GHCi bytecode interpreter Message-ID: <649c257632be8_3b5ae2cb4f8198683@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/pattern- at a-binders at Glasgow Haskell Compiler / GHC Commits: 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - 490152d9 by Andrei Borzenkov at 2023-06-28T16:18:53+04:00 Draft: Type patterns (22478, 18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - 06a901f0 by Andrei Borzenkov at 2023-06-28T16:18:53+04:00 Add more notes and comments to the patch - - - - - 30 changed files: - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - compiler/GHC/Builtin/Types.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Breakpoints.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Quote.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/532c915d2b462780e1811ac31c3b78cdca7328a3...06a901f0a8b045f198005c6d539957074e6956e1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/532c915d2b462780e1811ac31c3b78cdca7328a3...06a901f0a8b045f198005c6d539957074e6956e1 You're receiving 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 Jun 28 12:22:59 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Wed, 28 Jun 2023 08:22:59 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/pattern-@a-binders] Add more notes and comments to the patch Message-ID: <649c26233e0f_3b5ae2cb4f82012c3@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/pattern- at a-binders at Glasgow Haskell Compiler / GHC Commits: 94791a61 by Andrei Borzenkov at 2023-06-28T16:22:39+04:00 Add more notes and comments to the patch - - - - - 10 changed files: - compiler/GHC/Hs/Type.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/HsType.hs - testsuite/tests/gadt/T18191.stderr - testsuite/tests/rename/should_fail/T22478b.stderr - testsuite/tests/rename/should_fail/T7943.stderr - testsuite/tests/rename/should_fail/T9077.stderr Changes: ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -37,7 +37,7 @@ module GHC.Hs.Type ( HsOuterTyVarBndrs(..), HsOuterFamEqnTyVarBndrs, HsOuterSigTyVarBndrs, HsWildCardBndrs(..), HsPatSigType(..), HsPSRn(..), - HsTyPat(..), HsTyPatRn(..), isTyPatBndr, + HsTyPat(..), HsTyPatRn(..), tyPatToBndr, HsSigType(..), LHsSigType, LHsSigWcType, LHsWcType, HsTupleSort(..), HsContext, LHsContext, fromMaybeContext, @@ -222,7 +222,7 @@ type instance XHsPS GhcTc = HsPSRn type instance XHsTP GhcPs = EpAnnCO type instance XHsTP GhcRn = HsTyPatRn -type instance XHsTP GhcTc = HsTyPatRn +type instance XHsTP GhcTc = DataConCantHappen -- | The extension field for 'HsPatSigType', which is only used in the -- renamer onwards. See @Note [Pattern signature binders and scoping]@. @@ -240,8 +240,8 @@ data HsTyPatRn = HsTPRn deriving Data -- See Note [Type patterns: binders and unifiers] -isTyPatBndr :: HsTyPat GhcRn -> Maybe (HsTyVarBndr () GhcRn) -isTyPatBndr HsTP{hstp_body = (L _ hs_ty)} = go hs_ty where +tyPatToBndr :: HsTyPat GhcRn -> Maybe (HsTyVarBndr () GhcRn) +tyPatToBndr HsTP{hstp_body = (L _ hs_ty)} = go hs_ty where go :: HsType GhcRn -> Maybe (HsTyVarBndr () GhcRn) go (HsParTy _ (L _ ty)) = go ty go (HsTyVar an _ name) ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -555,7 +555,9 @@ rnHsTyKi env ty@(HsRecTy _ flds) get_fields ctxt = err ctxt err ctxt = - do { addErr $ TcRnIllegalRecordSyntax (Just ctxt) (Left ty) + do { addErr $ + TcRnWithHsDocContext ctxt $ + TcRnIllegalRecordSyntax (Left ty) ; return [] } rnHsTyKi env (HsFunTy u mult ty1 ty2) ===================================== compiler/GHC/Rename/Pat.hs ===================================== @@ -1109,6 +1109,10 @@ rnHsTyPat ctxt sigType = case sigType of , hstp_ext = buildHsTyPatRn tpb } +-- | Type pattern renaming monad +-- For the OccSet in the ReaderT, see Note [Locally bound names in type patterns] +-- For the HsTyPatRnBuilderRn in the WriterT, see Note [Implicit and explicit type variable binders] +-- For the CpsRn base monad, see Note [CpsRn monad] newtype TPRnM a = MkTPRnM (ReaderT (HsDocContext, OccSet) (WriterT HsTyPatRnBuilder CpsRn) a) deriving newtype (Functor, Applicative, Monad) @@ -1164,6 +1168,8 @@ lookupTypeOccTPRnM rdr_name = liftRnFV $ do name <- lookupTypeOccRn rdr_name pure (name, unitFV name) +-- | A variant of HsTyPatRn that uses difference lists for efficient concatenation. +-- See Note [Implicit and explicit type variable binders] data HsTyPatRnBuilder = HsTPRnB { hstpb_nwcs :: [Name] -> [Name], @@ -1204,7 +1210,8 @@ rn_lty_pat (L l hs_ty) = do rn_ty_pat_var :: LocatedN RdrName -> TPRnM (LocatedN Name) rn_ty_pat_var lrdr@(L l rdr) = do locals <- askLocals - if isRdrTyVar rdr && not (elemOccSet (occName rdr) locals) + if isRdrTyVar rdr + && not (elemOccSet (occName rdr) locals) -- See Note [Locally bound names in type patterns] then do -- binder name <- liftTPRnCps $ newPatName (LamMk True) lrdr @@ -1215,6 +1222,10 @@ rn_ty_pat_var lrdr@(L l rdr) = do name <- lookupTypeOccTPRnM rdr pure (L l name) +-- | Rename type patterns +-- +-- For the difference between `rn_ty_pat` and `rnHsTyKi` see Note [CpsRn monad] +-- and Note [Implicit and explicit type variable binders] rn_ty_pat :: HsType GhcPs -> TPRnM (HsType GhcRn) rn_ty_pat (HsTyVar an prom lrdr) = do name <- rn_ty_pat_var lrdr @@ -1227,7 +1238,7 @@ rn_ty_pat (HsForAllTy an tele body) = liftTPRnRaw $ \ctxt locals thing_inside -> locals' = locals `extendOccSetList` map occName tele_names unTPRnRaw (rn_lty_pat body) ctxt locals' $ \(body', tpb) -> - delLocalNames tele_names $ + delLocalNames tele_names $ -- locally bound names do not scope over the continuation thing_inside ((HsForAllTy an tele' body'), tpb) rn_ty_pat (HsQualTy an lctx body) = do @@ -1322,13 +1333,18 @@ rn_ty_pat (HsSpliceTy _ splice) = do | otherwise = lhs_ty rn_ty_pat (HsBangTy an bang_src lty) = do + ctxt <- askDocContext lty'@(L _ ty') <- rn_lty_pat lty - liftRn $ addErr $ TcRnUnexpectedAnnotation ty' bang_src + liftRn $ addErr $ + TcRnWithHsDocContext ctxt $ + TcRnUnexpectedAnnotation ty' bang_src pure (HsBangTy an bang_src lty') rn_ty_pat ty at HsRecTy{} = do ctxt <- askDocContext - liftRn $ addErr $ TcRnIllegalRecordSyntax (Just ctxt) (Left ty) + liftRn $ addErr $ + TcRnWithHsDocContext ctxt $ + TcRnIllegalRecordSyntax (Left ty) pure (HsWildCardTy noExtField) -- trick to avoid `failWithTc` rn_ty_pat ty@(XHsType{}) = do @@ -1341,3 +1357,44 @@ rn_ty_pat_arrow (HsLinearArrow (HsPct1 pct1 arr)) = pure (HsLinearArrow (HsPct1 rn_ty_pat_arrow (HsLinearArrow (HsLolly arr)) = pure (HsLinearArrow (HsLolly arr)) rn_ty_pat_arrow (HsExplicitMult pct p arr) = rn_lty_pat p <&> (\mult -> HsExplicitMult pct mult arr) + + +{- Note [Locally bound names in type patterns] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Type patterns can bind local names using forall. Compare the following examples: + f (Proxy @(Either a b)) = ... + g (Proxy @(forall a . Either a b)) = ... + +In `f` both `a` and `b` are bound by the pattern and scope over the RHS of f. +In `g` only `b` is bound by the pattern, whereas `a` is locally bound in the pattern +and does not scope over the RHS of `g`. + +We track locally bound names in the `OccSet` in `TPRnM` monad, and use it to +decide whether occurences of type variables are usages or bindings. + +The check is done in `rn_ty_pat_var` + +Note [Implicit and explicit type variable binders] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Type patterns are renamed differently from ordinary types. + * Types are renamed by `rnHsType` where all type variable occurences are considered usages + * Type patterns are renamed by `rnHsTyPat` where some type variable occurences are usages + and other are bindings + +Here is an example: + {-# LANGUAGE ScopedTypeVariables #-} + f :: forall b. Proxy _ -> ... + f (Proxy @(x :: (a, b))) = ... + +In the (x :: (a,b)) type pattern + * `x` is a type variable explicitly bound by type pattern + * `a` is a type variable implicitly bound in a pattern signature + * `b` is a usage of type variable bound by the outer forall + +This classification is clear to us in `rnHsTyPat`, but it is also useful in later passes, such +as `collectPatBinders` and `tcHsTyPat`, so we store it in the extension field of `HsTyPat`, namely +`HsTyPatRn`. + +To collect lists of those variables efficiently we use `HsTyPatRnBuilder` which is exactly like +`HsTyPatRn`, but uses difference lists. +-} ===================================== compiler/GHC/Tc/Errors/Ppr.hs ===================================== @@ -983,13 +983,9 @@ instance Diagnostic TcRnMessage where HsSrcBang _ _ _ -> "strictness" in text "Unexpected" <+> text err <+> text "annotation:" <+> ppr ty $$ text err <+> text "annotation cannot appear nested inside a type" - TcRnIllegalRecordSyntax m_ctxt either_ty_ty - -> mkSimpleDecorated $ case m_ctxt of - Nothing -> + TcRnIllegalRecordSyntax either_ty_ty + -> mkSimpleDecorated $ text "Record syntax is illegal here:" <+> either ppr ppr either_ty_ty - Just ctxt -> - text "Illegal record syntax" <+> either ppr ppr either_ty_ty - $$ inHsDocContext ctxt TcRnInvalidVisibleKindArgument arg ty -> mkSimpleDecorated $ ===================================== compiler/GHC/Tc/Errors/Types.hs ===================================== @@ -500,6 +500,8 @@ data TcRnMessage where rename/should_fail/T2723 rename/should_compile/T3262 driver/werror + rename/should_fail/T22478d + typecheck/should_fail/TyAppPat_ScopedTyVarConflict -} TcRnShadowedName :: OccName -> ShadowedNameProvenance -> TcRnMessage @@ -2201,6 +2203,7 @@ data TcRnMessage where Test cases: parser/should_fail/unpack_inside_type typecheck/should_fail/T7210 + rename/should_fail/T22478b -} TcRnUnexpectedAnnotation :: !(HsType GhcRn) -> !HsSrcBang -> TcRnMessage @@ -2211,8 +2214,9 @@ data TcRnMessage where Test cases: rename/should_fail/T7943 rename/should_fail/T9077 + rename/should_fail/T22478b -} - TcRnIllegalRecordSyntax :: Maybe HsDocContext -> Either (HsType GhcPs) (HsType GhcRn) -> TcRnMessage + TcRnIllegalRecordSyntax :: Either (HsType GhcPs) (HsType GhcRn) -> TcRnMessage {-| TcRnInvalidVisibleKindArgument is an error for a kind application on a target type that cannot accept it. @@ -4011,7 +4015,9 @@ data TcRnMessage where Test cases: dsrun006, mdofail002, mdofail003, mod23, mod24, qq006, rnfail001, - rnfail004, SimpleFail6, T14114, T16110_Fail1, tcfail038, TH_spliceD1 + rnfail004, SimpleFail6, T14114, T16110_Fail1, tcfail038, TH_spliceD1, + T22478b, TyAppPat_NonlinearMultiAppPat, TyAppPat_NonlinearMultiPat, + TyAppPat_NonlinearSinglePat, -} TcRnBindingNameConflict :: !RdrName -- ^ The conflicting name -> !(NE.NonEmpty SrcSpan) ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -1147,7 +1147,7 @@ tc_hs_type _ ty@(HsBangTy _ bang _) _ tc_hs_type _ ty@(HsRecTy {}) _ -- Record types (which only show up temporarily in constructor -- signatures) should have been removed by now - = failWithTc $ TcRnIllegalRecordSyntax Nothing (Right ty) + = failWithTc $ TcRnIllegalRecordSyntax (Right ty) -- HsSpliced is an annotation produced by 'GHC.Rename.Splice.rnSpliceType'. -- Here we get rid of it and add the finalizers to the global environment @@ -4156,18 +4156,39 @@ tcHsPatSigType ctxt hole_mode ctxt_kind = tc_type_in_pat ctxt hole_mode hs_ty sig_wcs sig_ns ctxt_kind + +-- Type check type patterns. This is different from `tcHsPatSigType` +-- in that we give special treatment to simple binders like +-- `@a` or `@(a :: k)` allowing them to have polymorphic kinds (#18986) +-- +-- See Note [Type patterns: binders and unifiers] in GHC.Hs.Type tcHsTyPat :: HsTyPat GhcRn -- The type pattern -> Kind -- What kind is expected -> TcM ( [(Name, TcTyVar)] -- Wildcards , [(Name, TcTyVar)] -- The new bit of type environment, binding -- the scoped type variables , TcType) -- The type -tcHsTyPat hs_pat@(HsTP{hstp_ext = bndrs}) expected_kind - | Just bndr <- isTyPatBndr hs_pat -- See Note [Type patterns: binders and unifiers] in GHC.Hs.Type - - , HsTPRn { hstp_nwcs = wcs, hstp_imp_tvs = imp_ns} <- bndrs - = do - traceTc "tcHsTyPat 1" (ppr expected_kind) +tcHsTyPat hs_pat@(HsTP{hstp_ext = hstp_rn, hstp_body = hs_ty}) expected_kind + = case tyPatToBndr hs_pat of + Nothing -> tc_unif_in_pat hs_ty wcs all_ns (TheKind expected_kind) + Just bndr -> tc_bndr_in_pat bndr wcs imp_ns expected_kind + where + all_ns = imp_ns ++ exp_ns + HsTPRn{hstp_nwcs = wcs, hstp_imp_tvs = imp_ns, hstp_exp_tvs = exp_ns} = hstp_rn + tc_unif_in_pat = tc_type_in_pat TypeAppCtxt HM_TyAppPat + +-- `tc_bndr_in_pat` is used in type patterns to handle the binders case. +-- See Note [Type patterns: binders and unifiers] in GHC.Hs.Type +tc_bndr_in_pat :: HsTyVarBndr flag GhcRn + -> [Name] -- All named wildcards in type + -> [Name] -- Implicit (but not explicit) binders in type + -> Kind -- Expected kind + -> TcM ( [(Name, TcTyVar)] -- Wildcards + , [(Name, TcTyVar)] -- The new bit of type environment, binding + -- the scoped type variables + , TcType) -- The type +tc_bndr_in_pat bndr wcs imp_ns expected_kind = do + traceTc "tc_bndr_in_pat 1" (ppr expected_kind) case bndr of UserTyVar _ _ (L _ name) -> do tv <- newPatTyVar name expected_kind @@ -4175,7 +4196,7 @@ tcHsTyPat hs_pat@(HsTP{hstp_ext = bndrs}) expected_kind KindedTyVar _ _ (L _ name) ki -> do tkv_prs <- mapM new_implicit_tv imp_ns wcs <- addTypeCtxt ki $ - solveEqualities "tcHsTyPat" $ + solveEqualities "tc_bndr_in_pat" $ -- See Note [Failure in local type signatures] -- and c.f #16033 bindNamedWildCardBinders wcs $ \ wcs -> @@ -4189,7 +4210,7 @@ tcHsTyPat hs_pat@(HsTP{hstp_ext = bndrs}) expected_kind tv <- newPatTyVar name expected_kind - traceTc "tcHsTyPat 2" $ vcat + traceTc "tc_bndr_in_pat 2" $ vcat [ text "expected_kind" <+> ppr expected_kind , text "wcs" <+> ppr wcs , text "(name,tv)" <+> ppr (name,tv) @@ -4203,13 +4224,10 @@ tcHsTyPat hs_pat@(HsTP{hstp_ext = bndrs}) expected_kind -- NB: tv's Name is fresh ; return (name, tv) } -tcHsTyPat - (HsTP { hstp_ext = HsTPRn wcs imp_ns exp_ns - , hstp_body = hs_ty }) - ki - = tc_type_in_pat TypeAppCtxt HM_TyAppPat hs_ty wcs (imp_ns ++ exp_ns) (TheKind ki) - - +-- * In type patterns `tc_type_in_pat` is used to handle the unifiers case. +-- See Note [Type patterns: binders and unifiers] in GHC.Hs.Type +-- +-- * In patterns `tc_type_in_pat` is used to check pattern signatures. tc_type_in_pat :: UserTypeCtxt -> HoleMode -- HM_Sig when in a SigPat, HM_TyAppPat when in a ConPat checking type applications. -> LHsType GhcRn -- The type in pattern ===================================== testsuite/tests/gadt/T18191.stderr ===================================== @@ -16,13 +16,13 @@ T18191.hs:15:21: error: [GHC-71492] • In the definition of data constructor ‘MkZ1’ T18191.hs:15:31: error: [GHC-89246] - Illegal record syntax {unZ1 :: (a, b)} - In the definition of data constructor ‘MkZ1’ + • Record syntax is illegal here: {unZ1 :: (a, b)} + • In the definition of data constructor ‘MkZ1’ T18191.hs:16:19: error: [GHC-71492] • GADT constructor type signature cannot contain nested ‘forall’s or contexts • In the definition of data constructor ‘MkZ2’ T18191.hs:16:27: error: [GHC-89246] - Illegal record syntax {unZ1 :: (a, b)} - In the definition of data constructor ‘MkZ2’ + • Record syntax is illegal here: {unZ1 :: (a, b)} + • In the definition of data constructor ‘MkZ2’ ===================================== testsuite/tests/rename/should_fail/T22478b.stderr ===================================== @@ -6,15 +6,16 @@ T22478b.hs:14:14: error: [GHC-10498] • In an equation for ‘fOutOfOrder’ T22478b.hs:16:10: error: [GHC-18932] - Unexpected strictness annotation: Int - strictness annotation cannot appear nested inside a type + • Unexpected strictness annotation: Int + strictness annotation cannot appear nested inside a type + • In a type argument in a pattern T22478b.hs:19:54: error: [GHC-76037] Not in scope: type variable ‘a’ T22478b.hs:21:12: error: [GHC-89246] - Illegal record syntax {fld :: Int} - In a type argument in a pattern + • Record syntax is illegal here: {fld :: Int} + • In a type argument in a pattern T22478b.hs:23:21: error: [GHC-10498] • Conflicting definitions for ‘a’ ===================================== testsuite/tests/rename/should_fail/T7943.stderr ===================================== @@ -1,4 +1,4 @@ T7943.hs:4:21: error: [GHC-89246] - Illegal record syntax {bar :: String} - In the definition of data constructor ‘B’ + • Record syntax is illegal here: {bar :: String} + • In the definition of data constructor ‘B’ ===================================== testsuite/tests/rename/should_fail/T9077.stderr ===================================== @@ -1,4 +1,4 @@ T9077.hs:3:12: error: [GHC-89246] - Illegal record syntax {} - In the type signature for ‘main’ + • Record syntax is illegal here: {} + • In the type signature for ‘main’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/94791a6126351f76240c7f76448bb22886f866ef -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/94791a6126351f76240c7f76448bb22886f866ef You're receiving 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 Jun 28 13:46:29 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Wed, 28 Jun 2023 09:46:29 -0400 Subject: [Git][ghc/ghc][wip/T23496] Draft: Split GHC.Generics into two modules Message-ID: <649c39b54176f_3b5ae2c763c227446@gitlab.mail> Ryan Scott pushed to branch wip/T23496 at Glasgow Haskell Compiler / GHC Commits: 1e741c96 by Ryan Scott at 2023-06-28T09:43:48-04:00 Draft: Split GHC.Generics into two modules Most of `GHC.Generics` has now been moved to `GHC.Generics.Internal`, which `GHC.Generics` re-exports. The only things now defined in `GHC.Generics` are the derived `Generic(1)` instances. These need to be put in a different module because of GHC's new approach to dependency analysis, which is perfectly within its rights to typecheck a derived `Generic` instance before it typechecks any of the definitions that are referenced in the generated code. Putting the definitions in a separate module from the derived `Generic` instances is a sure-fire way to ensure that this doesn't happen. Unfortunately, this uncovers another issue when building `Cabal-syntax`: ``` libraries/Cabal/Cabal-syntax/src/Distribution/Compat/Prelude.hs:279:21: error: [GHC-88464] Variable not in scope: from :: a -> f0 a0 Suggested fix: Add ‘from’ to the import list in the import of ‘GHC.Generics’ (at libraries/Cabal/Cabal-syntax/src/Distribution/Compat/Prelude.hs:251:1-105). | 279 | genericRnf = grnf . from | ^^^^ ``` See https://gitlab.haskell.org/ghc/ghc/-/issues/23496#note_507555. - - - - - 4 changed files: - compiler/GHC/Builtin/Names.hs - libraries/base/GHC/Generics.hs - + libraries/base/GHC/Generics/Internal.hs - libraries/base/base.cabal Changes: ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -548,7 +548,7 @@ pRELUDE :: Module pRELUDE = mkBaseModule_ pRELUDE_NAME gHC_PRIM, gHC_PRIM_PANIC, - gHC_TYPES, gHC_GENERICS, gHC_MAGIC, gHC_MAGIC_DICT, + gHC_TYPES, gHC_GENERICS_INTERNAL, gHC_MAGIC, gHC_MAGIC_DICT, gHC_CLASSES, gHC_PRIMOPWRAPPERS, gHC_BASE, gHC_ENUM, gHC_GHCI, gHC_GHCI_HELPERS, gHC_CSTRING, gHC_SHOW, gHC_READ, gHC_NUM, gHC_MAYBE, @@ -623,7 +623,7 @@ rANDOM = mkBaseModule (fsLit "System.Random") gHC_EXTS = mkBaseModule (fsLit "GHC.Exts") gHC_IS_LIST = mkBaseModule (fsLit "GHC.IsList") cONTROL_EXCEPTION_BASE = mkBaseModule (fsLit "Control.Exception.Base") -gHC_GENERICS = mkBaseModule (fsLit "GHC.Generics") +gHC_GENERICS_INTERNAL = mkBaseModule (fsLit "GHC.Generics.Internal") gHC_TYPEERROR = mkBaseModule (fsLit "GHC.TypeError") gHC_TYPELITS = mkBaseModule (fsLit "GHC.TypeLits") gHC_TYPELITS_INTERNAL = mkBaseModule (fsLit "GHC.TypeLits.Internal") @@ -860,56 +860,56 @@ u1DataCon_RDR, par1DataCon_RDR, rec1DataCon_RDR, uAddrHash_RDR, uCharHash_RDR, uDoubleHash_RDR, uFloatHash_RDR, uIntHash_RDR, uWordHash_RDR :: RdrName -u1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "U1") -par1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "Par1") -rec1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "Rec1") -k1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "K1") -m1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "M1") - -l1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "L1") -r1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "R1") - -prodDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit ":*:") -comp1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "Comp1") - -unPar1_RDR = fieldQual_RDR gHC_GENERICS (fsLit "Par1") (fsLit "unPar1") -unRec1_RDR = fieldQual_RDR gHC_GENERICS (fsLit "Rec1") (fsLit "unRec1") -unK1_RDR = fieldQual_RDR gHC_GENERICS (fsLit "K1") (fsLit "unK1") -unComp1_RDR = fieldQual_RDR gHC_GENERICS (fsLit "Comp1") (fsLit "unComp1") - -from_RDR = varQual_RDR gHC_GENERICS (fsLit "from") -from1_RDR = varQual_RDR gHC_GENERICS (fsLit "from1") -to_RDR = varQual_RDR gHC_GENERICS (fsLit "to") -to1_RDR = varQual_RDR gHC_GENERICS (fsLit "to1") - -datatypeName_RDR = varQual_RDR gHC_GENERICS (fsLit "datatypeName") -moduleName_RDR = varQual_RDR gHC_GENERICS (fsLit "moduleName") -packageName_RDR = varQual_RDR gHC_GENERICS (fsLit "packageName") -isNewtypeName_RDR = varQual_RDR gHC_GENERICS (fsLit "isNewtype") -selName_RDR = varQual_RDR gHC_GENERICS (fsLit "selName") -conName_RDR = varQual_RDR gHC_GENERICS (fsLit "conName") -conFixity_RDR = varQual_RDR gHC_GENERICS (fsLit "conFixity") -conIsRecord_RDR = varQual_RDR gHC_GENERICS (fsLit "conIsRecord") - -prefixDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "Prefix") -infixDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "Infix") +u1DataCon_RDR = dataQual_RDR gHC_GENERICS_INTERNAL (fsLit "U1") +par1DataCon_RDR = dataQual_RDR gHC_GENERICS_INTERNAL (fsLit "Par1") +rec1DataCon_RDR = dataQual_RDR gHC_GENERICS_INTERNAL (fsLit "Rec1") +k1DataCon_RDR = dataQual_RDR gHC_GENERICS_INTERNAL (fsLit "K1") +m1DataCon_RDR = dataQual_RDR gHC_GENERICS_INTERNAL (fsLit "M1") + +l1DataCon_RDR = dataQual_RDR gHC_GENERICS_INTERNAL (fsLit "L1") +r1DataCon_RDR = dataQual_RDR gHC_GENERICS_INTERNAL (fsLit "R1") + +prodDataCon_RDR = dataQual_RDR gHC_GENERICS_INTERNAL (fsLit ":*:") +comp1DataCon_RDR = dataQual_RDR gHC_GENERICS_INTERNAL (fsLit "Comp1") + +unPar1_RDR = fieldQual_RDR gHC_GENERICS_INTERNAL (fsLit "Par1") (fsLit "unPar1") +unRec1_RDR = fieldQual_RDR gHC_GENERICS_INTERNAL (fsLit "Rec1") (fsLit "unRec1") +unK1_RDR = fieldQual_RDR gHC_GENERICS_INTERNAL (fsLit "K1") (fsLit "unK1") +unComp1_RDR = fieldQual_RDR gHC_GENERICS_INTERNAL (fsLit "Comp1") (fsLit "unComp1") + +from_RDR = varQual_RDR gHC_GENERICS_INTERNAL (fsLit "from") +from1_RDR = varQual_RDR gHC_GENERICS_INTERNAL (fsLit "from1") +to_RDR = varQual_RDR gHC_GENERICS_INTERNAL (fsLit "to") +to1_RDR = varQual_RDR gHC_GENERICS_INTERNAL (fsLit "to1") + +datatypeName_RDR = varQual_RDR gHC_GENERICS_INTERNAL (fsLit "datatypeName") +moduleName_RDR = varQual_RDR gHC_GENERICS_INTERNAL (fsLit "moduleName") +packageName_RDR = varQual_RDR gHC_GENERICS_INTERNAL (fsLit "packageName") +isNewtypeName_RDR = varQual_RDR gHC_GENERICS_INTERNAL (fsLit "isNewtype") +selName_RDR = varQual_RDR gHC_GENERICS_INTERNAL (fsLit "selName") +conName_RDR = varQual_RDR gHC_GENERICS_INTERNAL (fsLit "conName") +conFixity_RDR = varQual_RDR gHC_GENERICS_INTERNAL (fsLit "conFixity") +conIsRecord_RDR = varQual_RDR gHC_GENERICS_INTERNAL (fsLit "conIsRecord") + +prefixDataCon_RDR = dataQual_RDR gHC_GENERICS_INTERNAL (fsLit "Prefix") +infixDataCon_RDR = dataQual_RDR gHC_GENERICS_INTERNAL (fsLit "Infix") leftAssocDataCon_RDR = nameRdrName leftAssociativeDataConName rightAssocDataCon_RDR = nameRdrName rightAssociativeDataConName notAssocDataCon_RDR = nameRdrName notAssociativeDataConName -uAddrDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "UAddr") -uCharDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "UChar") -uDoubleDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "UDouble") -uFloatDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "UFloat") -uIntDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "UInt") -uWordDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "UWord") +uAddrDataCon_RDR = dataQual_RDR gHC_GENERICS_INTERNAL (fsLit "UAddr") +uCharDataCon_RDR = dataQual_RDR gHC_GENERICS_INTERNAL (fsLit "UChar") +uDoubleDataCon_RDR = dataQual_RDR gHC_GENERICS_INTERNAL (fsLit "UDouble") +uFloatDataCon_RDR = dataQual_RDR gHC_GENERICS_INTERNAL (fsLit "UFloat") +uIntDataCon_RDR = dataQual_RDR gHC_GENERICS_INTERNAL (fsLit "UInt") +uWordDataCon_RDR = dataQual_RDR gHC_GENERICS_INTERNAL (fsLit "UWord") -uAddrHash_RDR = fieldQual_RDR gHC_GENERICS (fsLit "UAddr") (fsLit "uAddr#") -uCharHash_RDR = fieldQual_RDR gHC_GENERICS (fsLit "UChar") (fsLit "uChar#") -uDoubleHash_RDR = fieldQual_RDR gHC_GENERICS (fsLit "UDouble") (fsLit "uDouble#") -uFloatHash_RDR = fieldQual_RDR gHC_GENERICS (fsLit "UFloat") (fsLit "uFloat#") -uIntHash_RDR = fieldQual_RDR gHC_GENERICS (fsLit "UInt") (fsLit "uInt#") -uWordHash_RDR = fieldQual_RDR gHC_GENERICS (fsLit "UWord") (fsLit "uWord#") +uAddrHash_RDR = fieldQual_RDR gHC_GENERICS_INTERNAL (fsLit "UAddr") (fsLit "uAddr#") +uCharHash_RDR = fieldQual_RDR gHC_GENERICS_INTERNAL (fsLit "UChar") (fsLit "uChar#") +uDoubleHash_RDR = fieldQual_RDR gHC_GENERICS_INTERNAL (fsLit "UDouble") (fsLit "uDouble#") +uFloatHash_RDR = fieldQual_RDR gHC_GENERICS_INTERNAL (fsLit "UFloat") (fsLit "uFloat#") +uIntHash_RDR = fieldQual_RDR gHC_GENERICS_INTERNAL (fsLit "UInt") (fsLit "uInt#") +uWordHash_RDR = fieldQual_RDR gHC_GENERICS_INTERNAL (fsLit "UWord") (fsLit "uWord#") fmap_RDR, replace_RDR, pure_RDR, ap_RDR, liftA2_RDR, foldable_foldr_RDR, foldMap_RDR, null_RDR, all_RDR, traverse_RDR, mempty_RDR, @@ -991,57 +991,57 @@ v1TyConName, u1TyConName, par1TyConName, rec1TyConName, decidedLazyDataConName, decidedStrictDataConName, decidedUnpackDataConName, metaDataDataConName, metaConsDataConName, metaSelDataConName :: Name -v1TyConName = tcQual gHC_GENERICS (fsLit "V1") v1TyConKey -u1TyConName = tcQual gHC_GENERICS (fsLit "U1") u1TyConKey -par1TyConName = tcQual gHC_GENERICS (fsLit "Par1") par1TyConKey -rec1TyConName = tcQual gHC_GENERICS (fsLit "Rec1") rec1TyConKey -k1TyConName = tcQual gHC_GENERICS (fsLit "K1") k1TyConKey -m1TyConName = tcQual gHC_GENERICS (fsLit "M1") m1TyConKey - -sumTyConName = tcQual gHC_GENERICS (fsLit ":+:") sumTyConKey -prodTyConName = tcQual gHC_GENERICS (fsLit ":*:") prodTyConKey -compTyConName = tcQual gHC_GENERICS (fsLit ":.:") compTyConKey - -rTyConName = tcQual gHC_GENERICS (fsLit "R") rTyConKey -dTyConName = tcQual gHC_GENERICS (fsLit "D") dTyConKey -cTyConName = tcQual gHC_GENERICS (fsLit "C") cTyConKey -sTyConName = tcQual gHC_GENERICS (fsLit "S") sTyConKey - -rec0TyConName = tcQual gHC_GENERICS (fsLit "Rec0") rec0TyConKey -d1TyConName = tcQual gHC_GENERICS (fsLit "D1") d1TyConKey -c1TyConName = tcQual gHC_GENERICS (fsLit "C1") c1TyConKey -s1TyConName = tcQual gHC_GENERICS (fsLit "S1") s1TyConKey - -repTyConName = tcQual gHC_GENERICS (fsLit "Rep") repTyConKey -rep1TyConName = tcQual gHC_GENERICS (fsLit "Rep1") rep1TyConKey - -uRecTyConName = tcQual gHC_GENERICS (fsLit "URec") uRecTyConKey -uAddrTyConName = tcQual gHC_GENERICS (fsLit "UAddr") uAddrTyConKey -uCharTyConName = tcQual gHC_GENERICS (fsLit "UChar") uCharTyConKey -uDoubleTyConName = tcQual gHC_GENERICS (fsLit "UDouble") uDoubleTyConKey -uFloatTyConName = tcQual gHC_GENERICS (fsLit "UFloat") uFloatTyConKey -uIntTyConName = tcQual gHC_GENERICS (fsLit "UInt") uIntTyConKey -uWordTyConName = tcQual gHC_GENERICS (fsLit "UWord") uWordTyConKey - -prefixIDataConName = dcQual gHC_GENERICS (fsLit "PrefixI") prefixIDataConKey -infixIDataConName = dcQual gHC_GENERICS (fsLit "InfixI") infixIDataConKey -leftAssociativeDataConName = dcQual gHC_GENERICS (fsLit "LeftAssociative") leftAssociativeDataConKey -rightAssociativeDataConName = dcQual gHC_GENERICS (fsLit "RightAssociative") rightAssociativeDataConKey -notAssociativeDataConName = dcQual gHC_GENERICS (fsLit "NotAssociative") notAssociativeDataConKey - -sourceUnpackDataConName = dcQual gHC_GENERICS (fsLit "SourceUnpack") sourceUnpackDataConKey -sourceNoUnpackDataConName = dcQual gHC_GENERICS (fsLit "SourceNoUnpack") sourceNoUnpackDataConKey -noSourceUnpackednessDataConName = dcQual gHC_GENERICS (fsLit "NoSourceUnpackedness") noSourceUnpackednessDataConKey -sourceLazyDataConName = dcQual gHC_GENERICS (fsLit "SourceLazy") sourceLazyDataConKey -sourceStrictDataConName = dcQual gHC_GENERICS (fsLit "SourceStrict") sourceStrictDataConKey -noSourceStrictnessDataConName = dcQual gHC_GENERICS (fsLit "NoSourceStrictness") noSourceStrictnessDataConKey -decidedLazyDataConName = dcQual gHC_GENERICS (fsLit "DecidedLazy") decidedLazyDataConKey -decidedStrictDataConName = dcQual gHC_GENERICS (fsLit "DecidedStrict") decidedStrictDataConKey -decidedUnpackDataConName = dcQual gHC_GENERICS (fsLit "DecidedUnpack") decidedUnpackDataConKey - -metaDataDataConName = dcQual gHC_GENERICS (fsLit "MetaData") metaDataDataConKey -metaConsDataConName = dcQual gHC_GENERICS (fsLit "MetaCons") metaConsDataConKey -metaSelDataConName = dcQual gHC_GENERICS (fsLit "MetaSel") metaSelDataConKey +v1TyConName = tcQual gHC_GENERICS_INTERNAL (fsLit "V1") v1TyConKey +u1TyConName = tcQual gHC_GENERICS_INTERNAL (fsLit "U1") u1TyConKey +par1TyConName = tcQual gHC_GENERICS_INTERNAL (fsLit "Par1") par1TyConKey +rec1TyConName = tcQual gHC_GENERICS_INTERNAL (fsLit "Rec1") rec1TyConKey +k1TyConName = tcQual gHC_GENERICS_INTERNAL (fsLit "K1") k1TyConKey +m1TyConName = tcQual gHC_GENERICS_INTERNAL (fsLit "M1") m1TyConKey + +sumTyConName = tcQual gHC_GENERICS_INTERNAL (fsLit ":+:") sumTyConKey +prodTyConName = tcQual gHC_GENERICS_INTERNAL (fsLit ":*:") prodTyConKey +compTyConName = tcQual gHC_GENERICS_INTERNAL (fsLit ":.:") compTyConKey + +rTyConName = tcQual gHC_GENERICS_INTERNAL (fsLit "R") rTyConKey +dTyConName = tcQual gHC_GENERICS_INTERNAL (fsLit "D") dTyConKey +cTyConName = tcQual gHC_GENERICS_INTERNAL (fsLit "C") cTyConKey +sTyConName = tcQual gHC_GENERICS_INTERNAL (fsLit "S") sTyConKey + +rec0TyConName = tcQual gHC_GENERICS_INTERNAL (fsLit "Rec0") rec0TyConKey +d1TyConName = tcQual gHC_GENERICS_INTERNAL (fsLit "D1") d1TyConKey +c1TyConName = tcQual gHC_GENERICS_INTERNAL (fsLit "C1") c1TyConKey +s1TyConName = tcQual gHC_GENERICS_INTERNAL (fsLit "S1") s1TyConKey + +repTyConName = tcQual gHC_GENERICS_INTERNAL (fsLit "Rep") repTyConKey +rep1TyConName = tcQual gHC_GENERICS_INTERNAL (fsLit "Rep1") rep1TyConKey + +uRecTyConName = tcQual gHC_GENERICS_INTERNAL (fsLit "URec") uRecTyConKey +uAddrTyConName = tcQual gHC_GENERICS_INTERNAL (fsLit "UAddr") uAddrTyConKey +uCharTyConName = tcQual gHC_GENERICS_INTERNAL (fsLit "UChar") uCharTyConKey +uDoubleTyConName = tcQual gHC_GENERICS_INTERNAL (fsLit "UDouble") uDoubleTyConKey +uFloatTyConName = tcQual gHC_GENERICS_INTERNAL (fsLit "UFloat") uFloatTyConKey +uIntTyConName = tcQual gHC_GENERICS_INTERNAL (fsLit "UInt") uIntTyConKey +uWordTyConName = tcQual gHC_GENERICS_INTERNAL (fsLit "UWord") uWordTyConKey + +prefixIDataConName = dcQual gHC_GENERICS_INTERNAL (fsLit "PrefixI") prefixIDataConKey +infixIDataConName = dcQual gHC_GENERICS_INTERNAL (fsLit "InfixI") infixIDataConKey +leftAssociativeDataConName = dcQual gHC_GENERICS_INTERNAL (fsLit "LeftAssociative") leftAssociativeDataConKey +rightAssociativeDataConName = dcQual gHC_GENERICS_INTERNAL (fsLit "RightAssociative") rightAssociativeDataConKey +notAssociativeDataConName = dcQual gHC_GENERICS_INTERNAL (fsLit "NotAssociative") notAssociativeDataConKey + +sourceUnpackDataConName = dcQual gHC_GENERICS_INTERNAL (fsLit "SourceUnpack") sourceUnpackDataConKey +sourceNoUnpackDataConName = dcQual gHC_GENERICS_INTERNAL (fsLit "SourceNoUnpack") sourceNoUnpackDataConKey +noSourceUnpackednessDataConName = dcQual gHC_GENERICS_INTERNAL (fsLit "NoSourceUnpackedness") noSourceUnpackednessDataConKey +sourceLazyDataConName = dcQual gHC_GENERICS_INTERNAL (fsLit "SourceLazy") sourceLazyDataConKey +sourceStrictDataConName = dcQual gHC_GENERICS_INTERNAL (fsLit "SourceStrict") sourceStrictDataConKey +noSourceStrictnessDataConName = dcQual gHC_GENERICS_INTERNAL (fsLit "NoSourceStrictness") noSourceStrictnessDataConKey +decidedLazyDataConName = dcQual gHC_GENERICS_INTERNAL (fsLit "DecidedLazy") decidedLazyDataConKey +decidedStrictDataConName = dcQual gHC_GENERICS_INTERNAL (fsLit "DecidedStrict") decidedStrictDataConKey +decidedUnpackDataConName = dcQual gHC_GENERICS_INTERNAL (fsLit "DecidedUnpack") decidedUnpackDataConKey + +metaDataDataConName = dcQual gHC_GENERICS_INTERNAL (fsLit "MetaData") metaDataDataConKey +metaConsDataConName = dcQual gHC_GENERICS_INTERNAL (fsLit "MetaCons") metaConsDataConKey +metaSelDataConName = dcQual gHC_GENERICS_INTERNAL (fsLit "MetaSel") metaSelDataConKey -- Primitive Int divIntName, modIntName :: Name @@ -1526,12 +1526,12 @@ readClassName = clsQual gHC_READ (fsLit "Read") readClassKey -- Classes Generic and Generic1, Datatype, Constructor and Selector genClassName, gen1ClassName, datatypeClassName, constructorClassName, selectorClassName :: Name -genClassName = clsQual gHC_GENERICS (fsLit "Generic") genClassKey -gen1ClassName = clsQual gHC_GENERICS (fsLit "Generic1") gen1ClassKey +genClassName = clsQual gHC_GENERICS_INTERNAL (fsLit "Generic") genClassKey +gen1ClassName = clsQual gHC_GENERICS_INTERNAL (fsLit "Generic1") gen1ClassKey -datatypeClassName = clsQual gHC_GENERICS (fsLit "Datatype") datatypeClassKey -constructorClassName = clsQual gHC_GENERICS (fsLit "Constructor") constructorClassKey -selectorClassName = clsQual gHC_GENERICS (fsLit "Selector") selectorClassKey +datatypeClassName = clsQual gHC_GENERICS_INTERNAL (fsLit "Datatype") datatypeClassKey +constructorClassName = clsQual gHC_GENERICS_INTERNAL (fsLit "Constructor") constructorClassKey +selectorClassName = clsQual gHC_GENERICS_INTERNAL (fsLit "Selector") selectorClassKey genericClassNames :: [Name] genericClassNames = [genClassName, gen1ClassName] ===================================== libraries/base/GHC/Generics.hs ===================================== @@ -1,26 +1,11 @@ -{-# OPTIONS_GHC -Wno-noncanonical-monoid-instances #-} - -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE EmptyDataDeriving #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE StandaloneKindSignatures #-} -{-# LANGUAGE Trustworthy #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE TypeOperators #-} + +{-# OPTIONS_GHC -Wno-orphans #-} ----------------------------------------------------------------------------- -- | @@ -38,1519 +23,120 @@ -- package, which -- contains many useful generic functions. -module GHC.Generics ( --- * Introduction --- --- | --- --- Datatype-generic functions are based on the idea of converting values of --- a datatype @T@ into corresponding values of a (nearly) isomorphic type @'Rep' T at . --- The type @'Rep' T@ is --- built from a limited set of type constructors, all provided by this module. A --- datatype-generic function is then an overloaded function with instances --- for most of these type constructors, together with a wrapper that performs --- the mapping between @T@ and @'Rep' T at . By using this technique, we merely need --- a few generic instances in order to implement functionality that works for any --- representable type. --- --- Representable types are collected in the 'Generic' class, which defines the --- associated type 'Rep' as well as conversion functions 'from' and 'to'. --- Typically, you will not define 'Generic' instances by hand, but have the compiler --- derive them for you. - --- ** Representing datatypes --- --- | --- --- The key to defining your own datatype-generic functions is to understand how to --- represent datatypes using the given set of type constructors. --- --- Let us look at an example first: --- --- @ --- data Tree a = Leaf a | Node (Tree a) (Tree a) --- deriving 'Generic' --- @ --- --- The above declaration (which requires the language pragma @DeriveGeneric@) --- causes the following representation to be generated: --- --- @ --- instance 'Generic' (Tree a) where --- type 'Rep' (Tree a) = --- 'D1' ('MetaData \"Tree\" \"Main\" \"package-name\" 'False) --- ('C1' ('MetaCons \"Leaf\" 'PrefixI 'False) --- ('S1' ('MetaSel 'Nothing --- 'NoSourceUnpackedness --- 'NoSourceStrictness --- 'DecidedLazy) --- ('Rec0' a)) --- ':+:' --- 'C1' ('MetaCons \"Node\" 'PrefixI 'False) --- ('S1' ('MetaSel 'Nothing --- 'NoSourceUnpackedness --- 'NoSourceStrictness --- 'DecidedLazy) --- ('Rec0' (Tree a)) --- ':*:' --- 'S1' ('MetaSel 'Nothing --- 'NoSourceUnpackedness --- 'NoSourceStrictness --- 'DecidedLazy) --- ('Rec0' (Tree a)))) --- ... --- @ --- --- /Hint:/ You can obtain information about the code being generated from GHC by passing --- the @-ddump-deriv@ flag. In GHCi, you can expand a type family such as 'Rep' using --- the @:kind!@ command. --- --- This is a lot of information! However, most of it is actually merely meta-information --- that makes names of datatypes and constructors and more available on the type level. --- --- Here is a reduced representation for @Tree@ with nearly all meta-information removed, --- for now keeping only the most essential aspects: --- --- @ --- instance 'Generic' (Tree a) where --- type 'Rep' (Tree a) = --- 'Rec0' a --- ':+:' --- ('Rec0' (Tree a) ':*:' 'Rec0' (Tree a)) --- @ --- --- The @Tree@ datatype has two constructors. The representation of individual constructors --- is combined using the binary type constructor ':+:'. --- --- The first constructor consists of a single field, which is the parameter @a at . This is --- represented as @'Rec0' a at . --- --- The second constructor consists of two fields. Each is a recursive field of type @Tree a@, --- represented as @'Rec0' (Tree a)@. Representations of individual fields are combined using --- the binary type constructor ':*:'. --- --- Now let us explain the additional tags being used in the complete representation: --- --- * The @'S1' ('MetaSel 'Nothing 'NoSourceUnpackedness 'NoSourceStrictness --- 'DecidedLazy)@ tag indicates several things. The @'Nothing@ indicates --- that there is no record field selector associated with this field of --- the constructor (if there were, it would have been marked @'Just --- \"recordName\"@ instead). The other types contain meta-information on --- the field's strictness: --- --- * There is no @{\-\# UNPACK \#-\}@ or @{\-\# NOUNPACK \#-\}@ annotation --- in the source, so it is tagged with @'NoSourceUnpackedness at . --- --- * There is no strictness (@!@) or laziness (@~@) annotation in the --- source, so it is tagged with @'NoSourceStrictness at . --- --- * The compiler infers that the field is lazy, so it is tagged with --- @'DecidedLazy at . Bear in mind that what the compiler decides may be --- quite different from what is written in the source. See --- 'DecidedStrictness' for a more detailed explanation. --- --- The @'MetaSel@ type is also an instance of the type class 'Selector', --- which can be used to obtain information about the field at the value --- level. --- --- * The @'C1' ('MetaCons \"Leaf\" 'PrefixI 'False)@ and --- @'C1' ('MetaCons \"Node\" 'PrefixI 'False)@ invocations indicate that the enclosed part is --- the representation of the first and second constructor of datatype @Tree@, respectively. --- Here, the meta-information regarding constructor names, fixity and whether --- it has named fields or not is encoded at the type level. The @'MetaCons@ --- type is also an instance of the type class 'Constructor'. This type class can be used --- to obtain information about the constructor at the value level. --- --- * The @'D1' ('MetaData \"Tree\" \"Main\" \"package-name\" 'False)@ tag --- indicates that the enclosed part is the representation of the --- datatype @Tree at . Again, the meta-information is encoded at the type level. --- The @'MetaData@ type is an instance of class 'Datatype', which --- can be used to obtain the name of a datatype, the module it has been --- defined in, the package it is located under, and whether it has been --- defined using @data@ or @newtype@ at the value level. - --- ** Derived and fundamental representation types --- --- | --- --- There are many datatype-generic functions that do not distinguish between positions that --- are parameters or positions that are recursive calls. There are also many datatype-generic --- functions that do not care about the names of datatypes and constructors at all. To keep --- the number of cases to consider in generic functions in such a situation to a minimum, --- it turns out that many of the type constructors introduced above are actually synonyms, --- defining them to be variants of a smaller set of constructors. - --- *** Individual fields of constructors: 'K1' --- --- | --- --- The type constructor 'Rec0' is a variant of 'K1': --- --- @ --- type 'Rec0' = 'K1' 'R' --- @ --- --- Here, 'R' is a type-level proxy that does not have any associated values. --- --- There used to be another variant of 'K1' (namely @Par0@), but it has since --- been deprecated. - --- *** Meta information: 'M1' --- --- | --- --- The type constructors 'S1', 'C1' and 'D1' are all variants of 'M1': --- --- @ --- type 'S1' = 'M1' 'S' --- type 'C1' = 'M1' 'C' --- type 'D1' = 'M1' 'D' --- @ --- --- The types 'S', 'C' and 'D' are once again type-level proxies, just used to create --- several variants of 'M1'. - --- *** Additional generic representation type constructors --- --- | --- --- Next to 'K1', 'M1', ':+:' and ':*:' there are a few more type constructors that occur --- in the representations of other datatypes. - --- **** Empty datatypes: 'V1' --- --- | --- --- For empty datatypes, 'V1' is used as a representation. For example, --- --- @ --- data Empty deriving 'Generic' --- @ --- --- yields --- --- @ --- instance 'Generic' Empty where --- type 'Rep' Empty = --- 'D1' ('MetaData \"Empty\" \"Main\" \"package-name\" 'False) 'V1' --- @ - --- **** Constructors without fields: 'U1' --- --- | --- --- If a constructor has no arguments, then 'U1' is used as its representation. For example --- the representation of 'Bool' is --- --- @ --- instance 'Generic' Bool where --- type 'Rep' Bool = --- 'D1' ('MetaData \"Bool\" \"Data.Bool\" \"package-name\" 'False) --- ('C1' ('MetaCons \"False\" 'PrefixI 'False) 'U1' ':+:' 'C1' ('MetaCons \"True\" 'PrefixI 'False) 'U1') --- @ - --- *** Representation of types with many constructors or many fields --- --- | --- --- As ':+:' and ':*:' are just binary operators, one might ask what happens if the --- datatype has more than two constructors, or a constructor with more than two --- fields. The answer is simple: the operators are used several times, to combine --- all the constructors and fields as needed. However, users /should not rely on --- a specific nesting strategy/ for ':+:' and ':*:' being used. The compiler is --- free to choose any nesting it prefers. (In practice, the current implementation --- tries to produce a more-or-less balanced nesting, so that the traversal of --- the structure of the datatype from the root to a particular component can be --- performed in logarithmic rather than linear time.) - --- ** Defining datatype-generic functions --- --- | --- --- A datatype-generic function comprises two parts: --- --- 1. /Generic instances/ for the function, implementing it for most of the representation --- type constructors introduced above. --- --- 2. A /wrapper/ that for any datatype that is in `Generic`, performs the conversion --- between the original value and its `Rep`-based representation and then invokes the --- generic instances. --- --- As an example, let us look at a function @encode@ that produces a naive, but lossless --- bit encoding of values of various datatypes. So we are aiming to define a function --- --- @ --- encode :: 'Generic' a => a -> [Bool] --- @ --- --- where we use 'Bool' as our datatype for bits. --- --- For part 1, we define a class @Encode'@. Perhaps surprisingly, this class is parameterized --- over a type constructor @f@ of kind @* -> *@. This is a technicality: all the representation --- type constructors operate with kind @* -> *@ as base kind. But the type argument is never --- being used. This may be changed at some point in the future. The class has a single method, --- and we use the type we want our final function to have, but we replace the occurrences of --- the generic type argument @a@ with @f p@ (where the @p@ is any argument; it will not be used). --- --- > class Encode' f where --- > encode' :: f p -> [Bool] --- --- With the goal in mind to make @encode@ work on @Tree@ and other datatypes, we now define --- instances for the representation type constructors 'V1', 'U1', ':+:', ':*:', 'K1', and 'M1'. - --- *** Definition of the generic representation types --- --- | --- --- In order to be able to do this, we need to know the actual definitions of these types: --- --- @ --- data 'V1' p -- lifted version of Empty --- data 'U1' p = 'U1' -- lifted version of () --- data (':+:') f g p = 'L1' (f p) | 'R1' (g p) -- lifted version of 'Either' --- data (':*:') f g p = (f p) ':*:' (g p) -- lifted version of (,) --- newtype 'K1' i c p = 'K1' { 'unK1' :: c } -- a container for a c --- newtype 'M1' i t f p = 'M1' { 'unM1' :: f p } -- a wrapper --- @ --- --- So, 'U1' is just the unit type, ':+:' is just a binary choice like 'Either', --- ':*:' is a binary pair like the pair constructor @(,)@, and 'K1' is a value --- of a specific type @c@, and 'M1' wraps a value of the generic type argument, --- which in the lifted world is an @f p@ (where we do not care about @p@). - --- *** Generic instances --- --- | --- --- To deal with the 'V1' case, we use the following code (which requires the pragma @EmptyCase@): --- --- @ --- instance Encode' 'V1' where --- encode' x = case x of { } --- @ --- --- There are no values of type @V1 p@ to pass, so it is impossible for this --- function to be invoked. One can ask why it is useful to define an instance --- for 'V1' at all in this case? Well, an empty type can be used as an argument --- to a non-empty type, and you might still want to encode the resulting type. --- As a somewhat contrived example, consider @[Empty]@, which is not an empty --- type, but contains just the empty list. The 'V1' instance ensures that we --- can call the generic function on such types. --- --- There is exactly one value of type 'U1', so encoding it requires no --- knowledge, and we can use zero bits: --- --- @ --- instance Encode' 'U1' where --- encode' 'U1' = [] --- @ --- --- In the case for ':+:', we produce 'False' or 'True' depending on whether --- the constructor of the value provided is located on the left or on the right: --- --- @ --- instance (Encode' f, Encode' g) => Encode' (f ':+:' g) where --- encode' ('L1' x) = False : encode' x --- encode' ('R1' x) = True : encode' x --- @ --- --- (Note that this encoding strategy may not be reliable across different --- versions of GHC. Recall that the compiler is free to choose any nesting --- of ':+:' it chooses, so if GHC chooses @(a ':+:' b) ':+:' c@, then the --- encoding for @a@ would be @[False, False]@, @b@ would be @[False, True]@, --- and @c@ would be @[True]@. However, if GHC chooses @a ':+:' (b ':+:' c)@, --- then the encoding for @a@ would be @[False]@, @b@ would be @[True, False]@, --- and @c@ would be @[True, True]@.) --- --- In the case for ':*:', we append the encodings of the two subcomponents: --- --- @ --- instance (Encode' f, Encode' g) => Encode' (f ':*:' g) where --- encode' (x ':*:' y) = encode' x ++ encode' y --- @ --- --- The case for 'K1' is rather interesting. Here, we call the final function --- @encode@ that we yet have to define, recursively. We will use another type --- class @Encode@ for that function: --- --- @ --- instance (Encode c) => Encode' ('K1' i c) where --- encode' ('K1' x) = encode x --- @ --- --- Note how we can define a uniform instance for 'M1', because we completely --- disregard all meta-information: --- --- @ --- instance (Encode' f) => Encode' ('M1' i t f) where --- encode' ('M1' x) = encode' x --- @ --- --- Unlike in 'K1', the instance for 'M1' refers to @encode'@, not @encode at . - --- *** The wrapper and generic default --- --- | --- --- We now define class @Encode@ for the actual @encode@ function: --- --- @ --- class Encode a where --- encode :: a -> [Bool] --- default encode :: (Generic a, Encode' (Rep a)) => a -> [Bool] --- encode x = encode' ('from' x) --- @ --- --- The incoming @x@ is converted using 'from', then we dispatch to the --- generic instances using @encode'@. We use this as a default definition --- for @encode at . We need the @default encode@ signature because ordinary --- Haskell default methods must not introduce additional class constraints, --- but our generic default does. --- --- Defining a particular instance is now as simple as saying --- --- @ --- instance (Encode a) => Encode (Tree a) --- @ --- -#if 0 --- /TODO:/ Add usage example? --- -#endif --- The generic default is being used. In the future, it will hopefully be --- possible to use @deriving Encode@ as well, but GHC does not yet support --- that syntax for this situation. --- --- Having @Encode@ as a class has the advantage that we can define --- non-generic special cases, which is particularly useful for abstract --- datatypes that have no structural representation. For example, given --- a suitable integer encoding function @encodeInt@, we can define --- --- @ --- instance Encode Int where --- encode = encodeInt --- @ - --- *** Omitting generic instances --- --- | --- --- It is not always required to provide instances for all the generic --- representation types, but omitting instances restricts the set of --- datatypes the functions will work for: --- --- * If no ':+:' instance is given, the function may still work for --- empty datatypes or datatypes that have a single constructor, --- but will fail on datatypes with more than one constructor. --- --- * If no ':*:' instance is given, the function may still work for --- datatypes where each constructor has just zero or one field, --- in particular for enumeration types. --- --- * If no 'K1' instance is given, the function may still work for --- enumeration types, where no constructor has any fields. --- --- * If no 'V1' instance is given, the function may still work for --- any datatype that is not empty. --- --- * If no 'U1' instance is given, the function may still work for --- any datatype where each constructor has at least one field. --- --- An 'M1' instance is always required (but it can just ignore the --- meta-information, as is the case for @encode@ above). -#if 0 --- *** Using meta-information --- --- | --- --- TODO -#endif --- ** Generic constructor classes --- --- | --- --- Datatype-generic functions as defined above work for a large class --- of datatypes, including parameterized datatypes. (We have used @Tree@ --- as our example above, which is of kind @* -> *@.) However, the --- 'Generic' class ranges over types of kind @*@, and therefore, the --- resulting generic functions (such as @encode@) must be parameterized --- by a generic type argument of kind @*@. --- --- What if we want to define generic classes that range over type --- constructors (such as 'Data.Functor.Functor', --- 'Data.Traversable.Traversable', or 'Data.Foldable.Foldable')? - --- *** The 'Generic1' class --- --- | --- --- Like 'Generic', there is a class 'Generic1' that defines a --- representation 'Rep1' and conversion functions 'from1' and 'to1', --- only that 'Generic1' ranges over types of kind @* -> *@. (More generally, --- it can range over types of kind @k -> *@, for any kind @k@, if the --- @PolyKinds@ extension is enabled. More on this later.) --- The 'Generic1' class is also derivable. --- --- The representation 'Rep1' is ever so slightly different from 'Rep'. --- Let us look at @Tree@ as an example again: --- --- @ --- data Tree a = Leaf a | Node (Tree a) (Tree a) --- deriving 'Generic1' --- @ --- --- The above declaration causes the following representation to be generated: --- --- @ --- instance 'Generic1' Tree where --- type 'Rep1' Tree = --- 'D1' ('MetaData \"Tree\" \"Main\" \"package-name\" 'False) --- ('C1' ('MetaCons \"Leaf\" 'PrefixI 'False) --- ('S1' ('MetaSel 'Nothing --- 'NoSourceUnpackedness --- 'NoSourceStrictness --- 'DecidedLazy) --- 'Par1') --- ':+:' --- 'C1' ('MetaCons \"Node\" 'PrefixI 'False) --- ('S1' ('MetaSel 'Nothing --- 'NoSourceUnpackedness --- 'NoSourceStrictness --- 'DecidedLazy) --- ('Rec1' Tree) --- ':*:' --- 'S1' ('MetaSel 'Nothing --- 'NoSourceUnpackedness --- 'NoSourceStrictness --- 'DecidedLazy) --- ('Rec1' Tree))) --- ... --- @ --- --- The representation reuses 'D1', 'C1', 'S1' (and thereby 'M1') as well --- as ':+:' and ':*:' from 'Rep'. (This reusability is the reason that we --- carry around the dummy type argument for kind-@*@-types, but there are --- already enough different names involved without duplicating each of --- these.) --- --- What's different is that we now use 'Par1' to refer to the parameter --- (and that parameter, which used to be @a@), is not mentioned explicitly --- by name anywhere; and we use 'Rec1' to refer to a recursive use of @Tree a at . - --- *** Representation of @* -> *@ types --- --- | --- --- Unlike 'Rec0', the 'Par1' and 'Rec1' type constructors do not --- map to 'K1'. They are defined directly, as follows: --- --- @ --- newtype 'Par1' p = 'Par1' { 'unPar1' :: p } -- gives access to parameter p --- newtype 'Rec1' f p = 'Rec1' { 'unRec1' :: f p } -- a wrapper --- @ --- --- In 'Par1', the parameter @p@ is used for the first time, whereas 'Rec1' simply --- wraps an application of @f@ to @p at . --- --- Note that 'K1' (in the guise of 'Rec0') can still occur in a 'Rep1' representation, --- namely when the datatype has a field that does not mention the parameter. --- --- The declaration --- --- @ --- data WithInt a = WithInt Int a --- deriving 'Generic1' --- @ --- --- yields --- --- @ --- instance 'Generic1' WithInt where --- type 'Rep1' WithInt = --- 'D1' ('MetaData \"WithInt\" \"Main\" \"package-name\" 'False) --- ('C1' ('MetaCons \"WithInt\" 'PrefixI 'False) --- ('S1' ('MetaSel 'Nothing --- 'NoSourceUnpackedness --- 'NoSourceStrictness --- 'DecidedLazy) --- ('Rec0' Int) --- ':*:' --- 'S1' ('MetaSel 'Nothing --- 'NoSourceUnpackedness --- 'NoSourceStrictness --- 'DecidedLazy) --- 'Par1')) --- @ --- --- If the parameter @a@ appears underneath a composition of other type constructors, --- then the representation involves composition, too: --- --- @ --- data Rose a = Fork a [Rose a] --- @ --- --- yields --- --- @ --- instance 'Generic1' Rose where --- type 'Rep1' Rose = --- 'D1' ('MetaData \"Rose\" \"Main\" \"package-name\" 'False) --- ('C1' ('MetaCons \"Fork\" 'PrefixI 'False) --- ('S1' ('MetaSel 'Nothing --- 'NoSourceUnpackedness --- 'NoSourceStrictness --- 'DecidedLazy) --- 'Par1' --- ':*:' --- 'S1' ('MetaSel 'Nothing --- 'NoSourceUnpackedness --- 'NoSourceStrictness --- 'DecidedLazy) --- ([] ':.:' 'Rec1' Rose))) --- @ --- --- where --- --- @ --- newtype (':.:') f g p = 'Comp1' { 'unComp1' :: f (g p) } --- @ - --- *** Representation of @k -> *@ types --- --- | --- --- The 'Generic1' class can be generalized to range over types of kind --- @k -> *@, for any kind @k at . To do so, derive a 'Generic1' instance with the --- @PolyKinds@ extension enabled. For example, the declaration --- --- @ --- data Proxy (a :: k) = Proxy deriving 'Generic1' --- @ --- --- yields a slightly different instance depending on whether @PolyKinds@ is --- enabled. If compiled without @PolyKinds@, then @'Rep1' Proxy :: * -> *@, but --- if compiled with @PolyKinds@, then @'Rep1' Proxy :: k -> *@. - --- *** Representation of unlifted types --- --- | --- --- If one were to attempt to derive a Generic instance for a datatype with an --- unlifted argument (for example, 'Int#'), one might expect the occurrence of --- the 'Int#' argument to be marked with @'Rec0' 'Int#'@. This won't work, --- though, since 'Int#' is of an unlifted kind, and 'Rec0' expects a type of --- kind @*@. --- --- One solution would be to represent an occurrence of 'Int#' with 'Rec0 Int' --- instead. With this approach, however, the programmer has no way of knowing --- whether the 'Int' is actually an 'Int#' in disguise. --- --- Instead of reusing 'Rec0', a separate data family 'URec' is used to mark --- occurrences of common unlifted types: --- --- @ --- data family URec a p --- --- data instance 'URec' ('Ptr' ()) p = 'UAddr' { 'uAddr#' :: 'Addr#' } --- data instance 'URec' 'Char' p = 'UChar' { 'uChar#' :: 'Char#' } --- data instance 'URec' 'Double' p = 'UDouble' { 'uDouble#' :: 'Double#' } --- data instance 'URec' 'Int' p = 'UFloat' { 'uFloat#' :: 'Float#' } --- data instance 'URec' 'Float' p = 'UInt' { 'uInt#' :: 'Int#' } --- data instance 'URec' 'Word' p = 'UWord' { 'uWord#' :: 'Word#' } --- @ --- --- Several type synonyms are provided for convenience: --- --- @ --- type 'UAddr' = 'URec' ('Ptr' ()) --- type 'UChar' = 'URec' 'Char' --- type 'UDouble' = 'URec' 'Double' --- type 'UFloat' = 'URec' 'Float' --- type 'UInt' = 'URec' 'Int' --- type 'UWord' = 'URec' 'Word' --- @ --- --- The declaration --- --- @ --- data IntHash = IntHash Int# --- deriving 'Generic' --- @ --- --- yields --- --- @ --- instance 'Generic' IntHash where --- type 'Rep' IntHash = --- 'D1' ('MetaData \"IntHash\" \"Main\" \"package-name\" 'False) --- ('C1' ('MetaCons \"IntHash\" 'PrefixI 'False) --- ('S1' ('MetaSel 'Nothing --- 'NoSourceUnpackedness --- 'NoSourceStrictness --- 'DecidedLazy) --- 'UInt')) --- @ --- --- Currently, only the six unlifted types listed above are generated, but this --- may be extended to encompass more unlifted types in the future. -#if 0 --- *** Limitations --- --- | --- --- /TODO/ --- --- /TODO:/ Also clear up confusion about 'Rec0' and 'Rec1' not really indicating recursion. --- -#endif ------------------------------------------------------------------------------ - - -- * Generic representation types - V1, U1(..), Par1(..), Rec1(..), K1(..), M1(..) - , (:+:)(..), (:*:)(..), (:.:)(..) - - -- ** Unboxed representation types - , URec(..) - , type UAddr, type UChar, type UDouble - , type UFloat, type UInt, type UWord - - -- ** Synonyms for convenience - , Rec0, R - , D1, C1, S1, D, C, S - - -- * Meta-information - , Datatype(..), Constructor(..), Selector(..) - , Fixity(..), FixityI(..), Associativity(..), prec - , SourceUnpackedness(..), SourceStrictness(..), DecidedStrictness(..) - , Meta(..) - - -- * Generic type classes - , Generic(..) - , Generic1(..) - - -- * Generic wrapper - , Generically(..) - , Generically1(..) +module GHC.Generics + ( module GHC.Generics.Internal ) where --- We use some base types -import Data.Either ( Either (..) ) -import Data.Maybe ( Maybe(..), fromMaybe ) -import Data.Ord ( Down(..) ) -import GHC.Num.Integer ( Integer, integerToInt ) -import GHC.Prim ( Addr#, Char#, Double#, Float#, Int#, Word# ) -import GHC.Ptr ( Ptr ) -import GHC.Types - --- Needed for instances -import GHC.Ix ( Ix ) -import GHC.Base ( Alternative(..), Applicative(..), Functor(..) - , Monad(..), MonadPlus(..), NonEmpty(..), String, coerce - , Semigroup(..), Monoid(..), Void ) -import GHC.Classes ( Eq(..), Ord(..) ) -import GHC.Enum ( Bounded, Enum ) -import GHC.Read ( Read(..) ) -import GHC.Show ( Show(..), showString ) -import GHC.Stack.Types ( SrcLoc(..) ) -import GHC.Tuple (Solo (..)) -import GHC.Unicode ( GeneralCategory(..) ) +import Data.Either ( Either(..) ) +import Data.Maybe ( Maybe(..) ) +import Data.Ord ( Down(..) ) +import Data.Proxy ( Proxy(..) ) +import GHC.Base ( Functor(..), NonEmpty(..), Void ) import GHC.Fingerprint.Type ( Fingerprint(..) ) +import GHC.Ptr ( Ptr ) +import GHC.Stack.Types ( SrcLoc(..) ) +import GHC.Tuple ( Solo (..) ) +import GHC.Types +import GHC.Unicode ( GeneralCategory(..) ) --- Needed for metadata -import Data.Proxy ( Proxy(..) ) -import GHC.TypeLits ( KnownSymbol, KnownNat, Nat, symbolVal, natVal ) +import GHC.Generics.Internal -------------------------------------------------------------------------------- --- Representation types +-- Derived instances for types in GHC.Generics.Internal -------------------------------------------------------------------------------- --- | Void: used for datatypes without constructors -data V1 (p :: k) - deriving ( Eq -- ^ @since 4.9.0.0 - , Ord -- ^ @since 4.9.0.0 - , Read -- ^ @since 4.9.0.0 - , Show -- ^ @since 4.9.0.0 - , Functor -- ^ @since 4.9.0.0 - , Generic -- ^ @since 4.9.0.0 - , Generic1 -- ^ @since 4.9.0.0 - ) - --- | @since 4.12.0.0 -instance Semigroup (V1 p) where - v <> _ = v - --- | Unit: used for constructors without arguments -data U1 (p :: k) = U1 - deriving ( Generic -- ^ @since 4.7.0.0 - , Generic1 -- ^ @since 4.9.0.0 - ) - -- | @since 4.9.0.0 -instance Eq (U1 p) where - _ == _ = True +deriving instance Generic (V1 p) +-- | @ since 4.9.0.0 +deriving instance Generic1 V1 -- | @since 4.7.0.0 -instance Ord (U1 p) where - compare _ _ = EQ - --- | @since 4.9.0.0 -deriving instance Read (U1 p) - --- | @since 4.9.0.0 -instance Show (U1 p) where - showsPrec _ _ = showString "U1" +deriving instance Generic (U1 p) +-- | @ since 4.9.0.0 +deriving instance Generic1 U1 --- | @since 4.9.0.0 -instance Functor U1 where - fmap _ _ = U1 - --- | @since 4.9.0.0 -instance Applicative U1 where - pure _ = U1 - _ <*> _ = U1 - liftA2 _ _ _ = U1 - --- | @since 4.9.0.0 -instance Alternative U1 where - empty = U1 - _ <|> _ = U1 - --- | @since 4.9.0.0 -instance Monad U1 where - _ >>= _ = U1 - --- | @since 4.9.0.0 -instance MonadPlus U1 - --- | @since 4.12.0.0 -instance Semigroup (U1 p) where - _ <> _ = U1 - --- | @since 4.12.0.0 -instance Monoid (U1 p) where - mempty = U1 - --- | Used for marking occurrences of the parameter -newtype Par1 p = Par1 { unPar1 :: p } - deriving ( Eq -- ^ @since 4.7.0.0 - , Ord -- ^ @since 4.7.0.0 - , Read -- ^ @since 4.7.0.0 - , Show -- ^ @since 4.7.0.0 - , Functor -- ^ @since 4.9.0.0 - , Generic -- ^ @since 4.7.0.0 - , Generic1 -- ^ @since 4.9.0.0 - ) - --- | @since 4.9.0.0 -instance Applicative Par1 where - pure = Par1 - (<*>) = coerce - liftA2 = coerce - --- | @since 4.9.0.0 -instance Monad Par1 where - Par1 x >>= f = f x - --- | @since 4.12.0.0 -deriving instance Semigroup p => Semigroup (Par1 p) - --- | @since 4.12.0.0 -deriving instance Monoid p => Monoid (Par1 p) - --- | Recursive calls of kind @* -> *@ (or kind @k -> *@, when @PolyKinds@ --- is enabled) -newtype Rec1 (f :: k -> Type) (p :: k) = Rec1 { unRec1 :: f p } - deriving ( Eq -- ^ @since 4.7.0.0 - , Ord -- ^ @since 4.7.0.0 - , Read -- ^ @since 4.7.0.0 - , Show -- ^ @since 4.7.0.0 - , Functor -- ^ @since 4.9.0.0 - , Generic -- ^ @since 4.7.0.0 - , Generic1 -- ^ @since 4.9.0.0 - ) - --- | @since 4.9.0.0 -deriving instance Applicative f => Applicative (Rec1 f) - --- | @since 4.9.0.0 -deriving instance Alternative f => Alternative (Rec1 f) - --- | @since 4.9.0.0 -instance Monad f => Monad (Rec1 f) where - Rec1 x >>= f = Rec1 (x >>= \a -> unRec1 (f a)) - --- | @since 4.9.0.0 -deriving instance MonadPlus f => MonadPlus (Rec1 f) - --- | @since 4.12.0.0 -deriving instance Semigroup (f p) => Semigroup (Rec1 f p) - --- | @since 4.12.0.0 -deriving instance Monoid (f p) => Monoid (Rec1 f p) - --- | Constants, additional parameters and recursion of kind @*@ -newtype K1 (i :: Type) c (p :: k) = K1 { unK1 :: c } - deriving ( Eq -- ^ @since 4.7.0.0 - , Ord -- ^ @since 4.7.0.0 - , Read -- ^ @since 4.7.0.0 - , Show -- ^ @since 4.7.0.0 - , Functor -- ^ @since 4.9.0.0 - , Generic -- ^ @since 4.7.0.0 - , Generic1 -- ^ @since 4.9.0.0 - ) - --- | @since 4.12.0.0 -instance Monoid c => Applicative (K1 i c) where - pure _ = K1 mempty - liftA2 = \_ -> coerce (mappend :: c -> c -> c) - (<*>) = coerce (mappend :: c -> c -> c) - --- | @since 4.12.0.0 -deriving instance Semigroup c => Semigroup (K1 i c p) - --- | @since 4.12.0.0 -deriving instance Monoid c => Monoid (K1 i c p) +-- | @since 4.7.0.0 +deriving instance Generic (Par1 p) +-- | @ since 4.9.0.0 +deriving instance Generic1 Par1 --- | @since 4.9.0.0 -deriving instance Applicative f => Applicative (M1 i c f) +-- | @since 4.7.0.0 +deriving instance Generic (Rec1 f p) +-- | @ since 4.9.0.0 +deriving instance Generic1 (Rec1 f) --- | @since 4.9.0.0 -deriving instance Alternative f => Alternative (M1 i c f) +-- | @since 4.7.0.0 +deriving instance Generic (K1 i c p) +-- | @ since 4.9.0.0 +deriving instance Generic1 (K1 i c) --- | @since 4.9.0.0 -deriving instance Monad f => Monad (M1 i c f) +-- | @since 4.7.0.0 +deriving instance Generic (M1 i c f p) +-- | @ since 4.9.0.0 +deriving instance Generic1 (M1 i c f) --- | @since 4.9.0.0 -deriving instance MonadPlus f => MonadPlus (M1 i c f) +-- | @since 4.7.0.0 +deriving instance Generic ((f :+: g) p) +-- | @ since 4.9.0.0 +deriving instance Generic1 (f :+: g) --- | @since 4.12.0.0 -deriving instance Semigroup (f p) => Semigroup (M1 i c f p) +-- | @since 4.7.0.0 +deriving instance Generic ((f :*: g) p) +-- | @ since 4.9.0.0 +deriving instance Generic1 (f :*: g) --- | @since 4.12.0.0 -deriving instance Monoid (f p) => Monoid (M1 i c f p) - --- | Meta-information (constructor names, etc.) -newtype M1 (i :: Type) (c :: Meta) (f :: k -> Type) (p :: k) = - M1 { unM1 :: f p } - deriving ( Eq -- ^ @since 4.7.0.0 - , Ord -- ^ @since 4.7.0.0 - , Read -- ^ @since 4.7.0.0 - , Show -- ^ @since 4.7.0.0 - , Functor -- ^ @since 4.9.0.0 - , Generic -- ^ @since 4.7.0.0 - , Generic1 -- ^ @since 4.9.0.0 - ) - --- | Sums: encode choice between constructors -infixr 5 :+: -data (:+:) (f :: k -> Type) (g :: k -> Type) (p :: k) = L1 (f p) | R1 (g p) - deriving ( Eq -- ^ @since 4.7.0.0 - , Ord -- ^ @since 4.7.0.0 - , Read -- ^ @since 4.7.0.0 - , Show -- ^ @since 4.7.0.0 - , Functor -- ^ @since 4.9.0.0 - , Generic -- ^ @since 4.7.0.0 - , Generic1 -- ^ @since 4.9.0.0 - ) - --- | Products: encode multiple arguments to constructors -infixr 6 :*: -data (:*:) (f :: k -> Type) (g :: k -> Type) (p :: k) = f p :*: g p - deriving ( Eq -- ^ @since 4.7.0.0 - , Ord -- ^ @since 4.7.0.0 - , Read -- ^ @since 4.7.0.0 - , Show -- ^ @since 4.7.0.0 - , Functor -- ^ @since 4.9.0.0 - , Generic -- ^ @since 4.7.0.0 - , Generic1 -- ^ @since 4.9.0.0 - ) +-- | @since 4.7.0.0 +deriving instance Generic ((f :.: g) p) +-- | @ since 4.9.0.0 +deriving instance Functor f => Generic1 (f :.: g) -- | @since 4.9.0.0 -instance (Applicative f, Applicative g) => Applicative (f :*: g) where - pure a = pure a :*: pure a - (f :*: g) <*> (x :*: y) = (f <*> x) :*: (g <*> y) - liftA2 f (a :*: b) (x :*: y) = liftA2 f a x :*: liftA2 f b y +deriving instance Generic (URec (Ptr ()) p) +-- | @ since 4.9.0.0 +deriving instance Generic1 (URec (Ptr ())) -- | @since 4.9.0.0 -instance (Alternative f, Alternative g) => Alternative (f :*: g) where - empty = empty :*: empty - (x1 :*: y1) <|> (x2 :*: y2) = (x1 <|> x2) :*: (y1 <|> y2) +deriving instance Generic (URec Char p) +-- | @ since 4.9.0.0 +deriving instance Generic1 (URec Char) -- | @since 4.9.0.0 -instance (Monad f, Monad g) => Monad (f :*: g) where - (m :*: n) >>= f = (m >>= \a -> fstP (f a)) :*: (n >>= \a -> sndP (f a)) - where - fstP (a :*: _) = a - sndP (_ :*: b) = b +deriving instance Generic (URec Double p) +-- | @ since 4.9.0.0 +deriving instance Generic1 (URec Double) -- | @since 4.9.0.0 -instance (MonadPlus f, MonadPlus g) => MonadPlus (f :*: g) - --- | @since 4.12.0.0 -instance (Semigroup (f p), Semigroup (g p)) => Semigroup ((f :*: g) p) where - (x1 :*: y1) <> (x2 :*: y2) = (x1 <> x2) :*: (y1 <> y2) - --- | @since 4.12.0.0 -instance (Monoid (f p), Monoid (g p)) => Monoid ((f :*: g) p) where - mempty = mempty :*: mempty - --- | Composition of functors -infixr 7 :.: -newtype (:.:) (f :: k2 -> Type) (g :: k1 -> k2) (p :: k1) = - Comp1 { unComp1 :: f (g p) } - deriving ( Eq -- ^ @since 4.7.0.0 - , Ord -- ^ @since 4.7.0.0 - , Read -- ^ @since 4.7.0.0 - , Show -- ^ @since 4.7.0.0 - , Functor -- ^ @since 4.9.0.0 - , Generic -- ^ @since 4.7.0.0 - , Generic1 -- ^ @since 4.9.0.0 - ) +deriving instance Generic (URec Float p) +-- | @ since 4.9.0.0 +deriving instance Generic1 (URec Float) -- | @since 4.9.0.0 -instance (Applicative f, Applicative g) => Applicative (f :.: g) where - pure x = Comp1 (pure (pure x)) - Comp1 f <*> Comp1 x = Comp1 (liftA2 (<*>) f x) - liftA2 f (Comp1 x) (Comp1 y) = Comp1 (liftA2 (liftA2 f) x y) +deriving instance Generic (URec Int p) +-- | @ since 4.9.0.0 +deriving instance Generic1 (URec Int) -- | @since 4.9.0.0 -instance (Alternative f, Applicative g) => Alternative (f :.: g) where - empty = Comp1 empty - (<|>) = coerce ((<|>) :: f (g a) -> f (g a) -> f (g a)) :: - forall a . (f :.: g) a -> (f :.: g) a -> (f :.: g) a - --- | @since 4.12.0.0 -deriving instance Semigroup (f (g p)) => Semigroup ((f :.: g) p) - --- | @since 4.12.0.0 -deriving instance Monoid (f (g p)) => Monoid ((f :.: g) p) - --- | Constants of unlifted kinds --- --- @since 4.9.0.0 -data family URec (a :: Type) (p :: k) - --- | Used for marking occurrences of 'Addr#' --- --- @since 4.9.0.0 -data instance URec (Ptr ()) (p :: k) = UAddr { uAddr# :: Addr# } - deriving ( Eq -- ^ @since 4.9.0.0 - , Ord -- ^ @since 4.9.0.0 - , Functor -- ^ @since 4.9.0.0 - , Generic -- ^ @since 4.9.0.0 - , Generic1 -- ^ @since 4.9.0.0 - ) - --- | Used for marking occurrences of 'Char#' --- --- @since 4.9.0.0 -data instance URec Char (p :: k) = UChar { uChar# :: Char# } - deriving ( Eq -- ^ @since 4.9.0.0 - , Ord -- ^ @since 4.9.0.0 - , Show -- ^ @since 4.9.0.0 - , Functor -- ^ @since 4.9.0.0 - , Generic -- ^ @since 4.9.0.0 - , Generic1 -- ^ @since 4.9.0.0 - ) - --- | Used for marking occurrences of 'Double#' --- --- @since 4.9.0.0 -data instance URec Double (p :: k) = UDouble { uDouble# :: Double# } - deriving ( Eq -- ^ @since 4.9.0.0 - , Ord -- ^ @since 4.9.0.0 - , Show -- ^ @since 4.9.0.0 - , Functor -- ^ @since 4.9.0.0 - , Generic -- ^ @since 4.9.0.0 - , Generic1 -- ^ @since 4.9.0.0 - ) - --- | Used for marking occurrences of 'Float#' --- --- @since 4.9.0.0 -data instance URec Float (p :: k) = UFloat { uFloat# :: Float# } - deriving ( Eq, Ord, Show - , Functor -- ^ @since 4.9.0.0 - , Generic - , Generic1 -- ^ @since 4.9.0.0 - ) - --- | Used for marking occurrences of 'Int#' --- --- @since 4.9.0.0 -data instance URec Int (p :: k) = UInt { uInt# :: Int# } - deriving ( Eq -- ^ @since 4.9.0.0 - , Ord -- ^ @since 4.9.0.0 - , Show -- ^ @since 4.9.0.0 - , Functor -- ^ @since 4.9.0.0 - , Generic -- ^ @since 4.9.0.0 - , Generic1 -- ^ @since 4.9.0.0 - ) - --- | Used for marking occurrences of 'Word#' --- --- @since 4.9.0.0 -data instance URec Word (p :: k) = UWord { uWord# :: Word# } - deriving ( Eq -- ^ @since 4.9.0.0 - , Ord -- ^ @since 4.9.0.0 - , Show -- ^ @since 4.9.0.0 - , Functor -- ^ @since 4.9.0.0 - , Generic -- ^ @since 4.9.0.0 - , Generic1 -- ^ @since 4.9.0.0 - ) - --- | Type synonym for @'URec' 'Addr#'@ --- --- @since 4.9.0.0 -type UAddr = URec (Ptr ()) --- | Type synonym for @'URec' 'Char#'@ --- --- @since 4.9.0.0 -type UChar = URec Char - --- | Type synonym for @'URec' 'Double#'@ --- --- @since 4.9.0.0 -type UDouble = URec Double - --- | Type synonym for @'URec' 'Float#'@ --- --- @since 4.9.0.0 -type UFloat = URec Float +deriving instance Generic (URec Word p) +-- | @ since 4.9.0.0 +deriving instance Generic1 (URec Word) --- | Type synonym for @'URec' 'Int#'@ --- --- @since 4.9.0.0 -type UInt = URec Int +-- | @since 4.7.0.0 +deriving instance Generic Fixity --- | Type synonym for @'URec' 'Word#'@ --- --- @since 4.9.0.0 -type UWord = URec Word - --- | Tag for K1: recursion (of kind @Type@) -data R - --- | Type synonym for encoding recursion (of kind @Type@) -type Rec0 = K1 R - --- | Tag for M1: datatype -data D --- | Tag for M1: constructor -data C --- | Tag for M1: record selector -data S - --- | Type synonym for encoding meta-information for datatypes -type D1 = M1 D - --- | Type synonym for encoding meta-information for constructors -type C1 = M1 C - --- | Type synonym for encoding meta-information for record selectors -type S1 = M1 S - --- | Class for datatypes that represent datatypes -class Datatype d where - -- | The name of the datatype (unqualified) - datatypeName :: t d (f :: k -> Type) (a :: k) -> [Char] - -- | The fully-qualified name of the module where the type is declared - moduleName :: t d (f :: k -> Type) (a :: k) -> [Char] - -- | The package name of the module where the type is declared - -- - -- @since 4.9.0.0 - packageName :: t d (f :: k -> Type) (a :: k) -> [Char] - -- | Marks if the datatype is actually a newtype - -- - -- @since 4.7.0.0 - isNewtype :: t d (f :: k -> Type) (a :: k) -> Bool - isNewtype _ = False +-- | @since 4.7.0.0 +deriving instance Generic Associativity -- | @since 4.9.0.0 -instance (KnownSymbol n, KnownSymbol m, KnownSymbol p, SingI nt) - => Datatype ('MetaData n m p nt) where - datatypeName _ = symbolVal (Proxy :: Proxy n) - moduleName _ = symbolVal (Proxy :: Proxy m) - packageName _ = symbolVal (Proxy :: Proxy p) - isNewtype _ = fromSing (sing :: Sing nt) - --- | Class for datatypes that represent data constructors -class Constructor c where - -- | The name of the constructor - conName :: t c (f :: k -> Type) (a :: k) -> [Char] - - -- | The fixity of the constructor - conFixity :: t c (f :: k -> Type) (a :: k) -> Fixity - conFixity _ = Prefix - - -- | Marks if this constructor is a record - conIsRecord :: t c (f :: k -> Type) (a :: k) -> Bool - conIsRecord _ = False +deriving instance Generic SourceUnpackedness -- | @since 4.9.0.0 -instance (KnownSymbol n, SingI f, SingI r) - => Constructor ('MetaCons n f r) where - conName _ = symbolVal (Proxy :: Proxy n) - conFixity _ = fromSing (sing :: Sing f) - conIsRecord _ = fromSing (sing :: Sing r) - --- | Datatype to represent the fixity of a constructor. An infix --- | declaration directly corresponds to an application of 'Infix'. -data Fixity = Prefix | Infix Associativity Int - deriving ( Eq -- ^ @since 4.6.0.0 - , Show -- ^ @since 4.6.0.0 - , Ord -- ^ @since 4.6.0.0 - , Read -- ^ @since 4.6.0.0 - , Generic -- ^ @since 4.7.0.0 - ) - --- | This variant of 'Fixity' appears at the type level. --- --- @since 4.9.0.0 -data FixityI = PrefixI | InfixI Associativity Nat - --- | Get the precedence of a fixity value. -prec :: Fixity -> Int -prec Prefix = 10 -prec (Infix _ n) = n - --- | Datatype to represent the associativity of a constructor -data Associativity = LeftAssociative - | RightAssociative - | NotAssociative - deriving ( Eq -- ^ @since 4.6.0.0 - , Show -- ^ @since 4.6.0.0 - , Ord -- ^ @since 4.6.0.0 - , Read -- ^ @since 4.6.0.0 - , Enum -- ^ @since 4.9.0.0 - , Bounded -- ^ @since 4.9.0.0 - , Ix -- ^ @since 4.9.0.0 - , Generic -- ^ @since 4.7.0.0 - ) - --- | The unpackedness of a field as the user wrote it in the source code. For --- example, in the following data type: --- --- @ --- data E = ExampleConstructor Int --- {\-\# NOUNPACK \#-\} Int --- {\-\# UNPACK \#-\} Int --- @ --- --- The fields of @ExampleConstructor@ have 'NoSourceUnpackedness', --- 'SourceNoUnpack', and 'SourceUnpack', respectively. --- --- @since 4.9.0.0 -data SourceUnpackedness = NoSourceUnpackedness - | SourceNoUnpack - | SourceUnpack - deriving ( Eq -- ^ @since 4.9.0.0 - , Show -- ^ @since 4.9.0.0 - , Ord -- ^ @since 4.9.0.0 - , Read -- ^ @since 4.9.0.0 - , Enum -- ^ @since 4.9.0.0 - , Bounded -- ^ @since 4.9.0.0 - , Ix -- ^ @since 4.9.0.0 - , Generic -- ^ @since 4.9.0.0 - ) - --- | The strictness of a field as the user wrote it in the source code. For --- example, in the following data type: --- --- @ --- data E = ExampleConstructor Int ~Int !Int --- @ --- --- The fields of @ExampleConstructor@ have 'NoSourceStrictness', --- 'SourceLazy', and 'SourceStrict', respectively. --- --- @since 4.9.0.0 -data SourceStrictness = NoSourceStrictness - | SourceLazy - | SourceStrict - deriving ( Eq -- ^ @since 4.9.0.0 - , Show -- ^ @since 4.9.0.0 - , Ord -- ^ @since 4.9.0.0 - , Read -- ^ @since 4.9.0.0 - , Enum -- ^ @since 4.9.0.0 - , Bounded -- ^ @since 4.9.0.0 - , Ix -- ^ @since 4.9.0.0 - , Generic -- ^ @since 4.9.0.0 - ) - --- | The strictness that GHC infers for a field during compilation. Whereas --- there are nine different combinations of 'SourceUnpackedness' and --- 'SourceStrictness', the strictness that GHC decides will ultimately be one --- of lazy, strict, or unpacked. What GHC decides is affected both by what the --- user writes in the source code and by GHC flags. As an example, consider --- this data type: --- --- @ --- data E = ExampleConstructor {\-\# UNPACK \#-\} !Int !Int Int --- @ --- --- * If compiled without optimization or other language extensions, then the --- fields of @ExampleConstructor@ will have 'DecidedStrict', 'DecidedStrict', --- and 'DecidedLazy', respectively. --- --- * If compiled with @-XStrictData@ enabled, then the fields will have --- 'DecidedStrict', 'DecidedStrict', and 'DecidedStrict', respectively. --- --- * If compiled with @-O2@ enabled, then the fields will have 'DecidedUnpack', --- 'DecidedStrict', and 'DecidedLazy', respectively. --- --- @since 4.9.0.0 -data DecidedStrictness = DecidedLazy - | DecidedStrict - | DecidedUnpack - deriving ( Eq -- ^ @since 4.9.0.0 - , Show -- ^ @since 4.9.0.0 - , Ord -- ^ @since 4.9.0.0 - , Read -- ^ @since 4.9.0.0 - , Enum -- ^ @since 4.9.0.0 - , Bounded -- ^ @since 4.9.0.0 - , Ix -- ^ @since 4.9.0.0 - , Generic -- ^ @since 4.9.0.0 - ) - --- | Class for datatypes that represent records -class Selector s where - -- | The name of the selector - selName :: t s (f :: k -> Type) (a :: k) -> [Char] - -- | The selector's unpackedness annotation (if any) - -- - -- @since 4.9.0.0 - selSourceUnpackedness :: t s (f :: k -> Type) (a :: k) -> SourceUnpackedness - -- | The selector's strictness annotation (if any) - -- - -- @since 4.9.0.0 - selSourceStrictness :: t s (f :: k -> Type) (a :: k) -> SourceStrictness - -- | The strictness that the compiler inferred for the selector - -- - -- @since 4.9.0.0 - selDecidedStrictness :: t s (f :: k -> Type) (a :: k) -> DecidedStrictness +deriving instance Generic SourceStrictness -- | @since 4.9.0.0 -instance (SingI mn, SingI su, SingI ss, SingI ds) - => Selector ('MetaSel mn su ss ds) where - selName _ = fromMaybe "" (fromSing (sing :: Sing mn)) - selSourceUnpackedness _ = fromSing (sing :: Sing su) - selSourceStrictness _ = fromSing (sing :: Sing ss) - selDecidedStrictness _ = fromSing (sing :: Sing ds) - --- | Representable types of kind @*@. --- This class is derivable in GHC with the @DeriveGeneric@ flag on. --- --- A 'Generic' instance must satisfy the following laws: --- --- @ --- 'from' . 'to' ≡ 'Prelude.id' --- 'to' . 'from' ≡ 'Prelude.id' --- @ -class Generic a where - -- | Generic representation type - type Rep a :: Type -> Type - -- | Convert from the datatype to its representation - from :: a -> (Rep a) x - -- | Convert from the representation to the datatype - to :: (Rep a) x -> a - - --- | Representable types of kind @* -> *@ (or kind @k -> *@, when @PolyKinds@ --- is enabled). --- This class is derivable in GHC with the @DeriveGeneric@ flag on. --- --- A 'Generic1' instance must satisfy the following laws: --- --- @ --- 'from1' . 'to1' ≡ 'Prelude.id' --- 'to1' . 'from1' ≡ 'Prelude.id' --- @ -class Generic1 (f :: k -> Type) where - -- | Generic representation type - type Rep1 f :: k -> Type - -- | Convert from the datatype to its representation - from1 :: f a -> (Rep1 f) a - -- | Convert from the representation to the datatype - to1 :: (Rep1 f) a -> f a +deriving instance Generic DecidedStrictness -------------------------------------------------------------------------------- --- 'Generic' wrapper --------------------------------------------------------------------------------- - --- | A datatype whose instances are defined generically, using the --- 'Generic' representation. 'Generically1' is a higher-kinded version --- of 'Generically' that uses 'Generic1'. --- --- Generic instances can be derived via @'Generically' A@ using --- @-XDerivingVia at . --- --- @ --- {-# LANGUAGE DeriveGeneric #-} --- {-# LANGUAGE DerivingStrategies #-} --- {-# LANGUAGE DerivingVia #-} --- --- import GHC.Generics (Generic) --- --- data V4 a = V4 a a a a --- deriving stock Generic --- --- deriving (Semigroup, Monoid) --- via Generically (V4 a) --- @ --- --- This corresponds to 'Semigroup' and 'Monoid' instances defined by --- pointwise lifting: --- --- @ --- instance Semigroup a => Semigroup (V4 a) where --- (<>) :: V4 a -> V4 a -> V4 a --- V4 a1 b1 c1 d1 <> V4 a2 b2 c2 d2 = --- V4 (a1 <> a2) (b1 <> b2) (c1 <> c2) (d1 <> d2) --- --- instance Monoid a => Monoid (V4 a) where --- mempty :: V4 a --- mempty = V4 mempty mempty mempty mempty --- @ --- --- Historically this required modifying the type class to include --- generic method definitions (@-XDefaultSignatures@) and deriving it --- with the @anyclass@ strategy (@-XDeriveAnyClass@). Having a /via --- type/ like 'Generically' decouples the instance from the type --- class. --- --- @since 4.17.0.0 -newtype Generically a = Generically a - --- | @since 4.17.0.0 -instance (Generic a, Semigroup (Rep a ())) => Semigroup (Generically a) where - (<>) :: Generically a -> Generically a -> Generically a - Generically a <> Generically b = Generically (to (from a <> from b :: Rep a ())) - --- | @since 4.17.0.0 -instance (Generic a, Monoid (Rep a ())) => Monoid (Generically a) where - mempty :: Generically a - mempty = Generically (to (mempty :: Rep a ())) - - mappend :: Generically a -> Generically a -> Generically a - mappend = (<>) - --- | A type whose instances are defined generically, using the --- 'Generic1' representation. 'Generically1' is a higher-kinded --- version of 'Generically' that uses 'Generic'. --- --- Generic instances can be derived for type constructors via --- @'Generically1' F@ using @-XDerivingVia at . --- --- @ --- {-# LANGUAGE DeriveGeneric #-} --- {-# LANGUAGE DerivingStrategies #-} --- {-# LANGUAGE DerivingVia #-} --- --- import GHC.Generics (Generic) --- --- data V4 a = V4 a a a a --- deriving stock (Functor, Generic1) --- --- deriving Applicative --- via Generically1 V4 --- @ --- --- This corresponds to 'Applicative' instances defined by pointwise --- lifting: --- --- @ --- instance Applicative V4 where --- pure :: a -> V4 a --- pure a = V4 a a a a --- --- liftA2 :: (a -> b -> c) -> (V4 a -> V4 b -> V4 c) --- liftA2 (·) (V4 a1 b1 c1 d1) (V4 a2 b2 c2 d2) = --- V4 (a1 · a2) (b1 · b2) (c1 · c2) (d1 · d2) --- @ --- --- Historically this required modifying the type class to include --- generic method definitions (@-XDefaultSignatures@) and deriving it --- with the @anyclass@ strategy (@-XDeriveAnyClass@). Having a /via --- type/ like 'Generically1' decouples the instance from the type --- class. --- --- @since 4.17.0.0 -type Generically1 :: forall k. (k -> Type) -> (k -> Type) -newtype Generically1 f a where - Generically1 :: forall {k} f a. f a -> Generically1 @k f a - --- | @since 4.18.0.0 -instance (Generic1 f, Eq (Rep1 f a)) => Eq (Generically1 f a) where - Generically1 x == Generically1 y = from1 x == from1 y - Generically1 x /= Generically1 y = from1 x /= from1 y - --- | @since 4.18.0.0 -instance (Generic1 f, Ord (Rep1 f a)) => Ord (Generically1 f a) where - Generically1 x `compare` Generically1 y = from1 x `compare` from1 y - --- | @since 4.17.0.0 -instance (Generic1 f, Functor (Rep1 f)) => Functor (Generically1 f) where - fmap :: (a -> a') -> (Generically1 f a -> Generically1 f a') - fmap f (Generically1 as) = Generically1 - (to1 (fmap f (from1 as))) - - (<$) :: a -> Generically1 f b -> Generically1 f a - a <$ Generically1 as = Generically1 - (to1 (a <$ from1 as)) - --- | @since 4.17.0.0 -instance (Generic1 f, Applicative (Rep1 f)) => Applicative (Generically1 f) where - pure :: a -> Generically1 f a - pure a = Generically1 - (to1 (pure a)) - - (<*>) :: Generically1 f (a1 -> a2) -> Generically1 f a1 -> Generically1 f a2 - Generically1 fs <*> Generically1 as = Generically1 - (to1 (from1 fs <*> from1 as)) - - liftA2 :: (a1 -> a2 -> a3) - -> (Generically1 f a1 -> Generically1 f a2 -> Generically1 f a3) - liftA2 (·) (Generically1 as) (Generically1 bs) = Generically1 - (to1 (liftA2 (·) (from1 as) (from1 bs))) - --- | @since 4.17.0.0 -instance (Generic1 f, Alternative (Rep1 f)) => Alternative (Generically1 f) where - empty :: Generically1 f a - empty = Generically1 - (to1 empty) - - (<|>) :: Generically1 f a -> Generically1 f a -> Generically1 f a - Generically1 as1 <|> Generically1 as2 = Generically1 - (to1 (from1 as1 <|> from1 as2)) - --------------------------------------------------------------------------------- --- Meta-data --------------------------------------------------------------------------------- - --- | Datatype to represent metadata associated with a datatype (@MetaData@), --- constructor (@MetaCons@), or field selector (@MetaSel@). --- --- * In @MetaData n m p nt@, @n@ is the datatype's name, @m@ is the module in --- which the datatype is defined, @p@ is the package in which the datatype --- is defined, and @nt@ is @'True@ if the datatype is a @newtype at . --- --- * In @MetaCons n f s@, @n@ is the constructor's name, @f@ is its fixity, --- and @s@ is @'True@ if the constructor contains record selectors. --- --- * In @MetaSel mn su ss ds@, if the field uses record syntax, then @mn@ is --- 'Just' the record name. Otherwise, @mn@ is 'Nothing'. @su@ and @ss@ are --- the field's unpackedness and strictness annotations, and @ds@ is the --- strictness that GHC infers for the field. --- --- @since 4.9.0.0 -data Meta = MetaData Symbol Symbol Symbol Bool - | MetaCons Symbol FixityI Bool - | MetaSel (Maybe Symbol) - SourceUnpackedness SourceStrictness DecidedStrictness - --------------------------------------------------------------------------------- --- Derived instances +-- Derived instances for other types in base -------------------------------------------------------------------------------- -- | @since 4.8.0.0 @@ -1699,179 +285,3 @@ deriving instance Generic1 ((,,,,,,,,,,,,,,) a b c d e f g h i j k l m n) -- | @since 4.12.0.0 deriving instance Generic1 Down - --------------------------------------------------------------------------------- --- Copied from the singletons package --------------------------------------------------------------------------------- - --- | The singleton kind-indexed data family. -data family Sing (a :: k) - --- | A 'SingI' constraint is essentially an implicitly-passed singleton. -class SingI (a :: k) where - -- | Produce the singleton explicitly. You will likely need the @ScopedTypeVariables@ - -- extension to use this method the way you want. - sing :: Sing a - --- | The 'SingKind' class is essentially a /kind/ class. It classifies all kinds --- for which singletons are defined. The class supports converting between a singleton --- type and the base (unrefined) type which it is built from. -class SingKind k where - -- | Get a base type from a proxy for the promoted kind. For example, - -- @DemoteRep Bool@ will be the type @Bool at . - type DemoteRep k :: Type - - -- | Convert a singleton to its unrefined version. - fromSing :: Sing (a :: k) -> DemoteRep k - --- Singleton symbols -data instance Sing (s :: Symbol) where - SSym :: KnownSymbol s => Sing s - --- | @since 4.9.0.0 -instance KnownSymbol a => SingI a where sing = SSym - --- | @since 4.9.0.0 -instance SingKind Symbol where - type DemoteRep Symbol = String - fromSing (SSym :: Sing s) = symbolVal (Proxy :: Proxy s) - --- Singleton booleans -data instance Sing (a :: Bool) where - STrue :: Sing 'True - SFalse :: Sing 'False - --- | @since 4.9.0.0 -instance SingI 'True where sing = STrue - --- | @since 4.9.0.0 -instance SingI 'False where sing = SFalse - --- | @since 4.9.0.0 -instance SingKind Bool where - type DemoteRep Bool = Bool - fromSing STrue = True - fromSing SFalse = False - --- Singleton Maybe -data instance Sing (b :: Maybe a) where - SNothing :: Sing 'Nothing - SJust :: Sing a -> Sing ('Just a) - --- | @since 4.9.0.0 -instance SingI 'Nothing where sing = SNothing - --- | @since 4.9.0.0 -instance SingI a => SingI ('Just a) where sing = SJust sing - --- | @since 4.9.0.0 -instance SingKind a => SingKind (Maybe a) where - type DemoteRep (Maybe a) = Maybe (DemoteRep a) - fromSing SNothing = Nothing - fromSing (SJust a) = Just (fromSing a) - --- Singleton Fixity -data instance Sing (a :: FixityI) where - SPrefix :: Sing 'PrefixI - SInfix :: Sing a -> Integer -> Sing ('InfixI a n) - --- | @since 4.9.0.0 -instance SingI 'PrefixI where sing = SPrefix - --- | @since 4.9.0.0 -instance (SingI a, KnownNat n) => SingI ('InfixI a n) where - sing = SInfix (sing :: Sing a) (natVal (Proxy :: Proxy n)) - --- | @since 4.9.0.0 -instance SingKind FixityI where - type DemoteRep FixityI = Fixity - fromSing SPrefix = Prefix - fromSing (SInfix a n) = Infix (fromSing a) (integerToInt n) - --- Singleton Associativity -data instance Sing (a :: Associativity) where - SLeftAssociative :: Sing 'LeftAssociative - SRightAssociative :: Sing 'RightAssociative - SNotAssociative :: Sing 'NotAssociative - --- | @since 4.9.0.0 -instance SingI 'LeftAssociative where sing = SLeftAssociative - --- | @since 4.9.0.0 -instance SingI 'RightAssociative where sing = SRightAssociative - --- | @since 4.9.0.0 -instance SingI 'NotAssociative where sing = SNotAssociative - --- | @since 4.0.0.0 -instance SingKind Associativity where - type DemoteRep Associativity = Associativity - fromSing SLeftAssociative = LeftAssociative - fromSing SRightAssociative = RightAssociative - fromSing SNotAssociative = NotAssociative - --- Singleton SourceUnpackedness -data instance Sing (a :: SourceUnpackedness) where - SNoSourceUnpackedness :: Sing 'NoSourceUnpackedness - SSourceNoUnpack :: Sing 'SourceNoUnpack - SSourceUnpack :: Sing 'SourceUnpack - --- | @since 4.9.0.0 -instance SingI 'NoSourceUnpackedness where sing = SNoSourceUnpackedness - --- | @since 4.9.0.0 -instance SingI 'SourceNoUnpack where sing = SSourceNoUnpack - --- | @since 4.9.0.0 -instance SingI 'SourceUnpack where sing = SSourceUnpack - --- | @since 4.9.0.0 -instance SingKind SourceUnpackedness where - type DemoteRep SourceUnpackedness = SourceUnpackedness - fromSing SNoSourceUnpackedness = NoSourceUnpackedness - fromSing SSourceNoUnpack = SourceNoUnpack - fromSing SSourceUnpack = SourceUnpack - --- Singleton SourceStrictness -data instance Sing (a :: SourceStrictness) where - SNoSourceStrictness :: Sing 'NoSourceStrictness - SSourceLazy :: Sing 'SourceLazy - SSourceStrict :: Sing 'SourceStrict - --- | @since 4.9.0.0 -instance SingI 'NoSourceStrictness where sing = SNoSourceStrictness - --- | @since 4.9.0.0 -instance SingI 'SourceLazy where sing = SSourceLazy - --- | @since 4.9.0.0 -instance SingI 'SourceStrict where sing = SSourceStrict - --- | @since 4.9.0.0 -instance SingKind SourceStrictness where - type DemoteRep SourceStrictness = SourceStrictness - fromSing SNoSourceStrictness = NoSourceStrictness - fromSing SSourceLazy = SourceLazy - fromSing SSourceStrict = SourceStrict - --- Singleton DecidedStrictness -data instance Sing (a :: DecidedStrictness) where - SDecidedLazy :: Sing 'DecidedLazy - SDecidedStrict :: Sing 'DecidedStrict - SDecidedUnpack :: Sing 'DecidedUnpack - --- | @since 4.9.0.0 -instance SingI 'DecidedLazy where sing = SDecidedLazy - --- | @since 4.9.0.0 -instance SingI 'DecidedStrict where sing = SDecidedStrict - --- | @since 4.9.0.0 -instance SingI 'DecidedUnpack where sing = SDecidedUnpack - --- | @since 4.9.0.0 -instance SingKind DecidedStrictness where - type DemoteRep DecidedStrictness = DecidedStrictness - fromSing SDecidedLazy = DecidedLazy - fromSing SDecidedStrict = DecidedStrict - fromSing SDecidedUnpack = DecidedUnpack ===================================== libraries/base/GHC/Generics/Internal.hs ===================================== @@ -0,0 +1,1683 @@ +{-# OPTIONS_GHC -Wno-noncanonical-monoid-instances #-} + +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE EmptyDataDeriving #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE StandaloneKindSignatures #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : GHC.Generics.Internal +-- Copyright : (c) Universiteit Utrecht 2010-2011, University of Oxford 2012-2014 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : libraries at haskell.org +-- Stability : internal +-- Portability : non-portable +-- +-- This module only exists to put 'Generic'-related definitions in a separate +-- module from the derived 'Generic'/'Generic1' instances in 'GHC.Generics'. +-- If these derived instances were put in the same module as the definitions, +-- then GHC's dependency analysis might typecheck a derived instance /before/ it +-- typechecks the definitions that it depends on, which would be disastrous. + +module GHC.Generics.Internal ( +-- * Introduction +-- +-- | +-- +-- Datatype-generic functions are based on the idea of converting values of +-- a datatype @T@ into corresponding values of a (nearly) isomorphic type @'Rep' T at . +-- The type @'Rep' T@ is +-- built from a limited set of type constructors, all provided by this module. A +-- datatype-generic function is then an overloaded function with instances +-- for most of these type constructors, together with a wrapper that performs +-- the mapping between @T@ and @'Rep' T at . By using this technique, we merely need +-- a few generic instances in order to implement functionality that works for any +-- representable type. +-- +-- Representable types are collected in the 'Generic' class, which defines the +-- associated type 'Rep' as well as conversion functions 'from' and 'to'. +-- Typically, you will not define 'Generic' instances by hand, but have the compiler +-- derive them for you. + +-- ** Representing datatypes +-- +-- | +-- +-- The key to defining your own datatype-generic functions is to understand how to +-- represent datatypes using the given set of type constructors. +-- +-- Let us look at an example first: +-- +-- @ +-- data Tree a = Leaf a | Node (Tree a) (Tree a) +-- deriving 'Generic' +-- @ +-- +-- The above declaration (which requires the language pragma @DeriveGeneric@) +-- causes the following representation to be generated: +-- +-- @ +-- instance 'Generic' (Tree a) where +-- type 'Rep' (Tree a) = +-- 'D1' ('MetaData \"Tree\" \"Main\" \"package-name\" 'False) +-- ('C1' ('MetaCons \"Leaf\" 'PrefixI 'False) +-- ('S1' ('MetaSel 'Nothing +-- 'NoSourceUnpackedness +-- 'NoSourceStrictness +-- 'DecidedLazy) +-- ('Rec0' a)) +-- ':+:' +-- 'C1' ('MetaCons \"Node\" 'PrefixI 'False) +-- ('S1' ('MetaSel 'Nothing +-- 'NoSourceUnpackedness +-- 'NoSourceStrictness +-- 'DecidedLazy) +-- ('Rec0' (Tree a)) +-- ':*:' +-- 'S1' ('MetaSel 'Nothing +-- 'NoSourceUnpackedness +-- 'NoSourceStrictness +-- 'DecidedLazy) +-- ('Rec0' (Tree a)))) +-- ... +-- @ +-- +-- /Hint:/ You can obtain information about the code being generated from GHC by passing +-- the @-ddump-deriv@ flag. In GHCi, you can expand a type family such as 'Rep' using +-- the @:kind!@ command. +-- +-- This is a lot of information! However, most of it is actually merely meta-information +-- that makes names of datatypes and constructors and more available on the type level. +-- +-- Here is a reduced representation for @Tree@ with nearly all meta-information removed, +-- for now keeping only the most essential aspects: +-- +-- @ +-- instance 'Generic' (Tree a) where +-- type 'Rep' (Tree a) = +-- 'Rec0' a +-- ':+:' +-- ('Rec0' (Tree a) ':*:' 'Rec0' (Tree a)) +-- @ +-- +-- The @Tree@ datatype has two constructors. The representation of individual constructors +-- is combined using the binary type constructor ':+:'. +-- +-- The first constructor consists of a single field, which is the parameter @a at . This is +-- represented as @'Rec0' a at . +-- +-- The second constructor consists of two fields. Each is a recursive field of type @Tree a@, +-- represented as @'Rec0' (Tree a)@. Representations of individual fields are combined using +-- the binary type constructor ':*:'. +-- +-- Now let us explain the additional tags being used in the complete representation: +-- +-- * The @'S1' ('MetaSel 'Nothing 'NoSourceUnpackedness 'NoSourceStrictness +-- 'DecidedLazy)@ tag indicates several things. The @'Nothing@ indicates +-- that there is no record field selector associated with this field of +-- the constructor (if there were, it would have been marked @'Just +-- \"recordName\"@ instead). The other types contain meta-information on +-- the field's strictness: +-- +-- * There is no @{\-\# UNPACK \#-\}@ or @{\-\# NOUNPACK \#-\}@ annotation +-- in the source, so it is tagged with @'NoSourceUnpackedness at . +-- +-- * There is no strictness (@!@) or laziness (@~@) annotation in the +-- source, so it is tagged with @'NoSourceStrictness at . +-- +-- * The compiler infers that the field is lazy, so it is tagged with +-- @'DecidedLazy at . Bear in mind that what the compiler decides may be +-- quite different from what is written in the source. See +-- 'DecidedStrictness' for a more detailed explanation. +-- +-- The @'MetaSel@ type is also an instance of the type class 'Selector', +-- which can be used to obtain information about the field at the value +-- level. +-- +-- * The @'C1' ('MetaCons \"Leaf\" 'PrefixI 'False)@ and +-- @'C1' ('MetaCons \"Node\" 'PrefixI 'False)@ invocations indicate that the enclosed part is +-- the representation of the first and second constructor of datatype @Tree@, respectively. +-- Here, the meta-information regarding constructor names, fixity and whether +-- it has named fields or not is encoded at the type level. The @'MetaCons@ +-- type is also an instance of the type class 'Constructor'. This type class can be used +-- to obtain information about the constructor at the value level. +-- +-- * The @'D1' ('MetaData \"Tree\" \"Main\" \"package-name\" 'False)@ tag +-- indicates that the enclosed part is the representation of the +-- datatype @Tree at . Again, the meta-information is encoded at the type level. +-- The @'MetaData@ type is an instance of class 'Datatype', which +-- can be used to obtain the name of a datatype, the module it has been +-- defined in, the package it is located under, and whether it has been +-- defined using @data@ or @newtype@ at the value level. + +-- ** Derived and fundamental representation types +-- +-- | +-- +-- There are many datatype-generic functions that do not distinguish between positions that +-- are parameters or positions that are recursive calls. There are also many datatype-generic +-- functions that do not care about the names of datatypes and constructors at all. To keep +-- the number of cases to consider in generic functions in such a situation to a minimum, +-- it turns out that many of the type constructors introduced above are actually synonyms, +-- defining them to be variants of a smaller set of constructors. + +-- *** Individual fields of constructors: 'K1' +-- +-- | +-- +-- The type constructor 'Rec0' is a variant of 'K1': +-- +-- @ +-- type 'Rec0' = 'K1' 'R' +-- @ +-- +-- Here, 'R' is a type-level proxy that does not have any associated values. +-- +-- There used to be another variant of 'K1' (namely @Par0@), but it has since +-- been deprecated. + +-- *** Meta information: 'M1' +-- +-- | +-- +-- The type constructors 'S1', 'C1' and 'D1' are all variants of 'M1': +-- +-- @ +-- type 'S1' = 'M1' 'S' +-- type 'C1' = 'M1' 'C' +-- type 'D1' = 'M1' 'D' +-- @ +-- +-- The types 'S', 'C' and 'D' are once again type-level proxies, just used to create +-- several variants of 'M1'. + +-- *** Additional generic representation type constructors +-- +-- | +-- +-- Next to 'K1', 'M1', ':+:' and ':*:' there are a few more type constructors that occur +-- in the representations of other datatypes. + +-- **** Empty datatypes: 'V1' +-- +-- | +-- +-- For empty datatypes, 'V1' is used as a representation. For example, +-- +-- @ +-- data Empty deriving 'Generic' +-- @ +-- +-- yields +-- +-- @ +-- instance 'Generic' Empty where +-- type 'Rep' Empty = +-- 'D1' ('MetaData \"Empty\" \"Main\" \"package-name\" 'False) 'V1' +-- @ + +-- **** Constructors without fields: 'U1' +-- +-- | +-- +-- If a constructor has no arguments, then 'U1' is used as its representation. For example +-- the representation of 'Bool' is +-- +-- @ +-- instance 'Generic' Bool where +-- type 'Rep' Bool = +-- 'D1' ('MetaData \"Bool\" \"Data.Bool\" \"package-name\" 'False) +-- ('C1' ('MetaCons \"False\" 'PrefixI 'False) 'U1' ':+:' 'C1' ('MetaCons \"True\" 'PrefixI 'False) 'U1') +-- @ + +-- *** Representation of types with many constructors or many fields +-- +-- | +-- +-- As ':+:' and ':*:' are just binary operators, one might ask what happens if the +-- datatype has more than two constructors, or a constructor with more than two +-- fields. The answer is simple: the operators are used several times, to combine +-- all the constructors and fields as needed. However, users /should not rely on +-- a specific nesting strategy/ for ':+:' and ':*:' being used. The compiler is +-- free to choose any nesting it prefers. (In practice, the current implementation +-- tries to produce a more-or-less balanced nesting, so that the traversal of +-- the structure of the datatype from the root to a particular component can be +-- performed in logarithmic rather than linear time.) + +-- ** Defining datatype-generic functions +-- +-- | +-- +-- A datatype-generic function comprises two parts: +-- +-- 1. /Generic instances/ for the function, implementing it for most of the representation +-- type constructors introduced above. +-- +-- 2. A /wrapper/ that for any datatype that is in `Generic`, performs the conversion +-- between the original value and its `Rep`-based representation and then invokes the +-- generic instances. +-- +-- As an example, let us look at a function @encode@ that produces a naive, but lossless +-- bit encoding of values of various datatypes. So we are aiming to define a function +-- +-- @ +-- encode :: 'Generic' a => a -> [Bool] +-- @ +-- +-- where we use 'Bool' as our datatype for bits. +-- +-- For part 1, we define a class @Encode'@. Perhaps surprisingly, this class is parameterized +-- over a type constructor @f@ of kind @* -> *@. This is a technicality: all the representation +-- type constructors operate with kind @* -> *@ as base kind. But the type argument is never +-- being used. This may be changed at some point in the future. The class has a single method, +-- and we use the type we want our final function to have, but we replace the occurrences of +-- the generic type argument @a@ with @f p@ (where the @p@ is any argument; it will not be used). +-- +-- > class Encode' f where +-- > encode' :: f p -> [Bool] +-- +-- With the goal in mind to make @encode@ work on @Tree@ and other datatypes, we now define +-- instances for the representation type constructors 'V1', 'U1', ':+:', ':*:', 'K1', and 'M1'. + +-- *** Definition of the generic representation types +-- +-- | +-- +-- In order to be able to do this, we need to know the actual definitions of these types: +-- +-- @ +-- data 'V1' p -- lifted version of Empty +-- data 'U1' p = 'U1' -- lifted version of () +-- data (':+:') f g p = 'L1' (f p) | 'R1' (g p) -- lifted version of 'Either' +-- data (':*:') f g p = (f p) ':*:' (g p) -- lifted version of (,) +-- newtype 'K1' i c p = 'K1' { 'unK1' :: c } -- a container for a c +-- newtype 'M1' i t f p = 'M1' { 'unM1' :: f p } -- a wrapper +-- @ +-- +-- So, 'U1' is just the unit type, ':+:' is just a binary choice like 'Either', +-- ':*:' is a binary pair like the pair constructor @(,)@, and 'K1' is a value +-- of a specific type @c@, and 'M1' wraps a value of the generic type argument, +-- which in the lifted world is an @f p@ (where we do not care about @p@). + +-- *** Generic instances +-- +-- | +-- +-- To deal with the 'V1' case, we use the following code (which requires the pragma @EmptyCase@): +-- +-- @ +-- instance Encode' 'V1' where +-- encode' x = case x of { } +-- @ +-- +-- There are no values of type @V1 p@ to pass, so it is impossible for this +-- function to be invoked. One can ask why it is useful to define an instance +-- for 'V1' at all in this case? Well, an empty type can be used as an argument +-- to a non-empty type, and you might still want to encode the resulting type. +-- As a somewhat contrived example, consider @[Empty]@, which is not an empty +-- type, but contains just the empty list. The 'V1' instance ensures that we +-- can call the generic function on such types. +-- +-- There is exactly one value of type 'U1', so encoding it requires no +-- knowledge, and we can use zero bits: +-- +-- @ +-- instance Encode' 'U1' where +-- encode' 'U1' = [] +-- @ +-- +-- In the case for ':+:', we produce 'False' or 'True' depending on whether +-- the constructor of the value provided is located on the left or on the right: +-- +-- @ +-- instance (Encode' f, Encode' g) => Encode' (f ':+:' g) where +-- encode' ('L1' x) = False : encode' x +-- encode' ('R1' x) = True : encode' x +-- @ +-- +-- (Note that this encoding strategy may not be reliable across different +-- versions of GHC. Recall that the compiler is free to choose any nesting +-- of ':+:' it chooses, so if GHC chooses @(a ':+:' b) ':+:' c@, then the +-- encoding for @a@ would be @[False, False]@, @b@ would be @[False, True]@, +-- and @c@ would be @[True]@. However, if GHC chooses @a ':+:' (b ':+:' c)@, +-- then the encoding for @a@ would be @[False]@, @b@ would be @[True, False]@, +-- and @c@ would be @[True, True]@.) +-- +-- In the case for ':*:', we append the encodings of the two subcomponents: +-- +-- @ +-- instance (Encode' f, Encode' g) => Encode' (f ':*:' g) where +-- encode' (x ':*:' y) = encode' x ++ encode' y +-- @ +-- +-- The case for 'K1' is rather interesting. Here, we call the final function +-- @encode@ that we yet have to define, recursively. We will use another type +-- class @Encode@ for that function: +-- +-- @ +-- instance (Encode c) => Encode' ('K1' i c) where +-- encode' ('K1' x) = encode x +-- @ +-- +-- Note how we can define a uniform instance for 'M1', because we completely +-- disregard all meta-information: +-- +-- @ +-- instance (Encode' f) => Encode' ('M1' i t f) where +-- encode' ('M1' x) = encode' x +-- @ +-- +-- Unlike in 'K1', the instance for 'M1' refers to @encode'@, not @encode at . + +-- *** The wrapper and generic default +-- +-- | +-- +-- We now define class @Encode@ for the actual @encode@ function: +-- +-- @ +-- class Encode a where +-- encode :: a -> [Bool] +-- default encode :: (Generic a, Encode' (Rep a)) => a -> [Bool] +-- encode x = encode' ('from' x) +-- @ +-- +-- The incoming @x@ is converted using 'from', then we dispatch to the +-- generic instances using @encode'@. We use this as a default definition +-- for @encode at . We need the @default encode@ signature because ordinary +-- Haskell default methods must not introduce additional class constraints, +-- but our generic default does. +-- +-- Defining a particular instance is now as simple as saying +-- +-- @ +-- instance (Encode a) => Encode (Tree a) +-- @ +-- +#if 0 +-- /TODO:/ Add usage example? +-- +#endif +-- The generic default is being used. In the future, it will hopefully be +-- possible to use @deriving Encode@ as well, but GHC does not yet support +-- that syntax for this situation. +-- +-- Having @Encode@ as a class has the advantage that we can define +-- non-generic special cases, which is particularly useful for abstract +-- datatypes that have no structural representation. For example, given +-- a suitable integer encoding function @encodeInt@, we can define +-- +-- @ +-- instance Encode Int where +-- encode = encodeInt +-- @ + +-- *** Omitting generic instances +-- +-- | +-- +-- It is not always required to provide instances for all the generic +-- representation types, but omitting instances restricts the set of +-- datatypes the functions will work for: +-- +-- * If no ':+:' instance is given, the function may still work for +-- empty datatypes or datatypes that have a single constructor, +-- but will fail on datatypes with more than one constructor. +-- +-- * If no ':*:' instance is given, the function may still work for +-- datatypes where each constructor has just zero or one field, +-- in particular for enumeration types. +-- +-- * If no 'K1' instance is given, the function may still work for +-- enumeration types, where no constructor has any fields. +-- +-- * If no 'V1' instance is given, the function may still work for +-- any datatype that is not empty. +-- +-- * If no 'U1' instance is given, the function may still work for +-- any datatype where each constructor has at least one field. +-- +-- An 'M1' instance is always required (but it can just ignore the +-- meta-information, as is the case for @encode@ above). +#if 0 +-- *** Using meta-information +-- +-- | +-- +-- TODO +#endif +-- ** Generic constructor classes +-- +-- | +-- +-- Datatype-generic functions as defined above work for a large class +-- of datatypes, including parameterized datatypes. (We have used @Tree@ +-- as our example above, which is of kind @* -> *@.) However, the +-- 'Generic' class ranges over types of kind @*@, and therefore, the +-- resulting generic functions (such as @encode@) must be parameterized +-- by a generic type argument of kind @*@. +-- +-- What if we want to define generic classes that range over type +-- constructors (such as 'Data.Functor.Functor', +-- 'Data.Traversable.Traversable', or 'Data.Foldable.Foldable')? + +-- *** The 'Generic1' class +-- +-- | +-- +-- Like 'Generic', there is a class 'Generic1' that defines a +-- representation 'Rep1' and conversion functions 'from1' and 'to1', +-- only that 'Generic1' ranges over types of kind @* -> *@. (More generally, +-- it can range over types of kind @k -> *@, for any kind @k@, if the +-- @PolyKinds@ extension is enabled. More on this later.) +-- The 'Generic1' class is also derivable. +-- +-- The representation 'Rep1' is ever so slightly different from 'Rep'. +-- Let us look at @Tree@ as an example again: +-- +-- @ +-- data Tree a = Leaf a | Node (Tree a) (Tree a) +-- deriving 'Generic1' +-- @ +-- +-- The above declaration causes the following representation to be generated: +-- +-- @ +-- instance 'Generic1' Tree where +-- type 'Rep1' Tree = +-- 'D1' ('MetaData \"Tree\" \"Main\" \"package-name\" 'False) +-- ('C1' ('MetaCons \"Leaf\" 'PrefixI 'False) +-- ('S1' ('MetaSel 'Nothing +-- 'NoSourceUnpackedness +-- 'NoSourceStrictness +-- 'DecidedLazy) +-- 'Par1') +-- ':+:' +-- 'C1' ('MetaCons \"Node\" 'PrefixI 'False) +-- ('S1' ('MetaSel 'Nothing +-- 'NoSourceUnpackedness +-- 'NoSourceStrictness +-- 'DecidedLazy) +-- ('Rec1' Tree) +-- ':*:' +-- 'S1' ('MetaSel 'Nothing +-- 'NoSourceUnpackedness +-- 'NoSourceStrictness +-- 'DecidedLazy) +-- ('Rec1' Tree))) +-- ... +-- @ +-- +-- The representation reuses 'D1', 'C1', 'S1' (and thereby 'M1') as well +-- as ':+:' and ':*:' from 'Rep'. (This reusability is the reason that we +-- carry around the dummy type argument for kind-@*@-types, but there are +-- already enough different names involved without duplicating each of +-- these.) +-- +-- What's different is that we now use 'Par1' to refer to the parameter +-- (and that parameter, which used to be @a@), is not mentioned explicitly +-- by name anywhere; and we use 'Rec1' to refer to a recursive use of @Tree a at . + +-- *** Representation of @* -> *@ types +-- +-- | +-- +-- Unlike 'Rec0', the 'Par1' and 'Rec1' type constructors do not +-- map to 'K1'. They are defined directly, as follows: +-- +-- @ +-- newtype 'Par1' p = 'Par1' { 'unPar1' :: p } -- gives access to parameter p +-- newtype 'Rec1' f p = 'Rec1' { 'unRec1' :: f p } -- a wrapper +-- @ +-- +-- In 'Par1', the parameter @p@ is used for the first time, whereas 'Rec1' simply +-- wraps an application of @f@ to @p at . +-- +-- Note that 'K1' (in the guise of 'Rec0') can still occur in a 'Rep1' representation, +-- namely when the datatype has a field that does not mention the parameter. +-- +-- The declaration +-- +-- @ +-- data WithInt a = WithInt Int a +-- deriving 'Generic1' +-- @ +-- +-- yields +-- +-- @ +-- instance 'Generic1' WithInt where +-- type 'Rep1' WithInt = +-- 'D1' ('MetaData \"WithInt\" \"Main\" \"package-name\" 'False) +-- ('C1' ('MetaCons \"WithInt\" 'PrefixI 'False) +-- ('S1' ('MetaSel 'Nothing +-- 'NoSourceUnpackedness +-- 'NoSourceStrictness +-- 'DecidedLazy) +-- ('Rec0' Int) +-- ':*:' +-- 'S1' ('MetaSel 'Nothing +-- 'NoSourceUnpackedness +-- 'NoSourceStrictness +-- 'DecidedLazy) +-- 'Par1')) +-- @ +-- +-- If the parameter @a@ appears underneath a composition of other type constructors, +-- then the representation involves composition, too: +-- +-- @ +-- data Rose a = Fork a [Rose a] +-- @ +-- +-- yields +-- +-- @ +-- instance 'Generic1' Rose where +-- type 'Rep1' Rose = +-- 'D1' ('MetaData \"Rose\" \"Main\" \"package-name\" 'False) +-- ('C1' ('MetaCons \"Fork\" 'PrefixI 'False) +-- ('S1' ('MetaSel 'Nothing +-- 'NoSourceUnpackedness +-- 'NoSourceStrictness +-- 'DecidedLazy) +-- 'Par1' +-- ':*:' +-- 'S1' ('MetaSel 'Nothing +-- 'NoSourceUnpackedness +-- 'NoSourceStrictness +-- 'DecidedLazy) +-- ([] ':.:' 'Rec1' Rose))) +-- @ +-- +-- where +-- +-- @ +-- newtype (':.:') f g p = 'Comp1' { 'unComp1' :: f (g p) } +-- @ + +-- *** Representation of @k -> *@ types +-- +-- | +-- +-- The 'Generic1' class can be generalized to range over types of kind +-- @k -> *@, for any kind @k at . To do so, derive a 'Generic1' instance with the +-- @PolyKinds@ extension enabled. For example, the declaration +-- +-- @ +-- data Proxy (a :: k) = Proxy deriving 'Generic1' +-- @ +-- +-- yields a slightly different instance depending on whether @PolyKinds@ is +-- enabled. If compiled without @PolyKinds@, then @'Rep1' Proxy :: * -> *@, but +-- if compiled with @PolyKinds@, then @'Rep1' Proxy :: k -> *@. + +-- *** Representation of unlifted types +-- +-- | +-- +-- If one were to attempt to derive a Generic instance for a datatype with an +-- unlifted argument (for example, 'Int#'), one might expect the occurrence of +-- the 'Int#' argument to be marked with @'Rec0' 'Int#'@. This won't work, +-- though, since 'Int#' is of an unlifted kind, and 'Rec0' expects a type of +-- kind @*@. +-- +-- One solution would be to represent an occurrence of 'Int#' with 'Rec0 Int' +-- instead. With this approach, however, the programmer has no way of knowing +-- whether the 'Int' is actually an 'Int#' in disguise. +-- +-- Instead of reusing 'Rec0', a separate data family 'URec' is used to mark +-- occurrences of common unlifted types: +-- +-- @ +-- data family URec a p +-- +-- data instance 'URec' ('Ptr' ()) p = 'UAddr' { 'uAddr#' :: 'Addr#' } +-- data instance 'URec' 'Char' p = 'UChar' { 'uChar#' :: 'Char#' } +-- data instance 'URec' 'Double' p = 'UDouble' { 'uDouble#' :: 'Double#' } +-- data instance 'URec' 'Int' p = 'UFloat' { 'uFloat#' :: 'Float#' } +-- data instance 'URec' 'Float' p = 'UInt' { 'uInt#' :: 'Int#' } +-- data instance 'URec' 'Word' p = 'UWord' { 'uWord#' :: 'Word#' } +-- @ +-- +-- Several type synonyms are provided for convenience: +-- +-- @ +-- type 'UAddr' = 'URec' ('Ptr' ()) +-- type 'UChar' = 'URec' 'Char' +-- type 'UDouble' = 'URec' 'Double' +-- type 'UFloat' = 'URec' 'Float' +-- type 'UInt' = 'URec' 'Int' +-- type 'UWord' = 'URec' 'Word' +-- @ +-- +-- The declaration +-- +-- @ +-- data IntHash = IntHash Int# +-- deriving 'Generic' +-- @ +-- +-- yields +-- +-- @ +-- instance 'Generic' IntHash where +-- type 'Rep' IntHash = +-- 'D1' ('MetaData \"IntHash\" \"Main\" \"package-name\" 'False) +-- ('C1' ('MetaCons \"IntHash\" 'PrefixI 'False) +-- ('S1' ('MetaSel 'Nothing +-- 'NoSourceUnpackedness +-- 'NoSourceStrictness +-- 'DecidedLazy) +-- 'UInt')) +-- @ +-- +-- Currently, only the six unlifted types listed above are generated, but this +-- may be extended to encompass more unlifted types in the future. +#if 0 +-- *** Limitations +-- +-- | +-- +-- /TODO/ +-- +-- /TODO:/ Also clear up confusion about 'Rec0' and 'Rec1' not really indicating recursion. +-- +#endif +----------------------------------------------------------------------------- + + -- * Generic representation types + V1, U1(..), Par1(..), Rec1(..), K1(..), M1(..) + , (:+:)(..), (:*:)(..), (:.:)(..) + + -- ** Unboxed representation types + , URec(..) + , type UAddr, type UChar, type UDouble + , type UFloat, type UInt, type UWord + + -- ** Synonyms for convenience + , Rec0, R + , D1, C1, S1, D, C, S + + -- * Meta-information + , Datatype(..), Constructor(..), Selector(..) + , Fixity(..), FixityI(..), Associativity(..), prec + , SourceUnpackedness(..), SourceStrictness(..), DecidedStrictness(..) + , Meta(..) + + -- * Generic type classes + , Generic(..) + , Generic1(..) + + -- * Generic wrapper + , Generically(..) + , Generically1(..) + ) where + +-- We use some base types +import Data.Maybe ( Maybe(..), fromMaybe ) +import GHC.Num.Integer ( Integer, integerToInt ) +import GHC.Prim ( Addr#, Char#, Double#, Float#, Int#, Word# ) +import GHC.Ptr ( Ptr ) +import GHC.Types + +-- Needed for instances +import GHC.Ix ( Ix ) +import GHC.Base ( Alternative(..), Applicative(..), Functor(..) + , Monad(..), MonadPlus(..), String, coerce + , Semigroup(..), Monoid(..) ) +import GHC.Classes ( Eq(..), Ord(..) ) +import GHC.Enum ( Bounded, Enum ) +import GHC.Read ( Read(..) ) +import GHC.Show ( Show(..), showString ) + +-- Needed for metadata +import Data.Proxy ( Proxy(..) ) +import GHC.TypeLits ( KnownSymbol, KnownNat, Nat, symbolVal, natVal ) + +-------------------------------------------------------------------------------- +-- Representation types +-------------------------------------------------------------------------------- + +-- | Void: used for datatypes without constructors +data V1 (p :: k) + deriving ( Eq -- ^ @since 4.9.0.0 + , Ord -- ^ @since 4.9.0.0 + , Read -- ^ @since 4.9.0.0 + , Show -- ^ @since 4.9.0.0 + , Functor -- ^ @since 4.9.0.0 + ) + +-- | @since 4.12.0.0 +instance Semigroup (V1 p) where + v <> _ = v + +-- | Unit: used for constructors without arguments +data U1 (p :: k) = U1 + +-- | @since 4.9.0.0 +instance Eq (U1 p) where + _ == _ = True + +-- | @since 4.7.0.0 +instance Ord (U1 p) where + compare _ _ = EQ + +-- | @since 4.9.0.0 +deriving instance Read (U1 p) + +-- | @since 4.9.0.0 +instance Show (U1 p) where + showsPrec _ _ = showString "U1" + +-- | @since 4.9.0.0 +instance Functor U1 where + fmap _ _ = U1 + +-- | @since 4.9.0.0 +instance Applicative U1 where + pure _ = U1 + _ <*> _ = U1 + liftA2 _ _ _ = U1 + +-- | @since 4.9.0.0 +instance Alternative U1 where + empty = U1 + _ <|> _ = U1 + +-- | @since 4.9.0.0 +instance Monad U1 where + _ >>= _ = U1 + +-- | @since 4.9.0.0 +instance MonadPlus U1 + +-- | @since 4.12.0.0 +instance Semigroup (U1 p) where + _ <> _ = U1 + +-- | @since 4.12.0.0 +instance Monoid (U1 p) where + mempty = U1 + +-- | Used for marking occurrences of the parameter +newtype Par1 p = Par1 { unPar1 :: p } + deriving ( Eq -- ^ @since 4.7.0.0 + , Ord -- ^ @since 4.7.0.0 + , Read -- ^ @since 4.7.0.0 + , Show -- ^ @since 4.7.0.0 + , Functor -- ^ @since 4.9.0.0 + ) + +-- | @since 4.9.0.0 +instance Applicative Par1 where + pure = Par1 + (<*>) = coerce + liftA2 = coerce + +-- | @since 4.9.0.0 +instance Monad Par1 where + Par1 x >>= f = f x + +-- | @since 4.12.0.0 +deriving instance Semigroup p => Semigroup (Par1 p) + +-- | @since 4.12.0.0 +deriving instance Monoid p => Monoid (Par1 p) + +-- | Recursive calls of kind @* -> *@ (or kind @k -> *@, when @PolyKinds@ +-- is enabled) +newtype Rec1 (f :: k -> Type) (p :: k) = Rec1 { unRec1 :: f p } + deriving ( Eq -- ^ @since 4.7.0.0 + , Ord -- ^ @since 4.7.0.0 + , Read -- ^ @since 4.7.0.0 + , Show -- ^ @since 4.7.0.0 + , Functor -- ^ @since 4.9.0.0 + ) + +-- | @since 4.9.0.0 +deriving instance Applicative f => Applicative (Rec1 f) + +-- | @since 4.9.0.0 +deriving instance Alternative f => Alternative (Rec1 f) + +-- | @since 4.9.0.0 +instance Monad f => Monad (Rec1 f) where + Rec1 x >>= f = Rec1 (x >>= \a -> unRec1 (f a)) + +-- | @since 4.9.0.0 +deriving instance MonadPlus f => MonadPlus (Rec1 f) + +-- | @since 4.12.0.0 +deriving instance Semigroup (f p) => Semigroup (Rec1 f p) + +-- | @since 4.12.0.0 +deriving instance Monoid (f p) => Monoid (Rec1 f p) + +-- | Constants, additional parameters and recursion of kind @*@ +newtype K1 (i :: Type) c (p :: k) = K1 { unK1 :: c } + deriving ( Eq -- ^ @since 4.7.0.0 + , Ord -- ^ @since 4.7.0.0 + , Read -- ^ @since 4.7.0.0 + , Show -- ^ @since 4.7.0.0 + , Functor -- ^ @since 4.9.0.0 + ) + +-- | @since 4.12.0.0 +instance Monoid c => Applicative (K1 i c) where + pure _ = K1 mempty + liftA2 = \_ -> coerce (mappend :: c -> c -> c) + (<*>) = coerce (mappend :: c -> c -> c) + +-- | @since 4.12.0.0 +deriving instance Semigroup c => Semigroup (K1 i c p) + +-- | @since 4.12.0.0 +deriving instance Monoid c => Monoid (K1 i c p) + +-- | @since 4.9.0.0 +deriving instance Applicative f => Applicative (M1 i c f) + +-- | @since 4.9.0.0 +deriving instance Alternative f => Alternative (M1 i c f) + +-- | @since 4.9.0.0 +deriving instance Monad f => Monad (M1 i c f) + +-- | @since 4.9.0.0 +deriving instance MonadPlus f => MonadPlus (M1 i c f) + +-- | @since 4.12.0.0 +deriving instance Semigroup (f p) => Semigroup (M1 i c f p) + +-- | @since 4.12.0.0 +deriving instance Monoid (f p) => Monoid (M1 i c f p) + +-- | Meta-information (constructor names, etc.) +newtype M1 (i :: Type) (c :: Meta) (f :: k -> Type) (p :: k) = + M1 { unM1 :: f p } + deriving ( Eq -- ^ @since 4.7.0.0 + , Ord -- ^ @since 4.7.0.0 + , Read -- ^ @since 4.7.0.0 + , Show -- ^ @since 4.7.0.0 + , Functor -- ^ @since 4.9.0.0 + ) + +-- | Sums: encode choice between constructors +infixr 5 :+: +data (:+:) (f :: k -> Type) (g :: k -> Type) (p :: k) = L1 (f p) | R1 (g p) + deriving ( Eq -- ^ @since 4.7.0.0 + , Ord -- ^ @since 4.7.0.0 + , Read -- ^ @since 4.7.0.0 + , Show -- ^ @since 4.7.0.0 + , Functor -- ^ @since 4.9.0.0 + ) + +-- | Products: encode multiple arguments to constructors +infixr 6 :*: +data (:*:) (f :: k -> Type) (g :: k -> Type) (p :: k) = f p :*: g p + deriving ( Eq -- ^ @since 4.7.0.0 + , Ord -- ^ @since 4.7.0.0 + , Read -- ^ @since 4.7.0.0 + , Show -- ^ @since 4.7.0.0 + , Functor -- ^ @since 4.9.0.0 + ) + +-- | @since 4.9.0.0 +instance (Applicative f, Applicative g) => Applicative (f :*: g) where + pure a = pure a :*: pure a + (f :*: g) <*> (x :*: y) = (f <*> x) :*: (g <*> y) + liftA2 f (a :*: b) (x :*: y) = liftA2 f a x :*: liftA2 f b y + +-- | @since 4.9.0.0 +instance (Alternative f, Alternative g) => Alternative (f :*: g) where + empty = empty :*: empty + (x1 :*: y1) <|> (x2 :*: y2) = (x1 <|> x2) :*: (y1 <|> y2) + +-- | @since 4.9.0.0 +instance (Monad f, Monad g) => Monad (f :*: g) where + (m :*: n) >>= f = (m >>= \a -> fstP (f a)) :*: (n >>= \a -> sndP (f a)) + where + fstP (a :*: _) = a + sndP (_ :*: b) = b + +-- | @since 4.9.0.0 +instance (MonadPlus f, MonadPlus g) => MonadPlus (f :*: g) + +-- | @since 4.12.0.0 +instance (Semigroup (f p), Semigroup (g p)) => Semigroup ((f :*: g) p) where + (x1 :*: y1) <> (x2 :*: y2) = (x1 <> x2) :*: (y1 <> y2) + +-- | @since 4.12.0.0 +instance (Monoid (f p), Monoid (g p)) => Monoid ((f :*: g) p) where + mempty = mempty :*: mempty + +-- | Composition of functors +infixr 7 :.: +newtype (:.:) (f :: k2 -> Type) (g :: k1 -> k2) (p :: k1) = + Comp1 { unComp1 :: f (g p) } + deriving ( Eq -- ^ @since 4.7.0.0 + , Ord -- ^ @since 4.7.0.0 + , Read -- ^ @since 4.7.0.0 + , Show -- ^ @since 4.7.0.0 + , Functor -- ^ @since 4.9.0.0 + ) + +-- | @since 4.9.0.0 +instance (Applicative f, Applicative g) => Applicative (f :.: g) where + pure x = Comp1 (pure (pure x)) + Comp1 f <*> Comp1 x = Comp1 (liftA2 (<*>) f x) + liftA2 f (Comp1 x) (Comp1 y) = Comp1 (liftA2 (liftA2 f) x y) + +-- | @since 4.9.0.0 +instance (Alternative f, Applicative g) => Alternative (f :.: g) where + empty = Comp1 empty + (<|>) = coerce ((<|>) :: f (g a) -> f (g a) -> f (g a)) :: + forall a . (f :.: g) a -> (f :.: g) a -> (f :.: g) a + +-- | @since 4.12.0.0 +deriving instance Semigroup (f (g p)) => Semigroup ((f :.: g) p) + +-- | @since 4.12.0.0 +deriving instance Monoid (f (g p)) => Monoid ((f :.: g) p) + +-- | Constants of unlifted kinds +-- +-- @since 4.9.0.0 +data family URec (a :: Type) (p :: k) + +-- | Used for marking occurrences of 'Addr#' +-- +-- @since 4.9.0.0 +data instance URec (Ptr ()) (p :: k) = UAddr { uAddr# :: Addr# } + deriving ( Eq -- ^ @since 4.9.0.0 + , Ord -- ^ @since 4.9.0.0 + , Functor -- ^ @since 4.9.0.0 + ) + +-- | Used for marking occurrences of 'Char#' +-- +-- @since 4.9.0.0 +data instance URec Char (p :: k) = UChar { uChar# :: Char# } + deriving ( Eq -- ^ @since 4.9.0.0 + , Ord -- ^ @since 4.9.0.0 + , Show -- ^ @since 4.9.0.0 + , Functor -- ^ @since 4.9.0.0 + ) + +-- | Used for marking occurrences of 'Double#' +-- +-- @since 4.9.0.0 +data instance URec Double (p :: k) = UDouble { uDouble# :: Double# } + deriving ( Eq -- ^ @since 4.9.0.0 + , Ord -- ^ @since 4.9.0.0 + , Show -- ^ @since 4.9.0.0 + , Functor -- ^ @since 4.9.0.0 + ) + +-- | Used for marking occurrences of 'Float#' +-- +-- @since 4.9.0.0 +data instance URec Float (p :: k) = UFloat { uFloat# :: Float# } + deriving ( Eq, Ord, Show + , Functor -- ^ @since 4.9.0.0 + ) + +-- | Used for marking occurrences of 'Int#' +-- +-- @since 4.9.0.0 +data instance URec Int (p :: k) = UInt { uInt# :: Int# } + deriving ( Eq -- ^ @since 4.9.0.0 + , Ord -- ^ @since 4.9.0.0 + , Show -- ^ @since 4.9.0.0 + , Functor -- ^ @since 4.9.0.0 + ) + +-- | Used for marking occurrences of 'Word#' +-- +-- @since 4.9.0.0 +data instance URec Word (p :: k) = UWord { uWord# :: Word# } + deriving ( Eq -- ^ @since 4.9.0.0 + , Ord -- ^ @since 4.9.0.0 + , Show -- ^ @since 4.9.0.0 + , Functor -- ^ @since 4.9.0.0 + ) + +-- | Type synonym for @'URec' 'Addr#'@ +-- +-- @since 4.9.0.0 +type UAddr = URec (Ptr ()) +-- | Type synonym for @'URec' 'Char#'@ +-- +-- @since 4.9.0.0 +type UChar = URec Char + +-- | Type synonym for @'URec' 'Double#'@ +-- +-- @since 4.9.0.0 +type UDouble = URec Double + +-- | Type synonym for @'URec' 'Float#'@ +-- +-- @since 4.9.0.0 +type UFloat = URec Float + +-- | Type synonym for @'URec' 'Int#'@ +-- +-- @since 4.9.0.0 +type UInt = URec Int + +-- | Type synonym for @'URec' 'Word#'@ +-- +-- @since 4.9.0.0 +type UWord = URec Word + +-- | Tag for K1: recursion (of kind @Type@) +data R + +-- | Type synonym for encoding recursion (of kind @Type@) +type Rec0 = K1 R + +-- | Tag for M1: datatype +data D +-- | Tag for M1: constructor +data C +-- | Tag for M1: record selector +data S + +-- | Type synonym for encoding meta-information for datatypes +type D1 = M1 D + +-- | Type synonym for encoding meta-information for constructors +type C1 = M1 C + +-- | Type synonym for encoding meta-information for record selectors +type S1 = M1 S + +-- | Class for datatypes that represent datatypes +class Datatype d where + -- | The name of the datatype (unqualified) + datatypeName :: t d (f :: k -> Type) (a :: k) -> [Char] + -- | The fully-qualified name of the module where the type is declared + moduleName :: t d (f :: k -> Type) (a :: k) -> [Char] + -- | The package name of the module where the type is declared + -- + -- @since 4.9.0.0 + packageName :: t d (f :: k -> Type) (a :: k) -> [Char] + -- | Marks if the datatype is actually a newtype + -- + -- @since 4.7.0.0 + isNewtype :: t d (f :: k -> Type) (a :: k) -> Bool + isNewtype _ = False + +-- | @since 4.9.0.0 +instance (KnownSymbol n, KnownSymbol m, KnownSymbol p, SingI nt) + => Datatype ('MetaData n m p nt) where + datatypeName _ = symbolVal (Proxy :: Proxy n) + moduleName _ = symbolVal (Proxy :: Proxy m) + packageName _ = symbolVal (Proxy :: Proxy p) + isNewtype _ = fromSing (sing :: Sing nt) + +-- | Class for datatypes that represent data constructors +class Constructor c where + -- | The name of the constructor + conName :: t c (f :: k -> Type) (a :: k) -> [Char] + + -- | The fixity of the constructor + conFixity :: t c (f :: k -> Type) (a :: k) -> Fixity + conFixity _ = Prefix + + -- | Marks if this constructor is a record + conIsRecord :: t c (f :: k -> Type) (a :: k) -> Bool + conIsRecord _ = False + +-- | @since 4.9.0.0 +instance (KnownSymbol n, SingI f, SingI r) + => Constructor ('MetaCons n f r) where + conName _ = symbolVal (Proxy :: Proxy n) + conFixity _ = fromSing (sing :: Sing f) + conIsRecord _ = fromSing (sing :: Sing r) + +-- | Datatype to represent the fixity of a constructor. An infix +-- | declaration directly corresponds to an application of 'Infix'. +data Fixity = Prefix | Infix Associativity Int + deriving ( Eq -- ^ @since 4.6.0.0 + , Show -- ^ @since 4.6.0.0 + , Ord -- ^ @since 4.6.0.0 + , Read -- ^ @since 4.6.0.0 + ) + +-- | This variant of 'Fixity' appears at the type level. +-- +-- @since 4.9.0.0 +data FixityI = PrefixI | InfixI Associativity Nat + +-- | Get the precedence of a fixity value. +prec :: Fixity -> Int +prec Prefix = 10 +prec (Infix _ n) = n + +-- | Datatype to represent the associativity of a constructor +data Associativity = LeftAssociative + | RightAssociative + | NotAssociative + deriving ( Eq -- ^ @since 4.6.0.0 + , Show -- ^ @since 4.6.0.0 + , Ord -- ^ @since 4.6.0.0 + , Read -- ^ @since 4.6.0.0 + , Enum -- ^ @since 4.9.0.0 + , Bounded -- ^ @since 4.9.0.0 + , Ix -- ^ @since 4.9.0.0 + ) + +-- | The unpackedness of a field as the user wrote it in the source code. For +-- example, in the following data type: +-- +-- @ +-- data E = ExampleConstructor Int +-- {\-\# NOUNPACK \#-\} Int +-- {\-\# UNPACK \#-\} Int +-- @ +-- +-- The fields of @ExampleConstructor@ have 'NoSourceUnpackedness', +-- 'SourceNoUnpack', and 'SourceUnpack', respectively. +-- +-- @since 4.9.0.0 +data SourceUnpackedness = NoSourceUnpackedness + | SourceNoUnpack + | SourceUnpack + deriving ( Eq -- ^ @since 4.9.0.0 + , Show -- ^ @since 4.9.0.0 + , Ord -- ^ @since 4.9.0.0 + , Read -- ^ @since 4.9.0.0 + , Enum -- ^ @since 4.9.0.0 + , Bounded -- ^ @since 4.9.0.0 + , Ix -- ^ @since 4.9.0.0 + ) + +-- | The strictness of a field as the user wrote it in the source code. For +-- example, in the following data type: +-- +-- @ +-- data E = ExampleConstructor Int ~Int !Int +-- @ +-- +-- The fields of @ExampleConstructor@ have 'NoSourceStrictness', +-- 'SourceLazy', and 'SourceStrict', respectively. +-- +-- @since 4.9.0.0 +data SourceStrictness = NoSourceStrictness + | SourceLazy + | SourceStrict + deriving ( Eq -- ^ @since 4.9.0.0 + , Show -- ^ @since 4.9.0.0 + , Ord -- ^ @since 4.9.0.0 + , Read -- ^ @since 4.9.0.0 + , Enum -- ^ @since 4.9.0.0 + , Bounded -- ^ @since 4.9.0.0 + , Ix -- ^ @since 4.9.0.0 + ) + +-- | The strictness that GHC infers for a field during compilation. Whereas +-- there are nine different combinations of 'SourceUnpackedness' and +-- 'SourceStrictness', the strictness that GHC decides will ultimately be one +-- of lazy, strict, or unpacked. What GHC decides is affected both by what the +-- user writes in the source code and by GHC flags. As an example, consider +-- this data type: +-- +-- @ +-- data E = ExampleConstructor {\-\# UNPACK \#-\} !Int !Int Int +-- @ +-- +-- * If compiled without optimization or other language extensions, then the +-- fields of @ExampleConstructor@ will have 'DecidedStrict', 'DecidedStrict', +-- and 'DecidedLazy', respectively. +-- +-- * If compiled with @-XStrictData@ enabled, then the fields will have +-- 'DecidedStrict', 'DecidedStrict', and 'DecidedStrict', respectively. +-- +-- * If compiled with @-O2@ enabled, then the fields will have 'DecidedUnpack', +-- 'DecidedStrict', and 'DecidedLazy', respectively. +-- +-- @since 4.9.0.0 +data DecidedStrictness = DecidedLazy + | DecidedStrict + | DecidedUnpack + deriving ( Eq -- ^ @since 4.9.0.0 + , Show -- ^ @since 4.9.0.0 + , Ord -- ^ @since 4.9.0.0 + , Read -- ^ @since 4.9.0.0 + , Enum -- ^ @since 4.9.0.0 + , Bounded -- ^ @since 4.9.0.0 + , Ix -- ^ @since 4.9.0.0 + ) + +-- | Class for datatypes that represent records +class Selector s where + -- | The name of the selector + selName :: t s (f :: k -> Type) (a :: k) -> [Char] + -- | The selector's unpackedness annotation (if any) + -- + -- @since 4.9.0.0 + selSourceUnpackedness :: t s (f :: k -> Type) (a :: k) -> SourceUnpackedness + -- | The selector's strictness annotation (if any) + -- + -- @since 4.9.0.0 + selSourceStrictness :: t s (f :: k -> Type) (a :: k) -> SourceStrictness + -- | The strictness that the compiler inferred for the selector + -- + -- @since 4.9.0.0 + selDecidedStrictness :: t s (f :: k -> Type) (a :: k) -> DecidedStrictness + +-- | @since 4.9.0.0 +instance (SingI mn, SingI su, SingI ss, SingI ds) + => Selector ('MetaSel mn su ss ds) where + selName _ = fromMaybe "" (fromSing (sing :: Sing mn)) + selSourceUnpackedness _ = fromSing (sing :: Sing su) + selSourceStrictness _ = fromSing (sing :: Sing ss) + selDecidedStrictness _ = fromSing (sing :: Sing ds) + +-- | Representable types of kind @*@. +-- This class is derivable in GHC with the @DeriveGeneric@ flag on. +-- +-- A 'Generic' instance must satisfy the following laws: +-- +-- @ +-- 'from' . 'to' ≡ 'Prelude.id' +-- 'to' . 'from' ≡ 'Prelude.id' +-- @ +class Generic a where + -- | Generic representation type + type Rep a :: Type -> Type + -- | Convert from the datatype to its representation + from :: a -> (Rep a) x + -- | Convert from the representation to the datatype + to :: (Rep a) x -> a + + +-- | Representable types of kind @* -> *@ (or kind @k -> *@, when @PolyKinds@ +-- is enabled). +-- This class is derivable in GHC with the @DeriveGeneric@ flag on. +-- +-- A 'Generic1' instance must satisfy the following laws: +-- +-- @ +-- 'from1' . 'to1' ≡ 'Prelude.id' +-- 'to1' . 'from1' ≡ 'Prelude.id' +-- @ +class Generic1 (f :: k -> Type) where + -- | Generic representation type + type Rep1 f :: k -> Type + -- | Convert from the datatype to its representation + from1 :: f a -> (Rep1 f) a + -- | Convert from the representation to the datatype + to1 :: (Rep1 f) a -> f a + +-------------------------------------------------------------------------------- +-- 'Generic' wrapper +-------------------------------------------------------------------------------- + +-- | A datatype whose instances are defined generically, using the +-- 'Generic' representation. 'Generically1' is a higher-kinded version +-- of 'Generically' that uses 'Generic1'. +-- +-- Generic instances can be derived via @'Generically' A@ using +-- @-XDerivingVia at . +-- +-- @ +-- {-# LANGUAGE DeriveGeneric #-} +-- {-# LANGUAGE DerivingStrategies #-} +-- {-# LANGUAGE DerivingVia #-} +-- +-- import GHC.Generics (Generic) +-- +-- data V4 a = V4 a a a a +-- deriving stock Generic +-- +-- deriving (Semigroup, Monoid) +-- via Generically (V4 a) +-- @ +-- +-- This corresponds to 'Semigroup' and 'Monoid' instances defined by +-- pointwise lifting: +-- +-- @ +-- instance Semigroup a => Semigroup (V4 a) where +-- (<>) :: V4 a -> V4 a -> V4 a +-- V4 a1 b1 c1 d1 <> V4 a2 b2 c2 d2 = +-- V4 (a1 <> a2) (b1 <> b2) (c1 <> c2) (d1 <> d2) +-- +-- instance Monoid a => Monoid (V4 a) where +-- mempty :: V4 a +-- mempty = V4 mempty mempty mempty mempty +-- @ +-- +-- Historically this required modifying the type class to include +-- generic method definitions (@-XDefaultSignatures@) and deriving it +-- with the @anyclass@ strategy (@-XDeriveAnyClass@). Having a /via +-- type/ like 'Generically' decouples the instance from the type +-- class. +-- +-- @since 4.17.0.0 +newtype Generically a = Generically a + +-- | @since 4.17.0.0 +instance (Generic a, Semigroup (Rep a ())) => Semigroup (Generically a) where + (<>) :: Generically a -> Generically a -> Generically a + Generically a <> Generically b = Generically (to (from a <> from b :: Rep a ())) + +-- | @since 4.17.0.0 +instance (Generic a, Monoid (Rep a ())) => Monoid (Generically a) where + mempty :: Generically a + mempty = Generically (to (mempty :: Rep a ())) + + mappend :: Generically a -> Generically a -> Generically a + mappend = (<>) + +-- | A type whose instances are defined generically, using the +-- 'Generic1' representation. 'Generically1' is a higher-kinded +-- version of 'Generically' that uses 'Generic'. +-- +-- Generic instances can be derived for type constructors via +-- @'Generically1' F@ using @-XDerivingVia at . +-- +-- @ +-- {-# LANGUAGE DeriveGeneric #-} +-- {-# LANGUAGE DerivingStrategies #-} +-- {-# LANGUAGE DerivingVia #-} +-- +-- import GHC.Generics (Generic) +-- +-- data V4 a = V4 a a a a +-- deriving stock (Functor, Generic1) +-- +-- deriving Applicative +-- via Generically1 V4 +-- @ +-- +-- This corresponds to 'Applicative' instances defined by pointwise +-- lifting: +-- +-- @ +-- instance Applicative V4 where +-- pure :: a -> V4 a +-- pure a = V4 a a a a +-- +-- liftA2 :: (a -> b -> c) -> (V4 a -> V4 b -> V4 c) +-- liftA2 (·) (V4 a1 b1 c1 d1) (V4 a2 b2 c2 d2) = +-- V4 (a1 · a2) (b1 · b2) (c1 · c2) (d1 · d2) +-- @ +-- +-- Historically this required modifying the type class to include +-- generic method definitions (@-XDefaultSignatures@) and deriving it +-- with the @anyclass@ strategy (@-XDeriveAnyClass@). Having a /via +-- type/ like 'Generically1' decouples the instance from the type +-- class. +-- +-- @since 4.17.0.0 +type Generically1 :: forall k. (k -> Type) -> (k -> Type) +newtype Generically1 f a where + Generically1 :: forall {k} f a. f a -> Generically1 @k f a + +-- | @since 4.18.0.0 +instance (Generic1 f, Eq (Rep1 f a)) => Eq (Generically1 f a) where + Generically1 x == Generically1 y = from1 x == from1 y + Generically1 x /= Generically1 y = from1 x /= from1 y + +-- | @since 4.18.0.0 +instance (Generic1 f, Ord (Rep1 f a)) => Ord (Generically1 f a) where + Generically1 x `compare` Generically1 y = from1 x `compare` from1 y + +-- | @since 4.17.0.0 +instance (Generic1 f, Functor (Rep1 f)) => Functor (Generically1 f) where + fmap :: (a -> a') -> (Generically1 f a -> Generically1 f a') + fmap f (Generically1 as) = Generically1 + (to1 (fmap f (from1 as))) + + (<$) :: a -> Generically1 f b -> Generically1 f a + a <$ Generically1 as = Generically1 + (to1 (a <$ from1 as)) + +-- | @since 4.17.0.0 +instance (Generic1 f, Applicative (Rep1 f)) => Applicative (Generically1 f) where + pure :: a -> Generically1 f a + pure a = Generically1 + (to1 (pure a)) + + (<*>) :: Generically1 f (a1 -> a2) -> Generically1 f a1 -> Generically1 f a2 + Generically1 fs <*> Generically1 as = Generically1 + (to1 (from1 fs <*> from1 as)) + + liftA2 :: (a1 -> a2 -> a3) + -> (Generically1 f a1 -> Generically1 f a2 -> Generically1 f a3) + liftA2 (·) (Generically1 as) (Generically1 bs) = Generically1 + (to1 (liftA2 (·) (from1 as) (from1 bs))) + +-- | @since 4.17.0.0 +instance (Generic1 f, Alternative (Rep1 f)) => Alternative (Generically1 f) where + empty :: Generically1 f a + empty = Generically1 + (to1 empty) + + (<|>) :: Generically1 f a -> Generically1 f a -> Generically1 f a + Generically1 as1 <|> Generically1 as2 = Generically1 + (to1 (from1 as1 <|> from1 as2)) + +-------------------------------------------------------------------------------- +-- Meta-data +-------------------------------------------------------------------------------- + +-- | Datatype to represent metadata associated with a datatype (@MetaData@), +-- constructor (@MetaCons@), or field selector (@MetaSel@). +-- +-- * In @MetaData n m p nt@, @n@ is the datatype's name, @m@ is the module in +-- which the datatype is defined, @p@ is the package in which the datatype +-- is defined, and @nt@ is @'True@ if the datatype is a @newtype at . +-- +-- * In @MetaCons n f s@, @n@ is the constructor's name, @f@ is its fixity, +-- and @s@ is @'True@ if the constructor contains record selectors. +-- +-- * In @MetaSel mn su ss ds@, if the field uses record syntax, then @mn@ is +-- 'Just' the record name. Otherwise, @mn@ is 'Nothing'. @su@ and @ss@ are +-- the field's unpackedness and strictness annotations, and @ds@ is the +-- strictness that GHC infers for the field. +-- +-- @since 4.9.0.0 +data Meta = MetaData Symbol Symbol Symbol Bool + | MetaCons Symbol FixityI Bool + | MetaSel (Maybe Symbol) + SourceUnpackedness SourceStrictness DecidedStrictness + +-------------------------------------------------------------------------------- +-- Copied from the singletons package +-------------------------------------------------------------------------------- + +-- | The singleton kind-indexed data family. +data family Sing (a :: k) + +-- | A 'SingI' constraint is essentially an implicitly-passed singleton. +class SingI (a :: k) where + -- | Produce the singleton explicitly. You will likely need the @ScopedTypeVariables@ + -- extension to use this method the way you want. + sing :: Sing a + +-- | The 'SingKind' class is essentially a /kind/ class. It classifies all kinds +-- for which singletons are defined. The class supports converting between a singleton +-- type and the base (unrefined) type which it is built from. +class SingKind k where + -- | Get a base type from a proxy for the promoted kind. For example, + -- @DemoteRep Bool@ will be the type @Bool at . + type DemoteRep k :: Type + + -- | Convert a singleton to its unrefined version. + fromSing :: Sing (a :: k) -> DemoteRep k + +-- Singleton symbols +data instance Sing (s :: Symbol) where + SSym :: KnownSymbol s => Sing s + +-- | @since 4.9.0.0 +instance KnownSymbol a => SingI a where sing = SSym + +-- | @since 4.9.0.0 +instance SingKind Symbol where + type DemoteRep Symbol = String + fromSing (SSym :: Sing s) = symbolVal (Proxy :: Proxy s) + +-- Singleton booleans +data instance Sing (a :: Bool) where + STrue :: Sing 'True + SFalse :: Sing 'False + +-- | @since 4.9.0.0 +instance SingI 'True where sing = STrue + +-- | @since 4.9.0.0 +instance SingI 'False where sing = SFalse + +-- | @since 4.9.0.0 +instance SingKind Bool where + type DemoteRep Bool = Bool + fromSing STrue = True + fromSing SFalse = False + +-- Singleton Maybe +data instance Sing (b :: Maybe a) where + SNothing :: Sing 'Nothing + SJust :: Sing a -> Sing ('Just a) + +-- | @since 4.9.0.0 +instance SingI 'Nothing where sing = SNothing + +-- | @since 4.9.0.0 +instance SingI a => SingI ('Just a) where sing = SJust sing + +-- | @since 4.9.0.0 +instance SingKind a => SingKind (Maybe a) where + type DemoteRep (Maybe a) = Maybe (DemoteRep a) + fromSing SNothing = Nothing + fromSing (SJust a) = Just (fromSing a) + +-- Singleton Fixity +data instance Sing (a :: FixityI) where + SPrefix :: Sing 'PrefixI + SInfix :: Sing a -> Integer -> Sing ('InfixI a n) + +-- | @since 4.9.0.0 +instance SingI 'PrefixI where sing = SPrefix + +-- | @since 4.9.0.0 +instance (SingI a, KnownNat n) => SingI ('InfixI a n) where + sing = SInfix (sing :: Sing a) (natVal (Proxy :: Proxy n)) + +-- | @since 4.9.0.0 +instance SingKind FixityI where + type DemoteRep FixityI = Fixity + fromSing SPrefix = Prefix + fromSing (SInfix a n) = Infix (fromSing a) (integerToInt n) + +-- Singleton Associativity +data instance Sing (a :: Associativity) where + SLeftAssociative :: Sing 'LeftAssociative + SRightAssociative :: Sing 'RightAssociative + SNotAssociative :: Sing 'NotAssociative + +-- | @since 4.9.0.0 +instance SingI 'LeftAssociative where sing = SLeftAssociative + +-- | @since 4.9.0.0 +instance SingI 'RightAssociative where sing = SRightAssociative + +-- | @since 4.9.0.0 +instance SingI 'NotAssociative where sing = SNotAssociative + +-- | @since 4.0.0.0 +instance SingKind Associativity where + type DemoteRep Associativity = Associativity + fromSing SLeftAssociative = LeftAssociative + fromSing SRightAssociative = RightAssociative + fromSing SNotAssociative = NotAssociative + +-- Singleton SourceUnpackedness +data instance Sing (a :: SourceUnpackedness) where + SNoSourceUnpackedness :: Sing 'NoSourceUnpackedness + SSourceNoUnpack :: Sing 'SourceNoUnpack + SSourceUnpack :: Sing 'SourceUnpack + +-- | @since 4.9.0.0 +instance SingI 'NoSourceUnpackedness where sing = SNoSourceUnpackedness + +-- | @since 4.9.0.0 +instance SingI 'SourceNoUnpack where sing = SSourceNoUnpack + +-- | @since 4.9.0.0 +instance SingI 'SourceUnpack where sing = SSourceUnpack + +-- | @since 4.9.0.0 +instance SingKind SourceUnpackedness where + type DemoteRep SourceUnpackedness = SourceUnpackedness + fromSing SNoSourceUnpackedness = NoSourceUnpackedness + fromSing SSourceNoUnpack = SourceNoUnpack + fromSing SSourceUnpack = SourceUnpack + +-- Singleton SourceStrictness +data instance Sing (a :: SourceStrictness) where + SNoSourceStrictness :: Sing 'NoSourceStrictness + SSourceLazy :: Sing 'SourceLazy + SSourceStrict :: Sing 'SourceStrict + +-- | @since 4.9.0.0 +instance SingI 'NoSourceStrictness where sing = SNoSourceStrictness + +-- | @since 4.9.0.0 +instance SingI 'SourceLazy where sing = SSourceLazy + +-- | @since 4.9.0.0 +instance SingI 'SourceStrict where sing = SSourceStrict + +-- | @since 4.9.0.0 +instance SingKind SourceStrictness where + type DemoteRep SourceStrictness = SourceStrictness + fromSing SNoSourceStrictness = NoSourceStrictness + fromSing SSourceLazy = SourceLazy + fromSing SSourceStrict = SourceStrict + +-- Singleton DecidedStrictness +data instance Sing (a :: DecidedStrictness) where + SDecidedLazy :: Sing 'DecidedLazy + SDecidedStrict :: Sing 'DecidedStrict + SDecidedUnpack :: Sing 'DecidedUnpack + +-- | @since 4.9.0.0 +instance SingI 'DecidedLazy where sing = SDecidedLazy + +-- | @since 4.9.0.0 +instance SingI 'DecidedStrict where sing = SDecidedStrict + +-- | @since 4.9.0.0 +instance SingI 'DecidedUnpack where sing = SDecidedUnpack + +-- | @since 4.9.0.0 +instance SingKind DecidedStrictness where + type DemoteRep DecidedStrictness = DecidedStrictness + fromSing SDecidedLazy = DecidedLazy + fromSing SDecidedStrict = DecidedStrict + fromSing SDecidedUnpack = DecidedUnpack ===================================== libraries/base/base.cabal ===================================== @@ -223,6 +223,7 @@ Library GHC.GHCi GHC.GHCi.Helpers GHC.Generics + GHC.Generics.Internal GHC.InfoProv GHC.IO GHC.IO.Buffer View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e741c9600f1ba28b2294cb965cd32fcbce43fbb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e741c9600f1ba28b2294cb965cd32fcbce43fbb You're receiving 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 Jun 28 14:55:46 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Wed, 28 Jun 2023 10:55:46 -0400 Subject: [Git][ghc/ghc][wip/T22010] Replace fromIntegral with specialized versions Message-ID: <649c49f256ad5_3b5ae2c7628255211@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 718d3295 by Jaro Reinders at 2023-06-28T16:55:37+02:00 Replace fromIntegral with specialized versions - - - - - 10 changed files: - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/StgToJS/Symbols.hs - compiler/GHC/Types/Unique.hs - + compiler/GHC/Utils/Word64.hs - compiler/ghc.cabal.in - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout Changes: ===================================== compiler/GHC/Builtin/Uniques.hs ===================================== @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeApplications #-} + -- | This is where we define a mapping from Uniques to their associated -- known-key Names for things associated with tuples and sums. We use this @@ -69,7 +69,7 @@ import GHC.Utils.Panic import GHC.Utils.Panic.Plain (assert) import Data.Maybe -import Data.Word (Word64) +import GHC.Utils.Word64 (word64ToInt, intToWord64) -- | Get the 'Name' associated with a known-key 'Unique'. knownUniqueName :: Unique -> Maybe Name @@ -87,7 +87,7 @@ knownUniqueName u = where (tag, n') = unpkUnique u -- Known unique names are guaranteed to fit in Int, so we don't need the whole Word64. - n = assert (isValidKnownKeyUnique u) (fromIntegral @Word64 @Int n') + n = assert (isValidKnownKeyUnique u) (word64ToInt n') {- Note [Unique layout for unboxed sums] @@ -284,8 +284,8 @@ isTupleTyConUnique u = (tag, n) = unpkUnique u (arity', i) = quotRem n 2 arity = - assert (arity' <= fromIntegral @Int @Word64 (maxBound :: Int)) - (fromIntegral @Word64 @Int arity') + assert (arity' <= intToWord64 (maxBound :: Int)) + (word64ToInt arity') getTupleTyConName :: Boxity -> Int -> Name getTupleTyConName boxity n = ===================================== compiler/GHC/Cmm/CommonBlockElim.hs ===================================== @@ -1,5 +1,4 @@ {-# LANGUAGE GADTs, BangPatterns, ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} module GHC.Cmm.CommonBlockElim ( elimCommonBlocks @@ -27,6 +26,7 @@ import qualified Data.Map as M import qualified GHC.Data.TrieMap as TM import GHC.Types.Unique.FM import GHC.Types.Unique +import GHC.Utils.Word64 (truncateWord64ToWord32) import Control.Arrow (first, second) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE @@ -186,7 +186,7 @@ hash_block block = -- Since we are hashing, we can savely downcast Word64 to Word32 here. -- Although a different hashing function may be more effective. hash_unique :: Uniquable a => a -> Word32 - hash_unique = fromIntegral @Word64 @Word32 . getKey . getUnique + hash_unique = truncateWord64ToWord32 . getKey . getUnique -- | Ignore these node types for equality dont_care :: CmmNode O x -> Bool ===================================== compiler/GHC/Cmm/Dominators.hs ===================================== @@ -1,5 +1,4 @@ {-# LANGUAGE GADTs #-} -{-# LANGUAGE TypeApplications #-} module GHC.Cmm.Dominators ( @@ -41,6 +40,7 @@ import GHC.Cmm import GHC.Utils.Outputable( Outputable(..), text, int, hcat, (<+>)) import GHC.Utils.Misc import GHC.Utils.Panic +import GHC.Utils.Word64 (intToWord64) import qualified GHC.Data.Word64Map as WM import qualified GHC.Data.Word64Set as WS @@ -151,7 +151,7 @@ graphWithDominators g = GraphWithDominators (reachable rpblocks g) dmap rpmap blockIndex = labelIndex . entryLabel bounds :: (Word64, Word64) - bounds = (0, fromIntegral @Int @Word64 (length rpblocks - 1)) + bounds = (0, intToWord64 (length rpblocks - 1)) ltGraph :: [Block node C C] -> LT.Graph ltGraph [] = WM.empty ===================================== compiler/GHC/CmmToAsm/CFG/Dominators.hs ===================================== @@ -445,7 +445,7 @@ writes a xs = forM_ xs (\(i,x) -> (a.=x) i) fromAdj :: [(Node, [Node])] -> Graph fromAdj = WM.fromList . fmap (second WS.fromList) -fromEdges :: [(Node,Node)] -> Graph +fromEdges :: [Edge] -> Graph fromEdges = collectW WS.union fst (WS.singleton . snd) toAdj :: Graph -> [(Node, [Node])] ===================================== compiler/GHC/StgToJS/Symbols.hs ===================================== @@ -1,4 +1,3 @@ -{-# LANGUAGE TypeApplications #-} -- | JS symbol generation module GHC.StgToJS.Symbols @@ -16,6 +15,7 @@ import GHC.Prelude import GHC.Data.FastString import GHC.Unit.Module +import GHC.Utils.Word64 (intToWord64) import Data.ByteString (ByteString) import Data.Word (Word64) import qualified Data.ByteString.Char8 as BSC @@ -26,7 +26,7 @@ import qualified Data.ByteString.Lazy as BSL -- -- Used for the sub indices. intBS :: Int -> ByteString -intBS = word64BS . fromIntegral @Int @Word64 +intBS = word64BS . intToWord64 -- | Hexadecimal representation of a 64-bit word -- ===================================== compiler/GHC/Types/Unique.hs ===================================== @@ -19,7 +19,6 @@ Haskell). {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns, MagicHash #-} -{-# LANGUAGE TypeApplications #-} module GHC.Types.Unique ( -- * Main data types @@ -56,6 +55,7 @@ import GHC.Prelude import GHC.Data.FastString import GHC.Utils.Outputable +import GHC.Utils.Word64 (intToWord64, word64ToInt) -- just for implementing a fast [0,61) -> Char function import GHC.Exts (indexCharOffAddr#, Char(..), Int(..)) @@ -145,7 +145,7 @@ uniqueMask = (1 `shiftL` uNIQUE_BITS) - 1 -- This function is used in @`mkSplitUniqSupply`@ so that it can -- precompute and share the tag part of the uniques it generates. mkTag :: Char -> Word64 -mkTag c = fromIntegral @Int @Word64 (ord c) `shiftL` uNIQUE_BITS +mkTag c = intToWord64 (ord c) `shiftL` uNIQUE_BITS -- pop the Char in the top 8 bits of the Unique(Supply) @@ -162,16 +162,16 @@ mkUnique c i bits = i .&. uniqueMask mkUniqueInt :: Char -> Int -> Unique -mkUniqueInt c i = mkUnique c (fromIntegral @Int @Word64 i) +mkUniqueInt c i = mkUnique c (intToWord64 i) mkUniqueIntGrimily :: Int -> Unique -mkUniqueIntGrimily = MkUnique . fromIntegral @Int @Word64 +mkUniqueIntGrimily = MkUnique . intToWord64 unpkUnique (MkUnique u) = let -- The potentially truncating use of fromIntegral here is safe -- because the argument is just the tag bits after shifting. - tag = chr (fromIntegral @Word64 @Int (u `shiftR` uNIQUE_BITS)) + tag = chr (word64ToInt (u `shiftR` uNIQUE_BITS)) i = u .&. uniqueMask in (tag, i) @@ -332,13 +332,13 @@ Code stolen from Lennart. w64ToBase62 :: Word64 -> String w64ToBase62 n_ = go n_ "" where - -- The uses of potentially truncating uses fromIntegral here are safe + -- The potentially truncating uses of fromIntegral here are safe -- because the argument is guaranteed to be less than 62 in both cases. go n cs | n < 62 - = let !c = chooseChar62 (fromIntegral @Word64 @Int n) in c : cs + = let !c = chooseChar62 (word64ToInt n) in c : cs | otherwise = go q (c : cs) where (!q, r) = quotRem n 62 - !c = chooseChar62 (fromIntegral @Word64 @Int r) + !c = chooseChar62 (word64ToInt r) chooseChar62 :: Int -> Char {-# INLINE chooseChar62 #-} ===================================== compiler/GHC/Utils/Word64.hs ===================================== @@ -0,0 +1,20 @@ +module GHC.Utils.Word64 ( + intToWord64, + word64ToInt, + truncateWord64ToWord32, + ) where + +import GHC.Prelude +import GHC.Utils.Panic.Plain (assert) + +import Data.Word +import GHC.Stack + +intToWord64 :: HasCallStack => Int -> Word64 +intToWord64 x = assert (0 <= x) (fromIntegral x) + +word64ToInt :: HasCallStack => Word64 -> Int +word64ToInt x = assert (x <= fromIntegral (maxBound :: Int)) (fromIntegral x) + +truncateWord64ToWord32 :: Word64 -> Word32 +truncateWord64ToWord32 = fromIntegral \ No newline at end of file ===================================== compiler/ghc.cabal.in ===================================== @@ -901,6 +901,7 @@ Library GHC.Utils.TmpFs GHC.Utils.Trace GHC.Utils.Unique + GHC.Utils.Word64 GHC.Wasm.ControlFlow GHC.Wasm.ControlFlow.FromCmm GHC.CmmToAsm.Wasm ===================================== testsuite/tests/count-deps/CountDepsAst.stdout ===================================== @@ -316,6 +316,7 @@ GHC.Utils.Ppr.Colour GHC.Utils.TmpFs GHC.Utils.Trace GHC.Utils.Unique +GHC.Utils.Word64 Language.Haskell.Syntax Language.Haskell.Syntax.Basic Language.Haskell.Syntax.Binds ===================================== testsuite/tests/count-deps/CountDepsParser.stdout ===================================== @@ -323,6 +323,7 @@ GHC.Utils.Ppr.Colour GHC.Utils.TmpFs GHC.Utils.Trace GHC.Utils.Unique +GHC.Utils.Word64 Language.Haskell.Syntax Language.Haskell.Syntax.Basic Language.Haskell.Syntax.Binds View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/718d3295febef15dca2f90789d1ff87cc44d35fe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/718d3295febef15dca2f90789d1ff87cc44d35fe You're receiving 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 Jun 28 15:06:58 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 28 Jun 2023 11:06:58 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23568 Message-ID: <649c4c921faa1_3b5ae2c7614260028@gitlab.mail> Ben Gamari pushed new branch wip/T23568 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23568 You're receiving 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 Jun 28 15:21:24 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 28 Jun 2023 11:21:24 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/tracing-rework Message-ID: <649c4ff480238_3b5ae2c75ec264083@gitlab.mail> Ben Gamari pushed new branch wip/tracing-rework at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/tracing-rework You're receiving 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 Jun 28 15:38:40 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 28 Jun 2023 11:38:40 -0400 Subject: [Git][ghc/ghc][wip/T23568] Define FFI_GO_CLOSURES Message-ID: <649c54005c9b5_3b5ae2c76142657b9@gitlab.mail> Ben Gamari pushed to branch wip/T23568 at Glasgow Haskell Compiler / GHC Commits: 35710a32 by Ben Gamari at 2023-06-28T11:38:34-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - 7 changed files: - compiler/GHC/Driver/CodeOutput.hs - libraries/ghci/GHCi/FFI.hsc - rts/Interpreter.c - rts/adjustor/LibffiAdjustor.c - + rts/include/rts/ghc_ffi.h - rts/rts.cabal.in - rts/sm/Storage.c Changes: ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -295,7 +295,7 @@ outputForeignStubs logger tmpfs dflags unit_state mod location stubs -- wrapper code mentions the ffi_arg type, which comes from ffi.h ffi_includes - | platformMisc_libFFI $ platformMisc dflags = "#include \n" + | platformMisc_libFFI $ platformMisc dflags = "#include \"ghc_ffi.h\"\n" | otherwise = "" stub_h_file_exists ===================================== libraries/ghci/GHCi/FFI.hsc ===================================== @@ -23,6 +23,13 @@ #if !defined(javascript_HOST_ARCH) #include + +-- See Note [FFI_GO_CLOSURES workaround] in ghc_ffi.h +#if darwin_HOST_OS +#if !defined(FFI_GO_CLOSURES) +#define FFI_GO_CLOSURES 0 +#endif +#endif #endif {-# LANGUAGE CPP, DeriveGeneric, DeriveAnyClass #-} ===================================== rts/Interpreter.c ===================================== @@ -39,7 +39,7 @@ #endif #endif -#include "ffi.h" +#include "rts/ghc_ffi.h" /* -------------------------------------------------------------------------- * The bytecode interpreter ===================================== rts/adjustor/LibffiAdjustor.c ===================================== @@ -11,7 +11,7 @@ #include "Hash.h" #include "Adjustor.h" -#include "ffi.h" +#include "rts/ghc_ffi.h" #include // Note that ffi_alloc_prep_closure is a non-standard libffi closure ===================================== rts/include/rts/ghc_ffi.h ===================================== @@ -0,0 +1,28 @@ +/* + * wrapper working around #23586. + * + * (c) The University of Glasgow 2023 + * + */ + +#pragma once + +#include "ffi.h" + +/* + * Note [FFI_GO_CLOSURES workaround] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * Apple ships a broken libffi with Xcode which lacks a definition of + * FFI_GO_CLOSURES despite having references to said macro. Work around this + * for now to avoid -Wundef warnings. + * + * We choose the value zero here by following the model of OpenJDK. + * See https://github.com/openjdk/jdk17u-dev/pull/741/files. + * + * See #23568. + */ +#if darwin_HOST_OS +#if !defined(FFI_GO_CLOSURES) +#define FFI_GO_CLOSURES 0 +#endif +#endif ===================================== rts/rts.cabal.in ===================================== @@ -237,6 +237,7 @@ library rts/EventLogConstants.h rts/EventTypes.h -- ^ generated + rts/ghc_ffi.h rts/Adjustor.h rts/ExecPage.h rts/BlockSignals.h ===================================== rts/sm/Storage.c ===================================== @@ -53,7 +53,7 @@ #include -#include "ffi.h" +#include "rts/ghc_ffi.h" /* * All these globals require sm_mutex to access in THREADED_RTS mode. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/35710a3262ab307e4ceb84403c389132ec71a4bf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/35710a3262ab307e4ceb84403c389132ec71a4bf You're receiving 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 Jun 28 15:47:41 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Wed, 28 Jun 2023 11:47:41 -0400 Subject: [Git][ghc/ghc][wip/T22010] Rename mask to tag Message-ID: <649c561dd7e49_3b5ae2c761427303c@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 64e13a3b by Jaro Reinders at 2023-06-28T17:47:30+02:00 Rename mask to tag - - - - - 12 changed files: - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Name/Cache.hs - compiler/GHC/Types/Unique.hs - compiler/GHC/Types/Unique/Supply.hs Changes: ===================================== compiler/GHC/Builtin/Uniques.hs ===================================== @@ -305,7 +305,7 @@ getTupleDataConName boxity n = _ -> panic "getTupleDataConName: impossible" {- -Note [Uniques for wired-in prelude things and known masks] +Note [Uniques for wired-in prelude things and known tags] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Allocation of unique supply characters: v,u: for renumbering value-, and usage- vars. ===================================== compiler/GHC/CmmToLlvm/Base.hs ===================================== @@ -260,7 +260,7 @@ data LlvmEnv = LlvmEnv , envConfig :: !LlvmCgConfig -- ^ Configuration for LLVM code gen , envLogger :: !Logger -- ^ Logger , envOutput :: BufHandle -- ^ Output buffer - , envMask :: !Char -- ^ Mask for creating unique values + , envTag :: !Char -- ^ Tag for creating unique values , envFreshMeta :: MetaId -- ^ Supply of fresh metadata IDs , envUniqMeta :: UniqFM Unique MetaId -- ^ Global metadata nodes , envFunMap :: LlvmEnvMap -- ^ Global functions so far, with type @@ -292,12 +292,12 @@ getConfig = LlvmM $ \env -> return (envConfig env, env) instance MonadUnique LlvmM where getUniqueSupplyM = do - mask <- getEnv envMask - liftIO $! mkSplitUniqSupply mask + tag <- getEnv envTag + liftIO $! mkSplitUniqSupply tag getUniqueM = do - mask <- getEnv envMask - liftIO $! uniqFromMask mask + tag <- getEnv envTag + liftIO $! uniqFromTag tag -- | Lifting of IO actions. Not exported, as we want to encapsulate IO. liftIO :: IO a -> LlvmM a @@ -318,7 +318,7 @@ runLlvm logger cfg ver out m = do , envConfig = cfg , envLogger = logger , envOutput = out - , envMask = 'n' + , envTag = 'n' , envFreshMeta = MetaId 0 , envUniqMeta = emptyUFM } ===================================== compiler/GHC/Core/Opt/Monad.hs ===================================== @@ -20,7 +20,7 @@ module GHC.Core.Opt.Monad ( initRuleEnv, getExternalRuleBase, getDynFlags, getPackageFamInstEnv, getInteractiveContext, - getUniqMask, + getUniqTag, getNamePprCtx, getSrcSpanM, -- ** Writing to the monad @@ -117,7 +117,7 @@ data CoreReader = CoreReader { cr_name_ppr_ctx :: NamePprCtx, cr_loc :: SrcSpan, -- Use this for log/error messages so they -- are at least tagged with the right source file - cr_uniq_mask :: !Char -- Mask for creating unique values + cr_uniq_tag :: !Char -- Tag for creating unique values } -- Note: CoreWriter used to be defined with data, rather than newtype. If it @@ -167,12 +167,12 @@ instance MonadPlus CoreM instance MonadUnique CoreM where getUniqueSupplyM = do - mask <- read cr_uniq_mask - liftIO $! mkSplitUniqSupply mask + tag <- read cr_uniq_tag + liftIO $! mkSplitUniqSupply tag getUniqueM = do - mask <- read cr_uniq_mask - liftIO $! uniqFromMask mask + tag <- read cr_uniq_tag + liftIO $! uniqFromTag tag runCoreM :: HscEnv -> RuleBase @@ -182,7 +182,7 @@ runCoreM :: HscEnv -> SrcSpan -> CoreM a -> IO (a, SimplCount) -runCoreM hsc_env rule_base mask mod name_ppr_ctx loc m +runCoreM hsc_env rule_base tag mod name_ppr_ctx loc m = liftM extract $ runIOEnv reader $ unCoreM m where reader = CoreReader { @@ -191,7 +191,7 @@ runCoreM hsc_env rule_base mask mod name_ppr_ctx loc m cr_module = mod, cr_name_ppr_ctx = name_ppr_ctx, cr_loc = loc, - cr_uniq_mask = mask + cr_uniq_tag = tag } extract :: (a, CoreWriter) -> (a, SimplCount) @@ -261,8 +261,8 @@ getSrcSpanM = read cr_loc addSimplCount :: SimplCount -> CoreM () addSimplCount count = write (CoreWriter { cw_simpl_count = count }) -getUniqMask :: CoreM Char -getUniqMask = read cr_uniq_mask +getUniqTag :: CoreM Char +getUniqTag = read cr_uniq_tag -- Convenience accessors for useful fields of HscEnv ===================================== compiler/GHC/Core/Opt/Pipeline.hs ===================================== @@ -77,9 +77,9 @@ core2core hsc_env guts@(ModGuts { mg_module = mod , mg_loc = loc , mg_rdr_env = rdr_env }) = do { let builtin_passes = getCoreToDo dflags hpt_rule_base extra_vars - uniq_mask = 's' + uniq_tag = 's' - ; (guts2, stats) <- runCoreM hsc_env hpt_rule_base uniq_mask mod + ; (guts2, stats) <- runCoreM hsc_env hpt_rule_base uniq_tag mod name_ppr_ctx loc $ do { hsc_env' <- getHscEnv ; all_passes <- withPlugins (hsc_plugins hsc_env') ===================================== compiler/GHC/Core/Opt/Simplify/Monad.hs ===================================== @@ -180,13 +180,13 @@ traceSmpl herald doc ************************************************************************ -} --- See Note [Uniques for wired-in prelude things and known masks] in GHC.Builtin.Uniques -simplMask :: Char -simplMask = 's' +-- See Note [Uniques for wired-in prelude things and known tags] in GHC.Builtin.Uniques +simplTag :: Char +simplTag = 's' instance MonadUnique SimplM where - getUniqueSupplyM = liftIO $ mkSplitUniqSupply simplMask - getUniqueM = liftIO $ uniqFromMask simplMask + getUniqueSupplyM = liftIO $ mkSplitUniqSupply simplTag + getUniqueM = liftIO $ uniqFromTag simplTag instance HasLogger SimplM where getLogger = gets st_logger ===================================== compiler/GHC/Stg/Pipeline.hs ===================================== @@ -57,10 +57,10 @@ newtype StgM a = StgM { _unStgM :: ReaderT Char IO a } deriving (Functor, Applicative, Monad, MonadIO) instance MonadUnique StgM where - getUniqueSupplyM = StgM $ do { mask <- ask - ; liftIO $! mkSplitUniqSupply mask} - getUniqueM = StgM $ do { mask <- ask - ; liftIO $! uniqFromMask mask} + getUniqueSupplyM = StgM $ do { tag <- ask + ; liftIO $! mkSplitUniqSupply tag} + getUniqueM = StgM $ do { tag <- ask + ; liftIO $! uniqFromTag tag} runStgM :: Char -> StgM a -> IO a runStgM mask (StgM m) = runReaderT m mask ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -250,7 +250,7 @@ data Env gbl lcl -- Includes all info about imported things -- BangPattern is to fix leak, see #15111 - env_um :: {-# UNPACK #-} !Char, -- Mask for Uniques + env_ut :: {-# UNPACK #-} !Char, -- Tag for Uniques env_gbl :: gbl, -- Info about things defined at the top level -- of the module being compiled ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -322,7 +322,7 @@ unkSkolAnon = UnkSkol callStack -- shares a certain 'Unique'. mkSkolemInfo :: MonadIO m => SkolemInfoAnon -> m SkolemInfo mkSkolemInfo sk_anon = do - u <- liftIO $! uniqFromMask 's' + u <- liftIO $! uniqFromTag 's' return (SkolemInfo u sk_anon) getSkolemInfo :: SkolemInfo -> SkolemInfoAnon ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -450,14 +450,14 @@ an actual crash (attempting to look up the Integer type). ************************************************************************ -} -initTcRnIf :: Char -- ^ Mask for unique supply +initTcRnIf :: Char -- ^ Tag for unique supply -> HscEnv -> gbl -> lcl -> TcRnIf gbl lcl a -> IO a -initTcRnIf uniq_mask hsc_env gbl_env lcl_env thing_inside +initTcRnIf uniq_tag hsc_env gbl_env lcl_env thing_inside = do { let { env = Env { env_top = hsc_env, - env_um = uniq_mask, + env_ut = uniq_tag, env_gbl = gbl_env, env_lcl = lcl_env} } @@ -710,14 +710,14 @@ escapeArrowScope newUnique :: TcRnIf gbl lcl Unique newUnique = do { env <- getEnv - ; let mask = env_um env - ; liftIO $! uniqFromMask mask } + ; let tag = env_ut env + ; liftIO $! uniqFromTag tag } newUniqueSupply :: TcRnIf gbl lcl UniqSupply newUniqueSupply = do { env <- getEnv - ; let mask = env_um env - ; liftIO $! mkSplitUniqSupply mask } + ; let tag = env_ut env + ; liftIO $! mkSplitUniqSupply tag } cloneLocalName :: Name -> TcM Name -- Make a fresh Internal name with the same OccName and SrcSpan ===================================== compiler/GHC/Types/Name/Cache.hs ===================================== @@ -100,7 +100,7 @@ data NameCache = NameCache type OrigNameCache = ModuleEnv (OccEnv Name) takeUniqFromNameCache :: NameCache -> IO Unique -takeUniqFromNameCache (NameCache c _) = uniqFromMask c +takeUniqFromNameCache (NameCache c _) = uniqFromTag c lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name lookupOrigNameCache nc mod occ ===================================== compiler/GHC/Types/Unique.hs ===================================== @@ -72,16 +72,16 @@ import Language.Haskell.Syntax.Module.Name * * ************************************************************************ -Note [Uniques and masks] +Note [Uniques and tags] ~~~~~~~~~~~~~~~~~~~~~~~~ A `Unique` in GHC is a 64 bit value composed of two pieces: -* A "mask", of width `UNIQUE_TAG_BITS`, in the high order bits +* A "tag", of width `UNIQUE_TAG_BITS`, in the high order bits * A number, of width `uNIQUE_BITS`, which fills up the remainder of the Word64 -The mask is typically an ASCII character. It is typically used to make it easier +The tag is typically an ASCII character. It is typically used to make it easier to distinguish uniques constructed by different parts of the compiler. -There is a (potentially incomplete) list of unique masks used given in -GHC.Builtin.Uniques. See Note [Uniques for wired-in prelude things and known masks] +There is a (potentially incomplete) list of unique tags used given in +GHC.Builtin.Uniques. See Note [Uniques for wired-in prelude things and known tags] `mkUnique` constructs a `Unique` from its pieces mkUnique :: Char -> Word64 -> Unique @@ -135,8 +135,7 @@ maxLocalUnique = mkLocalUnique uniqueMask -- newTagUnique changes the "domain" of a unique to a different char newTagUnique u c = mkUnique c i where (_,i) = unpkUnique u --- | How many bits are devoted to the unique index (as opposed to the class --- character). +-- | Bitmask that has zeros for the tag bits and ones for the rest. uniqueMask :: Word64 uniqueMask = (1 `shiftL` uNIQUE_BITS) - 1 ===================================== compiler/GHC/Types/Unique/Supply.hs ===================================== @@ -15,7 +15,7 @@ module GHC.Types.Unique.Supply ( -- ** Operations on supplies uniqFromSupply, uniqsFromSupply, -- basic ops - takeUniqFromSupply, uniqFromMask, + takeUniqFromSupply, uniqFromTag, mkSplitUniqSupply, splitUniqSupply, listSplitUniqSupply, @@ -90,24 +90,24 @@ The general design (used throughout GHC) is to: * For creating new uniques either a UniqSupply is used and threaded through or for monadic code a MonadUnique instance might conjure up uniques using - `uniqFromMask`. + `uniqFromTag`. * Different parts of the compiler will use a UniqSupply or MonadUnique instance - with a specific mask. This way the different parts of the compiler will - generate uniques with different masks. + with a specific tag. This way the different parts of the compiler will + generate uniques with different tags. -If different code shares the same mask then care has to be taken that all uniques +If different code shares the same tag then care has to be taken that all uniques still get distinct numbers. Usually this is done by relying on genSym which has *one* counter per GHC invocation that is relied on by all calls to it. But using something like the address for pinned objects works as well and in fact is done for fast strings. This is important for example in the simplifier. Most passes of the simplifier use -the same mask 's'. However in some places we create a unique supply using `mkSplitUniqSupply` +the same tag 's'. However in some places we create a unique supply using `mkSplitUniqSupply` and thread it through the code, while in GHC.Core.Opt.Simplify.Monad we use the `instance MonadUnique SimplM`, which uses `mkSplitUniqSupply` in getUniqueSupplyM -and `uniqFromMask` in getUniqueM. +and `uniqFromTag` in getUniqueM. -Ultimately all these boil down to each new unique consisting of the mask and the result from +Ultimately all these boil down to each new unique consisting of the tag and the result from a call to `genSym`. The latter producing a distinct number for each invocation ensuring uniques are distinct. @@ -120,7 +120,7 @@ The inner loop of mkSplitUniqSupply is a function closure case unIO genSym s1 of { (# s2, u #) -> case unIO (unsafeDupableInterleaveIO (IO mk_supply)) s2 of { (# s3, x #) -> case unIO (unsafeDupableInterleaveIO (IO mk_supply)) s3 of { (# s4, y #) -> - (# s4, MkSplitUniqSupply (mask .|. u) x y #) + (# s4, MkSplitUniqSupply (tag .|. u) x y #) }}}} It's a classic example of an IO action that is captured and then called @@ -134,7 +134,7 @@ We used to write it as: genSym >>= \ u -> mk_supply >>= \ s1 -> mk_supply >>= \ s2 -> - return (MkSplitUniqSupply (mask .|. u) s1 s2) + return (MkSplitUniqSupply (tag .|. u) s1 s2) and to rely on -fno-state-hack, full laziness and inlining to get the same result. It was very brittle and required enabling -fno-state-hack globally. So @@ -153,29 +153,29 @@ The code for this is about as optimized as it gets, but we can't get around the need to allocate one `UniqSupply` for each Unique we need. -For code in IO we can improve on this by threading only the *mask* -we are going to use for Uniques. Using `uniqFromMask` to +For code in IO we can improve on this by threading only the *tag* +we are going to use for Uniques. Using `uniqFromTag` to generate uniques as needed. This gets rid of the overhead of allocating a new UniqSupply for each unique generated. It also avoids -frequent state updates when the Unique/Mask is part of the state in a +frequent state updates when the Unique/Tag is part of the state in a state monad. -For monadic code in IO which always uses the same mask we can go further -and hardcode the mask into the MonadUnique instance. On top of all the -benefits of threading the mask this *also* has the benefit of avoiding -the mask getting captured in thunks, or being passed around at runtime. -It does however come at the cost of having to use a fixed Mask for all -code run in this Monad. But remember, the Mask is purely cosmetic: -See Note [Uniques and masks]. +For monadic code in IO which always uses the same tag we can go further +and hardcode the tag into the MonadUnique instance. On top of all the +benefits of threading the tag this *also* has the benefit of avoiding +the tag getting captured in thunks, or being passed around at runtime. +It does however come at the cost of having to use a fixed tag for all +code run in this Monad. But remember, the tag is purely cosmetic: +See Note [Uniques and tags]. NB: It's *not* an optimization to pass around the UniqSupply inside an -IORef instead of the mask. While this would avoid frequent state updates +IORef instead of the tag. While this would avoid frequent state updates it still requires allocating one UniqSupply per Unique. On top of some overhead for reading/writing to/from the IORef. All of this hinges on the assumption that UniqSupply and -uniqFromMask use the same source of distinct numbers (`genSym`) which -allows both to be used at the same time, with the same mask, while still +uniqFromTag use the same source of distinct numbers (`genSym`) which +allows both to be used at the same time, with the same tag, while still ensuring distinct uniques. One might consider this fact to be an "accident". But GHC worked like this as far back as source control history goes. It also allows the later two @@ -197,12 +197,12 @@ data UniqSupply mkSplitUniqSupply :: Char -> IO UniqSupply -- ^ Create a unique supply out of thin air. --- The "mask" (Char) supplied is purely cosmetic, making it easier +-- The "tag" (Char) supplied is purely cosmetic, making it easier -- to figure out where a Unique was born. See --- Note [Uniques and masks]. +-- Note [Uniques and tags]. -- -- The payload part of the Uniques allocated from this UniqSupply are --- guaranteed distinct wrt all other supplies, regardless of their "mask". +-- guaranteed distinct wrt all other supplies, regardless of their "tag". -- This is achieved by allocating the payload part from -- a single source of Uniques, namely `genSym`, shared across -- all UniqSupply's. @@ -213,7 +213,7 @@ mkSplitUniqSupply c = unsafeDupableInterleaveIO (IO mk_supply) where - !mask = mkTag c + !tag = mkTag c -- Here comes THE MAGIC: see Note [How the unique supply works] -- This is one of the most hammered bits in the whole compiler @@ -225,7 +225,7 @@ mkSplitUniqSupply c -- deferred IO computations case unIO (unsafeDupableInterleaveIO (IO mk_supply)) s2 of { (# s3, x #) -> case unIO (unsafeDupableInterleaveIO (IO mk_supply)) s3 of { (# s4, y #) -> - (# s4, MkSplitUniqSupply (mask .|. u) x y #) + (# s4, MkSplitUniqSupply (tag .|. u) x y #) }}}} #if !MIN_VERSION_GLASGOW_HASKELL(9,1,0,0) || WORD_SIZE_IN_BITS != 64 @@ -261,11 +261,11 @@ initUniqSupply counter inc = do poke ghc_unique_counter64 counter poke ghc_unique_inc inc -uniqFromMask :: Char -> IO Unique -uniqFromMask !mask +uniqFromTag :: Char -> IO Unique +uniqFromTag !tag = do { uqNum <- genSym - ; return $! mkUnique mask uqNum } -{-# NOINLINE uniqFromMask #-} -- We'll unbox everything, but we don't want to inline it + ; return $! mkUnique tag uqNum } +{-# NOINLINE uniqFromTag #-} -- We'll unbox everything, but we don't want to inline it splitUniqSupply :: UniqSupply -> (UniqSupply, UniqSupply) -- ^ Build two 'UniqSupply' from a single one, each of which View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/64e13a3b24f2b370b9b44ae3a5072c79a6dce645 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/64e13a3b24f2b370b9b44ae3a5072c79a6dce645 You're receiving 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 Jun 28 16:07:06 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 28 Jun 2023 12:07:06 -0400 Subject: [Git][ghc/ghc][wip/simplifier-tweaks] 26 commits: Memory usage fixes for Haddock Message-ID: <649c5aaa2836_3b5ae2c763c282225@gitlab.mail> Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC Commits: 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - cca1179e by Simon Peyton Jones at 2023-06-28T17:06:57+01:00 Inline more, sooner - - - - - 3dda3a5f by Simon Peyton Jones at 2023-06-28T17:06:57+01:00 One more Simplifier optimistaions Inline in exprIsConAppMaybe - - - - - a69cd79b by Simon Peyton Jones at 2023-06-28T17:06:57+01:00 Further improvements - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6674f1dbcafa392f9ae0b3505923900b73e0cad2...a69cd79b441aa581c33daee1d6c5af3e2a8cb6a3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6674f1dbcafa392f9ae0b3505923900b73e0cad2...a69cd79b441aa581c33daee1d6c5af3e2a8cb6a3 You're receiving 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 Jun 28 16:08:02 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Wed, 28 Jun 2023 12:08:02 -0400 Subject: [Git][ghc/ghc][wip/T22010] Remove Uniquable Word64 instance Message-ID: <649c5ae2aa325_3b5ae2cd0c82824a9@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 48970668 by Jaro Reinders at 2023-06-28T18:07:54+02:00 Remove Uniquable Word64 instance - - - - - 5 changed files: - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Data/Graph/UnVar.hs - compiler/GHC/Types/Unique.hs - compiler/GHC/Types/Unique/DFM.hs - compiler/GHC/Types/Unique/FM.hs Changes: ===================================== compiler/GHC/Cmm/Dataflow/Label.hs ===================================== @@ -20,7 +20,7 @@ import GHC.Utils.Outputable -- TODO: This should really just use GHC's Unique and Uniq{Set,FM} import GHC.Cmm.Dataflow.Collections -import GHC.Types.Unique (Uniquable(..)) +import GHC.Types.Unique (Uniquable(..), mkUniqueGrimily) import GHC.Data.TrieMap import Data.Word (Word64) @@ -39,7 +39,7 @@ instance Show Label where show (Label n) = "L" ++ show n instance Uniquable Label where - getUnique label = getUnique (lblToUnique label) + getUnique label = mkUniqueGrimily (lblToUnique label) instance Outputable Label where ppr label = ppr (getUnique label) ===================================== compiler/GHC/Data/Graph/UnVar.hs ===================================== @@ -93,7 +93,7 @@ unionUnVarSets = foldl' (flip unionUnVarSet) emptyUnVarSet instance Outputable UnVarSet where ppr (UnVarSet s) = braces $ - hcat $ punctuate comma [ ppr (getUnique i) | i <- S.toList s] + hcat $ punctuate comma [ ppr (mkUniqueGrimily i) | i <- S.toList s] data UnVarGraph = CBPG !UnVarSet !UnVarSet -- ^ complete bipartite graph | CG !UnVarSet -- ^ complete graph ===================================== compiler/GHC/Types/Unique.hs ===================================== @@ -205,9 +205,6 @@ instance Uniquable FastString where instance Uniquable Int where getUnique i = mkUniqueIntGrimily i -instance Uniquable Word64 where - getUnique i = MkUnique i - instance Uniquable ModuleName where getUnique (ModuleName nm) = getUnique nm ===================================== compiler/GHC/Types/Unique/DFM.hs ===================================== @@ -71,7 +71,7 @@ module GHC.Types.Unique.DFM ( import GHC.Prelude -import GHC.Types.Unique ( Uniquable(..), Unique, getKey ) +import GHC.Types.Unique ( Uniquable(..), Unique, getKey, mkUniqueGrimily ) import GHC.Utils.Outputable import qualified GHC.Data.Word64Map.Strict as MS @@ -315,7 +315,7 @@ filterUDFM p (UDFM m i) = UDFM (M.filter (\(TaggedVal v _) -> p v) m) i filterUDFM_Directly :: (Unique -> elt -> Bool) -> UniqDFM key elt -> UniqDFM key elt filterUDFM_Directly p (UDFM m i) = UDFM (M.filterWithKey p' m) i where - p' k (TaggedVal v _) = p (getUnique k) v + p' k (TaggedVal v _) = p (mkUniqueGrimily k) v udfmRestrictKeys :: UniqDFM key elt -> UniqDFM key elt2 -> UniqDFM key elt udfmRestrictKeys (UDFM a i) (UDFM b _) = UDFM (M.restrictKeys a (M.keysSet b)) i @@ -329,7 +329,7 @@ udfmRestrictKeysSet (UDFM val_set i) set = -- It's O(n log n) while the corresponding function on `UniqFM` is O(n). udfmToList :: UniqDFM key elt -> [(Unique, elt)] udfmToList (UDFM m _i) = - [ (getUnique k, taggedFst v) + [ (mkUniqueGrimily k, taggedFst v) | (k, v) <- sortBy (compare `on` (taggedSnd . snd)) $ M.toList m ] -- Determines whether two 'UniqDFM's contain the same keys. ===================================== compiler/GHC/Types/Unique/FM.hs ===================================== @@ -86,7 +86,7 @@ module GHC.Types.Unique.FM ( import GHC.Prelude -import GHC.Types.Unique ( Uniquable(..), Unique, getKey ) +import GHC.Types.Unique ( Uniquable(..), Unique, getKey, mkUniqueGrimily ) import GHC.Utils.Outputable import GHC.Utils.Panic.Plain import qualified GHC.Data.Word64Map as M @@ -379,7 +379,7 @@ nonDetFoldUFM f z (UFM m) = M.foldr f z m nonDetFoldWithKeyUFM :: (Unique -> elt -> a -> a) -> a -> UniqFM key elt -> a nonDetFoldWithKeyUFM f z (UFM m) = M.foldrWithKey f' z m where - f' k e a = f (getUnique k) e a + f' k e a = f (mkUniqueGrimily k) e a mapUFM :: (elt1 -> elt2) -> UniqFM key elt1 -> UniqFM key elt2 mapUFM f (UFM m) = UFM (M.map f m) @@ -388,10 +388,10 @@ mapMaybeUFM :: (elt1 -> Maybe elt2) -> UniqFM key elt1 -> UniqFM key elt2 mapMaybeUFM f (UFM m) = UFM (M.mapMaybe f m) mapMaybeWithKeyUFM :: (Unique -> elt1 -> Maybe elt2) -> UniqFM key elt1 -> UniqFM key elt2 -mapMaybeWithKeyUFM f (UFM m) = UFM (M.mapMaybeWithKey (f . getUnique) m) +mapMaybeWithKeyUFM f (UFM m) = UFM (M.mapMaybeWithKey (f . mkUniqueGrimily) m) mapUFM_Directly :: (Unique -> elt1 -> elt2) -> UniqFM key elt1 -> UniqFM key elt2 -mapUFM_Directly f (UFM m) = UFM (M.mapWithKey (f . getUnique) m) +mapUFM_Directly f (UFM m) = UFM (M.mapWithKey (f . mkUniqueGrimily) m) strictMapUFM :: (a -> b) -> UniqFM k a -> UniqFM k b strictMapUFM f (UFM a) = UFM $ MS.map f a @@ -400,7 +400,7 @@ filterUFM :: (elt -> Bool) -> UniqFM key elt -> UniqFM key elt filterUFM p (UFM m) = UFM (M.filter p m) filterUFM_Directly :: (Unique -> elt -> Bool) -> UniqFM key elt -> UniqFM key elt -filterUFM_Directly p (UFM m) = UFM (M.filterWithKey (p . getUnique) m) +filterUFM_Directly p (UFM m) = UFM (M.filterWithKey (p . mkUniqueGrimily) m) partitionUFM :: (elt -> Bool) -> UniqFM key elt -> (UniqFM key elt, UniqFM key elt) partitionUFM p (UFM m) = @@ -451,7 +451,7 @@ nonDetEltsUFM (UFM m) = M.elems m -- If you use this please provide a justification why it doesn't introduce -- nondeterminism. nonDetKeysUFM :: UniqFM key elt -> [Unique] -nonDetKeysUFM (UFM m) = map getUnique $ M.keys m +nonDetKeysUFM (UFM m) = map mkUniqueGrimily $ M.keys m -- See Note [Deterministic UniqFM] to learn about nondeterminism. -- If you use this please provide a justification why it doesn't introduce @@ -468,18 +468,18 @@ nonDetStrictFoldUFM k z (UFM m) = M.foldl' (flip k) z m nonDetStrictFoldUFM_DirectlyM :: (Monad m) => (Unique -> b -> elt -> m b) -> b -> UniqFM key elt -> m b nonDetStrictFoldUFM_DirectlyM f z0 (UFM xs) = M.foldrWithKey c return xs z0 -- See Note [List fusion and continuations in 'c'] - where c u x k z = f (getUnique u) z x >>= k + where c u x k z = f (mkUniqueGrimily u) z x >>= k {-# INLINE c #-} nonDetStrictFoldUFM_Directly:: (Unique -> elt -> a -> a) -> a -> UniqFM key elt -> a -nonDetStrictFoldUFM_Directly k z (UFM m) = M.foldlWithKey' (\z' i x -> k (getUnique i) x z') z m +nonDetStrictFoldUFM_Directly k z (UFM m) = M.foldlWithKey' (\z' i x -> k (mkUniqueGrimily i) x z') z m {-# INLINE nonDetStrictFoldUFM_Directly #-} -- See Note [Deterministic UniqFM] to learn about nondeterminism. -- If you use this please provide a justification why it doesn't introduce -- nondeterminism. nonDetUFMToList :: UniqFM key elt -> [(Unique, elt)] -nonDetUFMToList (UFM m) = map (\(k, v) -> (getUnique k, v)) $ M.toList m +nonDetUFMToList (UFM m) = map (\(k, v) -> (mkUniqueGrimily k, v)) $ M.toList m -- | A wrapper around 'UniqFM' with the sole purpose of informing call sites -- that the provided 'Foldable' and 'Traversable' instances are View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/48970668865a07a04604f27a5bae93c0ca92d896 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/48970668865a07a04604f27a5bae93c0ca92d896 You're receiving 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 Jun 28 16:25:17 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 28 Jun 2023 12:25:17 -0400 Subject: [Git][ghc/ghc][master] Stop configuring unused Ld command in `settings` Message-ID: <649c5eed12bad_3b5ae2c763c288116@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - 13 changed files: - configure.ac - distrib/configure.ac.in - ghc/Main.hs - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - m4/fp_prog_ld_filelist.m4 - m4/fp_prog_ld_flag.m4 - m4/fp_prog_ld_is_gnu.m4 - m4/fp_prog_ld_no_compact_unwind.m4 - m4/fp_settings.m4 Changes: ===================================== configure.ac ===================================== @@ -482,9 +482,7 @@ FIND_LD([$target],[GccUseLdOpt]) FIND_MERGE_OBJECTS() CONF_GCC_LINKER_OPTS_STAGE1="$CONF_GCC_LINKER_OPTS_STAGE1 $GccUseLdOpt" CONF_GCC_LINKER_OPTS_STAGE2="$CONF_GCC_LINKER_OPTS_STAGE2 $GccUseLdOpt" -LdCmd="$LD" CFLAGS="$CFLAGS $GccUseLdOpt" -AC_SUBST([LdCmd]) FP_PROG_LD_IS_GNU FP_PROG_LD_NO_COMPACT_UNWIND @@ -1246,7 +1244,6 @@ echo "\ hs-cpp : $HaskellCPPCmd hs-cpp-flags : $HaskellCPPArgs ar : $ArCmd - ld : $LdCmd nm : $NmCmd objdump : $ObjdumpCmd ranlib : $RanlibCmd ===================================== distrib/configure.ac.in ===================================== @@ -125,9 +125,7 @@ FIND_LD([$target],[GccUseLdOpt]) FIND_MERGE_OBJECTS() CONF_GCC_LINKER_OPTS_STAGE1="$CONF_GCC_LINKER_OPTS_STAGE1 $GccUseLdOpt" CONF_GCC_LINKER_OPTS_STAGE2="$CONF_GCC_LINKER_OPTS_STAGE2 $GccUseLdOpt" -LdCmd="$LD" CFLAGS="$CFLAGS $GccUseLdOpt" -AC_SUBST([LdCmd]) FP_PROG_LD_IS_GNU FP_PROG_LD_NO_COMPACT_UNWIND ===================================== ghc/Main.hs ===================================== @@ -627,8 +627,8 @@ mode_flags = "LibDir", "Global Package DB", "C compiler flags", - "C compiler link flags", - "ld flags"], + "C compiler link flags" + ], let k' = "-print-" ++ map (replaceSpace . toLower) k replaceSpace ' ' = '-' replaceSpace c = c ===================================== hadrian/bindist/Makefile ===================================== @@ -87,8 +87,6 @@ lib/settings : config.mk @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ - @echo ',("ld command", "$(SettingsLdCommand)")' >> $@ - @echo ',("ld flags", "$(SettingsLdFlags)")' >> $@ @echo ',("ld supports compact unwind", "$(LdHasNoCompactUnwind)")' >> $@ @echo ',("ld supports filelist", "$(LdHasFilelist)")' >> $@ @echo ',("ld supports response files", "$(LdSupportsResponseFiles)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -263,8 +263,6 @@ SettingsCCompilerFlags = @SettingsCCompilerFlags@ SettingsCxxCompilerFlags = @SettingsCxxCompilerFlags@ SettingsCCompilerLinkFlags = @SettingsCCompilerLinkFlags@ SettingsCCompilerSupportsNoPie = @SettingsCCompilerSupportsNoPie@ -SettingsLdCommand = @SettingsLdCommand@ -SettingsLdFlags = @SettingsLdFlags@ SettingsMergeObjectsCommand = @SettingsMergeObjectsCommand@ SettingsMergeObjectsFlags = @SettingsMergeObjectsFlags@ SettingsArCommand = @SettingsArCommand@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -11,7 +11,7 @@ autoreconf = @AutoreconfCmd@ cc = @CC@ happy = @HappyCmd@ hs-cpp = @HaskellCPPCmd@ -ld = @LdCmd@ +ld = @LD@ make = @MakeCmd@ nm = @NmCmd@ merge-objects = @MergeObjsCmd@ @@ -151,8 +151,6 @@ settings-c-compiler-flags = @SettingsCCompilerFlags@ settings-cxx-compiler-flags = @SettingsCxxCompilerFlags@ settings-c-compiler-link-flags = @SettingsCCompilerLinkFlags@ settings-c-compiler-supports-no-pie = @SettingsCCompilerSupportsNoPie@ -settings-ld-command = @SettingsLdCommand@ -settings-ld-flags = @SettingsLdFlags@ settings-merge-objects-command = @SettingsMergeObjectsCommand@ settings-merge-objects-flags = @SettingsMergeObjectsFlags@ settings-ar-command = @SettingsArCommand@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -115,8 +115,6 @@ data SettingsFileSetting | SettingsFileSetting_CxxCompilerFlags | SettingsFileSetting_CCompilerLinkFlags | SettingsFileSetting_CCompilerSupportsNoPie - | SettingsFileSetting_LdCommand - | SettingsFileSetting_LdFlags | SettingsFileSetting_MergeObjectsCommand | SettingsFileSetting_MergeObjectsFlags | SettingsFileSetting_ArCommand @@ -214,8 +212,6 @@ settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_CxxCompilerFlags -> "settings-cxx-compiler-flags" SettingsFileSetting_CCompilerLinkFlags -> "settings-c-compiler-link-flags" SettingsFileSetting_CCompilerSupportsNoPie -> "settings-c-compiler-supports-no-pie" - SettingsFileSetting_LdCommand -> "settings-ld-command" - SettingsFileSetting_LdFlags -> "settings-ld-flags" SettingsFileSetting_MergeObjectsCommand -> "settings-merge-objects-command" SettingsFileSetting_MergeObjectsFlags -> "settings-merge-objects-flags" SettingsFileSetting_ArCommand -> "settings-ar-command" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -446,8 +446,6 @@ generateSettings = do , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags) - , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand) - , ("ld flags", expr $ settingsFileSetting SettingsFileSetting_LdFlags) , ("ld supports compact unwind", expr $ lookupSystemConfig "ld-has-no-compact-unwind") , ("ld supports filelist", expr $ lookupSystemConfig "ld-has-filelist") , ("ld supports response files", expr $ lookupSystemConfig "ld-supports-response-files") ===================================== m4/fp_prog_ld_filelist.m4 ===================================== @@ -12,7 +12,7 @@ AC_CACHE_CHECK([whether ld understands -filelist], [fp_cv_ld_has_filelist], ${CC-cc} -c conftest2.c echo conftest1.o > conftest.o-files echo conftest2.o >> conftest.o-files - if ${LdCmd} -r -filelist conftest.o-files -o conftest.o > /dev/null 2>&1 + if $LD -r -filelist conftest.o-files -o conftest.o > /dev/null 2>&1 then fp_cv_ld_has_filelist=yes else ===================================== m4/fp_prog_ld_flag.m4 ===================================== @@ -7,7 +7,7 @@ AC_DEFUN([FP_PROG_LD_FLAG], AC_CACHE_CHECK([whether ld understands $1], [fp_cv_$2], [echo 'int foo() { return 0; }' > conftest.c ${CC-cc} -c conftest.c -if ${LdCmd} -r $1 -o conftest2.o conftest.o > /dev/null 2>&1; then +if $LD -r $1 -o conftest2.o conftest.o > /dev/null 2>&1; then fp_cv_$2=$1 else fp_cv_$2= ===================================== m4/fp_prog_ld_is_gnu.m4 ===================================== @@ -4,7 +4,7 @@ # GNU ld or not. AC_DEFUN([FP_PROG_LD_IS_GNU],[ AC_CACHE_CHECK([whether ld is GNU ld], [fp_cv_gnu_ld], -[[if ${LdCmd} --version 2> /dev/null | grep "GNU" > /dev/null 2>&1; then +[[if $LD --version 2> /dev/null | grep "GNU" > /dev/null 2>&1; then fp_cv_gnu_ld=YES else fp_cv_gnu_ld=NO ===================================== m4/fp_prog_ld_no_compact_unwind.m4 ===================================== @@ -7,7 +7,7 @@ AC_DEFUN([FP_PROG_LD_NO_COMPACT_UNWIND], AC_CACHE_CHECK([whether ld understands -no_compact_unwind], [fp_cv_ld_no_compact_unwind], [echo 'int foo() { return 0; }' > conftest.c ${CC-cc} -c conftest.c -if ${LdCmd} -r -no_compact_unwind -o conftest2.o conftest.o > /dev/null 2>&1; then +if $LD -r -no_compact_unwind -o conftest2.o conftest.o > /dev/null 2>&1; then fp_cv_ld_no_compact_unwind=yes else fp_cv_ld_no_compact_unwind=no ===================================== m4/fp_settings.m4 ===================================== @@ -16,8 +16,6 @@ AC_DEFUN([FP_SETTINGS], SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2 -L\$\$tooldir/mingw/lib -L\$\$tooldir/mingw/x86_64-w64-mingw32/lib" SettingsHaskellCPPCommand="${mingw_bin_prefix}clang.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs -I\$\$tooldir/mingw/include" - SettingsLdCommand="${mingw_bin_prefix}ld.lld.exe" - SettingsLdFlags="" # LLD does not support object merging (#21068) SettingsMergeObjectsCommand="" SettingsMergeObjectsFlags="" @@ -38,8 +36,6 @@ AC_DEFUN([FP_SETTINGS], SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" - SettingsLdCommand="$LdCmd" - SettingsLdFlags="$CONF_LD_LINKER_OPTS_STAGE2" SettingsArCommand="$ArCmd" SettingsRanlibCommand="$RanlibCmd" SettingsMergeObjectsCommand="$MergeObjsCmd" @@ -113,8 +109,6 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCxxCompilerFlags) AC_SUBST(SettingsCCompilerLinkFlags) AC_SUBST(SettingsCCompilerSupportsNoPie) - AC_SUBST(SettingsLdCommand) - AC_SUBST(SettingsLdFlags) AC_SUBST(SettingsMergeObjectsCommand) AC_SUBST(SettingsMergeObjectsFlags) AC_SUBST(SettingsArCommand) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ecdc4353d0a758e3336c24d5d0a7b484d903344c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ecdc4353d0a758e3336c24d5d0a7b484d903344c You're receiving 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 Jun 28 16:26:17 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 28 Jun 2023 12:26:17 -0400 Subject: [Git][ghc/ghc][master] 4 commits: Remove extraneous debug output Message-ID: <649c5f29ff8b_3b5ae2c763c291681@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 2 changed files: - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix Changes: ===================================== .gitlab/ci.sh ===================================== @@ -211,7 +211,6 @@ function set_toolchain_paths() { esac info "Building toolchain for $NIX_SYSTEM" nix-build --quiet .gitlab/darwin/toolchain.nix --argstr system "$NIX_SYSTEM" -o toolchain.sh - cat toolchain.sh fi source toolchain.sh ;; @@ -219,10 +218,10 @@ function set_toolchain_paths() { # These are generally set by the Docker image but # we provide these handy fallbacks in case the # script isn't run from within a GHC CI docker image. - if [ -z "$GHC" ]; then GHC="$(which ghc)"; fi - if [ -z "$CABAL" ]; then CABAL="$(which cabal)"; fi - if [ -z "$HAPPY" ]; then HAPPY="$(which happy)"; fi - if [ -z "$ALEX" ]; then ALEX="$(which alex)"; fi + : ${GHC:=$(which ghc)} + : ${CABAL:=$(which cabal)} + : ${HAPPY:=$(which happy)} + : ${ALEX:=$(which alex)} ;; *) fail "bad toolchain_source" esac @@ -806,7 +805,7 @@ function shell() { if [ -z "$cmd" ]; then cmd="bash -i" fi - run "$cmd" + run $cmd } function lint_author(){ @@ -915,8 +914,8 @@ determine_metric_baseline set_toolchain_paths -case $1 in - usage) usage ;; +case ${1:-help} in + help|usage) usage ;; setup) setup && cleanup_submodules ;; configure) time_it "configure" configure ;; build_hadrian) time_it "build" build_hadrian ;; ===================================== .gitlab/darwin/toolchain.nix ===================================== @@ -113,6 +113,8 @@ pkgs.writeTextFile { export CABAL="$CABAL_INSTALL" sdk_path="$(xcrun --sdk macosx --show-sdk-path)" - export CONFIGURE_ARGS="$CONFIGURE_ARGS --with-ffi-libraries=$sdk_path/usr/lib --with-ffi-includes=$sdk_path/usr/include/ffi --build=${targetTriple}" + : ''${CONFIGURE_ARGS:=} + CONFIGURE_ARGS+="''${CONFIGURE_ARGS:+ }--with-ffi-libraries=$sdk_path/usr/lib --with-ffi-includes=$sdk_path/usr/include/ffi --build=${targetTriple}" + export CONFIGURE_ARGS ''; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ecdc4353d0a758e3336c24d5d0a7b484d903344c...887dc4fc5ad033b4dd2537e914d6d4a574b7fe23 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ecdc4353d0a758e3336c24d5d0a7b484d903344c...887dc4fc5ad033b4dd2537e914d6d4a574b7fe23 You're receiving 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 Jun 28 16:40:29 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 28 Jun 2023 12:40:29 -0400 Subject: [Git][ghc/ghc][wip/tracing-rework] rts/Trace: Ensure that debugTrace arguments are used Message-ID: <649c627dad212_3b5ae2d9ef9642938df@gitlab.mail> Ben Gamari pushed to branch wip/tracing-rework at Glasgow Haskell Compiler / GHC Commits: d2703805 by Ben Gamari at 2023-06-28T12:40:26-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - 1 changed file: - rts/Trace.h Changes: ===================================== rts/Trace.h ===================================== @@ -238,23 +238,15 @@ void traceThreadLabel_(Capability *cap, /* * Emit a debug message (only when DEBUG is defined) */ -#if defined(DEBUG) #define debugTrace(class, msg, ...) \ - if (RTS_UNLIKELY(class)) { \ + if (DEBUG && RTS_UNLIKELY(class)) { \ trace_(msg, ##__VA_ARGS__); \ } -#else -#define debugTrace(class, str, ...) /* nothing */ -#endif -#if defined(DEBUG) -#define debugTraceCap(class, cap, msg, ...) \ - if (RTS_UNLIKELY(class)) { \ +#define debugTraceCap(class, cap, msg, ...) \ + if (DEBUG && RTS_UNLIKELY(class)) { \ traceCap_(cap, msg, ##__VA_ARGS__); \ } -#else -#define debugTraceCap(class, cap, str, ...) /* nothing */ -#endif /* * Emit a message/event describing the state of a thread View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d27038050d2955a166b3f9e36a7484015ef08568 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d27038050d2955a166b3f9e36a7484015ef08568 You're receiving 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 Jun 28 16:57:33 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 28 Jun 2023 12:57:33 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 21 commits: Stop configuring unused Ld command in `settings` Message-ID: <649c667d7e328_3b5ae2e0a0a4c2962d4@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - d939cd10 by Rodrigo Mesquita at 2023-06-28T12:57:03-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - a39eabc2 by Ben Gamari at 2023-06-28T12:57:03-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - 4baa1fc9 by aadaa_fgtaa at 2023-06-28T12:57:08-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 5d080438 by Ben Gamari at 2023-06-28T12:57:08-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - 4bb6d219 by Ben Gamari at 2023-06-28T12:57:08-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 01408558 by Ben Gamari at 2023-06-28T12:57:08-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - 3ecc3d98 by Ben Gamari at 2023-06-28T12:57:08-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - e7690b82 by Ben Gamari at 2023-06-28T12:57:08-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 67edc44d by Sven Tennie at 2023-06-28T12:57:08-04:00 compiler: Drop MO_ReadBarrier - - - - - 33df4f18 by Ben Gamari at 2023-06-28T12:57:08-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 2f0562e1 by Sven Tennie at 2023-06-28T12:57:09-04:00 Delete write_barrier function - - - - - f9ebaf84 by Ben Gamari at 2023-06-28T12:57:09-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - 8a26ef35 by Sven Tennie at 2023-06-28T12:57:09-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - f95d0108 by Ryan Scott at 2023-06-28T12:57:10-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - e773b4fa by Rodrigo Mesquita at 2023-06-28T12:57:11-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 42591b51 by Sylvain Henry at 2023-06-28T12:57:22-04:00 JS: fix JS stack printing (#23565) - - - - - 30 changed files: - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.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 - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Tasks.hs - compiler/GHC/Tc/Gen/HsType.hs - configure.ac - distrib/configure.ac.in - ghc/Main.hs - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/05cb2e565d33919a3f0af371011ff90805be8e8b...42591b51795a1607c02e70c477bf4abf429f620c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/05cb2e565d33919a3f0af371011ff90805be8e8b...42591b51795a1607c02e70c477bf4abf429f620c You're receiving 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 Jun 28 18:45:13 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 28 Jun 2023 14:45:13 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] 9 commits: Add e-graphs submodule (hegg) Message-ID: <649c7fb995a7b_3b5ae2e2af6a8329230@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: c110a6f0 by Rodrigo Mesquita at 2023-06-28T19:44:44+01:00 Add e-graphs submodule (hegg) - - - - - 1e9f7103 by Rodrigo Mesquita at 2023-06-28T19:44:44+01:00 Create Core.Equality module This module defines CoreExprF -- the base functor of CoreExpr, and equality and ordering operations on the debruijnized CoreExprF. Furthermore, it provides a function to represent a CoreExpr in an e-graph. This is a requirement to represent, reason about equality, and manipulate CoreExprs in e-graphs. E-graphs are going to be used in the pattern match checker (#19272), and potentially for type family rewriting (#TODO) -- amongst other oportunities that are unlocked by having them available. - - - - - 0730c84d by Rodrigo Mesquita at 2023-06-28T19:44:45+01:00 Question - - - - - a98191a9 by Rodrigo Mesquita at 2023-06-28T19:44:45+01:00 Was going great until I started needing to thread ClassIds together with Ids. Ret-think this. - - - - - cf660080 by Rodrigo Mesquita at 2023-06-28T19:44:45+01:00 A solution with more lookups - - - - - 892bb311 by Rodrigo Mesquita at 2023-06-28T19:44:45+01:00 Fixes to Pmc.Ppr module - - - - - 8b4561ae by Rodrigo Mesquita at 2023-06-28T19:44:45+01:00 Wow, a lot (stage1) is working actually, without PMC errprs - - - - - 6ba420bb by Rodrigo Mesquita at 2023-06-28T19:44:45+01:00 We're still not there yet. - - - - - bcf8fd48 by Rodrigo Mesquita at 2023-06-28T19:44:45+01:00 WiP - - - - - 17 changed files: - .gitmodules - + compiler/GHC/Core/Equality.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Map/Type.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Check.hs - compiler/GHC/HsToCore/Pmc/Desugar.hs - compiler/GHC/HsToCore/Pmc/Ppr.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/Types/Unique/SDFM.hs - compiler/ghc.cabal.in - hadrian/src/Packages.hs - hadrian/src/Rules/ToolArgs.hs - hadrian/src/Settings/Default.hs - + libraries/hegg - packages Changes: ===================================== .gitmodules ===================================== @@ -117,3 +117,6 @@ [submodule "utils/hpc"] path = utils/hpc url = https://gitlab.haskell.org/hpc/hpc-bin.git +[submodule "libraries/hegg"] + path = libraries/hegg + url = https://github.com/alt-romes/hegg.git ===================================== compiler/GHC/Core/Equality.hs ===================================== @@ -0,0 +1,358 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE FlexibleContexts #-} + +module GHC.Core.Equality where + +import GHC.Exts (dataToTag#, tagToEnum#, (>#), (<#)) +import GHC.Prelude + +import GHC.Core +import GHC.Core.TyCo.Rep +import GHC.Core.Map.Type +import GHC.Core.Map.Expr +import GHC.Types.Var +import GHC.Types.Literal +import GHC.Types.Tickish +import Unsafe.Coerce (unsafeCoerce) + +import Control.Monad.Trans.State.Strict (state) +import Data.Equality.Graph as EG +import Data.Equality.Analysis +import qualified Data.Equality.Graph.Monad as EGM +import Data.Equality.Utils (Fix(..)) + +import GHC.Utils.Misc (all2) +import GHC.Utils.Outputable (showPprUnsafe) +import GHC.Core.Coercion (coercionType) + +-- Important to note the binders are also represented by $a$ +-- This is because in the e-graph we will represent binders with the +-- equivalence class id of things equivalent to it. +-- +-- Unfortunately type binders are still not correctly accounted for. +-- Perhaps it'd really be better to make DeBruijn work over these types + +data AltF b a + = AltF AltCon [b] a + deriving (Functor, Foldable, Traversable) + +data BindF b a + = NonRecF b a + | RecF [(b, a)] + deriving (Functor, Foldable, Traversable) + +data ExprF b a + = VarF Id + | LitF Literal + | AppF a a + | LamF b a + | LetF (BindF b a) a + | CaseF a b Type [AltF b a] + + | CastF a CoercionR + | TickF CoreTickish a + | TypeF Type + | CoercionF Coercion + deriving (Functor, Foldable, Traversable) + +type CoreExprF + = ExprF CoreBndr +type CoreAltF + = AltF CoreBndr +type CoreBindF + = BindF CoreBndr + +newtype DeBruijnF f a = DF (DeBruijn (f a)) + deriving (Functor, Foldable, Traversable) + +eqDeBruijnExprF :: forall a. Eq a => DeBruijn (CoreExprF a) -> DeBruijn (CoreExprF a) -> Bool +eqDeBruijnExprF (D env1 e1) (D env2 e2) = go e1 e2 where + go :: CoreExprF a -> CoreExprF a -> Bool + go (VarF v1) (VarF v2) = eqDeBruijnVar (D env1 v1) (D env2 v2) + go (LitF lit1) (LitF lit2) = lit1 == lit2 + go (TypeF t1) (TypeF t2) = eqDeBruijnType (D env1 t1) (D env2 t2) + -- See Note [Alpha-equality for Coercion arguments] + go (CoercionF {}) (CoercionF {}) = True + go (CastF e1 co1) (CastF e2 co2) = D env1 co1 == D env2 co2 && e1 == e2 + go (AppF f1 a1) (AppF f2 a2) = f1 == f2 && a1 == a2 + go (TickF n1 e1) (TickF n2 e2) + = eqDeBruijnTickish (D env1 n1) (D env2 n2) + && e1 == e2 + + go (LamF b1 e1) (LamF b2 e2) + = eqDeBruijnType (D env1 (varType b1)) (D env2 (varType b2)) + && D env1 (varMultMaybe b1) == D env2 (varMultMaybe b2) + && e1 == e2 + + go (LetF abs e1) (LetF bbs e2) + = D env1 abs == D env2 bbs + && e1 == e2 + + go (CaseF e1 _b1 t1 a1) (CaseF e2 _b2 t2 a2) + | null a1 -- See Note [Empty case alternatives] + = null a2 && e1 == e2 && D env1 t1 == D env2 t2 + | otherwise + = e1 == e2 && D env1 a1 == D env2 a2 + + go _ _ = False + +-- ROMES:TODO: This one can be derived automatically, but perhaps it's better +-- to be explicit here? We don't even really require the DeBruijn context here +eqDeBruijnAltF :: forall a. Eq a => DeBruijn (CoreAltF a) -> DeBruijn (CoreAltF a) -> Bool +eqDeBruijnAltF (D _env1 a1) (D _env2 a2) = go a1 a2 where + go (AltF DEFAULT _ rhs1) (AltF DEFAULT _ rhs2) + = rhs1 == rhs2 + go (AltF (LitAlt lit1) _ rhs1) (AltF (LitAlt lit2) _ rhs2) + = lit1 == lit2 && rhs1 == rhs2 + go (AltF (DataAlt dc1) _bs1 rhs1) (AltF (DataAlt dc2) _bs2 rhs2) + = dc1 == dc2 && + rhs1 == rhs2 -- the CM environments were extended on representation (see 'representDBAltExpr') + go _ _ = False + +-- | 'unsafeCoerce' mostly because I'm too lazy to write the boilerplate. +fromCoreExpr :: CoreExpr -> Fix CoreExprF +fromCoreExpr = unsafeCoerce + +toCoreExpr :: CoreExpr -> Fix CoreExprF +toCoreExpr = unsafeCoerce + +-- | Represents a DeBruijn CoreExpr being careful to correctly debruijnizie the expression as it is represented +-- +-- Always represent Ids, at least for now. We're seemingly using inexistent ids +-- ROMES:TODO: do this all inside EGraphM instead +representDBCoreExpr :: Analysis a (DeBruijnF CoreExprF) + => DeBruijn CoreExpr + -> EGraph a (DeBruijnF CoreExprF) + -> (ClassId, EGraph a (DeBruijnF CoreExprF)) +representDBCoreExpr (D cmenv expr) eg0 = case expr of + Var v -> add (Node $ DF (D cmenv (VarF v))) eg0 + Lit lit -> add (Node $ DF (D cmenv (LitF lit))) eg0 + Type t -> add (Node $ DF (D cmenv (TypeF t))) eg0 + Coercion c -> add (Node $ DF (D cmenv (CoercionF c))) eg0 + Cast e co -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 + in add (Node $ DF (D cmenv (CastF eid co))) eg1 + App f a -> let (fid,eg1) = representDBCoreExpr (D cmenv f) eg0 + (aid,eg2) = representDBCoreExpr (D cmenv a) eg1 + in add (Node $ DF (D cmenv (AppF fid aid))) eg2 + Tick n e -> let (eid,eg1) = representDBCoreExpr (D cmenv e) eg0 + in add (Node $ DF (D cmenv (TickF n eid))) eg1 + Lam b e -> let (eid,eg1) = representDBCoreExpr (D (extendCME cmenv b) e) eg0 + in add (Node $ DF (D cmenv (LamF b eid))) eg1 + Let (NonRec v r) e -> let (rid,eg1) = representDBCoreExpr (D cmenv r) eg0 + (eid,eg2) = representDBCoreExpr (D (extendCME cmenv v) e) eg1 + in add (Node $ DF (D cmenv (LetF (NonRecF v rid) eid))) eg2 + Let (Rec (unzip -> (bs,rs))) e -> + let cmenv' = extendCMEs cmenv bs + (bsids, eg1) = EGM.runEGraphM eg0 $ + traverse (state . representDBCoreExpr . D cmenv') rs + (eid, eg2) = representDBCoreExpr (D cmenv' e) eg1 + in add (Node $ DF (D cmenv (LetF (RecF (zip bs bsids)) eid))) eg2 + Case e b t as -> let (eid, eg1) = representDBCoreExpr (D cmenv e) eg0 + (as', eg2) = EGM.runEGraphM eg1 $ + traverse (state . representDBAltExpr . D (extendCME cmenv b)) as + in add (Node $ DF (D cmenv (CaseF eid b t as'))) eg2 + +representDBAltExpr :: Analysis a (DeBruijnF CoreExprF) + => DeBruijn CoreAlt + -> EGraph a (DeBruijnF CoreExprF) + -> (CoreAltF ClassId, EGraph a (DeBruijnF CoreExprF)) +representDBAltExpr (D cm (Alt cons bs a)) eg0 = + let (ai, eg1) = representDBCoreExpr (D (extendCMEs cm bs) a) eg0 + in (AltF cons bs ai, eg1) + +instance Eq a => Eq (DeBruijn (CoreAltF a)) where + (==) = eqDeBruijnAltF + +instance Eq a => Eq (DeBruijn (CoreExprF a)) where + (==) = eqDeBruijnExprF + +instance Eq a => Eq (DeBruijnF CoreExprF a) where + (==) (DF a) (DF b) = eqDeBruijnExprF a b + +instance Eq a => Eq (DeBruijnF CoreAltF a) where + (==) (DF a) (DF b) = eqDeBruijnAltF a b + +deriving instance Ord a => Ord (DeBruijnF CoreExprF a) + +instance Ord a => Ord (DeBruijn (CoreExprF a)) where + -- We must assume that if `a` is DeBruijn expression, it is already correctly "extended" because 'representDBCoreExpr' ensures that. + -- RM:TODO: We don't yet compare the CmEnv at any point. Should we? + -- RM: I don't think so, the CmEnv is used to determine whether bound variables are equal, but they don't otherwise influence the result. + -- Or rather, if the subexpression with variables is equal, then the CmEnv is necessarily equal too? + -- So I think that just works... + -- Wait, in that sense, couldn't we find a way to derive ord? the important part being that to compare Types and Vars we must use the DeBruijn Env ... + compare a b + = case a of + D cma (VarF va) + -> case b of + D cmb (VarF vb) -> cmpDeBruijnVar (D cma va) (D cmb vb) + _ -> LT + D _ (LitF la) + -> case b of + D _ VarF{} -> GT + D _ (LitF lb) -> la `compare` lb + _ -> LT + D _ (AppF af aarg) + -> case dataToTag# b of + bt + -> if tagToEnum# (bt ># 2#) then + LT + else + case b of + D _ (AppF bf barg) + -> case compare af bf of + LT -> LT + EQ -> aarg `compare` barg -- e.g. here, if we had for children other expresssions debruijnized, they would have the *correct* environments, so we needn't worry. + -- the issue to automatically deriving is only really the 'Var' and 'Type' parameters ... + GT -> GT + _ -> GT + D _ (LamF _abind abody) + -> case dataToTag# b of + bt + -> if tagToEnum# (bt ># 3#) then + LT + else + case b of + D _ (LamF _bbind bbody) -- we can ignore the binder since the represented DB expression has the correct DB environments by construction (see 'representDBCoreExpr') + -> compare abody bbody + _ -> GT + D cma (LetF as abody) + -> case dataToTag# b of + bt + -> if tagToEnum# (bt ># 4#) then + LT + else + case b of + D cmb (LetF bs bbody) + -> case compare (D cma as) (D cmb bs) of + LT -> LT + EQ -> compare abody bbody + GT -> GT + _ -> GT + D cma (CaseF cax _cabind catype caalt) + -> case dataToTag# b of + bt + -> if tagToEnum# (bt <# 5#) then + GT + else + case b of + D cmb (CaseF cbx _cbbind cbtype cbalt) + -> case compare cax cbx of + LT -> LT + -- ROMES:TODO: Consider changing order of comparisons to a more efficient one + EQ -> case cmpDeBruijnType (D cma catype) (D cmb cbtype) of + LT -> LT + EQ -> D cma caalt `compare` D cmb cbalt + GT -> GT + GT -> GT + _ -> LT + D cma (CastF cax caco) + -> case dataToTag# b of + bt + -> if tagToEnum# (bt <# 6#) then + GT + else + case b of + D cmb (CastF cbx cbco) + -> case compare cax cbx of + LT -> LT + EQ -> cmpDeBruijnCoercion (D cma caco) (D cmb cbco) + GT -> GT + _ -> LT + D cma (TickF tatickish tax) + -> case dataToTag# b of + bt + -> if tagToEnum# (bt <# 7#) then + GT + else + case b of + D cmb (TickF tbtickish tbx) + -> case cmpDeBruijnTickish (D cma tatickish) (D cmb tbtickish) of + LT -> LT + EQ -> tax `compare` tbx + GT -> GT + _ -> LT + D cma (TypeF at) + -> case b of + D _ CoercionF{} -> LT + D cmb (TypeF bt) -> cmpDeBruijnType (D cma at) (D cmb bt) + _ -> GT + D cma (CoercionF aco) + -> case b of + D cmb (CoercionF bco) -> cmpDeBruijnCoercion (D cma aco) (D cmb bco) + _ -> GT + +instance Eq a => Eq (DeBruijn (CoreBindF a)) where + D cma a == D cmb b = go a b where + go (NonRecF _v1 r1) (NonRecF _v2 r2) + = r1 == r2 -- See Note [Alpha-equality for let-bindings] + + go (RecF ps1) (RecF ps2) + = + -- See Note [Alpha-equality for let-bindings] + all2 (\b1 b2 -> eqDeBruijnType (D cma (varType b1)) + (D cmb (varType b2))) + bs1 bs2 + && rs1 == rs2 + where + (bs1,rs1) = unzip ps1 + (bs2,rs2) = unzip ps2 + + go _ _ = False + + +instance Ord a => Ord (DeBruijn (CoreBindF a)) where + compare a b + = case a of + D _cma (NonRecF _ab ax) + -> case b of + D _cmb (NonRecF _bb bx) -- Again, we ignore the binders bc on representation they were accounted for correctly. + -> ax `compare` bx + _ -> LT + D _cma (RecF as) + -> case b of + D _cmb (RecF bs) -> compare (map snd as) (map snd bs) + _ -> GT + + +instance Ord a => Ord (DeBruijn (CoreAltF a)) where + compare a b + = case a of + D _cma (AltF ac _abs arhs) + -> case b of + D _cmb (AltF bc _bbs brhs) + -> case compare ac bc of + LT -> LT + EQ -> -- Again, we don't look at binders bc we assume on representation they were accounted for correctly. + arhs `compare` brhs + GT -> GT + +cmpDeBruijnTickish :: DeBruijn CoreTickish -> DeBruijn CoreTickish -> Ordering +cmpDeBruijnTickish (D env1 t1) (D env2 t2) = go t1 t2 where + go (Breakpoint lext lid lids) (Breakpoint rext rid rids) + = case compare lid rid of + LT -> LT + EQ -> case compare (D env1 lids) (D env2 rids) of + LT -> LT + EQ -> compare lext rext + GT -> GT + GT -> GT + go l r = compare l r + +-- ROMES:TODO: DEBRUIJN ORDERING ON TYPES!!! +cmpDeBruijnType :: DeBruijn Type -> DeBruijn Type -> Ordering +cmpDeBruijnType d1@(D _ t1) d2@(D _ t2) + = if eqDeBruijnType d1 d2 + then EQ + else compare (showPprUnsafe t1) (showPprUnsafe t2) + + +-- ROMES:TODO: DEBRUIJN ORDERING ON COERCIONS!!! +cmpDeBruijnCoercion :: DeBruijn Coercion -> DeBruijn Coercion -> Ordering +cmpDeBruijnCoercion (D env1 co1) (D env2 co2) + = cmpDeBruijnType (D env1 (coercionType co1)) (D env2 (coercionType co2)) + ===================================== compiler/GHC/Core/Map/Expr.hs ===================================== @@ -18,6 +18,8 @@ module GHC.Core.Map.Expr ( CoreMap, emptyCoreMap, extendCoreMap, lookupCoreMap, foldCoreMap, -- * Alpha equality eqDeBruijnExpr, eqCoreExpr, + -- ** Exports for CoreExprF instances + eqDeBruijnTickish, eqDeBruijnVar, -- * 'TrieMap' class reexports TrieMap(..), insertTM, deleteTM, lkDFreeVar, xtDFreeVar, ===================================== compiler/GHC/Core/Map/Type.hs ===================================== @@ -6,6 +6,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DeriveTraversable #-} module GHC.Core.Map.Type ( -- * Re-export generic interface @@ -16,12 +17,13 @@ module GHC.Core.Map.Type ( LooseTypeMap, -- ** With explicit scoping CmEnv, lookupCME, extendTypeMapWithScope, lookupTypeMapWithScope, - mkDeBruijnContext, extendCME, extendCMEs, emptyCME, + mkDeBruijnContext, extendCME, extendCMEs, emptyCME, sizeCME, -- * Utilities for use by friends only TypeMapG, CoercionMapG, DeBruijn(..), deBruijnize, eqDeBruijnType, eqDeBruijnVar, + cmpDeBruijnVar, BndrMap, xtBndr, lkBndr, VarMap, xtVar, lkVar, lkDFreeVar, xtDFreeVar, @@ -282,6 +284,9 @@ eqDeBruijnType env_t1@(D env1 t1) env_t2@(D env2 t2) = instance Eq (DeBruijn Var) where (==) = eqDeBruijnVar +instance Ord (DeBruijn Var) where + compare = cmpDeBruijnVar + eqDeBruijnVar :: DeBruijn Var -> DeBruijn Var -> Bool eqDeBruijnVar (D env1 v1) (D env2 v2) = case (lookupCME env1 v1, lookupCME env2 v2) of @@ -289,6 +294,13 @@ eqDeBruijnVar (D env1 v1) (D env2 v2) = (Nothing, Nothing) -> v1 == v2 _ -> False +cmpDeBruijnVar :: DeBruijn Var -> DeBruijn Var -> Ordering +cmpDeBruijnVar (D env1 v1) (D env2 v2) = + case (lookupCME env1 v1, lookupCME env2 v2) of + (Just b1, Just b2) -> compare b1 b2 + (Nothing, Nothing) -> compare v1 v2 + (z,w) -> compare z w -- Compare Maybes on whether they're Just or Nothing + instance {-# OVERLAPPING #-} Outputable a => Outputable (TypeMapG a) where ppr m = text "TypeMap elts" <+> ppr (foldTM (:) m []) @@ -505,6 +517,10 @@ extendCMEs env vs = foldl' extendCME env vs lookupCME :: CmEnv -> Var -> Maybe BoundVar lookupCME (CME { cme_env = env }) v = lookupVarEnv env v +-- | \(O(1)\). Number of elements in the CmEnv. +sizeCME :: CmEnv -> Int +sizeCME CME{cme_next=next} = next + -- | @DeBruijn a@ represents @a@ modulo alpha-renaming. This is achieved -- by equipping the value with a 'CmEnv', which tracks an on-the-fly deBruijn -- numbering. This allows us to define an 'Eq' instance for @DeBruijn a@, even @@ -512,6 +528,7 @@ lookupCME (CME { cme_env = env }) v = lookupVarEnv env v -- export the constructor. Make a helper function if you find yourself -- needing it. data DeBruijn a = D CmEnv a + deriving (Functor, Foldable, Traversable) -- romes:TODO: for internal use only! -- | Synthesizes a @DeBruijn a@ from an @a@, by assuming that there are no -- bound binders (an empty 'CmEnv'). This is usually what you want if there @@ -525,6 +542,15 @@ instance Eq (DeBruijn a) => Eq (DeBruijn [a]) where D env xs == D env' xs' _ == _ = False +instance Ord (DeBruijn a) => Ord (DeBruijn [a]) where + D _ [] `compare` D _ [] = EQ + D env (x:xs) `compare` D env' (x':xs') = case D env x `compare` D env' x' of + LT -> LT + EQ -> D env xs `compare` D env' xs' + GT -> GT + D _ [] `compare` D _ (_:_) = LT + D _ (_:_) `compare` D _ [] = GT + instance Eq (DeBruijn a) => Eq (DeBruijn (Maybe a)) where D _ Nothing == D _ Nothing = True D env (Just x) == D env' (Just x') = D env x == D env' x' ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -393,7 +393,8 @@ getNFirstUncovered mode vars n (MkNablas nablas) = go n (bagToList nablas) go 0 _ = pure [] go _ [] = pure [] go n (nabla:nablas) = do - front <- generateInhabitingPatterns mode vars n nabla + let (vars', nabla') = representIds vars nabla -- they're already there, we're just getting the e-class ids back + front <- generateInhabitingPatterns mode vars' n nabla' back <- go (n - length front) nablas pure (front ++ back) ===================================== compiler/GHC/HsToCore/Pmc/Check.hs ===================================== @@ -106,6 +106,8 @@ checkGrd :: PmGrd -> CheckAction RedSets checkGrd grd = CA $ \inc -> case grd of -- let x = e: Refine with x ~ e PmLet x e -> do + -- romes: we could potentially do update the trees to use e-class ids here, + -- or in pmcMatches matched <- addPhiCtNablas inc (PhiCoreCt x e) tracePm "check:Let" (ppr x <+> char '=' <+> ppr e) pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched } @@ -182,7 +184,7 @@ checkEmptyCase pe@(PmEmptyCase { pe_var = var }) = CA $ \inc -> do unc <- addPhiCtNablas inc (PhiNotBotCt var) pure CheckResult { cr_ret = pe, cr_uncov = unc, cr_approx = mempty } -checkPatBind :: (PmPatBind Pre) -> CheckAction (PmPatBind Post) +checkPatBind :: PmPatBind Pre -> CheckAction (PmPatBind Post) checkPatBind = coerce checkGRHS {- Note [Checking EmptyCase] ===================================== compiler/GHC/HsToCore/Pmc/Desugar.hs ===================================== @@ -326,6 +326,8 @@ desugarEmptyCase :: Id -> DsM PmEmptyCase desugarEmptyCase var = pure PmEmptyCase { pe_var = var } -- | Desugar the non-empty 'Match'es of a 'MatchGroup'. +-- +-- Returns a desugared guard tree of guard expressions. desugarMatches :: [Id] -> NonEmpty (LMatch GhcTc (LHsExpr GhcTc)) -> DsM (PmMatchGroup Pre) desugarMatches vars matches = ===================================== compiler/GHC/HsToCore/Pmc/Ppr.hs ===================================== @@ -13,8 +13,6 @@ import GHC.Data.List.Infinite (Infinite (..)) import qualified GHC.Data.List.Infinite as Inf import GHC.Types.Basic import GHC.Types.Id -import GHC.Types.Var.Env -import GHC.Types.Unique.DFM import GHC.Core.ConLike import GHC.Core.DataCon import GHC.Builtin.Types @@ -27,6 +25,10 @@ import Data.List.NonEmpty (NonEmpty, nonEmpty, toList) import GHC.HsToCore.Pmc.Types +import Data.Equality.Graph (ClassId) +import Data.IntMap (IntMap) +import qualified Data.IntMap as IM + -- | Pretty-print the guts of an uncovered value vector abstraction, i.e., its -- components and refutable shapes associated to any mentioned variables. -- @@ -42,18 +44,19 @@ import GHC.HsToCore.Pmc.Types -- additional elements are indicated by "...". pprUncovered :: Nabla -> [Id] -> SDoc pprUncovered nabla vas - | isNullUDFM refuts = fsep vec -- there are no refutations - | otherwise = hang (fsep vec) 4 $ - text "where" <+> vcat (map (pprRefutableShapes . snd) (udfmToList refuts)) + | IM.null refuts = fsep vec -- there are no refutations + | otherwise = hang (fsep vec) 4 $ + text "where" <+> vcat (map (pprRefutableShapes . snd) (IM.toList refuts)) where init_prec -- No outer parentheses when it's a unary pattern by assuming lowest -- precedence | [_] <- vas = topPrec | otherwise = appPrec - ppr_action = mapM (pprPmVar init_prec) vas - (vec, renamings) = runPmPpr nabla ppr_action - refuts = prettifyRefuts nabla renamings + (vas',nabla') = representIds vas nabla + ppr_action = mapM (pprPmVar init_prec) vas' + (vec, renamings) = runPmPpr nabla' ppr_action + refuts = prettifyRefuts nabla' renamings -- | Output refutable shapes of a variable in the form of @var is not one of {2, -- Nothing, 3}@. Will never print more than 3 refutable shapes, the tail is @@ -96,35 +99,37 @@ substitution to the vectors before printing them out (see function `pprOne' in -- | Extract and assigns pretty names to constraint variables with refutable -- shapes. -prettifyRefuts :: Nabla -> DIdEnv (Id, SDoc) -> DIdEnv (SDoc, [PmAltCon]) -prettifyRefuts nabla = listToUDFM_Directly . map attach_refuts . udfmToList +prettifyRefuts :: Nabla -> IntMap (ClassId, SDoc) -> IntMap (SDoc, [PmAltCon]) +prettifyRefuts nabla = IM.mapWithKey attach_refuts where - attach_refuts (u, (x, sdoc)) = (u, (sdoc, lookupRefuts nabla x)) + -- RM: why map with key? + attach_refuts :: ClassId -> (ClassId, SDoc) -> (SDoc, [PmAltCon]) + attach_refuts _u (x, sdoc) = (sdoc, lookupRefuts nabla x) -type PmPprM a = RWS Nabla () (DIdEnv (Id, SDoc), Infinite SDoc) a +type PmPprM a = RWS Nabla () (IntMap (ClassId, SDoc), Infinite SDoc) a -- Try nice names p,q,r,s,t before using the (ugly) t_i nameList :: Infinite SDoc nameList = map text ["p","q","r","s","t"] Inf.++ flip Inf.unfoldr (0 :: Int) (\ u -> (text ('t':show u), u+1)) -runPmPpr :: Nabla -> PmPprM a -> (a, DIdEnv (Id, SDoc)) -runPmPpr nabla m = case runRWS m nabla (emptyDVarEnv, nameList) of +runPmPpr :: Nabla -> PmPprM a -> (a, IntMap (ClassId, SDoc)) +runPmPpr nabla m = case runRWS m nabla (IM.empty, nameList) of (a, (renamings, _), _) -> (a, renamings) -- | Allocates a new, clean name for the given 'Id' if it doesn't already have -- one. -getCleanName :: Id -> PmPprM SDoc +getCleanName :: ClassId -> PmPprM SDoc getCleanName x = do (renamings, name_supply) <- get let Inf clean_name name_supply' = name_supply - case lookupDVarEnv renamings x of + case IM.lookup x renamings of Just (_, nm) -> pure nm Nothing -> do - put (extendDVarEnv renamings x (x, clean_name), name_supply') + put (IM.insert x (x, clean_name) renamings, name_supply') pure clean_name -checkRefuts :: Id -> PmPprM (Maybe SDoc) -- the clean name if it has negative info attached +checkRefuts :: ClassId -> PmPprM (Maybe SDoc) -- the clean name if it has negative info attached checkRefuts x = do nabla <- ask case lookupRefuts nabla x of @@ -134,20 +139,20 @@ checkRefuts x = do -- | Pretty print a variable, but remember to prettify the names of the variables -- that refer to neg-literals. The ones that cannot be shown are printed as -- underscores. -pprPmVar :: PprPrec -> Id -> PmPprM SDoc +pprPmVar :: PprPrec -> ClassId -> PmPprM SDoc pprPmVar prec x = do nabla <- ask case lookupSolution nabla x of Just (PACA alt _tvs args) -> pprPmAltCon prec alt args Nothing -> fromMaybe underscore <$> checkRefuts x -pprPmAltCon :: PprPrec -> PmAltCon -> [Id] -> PmPprM SDoc +pprPmAltCon :: PprPrec -> PmAltCon -> [ClassId] -> PmPprM SDoc pprPmAltCon _prec (PmAltLit l) _ = pure (ppr l) pprPmAltCon prec (PmAltConLike cl) args = do nabla <- ask pprConLike nabla prec cl args -pprConLike :: Nabla -> PprPrec -> ConLike -> [Id] -> PmPprM SDoc +pprConLike :: Nabla -> PprPrec -> ConLike -> [ClassId] -> PmPprM SDoc pprConLike nabla _prec cl args | Just pm_expr_list <- pmExprAsList nabla (PmAltConLike cl) args = case pm_expr_list of @@ -174,8 +179,8 @@ pprConLike _nabla prec cl args -- | The result of 'pmExprAsList'. data PmExprList - = NilTerminated [Id] - | WcVarTerminated (NonEmpty Id) Id + = NilTerminated [ClassId] + | WcVarTerminated (NonEmpty ClassId) ClassId -- | Extract a list of 'Id's out of a sequence of cons cells, optionally -- terminated by a wildcard variable instead of @[]@. Some examples: @@ -186,7 +191,7 @@ data PmExprList -- ending in a wildcard variable x (of list type). Should be pretty-printed as -- (1:2:_). -- * @pmExprAsList [] == Just ('NilTerminated' [])@ -pmExprAsList :: Nabla -> PmAltCon -> [Id] -> Maybe PmExprList +pmExprAsList :: Nabla -> PmAltCon -> [ClassId] -> Maybe PmExprList pmExprAsList nabla = go_con [] where go_var rev_pref x ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -1,4 +1,5 @@ {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} @@ -49,18 +50,17 @@ import GHC.Data.Bag import GHC.Types.CompleteMatch import GHC.Types.Unique.Set import GHC.Types.Unique.DSet -import GHC.Types.Unique.SDFM import GHC.Types.Id import GHC.Types.Name import GHC.Types.Var (EvVar) import GHC.Types.Var.Env -import GHC.Types.Var.Set import GHC.Types.Unique.Supply import GHC.Core import GHC.Core.FVs (exprFreeVars) import GHC.Core.TyCo.Compare( eqType ) -import GHC.Core.Map.Expr +import GHC.Core.Map.Type +import GHC.Core.Equality import GHC.Core.Predicate (typeDeterminesValue) import GHC.Core.SimpleOpt (simpleOptExpr, exprIsConApp_maybe) import GHC.Core.Utils (exprType) @@ -99,6 +99,15 @@ import Data.List (sortBy, find) import qualified Data.List.NonEmpty as NE import Data.Ord (comparing) +import Data.Equality.Graph (ClassId) +import Data.Equality.Graph.Lens +import qualified Data.Equality.Graph as EG +import Data.Bifunctor (second) +import Data.Function ((&)) +import qualified Data.IntSet as IS +import Data.Tuple (swap) +import Data.Traversable (mapAccumL) + -- -- * Main exports -- @@ -556,6 +565,9 @@ where you can find the solution in a perhaps more digestible format. -- | A high-level pattern-match constraint. Corresponds to φ from Figure 3 of -- the LYG paper. +-- ROMES:TODO: Ultimately, all these Ids could be replaced by e-class ids which +-- are generated during desugaring, but there are some details to it +-- (propagating the e-graphs in which these e-classes were created) data PhiCt = PhiTyCt !PredType -- ^ A type constraint "T ~ U". @@ -662,74 +674,83 @@ nameTyCt pred_ty = do -- 'addTyCts' before, through 'addPhiCts'. addPhiTmCt :: Nabla -> PhiCt -> MaybeT DsM Nabla addPhiTmCt _ (PhiTyCt ct) = pprPanic "addPhiCt:TyCt" (ppr ct) -- See the precondition -addPhiTmCt nabla (PhiCoreCt x e) = addCoreCt nabla x e +addPhiTmCt nabla (PhiCoreCt x e) = let (xid, nabla') = representId x nabla + in addCoreCt nabla' xid e addPhiTmCt nabla (PhiConCt x con tvs dicts args) = do -- Case (1) of Note [Strict fields and variables of unlifted type] -- PhiConCt correspond to the higher-level φ constraints from the paper with -- bindings semantics. It disperses into lower-level δ constraints that the -- 'add*Ct' functions correspond to. - nabla' <- addTyCts nabla (listToBag dicts) - nabla'' <- addConCt nabla' x con tvs args - foldlM addNotBotCt nabla'' (filterUnliftedFields con args) -addPhiTmCt nabla (PhiNotConCt x con) = addNotConCt nabla x con -addPhiTmCt nabla (PhiBotCt x) = addBotCt nabla x -addPhiTmCt nabla (PhiNotBotCt x) = addNotBotCt nabla x - -filterUnliftedFields :: PmAltCon -> [Id] -> [Id] + nabla1 <- addTyCts nabla (listToBag dicts) + let (xid, nabla2) = representId x nabla1 + let (args_ids, nabla3) = representIds args nabla2 + -- romes: here we could have something like (merge (add K arg_ids) x) + -- or actually that should be done by addConCt? + nabla4 <- addConCt nabla3 xid con tvs args_ids + foldlM addNotBotCt nabla4 (filterUnliftedFields con (zip args_ids args)) +addPhiTmCt nabla (PhiNotConCt x con) = let (xid, nabla') = representId x nabla + in addNotConCt nabla' xid con +addPhiTmCt nabla (PhiBotCt x) = let (xid, nabla') = representId x nabla + in addBotCt nabla' xid +addPhiTmCt nabla (PhiNotBotCt x) = let (xid, nabla') = representId x nabla + in addNotBotCt nabla' xid + +filterUnliftedFields :: PmAltCon -> [(ClassId,Id)] -> [ClassId] filterUnliftedFields con args = - [ arg | (arg, bang) <- zipEqual "addPhiCt" args (pmAltConImplBangs con) - , isBanged bang || definitelyUnliftedType (idType arg) ] + [ arg_id | ((arg_id,arg), bang) <- zipEqual "addPhiCt" args (pmAltConImplBangs con) + , isBanged bang || definitelyUnliftedType (idType arg) ] -- | Adds the constraint @x ~ ⊥@, e.g. that evaluation of a particular 'Id' @x@ -- surely diverges. Quite similar to 'addConCt', only that it only cares about -- ⊥. -addBotCt :: Nabla -> Id -> MaybeT DsM Nabla -addBotCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x = do - let (y, vi at VI { vi_bot = bot }) = lookupVarInfoNT (nabla_tm_st nabla) x - case bot of - IsNotBot -> mzero -- There was x ≁ ⊥. Contradiction! - IsBot -> pure nabla -- There already is x ~ ⊥. Nothing left to do - MaybeBot -- We add x ~ ⊥ - | definitelyUnliftedType (idType x) - -- Case (3) in Note [Strict fields and variables of unlifted type] - -> mzero -- unlifted vars can never be ⊥ - | otherwise - -> do - let vi' = vi{ vi_bot = IsBot } - pure nabla{ nabla_tm_st = ts{ts_facts = addToUSDFM env y vi' } } +addBotCt :: Nabla -> ClassId -> MaybeT DsM Nabla +addBotCt nabla x = updateVarInfo x go nabla + where + go :: VarInfo -> MaybeT DsM VarInfo + go vi at VI { vi_bot = bot } + = case bot of + IsNotBot -> mzero -- There was x ≁ ⊥. Contradiction! + IsBot -> return vi -- There already is x ~ ⊥. Nothing left to do + MaybeBot -- We add x ~ ⊥ + | definitelyUnliftedType (eclassType x nabla) + -- Case (3) in Note [Strict fields and variables of unlifted type] + -> mzero -- unlifted vars can never be ⊥ + | otherwise + -> do + return vi{ vi_bot = IsBot } -- | Adds the constraint @x ~/ ⊥@ to 'Nabla'. Quite similar to 'addNotConCt', -- but only cares for the ⊥ "constructor". -addNotBotCt :: Nabla -> Id -> MaybeT DsM Nabla +addNotBotCt :: Nabla -> ClassId -> MaybeT DsM Nabla addNotBotCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts=env} } x = do - let (y, vi at VI { vi_bot = bot }) = lookupVarInfoNT (nabla_tm_st nabla) x + let (yid, vi at VI { vi_bot = bot }) = lookupVarInfoNT ts x case bot of IsBot -> mzero -- There was x ~ ⊥. Contradiction! IsNotBot -> pure nabla -- There already is x ≁ ⊥. Nothing left to do MaybeBot -> do -- We add x ≁ ⊥ and test if x is still inhabited -- Mark dirty for a delayed inhabitation test let vi' = vi{ vi_bot = IsNotBot} - pure $ markDirty y - $ nabla{ nabla_tm_st = ts{ ts_facts = addToUSDFM env y vi' } } + pure $ markDirty yid + $ nabla{nabla_tm_st = ts{ ts_facts = env & _class yid . _data .~ vi'}} -- | Record a @x ~/ K@ constraint, e.g. that a particular 'Id' @x@ can't -- take the shape of a 'PmAltCon' @K@ in the 'Nabla' and return @Nothing@ if -- that leads to a contradiction. -- See Note [TmState invariants]. -addNotConCt :: Nabla -> Id -> PmAltCon -> MaybeT DsM Nabla +addNotConCt :: Nabla -> ClassId -> PmAltCon -> MaybeT DsM Nabla addNotConCt _ _ (PmAltConLike (RealDataCon dc)) | isNewDataCon dc = mzero -- (3) in Note [Coverage checking Newtype matches] addNotConCt nabla x nalt = do (mb_mark_dirty, nabla') <- trvVarInfo go nabla x pure $ case mb_mark_dirty of - Just x -> markDirty x nabla' - Nothing -> nabla' + True -> markDirty x nabla' + False -> nabla' where -- Update `x`'s 'VarInfo' entry. Fail ('MaybeT') if contradiction, -- otherwise return updated entry and `Just x'` if `x` should be marked dirty, -- where `x'` is the representative of `x`. - go :: VarInfo -> MaybeT DsM (Maybe Id, VarInfo) - go vi@(VI x' pos neg _ rcm) = do + go :: VarInfo -> MaybeT DsM (Bool, VarInfo) + go vi@(VI _x' pos neg _ rcm) = do -- 1. Bail out quickly when nalt contradicts a solution let contradicts nalt sol = eqPmAltCon (paca_con sol) nalt == Equal guard (not (any (contradicts nalt) pos)) @@ -748,12 +769,12 @@ addNotConCt nabla x nalt = do pure $ case mb_rcm' of -- If nalt could be removed from a COMPLETE set, we'll get back Just and -- have to mark x dirty, by returning Just x'. - Just rcm' -> (Just x', vi'{ vi_rcm = rcm' }) + Just rcm' -> (True, vi'{ vi_rcm = rcm' }) -- Otherwise, nalt didn't occur in any residual COMPLETE set and we -- don't have to mark it dirty. So we return Nothing, which in the case -- above would have compromised precision. -- See Note [Shortcutting the inhabitation test], grep for T17836. - Nothing -> (Nothing, vi') + Nothing -> (False, vi') hasRequiredTheta :: PmAltCon -> Bool hasRequiredTheta (PmAltConLike cl) = notNull req_theta @@ -767,8 +788,9 @@ hasRequiredTheta _ = False -- have on @x@, reject (@Nothing@) otherwise. -- -- See Note [TmState invariants]. -addConCt :: Nabla -> Id -> PmAltCon -> [TyVar] -> [Id] -> MaybeT DsM Nabla -addConCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x alt tvs args = do +addConCt :: Nabla -> ClassId -> PmAltCon -> [TyVar] -> [ClassId] -> MaybeT DsM Nabla +addConCt nabla at MkNabla{ nabla_tm_st = ts } x alt tvs args = do + -- ROMES:TODO: Also looks like a function on varinfo (adjust) let vi@(VI _ pos neg bot _) = lookupVarInfo ts x -- First try to refute with a negative fact guard (not (elemPmAltConSet alt neg)) @@ -788,7 +810,7 @@ addConCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=env } } x alt tvs args = Nothing -> do let pos' = PACA alt tvs args : pos let nabla_with bot' = - nabla{ nabla_tm_st = ts{ts_facts = addToUSDFM env x (vi{vi_pos = pos', vi_bot = bot'})} } + nabla{nabla_tm_st = ts{ts_facts = ts_facts ts & _class x ._data .~ vi{vi_pos = pos', vi_bot = bot'}}} -- Do (2) in Note [Coverage checking Newtype matches] case (alt, args) of (PmAltConLike (RealDataCon dc), [y]) | isNewDataCon dc -> @@ -816,12 +838,15 @@ equateTys ts us = -- @nabla@ has integrated the knowledge from the equality constraint. -- -- See Note [TmState invariants]. -addVarCt :: Nabla -> Id -> Id -> MaybeT DsM Nabla +addVarCt :: Nabla -> ClassId -> ClassId -> MaybeT DsM Nabla +-- This is where equality-graphs really come into play. addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = - case equateUSDFM env x y of - (Nothing, env') -> pure (nabla{ nabla_tm_st = ts{ ts_facts = env' } }) + -- ROMES:TODO: equate auxiliary var that finds both vars, and lookups up the domain associated. However, I think we no longer should have Just/Nothing but rather always store emptyVarInfo for new e-nodes + -- equate should also update e-graph, basically re-implement "equateUSDFM" in terms of the e-graph, or inline it or so + case equate env x y of -- Add the constraints we had for x to y - (Just vi_x, env') -> do + -- See Note [Joining e-classes PMC] todo mention from joinA + (vi_x, env') -> do let nabla_equated = nabla{ nabla_tm_st = ts{ts_facts = env'} } -- and then gradually merge every positive fact we have on x into y let add_pos nabla (PACA cl tvs args) = addConCt nabla y cl tvs args @@ -829,6 +854,22 @@ addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = -- Do the same for negative info let add_neg nabla nalt = addNotConCt nabla y nalt foldlM add_neg nabla_pos (pmAltConSetElems (vi_neg vi_x)) + where + -- @equate env x y@ makes @x@ and @y@ point to the same entry, + -- thereby merging @x@'s class with @y@'s. + -- If both @x@ and @y@ are in the domain of the map, then @y@'s entry will be + -- chosen as the new entry and @x@'s old entry will be returned. + -- + -- Examples in terms of the model (see 'UniqSDFM'): + -- >>> equate [] u1 u2 == (Nothing, [({u1,u2}, Nothing)]) + -- >>> equate [({u1,u3}, Just ele1)] u3 u4 == (Nothing, [({u1,u3,u4}, Just ele1)]) + -- >>> equate [({u1,u3}, Just ele1)] u4 u3 == (Nothing, [({u1,u3,u4}, Just ele1)]) + -- >>> equate [({u1,u3}, Just ele1), ({u2}, Just ele2)] u3 u2 == (Just ele1, [({u2,u1,u3}, Just ele2)]) + equate :: TmEGraph -> ClassId -> ClassId -> (VarInfo, TmEGraph) + equate eg x y = let (_, eg') = EG.merge x y eg + in (eg ^. _class x ._data, eg') + -- Note: lookup in @eg@, not @eg'@, because it's before the merge. + -- | Inspects a 'PmCoreCt' @let x = e@ by recording constraints for @x@ based -- on the shape of the 'CoreExpr' @e at . Examples: @@ -842,7 +883,7 @@ addVarCt nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = env } } x y = -- for other literals. See 'coreExprAsPmLit'. -- * Finally, if we have @let x = e@ and we already have seen @let y = e@, we -- want to record @x ~ y at . -addCoreCt :: Nabla -> Id -> CoreExpr -> MaybeT DsM Nabla +addCoreCt :: Nabla -> ClassId -> CoreExpr -> MaybeT DsM Nabla addCoreCt nabla x e = do simpl_opts <- initSimpleOpts <$> getDynFlags let e' = simpleOptExpr simpl_opts e @@ -851,8 +892,9 @@ addCoreCt nabla x e = do where -- Takes apart a 'CoreExpr' and tries to extract as much information about -- literals and constructor applications as possible. - core_expr :: Id -> CoreExpr -> StateT Nabla (MaybeT DsM) () + core_expr :: ClassId -> CoreExpr -> StateT Nabla (MaybeT DsM) () -- TODO: Handle newtypes properly, by wrapping the expression in a DataCon + -- RM: Could this be done better with e-graphs? The whole newtype stuff -- This is the right thing for casts involving data family instances and -- their representation TyCon, though (which are not visible in source -- syntax). See Note [COMPLETE sets on data families] @@ -873,14 +915,19 @@ addCoreCt nabla x e = do | Just (in_scope, _empty_floats@[], dc, _arg_tys, args) <- exprIsConApp_maybe in_scope_env e = data_con_app x in_scope dc args - -- See Note [Detecting pattern synonym applications in expressions] - | Var y <- e, Nothing <- isDataConId_maybe x - -- We don't consider DataCons flexible variables - = modifyT (\nabla -> addVarCt nabla x y) | otherwise - -- Any other expression. Try to find other uses of a semantically - -- equivalent expression and represent them by the same variable! - = equate_with_similar_expr x e + = do + nabla' <- get + if + -- See Note [Detecting pattern synonym applications in expressions] + | Var y <- e, Nothing <- isDataConId_maybe (eclassMatchId x nabla') + -- We don't consider DataCons flexible variables + -> modifyT (\nabla -> let (yid, nabla') = representId y nabla + in addVarCt nabla' x yid) + | otherwise + -- Any other expression. Try to find other uses of a semantically + -- equivalent expression and represent them by the same variable! + -> equate_with_similar_expr x e where expr_ty = exprType e expr_in_scope = mkInScopeSet (exprFreeVars e) @@ -894,17 +941,21 @@ addCoreCt nabla x e = do -- see if we already encountered a constraint @let y = e'@ with @e'@ -- semantically equivalent to @e@, in which case we may add the constraint -- @x ~ y at . - equate_with_similar_expr :: Id -> CoreExpr -> StateT Nabla (MaybeT DsM) () - equate_with_similar_expr x e = do - rep <- StateT $ \nabla -> lift (representCoreExpr nabla e) + equate_with_similar_expr :: ClassId -> CoreExpr -> StateT Nabla (MaybeT DsM) () + equate_with_similar_expr _x e = do + rep <- StateT $ \nabla -> pure (representCoreExpr nabla e) -- Note that @rep == x@ if we encountered @e@ for the first time. + + -- ROMES:TODO: I don't think we need to do the following anymore, represent should directly do so in the right e-class (if rebuilt) modifyT (\nabla -> addVarCt nabla x rep) + -- ROMES:TODO: When to rebuild? - bind_expr :: CoreExpr -> StateT Nabla (MaybeT DsM) Id + bind_expr :: CoreExpr -> StateT Nabla (MaybeT DsM) ClassId bind_expr e = do x <- lift (lift (mkPmId (exprType e))) - core_expr x e - pure x + xid <- StateT $ \nabla -> pure $ representId x nabla + core_expr xid e + pure xid -- Look at @let x = K taus theta es@ and generate the following -- constraints (assuming universals were dropped from @taus@ before): @@ -913,7 +964,7 @@ addCoreCt nabla x e = do -- 3. @y_1 ~ e_1, ..., y_m ~ e_m@ for fresh @y_i@ -- 4. @x ~ K as ys@ -- This is quite similar to PmCheck.pmConCts. - data_con_app :: Id -> InScopeSet -> DataCon -> [CoreExpr] -> StateT Nabla (MaybeT DsM) () + data_con_app :: ClassId -> InScopeSet -> DataCon -> [CoreExpr] -> StateT Nabla (MaybeT DsM) () data_con_app x in_scope dc args = do let dc_ex_tvs = dataConExTyCoVars dc arty = dataConSourceArity dc @@ -936,13 +987,13 @@ addCoreCt nabla x e = do -- Adds a literal constraint, i.e. @x ~ 42 at . -- Also we assume that literal expressions won't diverge, so this -- will add a @x ~/ ⊥@ constraint. - pm_lit :: Id -> PmLit -> StateT Nabla (MaybeT DsM) () + pm_lit :: ClassId -> PmLit -> StateT Nabla (MaybeT DsM) () pm_lit x lit = do modifyT $ \nabla -> addNotBotCt nabla x pm_alt_con_app x (PmAltLit lit) [] [] -- Adds the given constructor application as a solution for @x at . - pm_alt_con_app :: Id -> PmAltCon -> [TyVar] -> [Id] -> StateT Nabla (MaybeT DsM) () + pm_alt_con_app :: ClassId -> PmAltCon -> [TyVar] -> [ClassId] -> StateT Nabla (MaybeT DsM) () pm_alt_con_app x con tvs args = modifyT $ \nabla -> addConCt nabla x con tvs args -- | Like 'modify', but with an effectful modifier action @@ -953,24 +1004,18 @@ modifyT f = StateT $ fmap ((,) ()) . f -- Which is the @x@ of a @let x = e'@ constraint (with @e@ semantically -- equivalent to @e'@) we encountered earlier, or a fresh identifier if -- there weren't any such constraints. -representCoreExpr :: Nabla -> CoreExpr -> DsM (Id, Nabla) -representCoreExpr nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_reps = reps } } e - | Just rep <- lookupCoreMap reps key = pure (rep, nabla) - | otherwise = do - rep <- mkPmId (exprType e) - let reps' = extendCoreMap reps key rep - let nabla' = nabla{ nabla_tm_st = ts{ ts_reps = reps' } } - pure (rep, nabla') - where - key = makeDictsCoherent e - -- Use a key in which dictionaries for the same type become equal. - -- See Note [Unique dictionaries in the TmOracle CoreMap] +representCoreExpr :: Nabla -> CoreExpr -> (ClassId, Nabla) +representCoreExpr nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts = egraph } } e = + second (\g -> nabla{nabla_tm_st = ts{ts_facts = g}}) $ representDBCoreExpr (deBruijnize (makeDictsCoherent e)) egraph + -- Use a key in which dictionaries for the same type become equal. + -- See Note [Unique dictionaries in the TmOracle CoreMap] -- | Change out 'Id's which are uniquely determined by their type to a -- common value, so that different names for dictionaries of the same type -- are considered equal when building a 'CoreMap'. -- -- See Note [Unique dictionaries in the TmOracle CoreMap] +-- ROMES:TODO: I suppose this should be taken into account by the Eq instance of DeBruijnF CoreExprF -- if we do that there then we're sure that EG.represent takes that into account. makeDictsCoherent :: CoreExpr -> CoreExpr makeDictsCoherent var@(Var v) | let ty = idType v @@ -1059,6 +1104,7 @@ In the end, replacing dictionaries with an error value in the pattern-match checker was the most self-contained, although we might want to revisit once we implement a more robust approach to computing equality in the pattern-match checker (see #19272). +ROMES:TODO: I don't think e-graphs avoid this situation, because the names of the binders will still differ (although the Eq instance could take this into account?) -} {- Note [The Pos/Neg invariant] @@ -1271,22 +1317,24 @@ tyStateRefined :: TyState -> TyState -> Bool -- refinement of b or vice versa! tyStateRefined a b = ty_st_n a /= ty_st_n b -markDirty :: Id -> Nabla -> Nabla +markDirty :: ClassId -> Nabla -> Nabla markDirty x nabla at MkNabla{nabla_tm_st = ts at TmSt{ts_dirty = dirty} } = - nabla{ nabla_tm_st = ts{ ts_dirty = extendDVarSet dirty x } } + nabla{nabla_tm_st = ts{ ts_dirty = IS.insert x dirty }} -traverseDirty :: Monad m => (VarInfo -> m VarInfo) -> TmState -> m TmState +traverseDirty :: Monad m => (ClassId -> VarInfo -> m VarInfo) -> TmState -> m TmState traverseDirty f ts at TmSt{ts_facts = env, ts_dirty = dirty} = - go (uniqDSetToList dirty) env + + go (IS.elems dirty) env where go [] env = pure ts{ts_facts=env} - go (x:xs) !env = do - vi' <- f (lookupVarInfo ts x) - go xs (addToUSDFM env x vi') + go (x:xs) !_env = do + let vi = env ^._class x._data + vi' <- f x vi + go xs (env & _class x._data .~ vi') -- Use 'over' or so instead? -traverseAll :: Monad m => (VarInfo -> m VarInfo) -> TmState -> m TmState +traverseAll :: Monad m => (ClassId -> VarInfo -> m VarInfo) -> TmState -> m TmState traverseAll f ts at TmSt{ts_facts = env} = do - env' <- traverseUSDFM f env + env' <- (_iclasses.(\fab (i,cl) -> let mvi = fab (i,cl^._data) in (cl &) . (_data .~) <$> mvi)) (uncurry f) env pure ts{ts_facts = env'} -- | Makes sure the given 'Nabla' is still inhabited, by trying to instantiate @@ -1308,31 +1356,34 @@ inhabitationTest fuel old_ty_st nabla at MkNabla{ nabla_tm_st = ts } = {-# SCC "in ts' <- if tyStateRefined old_ty_st (nabla_ty_st nabla) then traverseAll test_one ts else traverseDirty test_one ts - pure nabla{ nabla_tm_st = ts'{ts_dirty=emptyDVarSet}} + pure nabla{ nabla_tm_st = ts'{ts_dirty=IS.empty}} where - nabla_not_dirty = nabla{ nabla_tm_st = ts{ts_dirty=emptyDVarSet} } - test_one :: VarInfo -> MaybeT DsM VarInfo - test_one vi = - lift (varNeedsTesting old_ty_st nabla vi) >>= \case + nabla_not_dirty = nabla{ nabla_tm_st = ts{ts_dirty=IS.empty} } + test_one :: ClassId -> VarInfo -> MaybeT DsM VarInfo + test_one cid vi = + lift (varNeedsTesting old_ty_st nabla cid vi) >>= \case True -> do -- lift $ tracePm "test_one" (ppr vi) -- No solution yet and needs testing -- We have to test with a Nabla where all dirty bits are cleared - instantiate (fuel-1) nabla_not_dirty vi - _ -> pure vi + instantiate (fuel-1) nabla_not_dirty (cid,vi) + _ -> return vi + +-- ROMES:TODO: The dirty shortcutting bit seems like the bookeeping on nodes to +-- upward merge, perhaps we can rid of it too -- | Checks whether the given 'VarInfo' needs to be tested for inhabitants. -- Returns `False` when we can skip the inhabitation test, presuming it would -- say "yes" anyway. See Note [Shortcutting the inhabitation test]. -varNeedsTesting :: TyState -> Nabla -> VarInfo -> DsM Bool -varNeedsTesting _ MkNabla{nabla_tm_st=tm_st} vi - | elemDVarSet (vi_id vi) (ts_dirty tm_st) = pure True -varNeedsTesting _ _ vi +varNeedsTesting :: TyState -> Nabla -> ClassId -> VarInfo -> DsM Bool +varNeedsTesting _ MkNabla{nabla_tm_st=tm_st} cid _ + | IS.member cid (ts_dirty tm_st) = pure True +varNeedsTesting _ _ _ vi | notNull (vi_pos vi) = pure False -varNeedsTesting old_ty_st MkNabla{nabla_ty_st=new_ty_st} _ +varNeedsTesting old_ty_st MkNabla{nabla_ty_st=new_ty_st} _ _ -- Same type state => still inhabited | not (tyStateRefined old_ty_st new_ty_st) = pure False -varNeedsTesting old_ty_st MkNabla{nabla_ty_st=new_ty_st} vi = do +varNeedsTesting old_ty_st MkNabla{nabla_ty_st=new_ty_st} _ vi = do -- These normalisations are relatively expensive, but still better than having -- to perform a full inhabitation test (_, _, old_norm_ty) <- tntrGuts <$> pmTopNormaliseType old_ty_st (idType $ vi_id vi) @@ -1349,25 +1400,25 @@ varNeedsTesting old_ty_st MkNabla{nabla_ty_st=new_ty_st} vi = do -- NB: Does /not/ filter each CompleteMatch with the oracle; members may -- remain that do not satisfy it. This lazy approach just -- avoids doing unnecessary work. -instantiate :: Int -> Nabla -> VarInfo -> MaybeT DsM VarInfo -instantiate fuel nabla vi = {-# SCC "instantiate" #-} - (instBot fuel nabla vi <|> instCompleteSets fuel nabla vi) +instantiate :: Int -> Nabla -> (ClassId, VarInfo) -> MaybeT DsM VarInfo +instantiate fuel nabla (ci,vi) = {-# SCC "instantiate" #-} + (instBot fuel nabla (ci,vi) <|> instCompleteSets fuel nabla ci) -- | The \(⊢_{Bot}\) rule from the paper -instBot :: Int -> Nabla -> VarInfo -> MaybeT DsM VarInfo -instBot _fuel nabla vi = {-# SCC "instBot" #-} do - _nabla' <- addBotCt nabla (vi_id vi) +instBot :: Int -> Nabla -> (ClassId,VarInfo) -> MaybeT DsM VarInfo +instBot _fuel nabla (cid,vi) = {-# SCC "instBot" #-} do + _nabla' <- addBotCt nabla cid pure vi -addNormalisedTypeMatches :: Nabla -> Id -> DsM (ResidualCompleteMatches, Nabla) -addNormalisedTypeMatches nabla at MkNabla{ nabla_ty_st = ty_st } x - = trvVarInfo add_matches nabla x +addNormalisedTypeMatches :: Nabla -> ClassId -> DsM (ResidualCompleteMatches, Nabla) +addNormalisedTypeMatches nabla at MkNabla{ nabla_ty_st = ty_st } xid + = trvVarInfo add_matches nabla xid where add_matches vi at VI{ vi_rcm = rcm } -- important common case, shaving down allocations of PmSeriesG by -5% | isRcmInitialised rcm = pure (rcm, vi) add_matches vi at VI{ vi_rcm = rcm } = do - norm_res_ty <- normaliseSourceTypeWHNF ty_st (idType x) + norm_res_ty <- normaliseSourceTypeWHNF ty_st (eclassType xid nabla) env <- dsGetFamInstEnvs rcm' <- case splitReprTyConApp_maybe env norm_res_ty of Just (rep_tc, _args, _co) -> addTyConMatches rep_tc rcm @@ -1388,12 +1439,11 @@ splitReprTyConApp_maybe env ty = -- inhabitant, the whole thing is uninhabited. It returns the updated 'VarInfo' -- where all the attempted ConLike instantiations have been purged from the -- 'ResidualCompleteMatches', which functions as a cache. -instCompleteSets :: Int -> Nabla -> VarInfo -> MaybeT DsM VarInfo -instCompleteSets fuel nabla vi = {-# SCC "instCompleteSets" #-} do - let x = vi_id vi - (rcm, nabla) <- lift (addNormalisedTypeMatches nabla x) - nabla <- foldM (\nabla cls -> instCompleteSet fuel nabla x cls) nabla (getRcm rcm) - pure (lookupVarInfo (nabla_tm_st nabla) x) +instCompleteSets :: Int -> Nabla -> ClassId -> MaybeT DsM VarInfo +instCompleteSets fuel nabla cid = {-# SCC "instCompleteSets" #-} do + (rcm, nabla) <- lift (addNormalisedTypeMatches nabla cid) + nabla <- foldM (\nabla cls -> instCompleteSet fuel nabla cid cls) nabla (getRcm rcm) + pure (lookupVarInfo (nabla_tm_st nabla) cid) anyConLikeSolution :: (ConLike -> Bool) -> [PmAltConApp] -> Bool anyConLikeSolution p = any (go . paca_con) @@ -1411,18 +1461,19 @@ anyConLikeSolution p = any (go . paca_con) -- original Nabla, not a proper refinement! No positive information will be -- added, only negative information from failed instantiation attempts, -- entirely as an optimisation. -instCompleteSet :: Int -> Nabla -> Id -> CompleteMatch -> MaybeT DsM Nabla -instCompleteSet fuel nabla x cs - | anyConLikeSolution (`elementOfUniqDSet` (cmConLikes cs)) (vi_pos vi) +instCompleteSet :: Int -> Nabla -> ClassId -> CompleteMatch -> MaybeT DsM Nabla +instCompleteSet fuel nabla xid cs + | anyConLikeSolution (`elementOfUniqDSet` cmConLikes cs) (vi_pos vi) -- No need to instantiate a constructor of this COMPLETE set if we already -- have a solution! = pure nabla - | not (completeMatchAppliesAtType (varType x) cs) + | not (completeMatchAppliesAtType (eclassType xid nabla) cs) = pure nabla | otherwise = {-# SCC "instCompleteSet" #-} go nabla (sorted_candidates cs) where - vi = lookupVarInfo (nabla_tm_st nabla) x + vi = lookupVarInfo (nabla_tm_st nabla) xid + x = vi_id vi sorted_candidates :: CompleteMatch -> [ConLike] sorted_candidates cm @@ -1443,12 +1494,11 @@ instCompleteSet fuel nabla x cs | isDataConTriviallyInhabited dc = pure nabla go nabla (con:cons) = do - let x = vi_id vi let recur_not_con = do - nabla' <- addNotConCt nabla x (PmAltConLike con) + nabla' <- addNotConCt nabla xid (PmAltConLike con) go nabla' cons (nabla <$ instCon fuel nabla x con) -- return the original nabla, not the - -- refined one! + -- refined one! <|> recur_not_con -- Assume that x can't be con. Encode that fact -- with addNotConCt and recur. @@ -1532,6 +1582,7 @@ instCon fuel nabla at MkNabla{nabla_ty_st = ty_st} x con = {-# SCC "instCon" #-} Ma -- (4) Instantiate fresh term variables as arguments to the constructor let field_tys' = substTys sigma_ex $ map scaledThing field_tys arg_ids <- mapM mkPmId field_tys' + let (nabla', arg_class_ids) = mapAccumL (\nab id -> swap $ representId id nab) nabla arg_ids tracePm (hdr "(cts)") $ vcat [ ppr x <+> dcolon <+> ppr match_ty , text "In WHNF:" <+> ppr (isSourceTypeInWHNF match_ty) <+> ppr norm_match_ty @@ -1544,10 +1595,10 @@ instCon fuel nabla at MkNabla{nabla_ty_st = ty_st} x con = {-# SCC "instCon" #-} Ma runMaybeT $ do -- Case (2) of Note [Strict fields and variables of unlifted type] let alt = PmAltConLike con - let branching_factor = length $ filterUnliftedFields alt arg_ids + let branching_factor = length $ filterUnliftedFields alt (zip arg_class_ids arg_ids) let ct = PhiConCt x alt ex_tvs gammas arg_ids nabla1 <- traceWhenFailPm (hdr "(ct unsatisfiable) }") (ppr ct) $ - addPhiTmCt nabla ct + addPhiTmCt nabla' ct -- See Note [Fuel for the inhabitation test] let new_fuel | branching_factor <= 1 = fuel @@ -1564,13 +1615,13 @@ instCon fuel nabla at MkNabla{nabla_ty_st = ty_st} x con = {-# SCC "instCon" #-} Ma , ppr new_fuel ] nabla2 <- traceWhenFailPm (hdr "(inh test failed) }") (ppr nabla1) $ - inhabitationTest new_fuel (nabla_ty_st nabla) nabla1 + inhabitationTest new_fuel (nabla_ty_st nabla') nabla1 lift $ tracePm (hdr "(inh test succeeded) }") (ppr nabla2) pure nabla2 Nothing -> do tracePm (hdr "(match_ty not instance of res_ty) }") empty pure (Just nabla) -- Matching against match_ty failed. Inhabited! - -- See Note [Instantiating a ConLike]. + -- See Note [Instantiating a ConLike]. -- | @matchConLikeResTy _ _ ty K@ tries to match @ty@ against the result -- type of @K@, @res_ty at . It returns a substitution @s@ for @K@'s universal @@ -1905,13 +1956,15 @@ instance Outputable GenerateInhabitingPatternsMode where -- perhaps empty) refinements of @nabla@ that represent inhabited patterns. -- Negative information is only retained if literals are involved or for -- recursive GADTs. -generateInhabitingPatterns :: GenerateInhabitingPatternsMode -> [Id] -> Int -> Nabla -> DsM [Nabla] +-- +-- The list of 'Id's @vs@ is the list of match-ids ? and they have all already been represented in the e-graph, we just represent them again to re-gain class id information +generateInhabitingPatterns :: GenerateInhabitingPatternsMode -> [ClassId] -> Int -> Nabla -> DsM [Nabla] -- See Note [Why inhabitationTest doesn't call generateInhabitingPatterns] generateInhabitingPatterns _ _ 0 _ = pure [] generateInhabitingPatterns _ [] _ nabla = pure [nabla] -generateInhabitingPatterns mode (x:xs) n nabla = do +generateInhabitingPatterns mode (x:xs) n nabla at MkNabla{nabla_tm_st=ts} = do tracePm "generateInhabitingPatterns" (ppr mode <+> ppr n <+> ppr (x:xs) $$ ppr nabla) - let VI _ pos neg _ _ = lookupVarInfo (nabla_tm_st nabla) x + let VI _ pos neg _ _ = lookupVarInfo ts x case pos of _:_ -> do -- Example for multiple solutions (must involve a PatSyn): @@ -1941,15 +1994,15 @@ generateInhabitingPatterns mode (x:xs) n nabla = do -- Tries to instantiate a variable by possibly following the chain of -- newtypes and then instantiating to all ConLikes of the wrapped type's -- minimal residual COMPLETE set. - try_instantiate :: Id -> [Id] -> Int -> Nabla -> DsM [Nabla] + try_instantiate :: ClassId -> [ClassId] -> Int -> Nabla -> DsM [Nabla] -- Convention: x binds the outer constructor in the chain, y the inner one. try_instantiate x xs n nabla = do - (_src_ty, dcs, rep_ty) <- tntrGuts <$> pmTopNormaliseType (nabla_ty_st nabla) (idType x) + (_src_ty, dcs, rep_ty) <- tntrGuts <$> pmTopNormaliseType (nabla_ty_st nabla) (eclassType x nabla) mb_stuff <- runMaybeT $ instantiate_newtype_chain x nabla dcs case mb_stuff of Nothing -> pure [] - Just (y, newty_nabla) -> do - let vi = lookupVarInfo (nabla_tm_st newty_nabla) y + Just (y, newty_nabla at MkNabla{nabla_tm_st=ts}) -> do + let vi = lookupVarInfo ts y env <- dsGetFamInstEnvs rcm <- case splitReprTyConApp_maybe env rep_ty of Just (tc, _, _) -> addTyConMatches tc (vi_rcm vi) @@ -1973,16 +2026,17 @@ generateInhabitingPatterns mode (x:xs) n nabla = do -- Instantiates a chain of newtypes, beginning at @x at . -- Turns @x nabla [T,U,V]@ to @(y, nabla')@, where @nabla'@ we has the fact -- @x ~ T (U (V y))@. - instantiate_newtype_chain :: Id -> Nabla -> [(Type, DataCon, Type)] -> MaybeT DsM (Id, Nabla) + instantiate_newtype_chain :: ClassId -> Nabla -> [(Type, DataCon, Type)] -> MaybeT DsM (ClassId, Nabla) instantiate_newtype_chain x nabla [] = pure (x, nabla) instantiate_newtype_chain x nabla ((_ty, dc, arg_ty):dcs) = do y <- lift $ mkPmId arg_ty + let (yid,nabla') = representId y nabla -- Newtypes don't have existentials (yet?!), so passing an empty -- list as ex_tvs. - nabla' <- addConCt nabla x (PmAltConLike (RealDataCon dc)) [] [y] - instantiate_newtype_chain y nabla' dcs + nabla'' <- addConCt nabla' x (PmAltConLike (RealDataCon dc)) [] [yid] + instantiate_newtype_chain yid nabla'' dcs - instantiate_cons :: Id -> Type -> [Id] -> Int -> Nabla -> [ConLike] -> DsM [Nabla] + instantiate_cons :: ClassId -> Type -> [ClassId] -> Int -> Nabla -> [ConLike] -> DsM [Nabla] instantiate_cons _ _ _ _ _ [] = pure [] instantiate_cons _ _ _ 0 _ _ = pure [] instantiate_cons _ ty xs n nabla _ @@ -1991,8 +2045,8 @@ generateInhabitingPatterns mode (x:xs) n nabla = do = generateInhabitingPatterns mode xs n nabla instantiate_cons x ty xs n nabla (cl:cls) = do -- The following line is where we call out to the inhabitationTest! - mb_nabla <- runMaybeT $ instCon 4 nabla x cl - tracePm "instantiate_cons" (vcat [ ppr x <+> dcolon <+> ppr (idType x) + mb_nabla <- runMaybeT $ instCon 4 nabla (eclassMatchId x nabla) cl + tracePm "instantiate_cons" (vcat [ ppr x <+> dcolon <+> ppr (eclassType x nabla) , ppr ty , ppr cl , ppr nabla @@ -2082,3 +2136,17 @@ Note that for -XEmptyCase, we don't want to emit a minimal cover. We arrange that by passing 'CaseSplitTopLevel' to 'generateInhabitingPatterns'. We detect the -XEmptyCase case in 'reportWarnings' by looking for 'ReportEmptyCase'. -} + +-- | Update the value of the analysis data of some e-class by its id. +updateVarInfo :: Functor f => ClassId -> (VarInfo -> f VarInfo) -> Nabla -> f Nabla +-- Update the data at class @xid@ using lenses and the monadic action @go@ +updateVarInfo xid f nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_facts=eg } } = (\eg' -> nabla{ nabla_tm_st = ts{ts_facts = eg'} }) <$> (_class xid . _data) f eg + +eclassMatchId :: HasCallStack => ClassId -> Nabla -> Id +eclassMatchId cid = vi_id . (^. _class cid . _data) . (ts_facts . nabla_tm_st) + +eclassType :: ClassId -> Nabla -> Type +eclassType cid = idType . eclassMatchId cid + + +-- ROMES:TODO: When exactly to rebuild? ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -1,3 +1,7 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} @@ -10,12 +14,12 @@ module GHC.HsToCore.Pmc.Solver.Types ( -- * Normalised refinement types - BotInfo(..), PmAltConApp(..), VarInfo(..), TmState(..), TyState(..), + BotInfo(..), PmAltConApp(..), VarInfo(..), TmState(..), TmEGraph, TyState(..), Nabla(..), Nablas(..), initNablas, lookupRefuts, lookupSolution, -- ** Looking up 'VarInfo' - lookupVarInfo, lookupVarInfoNT, trvVarInfo, + lookupVarInfo, lookupVarInfoNT, trvVarInfo, emptyVarInfo, representId, representIds, -- ** Caching residual COMPLETE sets CompleteMatch, ResidualCompleteMatches(..), getRcm, isRcmInitialised, @@ -42,10 +46,9 @@ import GHC.Prelude import GHC.Data.Bag import GHC.Data.FastString import GHC.Types.Id -import GHC.Types.Var.Set import GHC.Types.Unique.DSet -import GHC.Types.Unique.SDFM import GHC.Types.Name +import GHC.Core.Equality import GHC.Core.DataCon import GHC.Core.ConLike import GHC.Utils.Outputable @@ -58,7 +61,7 @@ import GHC.Core.TyCon import GHC.Types.Literal import GHC.Core import GHC.Core.TyCo.Compare( eqType ) -import GHC.Core.Map.Expr +import GHC.Core.Map.Type import GHC.Core.Utils (exprType) import GHC.Builtin.Names import GHC.Builtin.Types @@ -75,6 +78,17 @@ import Data.Ratio import GHC.Real (Ratio(..)) import qualified Data.Semigroup as Semi +import Data.Tuple (swap) +import Data.Traversable (mapAccumL) +import Data.Functor.Compose +import Data.Equality.Analysis (Analysis(..)) +import Data.Equality.Graph (EGraph, ClassId) +import Data.Equality.Graph.Lens +import qualified Data.Equality.Graph as EG +import Data.IntSet (IntSet) +import qualified Data.IntSet as IS (empty) +import Data.Bifunctor (second) + -- import GHC.Driver.Ppr -- @@ -131,21 +145,19 @@ instance Outputable TyState where initTyState :: TyState initTyState = TySt 0 emptyInert --- | The term oracle state. Stores 'VarInfo' for encountered 'Id's. These --- entries are possibly shared when we figure out that two variables must be --- equal, thus represent the same set of values. +-- | The term oracle state. Stores 'VarInfo' for encountered 'Id's and +-- 'CoreExpr's. These entries are possibly shared when we figure out that two +-- variables must be equal, thus represent the same set of values. -- -- See Note [TmState invariants] in "GHC.HsToCore.Pmc.Solver". data TmState = TmSt - { ts_facts :: !(UniqSDFM Id VarInfo) - -- ^ Facts about term variables. Deterministic env, so that we generate - -- deterministic error messages. - , ts_reps :: !(CoreMap Id) - -- ^ An environment for looking up whether we already encountered semantically - -- equivalent expressions that we want to represent by the same 'Id' - -- representative. - , ts_dirty :: !DIdSet + { ts_facts :: !TmEGraph + -- ^ Facts about terms. + + -- ROMES:TODO: ts_dirty looks a bit to me like the bookeeping needed to know + -- which nodes to upward merge, perhaps we can get rid of it too. + , ts_dirty :: !IntSet -- ^ Which 'VarInfo' needs to be checked for inhabitants because of new -- negative constraints (e.g. @x ≁ ⊥@ or @x ≁ K@). } @@ -161,6 +173,8 @@ data VarInfo { vi_id :: !Id -- ^ The 'Id' in question. Important for adding new constraints relative to -- this 'VarInfo' when we don't easily have the 'Id' available. + -- ROMES:TODO: What is the Id in question when we might have multiple Ids in the same equivalence class? + -- It seems currenlty this is the representative of the e-class, so we could probably drop it, in favour of Type or so (since sometimes we need to know the type, and that's also reasonable data for the e-class to have) , vi_pos :: ![PmAltConApp] -- ^ Positive info: 'PmAltCon' apps it is (i.e. @x ~ [Just y, PatSyn z]@), all @@ -168,7 +182,7 @@ data VarInfo -- pattern matches involving pattern synonym -- case x of { Just y -> case x of PatSyn z -> ... } -- However, no more than one RealDataCon in the list, otherwise contradiction - -- because of generativity. + -- because of generativity (which would violate Invariant 1 from the paper). , vi_neg :: !PmAltConSet -- ^ Negative info: A list of 'PmAltCon's that it cannot match. @@ -206,7 +220,7 @@ data PmAltConApp = PACA { paca_con :: !PmAltCon , paca_tvs :: ![TyVar] - , paca_ids :: ![Id] + , paca_ids :: ![ClassId] } -- | See 'vi_bot'. @@ -227,7 +241,7 @@ instance Outputable BotInfo where -- | Not user-facing. instance Outputable TmState where - ppr (TmSt state reps dirty) = ppr state $$ ppr reps $$ ppr dirty + ppr (TmSt _ dirty) = text "" $$ ppr dirty -- | Not user-facing. instance Outputable VarInfo where @@ -248,7 +262,7 @@ instance Outputable VarInfo where -- | Initial state of the term oracle. initTmState :: TmState -initTmState = TmSt emptyUSDFM emptyCoreMap emptyDVarSet +initTmState = TmSt EG.emptyEGraph IS.empty -- | A data type that caches for the 'VarInfo' of @x@ the results of querying -- 'dsGetCompleteMatches' and then striking out all occurrences of @K@ for @@ -300,9 +314,14 @@ emptyVarInfo x , vi_rcm = emptyRCM } -lookupVarInfo :: TmState -> Id -> VarInfo --- (lookupVarInfo tms x) tells what we know about 'x' -lookupVarInfo (TmSt env _ _) x = fromMaybe (emptyVarInfo x) (lookupUSDFM env x) +-- | @lookupVarInfo tms x@ tells what we know about 'x' +--- romes:TODO: This will have a different type. I don't know what yet. +-- romes:TODO I don't think this is what we want any longer, more like represent Id and see if it was previously represented by some data or not? +-- romes:TodO should return VarInfo rather than Maybe VarInfo +lookupVarInfo :: TmState -> ClassId -> VarInfo +lookupVarInfo (TmSt eg _) x +-- RM: Yea, I don't like the fact that currently all e-classes are created by Ids and have an Empty Var info, yet we must call "fromMaybe" here. Not good. + = eg ^._class x._data -- | Like @lookupVarInfo ts x@, but @lookupVarInfo ts x = (y, vi)@ also looks -- through newtype constructors. We have @x ~ N1 (... (Nk y))@ such that the @@ -314,27 +333,33 @@ lookupVarInfo (TmSt env _ _) x = fromMaybe (emptyVarInfo x) (lookupUSDFM env x) -- modulo type normalisation! -- -- See also Note [Coverage checking Newtype matches] in GHC.HsToCore.Pmc.Solver. -lookupVarInfoNT :: TmState -> Id -> (Id, VarInfo) +-- +-- RM: looks like we could get perhaps represent the newtypes in the e-graph instead and somehow simplify this? +lookupVarInfoNT :: TmState -> ClassId -> (ClassId, VarInfo) lookupVarInfoNT ts x = case lookupVarInfo ts x of VI{ vi_pos = as_newtype -> Just y } -> lookupVarInfoNT ts y - res -> (x, res) + res -> (x, res) where as_newtype = listToMaybe . mapMaybe go go PACA{paca_con = PmAltConLike (RealDataCon dc), paca_ids = [y]} | isNewDataCon dc = Just y go _ = Nothing -trvVarInfo :: Functor f => (VarInfo -> f (a, VarInfo)) -> Nabla -> Id -> f (a, Nabla) +-- romes: We could probably inline this +trvVarInfo :: forall f a. Functor f => (VarInfo -> f (a,VarInfo)) -> Nabla -> ClassId -> f (a,Nabla) trvVarInfo f nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts = env} } x - = set_vi <$> f (lookupVarInfo ts x) - where - set_vi (a, vi') = - (a, nabla{ nabla_tm_st = ts{ ts_facts = addToUSDFM env (vi_id vi') vi' } }) + = second (\g -> nabla{nabla_tm_st = ts{ts_facts=g}}) <$> updateAccum (_class x._data) f env + where + updateAccum :: forall f a s c. Functor f => Lens' s a -> (a -> f (c,a)) -> s -> f (c,s) + updateAccum lens g = getCompose . lens @(Compose f ((,) c)) (Compose . g) ------------------------------------------------ -- * Exported utility functions querying 'Nabla' -lookupRefuts :: Nabla -> Id -> [PmAltCon] +-- ROMES:TODO: Document +-- | Lookup the refutable patterns, i.e. the pattern alt cons that certainly can't happen?? +-- ROMES:TODO: ClassId? +lookupRefuts :: Nabla -> ClassId -> [PmAltCon] -- Unfortunately we need the extra bit of polymorphism and the unfortunate -- duplication of lookupVarInfo here. lookupRefuts MkNabla{ nabla_tm_st = ts } x = @@ -346,7 +371,7 @@ isDataConSolution _ = False -- @lookupSolution nabla x@ picks a single solution ('vi_pos') of @x@ from -- possibly many, preferring 'RealDataCon' solutions whenever possible. -lookupSolution :: Nabla -> Id -> Maybe PmAltConApp +lookupSolution :: Nabla -> ClassId -> Maybe PmAltConApp lookupSolution nabla x = case vi_pos (lookupVarInfo (nabla_tm_st nabla) x) of [] -> Nothing pos@(x:_) @@ -465,6 +490,7 @@ extendPmAltConSet (PACS cls lits) (PmAltConLike cl) extendPmAltConSet (PACS cls lits) (PmAltLit lit) = PACS cls (unionLists lits [lit]) +-- | The elements of a 'PmAltConSet' pmAltConSetElems :: PmAltConSet -> [PmAltCon] pmAltConSetElems (PACS cls lits) = map PmAltConLike (uniqDSetToList cls) ++ map PmAltLit lits @@ -789,7 +815,7 @@ instance Outputable PmLit where , (charPrimTy, primCharSuffix) , (floatPrimTy, primFloatSuffix) , (doublePrimTy, primDoubleSuffix) ] - suffix = fromMaybe empty (snd <$> find (eqType ty . fst) tbl) + suffix = maybe empty snd (find (eqType ty . fst) tbl) instance Outputable PmAltCon where ppr (PmAltConLike cl) = ppr cl @@ -797,3 +823,45 @@ instance Outputable PmAltCon where instance Outputable PmEquality where ppr = text . show + +-- +-- * E-graphs to represent normalised refinment types +-- + +type TmEGraph = EGraph VarInfo (DeBruijnF CoreExprF) + +representId :: Id -> Nabla -> (ClassId, Nabla) +-- Will need to justify this well +representId x (MkNabla tyst tmst at TmSt{ts_facts=eg0}) + = case EG.add (EG.Node (DF (deBruijnize (VarF x)))) eg0 of + (xid, eg1) -> (xid, MkNabla tyst tmst{ts_facts=eg1}) + +representIds :: [Id] -> Nabla -> ([ClassId], Nabla) +representIds xs nabla = swap $ mapAccumL (\acc x -> swap $ representId x acc) nabla xs + +-- | This instance is seriously wrong for general purpose, it's just required for instancing Analysis. +-- There ought to be a better way. +instance Eq VarInfo where + (==) _ _ = False +instance Analysis VarInfo (DeBruijnF CoreExprF) where + {-# INLINE makeA #-} + {-# INLINE joinA #-} + + -- When an e-class is created for a variable, we create an VarInfo from it. + -- It doesn't matter if this variable is bound or free, since it's the first + -- variable in this e-class (and all others would have to be equivalent to + -- it) + -- + -- Also, the Eq instance for DeBruijn Vars will ensure that two free + -- variables with the same Id are equal and so they will be represented in + -- the same e-class + makeA (DF (D _ (VarF x))) = emptyVarInfo x + makeA _ = emptyVarInfo unitDataConId -- ROMES:TODO: this is dummy information which should never be used, this is quite wrong :) + -- I think the reason we end up in this + -- situation is bc we first represent an expression and only then merge it with some Id. + -- we'd need a way to represent directly into an e-class then, to not trigger the new e-class. + + -- romes: so currently, variables are joined in 'addVarCt' manually by getting the old value of $x$ and assuming the value of $y$ was chosen. + -- That's obviously bad now, it'd be much more clearer to do it here. It's just the nabla threading that's more trouble + joinA _a b = b + ===================================== compiler/GHC/Types/Unique/SDFM.hs ===================================== @@ -82,6 +82,7 @@ lookupUSDFM usdfm x = snd (lookupReprAndEntryUSDFM usdfm x) -- >>> equateUSDFM [({u1,u3}, Just ele1)] u3 u4 == (Nothing, [({u1,u3,u4}, Just ele1)]) -- >>> equateUSDFM [({u1,u3}, Just ele1)] u4 u3 == (Nothing, [({u1,u3,u4}, Just ele1)]) -- >>> equateUSDFM [({u1,u3}, Just ele1), ({u2}, Just ele2)] u3 u2 == (Just ele1, [({u2,u1,u3}, Just ele2)]) +-- ROMES:TODO: Are all USDFM functions just for the PMC Nabla TM? equateUSDFM :: Uniquable key => UniqSDFM key ele -> key -> key -> (Maybe ele, UniqSDFM key ele) equateUSDFM usdfm@(USDFM env) x y = ===================================== compiler/ghc.cabal.in ===================================== @@ -88,6 +88,7 @@ Library array >= 0.1 && < 0.6, filepath >= 1 && < 1.5, template-haskell == 2.20.*, + hegg, hpc == 0.6.*, transformers >= 0.5 && < 0.7, exceptions == 0.10.*, @@ -299,6 +300,7 @@ Library GHC.Core.ConLike GHC.Core.DataCon GHC.Core.FamInstEnv + GHC.Core.Equality GHC.Core.FVs GHC.Core.InstEnv GHC.Core.Lint ===================================== hadrian/src/Packages.hs ===================================== @@ -6,7 +6,7 @@ module Packages ( compareSizes, compiler, containers, deepseq, deriveConstants, directory, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, - hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, + hegg, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, touchy, transformers, unlit, unix, win32, xhtml, @@ -37,8 +37,8 @@ ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps , compareSizes, compiler, containers, deepseq, deriveConstants, directory , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh - , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs - , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl + , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline + , hegg, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml , timeout @@ -53,7 +53,7 @@ isGhcPackage = (`elem` ghcPackages) array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, - ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, + ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hegg, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml, @@ -93,6 +93,7 @@ ghcPkg = util "ghc-pkg" ghcPrim = lib "ghc-prim" haddock = util "haddock" haskeline = lib "haskeline" +hegg = lib "hegg" hsc2hs = util "hsc2hs" hp2ps = util "hp2ps" hpc = lib "hpc" ===================================== hadrian/src/Rules/ToolArgs.hs ===================================== @@ -162,6 +162,7 @@ toolTargets = [ binary , ghci , ghcPkg -- # executable -- , haddock -- # depends on ghc library + , hegg , hsc2hs -- # executable , hpc , hpcBin -- # executable ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -89,6 +89,7 @@ stage0Packages = do , ghci , ghcPkg , haddock + , hegg , hsc2hs , hpc , hpcBin @@ -137,6 +138,7 @@ stage1Packages = do , ghcPkg , ghcPrim , haskeline + , hegg , hp2ps , hsc2hs , integerGmp ===================================== libraries/hegg ===================================== @@ -0,0 +1 @@ +Subproject commit d2862ab93d0420841aae3b8436f27301814d61a0 ===================================== packages ===================================== @@ -51,6 +51,7 @@ libraries/deepseq - - ssh://g libraries/directory - - ssh://git at github.com/haskell/directory.git libraries/filepath - - ssh://git at github.com/haskell/filepath.git libraries/haskeline - - https://github.com/judah/haskeline.git +libraries/hegg - - https://github.com/alt-romes/hegg.git libraries/hpc - - - libraries/mtl - - https://github.com/haskell/mtl.git libraries/parsec - - https://github.com/haskell/parsec.git View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fedc72828fa29a76215c927c01ea602a851cc1e0...bcf8fd4882d86ddd6884d607ea4dc169a395ea99 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fedc72828fa29a76215c927c01ea602a851cc1e0...bcf8fd4882d86ddd6884d607ea4dc169a395ea99 You're receiving 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 Jun 28 19:18:33 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 28 Jun 2023 15:18:33 -0400 Subject: [Git][ghc/ghc][wip/tracing-rework] 13 commits: Propagate breakpoint information when inlining across modules Message-ID: <649c8789b48cc_3b5ae2d51d4f43391e9@gitlab.mail> Ben Gamari pushed to branch wip/tracing-rework at Glasgow Haskell Compiler / GHC Commits: c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 3b8a3313 by Ben Gamari at 2023-06-28T15:17:45-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - f4353b7d by Ben Gamari at 2023-06-28T15:18:10-04:00 rts: Various warnings fixes - - - - - eb000765 by GHC GitLab CI at 2023-06-28T15:18:18-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - 30 changed files: - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/HsToCore/Breakpoints.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Stg/BcPrep.hs - compiler/GHC/Stg/FVs.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d27038050d2955a166b3f9e36a7484015ef08568...eb000765c3016b574df63cc5b80480c48f55ffa9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d27038050d2955a166b3f9e36a7484015ef08568...eb000765c3016b574df63cc5b80480c48f55ffa9 You're receiving 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 Jun 28 19:20:45 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 28 Jun 2023 15:20:45 -0400 Subject: [Git][ghc/ghc][wip/T23568] 11 commits: Propagate breakpoint information when inlining across modules Message-ID: <649c880d7c779_3b5ae2de6703c3393d9@gitlab.mail> Ben Gamari pushed to branch wip/T23568 at Glasgow Haskell Compiler / GHC Commits: c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - e58456da by Ben Gamari at 2023-06-28T15:19:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - 30 changed files: - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/HsToCore/Breakpoints.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/Stg/BcPrep.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/35710a3262ab307e4ceb84403c389132ec71a4bf...e58456dae1dd2875c239ee62d50e789fce2468d4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/35710a3262ab307e4ceb84403c389132ec71a4bf...e58456dae1dd2875c239ee62d50e789fce2468d4 You're receiving 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 Jun 28 19:35:17 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Wed, 28 Jun 2023 15:35:17 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/23573 Message-ID: <649c8b75d335a_3b5ae2e2af61c3397db@gitlab.mail> Matthew Pickering pushed new branch wip/23573 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/23573 You're receiving 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 Jun 28 19:48:03 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Wed, 28 Jun 2023 15:48:03 -0400 Subject: [Git][ghc/ghc][wip/az/epa-simpler-comb2] 11 commits: Propagate breakpoint information when inlining across modules Message-ID: <649c8e735b4b0_3b5ae2d51d4f434217d@gitlab.mail> Alan Zimmerman pushed to branch wip/az/epa-simpler-comb2 at Glasgow Haskell Compiler / GHC Commits: c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 87ef924b by Alan Zimmerman at 2023-06-28T19:22:14+01:00 EPA: Simplify GHC/Parser.y comb2 Use the HasLoc instance from Ast.hs to allow comb2 to work with anything with a SrcSpan This gets rid of the custom comb2A, comb2Al, comb2N functions, and removes various reLoc calls. - - - - - 30 changed files: - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/HsToCore/Breakpoints.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Runtime/Eval.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d2a6dcd78716e0a2ea5c8054238862143254602c...87ef924b96ec5871f01cd4db55ea90e569a898d1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d2a6dcd78716e0a2ea5c8054238862143254602c...87ef924b96ec5871f01cd4db55ea90e569a898d1 You're receiving 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 Jun 28 20:00:01 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Wed, 28 Jun 2023 16:00:01 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/az/epa-simpler-comb3 Message-ID: <649c914143ef5_3b5ae2dc743103443d8@gitlab.mail> Alan Zimmerman pushed new branch wip/az/epa-simpler-comb3 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/az/epa-simpler-comb3 You're receiving 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 Jun 28 20:00:53 2023 From: gitlab at gitlab.haskell.org (Alan Zimmerman (@alanz)) Date: Wed, 28 Jun 2023 16:00:53 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/az/epa-simpler-sll Message-ID: <649c9175c46d2_3b5ae2d51d4f43445d7@gitlab.mail> Alan Zimmerman pushed new branch wip/az/epa-simpler-sll at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/az/epa-simpler-sll You're receiving 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 Jun 28 20:10:42 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 28 Jun 2023 16:10:42 -0400 Subject: [Git][ghc/ghc][wip/T23568] Define FFI_GO_CLOSURES Message-ID: <649c93c229056_3b5ae2debacb43502b@gitlab.mail> Ben Gamari pushed to branch wip/T23568 at Glasgow Haskell Compiler / GHC Commits: cbe8a3b4 by Ben Gamari at 2023-06-28T16:10:34-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - 7 changed files: - compiler/GHC/Driver/CodeOutput.hs - libraries/ghci/GHCi/FFI.hsc - rts/Interpreter.c - rts/adjustor/LibffiAdjustor.c - + rts/include/rts/ghc_ffi.h - rts/rts.cabal.in - rts/sm/Storage.c Changes: ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -295,7 +295,7 @@ outputForeignStubs logger tmpfs dflags unit_state mod location stubs -- wrapper code mentions the ffi_arg type, which comes from ffi.h ffi_includes - | platformMisc_libFFI $ platformMisc dflags = "#include \n" + | platformMisc_libFFI $ platformMisc dflags = "#include \"rts/ghc_ffi.h\"\n" | otherwise = "" stub_h_file_exists ===================================== libraries/ghci/GHCi/FFI.hsc ===================================== @@ -22,6 +22,14 @@ -} #if !defined(javascript_HOST_ARCH) +-- See Note [FFI_GO_CLOSURES workaround] in ghc_ffi.h +-- We can't include ghc_ffi.h here as we must build with stage0 +#if darwin_HOST_OS +#if !defined(FFI_GO_CLOSURES) +#define FFI_GO_CLOSURES 0 +#endif +#endif + #include #endif ===================================== rts/Interpreter.c ===================================== @@ -39,7 +39,7 @@ #endif #endif -#include "ffi.h" +#include "rts/ghc_ffi.h" /* -------------------------------------------------------------------------- * The bytecode interpreter ===================================== rts/adjustor/LibffiAdjustor.c ===================================== @@ -11,7 +11,7 @@ #include "Hash.h" #include "Adjustor.h" -#include "ffi.h" +#include "rts/ghc_ffi.h" #include // Note that ffi_alloc_prep_closure is a non-standard libffi closure ===================================== rts/include/rts/ghc_ffi.h ===================================== @@ -0,0 +1,28 @@ +/* + * wrapper working around #23586. + * + * (c) The University of Glasgow 2023 + * + */ + +#pragma once + +/* + * Note [FFI_GO_CLOSURES workaround] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * Apple ships a broken libffi with Xcode which lacks a definition of + * FFI_GO_CLOSURES despite having references to said macro. Work around this + * for now to avoid -Wundef warnings. + * + * We choose the value zero here by following the model of OpenJDK. + * See https://github.com/openjdk/jdk17u-dev/pull/741/files. + * + * See #23568. + */ +#if darwin_HOST_OS +#if !defined(FFI_GO_CLOSURES) +#define FFI_GO_CLOSURES 0 +#endif +#endif + +#include "ffi.h" ===================================== rts/rts.cabal.in ===================================== @@ -237,6 +237,7 @@ library rts/EventLogConstants.h rts/EventTypes.h -- ^ generated + rts/ghc_ffi.h rts/Adjustor.h rts/ExecPage.h rts/BlockSignals.h ===================================== rts/sm/Storage.c ===================================== @@ -53,7 +53,7 @@ #include -#include "ffi.h" +#include "rts/ghc_ffi.h" /* * All these globals require sm_mutex to access in THREADED_RTS mode. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cbe8a3b46303174d6b0da3e19a83b471b5242530 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cbe8a3b46303174d6b0da3e19a83b471b5242530 You're receiving 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 Jun 28 20:10:58 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 28 Jun 2023 16:10:58 -0400 Subject: [Git][ghc/ghc][wip/tracing-rework] hadrian: Ignore warnings in unix and semaphore-compat Message-ID: <649c93d2aea91_3b5ae2e2af694350891@gitlab.mail> Ben Gamari pushed to branch wip/tracing-rework at Glasgow Haskell Compiler / GHC Commits: 45d0d4ef by Ben Gamari at 2023-06-28T16:10:51-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - 1 changed file: - hadrian/src/Flavour.hs Changes: ===================================== hadrian/src/Flavour.hs ===================================== @@ -128,9 +128,13 @@ werror = ? notStage0 ? mconcat [ arg "-Werror" - , flag CrossCompiling - ? package unix + -- unix has many unused imports + , package unix ? mconcat [arg "-Wwarn=unused-imports", arg "-Wwarn=unused-top-binds"] + -- semaphore-compat relies on sem_getvalue as provided by unix, which is + -- not implemented on Darwin and therefore throws a deprecation warning + , package semaphoreCompat + ? mconcat [arg "-Wwarn=deprecations"] ] , builder Ghc ? package rts View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/45d0d4efd21a63bdf884e406a3e275b9a2bf6070 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/45d0d4efd21a63bdf884e406a3e275b9a2bf6070 You're receiving 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 Jun 28 20:41:47 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Wed, 28 Jun 2023 16:41:47 -0400 Subject: [Git][ghc/ghc][wip/romes/eqsat-pmc] Add instances for debugging Message-ID: <649c9b0b6f9a1_3b5ae2e2af69435361d@gitlab.mail> Rodrigo Mesquita pushed to branch wip/romes/eqsat-pmc at Glasgow Haskell Compiler / GHC Commits: ff5cc98a by Rodrigo Mesquita at 2023-06-28T21:41:39+01:00 Add instances for debugging - - - - - 2 changed files: - compiler/GHC/Core/Equality.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs Changes: ===================================== compiler/GHC/Core/Equality.hs ===================================== @@ -26,7 +26,7 @@ import qualified Data.Equality.Graph.Monad as EGM import Data.Equality.Utils (Fix(..)) import GHC.Utils.Misc (all2) -import GHC.Utils.Outputable (showPprUnsafe) +import GHC.Utils.Outputable import GHC.Core.Coercion (coercionType) -- Important to note the binders are also represented by $a$ @@ -343,16 +343,37 @@ cmpDeBruijnTickish (D env1 t1) (D env2 t2) = go t1 t2 where GT -> GT go l r = compare l r --- ROMES:TODO: DEBRUIJN ORDERING ON TYPES!!! cmpDeBruijnType :: DeBruijn Type -> DeBruijn Type -> Ordering cmpDeBruijnType d1@(D _ t1) d2@(D _ t2) = if eqDeBruijnType d1 d2 then EQ + -- ROMES:TODO: Is this OK? else compare (showPprUnsafe t1) (showPprUnsafe t2) - --- ROMES:TODO: DEBRUIJN ORDERING ON COERCIONS!!! cmpDeBruijnCoercion :: DeBruijn Coercion -> DeBruijn Coercion -> Ordering cmpDeBruijnCoercion (D env1 co1) (D env2 co2) = cmpDeBruijnType (D env1 (coercionType co1)) (D env2 (coercionType co2)) +-- instances for debugging purposes +instance Show a => Show (DeBruijnF CoreExprF a) where + show (DF (D _ (VarF id) )) = showPprUnsafe $ text "VarF" <+> ppr id + show (DF (D _ (LitF lit))) = showPprUnsafe $ text "LitF" <+> ppr lit + show (DF (D _ (AppF a b))) = "AppF " ++ show a ++ " " ++ show b + show (DF (D _ (LamF b a))) = showPprUnsafe (text "LamF" <+> ppr b <+> text "") ++ show a + show (DF (D _ (LetF b a))) = "LetF " ++ show b ++ " " ++ show a + show (DF (D _ (CaseF a b t alts))) = "CaseF " ++ show a ++ showPprUnsafe (ppr b <+> ppr t) ++ show alts + + show (DF (D _ (CastF a cor) )) = "CastF" + show (DF (D _ (TickF cotick a))) = "Tick" + show (DF (D _ (TypeF t) )) = "TypeF " ++ showPprUnsafe (ppr t) + show (DF (D _ (CoercionF co) )) = "CoercionF " ++ showPprUnsafe co + + +instance Show a => Show (BindF CoreBndr a) where + show (NonRecF b a) = "NonRecF " ++ showPprUnsafe b ++ show a + show (RecF bs) = "RecF " ++ unwords (map (\(a,b) -> showPprUnsafe a ++ show b) bs) + +instance Show a => Show (AltF CoreBndr a) where + show (AltF alt bs a) = "AltF " ++ showPprUnsafe (ppr alt <+> ppr bs) ++ show a + + ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -6,6 +6,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE MultiWayIf #-} +{-# OPTIONS_GHC -Wno-orphans #-} -- | Domain types used in "GHC.HsToCore.Pmc.Solver". -- The ultimate goal is to define 'Nabla', which models normalised refinement @@ -241,7 +242,7 @@ instance Outputable BotInfo where -- | Not user-facing. instance Outputable TmState where - ppr (TmSt _ dirty) = text "" $$ ppr dirty + ppr (TmSt eg dirty) = text (show eg) $$ ppr dirty -- | Not user-facing. instance Outputable VarInfo where @@ -829,6 +830,9 @@ instance Outputable PmEquality where -- type TmEGraph = EGraph VarInfo (DeBruijnF CoreExprF) +-- TODO delete orphans for showing TmEGraph for debugging reasons +instance Show VarInfo where + show = showPprUnsafe . ppr representId :: Id -> Nabla -> (ClassId, Nabla) -- Will need to justify this well @@ -842,7 +846,7 @@ representIds xs nabla = swap $ mapAccumL (\acc x -> swap $ representId x acc) na -- | This instance is seriously wrong for general purpose, it's just required for instancing Analysis. -- There ought to be a better way. instance Eq VarInfo where - (==) _ _ = False + (==) a b = vi_id a == vi_id b instance Analysis VarInfo (DeBruijnF CoreExprF) where {-# INLINE makeA #-} {-# INLINE joinA #-} @@ -865,3 +869,4 @@ instance Analysis VarInfo (DeBruijnF CoreExprF) where -- That's obviously bad now, it'd be much more clearer to do it here. It's just the nabla threading that's more trouble joinA _a b = b + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ff5cc98af2a50e16f9b8c4e40ea3f98abb448e29 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ff5cc98af2a50e16f9b8c4e40ea3f98abb448e29 You're receiving 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 Jun 28 21:46:33 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Wed, 28 Jun 2023 17:46:33 -0400 Subject: [Git][ghc/ghc][wip/simplifier-tweaks] Remove trace Message-ID: <649caa39dd7cf_3b5ae2e2af6a8372367@gitlab.mail> Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC Commits: f737fa77 by Simon Peyton Jones at 2023-06-28T22:46:14+01:00 Remove trace - - - - - 1 changed file: - compiler/GHC/Core/Opt/Simplify/Iteration.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -3685,7 +3685,7 @@ mkDupableContWithDmds env _ | isNothing (isDataConId_maybe (ai_fun fun)) , thumbsUpPlanA cont -- See point (3) of Note [Duplicating join points] = -- Use Plan A of Note [Duplicating StrictArg] - pprTrace "Using plan A" (ppr (ai_fun fun) $$ text "args" <+> ppr (ai_args fun) $$ text "cont" <+> ppr cont) $ +-- pprTrace "Using plan A" (ppr (ai_fun fun) $$ text "args" <+> ppr (ai_args fun) $$ text "cont" <+> ppr cont) $ do { let (_ : dmds) = ai_dmds fun ; (floats1, cont') <- mkDupableContWithDmds env dmds cont -- Use the demands from the function to add the right View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f737fa772c9b6ac2996eec08bd523473c9737dfa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f737fa772c9b6ac2996eec08bd523473c9737dfa You're receiving 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 Jun 28 22:07:22 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 28 Jun 2023 18:07:22 -0400 Subject: [Git][ghc/ghc][wip/testsuite-output-patch] 39 commits: IPE data compression Message-ID: <649caf1a75680_3b5ae2e2af69437994d@gitlab.mail> Ben Gamari pushed to branch wip/testsuite-output-patch at Glasgow Haskell Compiler / GHC Commits: cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - cd3a247c by Ben Gamari at 2023-06-28T18:07:17-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 52611286 by Ben Gamari at 2023-06-28T18:07:17-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 24 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/889d89d1dab3095055502dd225a4d9060abe37ce...52611286f229cac744eb12d5dc122ad0c92fb724 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/889d89d1dab3095055502dd225a4d9060abe37ce...52611286f229cac744eb12d5dc122ad0c92fb724 You're receiving 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 Jun 28 23:08:42 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 28 Jun 2023 19:08:42 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/refactor-gen-ci Message-ID: <649cbd7a6d6a2_3b5ae2e2af694384176@gitlab.mail> Ben Gamari pushed new branch wip/refactor-gen-ci at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/refactor-gen-ci You're receiving 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 Jun 28 23:09:34 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 28 Jun 2023 19:09:34 -0400 Subject: [Git][ghc/ghc][wip/refactor-gen-ci] gitlab-ci: Refactor compilation of gen_ci Message-ID: <649cbdae9794d_3b5ae2da244e83843f3@gitlab.mail> Ben Gamari pushed to branch wip/refactor-gen-ci at Glasgow Haskell Compiler / GHC Commits: b373e7af by Ben Gamari at 2023-06-28T19:09:00-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 9 changed files: - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mk - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/update-ci - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs Changes: ===================================== .gitlab/generate-ci/LICENSE ===================================== @@ -0,0 +1,30 @@ +Copyright (c) 2023, The GHC Developers + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of The GHC Developers nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ===================================== .gitlab/generate-ci/README.mk ===================================== @@ -0,0 +1,25 @@ +# generate-ci + +This is the generator for GHC's GitLab CI infrastructure. In particular, this +generates `.gitlab/jobs.yaml`, which is a YAML (or, strictly speaking, JSON) +file which defines the bulk of the validation, nightly, and release jobs of +GHC's CI. + +## Modifying the CI configuration (nix) + +The jobs are defined in `gen_ci.hs`. After modifying this you can run +```sh +nix run .#update-ci +``` +to update the generated configuration. + + +## Modifying the CI configuration (without nix) + +One can run `update-ci` without Nix as follows (assuming one has `jq`, +`cabal-install`, and GHC installed): +```sh +$ cabal build generate-ci +$ PATH="$(dirname $(cabal list-bin generate-ci)):$PATH" +$ ./update-ci +``` ===================================== .gitlab/generate-ci/flake.lock ===================================== @@ -0,0 +1,59 @@ +{ + "nodes": { + "flake-utils": { + "inputs": { + "systems": "systems" + }, + "locked": { + "lastModified": 1687709756, + "narHash": "sha256-Y5wKlQSkgEK2weWdOu4J3riRd+kV/VCgHsqLNTTWQ/0=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "dbabf0ca0c0c4bce6ea5eaf65af5cb694d2082c7", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "nixpkgs": { + "locked": { + "lastModified": 1687886075, + "narHash": "sha256-PeayJDDDy+uw1Ats4moZnRdL1OFuZm1Tj+KiHlD67+o=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "a565059a348422af5af9026b5174dc5c0dcefdae", + "type": "github" + }, + "original": { + "id": "nixpkgs", + "type": "indirect" + } + }, + "root": { + "inputs": { + "flake-utils": "flake-utils", + "nixpkgs": "nixpkgs" + } + }, + "systems": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } + } + }, + "root": "root", + "version": 7 +} ===================================== .gitlab/generate-ci/flake.nix ===================================== @@ -0,0 +1,33 @@ +{ + description = "GHC CI Generator"; + + inputs.flake-utils.url = "github:numtide/flake-utils"; + + outputs = { self, nixpkgs, flake-utils }: + flake-utils.lib.eachDefaultSystem (system: + let pkgs = nixpkgs.legacyPackages.${system}; in + { + packages = rec { + update-ci = pkgs.runCommand "update-ci" { + nativeBuildInputs = with pkgs; [ makeWrapper ]; + } '' + mkdir -p $out/bin + makeWrapper ${./update-ci} $out/bin/update-ci \ + --prefix PATH : ${with pkgs; lib.makeBinPath [ generate-ci jq ]} + ''; + + generate-ci = pkgs.haskellPackages.callCabal2nix "generate-ci" ./. {}; + + default = update-ci; + }; + + apps = rec { + update-ci = flake-utils.lib.mkApp { + drv = self.packages.${system}.update-ci; + }; + + default = update-ci; + }; + } + ); +} ===================================== .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs ===================================== @@ -3,9 +3,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{- cabal: -build-depends: base, aeson >= 1.8.1, containers, bytestring --} import Data.Aeson as A import qualified Data.Map as Map ===================================== .gitlab/generate-ci/generate-ci.cabal ===================================== @@ -0,0 +1,15 @@ +cabal-version: 3.0 +name: generate-ci +version: 0.1.0.0 +license: BSD-3-Clause +license-file: LICENSE +build-type: Simple + +executable generate-ci + main-is: gen_ci.hs + ghc-options: -Wall + build-depends: base, + containers, + bytestring, + aeson >= 1.8.1 + default-language: Haskell2010 ===================================== .gitlab/generate-ci/update-ci ===================================== @@ -0,0 +1,16 @@ +#!/usr/bin/env bash + +out_dir="./.gitlab" + +# Update job metadata for ghcup +generate-ci metadata "$out_dir/jobs-metadata.json" +echo "Updated $out_dir/jobs-metadata.json" + +# Update CI jobs +tmp="$(mktemp)" +generate-ci gitlab "$tmp" +rm -f "$out_dir/jobs.yaml" +echo "### THIS IS A GENERATED FILE, DO NOT MODIFY DIRECTLY" > "$out_dir/jobs.yaml" +cat "$tmp" | jq >> "$out_dir/jobs.yaml" +rm "$tmp" +echo "Updated $out_dir/jobs.yaml" ===================================== .gitlab/generate_job_metadata deleted ===================================== @@ -1,5 +0,0 @@ -#! /usr/bin/env nix-shell -#!nix-shell -i bash -p cabal-install "haskell.packages.ghc92.ghcWithPackages (pkgs: with pkgs; [aeson])" git jq - -cd "$(dirname "${BASH_SOURCE[0]}")" -cabal run gen_ci -- metadata jobs-metadata.json ===================================== .gitlab/generate_jobs deleted ===================================== @@ -1,13 +0,0 @@ -#!/usr/bin/env nix-shell -#!nix-shell -i bash -p cabal-install "haskell.packages.ghc92.ghcWithPackages (pkgs: with pkgs; [aeson])" git jq - -# shellcheck shell=bash - -set -euo pipefail - -cd "$(dirname "${BASH_SOURCE[0]}")" -tmp=$(mktemp) -cabal run gen_ci -- gitlab $tmp -rm -f jobs.yaml -echo "### THIS IS A GENERATED FILE, DO NOT MODIFY DIRECTLY" > jobs.yaml -cat $tmp | jq | tee -a jobs.yaml View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b373e7af3de8dddb8b03acda1f35f2fb1523ebfc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b373e7af3de8dddb8b03acda1f35f2fb1523ebfc You're receiving 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 Jun 28 23:11:21 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 28 Jun 2023 19:11:21 -0400 Subject: [Git][ghc/ghc][wip/refactor-gen-ci] gitlab-ci: Refactor compilation of gen_ci Message-ID: <649cbe191f128_3b5ae21282de1438943c@gitlab.mail> Ben Gamari pushed to branch wip/refactor-gen-ci at Glasgow Haskell Compiler / GHC Commits: 91c5f946 by Ben Gamari at 2023-06-28T19:11:13-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 9 changed files: - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mk - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/update-ci - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs Changes: ===================================== .gitlab/generate-ci/LICENSE ===================================== @@ -0,0 +1,30 @@ +Copyright (c) 2023, The GHC Developers + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of The GHC Developers nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ===================================== .gitlab/generate-ci/README.mk ===================================== @@ -0,0 +1,26 @@ +# generate-ci + +This is the generator for GHC's GitLab CI infrastructure. In particular, this +generates `.gitlab/jobs.yaml`, which is a YAML (or, strictly speaking, JSON) +file which defines the bulk of the validation, nightly, and release jobs of +GHC's CI. + + +## Modifying the CI configuration (nix) + +The jobs are defined in `gen_ci.hs`. After modifying this you can run +```sh +nix run .#update-ci +``` +from the root of the GHC repository to update the generated configuration. + + +## Modifying the CI configuration (without nix) + +One can run `update-ci` without Nix as follows (assuming one has `jq`, +`cabal-install`, and GHC installed): +```sh +$ cabal build generate-ci +$ PATH="$(dirname $(cabal list-bin generate-ci)):$PATH" +$ ./update-ci +``` ===================================== .gitlab/generate-ci/flake.lock ===================================== @@ -0,0 +1,59 @@ +{ + "nodes": { + "flake-utils": { + "inputs": { + "systems": "systems" + }, + "locked": { + "lastModified": 1687709756, + "narHash": "sha256-Y5wKlQSkgEK2weWdOu4J3riRd+kV/VCgHsqLNTTWQ/0=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "dbabf0ca0c0c4bce6ea5eaf65af5cb694d2082c7", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "nixpkgs": { + "locked": { + "lastModified": 1687886075, + "narHash": "sha256-PeayJDDDy+uw1Ats4moZnRdL1OFuZm1Tj+KiHlD67+o=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "a565059a348422af5af9026b5174dc5c0dcefdae", + "type": "github" + }, + "original": { + "id": "nixpkgs", + "type": "indirect" + } + }, + "root": { + "inputs": { + "flake-utils": "flake-utils", + "nixpkgs": "nixpkgs" + } + }, + "systems": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } + } + }, + "root": "root", + "version": 7 +} ===================================== .gitlab/generate-ci/flake.nix ===================================== @@ -0,0 +1,33 @@ +{ + description = "GHC CI Generator"; + + inputs.flake-utils.url = "github:numtide/flake-utils"; + + outputs = { self, nixpkgs, flake-utils }: + flake-utils.lib.eachDefaultSystem (system: + let pkgs = nixpkgs.legacyPackages.${system}; in + { + packages = rec { + update-ci = pkgs.runCommand "update-ci" { + nativeBuildInputs = with pkgs; [ makeWrapper ]; + } '' + mkdir -p $out/bin + makeWrapper ${./update-ci} $out/bin/update-ci \ + --prefix PATH : ${with pkgs; lib.makeBinPath [ generate-ci jq ]} + ''; + + generate-ci = pkgs.haskellPackages.callCabal2nix "generate-ci" ./. {}; + + default = update-ci; + }; + + apps = rec { + update-ci = flake-utils.lib.mkApp { + drv = self.packages.${system}.update-ci; + }; + + default = update-ci; + }; + } + ); +} ===================================== .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs ===================================== @@ -3,9 +3,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{- cabal: -build-depends: base, aeson >= 1.8.1, containers, bytestring --} import Data.Aeson as A import qualified Data.Map as Map ===================================== .gitlab/generate-ci/generate-ci.cabal ===================================== @@ -0,0 +1,15 @@ +cabal-version: 3.0 +name: generate-ci +version: 0.1.0.0 +license: BSD-3-Clause +license-file: LICENSE +build-type: Simple + +executable generate-ci + main-is: gen_ci.hs + ghc-options: -Wall + build-depends: base, + containers, + bytestring, + aeson >= 1.8.1 + default-language: Haskell2010 ===================================== .gitlab/generate-ci/update-ci ===================================== @@ -0,0 +1,16 @@ +#!/usr/bin/env bash + +out_dir="./.gitlab" + +# Update job metadata for ghcup +generate-ci metadata "$out_dir/jobs-metadata.json" +echo "Updated $out_dir/jobs-metadata.json" + +# Update CI jobs +tmp="$(mktemp)" +generate-ci gitlab "$tmp" +rm -f "$out_dir/jobs.yaml" +echo "### THIS IS A GENERATED FILE, DO NOT MODIFY DIRECTLY" > "$out_dir/jobs.yaml" +cat "$tmp" | jq >> "$out_dir/jobs.yaml" +rm "$tmp" +echo "Updated $out_dir/jobs.yaml" ===================================== .gitlab/generate_job_metadata deleted ===================================== @@ -1,5 +0,0 @@ -#! /usr/bin/env nix-shell -#!nix-shell -i bash -p cabal-install "haskell.packages.ghc92.ghcWithPackages (pkgs: with pkgs; [aeson])" git jq - -cd "$(dirname "${BASH_SOURCE[0]}")" -cabal run gen_ci -- metadata jobs-metadata.json ===================================== .gitlab/generate_jobs deleted ===================================== @@ -1,13 +0,0 @@ -#!/usr/bin/env nix-shell -#!nix-shell -i bash -p cabal-install "haskell.packages.ghc92.ghcWithPackages (pkgs: with pkgs; [aeson])" git jq - -# shellcheck shell=bash - -set -euo pipefail - -cd "$(dirname "${BASH_SOURCE[0]}")" -tmp=$(mktemp) -cabal run gen_ci -- gitlab $tmp -rm -f jobs.yaml -echo "### THIS IS A GENERATED FILE, DO NOT MODIFY DIRECTLY" > jobs.yaml -cat $tmp | jq | tee -a jobs.yaml View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/91c5f946d59be5b4cc879da8f7e770e39afec0e0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/91c5f946d59be5b4cc879da8f7e770e39afec0e0 You're receiving 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 Jun 28 23:15:03 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 28 Jun 2023 19:15:03 -0400 Subject: [Git][ghc/ghc][wip/refactor-gen-ci] gitlab-ci: Refactor compilation of gen_ci Message-ID: <649cbef7efee0_3b5ae2e2af694390193@gitlab.mail> Ben Gamari pushed to branch wip/refactor-gen-ci at Glasgow Haskell Compiler / GHC Commits: c28098cc by Ben Gamari at 2023-06-28T19:14:57-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 9 changed files: - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/update-ci - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs Changes: ===================================== .gitlab/generate-ci/LICENSE ===================================== @@ -0,0 +1,30 @@ +Copyright (c) 2023, The GHC Developers + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of The GHC Developers nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ===================================== .gitlab/generate-ci/README.mkd ===================================== @@ -0,0 +1,26 @@ +# generate-ci + +This is the generator for GHC's GitLab CI infrastructure. In particular, this +generates `.gitlab/jobs.yaml`, which is a YAML (or, strictly speaking, JSON) +file which defines the bulk of the validation, nightly, and release jobs of +GHC's CI. + + +## Modifying the CI configuration (nix) + +The jobs are defined in `gen_ci.hs`. After modifying this you can run +```sh +nix run ./.gitlab/generate-ci#update-ci +``` +from anywhere in the GHC repository to update the generated configuration. + + +## Modifying the CI configuration (without nix) + +One can run `update-ci` without Nix as follows (assuming one has `jq`, +`cabal-install`, and GHC installed): +```sh +$ cabal build generate-ci +$ PATH="$(dirname $(cabal list-bin generate-ci)):$PATH" +$ ./update-ci +``` ===================================== .gitlab/generate-ci/flake.lock ===================================== @@ -0,0 +1,59 @@ +{ + "nodes": { + "flake-utils": { + "inputs": { + "systems": "systems" + }, + "locked": { + "lastModified": 1687709756, + "narHash": "sha256-Y5wKlQSkgEK2weWdOu4J3riRd+kV/VCgHsqLNTTWQ/0=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "dbabf0ca0c0c4bce6ea5eaf65af5cb694d2082c7", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "nixpkgs": { + "locked": { + "lastModified": 1687886075, + "narHash": "sha256-PeayJDDDy+uw1Ats4moZnRdL1OFuZm1Tj+KiHlD67+o=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "a565059a348422af5af9026b5174dc5c0dcefdae", + "type": "github" + }, + "original": { + "id": "nixpkgs", + "type": "indirect" + } + }, + "root": { + "inputs": { + "flake-utils": "flake-utils", + "nixpkgs": "nixpkgs" + } + }, + "systems": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } + } + }, + "root": "root", + "version": 7 +} ===================================== .gitlab/generate-ci/flake.nix ===================================== @@ -0,0 +1,33 @@ +{ + description = "GHC CI Generator"; + + inputs.flake-utils.url = "github:numtide/flake-utils"; + + outputs = { self, nixpkgs, flake-utils }: + flake-utils.lib.eachDefaultSystem (system: + let pkgs = nixpkgs.legacyPackages.${system}; in + { + packages = rec { + update-ci = pkgs.runCommand "update-ci" { + nativeBuildInputs = with pkgs; [ makeWrapper ]; + } '' + mkdir -p $out/bin + makeWrapper ${./update-ci} $out/bin/update-ci \ + --prefix PATH : ${with pkgs; lib.makeBinPath [ generate-ci jq gitMinimal ]} + ''; + + generate-ci = pkgs.haskellPackages.callCabal2nix "generate-ci" ./. {}; + + default = update-ci; + }; + + apps = rec { + update-ci = flake-utils.lib.mkApp { + drv = self.packages.${system}.update-ci; + }; + + default = update-ci; + }; + } + ); +} ===================================== .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs ===================================== @@ -3,9 +3,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{- cabal: -build-depends: base, aeson >= 1.8.1, containers, bytestring --} import Data.Aeson as A import qualified Data.Map as Map ===================================== .gitlab/generate-ci/generate-ci.cabal ===================================== @@ -0,0 +1,15 @@ +cabal-version: 3.0 +name: generate-ci +version: 0.1.0.0 +license: BSD-3-Clause +license-file: LICENSE +build-type: Simple + +executable generate-ci + main-is: gen_ci.hs + ghc-options: -Wall + build-depends: base, + containers, + bytestring, + aeson >= 1.8.1 + default-language: Haskell2010 ===================================== .gitlab/generate-ci/update-ci ===================================== @@ -0,0 +1,16 @@ +#!/usr/bin/env bash + +out_dir="$(git rev-parse --show-toplevel)/.gitlab" + +# Update job metadata for ghcup +generate-ci metadata "$out_dir/jobs-metadata.json" +echo "Updated $out_dir/jobs-metadata.json" + +# Update CI jobs +tmp="$(mktemp)" +generate-ci gitlab "$tmp" +rm -f "$out_dir/jobs.yaml" +echo "### THIS IS A GENERATED FILE, DO NOT MODIFY DIRECTLY" > "$out_dir/jobs.yaml" +cat "$tmp" | jq >> "$out_dir/jobs.yaml" +rm "$tmp" +echo "Updated $out_dir/jobs.yaml" ===================================== .gitlab/generate_job_metadata deleted ===================================== @@ -1,5 +0,0 @@ -#! /usr/bin/env nix-shell -#!nix-shell -i bash -p cabal-install "haskell.packages.ghc92.ghcWithPackages (pkgs: with pkgs; [aeson])" git jq - -cd "$(dirname "${BASH_SOURCE[0]}")" -cabal run gen_ci -- metadata jobs-metadata.json ===================================== .gitlab/generate_jobs deleted ===================================== @@ -1,13 +0,0 @@ -#!/usr/bin/env nix-shell -#!nix-shell -i bash -p cabal-install "haskell.packages.ghc92.ghcWithPackages (pkgs: with pkgs; [aeson])" git jq - -# shellcheck shell=bash - -set -euo pipefail - -cd "$(dirname "${BASH_SOURCE[0]}")" -tmp=$(mktemp) -cabal run gen_ci -- gitlab $tmp -rm -f jobs.yaml -echo "### THIS IS A GENERATED FILE, DO NOT MODIFY DIRECTLY" > jobs.yaml -cat $tmp | jq | tee -a jobs.yaml View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c28098ccb71019a11105ba1f01411a4cbb52480d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c28098ccb71019a11105ba1f01411a4cbb52480d You're receiving 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 Jun 28 23:15:49 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 28 Jun 2023 19:15:49 -0400 Subject: [Git][ghc/ghc][wip/refactor-gen-ci] gitlab-ci: Refactor compilation of gen_ci Message-ID: <649cbf25a17d7_3b5ae21282de14390859@gitlab.mail> Ben Gamari pushed to branch wip/refactor-gen-ci at Glasgow Haskell Compiler / GHC Commits: 4c8b92af by Ben Gamari at 2023-06-28T19:15:40-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 9 changed files: - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/update-ci - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs Changes: ===================================== .gitlab/generate-ci/LICENSE ===================================== @@ -0,0 +1,30 @@ +Copyright (c) 2023, The GHC Developers + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of The GHC Developers nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ===================================== .gitlab/generate-ci/README.mkd ===================================== @@ -0,0 +1,26 @@ +# generate-ci + +This is the generator for GHC's GitLab CI infrastructure. In particular, this +generates `.gitlab/jobs.yaml`, which is a YAML (or, strictly speaking, JSON) +file which defines the bulk of the validation, nightly, and release jobs of +GHC's CI. + + +## Modifying the CI configuration (nix) + +The jobs are defined in `gen_ci.hs`. After modifying this you can run +```sh +nix run .gitlab/generate-ci#update-ci +``` +from the top of the GHC repository to update the generated configuration. + + +## Modifying the CI configuration (without nix) + +One can run `update-ci` without Nix as follows (assuming one has `jq`, +`cabal-install`, and GHC installed): +```sh +$ cabal build generate-ci +$ PATH="$(dirname $(cabal list-bin generate-ci)):$PATH" +$ ./update-ci +``` ===================================== .gitlab/generate-ci/flake.lock ===================================== @@ -0,0 +1,59 @@ +{ + "nodes": { + "flake-utils": { + "inputs": { + "systems": "systems" + }, + "locked": { + "lastModified": 1687709756, + "narHash": "sha256-Y5wKlQSkgEK2weWdOu4J3riRd+kV/VCgHsqLNTTWQ/0=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "dbabf0ca0c0c4bce6ea5eaf65af5cb694d2082c7", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "nixpkgs": { + "locked": { + "lastModified": 1687886075, + "narHash": "sha256-PeayJDDDy+uw1Ats4moZnRdL1OFuZm1Tj+KiHlD67+o=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "a565059a348422af5af9026b5174dc5c0dcefdae", + "type": "github" + }, + "original": { + "id": "nixpkgs", + "type": "indirect" + } + }, + "root": { + "inputs": { + "flake-utils": "flake-utils", + "nixpkgs": "nixpkgs" + } + }, + "systems": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } + } + }, + "root": "root", + "version": 7 +} ===================================== .gitlab/generate-ci/flake.nix ===================================== @@ -0,0 +1,33 @@ +{ + description = "GHC CI Generator"; + + inputs.flake-utils.url = "github:numtide/flake-utils"; + + outputs = { self, nixpkgs, flake-utils }: + flake-utils.lib.eachDefaultSystem (system: + let pkgs = nixpkgs.legacyPackages.${system}; in + { + packages = rec { + update-ci = pkgs.runCommand "update-ci" { + nativeBuildInputs = with pkgs; [ makeWrapper ]; + } '' + mkdir -p $out/bin + makeWrapper ${./update-ci} $out/bin/update-ci \ + --prefix PATH : ${with pkgs; lib.makeBinPath [ generate-ci jq gitMinimal ]} + ''; + + generate-ci = pkgs.haskellPackages.callCabal2nix "generate-ci" ./. {}; + + default = update-ci; + }; + + apps = rec { + update-ci = flake-utils.lib.mkApp { + drv = self.packages.${system}.update-ci; + }; + + default = update-ci; + }; + } + ); +} ===================================== .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs ===================================== @@ -3,9 +3,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{- cabal: -build-depends: base, aeson >= 1.8.1, containers, bytestring --} import Data.Aeson as A import qualified Data.Map as Map ===================================== .gitlab/generate-ci/generate-ci.cabal ===================================== @@ -0,0 +1,15 @@ +cabal-version: 3.0 +name: generate-ci +version: 0.1.0.0 +license: BSD-3-Clause +license-file: LICENSE +build-type: Simple + +executable generate-ci + main-is: gen_ci.hs + ghc-options: -Wall + build-depends: base, + containers, + bytestring, + aeson >= 1.8.1 + default-language: Haskell2010 ===================================== .gitlab/generate-ci/update-ci ===================================== @@ -0,0 +1,16 @@ +#!/usr/bin/env bash + +out_dir="$(git rev-parse --show-toplevel)/.gitlab" + +# Update job metadata for ghcup +generate-ci metadata "$out_dir/jobs-metadata.json" +echo "Updated $out_dir/jobs-metadata.json" + +# Update CI jobs +tmp="$(mktemp)" +generate-ci gitlab "$tmp" +rm -f "$out_dir/jobs.yaml" +echo "### THIS IS A GENERATED FILE, DO NOT MODIFY DIRECTLY" > "$out_dir/jobs.yaml" +cat "$tmp" | jq >> "$out_dir/jobs.yaml" +rm "$tmp" +echo "Updated $out_dir/jobs.yaml" ===================================== .gitlab/generate_job_metadata deleted ===================================== @@ -1,5 +0,0 @@ -#! /usr/bin/env nix-shell -#!nix-shell -i bash -p cabal-install "haskell.packages.ghc92.ghcWithPackages (pkgs: with pkgs; [aeson])" git jq - -cd "$(dirname "${BASH_SOURCE[0]}")" -cabal run gen_ci -- metadata jobs-metadata.json ===================================== .gitlab/generate_jobs deleted ===================================== @@ -1,13 +0,0 @@ -#!/usr/bin/env nix-shell -#!nix-shell -i bash -p cabal-install "haskell.packages.ghc92.ghcWithPackages (pkgs: with pkgs; [aeson])" git jq - -# shellcheck shell=bash - -set -euo pipefail - -cd "$(dirname "${BASH_SOURCE[0]}")" -tmp=$(mktemp) -cabal run gen_ci -- gitlab $tmp -rm -f jobs.yaml -echo "### THIS IS A GENERATED FILE, DO NOT MODIFY DIRECTLY" > jobs.yaml -cat $tmp | jq | tee -a jobs.yaml View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4c8b92aff11c1d559c3948fb2061cc80acab7f97 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4c8b92aff11c1d559c3948fb2061cc80acab7f97 You're receiving 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 Jun 28 23:17:14 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 28 Jun 2023 19:17:14 -0400 Subject: [Git][ghc/ghc][wip/testsuite-output-patch] 15 commits: Propagate breakpoint information when inlining across modules Message-ID: <649cbf7a120d6_3b5ae2de6703c39139e@gitlab.mail> Ben Gamari pushed to branch wip/testsuite-output-patch at Glasgow Haskell Compiler / GHC Commits: c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 4c8b92af by Ben Gamari at 2023-06-28T19:15:40-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 31966654 by Ben Gamari at 2023-06-28T19:16:25-04:00 Drop circle-ci-job.sh - - - - - 6e9acd9d by Ben Gamari at 2023-06-28T19:16:25-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 62d8611c by Ben Gamari at 2023-06-28T19:17:07-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - e982315d by Ben Gamari at 2023-06-28T19:17:07-04:00 fetch-testsuite-results: initial commit - - - - - 30 changed files: - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/darwin/toolchain.nix - + .gitlab/fetch-testsuite-results/fetch_testsuite_results.py - + .gitlab/fetch-testsuite-results/flake.lock - + .gitlab/fetch-testsuite-results/flake.nix - + .gitlab/fetch-testsuite-results/setup.py - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/update-ci - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/Tidy.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/52611286f229cac744eb12d5dc122ad0c92fb724...e982315db7f68d5cf0418ac42f14cf17cf91c587 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/52611286f229cac744eb12d5dc122ad0c92fb724...e982315db7f68d5cf0418ac42f14cf17cf91c587 You're receiving 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 Jun 28 23:37:49 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 28 Jun 2023 19:37:49 -0400 Subject: [Git][ghc/ghc][wip/testsuite-output-patch] gitlab-ci: Preserve unexpected output Message-ID: <649cc44dbc1c9_3b5ae21282de143921f0@gitlab.mail> Ben Gamari pushed to branch wip/testsuite-output-patch at Glasgow Haskell Compiler / GHC Commits: 02d785a0 by Ben Gamari at 2023-06-28T19:19:15-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 3 changed files: - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml Changes: ===================================== .gitlab/ci.sh ===================================== @@ -673,12 +673,14 @@ function test_hadrian() { --summary-junit=./junit.xml \ --test-have-intree-files \ --test-compiler="${test_compiler}" \ - "runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian main testsuite" + "runtest.opts+=${RUNTEST_ARGS:-}" \ + "runtest.opts+=--unexpected-output-dir=$DIR/unexpected-test-output" \ + || fail "hadrian main testsuite" + tar -czf unexpected-test-output.tar.gz unexpected-test-output info "STAGE2_TEST=$?" - fi - + fi } function summarise_hi_files() { ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -696,16 +696,19 @@ 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 + , let runtestArgs = + [ "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity" + | validateNonmovingGc buildConfig + ] + in "RUNTEST_ARGS" =: unwords runtestArgs ] jobArtifacts = Artifacts { junitReport = "junit.xml" , expireIn = "2 weeks" , artifactPaths = [binDistName arch opsys buildConfig ++ ".tar.xz" - ,"junit.xml"] + ,"junit.xml" + ,"unexpected-test-output.tar.gz"] , artifactsWhen = ArtifactsAlways } ===================================== .gitlab/jobs.yaml ===================================== @@ -11,7 +11,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-aarch64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -59,6 +60,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-darwin-validate" } }, @@ -73,7 +75,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -117,6 +120,7 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate" } }, @@ -131,7 +135,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-i386-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -175,6 +180,7 @@ "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb9-validate" } }, @@ -189,7 +195,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -237,6 +244,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-darwin-validate", "XZ_OPT": "-9" } @@ -252,7 +260,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -296,6 +305,7 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -311,7 +321,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -355,6 +366,7 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate+llvm", "XZ_OPT": "-9" } @@ -370,7 +382,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-i386-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -414,6 +427,7 @@ "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb9-validate", "XZ_OPT": "-9" } @@ -429,7 +443,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -477,6 +492,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-darwin-validate", "XZ_OPT": "-9", "ac_cv_func_clock_gettime": "no", @@ -495,7 +511,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-freebsd13-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -541,6 +558,7 @@ "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-freebsd13-validate", "XZ_OPT": "-9" } @@ -556,7 +574,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -603,6 +622,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-int_native-validate+fully_static", "XZ_OPT": "-9" } @@ -618,7 +638,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -665,6 +686,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-validate", "XZ_OPT": "-9" } @@ -680,7 +702,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -727,6 +750,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-validate+fully_static", "XZ_OPT": "-9" } @@ -742,7 +766,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -788,6 +813,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -803,7 +829,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -849,6 +876,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -864,7 +892,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -910,6 +939,7 @@ "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -925,7 +955,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-centos7-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -970,6 +1001,7 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-centos7-validate", "XZ_OPT": "-9" } @@ -985,7 +1017,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1029,6 +1062,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-int_native-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-int_native-validate", "XZ_OPT": "-9" } @@ -1044,7 +1078,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-no_tntc-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1088,6 +1123,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-no_tntc-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--disable-tables-next-to-code", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate", "XZ_OPT": "-9" } @@ -1103,7 +1139,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1148,6 +1185,7 @@ "BUILD_FLAVOUR": "slow-validate", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate", "XZ_OPT": "-9" } @@ -1163,7 +1201,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-unreg-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1207,6 +1246,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-unreg-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-unregisterised", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-unreg-validate", "XZ_OPT": "-9" } @@ -1222,7 +1262,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1266,6 +1307,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -1281,7 +1323,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1325,6 +1368,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+debug_info", "XZ_OPT": "-9" } @@ -1340,7 +1384,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1384,6 +1429,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+llvm", "XZ_OPT": "-9" } @@ -1399,7 +1445,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1444,6 +1491,7 @@ "BUILD_FLAVOUR": "validate+thread_sanitizer", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions", "XZ_OPT": "-9" @@ -1460,7 +1508,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1506,6 +1555,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "XZ_OPT": "-9" } @@ -1521,7 +1571,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1568,6 +1619,7 @@ "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate", "XZ_OPT": "-9" } @@ -1583,7 +1635,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1627,6 +1680,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-validate", "XZ_OPT": "-9" } @@ -1642,7 +1696,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1702,7 +1757,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1746,6 +1802,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb9-validate", "XZ_OPT": "-9" } @@ -1761,7 +1818,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1807,6 +1865,7 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -1822,7 +1881,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1869,6 +1929,7 @@ "HADRIAN_ARGS": "--haddock-base-url", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -1884,7 +1945,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1930,6 +1992,7 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-validate+debug_info", "XZ_OPT": "-9" } @@ -1945,7 +2008,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-rocky8-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1990,6 +2054,7 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-rocky8-validate", "XZ_OPT": "-9" } @@ -2005,7 +2070,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-ubuntu18_04-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2049,6 +2115,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu18_04-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu18_04-validate", "XZ_OPT": "-9" } @@ -2064,7 +2131,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-ubuntu20_04-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2108,6 +2176,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu20_04-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu20_04-validate", "XZ_OPT": "-9" } @@ -2122,7 +2191,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-windows-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2167,6 +2237,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-int_native-validate", "XZ_OPT": "-9" } @@ -2181,7 +2252,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-windows-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2226,6 +2298,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-validate", "XZ_OPT": "-9" } @@ -2241,7 +2314,8 @@ "expire_in": "1 year", "paths": [ "ghc-aarch64-darwin-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2290,6 +2364,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-darwin-release", "XZ_OPT": "-9" } @@ -2305,7 +2380,8 @@ "expire_in": "1 year", "paths": [ "ghc-aarch64-linux-deb10-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2351,6 +2427,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-release+no_split_sections", "XZ_OPT": "-9" } @@ -2366,7 +2443,8 @@ "expire_in": "1 year", "paths": [ "ghc-i386-linux-deb9-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2412,6 +2490,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb9-release+no_split_sections", "XZ_OPT": "-9" } @@ -2427,7 +2506,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-darwin-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2476,6 +2556,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-darwin-release", "XZ_OPT": "-9", "ac_cv_func_clock_gettime": "no", @@ -2494,7 +2575,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2542,6 +2624,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-int_native-release+fully_static", "XZ_OPT": "-9" } @@ -2557,7 +2640,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-release+fully_static+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2605,6 +2689,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-release+fully_static+no_split_sections", "XZ_OPT": "-9" } @@ -2620,7 +2705,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2668,6 +2754,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-release+no_split_sections", "XZ_OPT": "-9" } @@ -2683,7 +2770,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-centos7-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2729,6 +2817,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-centos7-release+no_split_sections", "XZ_OPT": "-9" } @@ -2744,7 +2833,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb10-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2790,6 +2880,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-release", "XZ_OPT": "-9" } @@ -2805,7 +2896,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb10-release+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2851,6 +2943,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-release+debug_info", "XZ_OPT": "-9" } @@ -2866,7 +2959,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb11-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2912,6 +3006,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-release", "XZ_OPT": "-9" } @@ -2927,7 +3022,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb11-release+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2989,7 +3085,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb9-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3035,6 +3132,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb9-release+no_split_sections", "XZ_OPT": "-9" } @@ -3050,7 +3148,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3098,6 +3197,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -3113,7 +3213,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3161,6 +3262,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release+debug_info", "XZ_OPT": "-9" } @@ -3176,7 +3278,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3224,6 +3327,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -3239,7 +3343,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-rocky8-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3285,6 +3390,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-rocky8-release", "XZ_OPT": "-9" } @@ -3300,7 +3406,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-ubuntu18_04-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3346,6 +3453,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu18_04-release", "XZ_OPT": "-9" } @@ -3361,7 +3469,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-ubuntu20_04-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3407,6 +3516,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu20_04-release", "XZ_OPT": "-9" } @@ -3421,7 +3531,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-windows-int_native-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3467,6 +3578,7 @@ "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-int_native-release+no_split_sections", "XZ_OPT": "-9" } @@ -3481,7 +3593,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-windows-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3527,6 +3640,7 @@ "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-release+no_split_sections", "XZ_OPT": "-9" } @@ -3542,7 +3656,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3590,6 +3705,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-darwin-validate", "ac_cv_func_clock_gettime": "no", "ac_cv_func_futimens": "no", @@ -3607,7 +3723,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-freebsd13-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3653,6 +3770,7 @@ "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-freebsd13-validate" } }, @@ -3667,7 +3785,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3714,6 +3833,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-validate+fully_static" } }, @@ -3728,7 +3848,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3774,6 +3895,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static" } }, @@ -3788,7 +3910,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3835,6 +3958,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static" } }, @@ -3849,7 +3973,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3896,6 +4021,7 @@ "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static" } }, @@ -3910,7 +4036,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3954,6 +4081,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-int_native-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-int_native-validate" } }, @@ -3968,7 +4096,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-no_tntc-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4013,6 +4142,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-no_tntc-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--disable-tables-next-to-code", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate" } }, @@ -4027,7 +4157,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4072,6 +4203,7 @@ "BUILD_FLAVOUR": "slow-validate", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate" } }, @@ -4086,7 +4218,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-unreg-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4130,6 +4263,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-unreg-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-unregisterised", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-unreg-validate" } }, @@ -4144,7 +4278,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4188,6 +4323,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate" } }, @@ -4202,7 +4338,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4246,6 +4383,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+debug_info" } }, @@ -4260,7 +4398,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4304,6 +4443,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+llvm" } }, @@ -4318,7 +4458,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4364,6 +4505,7 @@ "BUILD_FLAVOUR": "validate+thread_sanitizer", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" } @@ -4379,7 +4521,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4425,6 +4568,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" } }, @@ -4439,7 +4583,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4486,6 +4631,7 @@ "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate" } }, @@ -4500,7 +4646,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4559,7 +4706,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4605,6 +4753,7 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release" } }, @@ -4618,7 +4767,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-windows-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4663,6 +4813,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-validate" } } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/02d785a052ace58eb5ff163b05e78d1a4218795a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/02d785a052ace58eb5ff163b05e78d1a4218795a You're receiving 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 Jun 29 01:08:01 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 28 Jun 2023 21:08:01 -0400 Subject: [Git][ghc/ghc][master] Configure CPP into settings Message-ID: <649cd971c7188_3b5ae2e0a0a4c40097a@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 19 changed files: - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Settings/Builders/Hsc2Hs.hs - m4/fp_cpp_cmd_with_args.m4 - + m4/fp_hs_cpp_cmd_with_args.m4 - m4/fp_settings.m4 Changes: ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -121,7 +121,7 @@ runPhase (T_CmmCpp pipe_env hsc_env input_fn) = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = True }) input_fn output_fn @@ -679,7 +679,7 @@ runCppPhase hsc_env input_fn output_fn = do (hsc_dflags hsc_env) (hsc_unit_env hsc_env) (CppOpts - { cppUseCc = False + { useHsCpp = True , cppLinePragmas = True }) input_fn output_fn ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -97,6 +97,7 @@ module GHC.Driver.Session ( sPgm_F, sPgm_c, sPgm_cxx, + sPgm_cpp, sPgm_a, sPgm_l, sPgm_lm, @@ -135,8 +136,8 @@ module GHC.Driver.Session ( ghcUsagePath, ghciUsagePath, topDir, versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, - pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, - pgm_windres, pgm_ar, + pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, + pgm_dll, pgm_T, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -395,6 +396,8 @@ pgm_c :: DynFlags -> String pgm_c dflags = toolSettings_pgm_c $ toolSettings dflags pgm_cxx :: DynFlags -> String pgm_cxx dflags = toolSettings_pgm_cxx $ toolSettings dflags +pgm_cpp :: DynFlags -> (String,[Option]) +pgm_cpp dflags = toolSettings_pgm_cpp $ toolSettings dflags pgm_a :: DynFlags -> (String,[Option]) pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags pgm_l :: DynFlags -> (String,[Option]) ===================================== compiler/GHC/Settings.hs ===================================== @@ -29,6 +29,7 @@ module GHC.Settings , sPgm_F , sPgm_c , sPgm_cxx + , sPgm_cpp , sPgm_a , sPgm_l , sPgm_lm @@ -96,10 +97,13 @@ data ToolSettings = ToolSettings -- commands for particular phases , toolSettings_pgm_L :: String - , toolSettings_pgm_P :: (String, [Option]) + , -- | The Haskell C preprocessor and default options (not added by -optP) + toolSettings_pgm_P :: (String, [Option]) , toolSettings_pgm_F :: String , toolSettings_pgm_c :: String , toolSettings_pgm_cxx :: String + , -- | The C preprocessor (distinct from the Haskell C preprocessor!) + toolSettings_pgm_cpp :: (String, [Option]) , toolSettings_pgm_a :: (String, [Option]) , toolSettings_pgm_l :: (String, [Option]) , toolSettings_pgm_lm :: Maybe (String, [Option]) @@ -212,6 +216,8 @@ sPgm_c :: Settings -> String sPgm_c = toolSettings_pgm_c . sToolSettings sPgm_cxx :: Settings -> String sPgm_cxx = toolSettings_pgm_cxx . sToolSettings +sPgm_cpp :: Settings -> (String, [Option]) +sPgm_cpp = toolSettings_pgm_cpp . sToolSettings sPgm_a :: Settings -> (String, [Option]) sPgm_a = toolSettings_pgm_a . sToolSettings sPgm_l :: Settings -> (String, [Option]) ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -81,15 +81,18 @@ initSettings top_dir = do cc_args_str <- getToolSetting "C compiler flags" cxx_args_str <- getToolSetting "C++ compiler flags" gccSupportsNoPie <- getBooleanSetting "C compiler supports -no-pie" - cpp_prog <- getToolSetting "Haskell CPP command" - cpp_args_str <- getToolSetting "Haskell CPP flags" + cpp_prog <- getToolSetting "CPP command" + cpp_args_str <- getToolSetting "CPP flags" + hs_cpp_prog <- getToolSetting "Haskell CPP command" + hs_cpp_args_str <- getToolSetting "Haskell CPP flags" platform <- either pgmError pure $ getTargetPlatform settingsFile mySettings let unreg_cc_args = if platformUnregisterised platform then ["-DNO_REGS", "-DUSE_MINIINTERPRETER"] else [] - cpp_args = map Option (words cpp_args_str) + cpp_args = map Option (words cpp_args_str) + hs_cpp_args = map Option (words hs_cpp_args_str) cc_args = words cc_args_str ++ unreg_cc_args cxx_args = words cxx_args_str @@ -127,7 +130,6 @@ initSettings top_dir = do mkdll_prog <- getToolSetting "dllwrap command" let mkdll_args = [] - -- cpp is derived from gcc on all platforms -- HACK, see setPgmP below. We keep 'words' here to remember to fix -- Config.hs one day. @@ -180,10 +182,11 @@ initSettings top_dir = do , toolSettings_arSupportsDashL = arSupportsDashL , toolSettings_pgm_L = unlit_path - , toolSettings_pgm_P = (cpp_prog, cpp_args) + , toolSettings_pgm_P = (hs_cpp_prog, hs_cpp_args) , toolSettings_pgm_F = "" , toolSettings_pgm_c = cc_prog , toolSettings_pgm_cxx = cxx_prog + , toolSettings_pgm_cpp = (cpp_prog, cpp_args) , toolSettings_pgm_a = (as_prog, as_args) , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r ===================================== compiler/GHC/StgToJS/Linker/Linker.hs ===================================== @@ -1012,7 +1012,7 @@ embedJsFile logger dflags tmpfs unit_env input_fn output_fn = do js_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js" let cpp_opts = CppOpts - { cppUseCc = True + { useHsCpp = False , cppLinePragmas = False -- LINE pragmas aren't JS compatible } doCpp logger ===================================== compiler/GHC/SysTools/Cpp.hs ===================================== @@ -5,7 +5,7 @@ module GHC.SysTools.Cpp ( doCpp - , CppOpts (..) + , CppOpts(..) , getGhcVersionPathName , applyCDefs , offsetIncludePaths @@ -40,11 +40,34 @@ import System.Directory import System.FilePath data CppOpts = CppOpts - { cppUseCc :: !Bool -- ^ Use "cc -E" as preprocessor, otherwise use "cpp" - , cppLinePragmas :: !Bool -- ^ Enable generation of LINE pragmas + { useHsCpp :: !Bool + -- ^ Use the Haskell C preprocessor, otherwise use the C preprocessor. + -- See the Note [Preprocessing invocations] + , cppLinePragmas :: !Bool + -- ^ Enable generation of LINE pragmas } --- | Run CPP +{- +Note [Preprocessing invocations] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must consider two distinct preprocessors when preprocessing Haskell. +These are: + +(1) The Haskell C preprocessor (HsCpp), which preprocesses Haskell files that make use + of the CPP language extension + +(2) The C preprocessor (Cpp), which is used to preprocess C and Cmm files + +These preprocessors are indeed different. Despite often sharing the same +underlying program (the C compiler), the set of flags passed determines the +behaviour of the preprocessor, and Cpp and HsCpp behave differently. +Specifically, we rely on "traditional" (pre-standard) preprocessing semantics +(which most compilers expose via the `-traditional` flag) when preprocessing +Haskell source. This avoids, e.g., the preprocessor removing C-style comments. +-} + +-- | Run either the Haskell preprocessor or the C preprocessor, as per the +-- 'CppOpts' passed. See Note [Preprocessing invocations]. -- -- UnitEnv is needed to compute MIN_VERSION macros doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> CppOpts -> FilePath -> FilePath -> IO () @@ -73,9 +96,8 @@ doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do let verbFlags = getVerbFlags dflags let cpp_prog args - | cppUseCc opts = GHC.SysTools.runCc Nothing logger tmpfs dflags - (GHC.SysTools.Option "-E" : args) - | otherwise = GHC.SysTools.runCpp logger dflags args + | useHsCpp opts = GHC.SysTools.runHsCpp logger dflags args + | otherwise = GHC.SysTools.runCpp logger tmpfs dflags args let platform = targetPlatform dflags targetArch = stringEncodeArch $ platformArch platform ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -60,38 +60,9 @@ augmentImports _ [x] = [x] augmentImports dflags ("-include":fp:fps) = "-include" : augmentByWorkingDirectory dflags fp : augmentImports dflags fps augmentImports dflags (fp1: fp2: fps) = fp1 : augmentImports dflags (fp2:fps) -runCpp :: Logger -> DynFlags -> [Option] -> IO () -runCpp logger dflags args = traceSystoolCommand logger "cpp" $ do - let opts = getOpts dflags opt_P - modified_imports = augmentImports dflags opts - let (p,args0) = pgm_P dflags - args1 = map Option modified_imports - args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] - ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] - mb_env <- getGccEnv args2 - runSomethingFiltered logger id "C pre-processor" p - (args0 ++ args1 ++ args2 ++ args) Nothing mb_env - -runPp :: Logger -> DynFlags -> [Option] -> IO () -runPp logger dflags args = traceSystoolCommand logger "pp" $ do - let prog = pgm_F dflags - opts = map Option (getOpts dflags opt_F) - runSomething logger "Haskell pre-processor" prog (args ++ opts) - --- | Run compiler of C-like languages and raw objects (such as gcc or clang). -runCc :: Maybe ForeignSrcLang -> Logger -> TmpFs -> DynFlags -> [Option] -> IO () -runCc mLanguage logger tmpfs dflags args = traceSystoolCommand logger "cc" $ do - let args1 = map Option userOpts - args2 = languageOptions ++ args ++ args1 - -- We take care to pass -optc flags in args1 last to ensure that the - -- user can override flags passed by GHC. See #14452. - mb_env <- getGccEnv args2 - runSomethingResponseFile logger tmpfs dflags cc_filter dbgstring prog args2 - mb_env - where - -- discard some harmless warnings from gcc that we can't turn off - cc_filter = unlines . doFilter . lines - +-- | Discard some harmless warnings from gcc that we can't turn off +cc_filter :: String -> String +cc_filter = unlines . doFilter . lines where {- gcc gives warnings in chunks like so: In file included from /foo/bar/baz.h:11, @@ -139,6 +110,49 @@ runCc mLanguage logger tmpfs dflags args = traceSystoolCommand logger "cc" $ do | "warning: call-clobbered register used" `isContainedIn` w = False | otherwise = True +-- | Run the C preprocessor, which is different from running the +-- Haskell C preprocessor (they're configured separately!). +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runCpp :: Logger -> TmpFs -> DynFlags -> [Option] -> IO () +runCpp logger tmpfs dflags args = traceSystoolCommand logger "cpp" $ do + let (p,args0) = pgm_cpp dflags + userOpts_c = map Option $ getOpts dflags opt_c + args2 = args0 ++ args ++ userOpts_c + mb_env <- getGccEnv args2 + runSomethingResponseFile logger tmpfs dflags cc_filter "C pre-processor" p + args2 mb_env + +-- | Run the Haskell C preprocessor. +-- See also Note [Preprocessing invocations] in GHC.SysTools.Cpp +runHsCpp :: Logger -> DynFlags -> [Option] -> IO () +runHsCpp logger dflags args = traceSystoolCommand logger "hs-cpp" $ do + let (p,args0) = pgm_P dflags + opts = getOpts dflags opt_P + modified_imports = augmentImports dflags opts + args1 = map Option modified_imports + args2 = [Option "-Werror" | gopt Opt_WarnIsError dflags] + ++ [Option "-Wundef" | wopt Opt_WarnCPPUndef dflags] + mb_env <- getGccEnv args2 -- romes: what about args0 and args? + runSomethingFiltered logger id "Haskell C pre-processor" p + (args0 ++ args1 ++ args2 ++ args) Nothing mb_env + +runPp :: Logger -> DynFlags -> [Option] -> IO () +runPp logger dflags args = traceSystoolCommand logger "pp" $ do + let prog = pgm_F dflags + opts = map Option (getOpts dflags opt_F) + runSomething logger "Haskell pre-processor" prog (args ++ opts) + +-- | Run compiler of C-like languages and raw objects (such as gcc or clang). +runCc :: Maybe ForeignSrcLang -> Logger -> TmpFs -> DynFlags -> [Option] -> IO () +runCc mLanguage logger tmpfs dflags args = traceSystoolCommand logger "cc" $ do + let args1 = map Option userOpts + args2 = languageOptions ++ args ++ args1 + -- We take care to pass -optc flags in args1 last to ensure that the + -- user can override flags passed by GHC. See #14452. + mb_env <- getGccEnv args2 + runSomethingResponseFile logger tmpfs dflags cc_filter dbgstring prog args2 + mb_env + where -- force the C compiler to interpret this file as C when -- compiling .hc files, by adding the -x c option. -- Also useful for plain .c files, just in case GHC saw a ===================================== configure.ac ===================================== @@ -466,7 +466,7 @@ dnl make extensions visible to allow feature-tests to detect them lateron AC_USE_SYSTEM_EXTENSIONS # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) @@ -667,6 +667,16 @@ FP_CC_IGNORE_UNUSED_ARGS([$CC_STAGE0], [CONF_CC_OPTS_STAGE0]) FP_CC_IGNORE_UNUSED_ARGS([$CC], [CONF_CC_OPTS_STAGE1]) FP_CC_IGNORE_UNUSED_ARGS([$CC], [CONF_CC_OPTS_STAGE2]) +# CPP, CPPFLAGS +# --with-cpp/-with-cpp-flags +dnl Note that we must do this after setting and using the C99 CPPFLAGS, or +dnl otherwise risk trying to configure the C99 and LD flags using -E as a CPPFLAG +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + # See rules/distdir-way-opts.mk for details. # Flags passed to the C compiler AC_SUBST(CONF_CC_OPTS_STAGE0) @@ -1241,6 +1251,8 @@ echo "\ Unregisterised : $Unregisterised TablesNextToCode : $TablesNextToCode Build GMP in tree : $GMP_FORCE_INTREE + cpp : $CPPCmd + cpp-flags : $CONF_CPP_OPTS_STAGE2 hs-cpp : $HaskellCPPCmd hs-cpp-flags : $HaskellCPPArgs ar : $ArCmd ===================================== distrib/configure.ac.in ===================================== @@ -110,7 +110,7 @@ dnl ** figure out how to invoke the C preprocessor (i.e. `gcc -E`) AC_PROG_CPP # --with-hs-cpp/--with-hs-cpp-flags -FP_CPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) +FP_HSCPP_CMD_WITH_ARGS(HaskellCPPCmd, HaskellCPPArgs) AC_SUBST([HaskellCPPCmd]) AC_SUBST([HaskellCPPArgs]) @@ -224,6 +224,16 @@ dnl Pass -Qunused-arguments or otherwise GHC will have very noisy invocations of FP_CC_IGNORE_UNUSED_ARGS([$CC], [CONF_CC_OPTS_STAGE1]) FP_CC_IGNORE_UNUSED_ARGS([$CC], [CONF_CC_OPTS_STAGE2]) +# CPP, CPPFLAGS +# --with-cpp/-with-cpp-flags +dnl Note that we must do this after setting and using the C99 CPPFLAGS, or +dnl otherwise risk trying to configure the C99 and LD flags using -E as a CPPFLAG +FP_CPP_CMD_WITH_ARGS([$CC_STAGE0],[CPPCmd_STAGE0],[CONF_CPP_OPTS_STAGE0]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE1]) +FP_CPP_CMD_WITH_ARGS([$CC],[CPPCmd],[CONF_CPP_OPTS_STAGE2]) +AC_SUBST([CPPCmd_STAGE0]) +AC_SUBST([CPPCmd]) + dnl TargetWordSize for settings file AC_CHECK_SIZEOF(void *, 4) if test "x$ac_cv_sizeof_void_p" = "x0"; then ===================================== hadrian/bindist/Makefile ===================================== @@ -85,6 +85,8 @@ lib/settings : config.mk @echo ',("C++ compiler flags", "$(SettingsCxxCompilerFlags)")' >> $@ @echo ',("C compiler link flags", "$(SettingsCCompilerLinkFlags)")' >> $@ @echo ',("C compiler supports -no-pie", "$(SettingsCCompilerSupportsNoPie)")' >> $@ + @echo ',("CPP command", "$(SettingsCPPCommand)")' >> $@ + @echo ',("CPP flags", "$(SettingsCPPFlags)")' >> $@ @echo ',("Haskell CPP command", "$(SettingsHaskellCPPCommand)")' >> $@ @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ @echo ',("ld supports compact unwind", "$(LdHasNoCompactUnwind)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -257,6 +257,8 @@ TablesNextToCode = @TablesNextToCode@ SettingsCCompilerCommand = @SettingsCCompilerCommand@ SettingsCxxCompilerCommand = @SettingsCxxCompilerCommand@ +SettingsCPPCommand = @SettingsCPPCommand@ +SettingsCPPFlags = @SettingsCPPFlags@ SettingsHaskellCPPCommand = @SettingsHaskellCPPCommand@ SettingsHaskellCPPFlags = @SettingsHaskellCPPFlags@ SettingsCCompilerFlags = @SettingsCCompilerFlags@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -10,6 +10,7 @@ ar = @ArCmd@ autoreconf = @AutoreconfCmd@ cc = @CC@ happy = @HappyCmd@ +cpp = @CPPCmd@ hs-cpp = @HaskellCPPCmd@ ld = @LD@ make = @MakeCmd@ @@ -21,6 +22,7 @@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ system-ar = @AR_STAGE0@ system-cc = @CC_STAGE0@ +system-cpp = @CPPCmd_STAGE0@ system-ghc = @WithGhc@ system-ghc-pkg = @GhcPkgCmd@ tar = @TarCmd@ @@ -108,11 +110,6 @@ conf-cc-args-stage1 = @CONF_CC_OPTS_STAGE1@ conf-cc-args-stage2 = @CONF_CC_OPTS_STAGE2@ conf-cc-args-stage3 = @CONF_CC_OPTS_STAGE3@ -conf-cpp-args-stage0 = @CONF_CPP_OPTS_STAGE0@ -conf-cpp-args-stage1 = @CONF_CPP_OPTS_STAGE1@ -conf-cpp-args-stage2 = @CONF_CPP_OPTS_STAGE2@ -conf-cpp-args-stage3 = @CONF_CPP_OPTS_STAGE3@ - conf-gcc-linker-args-stage0 = @CONF_GCC_LINKER_OPTS_STAGE0@ conf-gcc-linker-args-stage1 = @CONF_GCC_LINKER_OPTS_STAGE1@ conf-gcc-linker-args-stage2 = @CONF_GCC_LINKER_OPTS_STAGE2@ @@ -145,6 +142,8 @@ ar-args = @ArArgs@ settings-c-compiler-command = @SettingsCCompilerCommand@ settings-cxx-compiler-command = @SettingsCxxCompilerCommand@ +settings-cpp-command = @SettingsCPPCommand@ +settings-cpp-flags = @SettingsCPPFlags@ settings-haskell-cpp-command = @SettingsHaskellCPPCommand@ settings-haskell-cpp-flags = @SettingsHaskellCPPFlags@ settings-c-compiler-flags = @SettingsCCompilerFlags@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -83,7 +83,6 @@ data Setting = BuildArch | TargetWordSize | BourneShell --- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions). -- | Each 'SettingList' comes from the file @hadrian/cfg/system.config@, -- generated by the @configure@ script from the input file -- @hadrian/cfg/system.config.in at . For example, the line @@ -94,7 +93,6 @@ data Setting = BuildArch -- the value of the setting and returns the list of strings -- @["-E", "-undef", "-traditional"]@, tracking the result in the Shake database. data SettingList = ConfCcArgs Stage - | ConfCppArgs Stage | ConfGccLinkerArgs Stage | ConfLdLinkerArgs Stage | ConfMergeObjectsArgs Stage @@ -109,6 +107,8 @@ data SettingList = ConfCcArgs Stage data SettingsFileSetting = SettingsFileSetting_CCompilerCommand | SettingsFileSetting_CxxCompilerCommand + | SettingsFileSetting_CPPCommand + | SettingsFileSetting_CPPFlags | SettingsFileSetting_HaskellCPPCommand | SettingsFileSetting_HaskellCPPFlags | SettingsFileSetting_CCompilerFlags @@ -193,7 +193,6 @@ bootIsStage0 s = s settingList :: SettingList -> Action [String] settingList key = fmap words $ lookupSystemConfig $ case key of ConfCcArgs stage -> "conf-cc-args-" ++ stageString (bootIsStage0 stage) - ConfCppArgs stage -> "conf-cpp-args-" ++ stageString (bootIsStage0 stage) ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString (bootIsStage0 stage) ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString (bootIsStage0 stage) ConfMergeObjectsArgs stage -> "conf-merge-objects-args-" ++ stageString (bootIsStage0 stage) @@ -206,6 +205,8 @@ settingsFileSetting :: SettingsFileSetting -> Action String settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_CCompilerCommand -> "settings-c-compiler-command" SettingsFileSetting_CxxCompilerCommand -> "settings-cxx-compiler-command" + SettingsFileSetting_CPPCommand -> "settings-cpp-command" + SettingsFileSetting_CPPFlags -> "settings-cpp-flags" SettingsFileSetting_HaskellCPPCommand -> "settings-haskell-cpp-command" SettingsFileSetting_HaskellCPPFlags -> "settings-haskell-cpp-flags" SettingsFileSetting_CCompilerFlags -> "settings-c-compiler-flags" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -444,6 +444,8 @@ generateSettings = do , ("C++ compiler flags", expr $ settingsFileSetting SettingsFileSetting_CxxCompilerFlags) , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags) , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie) + , ("CPP command", expr $ settingsFileSetting SettingsFileSetting_CPPCommand) + , ("CPP flags", expr $ settingsFileSetting SettingsFileSetting_CPPFlags) , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand) , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags) , ("ld supports compact unwind", expr $ lookupSystemConfig "ld-has-no-compact-unwind") ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -37,7 +37,6 @@ toolArgs = do [ packageGhcArgs , includeGhcArgs , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , getContextData hcOpts ] @@ -217,7 +216,6 @@ commonGhcArgs = do -- RTS package in the package database and failing. , package rts ? notStage0 ? arg "-ghcversion-file=rts/include/ghcversion.h" , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs - , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs , map ("-optP" ++) <$> getContextData cppOpts , arg "-outputdir", arg path -- we need to enable color explicitly because the output is ===================================== hadrian/src/Settings/Builders/Hsc2Hs.hs ===================================== @@ -50,7 +50,6 @@ getCFlags = do let cabalMacros = autogen -/- "cabal_macros.h" expr $ need [cabalMacros] mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs) - , getStagedSettingList ConfCppArgs , cIncludeArgs , getContextData ccOpts -- we might be able to leave out cppOpts, to be investigated. ===================================== m4/fp_cpp_cmd_with_args.m4 ===================================== @@ -2,98 +2,63 @@ # ---------------------- # sets CPP command and its arguments # -# $1 = the variable to set to CPP command -# $2 = the variable to set to CPP command arguments - +# $1 = CC (unmodified) +# $2 = the variable to set to CPP command +# $3 = the variable to set to CPP command arguments +# +# The reason for using the non-standard --with-cpp and --with-cpp-flags instead +# of the standard CPP and CPPFLAGS is that autoconf sets CPP to "$CC -E", +# whereas we expect the CPP command to be configured as a standalone executable +# rather than a command. These are symmetrical with --with-hs-cpp and +# --with-hs-cpp-flags. AC_DEFUN([FP_CPP_CMD_WITH_ARGS],[ -dnl ** what cpp to use? -dnl -------------------------------------------------------------- -AC_ARG_WITH(hs-cpp, -[AS_HELP_STRING([--with-hs-cpp=ARG], - [Path to the (C) preprocessor for Haskell files [default=autodetect]])], + +AC_ARG_WITH(cpp, +[AS_HELP_STRING([--with-cpp=ARG], + [Path to the (C) preprocessor [default=autodetect]. + If you set --with-cpp=CC, ensure -E is included in --with-cpp-flags])], [ if test "$HostOS" = "mingw32" then AC_MSG_WARN([Request to use $withval will be ignored]) else - HS_CPP_CMD=$withval + CPP_CMD="$withval" fi ], [ - - # We can't use $CPP here, since HS_CPP_CMD is expected to be a single - # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". - HS_CPP_CMD=$CC - - SOLARIS_GCC_CPP_BROKEN=NO - SOLARIS_FOUND_GOOD_CPP=NO - case $host in - i386-*-solaris2) - GCC_MAJOR_MINOR=`$CC --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` - if test "$GCC_MAJOR_MINOR" != "3.4"; then - # this is not 3.4.x release so with broken CPP - SOLARIS_GCC_CPP_BROKEN=YES - fi - ;; - esac - - if test "$SOLARIS_GCC_CPP_BROKEN" = "YES"; then - # let's try to find if GNU C 3.4.x is installed - if test -x /usr/sfw/bin/gcc; then - # something executable is in expected path so let's - # see if it's really GNU C - NEW_GCC_MAJOR_MINOR=`/usr/sfw/bin/gcc --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` - if test "$NEW_GCC_MAJOR_MINOR" = "3.4"; then - # this is GNU C 3.4.x which provides non-broken CPP on Solaris - # let's use it as CPP then. - HS_CPP_CMD=/usr/sfw/bin/gcc - SOLARIS_FOUND_GOOD_CPP=YES - fi - fi - if test "$SOLARIS_FOUND_GOOD_CPP" = "NO"; then - AC_MSG_WARN([Your GNU C provides broken CPP and you do not have GNU C 3.4.x installed.]) - AC_MSG_WARN([Please install GNU C 3.4.x to solve this issue. It will be used as CPP only.]) - fi - fi + # We can't use the CPP var here, since CPP_CMD is expected to be a single + # command (no flags), and autoconf defines CPP as "/usr/bin/gcc -E". + # So we use CC with -E by default + CPP_CMD="$1" + CPP_ARGS="-E" ] ) -dnl ** what cpp flags to use? -dnl ----------------------------------------------------------- -AC_ARG_WITH(hs-cpp-flags, - [AS_HELP_STRING([--with-hs-cpp-flags=ARG], - [Flags to the (C) preprocessor for Haskell files [default=autodetect]])], - [ - if test "$HostOS" = "mingw32" - then - AC_MSG_WARN([Request to use $withval will be ignored]) - else - HS_CPP_ARGS=$withval - fi - ], +AC_ARG_WITH(cpp-flags, +[AS_HELP_STRING([--with-cpp-flags=ARG], + [Flags to the (C) preprocessor [default=autodetect]])], [ - $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1 - if grep "__clang__" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs" + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) else - $HS_CPP_CMD -v > conftest.txt 2>&1 - if grep "gcc" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="-E -undef -traditional" - else - $HS_CPP_CMD --version > conftest.txt 2>&1 - if grep "cpphs" conftest.txt >/dev/null 2>&1; then - HS_CPP_ARGS="--cpp -traditional" - else - AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) - HS_CPP_ARGS="" - fi - fi + # Use whatever flags were manually set, ignoring previously configured + # flags; and add CPP_ARGS (which will be -E if CPP_CMD was not specified) + CPP_ARGS="$CPP_ARGS $withval" fi - ] -) +], +[ + # Augment CPP_ARGS with whatever flags were previously configured and passed + # as an argument. + CPP_ARGS="$CPP_ARGS $$3" +]) + +$2="$CPP_CMD" +$3="$CPP_ARGS" -$1=$HS_CPP_CMD -$2=$HS_CPP_ARGS +# Clear CPP_CMD and CPP_ARGS +unset CPP_CMD +unset CPP_ARGS ]) ===================================== m4/fp_hs_cpp_cmd_with_args.m4 ===================================== @@ -0,0 +1,98 @@ +# FP_HSCPP_CMD_WITH_ARGS() +# ---------------------- +# sets HS CPP command and its arguments +# +# $1 = the variable to set to HS CPP command +# $2 = the variable to set to HS CPP command arguments + +AC_DEFUN([FP_HSCPP_CMD_WITH_ARGS],[ +dnl ** what hs-cpp to use? +dnl -------------------------------------------------------------- +AC_ARG_WITH(hs-cpp, +[AS_HELP_STRING([--with-hs-cpp=ARG], + [Path to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], +[ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HS_CPP_CMD=$withval + fi +], +[ + + # We can't use $CPP here, since HS_CPP_CMD is expected to be a single + # command (no flags), and AC_PROG_CPP defines CPP as "/usr/bin/gcc -E". + HS_CPP_CMD=$CC + + SOLARIS_GCC_CPP_BROKEN=NO + SOLARIS_FOUND_GOOD_CPP=NO + case $host in + i386-*-solaris2) + GCC_MAJOR_MINOR=`$CC --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` + if test "$GCC_MAJOR_MINOR" != "3.4"; then + # this is not 3.4.x release so with broken CPP + SOLARIS_GCC_CPP_BROKEN=YES + fi + ;; + esac + + if test "$SOLARIS_GCC_CPP_BROKEN" = "YES"; then + # let's try to find if GNU C 3.4.x is installed + if test -x /usr/sfw/bin/gcc; then + # something executable is in expected path so let's + # see if it's really GNU C + NEW_GCC_MAJOR_MINOR=`/usr/sfw/bin/gcc --version|grep "gcc (GCC)"|cut -d ' ' -f 3-3|cut -d '.' -f 1-2` + if test "$NEW_GCC_MAJOR_MINOR" = "3.4"; then + # this is GNU C 3.4.x which provides non-broken CPP on Solaris + # let's use it as CPP then. + HS_CPP_CMD=/usr/sfw/bin/gcc + SOLARIS_FOUND_GOOD_CPP=YES + fi + fi + if test "$SOLARIS_FOUND_GOOD_CPP" = "NO"; then + AC_MSG_WARN([Your GNU C provides broken CPP and you do not have GNU C 3.4.x installed.]) + AC_MSG_WARN([Please install GNU C 3.4.x to solve this issue. It will be used as CPP only.]) + fi + fi +] +) + +dnl ** what hs-cpp flags to use? +dnl ----------------------------------------------------------- +AC_ARG_WITH(hs-cpp-flags, + [AS_HELP_STRING([--with-hs-cpp-flags=ARG], + [Flags to the Haskell (C) preprocessor for Haskell files [default=autodetect]])], + [ + if test "$HostOS" = "mingw32" + then + AC_MSG_WARN([Request to use $withval will be ignored]) + else + HS_CPP_ARGS=$withval + fi + ], +[ + $HS_CPP_CMD -x c /dev/null -dM -E > conftest.txt 2>&1 + if grep "__clang__" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs" + else + $HS_CPP_CMD -v > conftest.txt 2>&1 + if grep "gcc" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="-E -undef -traditional" + else + $HS_CPP_CMD --version > conftest.txt 2>&1 + if grep "cpphs" conftest.txt >/dev/null 2>&1; then + HS_CPP_ARGS="--cpp -traditional" + else + AC_MSG_WARN([configure can't recognize your CPP program, you may need to set --with-hs-cpp-flags=FLAGS explicitly]) + HS_CPP_ARGS="" + fi + fi + fi + ] +) + +$1=$HS_CPP_CMD +$2=$HS_CPP_ARGS + +]) ===================================== m4/fp_settings.m4 ===================================== @@ -14,6 +14,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCxxCompilerCommand="${mingw_bin_prefix}clang++.exe" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2 -L\$\$tooldir/mingw/lib -L\$\$tooldir/mingw/x86_64-w64-mingw32/lib" + SettingsCPPCommand="${mingw_bin_prefix}clang.exe" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2 -I\$\$tooldir/mingw/include" SettingsHaskellCPPCommand="${mingw_bin_prefix}clang.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs -I\$\$tooldir/mingw/include" # LLD does not support object merging (#21068) @@ -33,6 +35,8 @@ AC_DEFUN([FP_SETTINGS], SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerCommand="$CXX" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" + SettingsCPPCommand="$CPPCmd" + SettingsCPPFlags="$CONF_CPP_OPTS_STAGE2" SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -103,6 +107,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCCompilerCommand) AC_SUBST(SettingsCxxCompilerCommand) + AC_SUBST(SettingsCPPCommand) + AC_SUBST(SettingsCPPFlags) AC_SUBST(SettingsHaskellCPPCommand) AC_SUBST(SettingsHaskellCPPFlags) AC_SUBST(SettingsCCompilerFlags) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5ffc7d7b376a943d64524f7e2eb8655e7c9b3d63 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5ffc7d7b376a943d64524f7e2eb8655e7c9b3d63 You're receiving 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 Jun 29 01:08:31 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 28 Jun 2023 21:08:31 -0400 Subject: [Git][ghc/ghc][master] hadrian: Always canonicalize topDirectory Message-ID: <649cd98f6235_3b5ae2dc742fc404663@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - 1 changed file: - hadrian/src/Oracles/Setting.hs Changes: ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -17,6 +17,8 @@ module Oracles.Setting ( ghcWithInterpreter ) where +import System.Directory +import System.Info.Extra import Hadrian.Expression import Hadrian.Oracles.TextFile import Hadrian.Oracles.Path @@ -327,9 +329,14 @@ ghcCanonVersion = do let leadingZero = [ '0' | length ghcMinorVersion == 1 ] return $ ghcMajorVersion ++ leadingZero ++ ghcMinorVersion --- | Path to the GHC source tree. +-- | Absolute path to the GHC source tree. topDirectory :: Action FilePath -topDirectory = fixAbsolutePathOnWindows =<< setting GhcSourcePath +topDirectory = do + x <- fixAbsolutePathOnWindows =<< setting GhcSourcePath + canonicalize x + where + -- We must canonicalize as the source directory may be accessed via a symlink. See #22451. + canonicalize = if isWindows then return else liftIO . canonicalizePath ghcVersionStage :: Stage -> Action String ghcVersionStage (Stage0 {}) = setting GhcVersion View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5efa9ca545d8d33b9be4fc0ba91af1db38f19276 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5efa9ca545d8d33b9be4fc0ba91af1db38f19276 You're receiving 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 Jun 29 01:09:19 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 28 Jun 2023 21:09:19 -0400 Subject: [Git][ghc/ghc][master] Optimise ELF linker (#23464) Message-ID: <649cd9bfa3c7f_3b5ae2e2af694409688@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 3 changed files: - rts/Linker.c - rts/LinkerInternals.h - rts/linker/Elf.c Changes: ===================================== rts/Linker.c ===================================== @@ -1379,6 +1379,10 @@ mkOc( ObjectType type, pathchar *path, char *image, int imageSize, oc->rx_m32 = m32_allocator_new(true); #endif +#if defined(OBJFORMAT_ELF) && defined(SHN_XINDEX) + oc->shndx_table = SHNDX_TABLE_UNINIT; +#endif + oc->nc_ranges = NULL; oc->dlopen_handle = NULL; ===================================== rts/LinkerInternals.h ===================================== @@ -360,6 +360,15 @@ struct _ObjectCode { m32_allocator *rw_m32, *rx_m32; #endif +#if defined(OBJFORMAT_ELF) && defined(SHN_XINDEX) + /* Cached address of ELF's shndx table, or SHNDX_TABLE_UNINIT if not + * initialized yet. It would be better to put it info ELF-specific + * ObjectCodeFormatInfo, but unfortunately shndx table is needed in + * ocVerifyImage_ELF which runs before ObjectCodeFormatInfo is + * initialized by ocInit_ELF. */ + Elf_Word *shndx_table; +#endif + /* * The following are only valid if .type == DYNAMIC_OBJECT */ @@ -371,6 +380,15 @@ struct _ObjectCode { NativeCodeRange *nc_ranges; }; +#if defined(OBJFORMAT_ELF) && defined(SHN_XINDEX) +/* We cannot simply use NULL to signal uninitialised shndx_table because NULL + * is valid return value of get_shndx_table. Thus SHNDX_TABLE_UNINIT is defined + * as the address of global variable shndx_table_uninit_label, defined in + * rts/linker/Elf.c, which is definitely unequal to any heap-allocated address */ +extern Elf_Word shndx_table_uninit_label; +#define SHNDX_TABLE_UNINIT (&shndx_table_uninit_label) +#endif + #define OC_INFORMATIVE_FILENAME(OC) \ ( (OC)->archiveMemberName ? \ (OC)->archiveMemberName : \ ===================================== rts/linker/Elf.c ===================================== @@ -132,6 +132,11 @@ */ +#if defined(SHN_XINDEX) +/* global variable which address is used to signal an uninitialised shndx_table */ +Elf_Word shndx_table_uninit_label = 0; +#endif + static Elf_Word elf_shnum(Elf_Ehdr* ehdr) { Elf_Shdr* shdr = (Elf_Shdr*) ((char*)ehdr + ehdr->e_shoff); @@ -154,16 +159,22 @@ static Elf_Word elf_shstrndx(Elf_Ehdr* ehdr) #if defined(SHN_XINDEX) static Elf_Word* -get_shndx_table(Elf_Ehdr* ehdr) +get_shndx_table(ObjectCode* oc) { + if (RTS_LIKELY(oc->shndx_table != SHNDX_TABLE_UNINIT)) { + return oc->shndx_table; + } + Elf_Word i; - char* ehdrC = (char*)ehdr; + char* ehdrC = oc->image; + Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC; Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); const Elf_Word shnum = elf_shnum(ehdr); for (i = 0; i < shnum; i++) { if (shdr[i].sh_type == SHT_SYMTAB_SHNDX) { - return (Elf32_Word*)(ehdrC + shdr[i].sh_offset); + oc->shndx_table = (Elf32_Word*)(ehdrC + shdr[i].sh_offset); + return oc->shndx_table; } } return NULL; @@ -193,6 +204,10 @@ ocInit_ELF(ObjectCode * oc) oc->n_sections = elf_shnum(oc->info->elfHeader); + ElfRelocationTable *relTableLast = NULL; + ElfRelocationATable *relaTableLast = NULL; + ElfSymbolTable *symbolTablesLast = NULL; + /* get the symbol table(s) */ for(int i=0; i < oc->n_sections; i++) { if(SHT_REL == oc->info->sectionHeader[i].sh_type) { @@ -210,12 +225,12 @@ ocInit_ELF(ObjectCode * oc) relTab->sectionHeader = &oc->info->sectionHeader[i]; - if(oc->info->relTable == NULL) { + if(relTableLast == NULL) { oc->info->relTable = relTab; + relTableLast = relTab; } else { - ElfRelocationTable * tail = oc->info->relTable; - while(tail->next != NULL) tail = tail->next; - tail->next = relTab; + relTableLast->next = relTab; + relTableLast = relTab; } } else if(SHT_RELA == oc->info->sectionHeader[i].sh_type) { @@ -233,12 +248,12 @@ ocInit_ELF(ObjectCode * oc) relTab->sectionHeader = &oc->info->sectionHeader[i]; - if(oc->info->relaTable == NULL) { + if(relaTableLast == NULL) { oc->info->relaTable = relTab; + relaTableLast = relTab; } else { - ElfRelocationATable * tail = oc->info->relaTable; - while(tail->next != NULL) tail = tail->next; - tail->next = relTab; + relaTableLast->next = relTab; + relaTableLast = relTab; } } else if(SHT_SYMTAB == oc->info->sectionHeader[i].sh_type) { @@ -279,12 +294,12 @@ ocInit_ELF(ObjectCode * oc) } /* append the ElfSymbolTable */ - if(oc->info->symbolTables == NULL) { + if(symbolTablesLast == NULL) { oc->info->symbolTables = symTab; + symbolTablesLast = symTab; } else { - ElfSymbolTable * tail = oc->info->symbolTables; - while(tail->next != NULL) tail = tail->next; - tail->next = symTab; + symbolTablesLast->next = symTab; + symbolTablesLast = symTab; } } } @@ -329,6 +344,9 @@ ocDeinit_ELF(ObjectCode * oc) stgFree(oc->info); oc->info = NULL; +#if defined(SHN_XINDEX) + oc->shndx_table = SHNDX_TABLE_UNINIT; +#endif } } @@ -532,7 +550,7 @@ ocVerifyImage_ELF ( ObjectCode* oc ) IF_DEBUG(linker_verbose,debugBelch(" no normal string tables (potentially, but not necessarily a problem)\n")); } #if defined(SHN_XINDEX) - Elf_Word* shndxTable = get_shndx_table(ehdr); + Elf_Word* shndxTable = get_shndx_table(oc); #endif nsymtabs = 0; IF_DEBUG(linker_verbose,debugBelch( "Symbol tables\n" )); @@ -683,7 +701,7 @@ ocGetNames_ELF ( ObjectCode* oc ) Elf_Shdr* shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff); Section * sections; #if defined(SHN_XINDEX) - Elf_Word* shndxTable = get_shndx_table(ehdr); + Elf_Word* shndxTable = get_shndx_table(oc); #endif const Elf_Word shnum = elf_shnum(ehdr); @@ -1251,7 +1269,11 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC, IF_DEBUG(linker_verbose, debugBelch("Reloc: P = %p S = %p A = %p type=%d\n", (void*)P, (void*)S, (void*)A, reloc_type )); +#if defined(DEBUG) checkProddableBlock ( oc, pP, sizeof(Elf_Word) ); +#else + (void) pP; /* suppress unused varialbe warning in non-debug build */ +#endif #if defined(i386_HOST_ARCH) value = S + A; @@ -1555,7 +1577,7 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, int strtab_shndx = shdr[symtab_shndx].sh_link; int target_shndx = shdr[shnum].sh_info; #if defined(SHN_XINDEX) - Elf_Word* shndx_table = get_shndx_table((Elf_Ehdr*)ehdrC); + Elf_Word* shndx_table = get_shndx_table(oc); #endif #if defined(DEBUG) || defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH) /* This #if def only serves to avoid unused-var warnings. */ @@ -1657,7 +1679,7 @@ do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC, IF_DEBUG(linker_verbose,debugBelch("`%s' resolves to %p\n", symbol, (void*)S)); } -#if defined(DEBUG) || defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH) +#if defined(DEBUG) IF_DEBUG(linker_verbose,debugBelch("Reloc: P = %p S = %p A = %p\n", (void*)P, (void*)S, (void*)A )); checkProddableBlock(oc, (void*)P, sizeof(Elf_Word)); @@ -1920,7 +1942,7 @@ ocResolve_ELF ( ObjectCode* oc ) const Elf_Word shnum = elf_shnum(ehdr); #if defined(SHN_XINDEX) - Elf_Word* shndxTable = get_shndx_table(ehdr); + Elf_Word* shndxTable = get_shndx_table(oc); #endif /* resolve section symbols View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b3e1436f968c0c36a27ea0339ee2554970b329fe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b3e1436f968c0c36a27ea0339ee2554970b329fe You're receiving 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 Jun 29 01:09:59 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 28 Jun 2023 21:09:59 -0400 Subject: [Git][ghc/ghc][master] 9 commits: compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE Message-ID: <649cd9e726502_3b5ae2181898f04137d9@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - 26 changed files: - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/StgToCmm/Prim.hs - rts/CloneStack.c - rts/PrimOps.cmm - rts/RaiseAsync.c - rts/RtsSymbols.c - rts/Sparks.c - rts/TopHandler.c - rts/include/Cmm.h - rts/include/Stg.h - rts/include/stg/SMP.h - rts/sm/Evac.c - rts/sm/GC.c - rts/sm/GCAux.c - rts/sm/MarkWeak.c - rts/sm/Sanity.c - testsuite/tests/rts/testwsdeque.c Changes: ===================================== compiler/GHC/Cmm/MachOp.hs ===================================== @@ -670,8 +670,6 @@ data CallishMachOp | MO_SubIntC Width | MO_U_Mul2 Width - | MO_ReadBarrier - | MO_WriteBarrier | MO_Touch -- Keep variables live (when using interior pointers) -- Prefetch @@ -701,6 +699,9 @@ data CallishMachOp | MO_BSwap Width | MO_BRev Width + | MO_AcquireFence + | MO_ReleaseFence + -- | Atomic read-modify-write. Arguments are @[dest, n]@. | MO_AtomicRMW Width AtomicMachOp -- | Atomic read. Arguments are @[addr]@. ===================================== compiler/GHC/Cmm/Parser.y ===================================== @@ -1117,8 +1117,11 @@ callishMachOps platform = listToUFM $ ( "fabs32f", (MO_F32_Fabs,) ), ( "sqrt32f", (MO_F32_Sqrt,) ), - ( "read_barrier", (MO_ReadBarrier,)), - ( "write_barrier", (MO_WriteBarrier,)), + -- TODO: It would be nice to rename the following operations to + -- acquire_fence and release_fence. Be aware that there'll be issues + -- with an overlapping token ('acquire') in the lexer. + ( "fence_acquire", (MO_AcquireFence,)), + ( "fence_release", (MO_ReleaseFence,)), ( "memcpy", memcpyLikeTweakArgs MO_Memcpy ), ( "memset", memcpyLikeTweakArgs MO_Memset ), ( "memmove", memcpyLikeTweakArgs MO_Memmove ), ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -1558,9 +1558,8 @@ genCCall target dest_regs arg_regs bid = do MO_U_Mul2 _w -> unsupported mop -- Memory Ordering - -- TODO DMBSY is probably *way* too much! - MO_ReadBarrier -> return (unitOL DMBSY, Nothing) - MO_WriteBarrier -> return (unitOL DMBSY, Nothing) + MO_AcquireFence -> return (unitOL DMBISH, Nothing) + MO_ReleaseFence -> return (unitOL DMBISH, Nothing) MO_Touch -> return (nilOL, Nothing) -- Keep variables live (when using interior pointers) -- Prefetch MO_Prefetch_Data _n -> return (nilOL, Nothing) -- Prefetch hint. ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -136,6 +136,7 @@ regUsageOfInstr platform instr = case instr of -- 8. Synchronization Instructions ------------------------------------------- DMBSY -> usage ([], []) + DMBISH -> usage ([], []) -- 9. Floating Point Instructions -------------------------------------------- FCVT dst src -> usage (regOp src, regOp dst) @@ -276,6 +277,7 @@ patchRegsOfInstr instr env = case instr of -- 8. Synchronization Instructions ----------------------------------------- DMBSY -> DMBSY + DMBISH -> DMBISH -- 9. Floating Point Instructions ------------------------------------------ FCVT o1 o2 -> FCVT (patchOp o1) (patchOp o2) @@ -645,6 +647,7 @@ data Instr -- 8. Synchronization Instructions ----------------------------------------- | DMBSY + | DMBISH -- 9. Floating Point Instructions -- Float ConVerT | FCVT Operand Operand @@ -724,6 +727,7 @@ instrCon i = BL{} -> "BL" BCOND{} -> "BCOND" DMBSY{} -> "DMBSY" + DMBISH{} -> "DMBISH" FCVT{} -> "FCVT" SCVTF{} -> "SCVTF" FCVTZS{} -> "FCVTZS" ===================================== compiler/GHC/CmmToAsm/AArch64/Ppr.hs ===================================== @@ -530,6 +530,7 @@ pprInstr platform instr = case instr of -- 8. Synchronization Instructions ------------------------------------------- DMBSY -> line $ text "\tdmb sy" + DMBISH -> line $ text "\tdmb ish" -- 9. Floating Point Instructions -------------------------------------------- FCVT o1 o2 -> op2 (text "\tfcvt") o1 o2 SCVTF o1 o2 -> op2 (text "\tscvtf") o1 o2 ===================================== compiler/GHC/CmmToAsm/PPC/CodeGen.hs ===================================== @@ -1126,9 +1126,9 @@ genCCall :: ForeignTarget -- function to call -> [CmmFormal] -- where to put the result -> [CmmActual] -- arguments (of mixed type) -> NatM InstrBlock -genCCall (PrimTarget MO_ReadBarrier) _ _ +genCCall (PrimTarget MO_AcquireFence) _ _ = return $ unitOL LWSYNC -genCCall (PrimTarget MO_WriteBarrier) _ _ +genCCall (PrimTarget MO_ReleaseFence) _ _ = return $ unitOL LWSYNC genCCall (PrimTarget MO_Touch) _ _ @@ -2094,8 +2094,8 @@ genCCall' config gcp target dest_regs args MO_AddIntC {} -> unsupported MO_SubIntC {} -> unsupported MO_U_Mul2 {} -> unsupported - MO_ReadBarrier -> unsupported - MO_WriteBarrier -> unsupported + MO_AcquireFence -> unsupported + MO_ReleaseFence -> unsupported MO_Touch -> unsupported MO_Prefetch_Data _ -> unsupported unsupported = panic ("outOfLineCmmOp: " ++ show mop ===================================== compiler/GHC/CmmToAsm/Wasm/FromCmm.hs ===================================== @@ -1186,8 +1186,8 @@ lower_CallishMachOp lbl MO_F32_ExpM1 rs xs = lower_CallishMachOp lbl MO_F32_Fabs rs xs = lower_CMO_Un_Homo lbl "fabsf" rs xs lower_CallishMachOp lbl MO_F32_Sqrt rs xs = lower_CMO_Un_Homo lbl "sqrtf" rs xs lower_CallishMachOp lbl (MO_UF_Conv w0) rs xs = lower_MO_UF_Conv lbl w0 rs xs -lower_CallishMachOp _ MO_ReadBarrier _ _ = pure $ WasmStatements WasmNop -lower_CallishMachOp _ MO_WriteBarrier _ _ = pure $ WasmStatements WasmNop +lower_CallishMachOp _ MO_AcquireFence _ _ = pure $ WasmStatements WasmNop +lower_CallishMachOp _ MO_ReleaseFence _ _ = pure $ WasmStatements WasmNop lower_CallishMachOp _ MO_Touch _ _ = pure $ WasmStatements WasmNop lower_CallishMachOp _ (MO_Prefetch_Data {}) _ _ = pure $ WasmStatements WasmNop lower_CallishMachOp lbl (MO_Memcpy {}) [] xs = do ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -2160,8 +2160,8 @@ genSimplePrim bid (MO_Memcpy align) [] [dst,src,n] = genMemCpy bid a genSimplePrim bid (MO_Memmove align) [] [dst,src,n] = genMemMove bid align dst src n genSimplePrim bid (MO_Memcmp align) [res] [dst,src,n] = genMemCmp bid align res dst src n genSimplePrim bid (MO_Memset align) [] [dst,c,n] = genMemSet bid align dst c n -genSimplePrim _ MO_ReadBarrier [] [] = return nilOL -- barriers compile to no code on x86/x86-64; -genSimplePrim _ MO_WriteBarrier [] [] = return nilOL -- we keep it this long in order to prevent earlier optimisations. +genSimplePrim _ MO_AcquireFence [] [] = return nilOL -- barriers compile to no code on x86/x86-64; +genSimplePrim _ MO_ReleaseFence [] [] = return nilOL -- we keep it this long in order to prevent earlier optimisations. genSimplePrim _ MO_Touch [] [_] = return nilOL genSimplePrim _ (MO_Prefetch_Data n) [] [src] = genPrefetchData n src genSimplePrim _ (MO_BSwap width) [dst] [src] = genByteSwap width dst src ===================================== compiler/GHC/CmmToC.hs ===================================== @@ -261,6 +261,11 @@ pprStmt platform stmt = CmmUnsafeForeignCall (PrimTarget MO_Touch) _results _args -> empty CmmUnsafeForeignCall (PrimTarget (MO_Prefetch_Data _)) _results _args -> empty + CmmUnsafeForeignCall (PrimTarget MO_ReleaseFence) [] [] -> + text "__atomic_thread_fence(__ATOMIC_RELEASE);" + CmmUnsafeForeignCall (PrimTarget MO_AcquireFence) [] [] -> + text "__atomic_thread_fence(__ATOMIC_ACQUIRE);" + CmmUnsafeForeignCall target@(PrimTarget op) results args -> fn_call where @@ -944,8 +949,8 @@ pprCallishMachOp_for_C mop MO_F32_ExpM1 -> text "expm1f" MO_F32_Sqrt -> text "sqrtf" MO_F32_Fabs -> text "fabsf" - MO_ReadBarrier -> text "load_load_barrier" - MO_WriteBarrier -> text "write_barrier" + MO_AcquireFence -> unsupported + MO_ReleaseFence -> unsupported MO_Memcpy _ -> text "__builtin_memcpy" MO_Memset _ -> text "__builtin_memset" MO_Memmove _ -> text "__builtin_memmove" ===================================== compiler/GHC/CmmToLlvm/CodeGen.hs ===================================== @@ -171,34 +171,15 @@ getInstrinct fname retTy parTys = fty = LMFunction funSig in getInstrinct2 fname fty --- | Memory barrier instruction for LLVM >= 3.0 -barrier :: LlvmM StmtData -barrier = do - let s = Fence False SyncSeqCst - return (unitOL s, []) - --- | Insert a 'barrier', unless the target platform is in the provided list of --- exceptions (where no code will be emitted instead). -barrierUnless :: [Arch] -> LlvmM StmtData -barrierUnless exs = do - platform <- getPlatform - if platformArch platform `elem` exs - then return (nilOL, []) - else barrier - -- | Foreign Calls genCall :: ForeignTarget -> [CmmFormal] -> [CmmActual] -> LlvmM StmtData -- Barriers need to be handled specially as they are implemented as LLVM -- intrinsic functions. -genCall (PrimTarget MO_ReadBarrier) _ _ = - barrierUnless [ArchX86, ArchX86_64] - -genCall (PrimTarget MO_WriteBarrier) _ _ = - barrierUnless [ArchX86, ArchX86_64] - -genCall (PrimTarget MO_Touch) _ _ = - return (nilOL, []) +genCall (PrimTarget MO_AcquireFence) _ _ = runStmtsDecls $ + statement $ Fence False SyncAcquire +genCall (PrimTarget MO_ReleaseFence) _ _ = runStmtsDecls $ + statement $ Fence False SyncRelease genCall (PrimTarget (MO_UF_Conv w)) [dst] [e] = runStmtsDecls $ do dstV <- getCmmRegW (CmmLocal dst) @@ -1008,8 +989,8 @@ cmmPrimOpFunctions mop = do -- We support MO_U_Mul2 through ordinary LLVM mul instruction, see the -- appropriate case of genCall. MO_U_Mul2 {} -> unsupported - MO_ReadBarrier -> unsupported - MO_WriteBarrier -> unsupported + MO_ReleaseFence -> unsupported + MO_AcquireFence -> unsupported MO_Touch -> unsupported MO_UF_Conv _ -> unsupported ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -2177,7 +2177,7 @@ doWritePtrArrayOp addr idx val -- This write barrier is to ensure that the heap writes to the object -- referred to by val have happened before we write val into the array. -- See #12469 for details. - emitPrimCall [] MO_WriteBarrier [] + emitPrimCall [] MO_ReleaseFence [] mkBasicIndexedWrite hdr_size addr ty idx val emit (setInfo addr (CmmLit (CmmLabel mkMAP_DIRTY_infoLabel))) @@ -3048,7 +3048,7 @@ doWriteSmallPtrArrayOp addr idx val = do mkBasicIndexedRead NaturallyAligned (smallArrPtrsHdrSize profile) Nothing ty tmp addr ty idx whenUpdRemSetEnabled $ emitUpdRemSetPush (CmmReg (CmmLocal tmp)) - emitPrimCall [] MO_WriteBarrier [] -- #12469 + emitPrimCall [] MO_ReleaseFence [] -- #12469 mkBasicIndexedWrite (smallArrPtrsHdrSize profile) addr ty idx val emit (setInfo addr (CmmLit (CmmLabel mkSMAP_DIRTY_infoLabel))) ===================================== rts/CloneStack.c ===================================== @@ -74,9 +74,7 @@ void sendCloneStackMessage(StgTSO *tso, HsStablePtr mvar) { msg = (MessageCloneStack *)allocate(srcCapability, sizeofW(MessageCloneStack)); msg->tso = tso; msg->result = (StgMVar*)deRefStablePtr(mvar); - SET_HDR(msg, &stg_MSG_CLONE_STACK_info, CCS_SYSTEM); - // Ensure that writes constructing Message are committed before sending. - write_barrier(); + SET_HDR_RELEASE(msg, &stg_MSG_CLONE_STACK_info, CCS_SYSTEM); sendMessage(srcCapability, tso->cap, (Message *)msg); } ===================================== rts/PrimOps.cmm ===================================== @@ -2505,8 +2505,8 @@ stg_unpackClosurezh ( P_ closure ) { W_ info, ptrs, nptrs, p, ptrs_arr, dat_arr; MAYBE_GC_P(stg_unpackClosurezh, closure); - info = %GET_STD_INFO(UNTAG(closure)); - prim_read_barrier; + info = GET_INFO_ACQUIRE(UNTAG(closure)); + info = %STD_INFO(info); ptrs = TO_W_(%INFO_PTRS(info)); nptrs = TO_W_(%INFO_NPTRS(info)); @@ -2820,8 +2820,7 @@ stg_noDuplicatezh /* no arg list: explicit stack layout */ stg_getApStackValzh ( P_ ap_stack, W_ offset ) { W_ ap_stackinfo; - ap_stackinfo = %INFO_PTR(UNTAG(ap_stack)); - prim_read_barrier; + ap_stackinfo = GET_INFO_ACQUIRE(UNTAG(ap_stack)); if (ap_stackinfo == stg_AP_STACK_info) { return (1,StgAP_STACK_payload(ap_stack,offset)); } else { ===================================== rts/RaiseAsync.c ===================================== @@ -238,7 +238,7 @@ throwToMsg (Capability *cap, MessageThrowTo *msg) goto check_target; retry: - write_barrier(); + RELEASE_FENCE(); debugTrace(DEBUG_sched, "throwTo: retrying..."); check_target: @@ -874,9 +874,10 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception, ap->payload[i] = (StgClosure *)*sp++; } - write_barrier(); // XXX: Necessary? SET_HDR(ap,&stg_AP_STACK_info, ((StgClosure *)frame)->header.prof.ccs /* ToDo */); + // N.B. This will be made visible by updateThunk below, which + // implies a release memory barrier. TICK_ALLOC_UP_THK(AP_STACK_sizeW(words),0); //IF_DEBUG(scheduler, ===================================== rts/RtsSymbols.c ===================================== @@ -929,9 +929,6 @@ extern char **environ; SymI_HasProto(hs_spt_remove) \ SymI_HasProto(hs_spt_keys) \ SymI_HasProto(hs_spt_key_count) \ - SymI_HasProto(write_barrier) \ - SymI_HasProto(store_load_barrier) \ - SymI_HasProto(load_load_barrier) \ SymI_HasProto(cas) \ SymI_HasProto(_assertFail) \ SymI_HasProto(keepCAFs) \ ===================================== rts/Sparks.c ===================================== @@ -209,8 +209,7 @@ pruneSparkQueue (bool nonmovingMarkFinished, Capability *cap) cap->spark_stats.fizzled++; traceEventSparkFizzle(cap); } else { - info = RELAXED_LOAD(&spark->header.info); - load_load_barrier(); + info = ACQUIRE_LOAD(&spark->header.info); if (IS_FORWARDING_PTR(info)) { tmp = (StgClosure*)UN_FORWARDING_PTR(info); /* if valuable work: shift inside the pool */ ===================================== rts/TopHandler.c ===================================== @@ -32,8 +32,7 @@ StgTSO *getTopHandlerThread(void) { // topHandlerPtr was never initialised return NULL; } - const StgInfoTable *info = weak->header.info; - load_load_barrier(); + const StgInfoTable *info = ACQUIRE_LOAD(&weak->header.info); if (info == &stg_WEAK_info) { StgClosure *key = ((StgWeak*)weak)->key; ===================================== rts/include/Cmm.h ===================================== @@ -677,21 +677,18 @@ * explicit ordered accesses to make ordering apparent to TSAN. */ -// Memory barriers. +// Memory barriers // For discussion of how these are used to fence heap object // accesses see Note [Heap memory barriers] in SMP.h. #if defined(THREADED_RTS) -#define prim_read_barrier prim %read_barrier() #define prim_write_barrier prim %write_barrier() // See Note [ThreadSanitizer and fences] -#define RELEASE_FENCE prim %write_barrier() -#define ACQUIRE_FENCE prim %read_barrier() +#define RELEASE_FENCE prim %fence_release(); +#define ACQUIRE_FENCE prim %fence_acquire(); #else -#define prim_read_barrier /* nothing */ -#define prim_write_barrier /* nothing */ #define RELEASE_FENCE /* nothing */ #define ACQUIRE_FENCE /* nothing */ #endif /* THREADED_RTS */ ===================================== rts/include/Stg.h ===================================== @@ -392,7 +392,7 @@ external prototype return neither of these types to workaround #11395. #endif #include "stg/Prim.h" /* ghc-prim fallbacks */ -#include "stg/SMP.h" // write_barrier() inline is required +#include "stg/SMP.h" /* ----------------------------------------------------------------------------- Moving Floats and Doubles ===================================== rts/include/stg/SMP.h ===================================== @@ -44,11 +44,6 @@ void arm_atomic_spin_unlock(void); ------------------------------------------------------------------------- */ #if !IN_STG_CODE || IN_STGCRUN -// We only want the barriers, e.g. write_barrier(), declared in .hc -// files. Defining the other inline functions here causes type -// mismatch errors from gcc, because the generated C code is assuming -// that there are no prototypes in scope. - /* * The atomic exchange operation: xchg(p,w) exchanges the value * pointed to by p with the value w, returning the old value. @@ -105,24 +100,6 @@ EXTERN_INLINE void busy_wait_nop(void); #endif // !IN_STG_CODE -/* - * Various kinds of memory barrier. - * write_barrier: prevents future stores occurring before preceding stores. - * store_load_barrier: prevents future loads occurring before preceding stores. - * load_load_barrier: prevents future loads occurring before earlier loads. - * - * Reference for these: "The JSR-133 Cookbook for Compiler Writers" - * http://gee.cs.oswego.edu/dl/jmm/cookbook.html - * - * To check whether you got these right, try the test in - * testsuite/tests/rts/testwsdeque.c - * This tests the work-stealing deque implementation, which relies on - * properly working store_load and load_load memory barriers. - */ -EXTERN_INLINE void write_barrier(void); -EXTERN_INLINE void store_load_barrier(void); -EXTERN_INLINE void load_load_barrier(void); - /* * Note [Heap memory barriers] * ~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -354,7 +331,7 @@ EXTERN_INLINE void load_load_barrier(void); * Exchange the value pointed to by p with w and return the former. This * function is used to acquire a lock. An acquire memory barrier is sufficient * for a lock operation because corresponding unlock operation issues a - * store-store barrier (write_barrier()) immediately before releasing the lock. + * store-store barrier (release-store) immediately before releasing the lock. */ EXTERN_INLINE StgWord xchg(StgPtr p, StgWord w) @@ -463,91 +440,6 @@ busy_wait_nop(void) #endif // !IN_STG_CODE -/* - * We need to tell both the compiler AND the CPU about the barriers. - * It's no good preventing the CPU from reordering the operations if - * the compiler has already done so - hence the "memory" restriction - * on each of the barriers below. - */ -EXTERN_INLINE void -write_barrier(void) { -#if defined(NOSMP) - return; -#elif defined(TSAN_ENABLED) - // RELEASE is a bit stronger than the store-store barrier provided by - // write_barrier, consequently we only use this case as a conservative - // approximation when using ThreadSanitizer. See Note [ThreadSanitizer]. - __atomic_thread_fence(__ATOMIC_RELEASE); -#elif defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) \ - || defined(powerpc64le_HOST_ARCH) - __asm__ __volatile__ ("lwsync" : : : "memory"); -#elif defined(s390x_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH) - __asm__ __volatile__ ("dmb st" : : : "memory"); -#elif defined(riscv64_HOST_ARCH) - __asm__ __volatile__ ("fence w,w" : : : "memory"); -#elif defined(loongarch64_HOST_ARCH) - __asm__ __volatile__ ("dbar 0" : : : "memory"); -#else -#error memory barriers unimplemented on this architecture -#endif -} - -EXTERN_INLINE void -store_load_barrier(void) { -#if defined(NOSMP) - return; -#elif defined(i386_HOST_ARCH) - __asm__ __volatile__ ("lock; addl $0,0(%%esp)" : : : "memory"); -#elif defined(x86_64_HOST_ARCH) - __asm__ __volatile__ ("lock; addq $0,0(%%rsp)" : : : "memory"); -#elif defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) \ - || defined(powerpc64le_HOST_ARCH) - __asm__ __volatile__ ("sync" : : : "memory"); -#elif defined(s390x_HOST_ARCH) - __asm__ __volatile__ ("bcr 14,0" : : : "memory"); -#elif defined(arm_HOST_ARCH) - __asm__ __volatile__ ("dmb" : : : "memory"); -#elif defined(aarch64_HOST_ARCH) - __asm__ __volatile__ ("dmb sy" : : : "memory"); -#elif defined(riscv64_HOST_ARCH) - __asm__ __volatile__ ("fence w,r" : : : "memory"); -#elif defined(loongarch64_HOST_ARCH) - __asm__ __volatile__ ("dbar 0" : : : "memory"); -#else -#error memory barriers unimplemented on this architecture -#endif -} - -EXTERN_INLINE void -load_load_barrier(void) { -#if defined(NOSMP) - return; -#elif defined(i386_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(x86_64_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) \ - || defined(powerpc64le_HOST_ARCH) - __asm__ __volatile__ ("lwsync" : : : "memory"); -#elif defined(s390x_HOST_ARCH) - __asm__ __volatile__ ("" : : : "memory"); -#elif defined(arm_HOST_ARCH) - __asm__ __volatile__ ("dmb" : : : "memory"); -#elif defined(aarch64_HOST_ARCH) - __asm__ __volatile__ ("dmb ld" : : : "memory"); -#elif defined(riscv64_HOST_ARCH) - __asm__ __volatile__ ("fence r,r" : : : "memory"); -#elif defined(loongarch64_HOST_ARCH) - __asm__ __volatile__ ("dbar 0" : : : "memory"); -#else -#error memory barriers unimplemented on this architecture -#endif -} - // Load a pointer from a memory location that might be being modified // concurrently. This prevents the compiler from optimising away // multiple loads of the memory location, as it might otherwise do in @@ -586,13 +478,6 @@ load_load_barrier(void) { /* ---------------------------------------------------------------------- */ #else /* !THREADED_RTS */ -EXTERN_INLINE void write_barrier(void); -EXTERN_INLINE void store_load_barrier(void); -EXTERN_INLINE void load_load_barrier(void); -EXTERN_INLINE void write_barrier (void) {} /* nothing */ -EXTERN_INLINE void store_load_barrier(void) {} /* nothing */ -EXTERN_INLINE void load_load_barrier (void) {} /* nothing */ - // Relaxed atomic operations #define RELAXED_LOAD(ptr) *ptr #define RELAXED_STORE(ptr,val) *ptr = val ===================================== rts/sm/Evac.c ===================================== @@ -1394,8 +1394,7 @@ selector_loop: // the same selector thunk. SET_INFO((StgClosure*)p, (StgInfoTable *)info_ptr); OVERWRITING_CLOSURE((StgClosure*)p); - SET_INFO((StgClosure*)p, &stg_WHITEHOLE_info); - write_barrier(); + SET_INFO_RELEASE((StgClosure*)p, &stg_WHITEHOLE_info); #if defined(PARALLEL_GC) abort(); // LDV is incompatible with parallel GC #endif ===================================== rts/sm/GC.c ===================================== @@ -1508,7 +1508,6 @@ waitForGcThreads (Capability *cap, bool idle_cap[]) if (i == me || idle_cap[i]) { continue; } if (SEQ_CST_LOAD(&gc_threads[i]->wakeup) != GC_THREAD_STANDING_BY) { prodCapability(getCapability(i), cap->running_task); - write_barrier(); interruptCapability(getCapability(i)); } } ===================================== rts/sm/GCAux.c ===================================== @@ -91,8 +91,8 @@ isAlive(StgClosure *p) return TAG_CLOSURE(tag,(StgClosure*)UN_FORWARDING_PTR(info)); } + info = ACQUIRE_LOAD(&q->header.info); info = INFO_PTR_TO_STRUCT(info); - load_load_barrier(); switch (info->type) { ===================================== rts/sm/MarkWeak.c ===================================== @@ -457,7 +457,7 @@ static void checkWeakPtrSanity(StgWeak *hd, StgWeak *tl) * 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() +void collectFreshWeakPtrs( void ) { uint32_t i; // move recently allocated weak_ptr_list to the old list as well ===================================== rts/sm/Sanity.c ===================================== @@ -355,8 +355,7 @@ checkClosure( const StgClosure* p ) p = UNTAG_CONST_CLOSURE(p); - info = p->header.info; - load_load_barrier(); + info = ACQUIRE_LOAD(&p->header.info); if (IS_FORWARDING_PTR(info)) { barf("checkClosure: found EVACUATED closure %d", info->type); @@ -367,7 +366,6 @@ checkClosure( const StgClosure* p ) #endif info = INFO_PTR_TO_STRUCT(info); - load_load_barrier(); switch (info->type) { @@ -772,8 +770,7 @@ checkSTACK (StgStack *stack) void checkTSO(StgTSO *tso) { - const StgInfoTable *info = (const StgInfoTable*) tso->_link->header.info; - load_load_barrier(); + const StgInfoTable *info = (const StgInfoTable*) ACQUIRE_LOAD(&tso->_link)->header.info; ASSERT(tso->_link == END_TSO_QUEUE || info == &stg_MVAR_TSO_QUEUE_info || ===================================== testsuite/tests/rts/testwsdeque.c ===================================== @@ -34,47 +34,25 @@ void * myStealWSDeque_ (WSDeque *q, uint32_t n) { void * stolen; - StgWord b,t; // Can't do this on someone else's spark pool: // ASSERT_WSDEQUE_INVARIANTS(q); // NB. these loads must be ordered, otherwise there is a race // between steal and pop. - t = q->top; - load_load_barrier(); - b = q->bottom; + StgWord t = ACQUIRE_LOAD(&q->top); + SEQ_CST_FENCE(); + StgWord b = ACQUIRE_LOAD(&q->bottom); - // NB. b and t are unsigned; we need a signed value for the test - // below, because it is possible that t > b during a - // concurrent popWSQueue() operation. - if ((long)b - (long)t <= 0 ) { - return NULL; /* already looks empty, abort */ + void *result = NULL; + if (t < b) { + /* Non-empty queue */ + result = RELAXED_LOAD(&q->elements[t % q->size]); + if (!cas_top(q, t, t+1)) { + return NULL; + } } - // NB. the load of q->bottom must be ordered before the load of - // q->elements[t & q-> moduloSize]. See comment "KG:..." below - // and Ticket #13633. - load_load_barrier(); - /* now access array, see pushBottom() */ - stolen = q->elements[t & q->moduloSize]; - - /* now decide whether we have won */ - if ( !(CASTOP(&(q->top),t,t+1)) ) { - /* lost the race, someone else has changed top in the meantime */ - return NULL; - } /* else: OK, top has been incremented by the cas call */ - - // debugBelch("stealWSDeque_: t=%d b=%d\n", t, b); - -// Can't do this on someone else's spark pool: -// ASSERT_WSDEQUE_INVARIANTS(q); - - bufs[n] ++; - if (bufs[n] == BUF) { bufs[n] = 0; } - last_b[n][bufs[n]] = b; - last_t[n][bufs[n]] = t; - last_v[n][bufs[n]] = (StgWord)stolen; - return stolen; + return result; } void * View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b3e1436f968c0c36a27ea0339ee2554970b329fe...bb0ed354b9b05c0774c1e9379823bceb785987ce -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b3e1436f968c0c36a27ea0339ee2554970b329fe...bb0ed354b9b05c0774c1e9379823bceb785987ce You're receiving 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 Jun 29 01:10:27 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 28 Jun 2023 21:10:27 -0400 Subject: [Git][ghc/ghc][master] Fix number of free double regs Message-ID: <649cda03ccba9_3b5ae21869bca8417487@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - 1 changed file: - compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs Changes: ===================================== compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs ===================================== @@ -102,7 +102,8 @@ trivColorable -> Triv VirtualReg RegClass RealReg trivColorable platform virtualRegSqueeze realRegSqueeze RcInteger conflicts exclusions - | let cALLOCATABLE_REGS_INTEGER + | -- Allocatable are all regs of this class, where freeReg == True (MachRegs.h) + let cALLOCATABLE_REGS_INTEGER = (case platformArch platform of ArchX86 -> 3 ArchX86_64 -> 5 @@ -110,6 +111,9 @@ trivColorable platform virtualRegSqueeze realRegSqueeze RcInteger conflicts excl ArchPPC_64 _ -> 15 ArchARM _ _ _ -> panic "trivColorable ArchARM" -- N.B. x18 is reserved by the platform on AArch64/Darwin + -- 32 - Base - Sp - Hp - R1..R6 - SpLim - IP0 - SP - LR - FP - X18 + -- -> 32 - 15 = 17 + -- (one stack pointer for Haskell, one for C) ArchAArch64 -> 17 ArchAlpha -> panic "trivColorable ArchAlpha" ArchMipseb -> panic "trivColorable ArchMipseb" @@ -179,7 +183,7 @@ trivColorable platform virtualRegSqueeze realRegSqueeze RcDouble conflicts exclu ArchPPC -> 26 ArchPPC_64 _ -> 20 ArchARM _ _ _ -> panic "trivColorable ArchARM" - ArchAArch64 -> 32 + ArchAArch64 -> 28 -- 32 - D1..D4 ArchAlpha -> panic "trivColorable ArchAlpha" ArchMipseb -> panic "trivColorable ArchMipseb" ArchMipsel -> panic "trivColorable ArchMipsel" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ef81a1eba9da35be84cd56bd84f6402c929d1d0c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ef81a1eba9da35be84cd56bd84f6402c929d1d0c You're receiving 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 Jun 29 01:11:05 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 28 Jun 2023 21:11:05 -0400 Subject: [Git][ghc/ghc][master] Fix typechecking of promoted empty lists Message-ID: <649cda291485e_3b5ae21854eddc422677@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - 7 changed files: - compiler/GHC/Tc/Gen/HsType.hs - testsuite/tests/ghci/scripts/T15898.stderr - testsuite/tests/ghci/scripts/T6018ghcifail.stderr - testsuite/tests/ghci/scripts/T7939.stdout - + testsuite/tests/typecheck/should_compile/T23543.hs - testsuite/tests/typecheck/should_compile/all.T - testsuite/tests/typecheck/should_fail/T6018fail.stderr Changes: ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -1253,6 +1253,12 @@ tc_hs_type mode rn_ty@(HsSumTy _ hs_tys) exp_kind --------- Promoted lists and tuples tc_hs_type mode rn_ty@(HsExplicitListTy _ _ tys) exp_kind + -- The '[] case is handled in tc_infer_hs_type. + -- See Note [Future-proofing the type checker]. + | null tys + = tc_infer_hs_type_ek mode rn_ty exp_kind + + | otherwise = do { tks <- mapM (tc_infer_lhs_type mode) tys ; (taus', kind) <- unifyKinds tys tks ; let ty = (foldr (mk_cons kind) (mk_nil kind) taus') ===================================== testsuite/tests/ghci/scripts/T15898.stderr ===================================== @@ -18,7 +18,7 @@ In an equation for ‘it’: it = undefined :: [(), ()] :6:14: error: [GHC-83865] - • Expected a type, but ‘'( '[], '[])’ has kind ‘([k0], [k1])’ + • Expected a type, but ‘'( '[], '[])’ has kind ‘([a0], [a1])’ • In an expression type signature: '( '[], '[]) In the expression: undefined :: '( '[], '[]) In an equation for ‘it’: it = undefined :: '( '[], '[]) ===================================== testsuite/tests/ghci/scripts/T6018ghcifail.stderr ===================================== @@ -41,18 +41,18 @@ :55:41: error: [GHC-05175] Type family equation violates the family's injectivity annotation. - Type/kind variable ‘k1’ + Type/kind variable ‘a1’ cannot be inferred from the right-hand side. In the type family equation: - PolyKindVarsF @{[k1]} @[k2] ('[] @k1) = '[] @k2 + PolyKindVarsF @{[a1]} @[a2] ('[] @a1) = '[] @a2 -- Defined at :55:41 :60:15: error: [GHC-05175] Type family equation violates the family's injectivity annotation. - Type/kind variable ‘k1’ + Type/kind variable ‘a1’ cannot be inferred from the right-hand side. In the type family equation: - PolyKindVars @[k1] @[k2] ('[] @k1) = '[] @k2 + PolyKindVars @[a1] @[a2] ('[] @a1) = '[] @a2 -- Defined at :60:15 :64:15: error: [GHC-05175] ===================================== testsuite/tests/ghci/scripts/T7939.stdout ===================================== @@ -19,12 +19,12 @@ type family H a where H False = True -- Defined at T7939.hs:15:1 H :: Bool -> Bool -type J :: forall {k}. [k] -> Bool -type family J a where +type J :: forall {a}. [a] -> Bool +type family J a1 where J '[] = False - forall k (h :: k) (t :: [k]). J (h : t) = True + forall a (h :: a) (t :: [a]). J (h : t) = True -- Defined at T7939.hs:18:1 -J :: [k] -> Bool +J :: [a] -> Bool type K :: forall {a}. [a] -> Maybe a type family K a1 where K '[] = Nothing ===================================== testsuite/tests/typecheck/should_compile/T23543.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +module T23543 where + +type N :: forall a. Maybe a +type N = ('Nothing :: forall a. Maybe a) + +type L :: forall a. [a] +type L = ('[] :: forall a. [a]) ===================================== testsuite/tests/typecheck/should_compile/all.T ===================================== @@ -875,6 +875,7 @@ test('T23171', normal, compile, ['']) test('T23192', normal, compile, ['']) test('T23199', normal, compile, ['']) test('T23156', normal, compile, ['']) +test('T23543', normal, compile, ['']) test('T22560a', normal, compile, ['']) test('T22560b', normal, compile, ['']) test('T22560c', normal, compile, ['']) ===================================== testsuite/tests/typecheck/should_fail/T6018fail.stderr ===================================== @@ -52,18 +52,18 @@ T6018fail.hs:53:15: error: [GHC-05175] T6018fail.hs:61:10: error: [GHC-05175] Type family equation violates the family's injectivity annotation. - Type/kind variable ‘k1’ + Type/kind variable ‘a1’ cannot be inferred from the right-hand side. In the type family equation: - PolyKindVarsF @{[k1]} @[k2] ('[] @k1) = '[] @k2 + PolyKindVarsF @{[a1]} @[a2] ('[] @a1) = '[] @a2 -- Defined at T6018fail.hs:61:10 T6018fail.hs:64:15: error: [GHC-05175] Type family equation violates the family's injectivity annotation. - Type/kind variable ‘k1’ + Type/kind variable ‘a1’ cannot be inferred from the right-hand side. In the type family equation: - PolyKindVars @[k1] @[k2] ('[] @k1) = '[] @k2 + PolyKindVars @[a1] @[a2] ('[] @a1) = '[] @a2 -- Defined at T6018fail.hs:64:15 T6018fail.hs:68:15: error: [GHC-05175] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c335fb7c44a8447b3e73e7f18d9d0dcb18cea8dd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c335fb7c44a8447b3e73e7f18d9d0dcb18cea8dd You're receiving 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 Jun 29 01:11:41 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 28 Jun 2023 21:11:41 -0400 Subject: [Git][ghc/ghc][master] Configure MergeObjs supports response files rather than Ld Message-ID: <649cda4d993fc_3b5ae21875de484278b8@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 11 changed files: - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - distrib/configure.ac.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Rules/Generate.hs - − m4/fp_ld_supports_response_files.m4 - + m4/fp_merge_objects_supports_response_files.m4 Changes: ===================================== compiler/GHC/Settings.hs ===================================== @@ -19,7 +19,7 @@ module GHC.Settings , sGlobalPackageDatabasePath , sLdSupportsCompactUnwind , sLdSupportsFilelist - , sLdSupportsResponseFiles + , sMergeObjsSupportsResponseFiles , sLdIsGnuLd , sGccSupportsNoPie , sUseInplaceMinGW @@ -89,7 +89,7 @@ data Settings = Settings data ToolSettings = ToolSettings { toolSettings_ldSupportsCompactUnwind :: Bool , toolSettings_ldSupportsFilelist :: Bool - , toolSettings_ldSupportsResponseFiles :: Bool + , toolSettings_mergeObjsSupportsResponseFiles :: Bool , toolSettings_ldIsGnuLd :: Bool , toolSettings_ccSupportsNoPie :: Bool , toolSettings_useInplaceMinGW :: Bool @@ -195,8 +195,8 @@ sLdSupportsCompactUnwind :: Settings -> Bool sLdSupportsCompactUnwind = toolSettings_ldSupportsCompactUnwind . sToolSettings sLdSupportsFilelist :: Settings -> Bool sLdSupportsFilelist = toolSettings_ldSupportsFilelist . sToolSettings -sLdSupportsResponseFiles :: Settings -> Bool -sLdSupportsResponseFiles = toolSettings_ldSupportsResponseFiles . sToolSettings +sMergeObjsSupportsResponseFiles :: Settings -> Bool +sMergeObjsSupportsResponseFiles = toolSettings_mergeObjsSupportsResponseFiles . sToolSettings sLdIsGnuLd :: Settings -> Bool sLdIsGnuLd = toolSettings_ldIsGnuLd . sToolSettings sGccSupportsNoPie :: Settings -> Bool ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -107,7 +107,7 @@ initSettings top_dir = do ldSupportsCompactUnwind <- getBooleanSetting "ld supports compact unwind" ldSupportsFilelist <- getBooleanSetting "ld supports filelist" - ldSupportsResponseFiles <- getBooleanSetting "ld supports response files" + mergeObjsSupportsResponseFiles <- getBooleanSetting "Merge objects supports response files" ldIsGnuLd <- getBooleanSetting "ld is GNU ld" arSupportsDashL <- getBooleanSetting "ar supports -L" @@ -175,7 +175,7 @@ initSettings top_dir = do , sToolSettings = ToolSettings { toolSettings_ldSupportsCompactUnwind = ldSupportsCompactUnwind , toolSettings_ldSupportsFilelist = ldSupportsFilelist - , toolSettings_ldSupportsResponseFiles = ldSupportsResponseFiles + , toolSettings_mergeObjsSupportsResponseFiles = mergeObjsSupportsResponseFiles , toolSettings_ldIsGnuLd = ldIsGnuLd , toolSettings_ccSupportsNoPie = gccSupportsNoPie , toolSettings_useInplaceMinGW = useInplaceMinGW ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -363,7 +363,7 @@ runMergeObjects logger tmpfs dflags args = , "does not support object merging." ] optl_args = map Option (getOpts dflags opt_lm) args2 = args0 ++ args ++ optl_args - if toolSettings_ldSupportsResponseFiles (toolSettings dflags) + if toolSettings_mergeObjsSupportsResponseFiles (toolSettings dflags) then do mb_env <- getGccEnv args2 runSomethingResponseFile logger tmpfs dflags id "Merge objects" p args2 mb_env ===================================== configure.ac ===================================== @@ -646,7 +646,7 @@ 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]) -FP_LD_SUPPORTS_RESPONSE_FILES +FP_MERGE_OBJECTS_SUPPORTS_RESPONSE_FILES GHC_LLVM_TARGET_SET_VAR # we intend to pass trough --targets to llvm as is. ===================================== distrib/configure.ac.in ===================================== @@ -174,7 +174,7 @@ 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]) -FP_LD_SUPPORTS_RESPONSE_FILES +FP_MERGE_OBJECTS_SUPPORTS_RESPONSE_FILES AC_SUBST(CONF_CC_OPTS_STAGE0) AC_SUBST(CONF_CC_OPTS_STAGE1) ===================================== hadrian/bindist/Makefile ===================================== @@ -91,10 +91,10 @@ lib/settings : config.mk @echo ',("Haskell CPP flags", "$(SettingsHaskellCPPFlags)")' >> $@ @echo ',("ld supports compact unwind", "$(LdHasNoCompactUnwind)")' >> $@ @echo ',("ld supports filelist", "$(LdHasFilelist)")' >> $@ - @echo ',("ld supports response files", "$(LdSupportsResponseFiles)")' >> $@ @echo ',("ld is GNU ld", "$(LdIsGNULd)")' >> $@ @echo ',("Merge objects command", "$(SettingsMergeObjectsCommand)")' >> $@ @echo ',("Merge objects flags", "$(SettingsMergeObjectsFlags)")' >> $@ + @echo ',("Merge objects supports response files", "$(MergeObjsSupportsResponseFiles)")' >> $@ @echo ',("ar command", "$(SettingsArCommand)")' >> $@ @echo ',("ar flags", "$(ArArgs)")' >> $@ @echo ',("ar supports at file", "$(ArSupportsAtFile)")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -235,7 +235,7 @@ GhcRtsWithLibdw=$(strip $(if $(filter $(TargetArch_CPP),i386 x86_64 s390x), at UseL # See Note [tooldir: How GHC finds mingw on Windows] LdHasFilelist = @LdHasFilelist@ -LdSupportsResponseFiles = @LdSupportsResponseFiles@ +MergeObjsSupportsResponseFiles = @MergeObjsSupportsResponseFiles@ LdHasBuildId = @LdHasBuildId@ LdHasFilelist = @LdHasFilelist@ LdIsGNULd = @LdIsGNULd@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -136,7 +136,7 @@ conf-merge-objects-args-stage3 = @MergeObjsArgs@ ld-has-no-compact-unwind = @LdHasNoCompactUnwind@ ld-has-filelist = @LdHasFilelist@ -ld-supports-response-files = @LdSupportsResponseFiles@ +merge-objs-supports-response-files = @MergeObjsSupportsResponseFiles@ ld-is-gnu-ld = @LdIsGNULd@ ar-args = @ArArgs@ ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -450,10 +450,10 @@ generateSettings = do , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags) , ("ld supports compact unwind", expr $ lookupSystemConfig "ld-has-no-compact-unwind") , ("ld supports filelist", expr $ lookupSystemConfig "ld-has-filelist") - , ("ld supports response files", expr $ lookupSystemConfig "ld-supports-response-files") , ("ld is GNU ld", expr $ lookupSystemConfig "ld-is-gnu-ld") , ("Merge objects command", expr $ settingsFileSetting SettingsFileSetting_MergeObjectsCommand) , ("Merge objects flags", expr $ settingsFileSetting SettingsFileSetting_MergeObjectsFlags) + , ("Merge objects supports response files", expr $ lookupSystemConfig "merge-objs-supports-response-files") , ("ar command", expr $ settingsFileSetting SettingsFileSetting_ArCommand) , ("ar flags", expr $ lookupSystemConfig "ar-args") , ("ar supports at file", expr $ yesNo <$> flag ArSupportsAtFile) ===================================== m4/fp_ld_supports_response_files.m4 deleted ===================================== @@ -1,19 +0,0 @@ -# FP_LD_SUPPORTS_RESPONSE_FILES -# -------------------- -# See if whether we are using a version of ld which supports response files. -AC_DEFUN([FP_LD_SUPPORTS_RESPONSE_FILES], [ - AC_MSG_CHECKING([whether $LD supports response files]) - echo 'int main(void) {return 0;}' > conftest.c - "$CC" -c -o conftest.o conftest.c > /dev/null 2>&1 - printf -- "-o\nconftest\nconftest.o\n" > args.txt - if "$LD" -shared @args.txt > /dev/null 2>&1 || "$LD" -dylib @args.txt > /dev/null 2>&1 - then - LdSupportsResponseFiles=YES - AC_MSG_RESULT([yes]) - else - LdSupportsResponseFiles=NO - AC_MSG_RESULT([no]) - fi - rm -f conftest.c conftest args.txt - AC_SUBST(LdSupportsResponseFiles) -]) ===================================== m4/fp_merge_objects_supports_response_files.m4 ===================================== @@ -0,0 +1,22 @@ +# FP_MERGE_OBJECTS_SUPPORTS_RESPONSE_FILES +# -------------------- +# See if whether we are using a version of the merge objects tool which supports response files. +AC_DEFUN([FP_MERGE_OBJECTS_SUPPORTS_RESPONSE_FILES], [ + AC_MSG_CHECKING([whether $LD supports response files]) + echo 'int funA(int x) {return x;}' > conftesta.c + echo 'int funB(int x) {return x;}' > conftestb.c + "$CC" -c -o conftesta.o conftesta.c > /dev/null 2>&1 + "$CC" -c -o conftestb.o conftestb.c > /dev/null 2>&1 + printf -- "-o\nconftest.o\nconftesta.o\nconftestb.o\n" > args.txt + "$MergeObjsCmd" "$MergeObjsArgs" @args.txt > /dev/null 2>&1 + if ("$NM" conftest.o | grep "funA" > /dev/null 2>&1) && ("$NM" conftest.o | grep "funB" > /dev/null 2>&1) + then + MergeObjsSupportsResponseFiles=YES + AC_MSG_RESULT([yes]) + else + MergeObjsSupportsResponseFiles=NO + AC_MSG_RESULT([no]) + fi + rm -f conftesta.c conftestb.c conftesta.o conftestb.o conftest.o args.txt + AC_SUBST(MergeObjsSupportsResponseFiles) +]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fcf310e7c90f547f3d6b6b265d4f60730f910a3f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fcf310e7c90f547f3d6b6b265d4f60730f910a3f You're receiving 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 Jun 29 01:12:21 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 28 Jun 2023 21:12:21 -0400 Subject: [Git][ghc/ghc][master] JS: fix JS stack printing (#23565) Message-ID: <649cda753bea1_3b5ae21894f6484309aa@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 3 changed files: - rts/js/string.js - + testsuite/tests/javascript/T23565.hs - testsuite/tests/javascript/all.T Changes: ===================================== rts/js/string.js ===================================== @@ -739,7 +739,7 @@ function h$throwJSException(e) { if(typeof e === 'string') { strVal = e; } else if(e instanceof Error) { - strVal = e.toString() + '\n' + Array.prototype.join.call(e.stack, '\n'); + strVal = e.toString() + '\n' + e.stack; } else { strVal = "" + e; } ===================================== testsuite/tests/javascript/T23565.hs ===================================== @@ -0,0 +1,17 @@ +module Main where + +import GHC.JS.Prim +import Control.Exception +import System.Exit + +main :: IO () +main = foo `catch` \(JSException val s) -> do + -- check that the message (including call stack) hasn't too many lines + -- (#23565) + if length (lines s) >= 10 + then putStrLn "Failure: too many lines" >> exitFailure + else pure () + + +foreign import javascript "foo" + foo :: IO () ===================================== testsuite/tests/javascript/all.T ===================================== @@ -18,3 +18,4 @@ test('js-callback05', js_skip, compile_and_run, ['']) test('T23346', normal, compile_and_run, ['']) test('T22455', normal, compile_and_run, ['-ddisable-js-minifier']) +test('T23565', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/78b2f3ccb1d7603e11b3f364646240e361512cbc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/78b2f3ccb1d7603e11b3f364646240e361512cbc You're receiving 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 Jun 29 01:32:39 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 28 Jun 2023 21:32:39 -0400 Subject: [Git][ghc/ghc][wip/refactor-gen-ci] gitlab-ci: Refactor compilation of gen_ci Message-ID: <649cdf37135df_3b5ae218bdfe08431279@gitlab.mail> Ben Gamari pushed to branch wip/refactor-gen-ci at Glasgow Haskell Compiler / GHC Commits: 126a6be4 by Ben Gamari at 2023-06-28T21:32:30-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 10 changed files: - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/update-ci - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -274,9 +274,8 @@ lint-ci-config: GIT_SUBMODULE_STRATEGY: none before_script: - echo "experimental-features = nix-command flakes" >> /etc/nix/nix.conf - - nix-channel --update script: - - .gitlab/generate_jobs + - nix run .gitlab/generate-ci#update-ci # 1 if .gitlab/generate_jobs changed the output of the generated config - nix shell nixpkgs#git -c git diff --exit-code # And run this to just make sure that works ===================================== .gitlab/generate-ci/LICENSE ===================================== @@ -0,0 +1,30 @@ +Copyright (c) 2023, The GHC Developers + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of The GHC Developers nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ===================================== .gitlab/generate-ci/README.mkd ===================================== @@ -0,0 +1,26 @@ +# generate-ci + +This is the generator for GHC's GitLab CI infrastructure. In particular, this +generates `.gitlab/jobs.yaml`, which is a YAML (or, strictly speaking, JSON) +file which defines the bulk of the validation, nightly, and release jobs of +GHC's CI. + + +## Modifying the CI configuration (nix) + +The jobs are defined in `gen_ci.hs`. After modifying this you can run +```sh +nix run .gitlab/generate-ci#update-ci +``` +from the top of the GHC repository to update the generated configuration. + + +## Modifying the CI configuration (without nix) + +One can run `update-ci` without Nix as follows (assuming one has `jq`, +`cabal-install`, and GHC installed): +```sh +$ cabal build generate-ci +$ PATH="$(dirname $(cabal list-bin generate-ci)):$PATH" +$ ./update-ci +``` ===================================== .gitlab/generate-ci/flake.lock ===================================== @@ -0,0 +1,59 @@ +{ + "nodes": { + "flake-utils": { + "inputs": { + "systems": "systems" + }, + "locked": { + "lastModified": 1687709756, + "narHash": "sha256-Y5wKlQSkgEK2weWdOu4J3riRd+kV/VCgHsqLNTTWQ/0=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "dbabf0ca0c0c4bce6ea5eaf65af5cb694d2082c7", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "nixpkgs": { + "locked": { + "lastModified": 1687886075, + "narHash": "sha256-PeayJDDDy+uw1Ats4moZnRdL1OFuZm1Tj+KiHlD67+o=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "a565059a348422af5af9026b5174dc5c0dcefdae", + "type": "github" + }, + "original": { + "id": "nixpkgs", + "type": "indirect" + } + }, + "root": { + "inputs": { + "flake-utils": "flake-utils", + "nixpkgs": "nixpkgs" + } + }, + "systems": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } + } + }, + "root": "root", + "version": 7 +} ===================================== .gitlab/generate-ci/flake.nix ===================================== @@ -0,0 +1,33 @@ +{ + description = "GHC CI Generator"; + + inputs.flake-utils.url = "github:numtide/flake-utils"; + + outputs = { self, nixpkgs, flake-utils }: + flake-utils.lib.eachDefaultSystem (system: + let pkgs = nixpkgs.legacyPackages.${system}; in + { + packages = rec { + update-ci = pkgs.runCommand "update-ci" { + nativeBuildInputs = with pkgs; [ makeWrapper ]; + } '' + mkdir -p $out/bin + makeWrapper ${./update-ci} $out/bin/update-ci \ + --prefix PATH : ${with pkgs; lib.makeBinPath [ generate-ci jq gitMinimal ]} + ''; + + generate-ci = pkgs.haskellPackages.callCabal2nix "generate-ci" ./. {}; + + default = update-ci; + }; + + apps = rec { + update-ci = flake-utils.lib.mkApp { + drv = self.packages.${system}.update-ci; + }; + + default = update-ci; + }; + } + ); +} ===================================== .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs ===================================== @@ -3,9 +3,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{- cabal: -build-depends: base, aeson >= 1.8.1, containers, bytestring --} import Data.Aeson as A import qualified Data.Map as Map ===================================== .gitlab/generate-ci/generate-ci.cabal ===================================== @@ -0,0 +1,15 @@ +cabal-version: 3.0 +name: generate-ci +version: 0.1.0.0 +license: BSD-3-Clause +license-file: LICENSE +build-type: Simple + +executable generate-ci + main-is: gen_ci.hs + ghc-options: -Wall + build-depends: base, + containers, + bytestring, + aeson >= 1.8.1 + default-language: Haskell2010 ===================================== .gitlab/generate-ci/update-ci ===================================== @@ -0,0 +1,16 @@ +#!/usr/bin/env bash + +out_dir="$(git rev-parse --show-toplevel)/.gitlab" + +# Update job metadata for ghcup +generate-ci metadata "$out_dir/jobs-metadata.json" +echo "Updated $out_dir/jobs-metadata.json" + +# Update CI jobs +tmp="$(mktemp)" +generate-ci gitlab "$tmp" +rm -f "$out_dir/jobs.yaml" +echo "### THIS IS A GENERATED FILE, DO NOT MODIFY DIRECTLY" > "$out_dir/jobs.yaml" +cat "$tmp" | jq >> "$out_dir/jobs.yaml" +rm "$tmp" +echo "Updated $out_dir/jobs.yaml" ===================================== .gitlab/generate_job_metadata deleted ===================================== @@ -1,5 +0,0 @@ -#! /usr/bin/env nix-shell -#!nix-shell -i bash -p cabal-install "haskell.packages.ghc92.ghcWithPackages (pkgs: with pkgs; [aeson])" git jq - -cd "$(dirname "${BASH_SOURCE[0]}")" -cabal run gen_ci -- metadata jobs-metadata.json ===================================== .gitlab/generate_jobs deleted ===================================== @@ -1,13 +0,0 @@ -#!/usr/bin/env nix-shell -#!nix-shell -i bash -p cabal-install "haskell.packages.ghc92.ghcWithPackages (pkgs: with pkgs; [aeson])" git jq - -# shellcheck shell=bash - -set -euo pipefail - -cd "$(dirname "${BASH_SOURCE[0]}")" -tmp=$(mktemp) -cabal run gen_ci -- gitlab $tmp -rm -f jobs.yaml -echo "### THIS IS A GENERATED FILE, DO NOT MODIFY DIRECTLY" > jobs.yaml -cat $tmp | jq | tee -a jobs.yaml View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/126a6be4599612bdebf98d642ae4c4a21a4b6b0f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/126a6be4599612bdebf98d642ae4c4a21a4b6b0f You're receiving 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 Jun 29 01:35:43 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 28 Jun 2023 21:35:43 -0400 Subject: [Git][ghc/ghc][wip/T23568] 2 commits: Define FFI_GO_CLOSURES Message-ID: <649cdfef2b8de_3b5ae21875de484319a6@gitlab.mail> Ben Gamari pushed to branch wip/T23568 at Glasgow Haskell Compiler / GHC Commits: e054f357 by Ben Gamari at 2023-06-28T21:34:41-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - ec5cc3b2 by Ben Gamari at 2023-06-28T21:34:44-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 8 changed files: - compiler/GHC/Driver/CodeOutput.hs - libraries/base/include/HsBase.h - libraries/ghci/GHCi/FFI.hsc - rts/Interpreter.c - rts/adjustor/LibffiAdjustor.c - + rts/include/rts/ghc_ffi.h - rts/rts.cabal.in - rts/sm/Storage.c Changes: ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -295,7 +295,7 @@ outputForeignStubs logger tmpfs dflags unit_state mod location stubs -- wrapper code mentions the ffi_arg type, which comes from ffi.h ffi_includes - | platformMisc_libFFI $ platformMisc dflags = "#include \n" + | platformMisc_libFFI $ platformMisc dflags = "#include \"rts/ghc_ffi.h\"\n" | otherwise = "" stub_h_file_exists ===================================== libraries/base/include/HsBase.h ===================================== @@ -540,7 +540,7 @@ INLINE int __hscore_open(char *file, int how, mode_t mode) { } #endif -#if darwin_HOST_OS +#if defined(darwin_HOST_OS) // You should not access _environ directly on Darwin in a bundle/shared library. // See #2458 and http://developer.apple.com/library/mac/#documentation/Darwin/Reference/ManPages/man7/environ.7.html #include ===================================== libraries/ghci/GHCi/FFI.hsc ===================================== @@ -22,6 +22,14 @@ -} #if !defined(javascript_HOST_ARCH) +-- See Note [FFI_GO_CLOSURES workaround] in ghc_ffi.h +-- We can't include ghc_ffi.h here as we must build with stage0 +#if defined(darwin_HOST_OS) +#if !defined(FFI_GO_CLOSURES) +#define FFI_GO_CLOSURES 0 +#endif +#endif + #include #endif ===================================== rts/Interpreter.c ===================================== @@ -39,7 +39,7 @@ #endif #endif -#include "ffi.h" +#include "rts/ghc_ffi.h" /* -------------------------------------------------------------------------- * The bytecode interpreter ===================================== rts/adjustor/LibffiAdjustor.c ===================================== @@ -11,7 +11,7 @@ #include "Hash.h" #include "Adjustor.h" -#include "ffi.h" +#include "rts/ghc_ffi.h" #include // Note that ffi_alloc_prep_closure is a non-standard libffi closure ===================================== rts/include/rts/ghc_ffi.h ===================================== @@ -0,0 +1,28 @@ +/* + * wrapper working around #23586. + * + * (c) The University of Glasgow 2023 + * + */ + +#pragma once + +/* + * Note [FFI_GO_CLOSURES workaround] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * Apple ships a broken libffi with Xcode which lacks a definition of + * FFI_GO_CLOSURES despite having references to said macro. Work around this + * for now to avoid -Wundef warnings. + * + * We choose the value zero here by following the model of OpenJDK. + * See https://github.com/openjdk/jdk17u-dev/pull/741/files. + * + * See #23568. + */ +#if defined(darwin_HOST_OS) +#if !defined(FFI_GO_CLOSURES) +#define FFI_GO_CLOSURES 0 +#endif +#endif + +#include "ffi.h" ===================================== rts/rts.cabal.in ===================================== @@ -237,6 +237,7 @@ library rts/EventLogConstants.h rts/EventTypes.h -- ^ generated + rts/ghc_ffi.h rts/Adjustor.h rts/ExecPage.h rts/BlockSignals.h ===================================== rts/sm/Storage.c ===================================== @@ -53,7 +53,7 @@ #include -#include "ffi.h" +#include "rts/ghc_ffi.h" /* * All these globals require sm_mutex to access in THREADED_RTS mode. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cbe8a3b46303174d6b0da3e19a83b471b5242530...ec5cc3b2b6c60fa92709786b7690029047ab3ab9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cbe8a3b46303174d6b0da3e19a83b471b5242530...ec5cc3b2b6c60fa92709786b7690029047ab3ab9 You're receiving 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 Jun 29 01:42:16 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 28 Jun 2023 21:42:16 -0400 Subject: [Git][ghc/ghc][wip/testsuite-output-patch] 4 commits: gitlab-ci: Refactor compilation of gen_ci Message-ID: <649ce17869ff2_3b5ae219a235dc432595@gitlab.mail> Ben Gamari pushed to branch wip/testsuite-output-patch at Glasgow Haskell Compiler / GHC Commits: 126a6be4 by Ben Gamari at 2023-06-28T21:32:30-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 234b519f by Ben Gamari at 2023-06-28T21:40:46-04:00 Drop circle-ci-job.sh - - - - - 9bcda707 by Ben Gamari at 2023-06-28T21:40:46-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 7540d340 by Ben Gamari at 2023-06-28T21:41:24-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 16 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/update-ci - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - testsuite/driver/runtests.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py Changes: ===================================== .gitlab-ci.yml ===================================== @@ -274,9 +274,8 @@ lint-ci-config: GIT_SUBMODULE_STRATEGY: none before_script: - echo "experimental-features = nix-command flakes" >> /etc/nix/nix.conf - - nix-channel --update script: - - .gitlab/generate_jobs + - nix run .gitlab/generate-ci#update-ci # 1 if .gitlab/generate_jobs changed the output of the generated config - nix shell nixpkgs#git -c git diff --exit-code # And run this to just make sure that works ===================================== .gitlab/ci.sh ===================================== @@ -673,12 +673,14 @@ function test_hadrian() { --summary-junit=./junit.xml \ --test-have-intree-files \ --test-compiler="${test_compiler}" \ - "runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian main testsuite" + "runtest.opts+=${RUNTEST_ARGS:-}" \ + "runtest.opts+=--unexpected-output-dir=$TOP/unexpected-test-output" \ + || fail "hadrian main testsuite" + tar -czf unexpected-test-output.tar.gz unexpected-test-output info "STAGE2_TEST=$?" - fi - + fi } function summarise_hi_files() { ===================================== .gitlab/circle-ci-job.sh deleted ===================================== @@ -1,110 +0,0 @@ -# Circle CI "backend" for Gitlab CI -# ================================= -# -# Usage example: -# .gitlab/circle-ci-job.sh validate-x86_64-linux -# -# There are two things to configure to get artifacts to be -# uploaded to gitlab properly: -# -# - At https:///admin/application_settings, expand the -# Continuous Integration and Deployment section and set the -# "Maximum artifacts size (MB)" field to something large enough -# to contain the bindists (the test reports are tiny in comparison). -# 500MB seems to work fine, but 200MB might be sufficient. -# -# - If gitlab is exposed behind some form of proxy (e.g nginx), make sure -# the maximum client request body size is large enough to contain all the -# artifacts of a build. For nginx, this would be the following configuration -# option: https://nginx.org/en/docs/http/ngx_http_core_module.html#client_max_body_size -# (which can be set with services.nginx.clientMaxBodySize on nixos). - -#!/usr/bin/env sh - -set -e - -GHCCI_URL="localhost:8888" - -[ $# -gt 0 ] || (echo You need to pass the Circle CI job type as argument to this script; exit 1) -[ ${CI_RUNNER_ID:-} ] || (echo "CI_RUNNER_ID is not set"; exit 1) -[ ${CI_JOB_ID:-} ] || (echo "CI_JOB_ID is not set"; exit 1) -[ ${CI_COMMIT_SHA:-} ] || (echo "CI_COMMIT_SHA is not set"; exit 1) -[ ${CI_REPOSITORY_URL:-} ] || (echo "CI_REPOSITORY_URL is not set"; exit 1) -[ ${CI_PIPELINE_ID:-} ] || (echo "CI_PIPELINE_ID is not set"; exit 1) -# the first argument to this script is the Circle CI job type: -# validate-x86_64-linux, validate-i386-linux, ... -CIRCLE_JOB="circleci-$1" - -gitlab_user=$(echo $CI_REPOSITORY_URL | cut -d/ -f4) -gitlab_repo=$(echo $CI_REPOSITORY_URL | cut -d/ -f5 | cut -d. -f1) - -BODY="{ \"jobType\": \"$CIRCLE_JOB\", \"source\": { \"user\": \"$gitlab_user\", \"project\":\"$gitlab_repo\", \"commit\":\"$CI_COMMIT_SHA\" }, \"pipelineID\": $CI_PIPELINE_ID, \"runnerID\": $CI_RUNNER_ID, \"jobID\": $CI_JOB_ID }" - - -RESP=$(curl -s -XPOST -H "Content-Type: application/json" -d "$BODY" \ - http://${GHCCI_URL}/job) - -if [ $? -eq 0 ]; then - build_num=$(echo $RESP | jq '.build_num') - circle_url=$(echo $RESP | jq '.url') -else - echo "Couldn't submit job" - echo $RESP - exit 1 -fi - -echo Circle CI build number: $build_num -echo Circle CI build page: $circle_url - -outcome="null" -STATUS_URL="http://${GHCCI_URL}/job/${build_num}" -STATUS_RESP="" - -while [ "$outcome" == "null" ]; do - sleep 30s - STATUS_RESP=$(curl -s $STATUS_URL) - if [ $? -eq 0 ]; then - new_outcome=$(echo $STATUS_RESP | jq '.outcome') - jq_exitcode=$? - if [ "$new_outcome" == "null" ] && [ $jq_exitcode -ne 0 ]; then - echo "Couldn't read 'outcome' field in JSON:" - echo $STATUS_RESP - echo "Skipping" - else - outcome="$new_outcome" - fi - else - echo "curl failed:" - echo $STATUS_RESP - echo "Skipping" - fi -done - -if [ "$outcome" == "\"success\"" ]; then - echo The build passed - artifactsBody=$(curl -s http://${GHCCI_URL}/job/${build_num}/artifacts) - (echo $artifactsBody | jq '.[] | .url' | xargs wget -q) || echo "No artifacts" - exit 0 -else - echo The build failed - - artifactsBody=$(curl -s http://${GHCCI_URL}/job/${build_num}/artifacts) - (echo $artifactsBody | jq '.[] | .url' | xargs wget -q) || echo "No artifacts" - - failing_step=$(echo $STATUS_RESP | jq '.steps | .[] | .actions | .[] | select(.status != "success")') - failing_step_name=$(echo $failing_step | jq '.name' | sed -e 's/^"//' -e 's/"$//' -e 's/\\r\\n/\n/') - echo "Failing step: $failing_step_name" - - failing_cmds=$(echo $failing_step | jq '.bash_command' | sed -e 's/^"//' -e 's/"$//' -e 's/\\r\\n/\n/') - echo "Failing command(s):" - echo $failing_cmds - - log_url=$(echo $failing_step | jq '.output_url' | sed -e 's/^"//' -e 's/"$//' -e 's/\\r\\n/\n/') - echo "Log url: $log_url" - - last_log_lines=$(curl -s $log_url | gunzip | jq '.[] | select(.type == "out") | .message' | sed -e 's/^"//' -e 's/"$//' -e 's/\\r\\n/\n/' | tail -50) - echo End of the build log: - echo $last_log_lines - - exit 1 -fi ===================================== .gitlab/generate-ci/LICENSE ===================================== @@ -0,0 +1,30 @@ +Copyright (c) 2023, The GHC Developers + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of The GHC Developers nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ===================================== .gitlab/generate-ci/README.mkd ===================================== @@ -0,0 +1,26 @@ +# generate-ci + +This is the generator for GHC's GitLab CI infrastructure. In particular, this +generates `.gitlab/jobs.yaml`, which is a YAML (or, strictly speaking, JSON) +file which defines the bulk of the validation, nightly, and release jobs of +GHC's CI. + + +## Modifying the CI configuration (nix) + +The jobs are defined in `gen_ci.hs`. After modifying this you can run +```sh +nix run .gitlab/generate-ci#update-ci +``` +from the top of the GHC repository to update the generated configuration. + + +## Modifying the CI configuration (without nix) + +One can run `update-ci` without Nix as follows (assuming one has `jq`, +`cabal-install`, and GHC installed): +```sh +$ cabal build generate-ci +$ PATH="$(dirname $(cabal list-bin generate-ci)):$PATH" +$ ./update-ci +``` ===================================== .gitlab/generate-ci/flake.lock ===================================== @@ -0,0 +1,59 @@ +{ + "nodes": { + "flake-utils": { + "inputs": { + "systems": "systems" + }, + "locked": { + "lastModified": 1687709756, + "narHash": "sha256-Y5wKlQSkgEK2weWdOu4J3riRd+kV/VCgHsqLNTTWQ/0=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "dbabf0ca0c0c4bce6ea5eaf65af5cb694d2082c7", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "nixpkgs": { + "locked": { + "lastModified": 1687886075, + "narHash": "sha256-PeayJDDDy+uw1Ats4moZnRdL1OFuZm1Tj+KiHlD67+o=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "a565059a348422af5af9026b5174dc5c0dcefdae", + "type": "github" + }, + "original": { + "id": "nixpkgs", + "type": "indirect" + } + }, + "root": { + "inputs": { + "flake-utils": "flake-utils", + "nixpkgs": "nixpkgs" + } + }, + "systems": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } + } + }, + "root": "root", + "version": 7 +} ===================================== .gitlab/generate-ci/flake.nix ===================================== @@ -0,0 +1,33 @@ +{ + description = "GHC CI Generator"; + + inputs.flake-utils.url = "github:numtide/flake-utils"; + + outputs = { self, nixpkgs, flake-utils }: + flake-utils.lib.eachDefaultSystem (system: + let pkgs = nixpkgs.legacyPackages.${system}; in + { + packages = rec { + update-ci = pkgs.runCommand "update-ci" { + nativeBuildInputs = with pkgs; [ makeWrapper ]; + } '' + mkdir -p $out/bin + makeWrapper ${./update-ci} $out/bin/update-ci \ + --prefix PATH : ${with pkgs; lib.makeBinPath [ generate-ci jq gitMinimal ]} + ''; + + generate-ci = pkgs.haskellPackages.callCabal2nix "generate-ci" ./. {}; + + default = update-ci; + }; + + apps = rec { + update-ci = flake-utils.lib.mkApp { + drv = self.packages.${system}.update-ci; + }; + + default = update-ci; + }; + } + ); +} ===================================== .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs ===================================== @@ -3,9 +3,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{- cabal: -build-depends: base, aeson >= 1.8.1, containers, bytestring --} import Data.Aeson as A import qualified Data.Map as Map @@ -699,16 +696,19 @@ 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 + , let runtestArgs = + [ "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity" + | validateNonmovingGc buildConfig + ] + in "RUNTEST_ARGS" =: unwords runtestArgs ] jobArtifacts = Artifacts { junitReport = "junit.xml" , expireIn = "2 weeks" , artifactPaths = [binDistName arch opsys buildConfig ++ ".tar.xz" - ,"junit.xml"] + ,"junit.xml" + ,"unexpected-test-output.tar.gz"] , artifactsWhen = ArtifactsAlways } ===================================== .gitlab/generate-ci/generate-ci.cabal ===================================== @@ -0,0 +1,15 @@ +cabal-version: 3.0 +name: generate-ci +version: 0.1.0.0 +license: BSD-3-Clause +license-file: LICENSE +build-type: Simple + +executable generate-ci + main-is: gen_ci.hs + ghc-options: -Wall + build-depends: base, + containers, + bytestring, + aeson >= 1.8.1 + default-language: Haskell2010 ===================================== .gitlab/generate-ci/update-ci ===================================== @@ -0,0 +1,16 @@ +#!/usr/bin/env bash + +out_dir="$(git rev-parse --show-toplevel)/.gitlab" + +# Update job metadata for ghcup +generate-ci metadata "$out_dir/jobs-metadata.json" +echo "Updated $out_dir/jobs-metadata.json" + +# Update CI jobs +tmp="$(mktemp)" +generate-ci gitlab "$tmp" +rm -f "$out_dir/jobs.yaml" +echo "### THIS IS A GENERATED FILE, DO NOT MODIFY DIRECTLY" > "$out_dir/jobs.yaml" +cat "$tmp" | jq >> "$out_dir/jobs.yaml" +rm "$tmp" +echo "Updated $out_dir/jobs.yaml" ===================================== .gitlab/generate_job_metadata deleted ===================================== @@ -1,5 +0,0 @@ -#! /usr/bin/env nix-shell -#!nix-shell -i bash -p cabal-install "haskell.packages.ghc92.ghcWithPackages (pkgs: with pkgs; [aeson])" git jq - -cd "$(dirname "${BASH_SOURCE[0]}")" -cabal run gen_ci -- metadata jobs-metadata.json ===================================== .gitlab/generate_jobs deleted ===================================== @@ -1,13 +0,0 @@ -#!/usr/bin/env nix-shell -#!nix-shell -i bash -p cabal-install "haskell.packages.ghc92.ghcWithPackages (pkgs: with pkgs; [aeson])" git jq - -# shellcheck shell=bash - -set -euo pipefail - -cd "$(dirname "${BASH_SOURCE[0]}")" -tmp=$(mktemp) -cabal run gen_ci -- gitlab $tmp -rm -f jobs.yaml -echo "### THIS IS A GENERATED FILE, DO NOT MODIFY DIRECTLY" > jobs.yaml -cat $tmp | jq | tee -a jobs.yaml ===================================== .gitlab/jobs.yaml ===================================== @@ -11,7 +11,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-aarch64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -59,6 +60,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-darwin-validate" } }, @@ -73,7 +75,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -117,6 +120,7 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate" } }, @@ -131,7 +135,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-i386-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -175,6 +180,7 @@ "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb9-validate" } }, @@ -189,7 +195,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -237,6 +244,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-darwin-validate", "XZ_OPT": "-9" } @@ -252,7 +260,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -296,6 +305,7 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -311,7 +321,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -355,6 +366,7 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate+llvm", "XZ_OPT": "-9" } @@ -370,7 +382,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-i386-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -414,6 +427,7 @@ "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb9-validate", "XZ_OPT": "-9" } @@ -429,7 +443,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -477,6 +492,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-darwin-validate", "XZ_OPT": "-9", "ac_cv_func_clock_gettime": "no", @@ -495,7 +511,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-freebsd13-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -541,6 +558,7 @@ "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-freebsd13-validate", "XZ_OPT": "-9" } @@ -556,7 +574,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -603,6 +622,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-int_native-validate+fully_static", "XZ_OPT": "-9" } @@ -618,7 +638,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -665,6 +686,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-validate", "XZ_OPT": "-9" } @@ -680,7 +702,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -727,6 +750,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-validate+fully_static", "XZ_OPT": "-9" } @@ -742,7 +766,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -788,6 +813,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -803,7 +829,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -849,6 +876,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -864,7 +892,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -910,6 +939,7 @@ "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -925,7 +955,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-centos7-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -970,6 +1001,7 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-centos7-validate", "XZ_OPT": "-9" } @@ -985,7 +1017,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1029,6 +1062,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-int_native-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-int_native-validate", "XZ_OPT": "-9" } @@ -1044,7 +1078,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-no_tntc-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1088,6 +1123,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-no_tntc-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--disable-tables-next-to-code", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate", "XZ_OPT": "-9" } @@ -1103,7 +1139,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1148,6 +1185,7 @@ "BUILD_FLAVOUR": "slow-validate", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate", "XZ_OPT": "-9" } @@ -1163,7 +1201,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-unreg-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1207,6 +1246,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-unreg-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-unregisterised", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-unreg-validate", "XZ_OPT": "-9" } @@ -1222,7 +1262,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1266,6 +1307,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -1281,7 +1323,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1325,6 +1368,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+debug_info", "XZ_OPT": "-9" } @@ -1340,7 +1384,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1384,6 +1429,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+llvm", "XZ_OPT": "-9" } @@ -1399,7 +1445,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1444,6 +1491,7 @@ "BUILD_FLAVOUR": "validate+thread_sanitizer", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions", "XZ_OPT": "-9" @@ -1460,7 +1508,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1506,6 +1555,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "XZ_OPT": "-9" } @@ -1521,7 +1571,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1568,6 +1619,7 @@ "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate", "XZ_OPT": "-9" } @@ -1583,7 +1635,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1627,6 +1680,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-validate", "XZ_OPT": "-9" } @@ -1642,7 +1696,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1702,7 +1757,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1746,6 +1802,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb9-validate", "XZ_OPT": "-9" } @@ -1761,7 +1818,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1807,6 +1865,7 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -1822,7 +1881,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1869,6 +1929,7 @@ "HADRIAN_ARGS": "--haddock-base-url", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -1884,7 +1945,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1930,6 +1992,7 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-validate+debug_info", "XZ_OPT": "-9" } @@ -1945,7 +2008,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-rocky8-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1990,6 +2054,7 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-rocky8-validate", "XZ_OPT": "-9" } @@ -2005,7 +2070,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-ubuntu18_04-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2049,6 +2115,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu18_04-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu18_04-validate", "XZ_OPT": "-9" } @@ -2064,7 +2131,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-ubuntu20_04-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2108,6 +2176,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu20_04-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu20_04-validate", "XZ_OPT": "-9" } @@ -2122,7 +2191,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-windows-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2167,6 +2237,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-int_native-validate", "XZ_OPT": "-9" } @@ -2181,7 +2252,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-windows-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2226,6 +2298,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-validate", "XZ_OPT": "-9" } @@ -2241,7 +2314,8 @@ "expire_in": "1 year", "paths": [ "ghc-aarch64-darwin-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2290,6 +2364,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-darwin-release", "XZ_OPT": "-9" } @@ -2305,7 +2380,8 @@ "expire_in": "1 year", "paths": [ "ghc-aarch64-linux-deb10-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2351,6 +2427,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-release+no_split_sections", "XZ_OPT": "-9" } @@ -2366,7 +2443,8 @@ "expire_in": "1 year", "paths": [ "ghc-i386-linux-deb9-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2412,6 +2490,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb9-release+no_split_sections", "XZ_OPT": "-9" } @@ -2427,7 +2506,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-darwin-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2476,6 +2556,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-darwin-release", "XZ_OPT": "-9", "ac_cv_func_clock_gettime": "no", @@ -2494,7 +2575,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2542,6 +2624,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-int_native-release+fully_static", "XZ_OPT": "-9" } @@ -2557,7 +2640,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-release+fully_static+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2605,6 +2689,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-release+fully_static+no_split_sections", "XZ_OPT": "-9" } @@ -2620,7 +2705,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2668,6 +2754,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-release+no_split_sections", "XZ_OPT": "-9" } @@ -2683,7 +2770,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-centos7-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2729,6 +2817,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-centos7-release+no_split_sections", "XZ_OPT": "-9" } @@ -2744,7 +2833,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb10-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2790,6 +2880,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-release", "XZ_OPT": "-9" } @@ -2805,7 +2896,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb10-release+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2851,6 +2943,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-release+debug_info", "XZ_OPT": "-9" } @@ -2866,7 +2959,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb11-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2912,6 +3006,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-release", "XZ_OPT": "-9" } @@ -2927,7 +3022,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb11-release+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2989,7 +3085,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb9-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3035,6 +3132,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb9-release+no_split_sections", "XZ_OPT": "-9" } @@ -3050,7 +3148,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3098,6 +3197,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -3113,7 +3213,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3161,6 +3262,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release+debug_info", "XZ_OPT": "-9" } @@ -3176,7 +3278,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3224,6 +3327,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -3239,7 +3343,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-rocky8-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3285,6 +3390,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-rocky8-release", "XZ_OPT": "-9" } @@ -3300,7 +3406,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-ubuntu18_04-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3346,6 +3453,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu18_04-release", "XZ_OPT": "-9" } @@ -3361,7 +3469,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-ubuntu20_04-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3407,6 +3516,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu20_04-release", "XZ_OPT": "-9" } @@ -3421,7 +3531,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-windows-int_native-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3467,6 +3578,7 @@ "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-int_native-release+no_split_sections", "XZ_OPT": "-9" } @@ -3481,7 +3593,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-windows-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3527,6 +3640,7 @@ "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-release+no_split_sections", "XZ_OPT": "-9" } @@ -3542,7 +3656,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3590,6 +3705,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-darwin-validate", "ac_cv_func_clock_gettime": "no", "ac_cv_func_futimens": "no", @@ -3607,7 +3723,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-freebsd13-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3653,6 +3770,7 @@ "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-freebsd13-validate" } }, @@ -3667,7 +3785,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3714,6 +3833,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-validate+fully_static" } }, @@ -3728,7 +3848,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3774,6 +3895,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static" } }, @@ -3788,7 +3910,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3835,6 +3958,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static" } }, @@ -3849,7 +3973,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3896,6 +4021,7 @@ "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static" } }, @@ -3910,7 +4036,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3954,6 +4081,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-int_native-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-int_native-validate" } }, @@ -3968,7 +4096,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-no_tntc-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4013,6 +4142,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-no_tntc-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--disable-tables-next-to-code", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate" } }, @@ -4027,7 +4157,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4072,6 +4203,7 @@ "BUILD_FLAVOUR": "slow-validate", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate" } }, @@ -4086,7 +4218,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-unreg-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4130,6 +4263,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-unreg-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-unregisterised", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-unreg-validate" } }, @@ -4144,7 +4278,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4188,6 +4323,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate" } }, @@ -4202,7 +4338,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4246,6 +4383,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+debug_info" } }, @@ -4260,7 +4398,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4304,6 +4443,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+llvm" } }, @@ -4318,7 +4458,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4364,6 +4505,7 @@ "BUILD_FLAVOUR": "validate+thread_sanitizer", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" } @@ -4379,7 +4521,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4425,6 +4568,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" } }, @@ -4439,7 +4583,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4486,6 +4631,7 @@ "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate" } }, @@ -4500,7 +4646,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4559,7 +4706,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4605,6 +4753,7 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release" } }, @@ -4618,7 +4767,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-windows-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4663,6 +4813,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-validate" } } ===================================== testsuite/driver/runtests.py ===================================== @@ -71,6 +71,7 @@ parser.add_argument("--config", action='append', help="config field") parser.add_argument("--rootdir", action='append', help="root of tree containing tests (default: .)") parser.add_argument("--metrics-file", help="file in which to save (append) the performance test metrics. If omitted, git notes will be used.") parser.add_argument("--summary-file", help="file in which to save the (human-readable) summary") +parser.add_argument("--unexpected-output-dir", help="directory in which to place unexpected output") parser.add_argument("--target-wrapper", help="wrapper executable to use when executing binaries compiled for the target") parser.add_argument("--no-print-summary", action="store_true", help="should we print the summary?") parser.add_argument("--only", action="append", help="just this test (can be give multiple --only= flags)") @@ -128,6 +129,9 @@ if args.top: if args.test_package_db: config.test_package_db = args.test_package_db +if args.unexpected_output_dir: + config.unexpected_output_dir = Path(args.unexpected_output_dir) + if args.only: config.only = args.only config.run_only_some_tests = True ===================================== testsuite/driver/testglobals.py ===================================== @@ -203,7 +203,7 @@ class TestConfig: self.baseline_commit = None # type: Optional[GitRef] # Additional package dbs to inspect for test dependencies. - self.test_package_db = [] # type: [PathToPackageDb] + self.test_package_db = [] # type: List[PathToPackageDb] # Should we skip performance tests self.skip_perf_tests = False @@ -225,6 +225,10 @@ class TestConfig: # See Note [Haddock runtime stats files] at the bottom of this file. self.stats_files_dir = Path('/please_set_stats_files_dir') + # Where to place observed output files on when unexpected output + # is observed. + self.unexpected_output_dir = None # type: Optional[Path] + # Should we cleanup after test runs? self.cleanup = True ===================================== testsuite/driver/testlib.py ===================================== @@ -2257,11 +2257,15 @@ async def check_prof_ok(name: TestName, way: WayName) -> bool: # new output. Returns true if output matched or was accepted, false # otherwise. See Note [Output comparison] for the meaning of the # normaliser and whitespace_normaliser parameters. -async def compare_outputs(way: WayName, - kind: str, - normaliser: OutputNormalizer, - expected_file, actual_file, diff_file=None, - whitespace_normaliser: OutputNormalizer=lambda x:x) -> bool: +async def compare_outputs( + way: WayName, + kind: str, + normaliser: OutputNormalizer, + expected_file: Path, + actual_file: Path, + diff_file: Optional[Path]=None, + whitespace_normaliser: OutputNormalizer=lambda x:x) -> bool: + # Respect ignore_stdout and ignore_stderr options if kind == 'stderr' and getTestOpts().ignore_stderr: return True @@ -2338,6 +2342,12 @@ async def compare_outputs(way: WayName, expected_path.unlink() return True else: + if config.unexpected_output_dir is not None: + ghc_root = expected_path.relative_to(config.top.parent) + out = config.unexpected_output_dir / ghc_root + out.parent.mkdir(exist_ok=True, parents=True) + write_file(out, actual_raw) + return False # Checks that each line from pattern_file is present in actual_file as @@ -2392,6 +2402,15 @@ def grep_output(normaliser: OutputNormalizer, pattern_file, actual_file, is_subs # squash all whitespace, making the diff unreadable. Instead we rely # on the `diff` program to ignore whitespace changes as much as # possible (#10152). +# +# In addition, to aid CI users we will optionally collect all +# of the unexpected output that we encountered in the +# directory at config.unexpected_output_dir. The intent here is for this +# directory to be preserved as a CI artifact which can then +# be downloaded by the user and committed to their branch +# to address CI failures on platforms which they cannot +# test locally. + # Note [Null device handling] # ~~~~~~~~~~~~~~~~~~~~~~~~~~~ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/02d785a052ace58eb5ff163b05e78d1a4218795a...7540d3405b0f97575071e70149e72caedc302bec -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/02d785a052ace58eb5ff163b05e78d1a4218795a...7540d3405b0f97575071e70149e72caedc302bec You're receiving 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 Jun 29 01:43:37 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Wed, 28 Jun 2023 21:43:37 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 18 commits: Configure CPP into settings Message-ID: <649ce1c913198_3b5ae218c145184348cc@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 66cb98e1 by Matthew Pickering at 2023-06-28T21:43:29-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - 76039d53 by Ben Gamari at 2023-06-28T21:43:30-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 30 changed files: - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.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 - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools.hs - compiler/GHC/SysTools/Cpp.hs - − compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - compiler/GHC/Tc/Gen/HsType.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/42591b51795a1607c02e70c477bf4abf429f620c...76039d53d13d76da4f1633bd9ebb9f48da55ac61 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/42591b51795a1607c02e70c477bf4abf429f620c...76039d53d13d76da4f1633bd9ebb9f48da55ac61 You're receiving 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 Jun 29 01:44:50 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 28 Jun 2023 21:44:50 -0400 Subject: [Git][ghc/ghc][wip/refactor-gen-ci] gitlab-ci: Refactor compilation of gen_ci Message-ID: <649ce21262455_3b5ae2191d27344425b2@gitlab.mail> Ben Gamari pushed to branch wip/refactor-gen-ci at Glasgow Haskell Compiler / GHC Commits: 9a99d778 by Ben Gamari at 2023-06-28T21:44:42-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 10 changed files: - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/update-ci - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -274,13 +274,10 @@ lint-ci-config: GIT_SUBMODULE_STRATEGY: none before_script: - echo "experimental-features = nix-command flakes" >> /etc/nix/nix.conf - - nix-channel --update script: - - .gitlab/generate_jobs + - nix run .gitlab/generate-ci#update-ci # 1 if .gitlab/generate_jobs changed the output of the generated config - nix shell nixpkgs#git -c git diff --exit-code - # And run this to just make sure that works - - .gitlab/generate_job_metadata dependencies: [] lint-submods: ===================================== .gitlab/generate-ci/LICENSE ===================================== @@ -0,0 +1,30 @@ +Copyright (c) 2023, The GHC Developers + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of The GHC Developers nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ===================================== .gitlab/generate-ci/README.mkd ===================================== @@ -0,0 +1,26 @@ +# generate-ci + +This is the generator for GHC's GitLab CI infrastructure. In particular, this +generates `.gitlab/jobs.yaml`, which is a YAML (or, strictly speaking, JSON) +file which defines the bulk of the validation, nightly, and release jobs of +GHC's CI. + + +## Modifying the CI configuration (nix) + +The jobs are defined in `gen_ci.hs`. After modifying this you can run +```sh +nix run .gitlab/generate-ci#update-ci +``` +from the top of the GHC repository to update the generated configuration. + + +## Modifying the CI configuration (without nix) + +One can run `update-ci` without Nix as follows (assuming one has `jq`, +`cabal-install`, and GHC installed): +```sh +$ cabal build generate-ci +$ PATH="$(dirname $(cabal list-bin generate-ci)):$PATH" +$ ./update-ci +``` ===================================== .gitlab/generate-ci/flake.lock ===================================== @@ -0,0 +1,59 @@ +{ + "nodes": { + "flake-utils": { + "inputs": { + "systems": "systems" + }, + "locked": { + "lastModified": 1687709756, + "narHash": "sha256-Y5wKlQSkgEK2weWdOu4J3riRd+kV/VCgHsqLNTTWQ/0=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "dbabf0ca0c0c4bce6ea5eaf65af5cb694d2082c7", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "nixpkgs": { + "locked": { + "lastModified": 1687886075, + "narHash": "sha256-PeayJDDDy+uw1Ats4moZnRdL1OFuZm1Tj+KiHlD67+o=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "a565059a348422af5af9026b5174dc5c0dcefdae", + "type": "github" + }, + "original": { + "id": "nixpkgs", + "type": "indirect" + } + }, + "root": { + "inputs": { + "flake-utils": "flake-utils", + "nixpkgs": "nixpkgs" + } + }, + "systems": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } + } + }, + "root": "root", + "version": 7 +} ===================================== .gitlab/generate-ci/flake.nix ===================================== @@ -0,0 +1,33 @@ +{ + description = "GHC CI Generator"; + + inputs.flake-utils.url = "github:numtide/flake-utils"; + + outputs = { self, nixpkgs, flake-utils }: + flake-utils.lib.eachDefaultSystem (system: + let pkgs = nixpkgs.legacyPackages.${system}; in + { + packages = rec { + update-ci = pkgs.runCommand "update-ci" { + nativeBuildInputs = with pkgs; [ makeWrapper ]; + } '' + mkdir -p $out/bin + makeWrapper ${./update-ci} $out/bin/update-ci \ + --prefix PATH : ${with pkgs; lib.makeBinPath [ generate-ci jq gitMinimal ]} + ''; + + generate-ci = pkgs.haskellPackages.callCabal2nix "generate-ci" ./. {}; + + default = update-ci; + }; + + apps = rec { + update-ci = flake-utils.lib.mkApp { + drv = self.packages.${system}.update-ci; + }; + + default = update-ci; + }; + } + ); +} ===================================== .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs ===================================== @@ -3,9 +3,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{- cabal: -build-depends: base, aeson >= 1.8.1, containers, bytestring --} import Data.Aeson as A import qualified Data.Map as Map ===================================== .gitlab/generate-ci/generate-ci.cabal ===================================== @@ -0,0 +1,15 @@ +cabal-version: 3.0 +name: generate-ci +version: 0.1.0.0 +license: BSD-3-Clause +license-file: LICENSE +build-type: Simple + +executable generate-ci + main-is: gen_ci.hs + ghc-options: -Wall + build-depends: base, + containers, + bytestring, + aeson >= 1.8.1 + default-language: Haskell2010 ===================================== .gitlab/generate-ci/update-ci ===================================== @@ -0,0 +1,16 @@ +#!/usr/bin/env bash + +out_dir="$(git rev-parse --show-toplevel)/.gitlab" + +# Update job metadata for ghcup +generate-ci metadata "$out_dir/jobs-metadata.json" +echo "Updated $out_dir/jobs-metadata.json" + +# Update CI jobs +tmp="$(mktemp)" +generate-ci gitlab "$tmp" +rm -f "$out_dir/jobs.yaml" +echo "### THIS IS A GENERATED FILE, DO NOT MODIFY DIRECTLY" > "$out_dir/jobs.yaml" +cat "$tmp" | jq >> "$out_dir/jobs.yaml" +rm "$tmp" +echo "Updated $out_dir/jobs.yaml" ===================================== .gitlab/generate_job_metadata deleted ===================================== @@ -1,5 +0,0 @@ -#! /usr/bin/env nix-shell -#!nix-shell -i bash -p cabal-install "haskell.packages.ghc92.ghcWithPackages (pkgs: with pkgs; [aeson])" git jq - -cd "$(dirname "${BASH_SOURCE[0]}")" -cabal run gen_ci -- metadata jobs-metadata.json ===================================== .gitlab/generate_jobs deleted ===================================== @@ -1,13 +0,0 @@ -#!/usr/bin/env nix-shell -#!nix-shell -i bash -p cabal-install "haskell.packages.ghc92.ghcWithPackages (pkgs: with pkgs; [aeson])" git jq - -# shellcheck shell=bash - -set -euo pipefail - -cd "$(dirname "${BASH_SOURCE[0]}")" -tmp=$(mktemp) -cabal run gen_ci -- gitlab $tmp -rm -f jobs.yaml -echo "### THIS IS A GENERATED FILE, DO NOT MODIFY DIRECTLY" > jobs.yaml -cat $tmp | jq | tee -a jobs.yaml View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9a99d77805cf9b9a0508f8cfdffb68d0463ab049 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9a99d77805cf9b9a0508f8cfdffb68d0463ab049 You're receiving 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 Jun 29 01:45:15 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 28 Jun 2023 21:45:15 -0400 Subject: [Git][ghc/ghc][wip/testsuite-output-patch] 4 commits: gitlab-ci: Refactor compilation of gen_ci Message-ID: <649ce22bc6314_3b5ae219a235dc4432df@gitlab.mail> Ben Gamari pushed to branch wip/testsuite-output-patch at Glasgow Haskell Compiler / GHC Commits: 9a99d778 by Ben Gamari at 2023-06-28T21:44:42-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - af2b77d8 by Ben Gamari at 2023-06-28T21:44:55-04:00 Drop circle-ci-job.sh - - - - - ee046a22 by Ben Gamari at 2023-06-28T21:44:55-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - a4408099 by Ben Gamari at 2023-06-28T21:44:55-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 16 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/update-ci - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - testsuite/driver/runtests.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py Changes: ===================================== .gitlab-ci.yml ===================================== @@ -274,13 +274,10 @@ lint-ci-config: GIT_SUBMODULE_STRATEGY: none before_script: - echo "experimental-features = nix-command flakes" >> /etc/nix/nix.conf - - nix-channel --update script: - - .gitlab/generate_jobs + - nix run .gitlab/generate-ci#update-ci # 1 if .gitlab/generate_jobs changed the output of the generated config - nix shell nixpkgs#git -c git diff --exit-code - # And run this to just make sure that works - - .gitlab/generate_job_metadata dependencies: [] lint-submods: ===================================== .gitlab/ci.sh ===================================== @@ -673,12 +673,14 @@ function test_hadrian() { --summary-junit=./junit.xml \ --test-have-intree-files \ --test-compiler="${test_compiler}" \ - "runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian main testsuite" + "runtest.opts+=${RUNTEST_ARGS:-}" \ + "runtest.opts+=--unexpected-output-dir=$TOP/unexpected-test-output" \ + || fail "hadrian main testsuite" + tar -czf unexpected-test-output.tar.gz unexpected-test-output info "STAGE2_TEST=$?" - fi - + fi } function summarise_hi_files() { ===================================== .gitlab/circle-ci-job.sh deleted ===================================== @@ -1,110 +0,0 @@ -# Circle CI "backend" for Gitlab CI -# ================================= -# -# Usage example: -# .gitlab/circle-ci-job.sh validate-x86_64-linux -# -# There are two things to configure to get artifacts to be -# uploaded to gitlab properly: -# -# - At https:///admin/application_settings, expand the -# Continuous Integration and Deployment section and set the -# "Maximum artifacts size (MB)" field to something large enough -# to contain the bindists (the test reports are tiny in comparison). -# 500MB seems to work fine, but 200MB might be sufficient. -# -# - If gitlab is exposed behind some form of proxy (e.g nginx), make sure -# the maximum client request body size is large enough to contain all the -# artifacts of a build. For nginx, this would be the following configuration -# option: https://nginx.org/en/docs/http/ngx_http_core_module.html#client_max_body_size -# (which can be set with services.nginx.clientMaxBodySize on nixos). - -#!/usr/bin/env sh - -set -e - -GHCCI_URL="localhost:8888" - -[ $# -gt 0 ] || (echo You need to pass the Circle CI job type as argument to this script; exit 1) -[ ${CI_RUNNER_ID:-} ] || (echo "CI_RUNNER_ID is not set"; exit 1) -[ ${CI_JOB_ID:-} ] || (echo "CI_JOB_ID is not set"; exit 1) -[ ${CI_COMMIT_SHA:-} ] || (echo "CI_COMMIT_SHA is not set"; exit 1) -[ ${CI_REPOSITORY_URL:-} ] || (echo "CI_REPOSITORY_URL is not set"; exit 1) -[ ${CI_PIPELINE_ID:-} ] || (echo "CI_PIPELINE_ID is not set"; exit 1) -# the first argument to this script is the Circle CI job type: -# validate-x86_64-linux, validate-i386-linux, ... -CIRCLE_JOB="circleci-$1" - -gitlab_user=$(echo $CI_REPOSITORY_URL | cut -d/ -f4) -gitlab_repo=$(echo $CI_REPOSITORY_URL | cut -d/ -f5 | cut -d. -f1) - -BODY="{ \"jobType\": \"$CIRCLE_JOB\", \"source\": { \"user\": \"$gitlab_user\", \"project\":\"$gitlab_repo\", \"commit\":\"$CI_COMMIT_SHA\" }, \"pipelineID\": $CI_PIPELINE_ID, \"runnerID\": $CI_RUNNER_ID, \"jobID\": $CI_JOB_ID }" - - -RESP=$(curl -s -XPOST -H "Content-Type: application/json" -d "$BODY" \ - http://${GHCCI_URL}/job) - -if [ $? -eq 0 ]; then - build_num=$(echo $RESP | jq '.build_num') - circle_url=$(echo $RESP | jq '.url') -else - echo "Couldn't submit job" - echo $RESP - exit 1 -fi - -echo Circle CI build number: $build_num -echo Circle CI build page: $circle_url - -outcome="null" -STATUS_URL="http://${GHCCI_URL}/job/${build_num}" -STATUS_RESP="" - -while [ "$outcome" == "null" ]; do - sleep 30s - STATUS_RESP=$(curl -s $STATUS_URL) - if [ $? -eq 0 ]; then - new_outcome=$(echo $STATUS_RESP | jq '.outcome') - jq_exitcode=$? - if [ "$new_outcome" == "null" ] && [ $jq_exitcode -ne 0 ]; then - echo "Couldn't read 'outcome' field in JSON:" - echo $STATUS_RESP - echo "Skipping" - else - outcome="$new_outcome" - fi - else - echo "curl failed:" - echo $STATUS_RESP - echo "Skipping" - fi -done - -if [ "$outcome" == "\"success\"" ]; then - echo The build passed - artifactsBody=$(curl -s http://${GHCCI_URL}/job/${build_num}/artifacts) - (echo $artifactsBody | jq '.[] | .url' | xargs wget -q) || echo "No artifacts" - exit 0 -else - echo The build failed - - artifactsBody=$(curl -s http://${GHCCI_URL}/job/${build_num}/artifacts) - (echo $artifactsBody | jq '.[] | .url' | xargs wget -q) || echo "No artifacts" - - failing_step=$(echo $STATUS_RESP | jq '.steps | .[] | .actions | .[] | select(.status != "success")') - failing_step_name=$(echo $failing_step | jq '.name' | sed -e 's/^"//' -e 's/"$//' -e 's/\\r\\n/\n/') - echo "Failing step: $failing_step_name" - - failing_cmds=$(echo $failing_step | jq '.bash_command' | sed -e 's/^"//' -e 's/"$//' -e 's/\\r\\n/\n/') - echo "Failing command(s):" - echo $failing_cmds - - log_url=$(echo $failing_step | jq '.output_url' | sed -e 's/^"//' -e 's/"$//' -e 's/\\r\\n/\n/') - echo "Log url: $log_url" - - last_log_lines=$(curl -s $log_url | gunzip | jq '.[] | select(.type == "out") | .message' | sed -e 's/^"//' -e 's/"$//' -e 's/\\r\\n/\n/' | tail -50) - echo End of the build log: - echo $last_log_lines - - exit 1 -fi ===================================== .gitlab/generate-ci/LICENSE ===================================== @@ -0,0 +1,30 @@ +Copyright (c) 2023, The GHC Developers + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of The GHC Developers nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ===================================== .gitlab/generate-ci/README.mkd ===================================== @@ -0,0 +1,26 @@ +# generate-ci + +This is the generator for GHC's GitLab CI infrastructure. In particular, this +generates `.gitlab/jobs.yaml`, which is a YAML (or, strictly speaking, JSON) +file which defines the bulk of the validation, nightly, and release jobs of +GHC's CI. + + +## Modifying the CI configuration (nix) + +The jobs are defined in `gen_ci.hs`. After modifying this you can run +```sh +nix run .gitlab/generate-ci#update-ci +``` +from the top of the GHC repository to update the generated configuration. + + +## Modifying the CI configuration (without nix) + +One can run `update-ci` without Nix as follows (assuming one has `jq`, +`cabal-install`, and GHC installed): +```sh +$ cabal build generate-ci +$ PATH="$(dirname $(cabal list-bin generate-ci)):$PATH" +$ ./update-ci +``` ===================================== .gitlab/generate-ci/flake.lock ===================================== @@ -0,0 +1,59 @@ +{ + "nodes": { + "flake-utils": { + "inputs": { + "systems": "systems" + }, + "locked": { + "lastModified": 1687709756, + "narHash": "sha256-Y5wKlQSkgEK2weWdOu4J3riRd+kV/VCgHsqLNTTWQ/0=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "dbabf0ca0c0c4bce6ea5eaf65af5cb694d2082c7", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "nixpkgs": { + "locked": { + "lastModified": 1687886075, + "narHash": "sha256-PeayJDDDy+uw1Ats4moZnRdL1OFuZm1Tj+KiHlD67+o=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "a565059a348422af5af9026b5174dc5c0dcefdae", + "type": "github" + }, + "original": { + "id": "nixpkgs", + "type": "indirect" + } + }, + "root": { + "inputs": { + "flake-utils": "flake-utils", + "nixpkgs": "nixpkgs" + } + }, + "systems": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } + } + }, + "root": "root", + "version": 7 +} ===================================== .gitlab/generate-ci/flake.nix ===================================== @@ -0,0 +1,33 @@ +{ + description = "GHC CI Generator"; + + inputs.flake-utils.url = "github:numtide/flake-utils"; + + outputs = { self, nixpkgs, flake-utils }: + flake-utils.lib.eachDefaultSystem (system: + let pkgs = nixpkgs.legacyPackages.${system}; in + { + packages = rec { + update-ci = pkgs.runCommand "update-ci" { + nativeBuildInputs = with pkgs; [ makeWrapper ]; + } '' + mkdir -p $out/bin + makeWrapper ${./update-ci} $out/bin/update-ci \ + --prefix PATH : ${with pkgs; lib.makeBinPath [ generate-ci jq gitMinimal ]} + ''; + + generate-ci = pkgs.haskellPackages.callCabal2nix "generate-ci" ./. {}; + + default = update-ci; + }; + + apps = rec { + update-ci = flake-utils.lib.mkApp { + drv = self.packages.${system}.update-ci; + }; + + default = update-ci; + }; + } + ); +} ===================================== .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs ===================================== @@ -3,9 +3,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{- cabal: -build-depends: base, aeson >= 1.8.1, containers, bytestring --} import Data.Aeson as A import qualified Data.Map as Map @@ -699,16 +696,19 @@ 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 + , let runtestArgs = + [ "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity" + | validateNonmovingGc buildConfig + ] + in "RUNTEST_ARGS" =: unwords runtestArgs ] jobArtifacts = Artifacts { junitReport = "junit.xml" , expireIn = "2 weeks" , artifactPaths = [binDistName arch opsys buildConfig ++ ".tar.xz" - ,"junit.xml"] + ,"junit.xml" + ,"unexpected-test-output.tar.gz"] , artifactsWhen = ArtifactsAlways } ===================================== .gitlab/generate-ci/generate-ci.cabal ===================================== @@ -0,0 +1,15 @@ +cabal-version: 3.0 +name: generate-ci +version: 0.1.0.0 +license: BSD-3-Clause +license-file: LICENSE +build-type: Simple + +executable generate-ci + main-is: gen_ci.hs + ghc-options: -Wall + build-depends: base, + containers, + bytestring, + aeson >= 1.8.1 + default-language: Haskell2010 ===================================== .gitlab/generate-ci/update-ci ===================================== @@ -0,0 +1,16 @@ +#!/usr/bin/env bash + +out_dir="$(git rev-parse --show-toplevel)/.gitlab" + +# Update job metadata for ghcup +generate-ci metadata "$out_dir/jobs-metadata.json" +echo "Updated $out_dir/jobs-metadata.json" + +# Update CI jobs +tmp="$(mktemp)" +generate-ci gitlab "$tmp" +rm -f "$out_dir/jobs.yaml" +echo "### THIS IS A GENERATED FILE, DO NOT MODIFY DIRECTLY" > "$out_dir/jobs.yaml" +cat "$tmp" | jq >> "$out_dir/jobs.yaml" +rm "$tmp" +echo "Updated $out_dir/jobs.yaml" ===================================== .gitlab/generate_job_metadata deleted ===================================== @@ -1,5 +0,0 @@ -#! /usr/bin/env nix-shell -#!nix-shell -i bash -p cabal-install "haskell.packages.ghc92.ghcWithPackages (pkgs: with pkgs; [aeson])" git jq - -cd "$(dirname "${BASH_SOURCE[0]}")" -cabal run gen_ci -- metadata jobs-metadata.json ===================================== .gitlab/generate_jobs deleted ===================================== @@ -1,13 +0,0 @@ -#!/usr/bin/env nix-shell -#!nix-shell -i bash -p cabal-install "haskell.packages.ghc92.ghcWithPackages (pkgs: with pkgs; [aeson])" git jq - -# shellcheck shell=bash - -set -euo pipefail - -cd "$(dirname "${BASH_SOURCE[0]}")" -tmp=$(mktemp) -cabal run gen_ci -- gitlab $tmp -rm -f jobs.yaml -echo "### THIS IS A GENERATED FILE, DO NOT MODIFY DIRECTLY" > jobs.yaml -cat $tmp | jq | tee -a jobs.yaml ===================================== .gitlab/jobs.yaml ===================================== @@ -11,7 +11,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-aarch64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -59,6 +60,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-darwin-validate" } }, @@ -73,7 +75,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -117,6 +120,7 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate" } }, @@ -131,7 +135,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-i386-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -175,6 +180,7 @@ "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb9-validate" } }, @@ -189,7 +195,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -237,6 +244,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-darwin-validate", "XZ_OPT": "-9" } @@ -252,7 +260,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -296,6 +305,7 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -311,7 +321,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -355,6 +366,7 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate+llvm", "XZ_OPT": "-9" } @@ -370,7 +382,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-i386-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -414,6 +427,7 @@ "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb9-validate", "XZ_OPT": "-9" } @@ -429,7 +443,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -477,6 +492,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-darwin-validate", "XZ_OPT": "-9", "ac_cv_func_clock_gettime": "no", @@ -495,7 +511,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-freebsd13-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -541,6 +558,7 @@ "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-freebsd13-validate", "XZ_OPT": "-9" } @@ -556,7 +574,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -603,6 +622,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-int_native-validate+fully_static", "XZ_OPT": "-9" } @@ -618,7 +638,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -665,6 +686,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-validate", "XZ_OPT": "-9" } @@ -680,7 +702,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -727,6 +750,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-validate+fully_static", "XZ_OPT": "-9" } @@ -742,7 +766,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -788,6 +813,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -803,7 +829,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -849,6 +876,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -864,7 +892,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -910,6 +939,7 @@ "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -925,7 +955,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-centos7-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -970,6 +1001,7 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-centos7-validate", "XZ_OPT": "-9" } @@ -985,7 +1017,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1029,6 +1062,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-int_native-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-int_native-validate", "XZ_OPT": "-9" } @@ -1044,7 +1078,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-no_tntc-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1088,6 +1123,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-no_tntc-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--disable-tables-next-to-code", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate", "XZ_OPT": "-9" } @@ -1103,7 +1139,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1148,6 +1185,7 @@ "BUILD_FLAVOUR": "slow-validate", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate", "XZ_OPT": "-9" } @@ -1163,7 +1201,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-unreg-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1207,6 +1246,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-unreg-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-unregisterised", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-unreg-validate", "XZ_OPT": "-9" } @@ -1222,7 +1262,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1266,6 +1307,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -1281,7 +1323,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1325,6 +1368,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+debug_info", "XZ_OPT": "-9" } @@ -1340,7 +1384,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1384,6 +1429,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+llvm", "XZ_OPT": "-9" } @@ -1399,7 +1445,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1444,6 +1491,7 @@ "BUILD_FLAVOUR": "validate+thread_sanitizer", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions", "XZ_OPT": "-9" @@ -1460,7 +1508,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1506,6 +1555,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "XZ_OPT": "-9" } @@ -1521,7 +1571,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1568,6 +1619,7 @@ "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate", "XZ_OPT": "-9" } @@ -1583,7 +1635,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1627,6 +1680,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-validate", "XZ_OPT": "-9" } @@ -1642,7 +1696,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1702,7 +1757,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1746,6 +1802,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb9-validate", "XZ_OPT": "-9" } @@ -1761,7 +1818,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1807,6 +1865,7 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -1822,7 +1881,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1869,6 +1929,7 @@ "HADRIAN_ARGS": "--haddock-base-url", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -1884,7 +1945,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1930,6 +1992,7 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-validate+debug_info", "XZ_OPT": "-9" } @@ -1945,7 +2008,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-rocky8-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1990,6 +2054,7 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-rocky8-validate", "XZ_OPT": "-9" } @@ -2005,7 +2070,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-ubuntu18_04-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2049,6 +2115,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu18_04-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu18_04-validate", "XZ_OPT": "-9" } @@ -2064,7 +2131,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-ubuntu20_04-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2108,6 +2176,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu20_04-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu20_04-validate", "XZ_OPT": "-9" } @@ -2122,7 +2191,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-windows-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2167,6 +2237,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-int_native-validate", "XZ_OPT": "-9" } @@ -2181,7 +2252,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-windows-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2226,6 +2298,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-validate", "XZ_OPT": "-9" } @@ -2241,7 +2314,8 @@ "expire_in": "1 year", "paths": [ "ghc-aarch64-darwin-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2290,6 +2364,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-darwin-release", "XZ_OPT": "-9" } @@ -2305,7 +2380,8 @@ "expire_in": "1 year", "paths": [ "ghc-aarch64-linux-deb10-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2351,6 +2427,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-release+no_split_sections", "XZ_OPT": "-9" } @@ -2366,7 +2443,8 @@ "expire_in": "1 year", "paths": [ "ghc-i386-linux-deb9-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2412,6 +2490,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb9-release+no_split_sections", "XZ_OPT": "-9" } @@ -2427,7 +2506,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-darwin-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2476,6 +2556,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-darwin-release", "XZ_OPT": "-9", "ac_cv_func_clock_gettime": "no", @@ -2494,7 +2575,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2542,6 +2624,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-int_native-release+fully_static", "XZ_OPT": "-9" } @@ -2557,7 +2640,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-release+fully_static+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2605,6 +2689,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-release+fully_static+no_split_sections", "XZ_OPT": "-9" } @@ -2620,7 +2705,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2668,6 +2754,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-release+no_split_sections", "XZ_OPT": "-9" } @@ -2683,7 +2770,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-centos7-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2729,6 +2817,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-centos7-release+no_split_sections", "XZ_OPT": "-9" } @@ -2744,7 +2833,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb10-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2790,6 +2880,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-release", "XZ_OPT": "-9" } @@ -2805,7 +2896,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb10-release+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2851,6 +2943,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-release+debug_info", "XZ_OPT": "-9" } @@ -2866,7 +2959,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb11-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2912,6 +3006,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-release", "XZ_OPT": "-9" } @@ -2927,7 +3022,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb11-release+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2989,7 +3085,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb9-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3035,6 +3132,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb9-release+no_split_sections", "XZ_OPT": "-9" } @@ -3050,7 +3148,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3098,6 +3197,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -3113,7 +3213,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3161,6 +3262,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release+debug_info", "XZ_OPT": "-9" } @@ -3176,7 +3278,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3224,6 +3327,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -3239,7 +3343,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-rocky8-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3285,6 +3390,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-rocky8-release", "XZ_OPT": "-9" } @@ -3300,7 +3406,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-ubuntu18_04-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3346,6 +3453,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu18_04-release", "XZ_OPT": "-9" } @@ -3361,7 +3469,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-ubuntu20_04-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3407,6 +3516,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu20_04-release", "XZ_OPT": "-9" } @@ -3421,7 +3531,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-windows-int_native-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3467,6 +3578,7 @@ "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-int_native-release+no_split_sections", "XZ_OPT": "-9" } @@ -3481,7 +3593,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-windows-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3527,6 +3640,7 @@ "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-release+no_split_sections", "XZ_OPT": "-9" } @@ -3542,7 +3656,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3590,6 +3705,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-darwin-validate", "ac_cv_func_clock_gettime": "no", "ac_cv_func_futimens": "no", @@ -3607,7 +3723,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-freebsd13-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3653,6 +3770,7 @@ "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-freebsd13-validate" } }, @@ -3667,7 +3785,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3714,6 +3833,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-validate+fully_static" } }, @@ -3728,7 +3848,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3774,6 +3895,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static" } }, @@ -3788,7 +3910,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3835,6 +3958,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static" } }, @@ -3849,7 +3973,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3896,6 +4021,7 @@ "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static" } }, @@ -3910,7 +4036,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3954,6 +4081,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-int_native-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-int_native-validate" } }, @@ -3968,7 +4096,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-no_tntc-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4013,6 +4142,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-no_tntc-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--disable-tables-next-to-code", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate" } }, @@ -4027,7 +4157,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4072,6 +4203,7 @@ "BUILD_FLAVOUR": "slow-validate", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate" } }, @@ -4086,7 +4218,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-unreg-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4130,6 +4263,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-unreg-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-unregisterised", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-unreg-validate" } }, @@ -4144,7 +4278,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4188,6 +4323,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate" } }, @@ -4202,7 +4338,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4246,6 +4383,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+debug_info" } }, @@ -4260,7 +4398,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4304,6 +4443,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+llvm" } }, @@ -4318,7 +4458,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4364,6 +4505,7 @@ "BUILD_FLAVOUR": "validate+thread_sanitizer", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" } @@ -4379,7 +4521,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4425,6 +4568,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" } }, @@ -4439,7 +4583,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4486,6 +4631,7 @@ "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate" } }, @@ -4500,7 +4646,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4559,7 +4706,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4605,6 +4753,7 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release" } }, @@ -4618,7 +4767,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-windows-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4663,6 +4813,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-validate" } } ===================================== testsuite/driver/runtests.py ===================================== @@ -71,6 +71,7 @@ parser.add_argument("--config", action='append', help="config field") parser.add_argument("--rootdir", action='append', help="root of tree containing tests (default: .)") parser.add_argument("--metrics-file", help="file in which to save (append) the performance test metrics. If omitted, git notes will be used.") parser.add_argument("--summary-file", help="file in which to save the (human-readable) summary") +parser.add_argument("--unexpected-output-dir", help="directory in which to place unexpected output") parser.add_argument("--target-wrapper", help="wrapper executable to use when executing binaries compiled for the target") parser.add_argument("--no-print-summary", action="store_true", help="should we print the summary?") parser.add_argument("--only", action="append", help="just this test (can be give multiple --only= flags)") @@ -128,6 +129,9 @@ if args.top: if args.test_package_db: config.test_package_db = args.test_package_db +if args.unexpected_output_dir: + config.unexpected_output_dir = Path(args.unexpected_output_dir) + if args.only: config.only = args.only config.run_only_some_tests = True ===================================== testsuite/driver/testglobals.py ===================================== @@ -203,7 +203,7 @@ class TestConfig: self.baseline_commit = None # type: Optional[GitRef] # Additional package dbs to inspect for test dependencies. - self.test_package_db = [] # type: [PathToPackageDb] + self.test_package_db = [] # type: List[PathToPackageDb] # Should we skip performance tests self.skip_perf_tests = False @@ -225,6 +225,10 @@ class TestConfig: # See Note [Haddock runtime stats files] at the bottom of this file. self.stats_files_dir = Path('/please_set_stats_files_dir') + # Where to place observed output files on when unexpected output + # is observed. + self.unexpected_output_dir = None # type: Optional[Path] + # Should we cleanup after test runs? self.cleanup = True ===================================== testsuite/driver/testlib.py ===================================== @@ -2257,11 +2257,15 @@ async def check_prof_ok(name: TestName, way: WayName) -> bool: # new output. Returns true if output matched or was accepted, false # otherwise. See Note [Output comparison] for the meaning of the # normaliser and whitespace_normaliser parameters. -async def compare_outputs(way: WayName, - kind: str, - normaliser: OutputNormalizer, - expected_file, actual_file, diff_file=None, - whitespace_normaliser: OutputNormalizer=lambda x:x) -> bool: +async def compare_outputs( + way: WayName, + kind: str, + normaliser: OutputNormalizer, + expected_file: Path, + actual_file: Path, + diff_file: Optional[Path]=None, + whitespace_normaliser: OutputNormalizer=lambda x:x) -> bool: + # Respect ignore_stdout and ignore_stderr options if kind == 'stderr' and getTestOpts().ignore_stderr: return True @@ -2338,6 +2342,12 @@ async def compare_outputs(way: WayName, expected_path.unlink() return True else: + if config.unexpected_output_dir is not None: + ghc_root = expected_path.relative_to(config.top.parent) + out = config.unexpected_output_dir / ghc_root + out.parent.mkdir(exist_ok=True, parents=True) + write_file(out, actual_raw) + return False # Checks that each line from pattern_file is present in actual_file as @@ -2392,6 +2402,15 @@ def grep_output(normaliser: OutputNormalizer, pattern_file, actual_file, is_subs # squash all whitespace, making the diff unreadable. Instead we rely # on the `diff` program to ignore whitespace changes as much as # possible (#10152). +# +# In addition, to aid CI users we will optionally collect all +# of the unexpected output that we encountered in the +# directory at config.unexpected_output_dir. The intent here is for this +# directory to be preserved as a CI artifact which can then +# be downloaded by the user and committed to their branch +# to address CI failures on platforms which they cannot +# test locally. + # Note [Null device handling] # ~~~~~~~~~~~~~~~~~~~~~~~~~~~ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7540d3405b0f97575071e70149e72caedc302bec...a4408099b1dfe10e00a2edb2a874fce5f87056d2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7540d3405b0f97575071e70149e72caedc302bec...a4408099b1dfe10e00a2edb2a874fce5f87056d2 You're receiving 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 Jun 29 03:16:21 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Wed, 28 Jun 2023 23:16:21 -0400 Subject: [Git][ghc/ghc][wip/ci-interface-stability] 229 commits: testsuite: fix predicate on rdynamic test Message-ID: <649cf785257d7_3b5ae219a509ec449639@gitlab.mail> Ben Gamari pushed to branch wip/ci-interface-stability at Glasgow Haskell Compiler / GHC Commits: c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 9a99d778 by Ben Gamari at 2023-06-28T21:44:42-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - af2b77d8 by Ben Gamari at 2023-06-28T21:44:55-04:00 Drop circle-ci-job.sh - - - - - ee046a22 by Ben Gamari at 2023-06-28T21:44:55-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - a4408099 by Ben Gamari at 2023-06-28T21:44:55-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 6ac491e6 by Ben Gamari at 2023-06-28T21:45:16-04:00 compiler: Make OccSet opaque - - - - - 07551563 by Ben Gamari at 2023-06-28T21:45:16-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - f4b5f157 by Ben Gamari at 2023-06-28T23:16:10-04: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. - - - - - 26 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/darwin/toolchain.nix - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/update-ci - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - HACKING.md - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d9c6b7a88ae2c1c666a86c971d3549c5fc8a637d...f4b5f1572a0b3474daf62af8df9488574e4aec51 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d9c6b7a88ae2c1c666a86c971d3549c5fc8a637d...f4b5f1572a0b3474daf62af8df9488574e4aec51 You're receiving 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 Jun 29 07:05:02 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Thu, 29 Jun 2023 03:05:02 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/pattern-@a-binders] 23 commits: Stop configuring unused Ld command in `settings` Message-ID: <649d2d1eeded6_3b5ae218dd55f04724e9@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/pattern- at a-binders at Glasgow Haskell Compiler / GHC Commits: ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 09946c74 by Andrei Borzenkov at 2023-06-29T07:04:59+00:00 Draft: Type patterns (22478, 18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - 19f42c67 by Andrei Borzenkov at 2023-06-29T07:04:59+00:00 Add more notes and comments to the patch - - - - - 30 changed files: - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.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 - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/Types.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Splice.hs-boot - compiler/GHC/Rename/Utils.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/94791a6126351f76240c7f76448bb22886f866ef...19f42c6793547def0cd5d5d29a6f4a0072146a4d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/94791a6126351f76240c7f76448bb22886f866ef...19f42c6793547def0cd5d5d29a6f4a0072146a4d You're receiving 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 Jun 29 07:18:41 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Thu, 29 Jun 2023 03:18:41 -0400 Subject: [Git][ghc/ghc][wip/testsuite-no-cusks-transitional] 22 commits: Stop configuring unused Ld command in `settings` Message-ID: <649d30511d581_3b5ae218c145184765ee@gitlab.mail> Vladislav Zavialov pushed to branch wip/testsuite-no-cusks-transitional at Glasgow Haskell Compiler / GHC Commits: ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - caeb366d by Vladislav Zavialov at 2023-06-29T09:50:30+03:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 30 changed files: - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.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 - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/SysTools/Tasks.hs - compiler/GHC/Tc/Gen/HsType.hs - configure.ac - distrib/configure.ac.in - ghc/Main.hs - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d30d7803ed6cf53bac4876b9270f527a8658d4e1...caeb366db13ecdb8de40ed91f0af0e45351c7e07 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d30d7803ed6cf53bac4876b9270f527a8658d4e1...caeb366db13ecdb8de40ed91f0af0e45351c7e07 You're receiving 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 Jun 29 07:49:48 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 29 Jun 2023 03:49:48 -0400 Subject: [Git][ghc/ghc][wip/T22010] Remove GHC.Utils.Containers.Internal.Prelude Message-ID: <649d379c4db99_3b5ae218dd55f0481055@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: bfdc2dd2 by Jaro Reinders at 2023-06-29T09:49:40+02:00 Remove GHC.Utils.Containers.Internal.Prelude - - - - - 9 changed files: - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Data/Word64Map/Internal.hs - compiler/GHC/Data/Word64Map/Strict/Internal.hs - compiler/GHC/Data/Word64Set/Internal.hs - compiler/GHC/Utils/Containers/Internal/BitUtil.hs - − compiler/GHC/Utils/Containers/Internal/Prelude.hs - compiler/ghc.cabal.in - testsuite/tests/count-deps/CountDepsAst.stdout - testsuite/tests/count-deps/CountDepsParser.stdout Changes: ===================================== compiler/GHC/Builtin/Uniques.hs ===================================== @@ -69,7 +69,7 @@ import GHC.Utils.Panic import GHC.Utils.Panic.Plain (assert) import Data.Maybe -import GHC.Utils.Word64 (word64ToInt, intToWord64) +import GHC.Utils.Word64 (word64ToInt) -- | Get the 'Name' associated with a known-key 'Unique'. knownUniqueName :: Unique -> Maybe Name @@ -283,9 +283,7 @@ isTupleTyConUnique u = where (tag, n) = unpkUnique u (arity', i) = quotRem n 2 - arity = - assert (arity' <= intToWord64 (maxBound :: Int)) - (word64ToInt arity') + arity = word64ToInt arity' getTupleTyConName :: Boxity -> Int -> Name getTupleTyConName boxity n = ===================================== compiler/GHC/Data/Word64Map/Internal.hs ===================================== @@ -298,21 +298,16 @@ module GHC.Data.Word64Map.Internal ( , mapGentlyWhenMatched ) where +import GHC.Prelude.Basic hiding + (lookup, filter, foldr, foldl, foldl', null, map) + import Data.Functor.Identity (Identity (..)) -import Data.Semigroup (Semigroup(stimes)) -#if !(MIN_VERSION_base(4,11,0)) -import Data.Semigroup (Semigroup((<>))) -#endif -import Data.Semigroup (stimesIdempotentMonoid) +import Data.Semigroup (Semigroup(stimes,(<>)),stimesIdempotentMonoid) import Data.Functor.Classes import Control.DeepSeq (NFData(rnf)) -import Data.Bits import qualified Data.Foldable as Foldable import Data.Maybe (fromMaybe) -import GHC.Utils.Containers.Internal.Prelude hiding - (lookup, map, filter, foldr, foldl, null) -import Prelude () import GHC.Data.Word64Set.Internal (Key) import qualified GHC.Data.Word64Set.Internal as Word64Set ===================================== compiler/GHC/Data/Word64Map/Strict/Internal.hs ===================================== @@ -253,11 +253,9 @@ module GHC.Data.Word64Map.Strict.Internal ( , maxViewWithKey ) where -import GHC.Utils.Containers.Internal.Prelude hiding - (lookup,map,filter,foldr,foldl,null) -import Prelude () +import GHC.Prelude.Basic hiding + (lookup, filter, foldr, foldl, foldl', null, map) -import Data.Bits import qualified GHC.Data.Word64Map.Internal as L import GHC.Data.Word64Map.Internal ( Word64Map (..) ===================================== compiler/GHC/Data/Word64Set/Internal.hs ===================================== @@ -198,14 +198,9 @@ import Control.DeepSeq (NFData(rnf)) import Data.Bits import qualified Data.List as List import Data.Maybe (fromMaybe) -import Data.Semigroup (Semigroup(stimes)) -#if !(MIN_VERSION_base(4,11,0)) -import Data.Semigroup (Semigroup((<>))) -#endif -import Data.Semigroup (stimesIdempotentMonoid) -import GHC.Utils.Containers.Internal.Prelude hiding - (filter, foldr, foldl, null, map) -import Prelude () +import Data.Semigroup (Semigroup(stimes, (<>)), stimesIdempotentMonoid) +import GHC.Prelude.Basic hiding + (filter, foldr, foldl, foldl', null, map) import Data.Word ( Word64 ) import GHC.Utils.Containers.Internal.BitUtil ===================================== compiler/GHC/Utils/Containers/Internal/BitUtil.hs ===================================== @@ -37,10 +37,7 @@ module GHC.Utils.Containers.Internal.BitUtil , shiftRL ) where -import Data.Bits (popCount, unsafeShiftL, unsafeShiftR - , countLeadingZeros - ) -import Prelude +import GHC.Prelude.Basic import Data.Word {---------------------------------------------------------------------- ===================================== compiler/GHC/Utils/Containers/Internal/Prelude.hs deleted ===================================== @@ -1,18 +0,0 @@ -{-# LANGUAGE CPP #-} --- | This hideous module lets us avoid dealing with the fact that --- @liftA2@ wasn't previously exported from the standard prelude. -module GHC.Utils.Containers.Internal.Prelude - ( module Prelude - , Applicative (..) -#if !MIN_VERSION_base(4,10,0) - , liftA2 -#endif - ) - where - -import Prelude hiding (Applicative(..)) -import Control.Applicative(Applicative(..)) - -#if !MIN_VERSION_base(4,10,0) -import Control.Applicative(liftA2) -#endif ===================================== compiler/ghc.cabal.in ===================================== @@ -877,7 +877,6 @@ Library GHC.Utils.BufHandle GHC.Utils.CliOption GHC.Utils.Constants - GHC.Utils.Containers.Internal.Prelude GHC.Utils.Containers.Internal.BitUtil GHC.Utils.Containers.Internal.StrictPair GHC.Utils.Error ===================================== testsuite/tests/count-deps/CountDepsAst.stdout ===================================== @@ -294,7 +294,6 @@ GHC.Utils.BufHandle GHC.Utils.CliOption GHC.Utils.Constants GHC.Utils.Containers.Internal.BitUtil -GHC.Utils.Containers.Internal.Prelude GHC.Utils.Containers.Internal.StrictPair GHC.Utils.Error GHC.Utils.Exception ===================================== testsuite/tests/count-deps/CountDepsParser.stdout ===================================== @@ -301,7 +301,6 @@ GHC.Utils.BufHandle GHC.Utils.CliOption GHC.Utils.Constants GHC.Utils.Containers.Internal.BitUtil -GHC.Utils.Containers.Internal.Prelude GHC.Utils.Containers.Internal.StrictPair GHC.Utils.Error GHC.Utils.Exception View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bfdc2dd2ea957df3bc034fe23446c911fcb32841 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bfdc2dd2ea957df3bc034fe23446c911fcb32841 You're receiving 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 Jun 29 08:02:30 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 29 Jun 2023 04:02:30 -0400 Subject: [Git][ghc/ghc][wip/T22010] Add comment to genSym and remove invalid TH note Message-ID: <649d3a961ae86_3b5ae21978c24c481673@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 5ca4dc96 by Jaro Reinders at 2023-06-29T10:02:22+02:00 Add comment to genSym and remove invalid TH note - - - - - 4 changed files: - compiler/GHC/Data/Word64Map/Internal.hs - compiler/GHC/Data/Word64Set/Internal.hs - compiler/GHC/Types/Unique/Supply.hs - testsuite/tests/linters/notes.stdout Changes: ===================================== compiler/GHC/Data/Word64Map/Internal.hs ===================================== @@ -2,7 +2,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE PatternGuards #-} #ifdef __GLASGOW_HASKELL__ --- {-# LANGUAGE DeriveLift #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} @@ -321,9 +320,6 @@ import Data.Data (Data(..), Constr, mkConstr, constrIndex, Fixity(Prefix), import GHC.Exts (build) import qualified GHC.Exts as GHCExts import Text.Read --- import Language.Haskell.TH.Syntax (Lift) --- See Note [ Template Haskell Dependencies ] --- import Language.Haskell.TH () #endif import qualified Control.Category as Category import Data.Word @@ -375,9 +371,6 @@ type Mask = Word64 type Word64SetPrefix = Word64 type Word64SetBitMap = Word64 --- | @since 0.6.6 --- deriving instance Lift a => Lift (Word64Map a) - bitmapOf :: Word64 -> Word64SetBitMap bitmapOf x = shiftLL 1 (fromIntegral (x .&. Word64Set.suffixBitMask)) {-# INLINE bitmapOf #-} ===================================== compiler/GHC/Data/Word64Set/Internal.hs ===================================== @@ -2,7 +2,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE PatternGuards #-} #ifdef __GLASGOW_HASKELL__ --- {-# LANGUAGE DeriveLift #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} @@ -214,9 +213,6 @@ import Text.Read #if __GLASGOW_HASKELL__ import qualified GHC.Exts --- import Language.Haskell.TH.Syntax (Lift) --- See Note [ Template Haskell Dependencies ] --- import Language.Haskell.TH () #endif import qualified Data.Foldable as Foldable @@ -273,11 +269,6 @@ type Mask = Word64 type BitMap = Word64 type Key = Word64 --- #ifdef __GLASGOW_HASKELL__ --- | @since 0.6.6 --- deriving instance Lift Word64Set --- #endif - instance Monoid Word64Set where mempty = empty mconcat = unions ===================================== compiler/GHC/Types/Unique/Supply.hs ===================================== @@ -228,6 +228,9 @@ mkSplitUniqSupply c (# s4, MkSplitUniqSupply (tag .|. u) x y #) }}}} +-- If a word is not 64 bits then we would need a fetchAddWord64Addr# primitive, +-- which does not exist. So we fall back on the C implementation in that case. + #if !MIN_VERSION_GLASGOW_HASKELL(9,1,0,0) || WORD_SIZE_IN_BITS != 64 foreign import ccall unsafe "genSym" genSym :: IO Word64 #else ===================================== testsuite/tests/linters/notes.stdout ===================================== @@ -6,8 +6,6 @@ ref compiler/GHC/Core/Opt/Simplify/Iteration.hs:4018:8: Note [Lambda-boun ref compiler/GHC/Core/Opt/Simplify/Utils.hs:1343:37: Note [Gentle mode] ref compiler/GHC/Core/Opt/Specialise.hs:1765:29: Note [Arity decrease] ref compiler/GHC/Core/TyCo/Rep.hs:1565:31: Note [What prevents a constraint from floating] -ref compiler/GHC/Data/Word64Map/Internal.hs:330:7: Note [ Template Haskell Dependencies ] -ref compiler/GHC/Data/Word64Set/Internal.hs:226:7: Note [ Template Haskell Dependencies ] ref compiler/GHC/Driver/DynFlags.hs:1245:49: Note [Eta-reduction in -O0] ref compiler/GHC/Driver/Main.hs:1762:34: Note [simpleTidyPgm - mkBootModDetailsTc] ref compiler/GHC/Hs/Expr.hs:194:63: Note [Pending Splices] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5ca4dc960ef05856ad862f4925add25d79b056b0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5ca4dc960ef05856ad862f4925add25d79b056b0 You're receiving 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 Jun 29 08:14:01 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 29 Jun 2023 04:14:01 -0400 Subject: [Git][ghc/ghc][master] Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Message-ID: <649d3d4939d2d_3b5ae21978c24c4884bc@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - 7 changed files: - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Session.hs - docs/users_guide/9.8.1-notes.rst - docs/users_guide/using-optimisation.rst - testsuite/tests/simplCore/should_compile/T8331.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -2490,6 +2490,12 @@ specArgFreeIds (SpecDict dx) = exprFreeIds dx specArgFreeIds UnspecType = emptyVarSet specArgFreeIds UnspecArg = emptyVarSet +specArgFreeVars :: SpecArg -> VarSet +specArgFreeVars (SpecType ty) = tyCoVarsOfType ty +specArgFreeVars (SpecDict dx) = exprFreeVars dx +specArgFreeVars UnspecType = emptyVarSet +specArgFreeVars UnspecArg = emptyVarSet + isSpecDict :: SpecArg -> Bool isSpecDict (SpecDict {}) = True isSpecDict _ = False @@ -2798,6 +2804,12 @@ non-dictionary bindings too. Note [Specialising polymorphic dictionaries] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Note June 2023: This has proved to be quite a tricky optimisation to get right +see (#23469, #23109, #21229, #23445) so it is now guarded by a flag +`-fpolymorphic-specialisation`. + + Consider class M a where { foo :: a -> Int } @@ -2988,14 +3000,23 @@ getTheta = fmap piTyBinderType . filter isInvisiblePiTyBinder . filter isAnonPiT ------------------------------------------------------------ -singleCall :: Id -> [SpecArg] -> UsageDetails -singleCall id args +singleCall :: SpecEnv -> Id -> [SpecArg] -> UsageDetails +singleCall spec_env id args = MkUD {ud_binds = emptyFDBs, ud_calls = unitDVarEnv id $ CIS id $ unitBag (CI { ci_key = args , ci_fvs = call_fvs }) } where - call_fvs = foldr (unionVarSet . specArgFreeIds) emptyVarSet args + call_fvs = + foldr (unionVarSet . free_var_fn) emptyVarSet args + + free_var_fn = + if gopt Opt_PolymorphicSpecialisation (se_dflags spec_env) + then specArgFreeIds + else specArgFreeVars + + + -- specArgFreeIds: we specifically look for free Ids, not TyVars -- see (MP1) in Note [Specialising polymorphic dictionaries] -- @@ -3014,7 +3035,7 @@ mkCallUDs' env f args | wantCallsFor env f -- We want it, and... , not (null ci_key) -- this call site has a useful specialisation = -- pprTrace "mkCallUDs: keeping" _trace_doc - singleCall f ci_key + singleCall env f ci_key | otherwise -- See also Note [Specialisations already covered] = -- pprTrace "mkCallUDs: discarding" _trace_doc ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -257,6 +257,7 @@ data GeneralFlag | Opt_Specialise | Opt_SpecialiseAggressively | Opt_CrossModuleSpecialise + | Opt_PolymorphicSpecialisation | Opt_InlineGenerics | Opt_InlineGenericsAggressively | Opt_StaticArgumentTransformation ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2432,6 +2432,7 @@ fFlagsDeps = [ flagSpec "specialize-aggressively" Opt_SpecialiseAggressively, flagSpec "cross-module-specialise" Opt_CrossModuleSpecialise, flagSpec "cross-module-specialize" Opt_CrossModuleSpecialise, + flagSpec "polymorphic-specialisation" Opt_PolymorphicSpecialisation, flagSpec "inline-generics" Opt_InlineGenerics, flagSpec "inline-generics-aggressively" Opt_InlineGenericsAggressively, flagSpec "static-argument-transformation" Opt_StaticArgumentTransformation, ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -174,11 +174,16 @@ Compiler D(D2) ) D = D1 | D2 - + This allows for changing the structure of a library without immediately breaking user code, but instead being able to warn the user that a change in the library interface will occur in the future. +- Guard polymorphic specialisation behind the flag :ghc-flag:`-fpolymorphic-specialisation`. + This optimisation has led to a number of incorrect runtime result bugs, so we are disabling it + by default for now whilst we consider more carefully an appropiate fix. + (See :ghc-ticket:`23469`, :ghc-ticket:`23109`, :ghc-ticket:`21229`, :ghc-ticket:`23445`) + GHCi ~~~~ @@ -241,8 +246,8 @@ Runtime system We use this functionality in GHCi to modify how some messages are displayed. - The extensions fields of constructors of ``IE`` now take ``Maybe (WarningTxt p)`` - in ``GhcPs`` and ``GhcRn`` variants of the Syntax Tree. - This represents the warning assigned to a certain export item, + in ``GhcPs`` and ``GhcRn`` variants of the Syntax Tree. + This represents the warning assigned to a certain export item, which is used for :ref:`deprecated-exports`. ``ghc-heap`` library ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -1113,6 +1113,21 @@ as such you shouldn't need to set any of them explicitly. A flag which they are called in this module. Note that specialisation must be enabled (by ``-fspecialise``) for this to have any effect. +.. ghc-flag:: -fpolymorphic-specialisation + :shortdesc: Allow specialisation to abstract over free type variables + :type: dynamic + :reverse: -fno-polymorphic-specialisation + :category: + + :default: off + + Warning, this feature is highly experimental and may lead to incorrect runtime + results. Use at your own risk (:ghc-ticket:`23469`, :ghc-ticket:`23109`, :ghc-ticket:`21229`, :ghc-ticket:`23445`). + + Enable specialisation of function calls to known dictionaries with free type variables. + The created specialisation will abstract over the type variables free in the dictionary. + + .. ghc-flag:: -flate-specialise :shortdesc: Run a late specialisation pass :type: dynamic ===================================== testsuite/tests/simplCore/should_compile/T8331.stderr ===================================== @@ -1,149 +1,5 @@ ==================== Tidy Core rules ==================== -"SPEC $c*> @(ST s) @_" - forall (@s) (@r) ($dApplicative :: Applicative (ST s)). - $fApplicativeReaderT_$c*> @(ST s) @r $dApplicative - = ($fApplicativeReaderT2 @s @r) - `cast` (forall (a :: <*>_N) (b :: <*>_N). - _R - %<'Many>_N ->_R _R - %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) - ; Sym (N:ReaderT[0] <*>_N _R _R _N) - :: Coercible - (forall {a} {b}. - ReaderT r (ST s) a -> ReaderT r (ST s) b -> r -> STRep s b) - (forall {a} {b}. - ReaderT r (ST s) a -> ReaderT r (ST s) b -> ReaderT r (ST s) b)) -"SPEC $c<$ @(ST s) @_" - forall (@s) (@r) ($dFunctor :: Functor (ST s)). - $fFunctorReaderT_$c<$ @(ST s) @r $dFunctor - = ($fApplicativeReaderT6 @s @r) - `cast` (forall (a :: <*>_N) (b :: <*>_N). - _R - %<'Many>_N ->_R _R - %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) - ; Sym (N:ReaderT[0] <*>_N _R _R _N) - :: Coercible - (forall {a} {b}. a -> ReaderT r (ST s) b -> r -> STRep s a) - (forall {a} {b}. a -> ReaderT r (ST s) b -> ReaderT r (ST s) a)) -"SPEC $c<* @(ST s) @_" - forall (@s) (@r) ($dApplicative :: Applicative (ST s)). - $fApplicativeReaderT_$c<* @(ST s) @r $dApplicative - = ($fApplicativeReaderT1 @s @r) - `cast` (forall (a :: <*>_N) (b :: <*>_N). - _R - %<'Many>_N ->_R _R - %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) - ; Sym (N:ReaderT[0] <*>_N _R _R _N) - :: Coercible - (forall {a} {b}. - ReaderT r (ST s) a -> ReaderT r (ST s) b -> r -> STRep s a) - (forall {a} {b}. - ReaderT r (ST s) a -> ReaderT r (ST s) b -> ReaderT r (ST s) a)) -"SPEC $c<*> @(ST s) @_" - forall (@s) (@r) ($dApplicative :: Applicative (ST s)). - $fApplicativeReaderT9 @(ST s) @r $dApplicative - = ($fApplicativeReaderT4 @s @r) - `cast` (forall (a :: <*>_N) (b :: <*>_N). - b)>_R - %<'Many>_N ->_R _R - %<'Many>_N ->_R _R - %<'Many>_N ->_R Sym (N:ST[0] _N _R) - :: Coercible - (forall {a} {b}. - ReaderT r (ST s) (a -> b) -> ReaderT r (ST s) a -> r -> STRep s b) - (forall {a} {b}. - ReaderT r (ST s) (a -> b) -> ReaderT r (ST s) a -> r -> ST s b)) -"SPEC $c>> @(ST s) @_" - forall (@s) (@r) ($dMonad :: Monad (ST s)). - $fMonadReaderT1 @(ST s) @r $dMonad - = $fMonadAbstractIOSTReaderT_$s$c>> @s @r -"SPEC $c>>= @(ST s) @_" - forall (@s) (@r) ($dMonad :: Monad (ST s)). - $fMonadReaderT2 @(ST s) @r $dMonad - = ($fMonadAbstractIOSTReaderT2 @s @r) - `cast` (forall (a :: <*>_N) (b :: <*>_N). - _R - %<'Many>_N ->_R ReaderT r (ST s) b>_R - %<'Many>_N ->_R _R - %<'Many>_N ->_R Sym (N:ST[0] _N _R) - :: Coercible - (forall {a} {b}. - ReaderT r (ST s) a -> (a -> ReaderT r (ST s) b) -> r -> STRep s b) - (forall {a} {b}. - ReaderT r (ST s) a -> (a -> ReaderT r (ST s) b) -> r -> ST s b)) -"SPEC $cfmap @(ST s) @_" - forall (@s) (@r) ($dFunctor :: Functor (ST s)). - $fFunctorReaderT_$cfmap @(ST s) @r $dFunctor - = ($fApplicativeReaderT7 @s @r) - `cast` (forall (a :: <*>_N) (b :: <*>_N). - b>_R - %<'Many>_N ->_R _R - %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) - ; Sym (N:ReaderT[0] <*>_N _R _R _N) - :: Coercible - (forall {a} {b}. (a -> b) -> ReaderT r (ST s) a -> r -> STRep s b) - (forall {a} {b}. - (a -> b) -> ReaderT r (ST s) a -> ReaderT r (ST s) b)) -"SPEC $cliftA2 @(ST s) @_" - forall (@s) (@r) ($dApplicative :: Applicative (ST s)). - $fApplicativeReaderT_$cliftA2 @(ST s) @r $dApplicative - = ($fApplicativeReaderT3 @s @r) - `cast` (forall (a :: <*>_N) (b :: <*>_N) (c :: <*>_N). - b -> c>_R - %<'Many>_N ->_R _R - %<'Many>_N ->_R _R - %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) - ; Sym (N:ReaderT[0] <*>_N _R _R _N) - :: Coercible - (forall {a} {b} {c}. - (a -> b -> c) - -> ReaderT r (ST s) a -> ReaderT r (ST s) b -> r -> STRep s c) - (forall {a} {b} {c}. - (a -> b -> c) - -> ReaderT r (ST s) a -> ReaderT r (ST s) b -> ReaderT r (ST s) c)) -"SPEC $cp1Applicative @(ST s) @_" - forall (@s) (@r) ($dApplicative :: Applicative (ST s)). - $fApplicativeReaderT_$cp1Applicative @(ST s) @r $dApplicative - = $fApplicativeReaderT_$s$fFunctorReaderT @s @r -"SPEC $cp1Monad @(ST s) @_" - forall (@s) (@r) ($dMonad :: Monad (ST s)). - $fMonadReaderT_$cp1Monad @(ST s) @r $dMonad - = $fApplicativeReaderT_$s$fApplicativeReaderT @s @r -"SPEC $cpure @(ST s) @_" - forall (@s) (@r) ($dApplicative :: Applicative (ST s)). - $fApplicativeReaderT_$cpure @(ST s) @r $dApplicative - = ($fApplicativeReaderT5 @s @r) - `cast` (forall (a :: <*>_N). - _R - %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) - ; Sym (N:ReaderT[0] <*>_N _R _R _N) - :: Coercible - (forall {a}. a -> r -> STRep s a) - (forall {a}. a -> ReaderT r (ST s) a)) -"SPEC $creturn @(ST s) @_" - forall (@s) (@r) ($dMonad :: Monad (ST s)). - $fMonadReaderT_$creturn @(ST s) @r $dMonad - = ($fApplicativeReaderT5 @s @r) - `cast` (forall (a :: <*>_N). - _R - %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) - ; Sym (N:ReaderT[0] <*>_N _R _R _N) - :: Coercible - (forall {a}. a -> r -> STRep s a) - (forall {a}. a -> ReaderT r (ST s) a)) -"SPEC $fApplicativeReaderT @(ST s) @_" - forall (@s) (@r) ($dApplicative :: Applicative (ST s)). - $fApplicativeReaderT @(ST s) @r $dApplicative - = $fApplicativeReaderT_$s$fApplicativeReaderT @s @r -"SPEC $fFunctorReaderT @(ST s) @_" - forall (@s) (@r) ($dFunctor :: Functor (ST s)). - $fFunctorReaderT @(ST s) @r $dFunctor - = $fApplicativeReaderT_$s$fFunctorReaderT @s @r -"SPEC $fMonadReaderT @(ST s) @_" - forall (@s) (@r) ($dMonad :: Monad (ST s)). - $fMonadReaderT @(ST s) @r $dMonad - = $fMonadAbstractIOSTReaderT_$s$fMonadReaderT @s @r "USPEC useAbstractMonad @(ReaderT Int (ST s))" forall (@s) ($dMonadAbstractIOST :: MonadAbstractIOST (ReaderT Int (ST s))). ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -435,7 +435,7 @@ test('T21851', [grep_errmsg(r'case.*w\$sf') ], multimod_compile, ['T21851', '-O # One module, T22097.hs, has OPTIONS_GHC -ddump-simpl test('T22097', [grep_errmsg(r'case.*wgoEven') ], multimod_compile, ['T22097', '-O -dno-typeable-binds -dsuppress-uniques']) -test('T13873', [ grep_errmsg(r'SPEC') ], compile, ['-O -ddump-rules']) +test('T13873', [ grep_errmsg(r'SPEC') ], compile, ['-O -ddump-rules -fpolymorphic-specialisation']) test('T22357', normal, compile, ['-O']) test('T22471', normal, compile, ['-O']) test('T22347', normal, compile, ['-O -fno-full-laziness']) @@ -443,8 +443,8 @@ test('T22347a', normal, compile, ['-O2 -fno-full-laziness']) # T17366: expecting to see a rule # Rule fired: SPEC/T17366 f @(Tagged tag) @_ (T17366) -test('T17366', normal, multimod_compile, ['T17366', '-O -v0 -ddump-rule-firings']) -test('T17366_AR', [grep_errmsg(r'SPEC')], multimod_compile, ['T17366_AR', '-O -v0 -ddump-rule-firings']) +test('T17366', normal, multimod_compile, ['T17366', '-O -v0 -ddump-rule-firings -fpolymorphic-specialisation']) +test('T17366_AR', [grep_errmsg(r'SPEC')], multimod_compile, ['T17366_AR', '-O -v0 -ddump-rule-firings -fpolymorphic-specialisation']) test('T22375', normal, compile, ['-O -ddump-simpl -dsuppress-uniques -dno-typeable-binds -dsuppress-unfoldings']) # One module, T21851_2.hs, has OPTIONS_GHC -ddump-simpl @@ -467,7 +467,7 @@ test('T22623', normal, multimod_compile, ['T22623', '-O -v0']) test('T22662', normal, compile, ['']) test('T22725', normal, compile, ['-O']) test('T22502', normal, compile, ['-O']) -test('T22611', [when(wordsize(32), skip), grep_errmsg(r'\$salterF') ], compile, ['-O -ddump-simpl -dsuppress-uniques -dsuppress-all']) +test('T22611', [when(wordsize(32), skip), grep_errmsg(r'\$salterF') ], compile, ['-O -ddump-simpl -dsuppress-uniques -dsuppress-all -fpolymorphic-specialisation']) 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/9f01d14b5bc1c73828b2b061206c45b84353620e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9f01d14b5bc1c73828b2b061206c45b84353620e You're receiving 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 Jun 29 08:14:43 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 29 Jun 2023 04:14:43 -0400 Subject: [Git][ghc/ghc][master] Rip out runtime linker/compiler checks Message-ID: <649d3d73c04c7_3b5ae219a235dc493882@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 11 changed files: - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/SysTools.hs - − compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - compiler/ghc.cabal.in - + m4/fp_link_supports_no_as_needed.m4 - m4/fptools_set_c_ld_flags.m4 Changes: ===================================== compiler/GHC/Driver/Backend.hs ===================================== @@ -58,8 +58,6 @@ module GHC.Driver.Backend , DefunctionalizedCodeOutput(..) -- *** Back-end functions for assembly , DefunctionalizedPostHscPipeline(..) - , DefunctionalizedAssemblerProg(..) - , DefunctionalizedAssemblerInfoGetter(..) -- *** Other back-end functions , DefunctionalizedCDefs(..) -- ** Names of back ends (for API clients of version 9.4 or earlier) @@ -94,8 +92,6 @@ module GHC.Driver.Backend , backendSupportsHpc , backendSupportsCImport , backendSupportsCExport - , backendAssemblerProg - , backendAssemblerInfoGetter , backendCDefs , backendCodeOutput , backendUseJSLinker @@ -348,40 +344,6 @@ data PrimitiveImplementation deriving Show --- | Names a function that runs the assembler, of this type: --- --- > Logger -> DynFlags -> Platform -> [Option] -> IO () --- --- The functions so named are defined in "GHC.Driver.Pipeline.Execute". - -data DefunctionalizedAssemblerProg - = StandardAssemblerProg - -- ^ Use the standard system assembler - | JSAssemblerProg - -- ^ JS Backend compile to JS via Stg, and so does not use any assembler - | DarwinClangAssemblerProg - -- ^ If running on Darwin, use the assembler from the @clang@ - -- toolchain. Otherwise use the standard system assembler. - - - --- | Names a function that discover from what toolchain the assembler --- is coming, of this type: --- --- > Logger -> DynFlags -> Platform -> IO CompilerInfo --- --- The functions so named are defined in "GHC.Driver.Pipeline.Execute". - -data DefunctionalizedAssemblerInfoGetter - = StandardAssemblerInfoGetter - -- ^ Interrogate the standard system assembler - | JSAssemblerInfoGetter - -- ^ If using the JS backend; return 'Emscripten' - | DarwinClangAssemblerInfoGetter - -- ^ If running on Darwin, return `Clang`; otherwise - -- interrogate the standard system assembler. - - -- | Names a function that generates code and writes the results to a -- file, of this type: -- @@ -767,45 +729,6 @@ backendSupportsCExport (Named JavaScript) = True backendSupportsCExport (Named Interpreter) = False backendSupportsCExport (Named NoBackend) = True --- | This (defunctionalized) function runs the assembler --- used on the code that is written by this back end. A --- program determined by a combination of back end, --- `DynFlags`, and `Platform` is run with the given --- `Option`s. --- --- The function's type is --- @ --- Logger -> DynFlags -> Platform -> [Option] -> IO () --- @ --- --- This field is usually defaulted. -backendAssemblerProg :: Backend -> DefunctionalizedAssemblerProg -backendAssemblerProg (Named NCG) = StandardAssemblerProg -backendAssemblerProg (Named LLVM) = DarwinClangAssemblerProg -backendAssemblerProg (Named ViaC) = StandardAssemblerProg -backendAssemblerProg (Named JavaScript) = JSAssemblerProg -backendAssemblerProg (Named Interpreter) = StandardAssemblerProg -backendAssemblerProg (Named NoBackend) = StandardAssemblerProg - --- | This (defunctionalized) function is used to retrieve --- an enumeration value that characterizes the C/assembler --- part of a toolchain. The function caches the info in a --- mutable variable that is part of the `DynFlags`. --- --- The function's type is --- @ --- Logger -> DynFlags -> Platform -> IO CompilerInfo --- @ --- --- This field is usually defaulted. -backendAssemblerInfoGetter :: Backend -> DefunctionalizedAssemblerInfoGetter -backendAssemblerInfoGetter (Named NCG) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named LLVM) = DarwinClangAssemblerInfoGetter -backendAssemblerInfoGetter (Named ViaC) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named JavaScript) = JSAssemblerInfoGetter -backendAssemblerInfoGetter (Named Interpreter) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named NoBackend) = StandardAssemblerInfoGetter - -- | When using this back end, it may be necessary or -- advisable to pass some `-D` options to a C compiler. -- This (defunctionalized) function produces those ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -116,7 +116,6 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Trans.Reader (ReaderT) import Control.Monad.Trans.Writer (WriterT) -import Data.IORef import System.IO import System.IO.Error (catchIOError) import System.Environment (lookupEnv) @@ -420,15 +419,6 @@ data DynFlags = DynFlags { avx512pf :: Bool, -- Enable AVX-512 PreFetch Instructions. fma :: Bool, -- ^ Enable FMA instructions. - -- | Run-time linker information (what options we need, etc.) - rtldInfo :: IORef (Maybe LinkerInfo), - - -- | Run-time C compiler information - rtccInfo :: IORef (Maybe CompilerInfo), - - -- | Run-time assembler information - rtasmInfo :: IORef (Maybe CompilerInfo), - -- Constants used to control the amount of optimization done. -- | Max size, in bytes, of inline array allocations. @@ -490,9 +480,6 @@ class ContainsDynFlags t where initDynFlags :: DynFlags -> IO DynFlags initDynFlags dflags = do let - refRtldInfo <- newIORef Nothing - refRtccInfo <- newIORef Nothing - refRtasmInfo <- newIORef Nothing canUseUnicode <- do let enc = localeEncoding str = "‘’" (withCString enc str $ \cstr -> @@ -514,9 +501,6 @@ initDynFlags dflags = do useColor = useColor', canUseColor = stderrSupportsAnsiColors, colScheme = colScheme', - rtldInfo = refRtldInfo, - rtccInfo = refRtccInfo, - rtasmInfo = refRtasmInfo, tmpDir = TempDir tmp_dir } @@ -695,9 +679,6 @@ defaultDynFlags mySettings = avx512f = False, avx512pf = False, fma = False, - rtldInfo = panic "defaultDynFlags: no rtldInfo", - rtccInfo = panic "defaultDynFlags: no rtccInfo", - rtasmInfo = panic "defaultDynFlags: no rtasmInfo", maxInlineAllocSize = 128, maxInlineMemcpyInsns = 32, ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -110,7 +110,6 @@ module GHC.Driver.Main import GHC.Prelude import GHC.Platform -import GHC.Platform.Ways import GHC.Driver.Plugins import GHC.Driver.Session @@ -345,41 +344,11 @@ initHscEnv mb_top_dir = do mySettings <- initSysTools top_dir dflags <- initDynFlags (defaultDynFlags mySettings) hsc_env <- newHscEnv top_dir dflags - checkBrokenTablesNextToCode (hsc_logger hsc_env) dflags setUnsafeGlobalDynFlags dflags -- c.f. DynFlags.parseDynamicFlagsFull, which -- creates DynFlags and sets the UnsafeGlobalDynFlags return hsc_env --- | The binutils linker on ARM emits unnecessary R_ARM_COPY relocations which --- breaks tables-next-to-code in dynamically linked modules. This --- check should be more selective but there is currently no released --- version where this bug is fixed. --- See https://sourceware.org/bugzilla/show_bug.cgi?id=16177 and --- https://gitlab.haskell.org/ghc/ghc/issues/4210#note_78333 -checkBrokenTablesNextToCode :: Logger -> DynFlags -> IO () -checkBrokenTablesNextToCode logger dflags = do - let invalidLdErr = "Tables-next-to-code not supported on ARM \ - \when using binutils ld (please see: \ - \https://sourceware.org/bugzilla/show_bug.cgi?id=16177)" - broken <- checkBrokenTablesNextToCode' logger dflags - when broken (panic invalidLdErr) - -checkBrokenTablesNextToCode' :: Logger -> DynFlags -> IO Bool -checkBrokenTablesNextToCode' logger dflags - | not (isARM arch) = return False - | ways dflags `hasNotWay` WayDyn = return False - | not tablesNextToCode = return False - | otherwise = do - linkerInfo <- liftIO $ GHC.SysTools.getLinkerInfo logger dflags - case linkerInfo of - GnuLD _ -> return True - _ -> return False - where platform = targetPlatform dflags - arch = platformArch platform - tablesNextToCode = platformTablesNextToCode platform - - -- ----------------------------------------------------------------------------- getDiagnostics :: Hsc (Messages GhcMessage) ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -287,12 +287,6 @@ runAsPhase :: Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO F runAsPhase with_cpp pipe_env hsc_env location input_fn = do let dflags = hsc_dflags hsc_env let logger = hsc_logger hsc_env - let unit_env = hsc_unit_env hsc_env - let platform = ue_platform unit_env - - -- LLVM from version 3.0 onwards doesn't support the OS X system - -- assembler, so we use clang as the assembler instead. (#5636) - let as_prog = applyAssemblerProg $ backendAssemblerProg (backend dflags) let cmdline_include_paths = includePaths dflags let pic_c_flags = picCCOpts dflags @@ -310,9 +304,8 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do includePathsQuoteImplicit cmdline_include_paths] let runAssembler inputFilename outputFilename = withAtomicRename outputFilename $ \temp_outputFilename -> - as_prog + runAs logger dflags - platform (local_includes ++ global_includes -- See Note [-fPIC for assembler] ++ map GHC.SysTools.Option pic_c_flags @@ -392,22 +385,6 @@ runForeignJsPhase pipe_env hsc_env _location input_fn = do embedJsFile logger dflags tmpfs unit_env input_fn output_fn return output_fn - -applyAssemblerProg - :: DefunctionalizedAssemblerProg - -> Logger -> DynFlags -> Platform -> [Option] -> IO () -applyAssemblerProg StandardAssemblerProg logger dflags _platform = - runAs logger dflags -applyAssemblerProg JSAssemblerProg logger dflags _platform = - runEmscripten logger dflags -applyAssemblerProg DarwinClangAssemblerProg logger dflags platform = - if platformOS platform == OSDarwin then - runClang logger dflags - else - runAs logger dflags - - - runCcPhase :: Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO FilePath runCcPhase cc_phase pipe_env hsc_env location input_fn = do let dflags = hsc_dflags hsc_env ===================================== compiler/GHC/Linker/ExtraObj.hs ===================================== @@ -12,7 +12,6 @@ module GHC.Linker.ExtraObj , mkNoteObjsToLinkIntoBinary , checkLinkInfo , getLinkInfo - , getCompilerInfo , ghcLinkInfoSectionName , ghcLinkInfoNoteName , platformSupportsSavingLinkOpts @@ -40,10 +39,8 @@ import qualified GHC.Data.ShortText as ST import GHC.SysTools.Elf import GHC.SysTools.Tasks -import GHC.SysTools.Info import GHC.Linker.Unit -import Control.Monad.IO.Class import Control.Monad import Data.Maybe @@ -52,7 +49,6 @@ mkExtraObj logger tmpfs dflags unit_state extn xs = do cFile <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule extn oFile <- newTempName logger tmpfs (tmpDir dflags) TFL_GhcSession "o" writeFile cFile xs - ccInfo <- liftIO $ getCompilerInfo logger dflags runCc Nothing logger tmpfs dflags ([Option "-c", FileOption "" cFile, @@ -60,7 +56,7 @@ mkExtraObj logger tmpfs dflags unit_state extn xs FileOption "" oFile] ++ if extn /= "s" then cOpts - else asmOpts ccInfo) + else []) return oFile where -- Pass a different set of options to the C compiler depending one whether @@ -70,14 +66,6 @@ mkExtraObj logger tmpfs dflags unit_state extn xs ++ map (FileOption "-I" . ST.unpack) (unitIncludeDirs $ unsafeLookupUnit unit_state rtsUnit) - -- When compiling assembler code, we drop the usual C options, and if the - -- compiler is Clang, we add an extra argument to tell Clang to ignore - -- unused command line options. See trac #11684. - asmOpts ccInfo = - if any (ccInfo ==) [Clang, AppleClang, AppleClang51] - then [Option "-Qunused-arguments"] - else [] - -- When linking a binary, we need to create a C main() function that -- starts everything off. This used to be compiled statically as part -- of the RTS, but that made it hard to change the -rtsopts setting, ===================================== compiler/GHC/SysTools.hs ===================================== @@ -17,7 +17,6 @@ module GHC.SysTools ( -- * Interface to system tools module GHC.SysTools.Tasks, - module GHC.SysTools.Info, -- * Fast file copy copyFile, @@ -35,8 +34,6 @@ import GHC.Prelude import GHC.Utils.Panic import GHC.Driver.Session -import GHC.Linker.ExtraObj -import GHC.SysTools.Info import GHC.SysTools.Tasks import GHC.SysTools.BaseDir import GHC.Settings.IO ===================================== compiler/GHC/SysTools/Info.hs deleted ===================================== @@ -1,243 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} ------------------------------------------------------------------------------ --- --- Compiler information functions --- --- (c) The GHC Team 2017 --- ------------------------------------------------------------------------------ -module GHC.SysTools.Info where - -import GHC.Utils.Exception -import GHC.Utils.Error -import GHC.Driver.Session -import GHC.Utils.Outputable -import GHC.Utils.Misc -import GHC.Utils.Logger - -import Data.List ( isInfixOf, isPrefixOf ) -import Data.IORef - -import System.IO - -import GHC.Platform -import GHC.Prelude - -import GHC.SysTools.Process - -{- Note [Run-time linker info] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~ -See also: #5240, #6063, #10110 - -Before 'runLink', we need to be sure to get the relevant information -about the linker we're using at runtime to see if we need any extra -options. - -Generally, the linker changing from what was detected at ./configure -time has always been possible using -pgml, but on Linux it can happen -'transparently' by installing packages like binutils-gold, which -change what /usr/bin/ld actually points to. - -Clang vs GCC notes: - -For gcc, 'gcc -Wl,--version' gives a bunch of output about how to -invoke the linker before the version information string. For 'clang', -the version information for 'ld' is all that's output. For this -reason, we typically need to slurp up all of the standard error output -and look through it. - -Other notes: - -We cache the LinkerInfo inside DynFlags, since clients may link -multiple times. The definition of LinkerInfo is there to avoid a -circular dependency. - --} - -{- Note [ELF needed shared libs] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Some distributions change the link editor's default handling of -ELF DT_NEEDED tags to include only those shared objects that are -needed to resolve undefined symbols. For Template Haskell we need -the last temporary shared library also if it is not needed for the -currently linked temporary shared library. We specify --no-as-needed -to override the default. This flag exists in GNU ld and GNU gold. - -The flag is only needed on ELF systems. On Windows (PE) and Mac OS X -(Mach-O) the flag is not needed. - --} - -neededLinkArgs :: LinkerInfo -> [Option] -neededLinkArgs (GnuLD o) = o -neededLinkArgs (Mold o) = o -neededLinkArgs (GnuGold o) = o -neededLinkArgs (LlvmLLD o) = o -neededLinkArgs (DarwinLD o) = o -neededLinkArgs (SolarisLD o) = o -neededLinkArgs (AixLD o) = o -neededLinkArgs UnknownLD = [] - --- Grab linker info and cache it in DynFlags. -getLinkerInfo :: Logger -> DynFlags -> IO LinkerInfo -getLinkerInfo logger dflags = do - info <- readIORef (rtldInfo dflags) - case info of - Just v -> return v - Nothing -> do - v <- getLinkerInfo' logger dflags - writeIORef (rtldInfo dflags) (Just v) - return v - --- See Note [Run-time linker info]. -getLinkerInfo' :: Logger -> DynFlags -> IO LinkerInfo -getLinkerInfo' logger dflags = do - let platform = targetPlatform dflags - os = platformOS platform - (pgm,args0) = pgm_l dflags - args1 = map Option (getOpts dflags opt_l) - args2 = args0 ++ args1 - args3 = filter notNull (map showOpt args2) - - -- Try to grab the info from the process output. - parseLinkerInfo stdo _stde _exitc - | any ("GNU ld" `isPrefixOf`) stdo = - -- Set DT_NEEDED for all shared libraries. #10110. - return (GnuLD $ map Option [-- ELF specific flag - -- 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] - return (GnuGold [Option "-Wl,--no-as-needed"]) - - | any (\line -> "LLD" `isPrefixOf` line || "LLD" `elem` words line) stdo = - return (LlvmLLD $ map Option [ --see Note [ELF needed shared libs] - "-Wl,--no-as-needed" | osElfTarget os || os == OSMinGW32 ]) - - -- Unknown linker. - | otherwise = fail "invalid --version output, or linker is unsupported" - - -- Process the executable call - catchIO ( - case os of - OSSolaris2 -> - -- Solaris uses its own Solaris linker. Even all - -- GNU C are recommended to configure with Solaris - -- linker instead of using GNU binutils linker. Also - -- all GCC distributed with Solaris follows this rule - -- precisely so we assume here, the Solaris linker is - -- used. - return $ SolarisLD [] - OSAIX -> - -- IBM AIX uses its own non-binutils linker as well - return $ AixLD [] - OSDarwin -> - -- Darwin has neither GNU Gold or GNU LD, but a strange linker - -- that doesn't support --version. We can just assume that's - -- what we're using. - return $ DarwinLD [] - OSMinGW32 -> - -- GHC doesn't support anything but GNU ld on Windows anyway. - -- Process creation is also fairly expensive on win32, so - -- we short-circuit here. - return $ GnuLD $ map Option - [ -- Emit stack checks - -- See Note [Windows stack allocations] - "-fstack-check" - ] - _ -> do - -- In practice, we use the compiler as the linker here. Pass - -- -Wl,--version to get linker version info. - (exitc, stdo, stde) <- readProcessEnvWithExitCode pgm - (["-Wl,--version"] ++ args3) - c_locale_env - -- Split the output by lines to make certain kinds - -- of processing easier. In particular, 'clang' and 'gcc' - -- have slightly different outputs for '-Wl,--version', but - -- it's still easy to figure out. - parseLinkerInfo (lines stdo) (lines stde) exitc - ) - (\err -> do - debugTraceMsg logger 2 - (text "Error (figuring out linker information):" <+> - text (show err)) - errorMsg logger $ hang (text "Warning:") 9 $ - text "Couldn't figure out linker information!" $$ - text "Make sure you're using GNU ld, GNU gold" <+> - text "or the built in OS X linker, etc." - return UnknownLD - ) - --- | Grab compiler info and cache it in DynFlags. -getCompilerInfo :: Logger -> DynFlags -> IO CompilerInfo -getCompilerInfo logger dflags = do - info <- readIORef (rtccInfo dflags) - case info of - Just v -> return v - Nothing -> do - let pgm = pgm_c dflags - v <- getCompilerInfo' logger pgm - writeIORef (rtccInfo dflags) (Just v) - return v - --- | Grab assembler info and cache it in DynFlags. -getAssemblerInfo :: Logger -> DynFlags -> IO CompilerInfo -getAssemblerInfo logger dflags = do - info <- readIORef (rtasmInfo dflags) - case info of - Just v -> return v - Nothing -> do - let (pgm, _) = pgm_a dflags - v <- getCompilerInfo' logger pgm - writeIORef (rtasmInfo dflags) (Just v) - return v - --- See Note [Run-time linker info]. -getCompilerInfo' :: Logger -> String -> IO CompilerInfo -getCompilerInfo' logger pgm = do - let -- Try to grab the info from the process output. - parseCompilerInfo _stdo stde _exitc - -- Regular GCC - | any ("gcc version" `isInfixOf`) stde = - return GCC - -- Regular clang - | any ("clang version" `isInfixOf`) stde = - return Clang - -- FreeBSD clang - | any ("FreeBSD clang version" `isInfixOf`) stde = - return Clang - -- Xcode 5.1 clang - | any ("Apple LLVM version 5.1" `isPrefixOf`) stde = - return AppleClang51 - -- Xcode 5 clang - | any ("Apple LLVM version" `isPrefixOf`) stde = - return AppleClang - -- Xcode 4.1 clang - | any ("Apple clang version" `isPrefixOf`) stde = - return AppleClang - -- Unknown compiler. - | otherwise = fail $ "invalid -v output, or compiler is unsupported (" ++ pgm ++ "): " ++ unlines stde - - -- Process the executable call - catchIO (do - (exitc, stdo, stde) <- - readProcessEnvWithExitCode pgm ["-v"] c_locale_env - -- Split the output by lines to make certain kinds - -- of processing easier. - parseCompilerInfo (lines stdo) (lines stde) exitc - ) - (\err -> do - debugTraceMsg logger 2 - (text "Error (figuring out C compiler information):" <+> - text (show err)) - errorMsg logger $ hang (text "Warning:") 9 $ - text "Couldn't figure out C compiler information!" $$ - text "Make sure you're using GNU gcc, or clang" - return UnknownCC - ) ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -19,7 +19,6 @@ import GHC.CmmToLlvm.Config (LlvmVersion, llvmVersionStr, supportedLlvmVersionUp import GHC.Settings import GHC.SysTools.Process -import GHC.SysTools.Info import GHC.Driver.Session @@ -292,15 +291,12 @@ figureLlvmVersion logger dflags = traceSystoolCommand logger "llc" $ do runLink :: Logger -> TmpFs -> DynFlags -> [Option] -> IO () runLink logger tmpfs dflags args = traceSystoolCommand logger "linker" $ do - -- See Note [Run-time linker info] - -- -- `-optl` args come at the end, so that later `-l` options -- given there manually can fill in symbols needed by -- Haskell libraries coming in via `args`. - linkargs <- neededLinkArgs `fmap` getLinkerInfo logger dflags let (p,args0) = pgm_l dflags optl_args = map Option (getOpts dflags opt_l) - args2 = args0 ++ linkargs ++ args ++ optl_args + args2 = args0 ++ args ++ optl_args mb_env <- getGccEnv args2 runSomethingResponseFile logger tmpfs dflags ld_filter "Linker" p args2 mb_env where ===================================== compiler/ghc.cabal.in ===================================== @@ -715,7 +715,6 @@ Library GHC.SysTools.BaseDir GHC.SysTools.Cpp GHC.SysTools.Elf - GHC.SysTools.Info GHC.SysTools.Process GHC.SysTools.Tasks GHC.SysTools.Terminal ===================================== m4/fp_link_supports_no_as_needed.m4 ===================================== @@ -0,0 +1,33 @@ +# FP_LINK_SUPPORTS_NO_AS_NEEDED +# ---------------------------------- +# Set the Cc linker flag -Wl,--no-as-needed if it is supported +# $1 is the name of the linker flags variable when linking with gcc +# See also Note [ELF needed shared libs] +AC_DEFUN([FP_LINK_SUPPORTS_NO_AS_NEEDED], +[ + AC_MSG_CHECKING([whether Cc linker supports -Wl,--no-as-needed]) + echo 'int f(int a) {return 2*a;}' > conftest.a.c + echo 'int f(int a); int main(int argc, char **argv) {return f(0);}' > conftest.b.c + $CC -c -o conftest.a.o conftest.a.c > /dev/null 2>&1 + $CC -c -o conftest.b.o conftest.b.c > /dev/null 2>&1 + if "$CC" "$$1" -Wl,--no-as-needed -o conftest conftest.a.o conftest.b.o > /dev/null 2>&1 + then + $1="$$1 -Wl,--no-as-needed" + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + fi + rm -f conftest* +]) + +# Note [ELF needed shared libs] +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# Some distributions change the link editor's default handling of +# ELF DT_NEEDED tags to include only those shared objects that are +# needed to resolve undefined symbols. For Template Haskell we need +# the last temporary shared library also if it is not needed for the +# currently linked temporary shared library. We specify --no-as-needed +# to override the default. This flag exists in GNU ld and GNU gold. +# +# The flag is only needed on ELF systems. On Windows (PE) and Mac OS X +# (Mach-O) the flag is not needed. ===================================== m4/fptools_set_c_ld_flags.m4 ===================================== @@ -17,6 +17,21 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS], ;; esac + # See Note [ELF needed shared libs] + case $$1 in + *-linux|*-freebsd*) + FP_LINK_SUPPORTS_NO_AS_NEEDED([$3]) + ;; + esac + + # Emit stack checks + # See Note [Windows stack allocations] + case $$1 in + *-mingw32*) + $3="$$3 -fstack-check" + ;; + esac + case $$1 in i386-unknown-mingw32) $2="$$2 -march=i686" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b1e611d5d7e214cf9286e95936f41566f1235c7f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b1e611d5d7e214cf9286e95936f41566f1235c7f You're receiving 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 Jun 29 08:45:58 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 29 Jun 2023 04:45:58 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Message-ID: <649d44c6e9f83_3b5ae22152782850765e@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - ef433e69 by Ben Gamari at 2023-06-29T04:45:50-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - 8ac19e39 by Ben Gamari at 2023-06-29T04:45:51-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - aacf219b by Ben Gamari at 2023-06-29T04:45:51-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - f56c6adb by Ben Gamari at 2023-06-29T04:45:51-04:00 rts: Various warnings fixes - - - - - db699ff6 by Ben Gamari at 2023-06-29T04:45:51-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - 30 changed files: - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/SysTools.hs - − compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - compiler/ghc.cabal.in - docs/users_guide/9.8.1-notes.rst - docs/users_guide/using-optimisation.rst - hadrian/src/Flavour.hs - libraries/base/include/HsBase.h - libraries/ghci/GHCi/FFI.hsc - + m4/fp_link_supports_no_as_needed.m4 - m4/fptools_set_c_ld_flags.m4 - rts/Interpreter.c - rts/Schedule.c - rts/Sparks.c - rts/Trace.h - rts/TraverseHeap.c - rts/adjustor/LibffiAdjustor.c - + rts/include/rts/ghc_ffi.h - rts/rts.cabal.in - rts/sm/GC.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/76039d53d13d76da4f1633bd9ebb9f48da55ac61...db699ff60a26760536df825f2ff8329b38a9c0f4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/76039d53d13d76da4f1633bd9ebb9f48da55ac61...db699ff60a26760536df825f2ff8329b38a9c0f4 You're receiving 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 Jun 29 08:52:59 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 29 Jun 2023 04:52:59 -0400 Subject: [Git][ghc/ghc][wip/T22010] Refactor Unique to be represented by Word64 Message-ID: <649d466b6c64c_3b5ae22224836851341d@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: caadb410 by Jaro Reinders at 2023-06-29T10:39:56+02:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 19 changed files: - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Data/Graph/UnVar.hs - + compiler/GHC/Data/Word64Map.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/caadb410b59d9bc199e5c196b077ad1a34350b0a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/caadb410b59d9bc199e5c196b077ad1a34350b0a You're receiving 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 Jun 29 09:34:16 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 29 Jun 2023 05:34:16 -0400 Subject: [Git][ghc/ghc][wip/T22010] Refactor Unique to be represented by Word64 Message-ID: <649d5018120b0_3b5ae2220219b85417ed@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 960139c7 by Jaro Reinders at 2023-06-29T11:34:00+02:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 19 changed files: - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Data/Graph/UnVar.hs - + compiler/GHC/Data/Word64Map.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/960139c7eeed0aff7a6bf0a3f181c3f1d020430d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/960139c7eeed0aff7a6bf0a3f181c3f1d020430d You're receiving 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 Jun 29 09:34:54 2023 From: gitlab at gitlab.haskell.org (Rodrigo Mesquita (@alt-romes)) Date: Thu, 29 Jun 2023 05:34:54 -0400 Subject: [Git][ghc/ghc][wip/rip-solaris-configuration] 84 commits: Report scoped kind variables at the type-checking phase (#16635) Message-ID: <649d503ed5984_3b5ae2220306c0542616@gitlab.mail> Rodrigo Mesquita pushed to branch wip/rip-solaris-configuration at Glasgow Haskell Compiler / GHC Commits: 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - caa3d74d by Ben Gamari at 2023-06-29T10:34:20+01:00 configure: Rip out Solaris dyld check Solaris 11 was released over a decade ago and, moreover, I doubt we have any Solaris users - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.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 - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ab13551c6dd538ed122e12b3b0ab1b9a48589959...caa3d74d8bd96a5b9c4b1ae5f09c1d315457d7a4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ab13551c6dd538ed122e12b3b0ab1b9a48589959...caa3d74d8bd96a5b9c4b1ae5f09c1d315457d7a4 You're receiving 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 Jun 29 10:34:40 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 29 Jun 2023 06:34:40 -0400 Subject: [Git][ghc/ghc][wip/T22010] 164 commits: Output Lint errors to stderr instead of stdout Message-ID: <649d5e40e38c6_3b5ae22202ed98558516@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - b57c47cc by Jaro Reinders at 2023-06-29T12:34:26+02:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - HACKING.md - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Uniques.hs - − compiler/GHC/Builtin/bytearray-ops.txt.pp - utils/genprimopcode/gen_bytearray_ops.py → compiler/GHC/Builtin/gen_bytearray_addr_access_ops.py - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Utils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/960139c7eeed0aff7a6bf0a3f181c3f1d020430d...b57c47cc387e420f70462080c64cb07c37e37f7e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/960139c7eeed0aff7a6bf0a3f181c3f1d020430d...b57c47cc387e420f70462080c64cb07c37e37f7e You're receiving 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 Jun 29 10:56:31 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Thu, 29 Jun 2023 06:56:31 -0400 Subject: [Git][ghc/ghc][wip/T22010] Refactor Unique to be represented by Word64 Message-ID: <649d635f8e5ca_3b5ae224d2e4105703a8@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: a7b38595 by Jaro Reinders at 2023-06-29T12:56:06+02:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 18 changed files: - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Data/Graph/UnVar.hs - + compiler/GHC/Data/Word64Map.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a7b385951908695fd2615a32c89f191239b2155b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a7b385951908695fd2615a32c89f191239b2155b You're receiving 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 Jun 29 12:27:23 2023 From: gitlab at gitlab.haskell.org (Torsten Schmits (@torsten.schmits)) Date: Thu, 29 Jun 2023 08:27:23 -0400 Subject: [Git][ghc/ghc][wip/torsten.schmits/23272] 36 commits: rts: Work around missing prototypes errors Message-ID: <649d78abc325c_3b5ae224d2de20599858@gitlab.mail> Torsten Schmits pushed to branch wip/torsten.schmits/23272 at Glasgow Haskell Compiler / GHC Commits: 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - bf4d2834 by Torsten Schmits at 2023-06-29T14:27:02+02:00 Filter out nontrivial substituted expressions in substTickish Fixes #23272 - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - compiler/GHC/Builtin/Types.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.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 - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/Tidy.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2a23174c6f6d247ba6a1fe7cead024bf181d04e7...bf4d283479c5dad4323a9fad3a4e58f564d5c240 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2a23174c6f6d247ba6a1fe7cead024bf181d04e7...bf4d283479c5dad4323a9fad3a4e58f564d5c240 You're receiving 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 Jun 29 13:36:17 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Thu, 29 Jun 2023 09:36:17 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/int-index/tycl-inst-deps Message-ID: <649d88d1dc4a9_3b5ae227739c786111ec@gitlab.mail> Vladislav Zavialov pushed new branch wip/int-index/tycl-inst-deps at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/int-index/tycl-inst-deps You're receiving 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 Jun 29 14:38:06 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 29 Jun 2023 10:38:06 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23577 Message-ID: <649d974eae386_3b5ae2215278286208e0@gitlab.mail> Ben Gamari pushed new branch wip/T23577 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23577 You're receiving 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 Jun 29 14:46:05 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 29 Jun 2023 10:46:05 -0400 Subject: [Git][ghc/ghc][wip/refactor-gen-ci] gitlab-ci: Refactor compilation of gen_ci Message-ID: <649d992d51d64_3b5ae226e251dc6267df@gitlab.mail> Ben Gamari pushed to branch wip/refactor-gen-ci at Glasgow Haskell Compiler / GHC Commits: 8f6b7716 by Ben Gamari at 2023-06-29T10:45:58-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 11 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/update-ci - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs Changes: ===================================== .gitignore ===================================== @@ -97,6 +97,7 @@ _darcs/ # ----------------------------------------------------------------------------- # specific generated files +/.gitlab/jobs-metadata.json /bindist-list /bindist-list.uniq /bindistprep/ ===================================== .gitlab-ci.yml ===================================== @@ -274,13 +274,10 @@ lint-ci-config: GIT_SUBMODULE_STRATEGY: none before_script: - echo "experimental-features = nix-command flakes" >> /etc/nix/nix.conf - - nix-channel --update script: - - .gitlab/generate_jobs + - nix run .gitlab/generate-ci#update-ci # 1 if .gitlab/generate_jobs changed the output of the generated config - nix shell nixpkgs#git -c git diff --exit-code - # And run this to just make sure that works - - .gitlab/generate_job_metadata dependencies: [] lint-submods: @@ -1020,7 +1017,7 @@ project-version: - PipelineYear="$(date -d $CI_PIPELINE_CREATED_AT +%Y)" - nix shell nixpkgs#wget -c wget "https://ghc.gitlab.haskell.org/ghcup-metadata/ghcup-nightlies-$PipelineYear-0.0.7.yaml" -O ghcup-0.0.7.yaml - - .gitlab/generate_job_metadata + - nix run .gitlab/generate-ci#update-ci artifacts: paths: ===================================== .gitlab/generate-ci/LICENSE ===================================== @@ -0,0 +1,30 @@ +Copyright (c) 2023, The GHC Developers + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of The GHC Developers nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ===================================== .gitlab/generate-ci/README.mkd ===================================== @@ -0,0 +1,34 @@ +# generate-ci + +This is the generator for GHC's GitLab CI infrastructure. In particular, this +generates two outputs: + + * `.gitlab/jobs.yaml`, which is a YAML (or, strictly speaking, JSON) + file which defines the bulk of the validation, nightly, and release jobs of + GHC's CI. + + * `.gitlab/jobs-metadata.json`, which is a mapping between platforms and + produced binary distribution names used when producing `ghcup` metadata + for nightly pipeline artifacts. + +Both of these are generated by the `update-ci` script, although only +`jobs.yaml` is committed in the repository. + +## Modifying the CI configuration (nix) + +The jobs are defined in `gen_ci.hs`. After modifying this you can run +```sh +nix run .gitlab/generate-ci#update-ci +``` +from the top of the GHC repository to update the generated configuration. + + +## Modifying the CI configuration (without nix) + +One can run `update-ci` without Nix as follows (assuming one has `jq`, +`cabal-install`, and GHC installed): +```sh +$ cabal build generate-ci +$ PATH="$(dirname $(cabal list-bin generate-ci)):$PATH" +$ ./update-ci +``` ===================================== .gitlab/generate-ci/flake.lock ===================================== @@ -0,0 +1,59 @@ +{ + "nodes": { + "flake-utils": { + "inputs": { + "systems": "systems" + }, + "locked": { + "lastModified": 1687709756, + "narHash": "sha256-Y5wKlQSkgEK2weWdOu4J3riRd+kV/VCgHsqLNTTWQ/0=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "dbabf0ca0c0c4bce6ea5eaf65af5cb694d2082c7", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "nixpkgs": { + "locked": { + "lastModified": 1687886075, + "narHash": "sha256-PeayJDDDy+uw1Ats4moZnRdL1OFuZm1Tj+KiHlD67+o=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "a565059a348422af5af9026b5174dc5c0dcefdae", + "type": "github" + }, + "original": { + "id": "nixpkgs", + "type": "indirect" + } + }, + "root": { + "inputs": { + "flake-utils": "flake-utils", + "nixpkgs": "nixpkgs" + } + }, + "systems": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } + } + }, + "root": "root", + "version": 7 +} ===================================== .gitlab/generate-ci/flake.nix ===================================== @@ -0,0 +1,33 @@ +{ + description = "GHC CI Generator"; + + inputs.flake-utils.url = "github:numtide/flake-utils"; + + outputs = { self, nixpkgs, flake-utils }: + flake-utils.lib.eachDefaultSystem (system: + let pkgs = nixpkgs.legacyPackages.${system}; in + { + packages = rec { + update-ci = pkgs.runCommand "update-ci" { + nativeBuildInputs = with pkgs; [ makeWrapper ]; + } '' + mkdir -p $out/bin + makeWrapper ${./update-ci} $out/bin/update-ci \ + --prefix PATH : ${with pkgs; lib.makeBinPath [ generate-ci jq gitMinimal ]} + ''; + + generate-ci = pkgs.haskellPackages.callCabal2nix "generate-ci" ./. {}; + + default = update-ci; + }; + + apps = rec { + update-ci = flake-utils.lib.mkApp { + drv = self.packages.${system}.update-ci; + }; + + default = update-ci; + }; + } + ); +} ===================================== .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs ===================================== @@ -3,9 +3,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{- cabal: -build-depends: base, aeson >= 1.8.1, containers, bytestring --} import Data.Aeson as A import qualified Data.Map as Map ===================================== .gitlab/generate-ci/generate-ci.cabal ===================================== @@ -0,0 +1,15 @@ +cabal-version: 3.0 +name: generate-ci +version: 0.1.0.0 +license: BSD-3-Clause +license-file: LICENSE +build-type: Simple + +executable generate-ci + main-is: gen_ci.hs + ghc-options: -Wall + build-depends: base, + containers, + bytestring, + aeson >= 1.8.1 + default-language: Haskell2010 ===================================== .gitlab/generate-ci/update-ci ===================================== @@ -0,0 +1,16 @@ +#!/usr/bin/env bash + +out_dir="$(git rev-parse --show-toplevel)/.gitlab" + +# Update job metadata for ghcup +generate-ci metadata "$out_dir/jobs-metadata.json" +echo "Updated $out_dir/jobs-metadata.json" + +# Update CI jobs +tmp="$(mktemp)" +generate-ci gitlab "$tmp" +rm -f "$out_dir/jobs.yaml" +echo "### THIS IS A GENERATED FILE, DO NOT MODIFY DIRECTLY" > "$out_dir/jobs.yaml" +cat "$tmp" | jq >> "$out_dir/jobs.yaml" +rm "$tmp" +echo "Updated $out_dir/jobs.yaml" ===================================== .gitlab/generate_job_metadata deleted ===================================== @@ -1,5 +0,0 @@ -#! /usr/bin/env nix-shell -#!nix-shell -i bash -p cabal-install "haskell.packages.ghc92.ghcWithPackages (pkgs: with pkgs; [aeson])" git jq - -cd "$(dirname "${BASH_SOURCE[0]}")" -cabal run gen_ci -- metadata jobs-metadata.json ===================================== .gitlab/generate_jobs deleted ===================================== @@ -1,13 +0,0 @@ -#!/usr/bin/env nix-shell -#!nix-shell -i bash -p cabal-install "haskell.packages.ghc92.ghcWithPackages (pkgs: with pkgs; [aeson])" git jq - -# shellcheck shell=bash - -set -euo pipefail - -cd "$(dirname "${BASH_SOURCE[0]}")" -tmp=$(mktemp) -cabal run gen_ci -- gitlab $tmp -rm -f jobs.yaml -echo "### THIS IS A GENERATED FILE, DO NOT MODIFY DIRECTLY" > jobs.yaml -cat $tmp | jq | tee -a jobs.yaml View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8f6b771621922cab934ca7d84dd15b3ac4715e19 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8f6b771621922cab934ca7d84dd15b3ac4715e19 You're receiving 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 Jun 29 14:59:13 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 29 Jun 2023 10:59:13 -0400 Subject: [Git][ghc/ghc][wip/refactor-gen-ci] 19 commits: Configure CPP into settings Message-ID: <649d9c4147c35_3b5ae227739c78627261@gitlab.mail> Ben Gamari pushed to branch wip/refactor-gen-ci at Glasgow Haskell Compiler / GHC Commits: 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 68e474fd by Ben Gamari at 2023-06-29T10:59:06-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.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 - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.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/8f6b771621922cab934ca7d84dd15b3ac4715e19...68e474fdd3b307b7852369fc6cca48c4f61229b5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8f6b771621922cab934ca7d84dd15b3ac4715e19...68e474fdd3b307b7852369fc6cca48c4f61229b5 You're receiving 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 Jun 29 15:02:27 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 29 Jun 2023 11:02:27 -0400 Subject: [Git][ghc/ghc][wip/simplifier-tweaks] Add a strategic inline pragma Message-ID: <649d9d036fa8_3b5ae227739bd86277e4@gitlab.mail> Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC Commits: a52e3c44 by Simon Peyton Jones at 2023-06-29T14:23:22+01:00 Add a strategic inline pragma - - - - - 1 changed file: - compiler/GHC/HsToCore/Pmc/Solver/Types.hs Changes: ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -325,6 +325,11 @@ lookupVarInfoNT ts x = case lookupVarInfo ts x of go _ = Nothing trvVarInfo :: Functor f => (VarInfo -> f (a, VarInfo)) -> Nabla -> Id -> f (a, Nabla) +{-# INLINE trvVarInfo #-} +-- This function is called a lot and we want to specilise it, not only +-- for the type class, but also for its 'f' function argument. +-- Before the INLINE pragma it sometimes inlined and sometimes didn't, +-- depending delicately on GHC's optimisations. Better to use a pragma. trvVarInfo f nabla at MkNabla{ nabla_tm_st = ts at TmSt{ts_facts = env} } x = set_vi <$> f (lookupVarInfo ts x) where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a52e3c443e456f62898f0df65ef9435e706f4436 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a52e3c443e456f62898f0df65ef9435e706f4436 You're receiving 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 Jun 29 15:17:32 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 29 Jun 2023 11:17:32 -0400 Subject: [Git][ghc/ghc][wip/testsuite-output-patch] 22 commits: Configure CPP into settings Message-ID: <649da08c1b04c_3b5ae227739cc862826a@gitlab.mail> Ben Gamari pushed to branch wip/testsuite-output-patch at Glasgow Haskell Compiler / GHC Commits: 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 68e474fd by Ben Gamari at 2023-06-29T10:59:06-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - eddaa89c by Ben Gamari at 2023-06-29T11:10:50-04:00 Drop circle-ci-job.sh - - - - - 9c2ba7ed by Ben Gamari at 2023-06-29T11:10:50-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - e76ec6d2 by Ben Gamari at 2023-06-29T11:17:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.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 - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a4408099b1dfe10e00a2edb2a874fce5f87056d2...e76ec6d269f51d408a093803b79ead4315d32313 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a4408099b1dfe10e00a2edb2a874fce5f87056d2...e76ec6d269f51d408a093803b79ead4315d32313 You're receiving 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 Jun 29 15:17:51 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 29 Jun 2023 11:17:51 -0400 Subject: [Git][ghc/ghc][wip/ci-interface-stability] 26 commits: Configure CPP into settings Message-ID: <649da09f99202_3b5ae224d2de20628889@gitlab.mail> Ben Gamari pushed to branch wip/ci-interface-stability at Glasgow Haskell Compiler / GHC Commits: 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 68e474fd by Ben Gamari at 2023-06-29T10:59:06-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - eddaa89c by Ben Gamari at 2023-06-29T11:10:50-04:00 Drop circle-ci-job.sh - - - - - 9c2ba7ed by Ben Gamari at 2023-06-29T11:10:50-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - e76ec6d2 by Ben Gamari at 2023-06-29T11:17:22-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 62a912a3 by Ben Gamari at 2023-06-29T11:17:44-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - f7330f33 by Ben Gamari at 2023-06-29T11:17:44-04:00 compiler: Make OccSet opaque - - - - - 3adf5897 by Ben Gamari at 2023-06-29T11:17:44-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - a72541cf by Ben Gamari at 2023-06-29T11:17:44-04: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: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.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 - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f4b5f1572a0b3474daf62af8df9488574e4aec51...a72541cfd13a97537f5c212943f47f9d7f89ddca -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f4b5f1572a0b3474daf62af8df9488574e4aec51...a72541cfd13a97537f5c212943f47f9d7f89ddca You're receiving 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 Jun 29 16:22:11 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Thu, 29 Jun 2023 12:22:11 -0400 Subject: [Git][ghc/ghc][wip/testsuite-no-cusks-transitional] 3 commits: Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Message-ID: <649dafb356352_2b2f6ac9dd8391d5@gitlab.mail> Vladislav Zavialov pushed to branch wip/testsuite-no-cusks-transitional at Glasgow Haskell Compiler / GHC Commits: 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - ae1968d3 by Vladislav Zavialov at 2023-06-29T16:22:09+00:00 testsuite: Do not require CUSKs Numerous tests make use of CUSKs (complete user-supplied kinds), a legacy feature scheduled for deprecation. In order to proceed with the said deprecation, the tests have been updated to use SAKS instead (standalone kind signatures). This also allows us to remove the Haskell2010 language pragmas that were added in 115cd3c85a8 to work around the lack of CUSKs in GHC2021. - - - - - 30 changed files: - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/SysTools.hs - − compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - compiler/ghc.cabal.in - docs/users_guide/9.8.1-notes.rst - docs/users_guide/using-optimisation.rst - + m4/fp_link_supports_no_as_needed.m4 - m4/fptools_set_c_ld_flags.m4 - testsuite/tests/dependent/should_compile/Dep2.hs - testsuite/tests/dependent/should_compile/DkNameRes.hs - testsuite/tests/dependent/should_compile/KindEqualities2.hs - testsuite/tests/dependent/should_compile/RaeBlogPost.hs - testsuite/tests/dependent/should_compile/RaeJobTalk.hs - testsuite/tests/dependent/should_compile/T11711.hs - testsuite/tests/dependent/should_compile/T12442.hs - testsuite/tests/dependent/should_compile/T14066a.hs - testsuite/tests/dependent/should_compile/T14066a.stderr - testsuite/tests/dependent/should_compile/T14556.hs - testsuite/tests/dependent/should_compile/T14749.hs - testsuite/tests/dependent/should_compile/T16326_Compile1.hs - testsuite/tests/dependent/should_compile/TypeLevelVec.hs - testsuite/tests/dependent/should_compile/dynamic-paper.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/caeb366db13ecdb8de40ed91f0af0e45351c7e07...ae1968d3a5fad94142bc992d290ba078e8074ba0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/caeb366db13ecdb8de40ed91f0af0e45351c7e07...ae1968d3a5fad94142bc992d290ba078e8074ba0 You're receiving 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 Jun 29 17:58:45 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 29 Jun 2023 13:58:45 -0400 Subject: [Git][ghc/ghc][wip/testsuite-output-patch] gitlab-ci: Preserve unexpected output Message-ID: <649dc6555b9a9_2b2f6a1e9e4805143a@gitlab.mail> Ben Gamari pushed to branch wip/testsuite-output-patch at Glasgow Haskell Compiler / GHC Commits: 3bdc8b13 by Ben Gamari at 2023-06-29T13:58:23-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - 3 changed files: - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml Changes: ===================================== .gitlab/ci.sh ===================================== @@ -43,12 +43,13 @@ $0 - GHC continuous integration driver Common Modes: - usage Show this usage message. - setup Prepare environment for a build. - configure Run ./configure. - clean Clean the tree - shell Run an interactive shell with a configured build environment. - save_cache Preserve the cabal cache + usage Show this usage message. + setup Prepare environment for a build. + configure Run ./configure. + clean Clean the tree + shell Run an interactive shell with a configured build environment. + save_test_output Generate unexpected-test-output.tar.gz + save_cache Preserve the cabal cache Hadrian build system build_hadrian Build GHC via the Hadrian build system @@ -673,12 +674,13 @@ function test_hadrian() { --summary-junit=./junit.xml \ --test-have-intree-files \ --test-compiler="${test_compiler}" \ - "runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian main testsuite" + "runtest.opts+=${RUNTEST_ARGS:-}" \ + "runtest.opts+=--unexpected-output-dir=$TOP/unexpected-test-output" \ + || fail "hadrian main testsuite" info "STAGE2_TEST=$?" - fi - + fi } function summarise_hi_files() { @@ -770,6 +772,10 @@ function run_abi_test() { check_interfaces out/run1 out/run2 interfaces "Mismatched interface hashes" } +function save_test_output() { + tar -czf unexpected-test-output.tar.gz unexpected-test-output +} + function save_cache () { info "Storing cabal cache from $CABAL_DIR to $CABAL_CACHE..." rm -Rf "$CABAL_CACHE" @@ -935,6 +941,7 @@ case ${1:-help} in lint_author) shift; lint_author "$@" ;; compare_interfaces_of) shift; compare_interfaces_of "$@" ;; clean) clean ;; + save_test_output) save_test_output ;; save_cache) save_cache ;; shell) shift; shell "$@" ;; *) fail "unknown mode $1" ;; ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -670,10 +670,12 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } jobAfterScript | Windows <- opsys = [ "bash .gitlab/ci.sh save_cache" + , "bash .gitlab/ci.sh save_test_output" , "bash .gitlab/ci.sh clean" ] | otherwise = [ ".gitlab/ci.sh save_cache" + , ".gitlab/ci.sh save_test_output" , ".gitlab/ci.sh clean" , "cat ci_timings" ] @@ -696,16 +698,19 @@ 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 + , let runtestArgs = + [ "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity" + | validateNonmovingGc buildConfig + ] + in "RUNTEST_ARGS" =: unwords runtestArgs ] jobArtifacts = Artifacts { junitReport = "junit.xml" , expireIn = "2 weeks" , artifactPaths = [binDistName arch opsys buildConfig ++ ".tar.xz" - ,"junit.xml"] + ,"junit.xml" + ,"unexpected-test-output.tar.gz"] , artifactsWhen = ArtifactsAlways } ===================================== .gitlab/jobs.yaml ===================================== @@ -3,6 +3,7 @@ "aarch64-darwin-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -11,7 +12,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-aarch64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -59,12 +61,14 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-darwin-validate" } }, "aarch64-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -73,7 +77,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -117,12 +122,14 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate" } }, "i386-linux-deb9-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -131,7 +138,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-i386-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -175,12 +183,14 @@ "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb9-validate" } }, "nightly-aarch64-darwin-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -189,7 +199,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -237,6 +248,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-darwin-validate", "XZ_OPT": "-9" } @@ -244,6 +256,7 @@ "nightly-aarch64-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -252,7 +265,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -296,6 +310,7 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -303,6 +318,7 @@ "nightly-aarch64-linux-deb10-validate+llvm": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -311,7 +327,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -355,6 +372,7 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate+llvm", "XZ_OPT": "-9" } @@ -362,6 +380,7 @@ "nightly-i386-linux-deb9-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -370,7 +389,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-i386-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -414,6 +434,7 @@ "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb9-validate", "XZ_OPT": "-9" } @@ -421,6 +442,7 @@ "nightly-x86_64-darwin-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -429,7 +451,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -477,6 +500,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-darwin-validate", "XZ_OPT": "-9", "ac_cv_func_clock_gettime": "no", @@ -487,6 +511,7 @@ "nightly-x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -495,7 +520,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-freebsd13-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -541,6 +567,7 @@ "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-freebsd13-validate", "XZ_OPT": "-9" } @@ -548,6 +575,7 @@ "nightly-x86_64-linux-alpine3_12-int_native-validate+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -556,7 +584,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -603,6 +632,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-int_native-validate+fully_static", "XZ_OPT": "-9" } @@ -610,6 +640,7 @@ "nightly-x86_64-linux-alpine3_12-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -618,7 +649,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -665,6 +697,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-validate", "XZ_OPT": "-9" } @@ -672,6 +705,7 @@ "nightly-x86_64-linux-alpine3_12-validate+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -680,7 +714,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -727,6 +762,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-validate+fully_static", "XZ_OPT": "-9" } @@ -734,6 +770,7 @@ "nightly-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -742,7 +779,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -788,6 +826,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -795,6 +834,7 @@ "nightly-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -803,7 +843,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -849,6 +890,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -856,6 +898,7 @@ "nightly-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -864,7 +907,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -910,6 +954,7 @@ "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -917,6 +962,7 @@ "nightly-x86_64-linux-centos7-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -925,7 +971,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-centos7-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -970,6 +1017,7 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-centos7-validate", "XZ_OPT": "-9" } @@ -977,6 +1025,7 @@ "nightly-x86_64-linux-deb10-int_native-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -985,7 +1034,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1029,6 +1079,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-int_native-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-int_native-validate", "XZ_OPT": "-9" } @@ -1036,6 +1087,7 @@ "nightly-x86_64-linux-deb10-no_tntc-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1044,7 +1096,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-no_tntc-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1088,6 +1141,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-no_tntc-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--disable-tables-next-to-code", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate", "XZ_OPT": "-9" } @@ -1095,6 +1149,7 @@ "nightly-x86_64-linux-deb10-numa-slow-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1103,7 +1158,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1148,6 +1204,7 @@ "BUILD_FLAVOUR": "slow-validate", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate", "XZ_OPT": "-9" } @@ -1155,6 +1212,7 @@ "nightly-x86_64-linux-deb10-unreg-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1163,7 +1221,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-unreg-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1207,6 +1266,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-unreg-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-unregisterised", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-unreg-validate", "XZ_OPT": "-9" } @@ -1214,6 +1274,7 @@ "nightly-x86_64-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1222,7 +1283,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1266,6 +1328,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -1273,6 +1336,7 @@ "nightly-x86_64-linux-deb10-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1281,7 +1345,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1325,6 +1390,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+debug_info", "XZ_OPT": "-9" } @@ -1332,6 +1398,7 @@ "nightly-x86_64-linux-deb10-validate+llvm": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1340,7 +1407,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1384,6 +1452,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+llvm", "XZ_OPT": "-9" } @@ -1391,6 +1460,7 @@ "nightly-x86_64-linux-deb10-validate+thread_sanitizer": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1399,7 +1469,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1444,6 +1515,7 @@ "BUILD_FLAVOUR": "validate+thread_sanitizer", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions", "XZ_OPT": "-9" @@ -1452,6 +1524,7 @@ "nightly-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1460,7 +1533,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1506,6 +1580,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "XZ_OPT": "-9" } @@ -1513,6 +1588,7 @@ "nightly-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1521,7 +1597,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1568,6 +1645,7 @@ "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate", "XZ_OPT": "-9" } @@ -1575,6 +1653,7 @@ "nightly-x86_64-linux-deb11-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1583,7 +1662,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1627,6 +1707,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-validate", "XZ_OPT": "-9" } @@ -1634,6 +1715,7 @@ "nightly-x86_64-linux-deb11-validate+boot_nonmoving_gc": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1642,7 +1724,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1694,6 +1777,7 @@ "nightly-x86_64-linux-deb9-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1702,7 +1786,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1746,6 +1831,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb9-validate", "XZ_OPT": "-9" } @@ -1753,6 +1839,7 @@ "nightly-x86_64-linux-fedora33-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1761,7 +1848,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1807,6 +1895,7 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -1814,6 +1903,7 @@ "nightly-x86_64-linux-fedora33-release-hackage": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1822,7 +1912,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1869,6 +1960,7 @@ "HADRIAN_ARGS": "--haddock-base-url", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -1876,6 +1968,7 @@ "nightly-x86_64-linux-fedora33-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1884,7 +1977,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1930,6 +2024,7 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-validate+debug_info", "XZ_OPT": "-9" } @@ -1937,6 +2032,7 @@ "nightly-x86_64-linux-rocky8-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1945,7 +2041,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-rocky8-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1990,6 +2087,7 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-rocky8-validate", "XZ_OPT": "-9" } @@ -1997,6 +2095,7 @@ "nightly-x86_64-linux-ubuntu18_04-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2005,7 +2104,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-ubuntu18_04-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2049,6 +2149,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu18_04-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu18_04-validate", "XZ_OPT": "-9" } @@ -2056,6 +2157,7 @@ "nightly-x86_64-linux-ubuntu20_04-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2064,7 +2166,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-ubuntu20_04-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2108,6 +2211,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu20_04-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu20_04-validate", "XZ_OPT": "-9" } @@ -2115,6 +2219,7 @@ "nightly-x86_64-windows-int_native-validate": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -2122,7 +2227,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-windows-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2167,6 +2273,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-int_native-validate", "XZ_OPT": "-9" } @@ -2174,6 +2281,7 @@ "nightly-x86_64-windows-validate": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -2181,7 +2289,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-windows-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2226,6 +2335,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-validate", "XZ_OPT": "-9" } @@ -2233,6 +2343,7 @@ "release-aarch64-darwin-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2241,7 +2352,8 @@ "expire_in": "1 year", "paths": [ "ghc-aarch64-darwin-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2290,6 +2402,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-darwin-release", "XZ_OPT": "-9" } @@ -2297,6 +2410,7 @@ "release-aarch64-linux-deb10-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2305,7 +2419,8 @@ "expire_in": "1 year", "paths": [ "ghc-aarch64-linux-deb10-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2351,6 +2466,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-release+no_split_sections", "XZ_OPT": "-9" } @@ -2358,6 +2474,7 @@ "release-i386-linux-deb9-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2366,7 +2483,8 @@ "expire_in": "1 year", "paths": [ "ghc-i386-linux-deb9-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2412,6 +2530,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb9-release+no_split_sections", "XZ_OPT": "-9" } @@ -2419,6 +2538,7 @@ "release-x86_64-darwin-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2427,7 +2547,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-darwin-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2476,6 +2597,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-darwin-release", "XZ_OPT": "-9", "ac_cv_func_clock_gettime": "no", @@ -2486,6 +2608,7 @@ "release-x86_64-linux-alpine3_12-int_native-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2494,7 +2617,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2542,6 +2666,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-int_native-release+fully_static", "XZ_OPT": "-9" } @@ -2549,6 +2674,7 @@ "release-x86_64-linux-alpine3_12-release+fully_static+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2557,7 +2683,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-release+fully_static+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2605,6 +2732,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-release+fully_static+no_split_sections", "XZ_OPT": "-9" } @@ -2612,6 +2740,7 @@ "release-x86_64-linux-alpine3_12-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2620,7 +2749,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2668,6 +2798,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-release+no_split_sections", "XZ_OPT": "-9" } @@ -2675,6 +2806,7 @@ "release-x86_64-linux-centos7-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2683,7 +2815,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-centos7-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2729,6 +2862,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-centos7-release+no_split_sections", "XZ_OPT": "-9" } @@ -2736,6 +2870,7 @@ "release-x86_64-linux-deb10-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2744,7 +2879,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb10-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2790,6 +2926,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-release", "XZ_OPT": "-9" } @@ -2797,6 +2934,7 @@ "release-x86_64-linux-deb10-release+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2805,7 +2943,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb10-release+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2851,6 +2990,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-release+debug_info", "XZ_OPT": "-9" } @@ -2858,6 +2998,7 @@ "release-x86_64-linux-deb11-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2866,7 +3007,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb11-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2912,6 +3054,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-release", "XZ_OPT": "-9" } @@ -2919,6 +3062,7 @@ "release-x86_64-linux-deb11-release+boot_nonmoving_gc": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2927,7 +3071,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb11-release+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2981,6 +3126,7 @@ "release-x86_64-linux-deb9-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2989,7 +3135,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb9-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3035,6 +3182,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb9-release+no_split_sections", "XZ_OPT": "-9" } @@ -3042,6 +3190,7 @@ "release-x86_64-linux-fedora33-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3050,7 +3199,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3098,6 +3248,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -3105,6 +3256,7 @@ "release-x86_64-linux-fedora33-release+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3113,7 +3265,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3161,6 +3314,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release+debug_info", "XZ_OPT": "-9" } @@ -3168,6 +3322,7 @@ "release-x86_64-linux-fedora33-release-hackage": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3176,7 +3331,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3224,6 +3380,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -3231,6 +3388,7 @@ "release-x86_64-linux-rocky8-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3239,7 +3397,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-rocky8-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3285,6 +3444,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-rocky8-release", "XZ_OPT": "-9" } @@ -3292,6 +3452,7 @@ "release-x86_64-linux-ubuntu18_04-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3300,7 +3461,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-ubuntu18_04-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3346,6 +3508,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu18_04-release", "XZ_OPT": "-9" } @@ -3353,6 +3516,7 @@ "release-x86_64-linux-ubuntu20_04-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3361,7 +3525,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-ubuntu20_04-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3407,6 +3572,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu20_04-release", "XZ_OPT": "-9" } @@ -3414,6 +3580,7 @@ "release-x86_64-windows-int_native-release+no_split_sections": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -3421,7 +3588,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-windows-int_native-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3467,6 +3635,7 @@ "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-int_native-release+no_split_sections", "XZ_OPT": "-9" } @@ -3474,6 +3643,7 @@ "release-x86_64-windows-release+no_split_sections": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -3481,7 +3651,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-windows-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3527,6 +3698,7 @@ "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-release+no_split_sections", "XZ_OPT": "-9" } @@ -3534,6 +3706,7 @@ "x86_64-darwin-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3542,7 +3715,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3590,6 +3764,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-darwin-validate", "ac_cv_func_clock_gettime": "no", "ac_cv_func_futimens": "no", @@ -3599,6 +3774,7 @@ "x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3607,7 +3783,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-freebsd13-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3653,12 +3830,14 @@ "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-freebsd13-validate" } }, "x86_64-linux-alpine3_12-validate+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3667,7 +3846,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3714,12 +3894,14 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-validate+fully_static" } }, "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3728,7 +3910,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3774,12 +3957,14 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static" } }, "x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3788,7 +3973,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3835,12 +4021,14 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static" } }, "x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3849,7 +4037,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3896,12 +4085,14 @@ "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static" } }, "x86_64-linux-deb10-int_native-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3910,7 +4101,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3954,12 +4146,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-int_native-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-int_native-validate" } }, "x86_64-linux-deb10-no_tntc-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3968,7 +4162,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-no_tntc-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4013,12 +4208,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-no_tntc-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--disable-tables-next-to-code", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate" } }, "x86_64-linux-deb10-numa-slow-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4027,7 +4224,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4072,12 +4270,14 @@ "BUILD_FLAVOUR": "slow-validate", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate" } }, "x86_64-linux-deb10-unreg-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4086,7 +4286,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-unreg-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4130,12 +4331,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-unreg-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-unregisterised", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-unreg-validate" } }, "x86_64-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4144,7 +4347,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4188,12 +4392,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate" } }, "x86_64-linux-deb10-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4202,7 +4408,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4246,12 +4453,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+debug_info" } }, "x86_64-linux-deb10-validate+llvm": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4260,7 +4469,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4304,12 +4514,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+llvm" } }, "x86_64-linux-deb10-validate+thread_sanitizer": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4318,7 +4530,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4364,6 +4577,7 @@ "BUILD_FLAVOUR": "validate+thread_sanitizer", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" } @@ -4371,6 +4585,7 @@ "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4379,7 +4594,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4425,12 +4641,14 @@ "CONFIGURE_ARGS": "--with-intree-gmp", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" } }, "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4439,7 +4657,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4486,12 +4705,14 @@ "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", + "RUNTEST_ARGS": "", "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 save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4500,7 +4721,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4551,6 +4773,7 @@ "x86_64-linux-fedora33-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4559,7 +4782,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4605,12 +4829,14 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release" } }, "x86_64-windows-validate": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -4618,7 +4844,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-windows-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4663,6 +4890,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-validate" } } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3bdc8b135cbc079b415837c2c412e1df5372fa69 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3bdc8b135cbc079b415837c2c412e1df5372fa69 You're receiving 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 Jun 29 17:59:09 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 29 Jun 2023 13:59:09 -0400 Subject: [Git][ghc/ghc][wip/ci-interface-stability] 5 commits: gitlab-ci: Preserve unexpected output Message-ID: <649dc66dcad50_2b2f6a1e9b17c520b6@gitlab.mail> Ben Gamari pushed to branch wip/ci-interface-stability at Glasgow Haskell Compiler / GHC Commits: 3bdc8b13 by Ben Gamari at 2023-06-29T13:58:23-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - d13f10ff by Ben Gamari at 2023-06-29T13:58:32-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - f9b38e18 by Ben Gamari at 2023-06-29T13:58:32-04:00 compiler: Make OccSet opaque - - - - - 2e4ed59f by Ben Gamari at 2023-06-29T13:58:32-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 04bd83f8 by Ben Gamari at 2023-06-29T13:58:32-04: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. - - - - - 18 changed files: - .gitlab/ci.sh - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Type.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Types/TyThing/Ppr.hs - hadrian/src/Packages.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Default.hs - testsuite/mk/boilerplate.mk - testsuite/tests/ghci/scripts/ghci008.stdout - + testsuite/tests/interface-stability/Makefile - + testsuite/tests/interface-stability/README.mkd - + testsuite/tests/interface-stability/all.T - + testsuite/tests/interface-stability/base-exports.stdout - + utils/dump-decls/Main.hs - + utils/dump-decls/dump-decls.cabal Changes: ===================================== .gitlab/ci.sh ===================================== @@ -43,12 +43,13 @@ $0 - GHC continuous integration driver Common Modes: - usage Show this usage message. - setup Prepare environment for a build. - configure Run ./configure. - clean Clean the tree - shell Run an interactive shell with a configured build environment. - save_cache Preserve the cabal cache + usage Show this usage message. + setup Prepare environment for a build. + configure Run ./configure. + clean Clean the tree + shell Run an interactive shell with a configured build environment. + save_test_output Generate unexpected-test-output.tar.gz + save_cache Preserve the cabal cache Hadrian build system build_hadrian Build GHC via the Hadrian build system @@ -673,12 +674,14 @@ function test_hadrian() { --summary-junit=./junit.xml \ --test-have-intree-files \ --test-compiler="${test_compiler}" \ - "runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian main testsuite" + "runtest.opts+=${RUNTEST_ARGS:-}" \ + "runtest.opts+=--unexpected-output-dir=$TOP/unexpected-test-output" \ + || fail "hadrian main testsuite" + tar -czf unexpected-test-output.tar.gz unexpected-test-output info "STAGE2_TEST=$?" - fi - + fi } function summarise_hi_files() { @@ -770,6 +773,10 @@ function run_abi_test() { check_interfaces out/run1 out/run2 interfaces "Mismatched interface hashes" } +function save_test_output() { + tar -czf unexpected-test-output.tar.gz unexpected-test-output +} + function save_cache () { info "Storing cabal cache from $CABAL_DIR to $CABAL_CACHE..." rm -Rf "$CABAL_CACHE" @@ -935,6 +942,7 @@ case ${1:-help} in lint_author) shift; lint_author "$@" ;; compare_interfaces_of) shift; compare_interfaces_of "$@" ;; clean) clean ;; + save_test_output) save_test_output ;; save_cache) save_cache ;; shell) shift; shell "$@" ;; *) fail "unknown mode $1" ;; ===================================== .gitlab/generate-ci/gen_ci.hs ===================================== @@ -670,10 +670,12 @@ job arch opsys buildConfig = NamedJob { name = jobName, jobInfo = Job {..} } jobAfterScript | Windows <- opsys = [ "bash .gitlab/ci.sh save_cache" + , "bash .gitlab/ci.sh save_test_output" , "bash .gitlab/ci.sh clean" ] | otherwise = [ ".gitlab/ci.sh save_cache" + , ".gitlab/ci.sh save_test_output" , ".gitlab/ci.sh clean" , "cat ci_timings" ] @@ -696,16 +698,19 @@ 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 + , let runtestArgs = + [ "--way=nonmoving --way=nonmoving_thr --way=nonmoving_thr_sanity" + | validateNonmovingGc buildConfig + ] + in "RUNTEST_ARGS" =: unwords runtestArgs ] jobArtifacts = Artifacts { junitReport = "junit.xml" , expireIn = "2 weeks" , artifactPaths = [binDistName arch opsys buildConfig ++ ".tar.xz" - ,"junit.xml"] + ,"junit.xml" + ,"unexpected-test-output.tar.gz"] , artifactsWhen = ArtifactsAlways } ===================================== .gitlab/jobs.yaml ===================================== @@ -3,6 +3,7 @@ "aarch64-darwin-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -11,7 +12,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-aarch64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -59,12 +61,14 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-darwin-validate" } }, "aarch64-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -73,7 +77,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -117,12 +122,14 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate" } }, "i386-linux-deb9-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -131,7 +138,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-i386-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -175,12 +183,14 @@ "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb9-validate" } }, "nightly-aarch64-darwin-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -189,7 +199,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -237,6 +248,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-darwin-validate", "XZ_OPT": "-9" } @@ -244,6 +256,7 @@ "nightly-aarch64-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -252,7 +265,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -296,6 +310,7 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -303,6 +318,7 @@ "nightly-aarch64-linux-deb10-validate+llvm": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -311,7 +327,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-aarch64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -355,6 +372,7 @@ "BIN_DIST_NAME": "ghc-aarch64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-validate+llvm", "XZ_OPT": "-9" } @@ -362,6 +380,7 @@ "nightly-i386-linux-deb9-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -370,7 +389,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-i386-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -414,6 +434,7 @@ "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb9-validate", "XZ_OPT": "-9" } @@ -421,6 +442,7 @@ "nightly-x86_64-darwin-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -429,7 +451,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -477,6 +500,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-darwin-validate", "XZ_OPT": "-9", "ac_cv_func_clock_gettime": "no", @@ -487,6 +511,7 @@ "nightly-x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -495,7 +520,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-freebsd13-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -541,6 +567,7 @@ "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-freebsd13-validate", "XZ_OPT": "-9" } @@ -548,6 +575,7 @@ "nightly-x86_64-linux-alpine3_12-int_native-validate+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -556,7 +584,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -603,6 +632,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-int_native-validate+fully_static", "XZ_OPT": "-9" } @@ -610,6 +640,7 @@ "nightly-x86_64-linux-alpine3_12-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -618,7 +649,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -665,6 +697,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-validate", "XZ_OPT": "-9" } @@ -672,6 +705,7 @@ "nightly-x86_64-linux-alpine3_12-validate+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -680,7 +714,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -727,6 +762,7 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-validate+fully_static", "XZ_OPT": "-9" } @@ -734,6 +770,7 @@ "nightly-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -742,7 +779,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -788,6 +826,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -795,6 +834,7 @@ "nightly-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -803,7 +843,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -849,6 +890,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -856,6 +898,7 @@ "nightly-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -864,7 +907,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -910,6 +954,7 @@ "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static", "XZ_OPT": "-9" } @@ -917,6 +962,7 @@ "nightly-x86_64-linux-centos7-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -925,7 +971,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-centos7-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -970,6 +1017,7 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-centos7-validate", "XZ_OPT": "-9" } @@ -977,6 +1025,7 @@ "nightly-x86_64-linux-deb10-int_native-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -985,7 +1034,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1029,6 +1079,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-int_native-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-int_native-validate", "XZ_OPT": "-9" } @@ -1036,6 +1087,7 @@ "nightly-x86_64-linux-deb10-no_tntc-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1044,7 +1096,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-no_tntc-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1088,6 +1141,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-no_tntc-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--disable-tables-next-to-code", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate", "XZ_OPT": "-9" } @@ -1095,6 +1149,7 @@ "nightly-x86_64-linux-deb10-numa-slow-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1103,7 +1158,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1148,6 +1204,7 @@ "BUILD_FLAVOUR": "slow-validate", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate", "XZ_OPT": "-9" } @@ -1155,6 +1212,7 @@ "nightly-x86_64-linux-deb10-unreg-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1163,7 +1221,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-unreg-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1207,6 +1266,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-unreg-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-unregisterised", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-unreg-validate", "XZ_OPT": "-9" } @@ -1214,6 +1274,7 @@ "nightly-x86_64-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1222,7 +1283,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1266,6 +1328,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate", "XZ_OPT": "-9" } @@ -1273,6 +1336,7 @@ "nightly-x86_64-linux-deb10-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1281,7 +1345,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1325,6 +1390,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+debug_info", "XZ_OPT": "-9" } @@ -1332,6 +1398,7 @@ "nightly-x86_64-linux-deb10-validate+llvm": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1340,7 +1407,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1384,6 +1452,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+llvm", "XZ_OPT": "-9" } @@ -1391,6 +1460,7 @@ "nightly-x86_64-linux-deb10-validate+thread_sanitizer": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1399,7 +1469,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1444,6 +1515,7 @@ "BUILD_FLAVOUR": "validate+thread_sanitizer", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions", "XZ_OPT": "-9" @@ -1452,6 +1524,7 @@ "nightly-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1460,7 +1533,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1506,6 +1580,7 @@ "CONFIGURE_ARGS": "--with-intree-gmp", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate", "XZ_OPT": "-9" } @@ -1513,6 +1588,7 @@ "nightly-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1521,7 +1597,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1568,6 +1645,7 @@ "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate", "XZ_OPT": "-9" } @@ -1575,6 +1653,7 @@ "nightly-x86_64-linux-deb11-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1583,7 +1662,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1627,6 +1707,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb11-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-validate", "XZ_OPT": "-9" } @@ -1634,6 +1715,7 @@ "nightly-x86_64-linux-deb11-validate+boot_nonmoving_gc": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1642,7 +1724,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1694,6 +1777,7 @@ "nightly-x86_64-linux-deb9-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1702,7 +1786,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-deb9-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1746,6 +1831,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb9-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb9-validate", "XZ_OPT": "-9" } @@ -1753,6 +1839,7 @@ "nightly-x86_64-linux-fedora33-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1761,7 +1848,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1807,6 +1895,7 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -1814,6 +1903,7 @@ "nightly-x86_64-linux-fedora33-release-hackage": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1822,7 +1912,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1869,6 +1960,7 @@ "HADRIAN_ARGS": "--haddock-base-url", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -1876,6 +1968,7 @@ "nightly-x86_64-linux-fedora33-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1884,7 +1977,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-fedora33-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1930,6 +2024,7 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-validate+debug_info", "XZ_OPT": "-9" } @@ -1937,6 +2032,7 @@ "nightly-x86_64-linux-rocky8-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -1945,7 +2041,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-rocky8-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -1990,6 +2087,7 @@ "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-rocky8-validate", "XZ_OPT": "-9" } @@ -1997,6 +2095,7 @@ "nightly-x86_64-linux-ubuntu18_04-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2005,7 +2104,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-ubuntu18_04-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2049,6 +2149,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu18_04-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu18_04-validate", "XZ_OPT": "-9" } @@ -2056,6 +2157,7 @@ "nightly-x86_64-linux-ubuntu20_04-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2064,7 +2166,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-linux-ubuntu20_04-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2108,6 +2211,7 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu20_04-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu20_04-validate", "XZ_OPT": "-9" } @@ -2115,6 +2219,7 @@ "nightly-x86_64-windows-int_native-validate": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -2122,7 +2227,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-windows-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2167,6 +2273,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-int_native-validate", "XZ_OPT": "-9" } @@ -2174,6 +2281,7 @@ "nightly-x86_64-windows-validate": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -2181,7 +2289,8 @@ "expire_in": "8 weeks", "paths": [ "ghc-x86_64-windows-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2226,6 +2335,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-validate", "XZ_OPT": "-9" } @@ -2233,6 +2343,7 @@ "release-aarch64-darwin-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2241,7 +2352,8 @@ "expire_in": "1 year", "paths": [ "ghc-aarch64-darwin-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2290,6 +2402,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "11.0", "NIX_SYSTEM": "aarch64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-darwin-release", "XZ_OPT": "-9" } @@ -2297,6 +2410,7 @@ "release-aarch64-linux-deb10-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2305,7 +2419,8 @@ "expire_in": "1 year", "paths": [ "ghc-aarch64-linux-deb10-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2351,6 +2466,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "aarch64-linux-deb10-release+no_split_sections", "XZ_OPT": "-9" } @@ -2358,6 +2474,7 @@ "release-i386-linux-deb9-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2366,7 +2483,8 @@ "expire_in": "1 year", "paths": [ "ghc-i386-linux-deb9-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2412,6 +2530,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "i386-linux-deb9-release+no_split_sections", "XZ_OPT": "-9" } @@ -2419,6 +2538,7 @@ "release-x86_64-darwin-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2427,7 +2547,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-darwin-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2476,6 +2597,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-darwin-release", "XZ_OPT": "-9", "ac_cv_func_clock_gettime": "no", @@ -2486,6 +2608,7 @@ "release-x86_64-linux-alpine3_12-int_native-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2494,7 +2617,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-int_native-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2542,6 +2666,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-int_native-release+fully_static", "XZ_OPT": "-9" } @@ -2549,6 +2674,7 @@ "release-x86_64-linux-alpine3_12-release+fully_static+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2557,7 +2683,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-release+fully_static+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2605,6 +2732,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-release+fully_static+no_split_sections", "XZ_OPT": "-9" } @@ -2612,6 +2740,7 @@ "release-x86_64-linux-alpine3_12-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2620,7 +2749,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-alpine3_12-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2668,6 +2798,7 @@ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-release+no_split_sections", "XZ_OPT": "-9" } @@ -2675,6 +2806,7 @@ "release-x86_64-linux-centos7-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2683,7 +2815,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-centos7-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2729,6 +2862,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-centos7-release+no_split_sections", "XZ_OPT": "-9" } @@ -2736,6 +2870,7 @@ "release-x86_64-linux-deb10-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2744,7 +2879,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb10-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2790,6 +2926,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-release", "XZ_OPT": "-9" } @@ -2797,6 +2934,7 @@ "release-x86_64-linux-deb10-release+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2805,7 +2943,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb10-release+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2851,6 +2990,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-release+debug_info", "XZ_OPT": "-9" } @@ -2858,6 +2998,7 @@ "release-x86_64-linux-deb11-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2866,7 +3007,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb11-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2912,6 +3054,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-release", "XZ_OPT": "-9" } @@ -2919,6 +3062,7 @@ "release-x86_64-linux-deb11-release+boot_nonmoving_gc": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2927,7 +3071,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb11-release+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -2981,6 +3126,7 @@ "release-x86_64-linux-deb9-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -2989,7 +3135,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-deb9-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3035,6 +3182,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb9-release+no_split_sections", "XZ_OPT": "-9" } @@ -3042,6 +3190,7 @@ "release-x86_64-linux-fedora33-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3050,7 +3199,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3098,6 +3248,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -3105,6 +3256,7 @@ "release-x86_64-linux-fedora33-release+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3113,7 +3265,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3161,6 +3314,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release+debug_info", "XZ_OPT": "-9" } @@ -3168,6 +3322,7 @@ "release-x86_64-linux-fedora33-release-hackage": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3176,7 +3331,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3224,6 +3380,7 @@ "IGNORE_PERF_FAILURES": "all", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release", "XZ_OPT": "-9" } @@ -3231,6 +3388,7 @@ "release-x86_64-linux-rocky8-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3239,7 +3397,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-rocky8-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3285,6 +3444,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-rocky8-release", "XZ_OPT": "-9" } @@ -3292,6 +3452,7 @@ "release-x86_64-linux-ubuntu18_04-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3300,7 +3461,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-ubuntu18_04-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3346,6 +3508,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu18_04-release", "XZ_OPT": "-9" } @@ -3353,6 +3516,7 @@ "release-x86_64-linux-ubuntu20_04-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3361,7 +3525,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-linux-ubuntu20_04-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3407,6 +3572,7 @@ "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-ubuntu20_04-release", "XZ_OPT": "-9" } @@ -3414,6 +3580,7 @@ "release-x86_64-windows-int_native-release+no_split_sections": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -3421,7 +3588,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-windows-int_native-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3467,6 +3635,7 @@ "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-int_native-release+no_split_sections", "XZ_OPT": "-9" } @@ -3474,6 +3643,7 @@ "release-x86_64-windows-release+no_split_sections": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -3481,7 +3651,8 @@ "expire_in": "1 year", "paths": [ "ghc-x86_64-windows-release+no_split_sections.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3527,6 +3698,7 @@ "IGNORE_PERF_FAILURES": "all", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-release+no_split_sections", "XZ_OPT": "-9" } @@ -3534,6 +3706,7 @@ "x86_64-darwin-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3542,7 +3715,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-darwin-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3590,6 +3764,7 @@ "LANG": "en_US.UTF-8", "MACOSX_DEPLOYMENT_TARGET": "10.10", "NIX_SYSTEM": "x86_64-darwin", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-darwin-validate", "ac_cv_func_clock_gettime": "no", "ac_cv_func_futimens": "no", @@ -3599,6 +3774,7 @@ "x86_64-freebsd13-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3607,7 +3783,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-freebsd13-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3653,12 +3830,14 @@ "CONFIGURE_ARGS": "--with-gmp-includes=/usr/local/include --with-gmp-libraries=/usr/local/lib --with-iconv-includes=/usr/local/include --with-iconv-libraries=/usr/local/lib ", "GHC_VERSION": "9.4.3", "HADRIAN_ARGS": "--docs=no-sphinx", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-freebsd13-validate" } }, "x86_64-linux-alpine3_12-validate+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3667,7 +3846,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_12-validate+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3714,12 +3894,14 @@ "CONFIGURE_ARGS": "--disable-ld-override ", "HADRIAN_ARGS": "--docs=no-sphinx", "INSTALL_CONFIGURE_ARGS": "--disable-ld-override", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_12-validate+fully_static" } }, "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3728,7 +3910,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3774,12 +3957,14 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-cross_wasm32-wasi-release+fully_static" } }, "x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3788,7 +3973,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3835,12 +4021,14 @@ "CONFIGURE_ARGS": "--with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-int_native-cross_wasm32-wasi-release+fully_static" } }, "x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3849,7 +4037,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3896,12 +4085,14 @@ "CONFIGURE_ARGS": "--enable-unregisterised --with-intree-gmp --with-system-libffi", "CROSS_TARGET": "wasm32-wasi", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-alpine3_17-wasm-unreg-cross_wasm32-wasi-release+fully_static" } }, "x86_64-linux-deb10-int_native-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3910,7 +4101,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-int_native-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -3954,12 +4146,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-int_native-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-int_native-validate" } }, "x86_64-linux-deb10-no_tntc-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -3968,7 +4162,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-no_tntc-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4013,12 +4208,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-no_tntc-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--disable-tables-next-to-code", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-no_tntc-validate" } }, "x86_64-linux-deb10-numa-slow-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4027,7 +4224,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-numa-slow-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4072,12 +4270,14 @@ "BUILD_FLAVOUR": "slow-validate", "CONFIGURE_ARGS": "", "ENABLE_NUMA": "1", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-numa-slow-validate" } }, "x86_64-linux-deb10-unreg-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4086,7 +4286,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-unreg-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4130,12 +4331,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-unreg-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-unregisterised", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-unreg-validate" } }, "x86_64-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4144,7 +4347,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4188,12 +4392,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "--enable-ipe-data-compression", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate" } }, "x86_64-linux-deb10-validate+debug_info": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4202,7 +4408,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+debug_info.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4246,12 +4453,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+debug_info", "BUILD_FLAVOUR": "validate+debug_info", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+debug_info" } }, "x86_64-linux-deb10-validate+llvm": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4260,7 +4469,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+llvm.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4304,12 +4514,14 @@ "BIN_DIST_NAME": "ghc-x86_64-linux-deb10-validate+llvm", "BUILD_FLAVOUR": "validate+llvm", "CONFIGURE_ARGS": "", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+llvm" } }, "x86_64-linux-deb10-validate+thread_sanitizer": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4318,7 +4530,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb10-validate+thread_sanitizer.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4364,6 +4577,7 @@ "BUILD_FLAVOUR": "validate+thread_sanitizer", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--docs=none", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb10-validate+thread_sanitizer", "TSAN_OPTIONS": "suppressions=$CI_PROJECT_DIR/rts/.tsan-suppressions" } @@ -4371,6 +4585,7 @@ "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4379,7 +4594,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-cross_aarch64-linux-gnu-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4425,12 +4641,14 @@ "CONFIGURE_ARGS": "--with-intree-gmp", "CROSS_EMULATOR": "qemu-aarch64 -L /usr/aarch64-linux-gnu", "CROSS_TARGET": "aarch64-linux-gnu", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate" } }, "x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4439,7 +4657,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-int_native-cross_javascript-unknown-ghcjs-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4486,12 +4705,14 @@ "CONFIGURE_WRAPPER": "emconfigure", "CROSS_EMULATOR": "js-emulator", "CROSS_TARGET": "javascript-unknown-ghcjs", + "RUNTEST_ARGS": "", "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 save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4500,7 +4721,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-deb11-validate+boot_nonmoving_gc.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4551,6 +4773,7 @@ "x86_64-linux-fedora33-release": { "after_script": [ ".gitlab/ci.sh save_cache", + ".gitlab/ci.sh save_test_output", ".gitlab/ci.sh clean", "cat ci_timings" ], @@ -4559,7 +4782,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-linux-fedora33-release.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4605,12 +4829,14 @@ "CONFIGURE_ARGS": "", "LLC": "/bin/false", "OPT": "/bin/false", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-linux-fedora33-release" } }, "x86_64-windows-validate": { "after_script": [ "bash .gitlab/ci.sh save_cache", + "bash .gitlab/ci.sh save_test_output", "bash .gitlab/ci.sh clean" ], "allow_failure": false, @@ -4618,7 +4844,8 @@ "expire_in": "2 weeks", "paths": [ "ghc-x86_64-windows-validate.tar.xz", - "junit.xml" + "junit.xml", + "unexpected-test-output.tar.gz" ], "reports": { "junit": "junit.xml" @@ -4663,6 +4890,7 @@ "HADRIAN_ARGS": "--docs=no-sphinx", "LANG": "en_US.UTF-8", "MSYSTEM": "CLANG64", + "RUNTEST_ARGS": "", "TEST_ENV": "x86_64-windows-validate" } } ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -834,10 +834,13 @@ When printing an interface file (--show-iface), we want to print everything unqualified, so we can just print the OccName directly. -} +-- | Show a declaration but not its RHS. showToHeader :: ShowSub showToHeader = ShowSub { ss_how_much = ShowHeader $ AltPpr Nothing , ss_forall = ShowForAllWhen } +-- | Show declaration and its RHS, including GHc-internal information (e.g. +-- for @--show-iface@). showToIface :: ShowSub showToIface = ShowSub { ss_how_much = ShowIface , ss_forall = ShowForAllWhen } @@ -848,18 +851,20 @@ ppShowIface _ _ = Outputable.empty -- show if all sub-components or the complete interface is shown ppShowAllSubs :: ShowSub -> SDoc -> SDoc -- See Note [Minimal complete definition] -ppShowAllSubs (ShowSub { ss_how_much = ShowSome [] _ }) doc = doc -ppShowAllSubs (ShowSub { ss_how_much = ShowIface }) doc = doc -ppShowAllSubs _ _ = Outputable.empty +ppShowAllSubs (ShowSub { ss_how_much = ShowSome Nothing _ }) doc + = doc +ppShowAllSubs (ShowSub { ss_how_much = ShowIface }) doc = doc +ppShowAllSubs _ _ = Outputable.empty ppShowRhs :: ShowSub -> SDoc -> SDoc ppShowRhs (ShowSub { ss_how_much = ShowHeader _ }) _ = Outputable.empty ppShowRhs _ doc = doc showSub :: HasOccName n => ShowSub -> n -> Bool -showSub (ShowSub { ss_how_much = ShowHeader _ }) _ = False -showSub (ShowSub { ss_how_much = ShowSome (n:_) _ }) thing = n == occName thing -showSub (ShowSub { ss_how_much = _ }) _ = True +showSub (ShowSub { ss_how_much = ShowHeader _ }) _ = False +showSub (ShowSub { ss_how_much = ShowSome (Just f) _ }) thing + = f (occName thing) +showSub (ShowSub { ss_how_much = _ }) _ = True ppr_trim :: [Maybe SDoc] -> [SDoc] -- Collapse a group of Nothings to a single "..." ===================================== compiler/GHC/Iface/Type.hs ===================================== @@ -1361,21 +1361,18 @@ data ShowSub newtype AltPpr = AltPpr (Maybe (OccName -> SDoc)) data ShowHowMuch - = ShowHeader AltPpr -- ^Header information only, not rhs - | ShowSome [OccName] AltPpr - -- ^ Show only some sub-components. Specifically, - -- - -- [@\[\]@] Print all sub-components. - -- [@(n:ns)@] Print sub-component @n@ with @ShowSub = ns@; - -- elide other sub-components to @...@ - -- May 14: the list is max 1 element long at the moment + = ShowHeader AltPpr -- ^ Header information only, not rhs + | ShowSome (Maybe (OccName -> Bool)) AltPpr + -- ^ Show the declaration and its RHS. The @Maybe@ predicate + -- allows filtering of the sub-components which should be printing; + -- any sub-components filtered out will be elided with @... at . | ShowIface - -- ^Everything including GHC-internal information (used in --show-iface) + -- ^ Everything including GHC-internal information (used in --show-iface) instance Outputable ShowHowMuch where - ppr (ShowHeader _) = text "ShowHeader" - ppr ShowIface = text "ShowIface" - ppr (ShowSome occs _) = text "ShowSome" <+> ppr occs + ppr (ShowHeader _) = text "ShowHeader" + ppr ShowIface = text "ShowIface" + ppr (ShowSome _ _) = text "ShowSome" pprIfaceSigmaType :: ShowForAllFlag -> IfaceType -> SDoc pprIfaceSigmaType show_forall ty ===================================== compiler/GHC/Types/Name/Occurrence.hs ===================================== @@ -809,7 +809,7 @@ forceOccEnv nf (MkOccEnv fs) = seqEltsUFM (seqEltsUFM nf) fs -------------------------------------------------------------------------------- -type OccSet = FastStringEnv (UniqSet NameSpace) +newtype OccSet = OccSet (FastStringEnv (UniqSet NameSpace)) emptyOccSet :: OccSet unitOccSet :: OccName -> OccSet @@ -821,15 +821,15 @@ unionManyOccSets :: [OccSet] -> OccSet elemOccSet :: OccName -> OccSet -> Bool isEmptyOccSet :: OccSet -> Bool -emptyOccSet = emptyFsEnv -unitOccSet (OccName ns s) = unitFsEnv s (unitUniqSet ns) +emptyOccSet = OccSet emptyFsEnv +unitOccSet (OccName ns s) = OccSet $ unitFsEnv s (unitUniqSet ns) mkOccSet = extendOccSetList emptyOccSet -extendOccSet occs (OccName ns s) = extendFsEnv occs s (unitUniqSet ns) -extendOccSetList = foldl extendOccSet -unionOccSets = plusFsEnv_C unionUniqSets +extendOccSet (OccSet occs) (OccName ns s) = OccSet $ extendFsEnv occs s (unitUniqSet ns) +extendOccSetList = foldl' extendOccSet +unionOccSets (OccSet xs) (OccSet ys) = OccSet $ plusFsEnv_C unionUniqSets xs ys unionManyOccSets = foldl' unionOccSets emptyOccSet -elemOccSet (OccName ns s) occs = maybe False (elementOfUniqSet ns) $ lookupFsEnv occs s -isEmptyOccSet = isNullUFM +elemOccSet (OccName ns s) (OccSet occs) = maybe False (elementOfUniqSet ns) $ lookupFsEnv occs s +isEmptyOccSet (OccSet occs) = isNullUFM occs {- ************************************************************************ ===================================== compiler/GHC/Types/TyThing/Ppr.hs ===================================== @@ -145,16 +145,24 @@ pprTyThingHdr = pprTyThing showToHeader -- parts omitted. pprTyThingInContext :: ShowSub -> TyThing -> SDoc pprTyThingInContext show_sub thing - = go [] thing + = case parents thing of + -- If there are no parents print everything. + [] -> print_it Nothing thing + -- If `thing` has a parent, print the parent and only its child `thing` + thing':rest -> let subs = map getOccName (thing:rest) + filt = (`elem` subs) + in print_it (Just filt) thing' where - go ss thing - = case tyThingParent_maybe thing of - Just parent -> - go (getOccName thing : ss) parent - Nothing -> - pprTyThing - (show_sub { ss_how_much = ShowSome ss (AltPpr Nothing) }) - thing + parents = go + where + go thing = + case tyThingParent_maybe thing of + Just parent -> parent : go parent + Nothing -> [] + + print_it :: Maybe (OccName -> Bool) -> TyThing -> SDoc + print_it mb_filt thing = + pprTyThing (show_sub { ss_how_much = ShowSome mb_filt (AltPpr Nothing) }) thing -- | Like 'pprTyThingInContext', but adds the defining location. pprTyThingInContextLoc :: TyThing -> SDoc @@ -171,8 +179,8 @@ pprTyThing ss ty_thing pprIfaceDecl ss' (tyThingToIfaceDecl show_linear_types ty_thing) where ss' = case ss_how_much ss of - ShowHeader (AltPpr Nothing) -> ss { ss_how_much = ShowHeader ppr' } - ShowSome xs (AltPpr Nothing) -> ss { ss_how_much = ShowSome xs ppr' } + ShowHeader (AltPpr Nothing) -> ss { ss_how_much = ShowHeader ppr' } + ShowSome filt (AltPpr Nothing) -> ss { ss_how_much = ShowSome filt ppr' } _ -> ss ppr' = AltPpr $ ppr_bndr $ getName ty_thing ===================================== hadrian/src/Packages.hs ===================================== @@ -3,7 +3,7 @@ module Packages ( -- * GHC packages array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, @@ -35,7 +35,7 @@ import Oracles.Setting ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps - , compareSizes, compiler, containers, deepseq, deriveConstants, directory + , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl @@ -51,7 +51,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, @@ -75,6 +75,7 @@ containers = lib "containers" `setPath` "libraries/containers/con deepseq = lib "deepseq" deriveConstants = util "deriveConstants" directory = lib "directory" +dumpDecls = util "dump-decls" exceptions = lib "exceptions" filepath = lib "filepath" genapply = util "genapply" ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -40,6 +40,12 @@ countDepsSourcePath = "utils/count-deps/Main.hs" countDepsExtra :: [String] countDepsExtra = ["-iutils/count-deps"] +dumpDeclsProgPath, dumpDeclsSourcePath :: FilePath +dumpDeclsProgPath = "test/bin/dump-decls" <.> exe +dumpDeclsSourcePath = "utils/dump-decls/Main.hs" +dumpDeclsExtra :: [String] +dumpDeclsExtra = [] + noteLinterProgPath, noteLinterSourcePath :: FilePath noteLinterProgPath = "test/bin/lint-notes" <.> exe noteLinterSourcePath = "linters/lint-notes/Main.hs" @@ -67,6 +73,7 @@ checkPrograms = [ CheckProgram "test:check-ppr" checkPprProgPath checkPprSourcePath checkPprExtra checkPpr id id , CheckProgram "test:check-exact" checkExactProgPath checkExactSourcePath checkExactExtra checkExact id id , CheckProgram "test:count-deps" countDepsProgPath countDepsSourcePath countDepsExtra countDeps id id + , CheckProgram "test:dump-decls" dumpDeclsProgPath dumpDeclsSourcePath dumpDeclsExtra dumpDecls id id , CheckProgram "lint:notes" noteLinterProgPath noteLinterSourcePath noteLinterExtra lintNotes (const stage0Boot) id , CheckProgram "lint:whitespace" whitespaceLinterProgPath whitespaceLinterSourcePath whitespaceLinterExtra lintWhitespace (const stage0Boot) (filter (/= lintersCommon)) ] @@ -260,6 +267,7 @@ testRules = do setEnv "CHECK_PPR" (top -/- root -/- checkPprProgPath) setEnv "CHECK_EXACT" (top -/- root -/- checkExactProgPath) + setEnv "DUMP_DECLS" (top -/- root -/- dumpDeclsProgPath) setEnv "COUNT_DEPS" (top -/- root -/- countDepsProgPath) setEnv "LINT_NOTES" (top -/- root -/- noteLinterProgPath) setEnv "LINT_WHITESPACE" (top -/- root -/- whitespaceLinterProgPath) ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -167,7 +167,7 @@ stage2Packages = stage1Packages -- | Packages that are built only for the testsuite. testsuitePackages :: Action [Package] -testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig ]) +testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig, dumpDecls ]) -- | Default build ways for library packages: -- * We always build 'vanilla' way. ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -227,6 +227,10 @@ ifeq "$(CHECK_EXACT)" "" CHECK_EXACT := $(abspath $(TOP)/../inplace/bin/check-exact) endif +ifeq "$(DUMP_DECLS)" "" +DUMP_DECLS := $(abspath $(TOP)/../inplace/bin/dump-decls) +endif + ifeq "$(COUNT_DEPS)" "" COUNT_DEPS := $(abspath $(TOP)/../inplace/bin/count-deps) endif ===================================== testsuite/tests/ghci/scripts/ghci008.stdout ===================================== @@ -40,5 +40,5 @@ class (RealFrac a, Floating a) => RealFloat a where -- Defined in ‘GHC.Float’ instance RealFloat Double -- Defined in ‘GHC.Float’ instance RealFloat Float -- Defined in ‘GHC.Float’ -base-4.16.0.0:Data.OldList.isPrefixOf :: Eq a => [a] -> [a] -> Bool - -- Defined in ‘base-4.16.0.0:Data.OldList’ +base-4.18.0.0:Data.OldList.isPrefixOf :: Eq a => [a] -> [a] -> Bool + -- Defined in ‘base-4.18.0.0:Data.OldList’ ===================================== testsuite/tests/interface-stability/Makefile ===================================== @@ -0,0 +1,6 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +exports_% : + "$(DUMP_DECLS)" "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" $* ===================================== testsuite/tests/interface-stability/README.mkd ===================================== @@ -0,0 +1,11 @@ +# Interface stability testing + +The tests in this directory verify that the interfaces of exposed by GHC's +core libraries do not inadvertently change. They use the `utils/dump-decls` +utility to dump all exported declarations of all exposed modules for the +following packages: + + * base + +These are compared against the expected exports in the test's corresponding +`.stdout` file. ===================================== testsuite/tests/interface-stability/all.T ===================================== @@ -0,0 +1,7 @@ +def check_package(pkg_name): + test(f'{pkg_name}-exports', + req_hadrian_deps(['test:dump-decls']), + makefile_test, + [f'exports_{pkg_name}']) + +check_package('base') ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== The diff for this file was not included because it is too large. ===================================== utils/dump-decls/Main.hs ===================================== @@ -0,0 +1,243 @@ +module Main where + +import GHC +import GHC.Core.InstEnv (instEnvElts, instanceHead) +import GHC.Core.Class (classMinimalDef) +import GHC.Core.TyCo.FVs (tyConsOfType) +import GHC.Driver.Ppr (showSDocForUser) +import GHC.Unit.State (lookupUnitId, lookupPackageName) +import GHC.Unit.Info (UnitInfo, unitExposedModules, PackageName(..)) +import GHC.Data.FastString (fsLit) +import GHC.Driver.Env (hsc_units, hscEPS) +import GHC.Utils.Outputable +import GHC.Types.Unique.Set (nonDetEltsUniqSet) +import GHC.Types.TyThing (tyThingParent_maybe) +import GHC.Types.TyThing.Ppr (pprTyThing) +import GHC.Types.Name (nameOccName, nameModule_maybe, stableNameCmp) +import GHC.Types.Name.Occurrence (OccName, mkDataOcc, mkVarOcc) +import GHC.Unit.External (eps_inst_env) +import GHC.Iface.Syntax (ShowSub(..), ShowHowMuch(..), AltPpr(..)) +import GHC.Iface.Type (ShowForAllFlag(..)) + +import Data.Function (on) +import Data.List (sortBy) +import Control.Monad.IO.Class +import System.Environment (getArgs) +import Prelude hiding ((<>)) + +main :: IO () +main = do + ghcRoot:pkg_names <- getArgs + mapM_ (run ghcRoot) pkg_names + +run :: FilePath -> String -> IO () +run root pkg_nm = runGhc (Just root) $ do + let args = map noLoc + [ "-package=" ++ pkg_nm + , "-dppr-cols=1000" + , "-fprint-explicit-runtime-reps" + , "-fprint-explicit-foralls" + ] + dflags <- do + dflags <- getSessionDynFlags + logger <- getLogger + (dflags', _fileish_args, _dynamicFlagWarnings) <- + GHC.parseDynamicFlags logger dflags args + return dflags' + + _ <- setProgramDynFlags dflags + unit_state <- hsc_units <$> getSession + unit_id <- case lookupPackageName unit_state (PackageName $ fsLit pkg_nm) of + Just unit_id -> return unit_id + Nothing -> fail "failed to find package" + unit_info <- case lookupUnitId unit_state unit_id of + Just unit_info -> return unit_info + Nothing -> fail "unknown package" + + decls_doc <- reportUnitDecls unit_info + insts_doc <- reportInstances + + name_ppr_ctx <- GHC.getNamePprCtx + let rendered = showSDocForUser dflags unit_state name_ppr_ctx (vcat [decls_doc, insts_doc]) + liftIO $ putStrLn rendered + +ignoredModules :: [ModuleName] +ignoredModules = + map mkModuleName $ concat + [ unstableModules + , platformDependentModules + ] + where + unstableModules = + [ "GHC.Prim" + , "GHC.Conc.POSIX" + , "GHC.Conc.IO" + ] + platformDependentModules = + [ "System.Posix.Types" + , "Foreign.C.Types" + ] + +ignoredOccNames :: [OccName] +ignoredOccNames = + map mkDataOcc cTypeCons ++ + map mkVarOcc integerConversionIds + where + -- Data constructors from Foreign.C.Types whose RHSs are inherently platform-dependent + cTypeCons = + [ "CBool" + , "CChar" + , "CClock" + , "CDouble" + , "CFile" + , "CFloat" + , "CFpos" + , "CInt" + , "CIntMax" + , "CIntPtr" + , "CJmpBuf" + , "CLLong" + , "CLong" + , "CPtrdiff" + , "CSChar" + , "CSUSeconds" + , "CShort" + , "CSigAtomic" + , "CSize" + , "CTime" + , "CUChar" + , "CUInt" + , "CUIntMax" + , "CUIntPtr" + , "CULLong" + , "CULong" + , "CUSeconds" + , "CUShort" + , "CWchar" + ] + + -- Conversion functions in GHC.Integer which are only exposed on 32-bit + -- platforms + integerConversionIds = + [ "int64ToInteger" + , "integerToInt64" + , "integerToWord64" + , "word64ToInteger" + ] + +ignoredOccName :: OccName -> Bool +ignoredOccName occ = occ `elem` ignoredOccNames + +ignoredName :: Name -> Bool +ignoredName nm + | ignoredOccName (getOccName nm) + = True + | Just md <- nameModule_maybe nm + , moduleName md `elem` ignoredModules + = True + | otherwise + = False + +ignoredTyThing :: TyThing -> Bool +ignoredTyThing _ = False + +ignoredTyCon :: TyCon -> Bool +ignoredTyCon = ignoredName . getName + +ignoredType :: Type -> Bool +ignoredType = any ignoredTyCon . nonDetEltsUniqSet . tyConsOfType + +-- | Ignore instances whose heads mention ignored types. +ignoredInstance :: ClsInst -> Bool +ignoredInstance inst + | ignoredName $ getName cls + = True + | any ignoredType tys + = True + | otherwise + = False + where + (_, cls, tys) = instanceHead inst + +reportUnitDecls :: UnitInfo -> Ghc SDoc +reportUnitDecls unit_info = do + let exposed :: [ModuleName] + exposed = map fst (unitExposedModules unit_info) + vcat <$> mapM reportModuleDecls exposed + +reportModuleDecls :: ModuleName -> Ghc SDoc +reportModuleDecls modl_nm + | modl_nm `elem` ignoredModules = do + return $ vcat [ mod_header, text "-- ignored", text "" ] + | otherwise = do + modl <- GHC.lookupQualifiedModule NoPkgQual modl_nm + mb_mod_info <- GHC.getModuleInfo modl + mod_info <- case mb_mod_info of + Nothing -> fail "Failed to find module" + Just mod_info -> return mod_info + + Just name_ppr_ctx <- mkNamePprCtxForModule mod_info + let names = GHC.modInfoExports mod_info + sorted_names = sortBy (compare `on` nameOccName) names + + exported_occs :: [OccName] + exported_occs = map nameOccName names + + is_exported :: OccName -> Bool + is_exported occ = occ `elem` exported_occs + + show_occ :: OccName -> Bool + show_occ occ = is_exported occ && not (ignoredOccName occ) + + things <- mapM GHC.lookupName sorted_names + let contents = vcat $ + [ text "-- Safety:" <+> ppr (modInfoSafe mod_info) ] ++ + [ pprTyThing ss thing $$ extras + | Just thing <- things + , case tyThingParent_maybe thing of + Just parent + | is_exported (getOccName parent) -> False + _ -> True + , not $ ignoredTyThing thing + , let ss = ShowSub { ss_how_much = ShowSome (Just show_occ) (AltPpr Nothing) + , ss_forall = ShowForAllMust + } + , let extras = case thing of + ATyCon tycon + | Just cls <- tyConClass_maybe tycon + -> nest 2 (text "{-# MINIMAL" <+> ppr (classMinimalDef cls) <+> text "#-}") + _ -> empty + ] + + return $ withUserStyle name_ppr_ctx AllTheWay $ + hang mod_header 2 contents <> + text "" + where + mod_header = vcat + [ text "" + , text "module" <+> ppr modl_nm <+> text "where" + , text "" + ] + +reportInstances :: Ghc SDoc +reportInstances = do + hsc_env <- getSession + eps <- liftIO $ hscEPS hsc_env + let instances = eps_inst_env eps + return $ vcat $ + [ text "" + , text "" + , text "-- Instances:" + ] ++ + [ ppr inst + | inst <- sortBy compareInstances (instEnvElts instances) + , not $ ignoredInstance inst + ] + +compareInstances :: ClsInst -> ClsInst -> Ordering +compareInstances inst1 inst2 = mconcat + [ stableNameCmp (getName cls1) (getName cls2) + ] + where + (_, cls1, _tys1) = instanceHead inst1 + (_, cls2, _tys2) = instanceHead inst2 ===================================== utils/dump-decls/dump-decls.cabal ===================================== @@ -0,0 +1,13 @@ +cabal-version: 2.4 +name: dump-decls +version: 0.1.0.0 +synopsis: Dump the declarations of a package. +license: BSD-3-Clause +author: Ben Gamari +maintainer: ben at smart-cactus.org +copyright: (c) 2023 Ben Gamari + +executable dump-decls + main-is: Main.hs + build-depends: base, ghc + default-language: Haskell2010 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a72541cfd13a97537f5c212943f47f9d7f89ddca...04bd83f880c819c41aaccbad36e16d87cde557a9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a72541cfd13a97537f5c212943f47f9d7f89ddca...04bd83f880c819c41aaccbad36e16d87cde557a9 You're receiving 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 Jun 29 19:55:09 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 29 Jun 2023 15:55:09 -0400 Subject: [Git][ghc/ghc][wip/ipe-optimisation-9.4] 2 commits: Allow bootstrap testing jobs to fail Message-ID: <649de19d14b2f_2b2f6a1ea03ac668a@gitlab.mail> Ben Gamari pushed to branch wip/ipe-optimisation-9.4 at Glasgow Haskell Compiler / GHC Commits: bea9117a by Ben Gamari at 2023-06-29T15:25:39-04:00 Allow bootstrap testing jobs to fail The needed Docker images don't exist. - - - - - daba5dcf by Ben Gamari at 2023-06-29T15:54:58-04:00 configure: Fix missing CabalStaticLibZstd definition - - - - - 2 changed files: - .gitlab-ci.yml - m4/fp_find_libzstd.m4 Changes: ===================================== .gitlab-ci.yml ===================================== @@ -552,6 +552,7 @@ test-bootstrap: image: "$DOCKER_IMAGE" parallel: *bootstrap_matrix dependencies: null + allow-failure: true script: - mkdir test-bootstrap - tar -xf ghc-*[0-9]-src.tar.xz -C test-bootstrap ===================================== m4/fp_find_libzstd.m4 ===================================== @@ -116,5 +116,6 @@ AC_DEFUN([FP_FIND_LIBZSTD], else AC_SUBST([UseLibZstd],[NO]) AC_SUBST([CabalHaveLibZstd],[False]) + AC_SUBST([CabalStaticLibZstd],[False]) fi ]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/48daf5dd5e90e00f54ceb555f8b0fd8958aa38aa...daba5dcf8523be62ec1b3c62b8d81ff460c3e672 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/48daf5dd5e90e00f54ceb555f8b0fd8958aa38aa...daba5dcf8523be62ec1b3c62b8d81ff460c3e672 You're receiving 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 Jun 29 20:18:07 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 29 Jun 2023 16:18:07 -0400 Subject: [Git][ghc/ghc][wip/ipe-optimisation-9.4] 3 commits: configure: Fix missing CabalStaticLibZstd definition Message-ID: <649de6ff54dd_2b2f6a2304664695dd@gitlab.mail> Ben Gamari pushed to branch wip/ipe-optimisation-9.4 at Glasgow Haskell Compiler / GHC Commits: 220a9651 by Ben Gamari at 2023-06-29T16:17:49-04:00 configure: Fix missing CabalStaticLibZstd definition - - - - - 634b7650 by Ben Gamari at 2023-06-29T16:18:00-04:00 gitlab-ci: Allow linters to fail - - - - - 30ff7fc1 by Ben Gamari at 2023-06-29T16:18:00-04:00 Allow bootstrap testing jobs to fail The needed Docker images don't exist. - - - - - 2 changed files: - .gitlab-ci.yml - m4/fp_find_libzstd.m4 Changes: ===================================== .gitlab-ci.yml ===================================== @@ -93,6 +93,7 @@ workflow: .lint: stage: tool-lint + allow_failure: true tags: - lint rules: @@ -551,6 +552,7 @@ test-bootstrap: image: "$DOCKER_IMAGE" parallel: *bootstrap_matrix dependencies: null + allow_failure: true script: - mkdir test-bootstrap - tar -xf ghc-*[0-9]-src.tar.xz -C test-bootstrap ===================================== m4/fp_find_libzstd.m4 ===================================== @@ -116,5 +116,6 @@ AC_DEFUN([FP_FIND_LIBZSTD], else AC_SUBST([UseLibZstd],[NO]) AC_SUBST([CabalHaveLibZstd],[False]) + AC_SUBST([CabalStaticLibZstd],[False]) fi ]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/daba5dcf8523be62ec1b3c62b8d81ff460c3e672...30ff7fc135ea9da9f97b0b698ecbb66c0ad6b935 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/daba5dcf8523be62ec1b3c62b8d81ff460c3e672...30ff7fc135ea9da9f97b0b698ecbb66c0ad6b935 You're receiving 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 Jun 29 20:20:17 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Thu, 29 Jun 2023 16:20:17 -0400 Subject: [Git][ghc/ghc][wip/int-index/tycl-inst-deps] Draft: instances in dependency analysis Message-ID: <649de78161c05_2b2f6a230466469773@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/tycl-inst-deps at Glasgow Haskell Compiler / GHC Commits: 10315b70 by Vladislav Zavialov at 2023-06-29T23:19:21+03:00 Draft: instances in dependency analysis - - - - - 16 changed files: - compiler/GHC/Rename/Module.hs - + testsuite/tests/dependent/should_compile/T12088a.hs - + testsuite/tests/dependent/should_compile/T12088b.hs - + testsuite/tests/dependent/should_compile/T12088c.hs - + testsuite/tests/dependent/should_compile/T12239.hs - testsuite/tests/dependent/should_compile/all.T - testsuite/tests/deriving/should_compile/T17339.stderr - testsuite/tests/ghci/scripts/T4175.stdout - testsuite/tests/indexed-types/should_fail/OverDirectThisMod.stderr - testsuite/tests/indexed-types/should_fail/OverIndirectThisMod.stderr - testsuite/tests/parser/should_compile/DumpRenamedAst.stderr - testsuite/tests/partial-sigs/should_compile/TypeFamilyInstanceLHS.stderr - + testsuite/tests/perf/compiler/WWRec.stderr - testsuite/tests/plugins/test-defaulting-plugin.stderr - testsuite/tests/th/T17296.stderr - testsuite/tests/typecheck/should_fail/T6018fail.stderr Changes: ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -53,7 +53,7 @@ import GHC.Types.Name.Set import GHC.Types.Name.Env import GHC.Utils.Outputable import GHC.Data.Bag -import GHC.Types.Basic ( TypeOrKind(..) ) +import GHC.Types.Basic ( TypeOrKind(..), TyConFlavour(..) ) import GHC.Data.FastString import GHC.Types.SrcLoc as SrcLoc import GHC.Driver.DynFlags @@ -62,7 +62,8 @@ import GHC.Utils.Panic import GHC.Driver.Env ( HscEnv(..), hsc_home_unit) import GHC.Data.List.SetOps ( findDupsEq, removeDupsOn, equivClasses ) import GHC.Data.Graph.Directed ( SCC, flattenSCC, flattenSCCs, Node(..) - , stronglyConnCompFromEdgedVerticesUniq ) + , stronglyConnCompFromEdgedVerticesUniq + , stronglyConnCompFromEdgedVerticesOrd ) import GHC.Types.Unique.Set import GHC.Data.OrdList import qualified GHC.LanguageExtensions as LangExt @@ -71,8 +72,8 @@ import GHC.Core.DataCon ( isSrcStrict ) import Control.Monad import Control.Arrow ( first ) import Data.Foldable ( toList ) -import Data.List ( mapAccumL ) -import Data.List.NonEmpty ( NonEmpty(..), head ) +import Data.List ( mapAccumL, sortBy ) +import Data.List.NonEmpty ( NonEmpty(..), head, groupAllWith ) import Data.Maybe ( isNothing, fromMaybe, mapMaybe ) import qualified Data.Set as Set ( difference, fromList, toList, null ) import GHC.Types.GREInfo (ConInfo, mkConInfo, conInfoFields) @@ -1447,14 +1448,16 @@ rnTyClDecls tycl_ds all_groups = first_group ++ groups + new_groups = depAnalTyClDecls' rdr_env role_annots kisigs_w_fvs tycls_w_fvs instds_w_fvs + ; massertPpr (null final_inst_ds) (ppr instds_w_fvs $$ ppr inst_ds_map $$ ppr (flattenSCCs tycl_sccs) $$ ppr final_inst_ds) - ; traceRn "rnTycl dependency analysis made groups" (ppr all_groups) - ; return (all_groups, all_fvs) } + ; traceRn "rnTycl dependency analysis made groups" (ppr all_groups $$ text "new:" $$ ppr new_groups) + ; return (new_groups, all_fvs) } where mk_group :: RoleAnnotEnv -> KindSigEnv @@ -2705,3 +2708,213 @@ add_bind _ (XValBindsLR {}) = panic "GHC.Rename.Module.add_bind" add_sig :: LSig (GhcPass a) -> HsValBinds (GhcPass a) -> HsValBinds (GhcPass a) add_sig s (ValBinds x bs sigs) = ValBinds x bs (s:sigs) add_sig _ (XValBindsLR {}) = panic "GHC.Rename.Module.add_sig" + + +---------------------------------------------------- +depAnalTyClDecls' + :: GlobalRdrEnv + -> [LRoleAnnotDecl GhcRn] + -> [(LStandaloneKindSig GhcRn, FreeVars)] + -> [(LTyClDecl GhcRn, FreeVars)] + -> [(LInstDecl GhcRn, FreeVars)] + -> [TyClGroup GhcRn] +depAnalTyClDecls' rdr_env role_annots kisigs_w_fvs tycls_w_fvs instds_w_fvs = + concatMap (nestedDepAnalTyClDecls rdr_env) (stronglyConnCompFromEdgedVerticesOrd nodes) + where + kisig_fv_env :: NameEnv (LStandaloneKindSig GhcRn, FreeVars) + kisig_fv_env = mkNameEnvWith (standaloneKindSigName . unLoc . fst) kisigs_w_fvs + + role_annot_env :: RoleAnnotEnv + role_annot_env = mkRoleAnnotEnv role_annots + + insts :: [DepAnalInst] + insts = zipWith mk_inst [0..] instds_w_fvs + where + mk_inst i (inst, fvs) = + Inst { inst_index = i + , inst_name = name + , inst_inst = inst + , inst_fvs = fvs } + where name = get_inst_name inst + + decls :: [DepAnalDecl] + decls = map mk_decl tycls_w_fvs + where + mk_decl (decl, fvs) = + Decl { decl_name = name + , decl_roles = roles + , decl_kisig = kisig + , decl_decl = decl + , decl_fvs = fvs `plusFV` kisig_fvs + } + where name = get_decl_name decl + roles = lookupRoleAnnot role_annot_env name + (kisig, kisig_fvs) = lookupKiSigFVs kisig_fv_env name + + nodes :: [Node DepAnalKey DepAnalPayload] + nodes = + map (mk_decl_node get_deps) decls ++ + map (mk_inst_node get_deps) insts + + get_deps :: FreeVars -> [DepAnalKey] + get_deps = concatMap get_dep . mapMaybe (lookupGRE_Name rdr_env) . nonDetEltsUniqSet + + get_dep :: GlobalRdrElt -> [DepAnalKey] + get_dep GRE{gre_name = name, gre_info = info, gre_par = par} = + case info of + IAmTyCon OpenFamilyFlavour{} -> + case par of + NoParent -> DeclKey name : instances_of name + ParentIs p -> DeclKey p : instances_of p + _ -> + case par of + NoParent -> [DeclKey name] + ParentIs p -> [DeclKey p] + + instances_of :: Name -> [DepAnalKey] + instances_of name = + case lookupNameEnv inst_groups name of + Nothing -> [] + Just (k :| ks) -> k : ks + + inst_groups :: NameEnv (NonEmpty DepAnalKey) + inst_groups = (mkNameEnv . map mk_inst_group . groupAllWith inst_name) insts + where + mk_inst_group insts = (inst_name (head insts), fmap inst_key insts) + where inst_key inst = InstKey (inst_name inst) (inst_index inst) + +mk_decl_node :: (FreeVars -> [DepAnalKey]) -> DepAnalDecl -> Node DepAnalKey DepAnalPayload +mk_decl_node get_deps decl = DigraphNode payload key deps + where + payload = DeclPayload decl + key = DeclKey (decl_name decl) + deps = get_deps (decl_fvs decl) + +mk_inst_node :: (FreeVars -> [DepAnalKey]) -> DepAnalInst -> Node DepAnalKey DepAnalPayload +mk_inst_node get_deps inst = DigraphNode payload key deps + where + payload = InstPayload inst + key = InstKey (inst_name inst) (inst_index inst) + deps = get_deps (inst_fvs inst) + +{- Note [Nested dependency analysis] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The first pass of dependency analysis overapproximates the amount of dependencies, +producing SCCs that are too big. Now we break them into smaller subgroups. + +TODO (int-index): explain why this happens. +-} + + +-- See [Nested dependency analysis] +nestedDepAnalTyClDecls :: GlobalRdrEnv -> SCC DepAnalPayload -> [TyClGroup GhcRn] +nestedDepAnalTyClDecls rdr_env = concatMap get_dep_anal_payload . merge_inst_groups . nested_dep_anal rdr_env + +-- Just so that sort-by-location would see the instances grouped together +merge_inst_groups :: [[DepAnalPayload]] -> [[DepAnalPayload]] +merge_inst_groups [] = [] +merge_inst_groups (g : gs) = go g gs + where + go :: [DepAnalPayload] -> [[DepAnalPayload]] -> [[DepAnalPayload]] + go acc (g' : gs') | all is_inst_payload g' = go (g' ++ acc) gs' + go acc gs' = acc : merge_inst_groups gs' + + is_inst_payload (InstPayload _) = True + is_inst_payload (DeclPayload _) = False + +nested_dep_anal :: GlobalRdrEnv -> SCC DepAnalPayload -> [[DepAnalPayload]] +nested_dep_anal rdr_env payload = map flattenSCC (stronglyConnCompFromEdgedVerticesOrd nodes) + where + nodes :: [Node DepAnalKey DepAnalPayload] + nodes = do + p <- flattenSCC payload + case p of + DeclPayload decl -> [mk_decl_node get_deps decl] + InstPayload inst -> [mk_inst_node get_deps inst] + + get_deps :: FreeVars -> [DepAnalKey] + get_deps = concatMap get_dep . mapMaybe (lookupGRE_Name rdr_env) . nonDetEltsUniqSet + + get_dep :: GlobalRdrElt -> [DepAnalKey] + get_dep GRE{gre_name = name, gre_par = par} = + case par of + NoParent -> [DeclKey name] + ParentIs p -> [DeclKey p] + +get_dep_anal_payload :: [DepAnalPayload] -> [TyClGroup GhcRn] +get_dep_anal_payload ps = + let + group = foldr add_payload empty_group ps + insts = [ empty_group { group_instds = [inst] } + | inst <- sortBy cmpBufSpanA (group_instds group) ] + in + group { group_instds = [] } `cons` insts + where + empty_group = TyClGroup noExtField [] [] [] [] + cons (TyClGroup _ [] [] [] []) gs = gs + cons g gs = g : gs + +lookupKiSigFVs :: NameEnv (LStandaloneKindSig GhcRn, FreeVars) -> Name -> (Maybe (LStandaloneKindSig GhcRn), FreeVars) +lookupKiSigFVs env name = + case lookupNameEnv env name of + Nothing -> (Nothing, emptyFVs) + Just (kisig, fvs) -> (Just kisig, fvs) + +data DepAnalInst = + Inst { inst_index :: Int + , inst_name :: Name + , inst_inst :: LInstDecl GhcRn + , inst_fvs :: FreeVars } + +data DepAnalDecl = + Decl { decl_name :: Name + , decl_roles :: Maybe (LRoleAnnotDecl GhcRn) + , decl_kisig :: Maybe (LStandaloneKindSig GhcRn) + , decl_decl :: LTyClDecl GhcRn + , decl_fvs :: FreeVars } + +data DepAnalKey = + InstKey Name Int + | DeclKey Name + deriving (Eq, Ord) + +data DepAnalPayload = -- TyClGroupBuilder (TyClGroup GhcRn -> TyClGroup GhcRn) + InstPayload DepAnalInst + | DeclPayload DepAnalDecl + + +add_payload :: DepAnalPayload -> TyClGroup GhcRn -> TyClGroup GhcRn +add_payload (DeclPayload decl) g = + TyClGroup { group_ext = group_ext g + , group_tyclds = decl_decl decl : group_tyclds g + , group_kisigs = maybe id (:) (decl_kisig decl) (group_kisigs g) + , group_roles = maybe id (:) (decl_roles decl) (group_roles g) + , group_instds = group_instds g } +add_payload (InstPayload inst) g = + TyClGroup { group_ext = group_ext g + , group_tyclds = group_tyclds g + , group_kisigs = group_kisigs g + , group_roles = group_roles g + , group_instds = inst_inst inst : group_instds g } + +cmpBufSpanA :: GenLocated (SrcSpanAnn' a1) a2 -> GenLocated (SrcSpanAnn' a3) a2 -> Ordering +cmpBufSpanA (L la a) (L lb b) = cmpBufSpan (L (locA la) a) (L (locA lb) b) + +get_decl_name :: LTyClDecl GhcRn -> Name +get_decl_name = tcdName . unLoc + +get_inst_name :: LInstDecl GhcRn -> Name +get_inst_name (L _ inst) = + unLoc $ case inst of + ClsInstD { cid_inst = inst } -> + go ((unLoc . sig_body . unLoc . cid_poly_ty) inst) + where + go (HsTyVar _ _ name) = name + go (HsOpTy _ _ _ name _) = name + go HsQualTy{hst_body = L _ ty} = go ty + go (HsAppTy _ (L _ ty) _) = go ty + go (HsAppKindTy _ (L _ ty) _ _) = go ty + go (HsParTy _ (L _ ty)) = go ty + go _ = panic "get_inst_name: unsupported class instance head" + DataFamInstD { dfid_inst = inst } -> (feqn_tycon . dfid_eqn) inst + TyFamInstD { tfid_inst = inst } -> (feqn_tycon . tfid_eqn) inst ===================================== testsuite/tests/dependent/should_compile/T12088a.hs ===================================== @@ -0,0 +1,17 @@ +{-# LANGUAGE DataKinds, TypeFamilies, UndecidableInstances #-} + +module T12088a where + +import Data.Kind +import GHC.TypeLits + +type family Open a +type instance Open Bool = Nat +type instance Open Float = Type +type instance Open Char = F Float + +type F :: forall a -> Open a +type family F a +type instance F Bool = 42 +type instance F Float = [Nat] +type instance F Char = '[0, 1] ===================================== testsuite/tests/dependent/should_compile/T12088b.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE DataKinds, TypeFamilies #-} + +module T12088b where + +import Data.Kind + +type family IxKind (m :: Type) :: Type +type family Value (m :: Type) :: IxKind m -> Type +data T (k :: Type) (f :: k -> Type) = MkT + +type instance IxKind (T k f) = k +type instance Value (T k f) = f \ No newline at end of file ===================================== testsuite/tests/dependent/should_compile/T12088c.hs ===================================== @@ -0,0 +1,19 @@ +{-# LANGUAGE DataKinds, TypeFamilies #-} + +module T12088c where + +import Data.Kind + +type family K a + +class C a where -- C:def + type F a :: K a -- F:sig + type G a :: K a -- G:sig + +data T + +type instance K T = Type + +instance C T where -- C:inst + type F T = Bool -- F:def + type G T = String -- G:def \ No newline at end of file ===================================== testsuite/tests/dependent/should_compile/T12239.hs ===================================== @@ -0,0 +1,23 @@ +{-# LANGUAGE PolyKinds, DataKinds, GADTs, TypeFamilies #-} + +module T12239 where + +import Data.Kind (Type) + +data N = Z | S N + +data Fin :: N -> Type where + FZ :: Fin (S n) + FS :: Fin n -> Fin (S n) + +type family FieldCount (t :: Type) :: N + +type family FieldType (t :: Type) (i :: Fin (FieldCount t)) :: Type + +data T + +type instance FieldCount T = S (S (S Z)) + +type instance FieldType T FZ = Int +type instance FieldType T (FS FZ) = Bool +type instance FieldType T (FS (FS FZ)) = String ===================================== testsuite/tests/dependent/should_compile/all.T ===================================== @@ -63,3 +63,7 @@ test('T16347', normal, compile, ['']) test('T18660', normal, compile, ['']) test('T12174', normal, compile, ['']) test('LopezJuan', normal, compile, ['']) +test('T12239', normal, compile, ['']) +test('T12088a', normal, compile, ['']) +test('T12088b', normal, compile, ['']) +test('T12088c', normal, compile, ['']) \ No newline at end of file ===================================== testsuite/tests/deriving/should_compile/T17339.stderr ===================================== @@ -3,14 +3,14 @@ Result size of Tidy Core = {terms: 8, types: 20, coercions: 0, joins: 0/0} --- RHS size: {terms: 1, types: 2, coercions: 0, joins: 0/0} -T17339.$fClsA1B1 :: Cls A1 B1 -T17339.$fClsA1B1 = T17339.C:Cls @A1 @B1 - -- RHS size: {terms: 1, types: 2, coercions: 0, joins: 0/0} T17339.$fClsA2B1 :: Cls A2 B1 T17339.$fClsA2B1 = T17339.C:Cls @A2 @B1 +-- RHS size: {terms: 1, types: 2, coercions: 0, joins: 0/0} +T17339.$fClsA1B1 :: Cls A1 B1 +T17339.$fClsA1B1 = T17339.C:Cls @A1 @B1 + -- RHS size: {terms: 1, types: 2, coercions: 0, joins: 0/0} T17339.$fClsA1B2 :: Cls A1 B2 T17339.$fClsA1B2 = T17339.C:Cls @A1 @B2 ===================================== testsuite/tests/ghci/scripts/T4175.stdout ===================================== @@ -2,8 +2,8 @@ type A :: * -> * -> * type family A a b -- Defined at T4175.hs:8:1 type instance A (B a) b = () -- Defined at T4175.hs:11:15 -type instance A Int Int = () -- Defined at T4175.hs:9:15 type instance A (Maybe a) a = a -- Defined at T4175.hs:10:15 +type instance A Int Int = () -- Defined at T4175.hs:9:15 type B :: * -> * data family B a -- Defined at T4175.hs:13:1 ===================================== testsuite/tests/indexed-types/should_fail/OverDirectThisMod.stderr ===================================== @@ -1,10 +1,10 @@ OverDirectThisModC.hs:1:1: error: [GHC-34447] Conflicting family instance declarations: - D [Int] [a] = Int -- Defined in module OverDirectThisModB - D [a] [Int] = Char -- Defined at OverDirectThisModC.hs:12:15 + C [Int] [a] -- Defined in module OverDirectThisModB + C [a] [Int] -- Defined at OverDirectThisModC.hs:10:15 OverDirectThisModC.hs:1:1: error: [GHC-34447] Conflicting family instance declarations: - C [Int] [a] -- Defined in module OverDirectThisModB - C [a] [Int] -- Defined at OverDirectThisModC.hs:10:15 + D [Int] [a] = Int -- Defined in module OverDirectThisModB + D [a] [Int] = Char -- Defined at OverDirectThisModC.hs:12:15 ===================================== testsuite/tests/indexed-types/should_fail/OverIndirectThisMod.stderr ===================================== @@ -1,10 +1,10 @@ OverIndirectThisModD.hs:1:1: error: [GHC-34447] Conflicting family instance declarations: - D [Int] [a] = Int -- Defined in module OverIndirectThisModB - D [a] [Int] = Char -- Defined at OverIndirectThisModD.hs:13:15 + C [Int] [a] -- Defined in module OverIndirectThisModB + C [a] [Int] -- Defined at OverIndirectThisModD.hs:11:15 OverIndirectThisModD.hs:1:1: error: [GHC-34447] Conflicting family instance declarations: - C [Int] [a] -- Defined in module OverIndirectThisModB - C [a] [Int] -- Defined at OverIndirectThisModD.hs:11:15 + D [Int] [a] = Int -- Defined in module OverIndirectThisModB + D [a] [Int] = Char -- Defined at OverIndirectThisModD.hs:13:15 ===================================== testsuite/tests/parser/should_compile/DumpRenamedAst.stderr ===================================== @@ -437,6 +437,12 @@ (Nothing))))] [] [] + []) + ,(TyClGroup + (NoExtField) + [] + [] + [] [(L (SrcSpanAnn (EpAnn (Anchor @@ -1135,6 +1141,12 @@ []))] [] [] + []) + ,(TyClGroup + (NoExtField) + [] + [] + [] [(L (SrcSpanAnn (EpAnn (Anchor ===================================== testsuite/tests/partial-sigs/should_compile/TypeFamilyInstanceLHS.stderr ===================================== @@ -12,4 +12,4 @@ FAMILY INSTANCES type instance F Bool _ = Bool -- Defined at TypeFamilyInstanceLHS.hs:8:15 Dependent modules: [] -Dependent packages: [base-4.16.0.0] +Dependent packages: [base-4.18.0.0] ===================================== testsuite/tests/perf/compiler/WWRec.stderr ===================================== @@ -0,0 +1,14 @@ + +WWRec.hs:72:10: warning: [GHC-62412] [-Wsimplifiable-class-constraints (in -Wdefault)] + • The constraint ‘Rule f A30’ matches + instance Rule f A1 => Rule f A30 -- Defined at WWRec.hs:73:10 + This makes type inference for inner bindings fragile; + either use MonoLocalBinds, or simplify it using the instance + • In the instance declaration for ‘Rule f A29’ + +WWRec.hs:73:10: warning: [GHC-62412] [-Wsimplifiable-class-constraints (in -Wdefault)] + • The constraint ‘Rule f A1’ matches + instance Rule f A2 => Rule f A1 -- Defined at WWRec.hs:44:10 + This makes type inference for inner bindings fragile; + either use MonoLocalBinds, or simplify it using the instance + • In the instance declaration for ‘Rule f A30’ ===================================== testsuite/tests/plugins/test-defaulting-plugin.stderr ===================================== @@ -1,13 +1,13 @@ test-defaulting-plugin.hs:28:11: warning: [GHC-18042] [-Wtype-defaults (in -Wall)] - • Defaulting the type variable ‘a0’ to type ‘0’ in the following constraint + • Defaulting the type variable ‘a0’ to type ‘4’ in the following constraint KnownNat a0 arising from a use of ‘q’ • In the first argument of ‘(+)’, namely ‘q’ In the second argument of ‘($)’, namely ‘q + w’ In a stmt of a 'do' block: print $ q + w test-defaulting-plugin.hs:28:15: warning: [GHC-18042] [-Wtype-defaults (in -Wall)] - • Defaulting the type variable ‘a0’ to type ‘2’ in the following constraints + • Defaulting the type variable ‘a0’ to type ‘4’ in the following constraints (KnownNat a0) arising from a use of ‘w’ at test-defaulting-plugin.hs:28:15 (GHC.TypeError.Assert @@ -19,7 +19,7 @@ test-defaulting-plugin.hs:28:15: warning: [GHC-18042] [-Wtype-defaults (in -Wall In a stmt of a 'do' block: print $ q + w test-defaulting-plugin.hs:29:11: warning: [GHC-18042] [-Wtype-defaults (in -Wall)] - • Defaulting the type variable ‘b0’ to type ‘0’ in the following constraint + • Defaulting the type variable ‘b0’ to type ‘4’ in the following constraint KnownNat b0 arising from a use of ‘mc’ • In the second argument of ‘($)’, namely ‘mc Proxy Proxy’ In a stmt of a 'do' block: print $ mc Proxy Proxy @@ -28,7 +28,7 @@ test-defaulting-plugin.hs:29:11: warning: [GHC-18042] [-Wtype-defaults (in -Wall print $ mc Proxy Proxy test-defaulting-plugin.hs:29:11: warning: [GHC-18042] [-Wtype-defaults (in -Wall)] - • Defaulting the type variable ‘a0’ to type ‘0’ in the following constraint + • Defaulting the type variable ‘a0’ to type ‘4’ in the following constraint KnownNat a0 arising from a use of ‘mc’ • In the second argument of ‘($)’, namely ‘mc Proxy Proxy’ In a stmt of a 'do' block: print $ mc Proxy Proxy ===================================== testsuite/tests/th/T17296.stderr ===================================== @@ -3,17 +3,17 @@ data instance forall (a_0 :: *). T17296.Foo1 (GHC.Maybe.Maybe a_0) data instance T17296.Foo1 GHC.Types.Bool = T17296.Foo1Bool data family T17296.Foo2 :: k_0 -> * +data instance T17296.Foo2 :: GHC.Types.Char -> * data instance T17296.Foo2 :: (GHC.Types.Char -> GHC.Types.Char) -> * -data instance T17296.Foo2 :: GHC.Types.Char -> * data instance forall (a_1 :: *). T17296.Foo2 (GHC.Maybe.Maybe a_1 :: *) data instance T17296.Foo2 GHC.Types.Bool = T17296.Foo2Bool data family T17296.Foo3 :: k_0 -data instance T17296.Foo3 :: GHC.Types.Char -> * data instance T17296.Foo3 :: (GHC.Types.Char -> GHC.Types.Char) -> * -data instance forall (a_1 :: *). T17296.Foo3 (GHC.Maybe.Maybe a_1 :: *) +data instance T17296.Foo3 :: GHC.Types.Char -> * data instance T17296.Foo3 GHC.Types.Bool = T17296.Foo3Bool +data instance forall (a_1 :: *). T17296.Foo3 (GHC.Maybe.Maybe a_1 :: *) data instance T17296.Foo3 :: * ===================================== testsuite/tests/typecheck/should_fail/T6018fail.stderr ===================================== @@ -4,11 +4,11 @@ [4 of 5] Compiling T6018Dfail ( T6018Dfail.hs, T6018Dfail.o ) [5 of 5] Compiling T6018fail ( T6018fail.hs, T6018fail.o ) -T6018fail.hs:15:15: error: [GHC-05175] +T6018fail.hs:14:15: error: [GHC-05175] Type family equation right-hand sides overlap; this violates the family's injectivity annotation: - F Bool Int Char = Int -- Defined at T6018fail.hs:15:15 F Char Bool Int = Int -- Defined at T6018fail.hs:14:15 + F Bool Int Char = Int -- Defined at T6018fail.hs:15:15 T6018fail.hs:21:15: error: [GHC-05175] Type family equation right-hand sides overlap; this violates View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/10315b700cc2b0ad788769db8fe4b87a705af2b4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/10315b700cc2b0ad788769db8fe4b87a705af2b4 You're receiving 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 Jun 29 20:30:26 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 29 Jun 2023 16:30:26 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23579 Message-ID: <649de9e2cdb69_2b2f6a23502f8777dc@gitlab.mail> Ben Gamari pushed new branch wip/T23579 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23579 You're receiving 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 Jun 29 20:39:44 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 29 Jun 2023 16:39:44 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/testsuite-docs Message-ID: <649dec1064f61_2b2f6a1e9c298797d7@gitlab.mail> Ben Gamari pushed new branch wip/testsuite-docs at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/testsuite-docs You're receiving 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 Jun 29 21:32:25 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 29 Jun 2023 17:32:25 -0400 Subject: [Git][ghc/ghc][wip/drop-touch] 1183 commits: Introduce CapIOManager as the per-cap I/O mangager state Message-ID: <649df86932c0f_238a8ec957c2331f@gitlab.mail> Ben Gamari pushed to branch wip/drop-touch at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 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 - - - - - 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. - - - - - 08c0822c by doyougnu at 2023-02-15T00:16:39-05:00 docs: release notes, user guide: add js backend Follow up from #21078 - - - - - 79d8fd65 by Bryan Richter at 2023-02-15T00:17:15-05:00 Allow failure in nightly-x86_64-linux-deb10-no_tntc-validate See #22343 - - - - - 9ca51f9e by Cheng Shao at 2023-02-15T00:17:53-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. - - - - - 26df73fb by Oleg Grenrus at 2023-02-15T22:20:57-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 - - - - - 631c6c72 by Cheng Shao at 2023-02-16T06:43:09-05:00 docs: add a section for the wasm backend Fixes #22658 - - - - - 1878e0bd by Bryan Richter at 2023-02-16T06:43:47-05:00 tests: Mark T12903 fragile everywhere See #21184 - - - - - b9420eac by Bryan Richter at 2023-02-16T06:43:47-05:00 Mark all T5435 variants as fragile See #22970. - - - - - df3d94bd by Sylvain Henry at 2023-02-16T06:44:33-05:00 Testsuite: mark T13167 as fragile for JS (#22921) - - - - - 324e925b by Sylvain Henry at 2023-02-16T06:45:15-05:00 JS: disable debugging info for heap objects - - - - - 518af814 by Josh Meredith at 2023-02-16T10:16:32-05:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 34cd308e by Ben Gamari at 2023-02-16T10:17:08-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 12965aba by Simon Peyton Jones at 2023-02-16T10:17:46-05: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 - - - - - 5b038888 by Bodigrim at 2023-02-16T10:18:24-05:00 Documentation: add an example of SPEC usage - - - - - 681e0e8c by sheaf at 2023-02-16T14:09:56-05:00 No default finalizer exception handler Commit cfc8e2e2 introduced a mechanism for handling of exceptions that occur during Handle finalization, and 372cf730 set the default handler to print out the error to stderr. However, #21680 pointed out we might not want to set this by default, as it might pollute users' terminals with unwanted information. So, for the time being, the default handler discards the exception. Fixes #21680 - - - - - b3ac17ad by Matthew Pickering at 2023-02-16T14:10:31-05: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 ------------------------- - - - - - 8988eeef by sheaf at 2023-02-16T20:32:27-05:00 Expand synonyms in RoughMap We were failing to expand type synonyms in the function GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the RoughMap infrastructure crucially relies on type synonym expansion to work. This patch adds the missing type-synonym expansion. Fixes #22985 - - - - - 3dd50e2f by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Add test artifact Add the released testsuite tarball to the generated ghcup metadata. - - - - - c6a967d9 by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Use Ubuntu and Rocky bindists Prefer to use the Ubuntu 20.04 and 18.04 binary distributions on Ubuntu and Linux Mint. Prefer to use the Rocky 8 binary distribution on unknown distributions. - - - - - be0b7209 by Matthew Pickering at 2023-02-17T09:37:16+00:00 Add INLINABLE pragmas to `generic*` functions in Data.OldList These functions are * recursive * overloaded So it's important to add an `INLINABLE` pragma to each so that they can be specialised at the use site when the specific numeric type is known. Adding these pragmas improves the LazyText replicate benchmark (see https://gitlab.haskell.org/ghc/ghc/-/issues/22886#note_481020) https://github.com/haskell/core-libraries-committee/issues/129 - - - - - a203ad85 by Sylvain Henry at 2023-02-17T15:59:16-05:00 Merge libiserv with ghci `libiserv` serves no purpose. As it depends on `ghci` and doesn't have more dependencies than the `ghci` package, its code could live in the `ghci` package too. This commit also moves most of the code from the `iserv` program into the `ghci` package as well so that it can be reused. This is especially useful for the implementation of TH for the JS backend (#22261, !9779). - - - - - 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01: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 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-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. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-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. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-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. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 7192ef91 by Simon Peyton Jones at 2023-02-28T18:54:59-05:00 Take more care with unlifted bindings in the specialiser As #22998 showed, we were floating an unlifted binding to top level, which breaks a Core invariant. The fix is easy, albeit a little bit conservative. See Note [Care with unlifted bindings] in GHC.Core.Opt.Specialise - - - - - bb500e2a by Simon Peyton Jones at 2023-02-28T18:55:35-05:00 Account for TYPE vs CONSTRAINT in mkSelCo As #23018 showed, in mkRuntimeRepCo we need to account for coercions between TYPE and COERCION. See Note [mkRuntimeRepCo] in GHC.Core.Coercion. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-05:00 hadrian: Add dependency from lib/settings to mk/config.mk In 81975ef375de07a0ea5a69596b2077d7f5959182 we attempted to fix #20253 by adding logic to the bindist Makefile to regenerate the `settings` file from information gleaned by the bindist `configure` script. However, this fix had no effect as `lib/settings` is shipped in the binary distribution (to allow in-place use of the binary distribution). As `lib/settings` already existed and its rule declared no dependencies, `make` would fail to use the added rule to regenerate it. Fix this by explicitly declaring a dependency from `lib/settings` on `mk/config.mk`. Fixes #22982. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-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. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-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. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00: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. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 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: ...lots of lines omitted... 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. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04: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. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04: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> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+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. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 6489a5e1 by Ben Gamari at 2023-06-29T17:32:10-04:00 Drop dependence on `touch` This drops GHC's dependence on the `touch` program, instead implementing it within GHC. This eliminates an external dependency and means that we have one fewer program to keep track of in the `configure` script - - - - - 11 changed files: - .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/3a56337be36496ae4c11eb9afff092ebc0283256...6489a5e1297026be5fd139f2503a260fbb5c9d51 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3a56337be36496ae4c11eb9afff092ebc0283256...6489a5e1297026be5fd139f2503a260fbb5c9d51 You're receiving 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 Jun 29 21:33:20 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Thu, 29 Jun 2023 17:33:20 -0400 Subject: [Git][ghc/ghc][wip/simplifier-tweaks] Two improvements to coercion optimisation Message-ID: <649df8a0c0196_238a8ec957c235a6@gitlab.mail> Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC Commits: 74d7ab44 by Simon Peyton Jones at 2023-06-29T22:31:52+01:00 Two improvements to coercion optimisation One (mkSymCo) makes a big difference in GHC.Read The other (in zapSubstEnv) makes a big diffference in T18223 - - - - - 3 changed files: - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Utils.hs Changes: ===================================== compiler/GHC/Core/Coercion.hs ===================================== @@ -1126,12 +1126,17 @@ mkUnivCo prov role ty1 ty2 -- a kind of @t1 ~ t2@ becomes the kind @t2 ~ t1 at . mkSymCo :: Coercion -> Coercion --- Do a few simple optimizations, but don't bother pushing occurrences --- of symmetry to the leaves; the optimizer will take care of that. -mkSymCo co | isReflCo co = co -mkSymCo (SymCo co) = co -mkSymCo (SubCo (SymCo co)) = SubCo co -mkSymCo co = SymCo co +-- Do a few simple optimizations, mainly to expose the underlying +-- constructors to other 'mk' functions. E.g. +-- mkInstCo (mkSymCo (ForAllCo ...)) ty +-- We want to push the SymCo inside the ForallCo, so that we can instantiate +-- This can make a big difference. E.g without coercion optimisation, GHC.Read +-- totally explodes; but when we push Sym inside ForAll, it's fine. +mkSymCo co | isReflCo co = co +mkSymCo (SymCo co) = co +mkSymCo (SubCo (SymCo co)) = SubCo co +mkSymCo (ForAllCo tcv kco co) = ForAllCo tcv (mkSymCo kco) (mkSymCo co) +mkSymCo co = SymCo co -- | Create a new 'Coercion' by composing the two given 'Coercion's transitively. -- (co1 ; co2) ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -74,6 +74,7 @@ import GHC.Core.Type hiding ( substTy, substTyVar, substTyVarBndr, substCo , extendTvSubst, extendCvSubst ) import qualified GHC.Core.Coercion as Coercion import GHC.Core.Coercion hiding ( substCo, substCoVar, substCoVarBndr ) +import GHC.Core.Coercion.Opt( OptCoercionOpts(..) ) import GHC.Platform ( Platform ) import GHC.Types.Basic import GHC.Utils.Monad @@ -616,7 +617,11 @@ setInScopeFromE. --------------------- zapSubstEnv :: SimplEnv -> SimplEnv -zapSubstEnv env = env {seTvSubst = emptyVarEnv, seCvSubst = emptyVarEnv, seIdSubst = emptyVarEnv} +zapSubstEnv env@(SimplEnv { seMode = mode }) + = env { seTvSubst = emptyVarEnv, seCvSubst = emptyVarEnv, seIdSubst = emptyVarEnv + , seMode = mode { sm_co_opt_opts = OptCoercionOpts False } } + -- Zapping coercion optimisation here saves a /lot/ in T18223; + -- reduces compiled time allocation by more than 50% setSubstEnv :: SimplEnv -> TvSubstEnv -> CvSubstEnv -> SimplIdSubst -> SimplEnv setSubstEnv env tvs cvs ids = env { seTvSubst = tvs, seCvSubst = cvs, seIdSubst = ids } ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -263,41 +263,29 @@ mkPiMCo v (MCo co) = MCo (mkPiCo Representational v co) -- | Wrap the given expression in the coercion safely, dropping -- identity coercions and coalescing nested coercions mkCast :: HasDebugCallStack => CoreExpr -> CoercionR -> CoreExpr -mkCast e co - | assertPpr (coercionRole co == Representational) - (text "coercion" <+> ppr co <+> text "passed to mkCast" - <+> ppr e <+> text "has wrong role" <+> ppr (coercionRole co)) $ - isReflCo co - = e - -mkCast (Coercion e_co) co - | isCoVarType (coercionRKind co) - -- The guard here checks that g has a (~#) on both sides, - -- otherwise decomposeCo fails. Can in principle happen - -- with unsafeCoerce - = Coercion (mkCoCast e_co co) - -mkCast (Cast expr co2) co - = warnPprTrace (let { from_ty = coercionLKind co; - to_ty2 = coercionRKind co2 } in - not (from_ty `eqType` to_ty2)) - "mkCast" - (vcat ([ text "expr:" <+> ppr expr - , text "co2:" <+> ppr co2 - , text "co:" <+> ppr co ])) $ - mkCast expr (mkTransCo co2 co) - -mkCast (Tick t expr) co - = Tick t (mkCast expr co) mkCast expr co - = let from_ty = coercionLKind co in - warnPprTrace (not (from_ty `eqType` exprType expr)) + = {- assertPpr (coercionRole co == Representational) + (text "coercion" <+> ppr co <+> text "passed to mkCast" + <+> ppr expr <+> text "has wrong role" <+> ppr (coercionRole co)) $ + warnPprTrace (not (coercionLKind co `eqType` exprType expr)) "Trying to coerce" (text "(" <> ppr expr $$ text "::" <+> ppr (exprType expr) <> text ")" $$ ppr co $$ ppr (coercionType co) $$ callStackDoc) $ - (Cast expr co) + -} + case expr of + Cast expr co2 -> mkCast expr (mkTransCo co2 co) + Tick t expr -> Tick t (mkCast expr co) + + Coercion e_co | isCoVarType (coercionRKind co) + -- The guard here checks that g has a (~#) on both sides, + -- otherwise decomposeCo fails. Can in principle happen + -- with unsafeCoerce + -> Coercion (mkCoCast e_co co) + + _ | isReflCo co -> expr + | otherwise -> Cast expr co {- ********************************************************************* View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/74d7ab44eb2803994c5ec7cbffaf095805b4d031 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/74d7ab44eb2803994c5ec7cbffaf095805b4d031 You're receiving 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 Jun 29 21:56:05 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Thu, 29 Jun 2023 17:56:05 -0400 Subject: [Git][ghc/ghc][wip/int-index/tycl-inst-deps] 19 commits: Configure CPP into settings Message-ID: <649dfdf59d12a_238a8ec955434819@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/tycl-inst-deps at Glasgow Haskell Compiler / GHC Commits: 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 188c5050 by Vladislav Zavialov at 2023-06-30T00:55:01+03:00 Draft: instances in dependency analysis - - - - - 30 changed files: - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.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 - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Linker/Linker.hs - compiler/GHC/SysTools.hs - compiler/GHC/SysTools/Cpp.hs - − compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/ghc.cabal.in The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/10315b700cc2b0ad788769db8fe4b87a705af2b4...188c505027357133036e336ebdf0dbc6166547ff -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/10315b700cc2b0ad788769db8fe4b87a705af2b4...188c505027357133036e336ebdf0dbc6166547ff You're receiving 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 Jun 29 22:46:29 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 29 Jun 2023 18:46:29 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Define FFI_GO_CLOSURES Message-ID: <649e09c5936ba_238a8ec961c4207d@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 8 changed files: - compiler/GHC/Driver/CodeOutput.hs - libraries/base/include/HsBase.h - libraries/ghci/GHCi/FFI.hsc - rts/Interpreter.c - rts/adjustor/LibffiAdjustor.c - + rts/include/rts/ghc_ffi.h - rts/rts.cabal.in - rts/sm/Storage.c Changes: ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -295,7 +295,7 @@ outputForeignStubs logger tmpfs dflags unit_state mod location stubs -- wrapper code mentions the ffi_arg type, which comes from ffi.h ffi_includes - | platformMisc_libFFI $ platformMisc dflags = "#include \n" + | platformMisc_libFFI $ platformMisc dflags = "#include \"rts/ghc_ffi.h\"\n" | otherwise = "" stub_h_file_exists ===================================== libraries/base/include/HsBase.h ===================================== @@ -540,7 +540,7 @@ INLINE int __hscore_open(char *file, int how, mode_t mode) { } #endif -#if darwin_HOST_OS +#if defined(darwin_HOST_OS) // You should not access _environ directly on Darwin in a bundle/shared library. // See #2458 and http://developer.apple.com/library/mac/#documentation/Darwin/Reference/ManPages/man7/environ.7.html #include ===================================== libraries/ghci/GHCi/FFI.hsc ===================================== @@ -22,6 +22,14 @@ -} #if !defined(javascript_HOST_ARCH) +-- See Note [FFI_GO_CLOSURES workaround] in ghc_ffi.h +-- We can't include ghc_ffi.h here as we must build with stage0 +#if defined(darwin_HOST_OS) +#if !defined(FFI_GO_CLOSURES) +#define FFI_GO_CLOSURES 0 +#endif +#endif + #include #endif ===================================== rts/Interpreter.c ===================================== @@ -39,7 +39,7 @@ #endif #endif -#include "ffi.h" +#include "rts/ghc_ffi.h" /* -------------------------------------------------------------------------- * The bytecode interpreter ===================================== rts/adjustor/LibffiAdjustor.c ===================================== @@ -11,7 +11,7 @@ #include "Hash.h" #include "Adjustor.h" -#include "ffi.h" +#include "rts/ghc_ffi.h" #include // Note that ffi_alloc_prep_closure is a non-standard libffi closure ===================================== rts/include/rts/ghc_ffi.h ===================================== @@ -0,0 +1,28 @@ +/* + * wrapper working around #23586. + * + * (c) The University of Glasgow 2023 + * + */ + +#pragma once + +/* + * Note [FFI_GO_CLOSURES workaround] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * Apple ships a broken libffi with Xcode which lacks a definition of + * FFI_GO_CLOSURES despite having references to said macro. Work around this + * for now to avoid -Wundef warnings. + * + * We choose the value zero here by following the model of OpenJDK. + * See https://github.com/openjdk/jdk17u-dev/pull/741/files. + * + * See #23568. + */ +#if defined(darwin_HOST_OS) +#if !defined(FFI_GO_CLOSURES) +#define FFI_GO_CLOSURES 0 +#endif +#endif + +#include "ffi.h" ===================================== rts/rts.cabal.in ===================================== @@ -237,6 +237,7 @@ library rts/EventLogConstants.h rts/EventTypes.h -- ^ generated + rts/ghc_ffi.h rts/Adjustor.h rts/ExecPage.h rts/BlockSignals.h ===================================== rts/sm/Storage.c ===================================== @@ -53,7 +53,7 @@ #include -#include "ffi.h" +#include "rts/ghc_ffi.h" /* * All these globals require sm_mutex to access in THREADED_RTS mode. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b1e611d5d7e214cf9286e95936f41566f1235c7f...d7ef1704aeba451bd3e0efbdaaab2638ee1f0bc8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b1e611d5d7e214cf9286e95936f41566f1235c7f...d7ef1704aeba451bd3e0efbdaaab2638ee1f0bc8 You're receiving 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 Jun 29 22:47:08 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 29 Jun 2023 18:47:08 -0400 Subject: [Git][ghc/ghc][master] 3 commits: rts/Trace: Ensure that debugTrace arguments are used Message-ID: <649e09ec44370_238a8e1f78608455c1@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - 8 changed files: - hadrian/src/Flavour.hs - rts/Schedule.c - rts/Sparks.c - rts/Trace.h - rts/TraverseHeap.c - rts/sm/GC.c - rts/sm/NonMoving.c - rts/sm/NonMovingMark.c Changes: ===================================== hadrian/src/Flavour.hs ===================================== @@ -128,9 +128,13 @@ werror = ? notStage0 ? mconcat [ arg "-Werror" - , flag CrossCompiling - ? package unix + -- unix has many unused imports + , package unix ? mconcat [arg "-Wwarn=unused-imports", arg "-Wwarn=unused-top-binds"] + -- semaphore-compat relies on sem_getvalue as provided by unix, which is + -- not implemented on Darwin and therefore throws a deprecation warning + , package semaphoreCompat + ? mconcat [arg "-Wwarn=deprecations"] ] , builder Ghc ? package rts ===================================== rts/Schedule.c ===================================== @@ -1160,9 +1160,11 @@ scheduleHandleHeapOverflow( Capability *cap, StgTSO *t ) barf("allocation of %ld bytes too large (GHC should have complained at compile-time)", (long)cap->r.rHpAlloc); } +#if defined(DEBUG) debugTrace(DEBUG_sched, "--<< thread %ld (%s) stopped: requesting a large block (size %ld)\n", (long)t->id, what_next_strs[t->what_next], blocks); +#endif // don't do this if the nursery is (nearly) full, we'll GC first. if (cap->r.rCurrentNursery->link != NULL || @@ -1231,9 +1233,11 @@ scheduleHandleYield( Capability *cap, StgTSO *t, uint32_t prev_what_next ) // Shortcut if we're just switching evaluators: just run the thread. See // Note [avoiding threadPaused] in Interpreter.c. if (t->what_next != prev_what_next) { +#if defined(DEBUG) debugTrace(DEBUG_sched, "--<< thread %ld (%s) stopped to switch evaluators", (long)t->id, what_next_strs[t->what_next]); +#endif return true; } @@ -1806,7 +1810,7 @@ scheduleDoGC (Capability **pcap, Task *task USED_IF_THREADS, } } } - debugTrace(DEBUG_sched, "%d idle caps", n_idle_caps); + debugTrace(DEBUG_sched, "%d idle caps, %d failed grabs", n_idle_caps, n_failed_trygrab_idles); for (i=0; i < n_capabilities; i++) { NONATOMIC_ADD(&getCapability(i)->idle, 1); @@ -2643,7 +2647,6 @@ void scheduleWaitThread (StgTSO* tso, /*[out]*/HaskellObj* ret, Capability **pcap) { Task *task; - DEBUG_ONLY( StgThreadID id ); Capability *cap; cap = *pcap; @@ -2662,8 +2665,9 @@ scheduleWaitThread (StgTSO* tso, /*[out]*/HaskellObj* ret, Capability **pcap) appendToRunQueue(cap,tso); - DEBUG_ONLY( id = tso->id ); - debugTrace(DEBUG_sched, "new bound thread (%" FMT_StgThreadID ")", id); + DEBUG_ONLY( + debugTrace(DEBUG_sched, "new bound thread (%" FMT_StgThreadID ")", (StgThreadID) tso->id); + ); // As the TSO is bound and on the run queue, schedule() will run the TSO. cap = schedule(cap,task); @@ -2671,7 +2675,7 @@ scheduleWaitThread (StgTSO* tso, /*[out]*/HaskellObj* ret, Capability **pcap) ASSERT(task->incall->rstat != NoStatus); ASSERT_FULL_CAPABILITY_INVARIANTS(cap,task); - debugTrace(DEBUG_sched, "bound thread (%" FMT_StgThreadID ") finished", id); + debugTrace(DEBUG_sched, "bound thread (%" FMT_StgThreadID ") finished", (StgThreadID) tso->id); *pcap = cap; } @@ -2793,9 +2797,6 @@ exitScheduler (bool wait_foreign USED_IF_THREADS) shutdownCapabilities(task, wait_foreign); - // debugBelch("n_failed_trygrab_idles = %d, n_idle_caps = %d\n", - // n_failed_trygrab_idles, n_idle_caps); - exitMyTask(); } ===================================== rts/Sparks.c ===================================== @@ -119,11 +119,10 @@ pruneSparkQueue (bool nonmovingMarkFinished, Capability *cap) { SparkPool *pool; StgClosurePtr spark, tmp, *elements; - uint32_t n, pruned_sparks; // stats only + uint32_t pruned_sparks; // stats only StgInt botInd,oldBotInd,currInd; // indices in array (always < size) const StgInfoTable *info; - n = 0; pruned_sparks = 0; pool = cap->sparks; @@ -216,7 +215,6 @@ pruneSparkQueue (bool nonmovingMarkFinished, Capability *cap) if (closure_SHOULD_SPARK(tmp)) { elements[botInd] = tmp; // keep entry (new address) botInd++; - n++; } else { pruned_sparks++; // discard spark cap->spark_stats.fizzled++; @@ -246,7 +244,6 @@ pruneSparkQueue (bool nonmovingMarkFinished, Capability *cap) if (closure_SHOULD_SPARK(spark)) { elements[botInd] = spark; // keep entry (new address) botInd++; - n++; } else { pruned_sparks++; // discard spark cap->spark_stats.fizzled++; @@ -264,7 +261,6 @@ pruneSparkQueue (bool nonmovingMarkFinished, Capability *cap) // isAlive() also ignores static closures (see GCAux.c) elements[botInd] = spark; // keep entry (new address) botInd++; - n++; } else { pruned_sparks++; // discard spark cap->spark_stats.fizzled++; ===================================== rts/Trace.h ===================================== @@ -235,26 +235,25 @@ void traceThreadLabel_(Capability *cap, char *label, size_t len); + +#if defined(DEBUG) +#define DEBUG_RTS 1 +#else +#define DEBUG_RTS 0 +#endif + /* * Emit a debug message (only when DEBUG is defined) */ -#if defined(DEBUG) #define debugTrace(class, msg, ...) \ - if (RTS_UNLIKELY(class)) { \ + if (DEBUG_RTS && RTS_UNLIKELY(class)) { \ trace_(msg, ##__VA_ARGS__); \ } -#else -#define debugTrace(class, str, ...) /* nothing */ -#endif -#if defined(DEBUG) -#define debugTraceCap(class, cap, msg, ...) \ - if (RTS_UNLIKELY(class)) { \ +#define debugTraceCap(class, cap, msg, ...) \ + if (DEBUG_RTS && RTS_UNLIKELY(class)) { \ traceCap_(cap, msg, ##__VA_ARGS__); \ } -#else -#define debugTraceCap(class, cap, str, ...) /* nothing */ -#endif /* * Emit a message/event describing the state of a thread ===================================== rts/TraverseHeap.c ===================================== @@ -48,7 +48,7 @@ static void debug(const char *s, ...) va_end(ap); } #else -#define debug(...) +static void debug(const char *s STG_UNUSED, ...) {} #endif // number of blocks allocated for one stack ===================================== rts/sm/GC.c ===================================== @@ -691,6 +691,7 @@ GarbageCollect (struct GcConfig config, } copied += mut_list_size; +#if defined(DEBUG) debugTrace(DEBUG_gc, "mut_list_size: %lu (%d vars, %d arrays, %d MVARs, %d TVARs, %d TVAR_WATCH_QUEUEs, %d TREC_CHUNKs, %d TREC_HEADERs, %d others)", (unsigned long)(mut_list_size * sizeof(W_)), @@ -702,6 +703,7 @@ GarbageCollect (struct GcConfig config, mutlist_scav_stats.n_TREC_CHUNK, mutlist_scav_stats.n_TREC_HEADER, mutlist_scav_stats.n_OTHERS); +#endif } bdescr *next, *prev; ===================================== rts/sm/NonMoving.c ===================================== @@ -901,14 +901,12 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * // 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; - 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; } else { @@ -1161,24 +1159,20 @@ void assert_in_nonmoving_heap(StgPtr p) } // Search active segments - int seg_idx = 0; struct NonmovingSegment *seg = alloca->active; while (seg) { if (p >= (P_)seg && p < (((P_)seg) + NONMOVING_SEGMENT_SIZE_W)) { return; } - seg_idx++; seg = seg->link; } // Search filled segments - seg_idx = 0; seg = alloca->filled; while (seg) { if (p >= (P_)seg && p < (((P_)seg) + NONMOVING_SEGMENT_SIZE_W)) { return; } - seg_idx++; seg = seg->link; } } ===================================== rts/sm/NonMovingMark.c ===================================== @@ -268,7 +268,7 @@ void nonmovingMarkInit() { #endif } -#if defined(THREADED_RTS) && defined(DEBUG) +#if defined(THREADED_RTS) static uint32_t markQueueLength(MarkQueue *q); #endif static void init_mark_queue_(MarkQueue *queue); @@ -985,7 +985,7 @@ void freeMarkQueue (MarkQueue *queue) freeChain_lock(queue->blocks); } -#if defined(THREADED_RTS) && defined(DEBUG) +#if defined(THREADED_RTS) static uint32_t markQueueLength (MarkQueue *q) { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d7ef1704aeba451bd3e0efbdaaab2638ee1f0bc8...dec81dd1fd0475dde4929baae625d155387300bb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d7ef1704aeba451bd3e0efbdaaab2638ee1f0bc8...dec81dd1fd0475dde4929baae625d155387300bb You're receiving 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 Jun 29 23:18:29 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Thu, 29 Jun 2023 19:18:29 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Define FFI_GO_CLOSURES Message-ID: <649e1145b5606_238a8e23136b452138@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - 75665082 by Matthew Pickering at 2023-06-29T19:18:11-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - ae248f33 by sheaf at 2023-06-29T19:18:18-04:00 Add tests for #22106 Fixes #22106 - - - - - 24 changed files: - compiler/GHC/Driver/CodeOutput.hs - hadrian/src/Flavour.hs - hadrian/src/Rules/Documentation.hs - libraries/base/include/HsBase.h - libraries/ghci/GHCi/FFI.hsc - rts/Interpreter.c - rts/Schedule.c - rts/Sparks.c - rts/Trace.h - rts/TraverseHeap.c - rts/adjustor/LibffiAdjustor.c - + rts/include/rts/ghc_ffi.h - rts/rts.cabal.in - rts/sm/GC.c - rts/sm/NonMoving.c - rts/sm/NonMovingMark.c - rts/sm/Storage.c - + testsuite/tests/overloadedrecflds/should_compile/T22106_A.hs - + testsuite/tests/overloadedrecflds/should_compile/T22106_B.hs - + testsuite/tests/overloadedrecflds/should_compile/T22106_C.hs - + testsuite/tests/overloadedrecflds/should_compile/T22106_C.stderr - + testsuite/tests/overloadedrecflds/should_compile/T22106_D.hs - + testsuite/tests/overloadedrecflds/should_compile/T22106_aux.hs - testsuite/tests/overloadedrecflds/should_compile/all.T Changes: ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -295,7 +295,7 @@ outputForeignStubs logger tmpfs dflags unit_state mod location stubs -- wrapper code mentions the ffi_arg type, which comes from ffi.h ffi_includes - | platformMisc_libFFI $ platformMisc dflags = "#include \n" + | platformMisc_libFFI $ platformMisc dflags = "#include \"rts/ghc_ffi.h\"\n" | otherwise = "" stub_h_file_exists ===================================== hadrian/src/Flavour.hs ===================================== @@ -128,9 +128,13 @@ werror = ? notStage0 ? mconcat [ arg "-Werror" - , flag CrossCompiling - ? package unix + -- unix has many unused imports + , package unix ? mconcat [arg "-Wwarn=unused-imports", arg "-Wwarn=unused-top-binds"] + -- semaphore-compat relies on sem_getvalue as provided by unix, which is + -- not implemented on Darwin and therefore throws a deprecation warning + , package semaphoreCompat + ? mconcat [arg "-Wwarn=deprecations"] ] , builder Ghc ? package rts ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -258,6 +258,15 @@ buildPackageDocumentation = do need [ takeDirectory file -/- "haddock-prologue.txt"] haddocks <- haddockDependencies context + -- Build Haddock documentation + -- TODO: Pass the correct way from Rules via Context. + dynamicPrograms <- dynamicGhcPrograms =<< flavour + let haddockWay = if dynamicPrograms then dynamic else vanilla + + -- Build the dependencies of the package we are going to build documentation for + dep_pkgs <- sequence [pkgConfFile (context { way = haddockWay, Context.package = p}) + | (p, _) <- haddocks] + -- `ghc-prim` has a source file for 'GHC.Prim' which is generated just -- for Haddock. We need to 'union' (instead of '++') to avoid passing -- 'GHC.PrimopWrappers' (which unfortunately shows up in both @@ -266,12 +275,8 @@ buildPackageDocumentation = do vanillaSrcs <- hsSources context let srcs = vanillaSrcs `union` generatedSrcs - need $ srcs ++ (map snd haddocks) + need $ srcs ++ (map snd haddocks) ++ dep_pkgs - -- Build Haddock documentation - -- TODO: Pass the correct way from Rules via Context. - dynamicPrograms <- dynamicGhcPrograms =<< flavour - let haddockWay = if dynamicPrograms then dynamic else vanilla statsFilesDir <- haddockStatsFilesDir createDirectory statsFilesDir build $ target (context {way = haddockWay}) (Haddock BuildPackage) srcs [file] ===================================== libraries/base/include/HsBase.h ===================================== @@ -540,7 +540,7 @@ INLINE int __hscore_open(char *file, int how, mode_t mode) { } #endif -#if darwin_HOST_OS +#if defined(darwin_HOST_OS) // You should not access _environ directly on Darwin in a bundle/shared library. // See #2458 and http://developer.apple.com/library/mac/#documentation/Darwin/Reference/ManPages/man7/environ.7.html #include ===================================== libraries/ghci/GHCi/FFI.hsc ===================================== @@ -22,6 +22,14 @@ -} #if !defined(javascript_HOST_ARCH) +-- See Note [FFI_GO_CLOSURES workaround] in ghc_ffi.h +-- We can't include ghc_ffi.h here as we must build with stage0 +#if defined(darwin_HOST_OS) +#if !defined(FFI_GO_CLOSURES) +#define FFI_GO_CLOSURES 0 +#endif +#endif + #include #endif ===================================== rts/Interpreter.c ===================================== @@ -39,7 +39,7 @@ #endif #endif -#include "ffi.h" +#include "rts/ghc_ffi.h" /* -------------------------------------------------------------------------- * The bytecode interpreter ===================================== rts/Schedule.c ===================================== @@ -1160,9 +1160,11 @@ scheduleHandleHeapOverflow( Capability *cap, StgTSO *t ) barf("allocation of %ld bytes too large (GHC should have complained at compile-time)", (long)cap->r.rHpAlloc); } +#if defined(DEBUG) debugTrace(DEBUG_sched, "--<< thread %ld (%s) stopped: requesting a large block (size %ld)\n", (long)t->id, what_next_strs[t->what_next], blocks); +#endif // don't do this if the nursery is (nearly) full, we'll GC first. if (cap->r.rCurrentNursery->link != NULL || @@ -1231,9 +1233,11 @@ scheduleHandleYield( Capability *cap, StgTSO *t, uint32_t prev_what_next ) // Shortcut if we're just switching evaluators: just run the thread. See // Note [avoiding threadPaused] in Interpreter.c. if (t->what_next != prev_what_next) { +#if defined(DEBUG) debugTrace(DEBUG_sched, "--<< thread %ld (%s) stopped to switch evaluators", (long)t->id, what_next_strs[t->what_next]); +#endif return true; } @@ -1806,7 +1810,7 @@ scheduleDoGC (Capability **pcap, Task *task USED_IF_THREADS, } } } - debugTrace(DEBUG_sched, "%d idle caps", n_idle_caps); + debugTrace(DEBUG_sched, "%d idle caps, %d failed grabs", n_idle_caps, n_failed_trygrab_idles); for (i=0; i < n_capabilities; i++) { NONATOMIC_ADD(&getCapability(i)->idle, 1); @@ -2643,7 +2647,6 @@ void scheduleWaitThread (StgTSO* tso, /*[out]*/HaskellObj* ret, Capability **pcap) { Task *task; - DEBUG_ONLY( StgThreadID id ); Capability *cap; cap = *pcap; @@ -2662,8 +2665,9 @@ scheduleWaitThread (StgTSO* tso, /*[out]*/HaskellObj* ret, Capability **pcap) appendToRunQueue(cap,tso); - DEBUG_ONLY( id = tso->id ); - debugTrace(DEBUG_sched, "new bound thread (%" FMT_StgThreadID ")", id); + DEBUG_ONLY( + debugTrace(DEBUG_sched, "new bound thread (%" FMT_StgThreadID ")", (StgThreadID) tso->id); + ); // As the TSO is bound and on the run queue, schedule() will run the TSO. cap = schedule(cap,task); @@ -2671,7 +2675,7 @@ scheduleWaitThread (StgTSO* tso, /*[out]*/HaskellObj* ret, Capability **pcap) ASSERT(task->incall->rstat != NoStatus); ASSERT_FULL_CAPABILITY_INVARIANTS(cap,task); - debugTrace(DEBUG_sched, "bound thread (%" FMT_StgThreadID ") finished", id); + debugTrace(DEBUG_sched, "bound thread (%" FMT_StgThreadID ") finished", (StgThreadID) tso->id); *pcap = cap; } @@ -2793,9 +2797,6 @@ exitScheduler (bool wait_foreign USED_IF_THREADS) shutdownCapabilities(task, wait_foreign); - // debugBelch("n_failed_trygrab_idles = %d, n_idle_caps = %d\n", - // n_failed_trygrab_idles, n_idle_caps); - exitMyTask(); } ===================================== rts/Sparks.c ===================================== @@ -119,11 +119,10 @@ pruneSparkQueue (bool nonmovingMarkFinished, Capability *cap) { SparkPool *pool; StgClosurePtr spark, tmp, *elements; - uint32_t n, pruned_sparks; // stats only + uint32_t pruned_sparks; // stats only StgInt botInd,oldBotInd,currInd; // indices in array (always < size) const StgInfoTable *info; - n = 0; pruned_sparks = 0; pool = cap->sparks; @@ -216,7 +215,6 @@ pruneSparkQueue (bool nonmovingMarkFinished, Capability *cap) if (closure_SHOULD_SPARK(tmp)) { elements[botInd] = tmp; // keep entry (new address) botInd++; - n++; } else { pruned_sparks++; // discard spark cap->spark_stats.fizzled++; @@ -246,7 +244,6 @@ pruneSparkQueue (bool nonmovingMarkFinished, Capability *cap) if (closure_SHOULD_SPARK(spark)) { elements[botInd] = spark; // keep entry (new address) botInd++; - n++; } else { pruned_sparks++; // discard spark cap->spark_stats.fizzled++; @@ -264,7 +261,6 @@ pruneSparkQueue (bool nonmovingMarkFinished, Capability *cap) // isAlive() also ignores static closures (see GCAux.c) elements[botInd] = spark; // keep entry (new address) botInd++; - n++; } else { pruned_sparks++; // discard spark cap->spark_stats.fizzled++; ===================================== rts/Trace.h ===================================== @@ -235,26 +235,25 @@ void traceThreadLabel_(Capability *cap, char *label, size_t len); + +#if defined(DEBUG) +#define DEBUG_RTS 1 +#else +#define DEBUG_RTS 0 +#endif + /* * Emit a debug message (only when DEBUG is defined) */ -#if defined(DEBUG) #define debugTrace(class, msg, ...) \ - if (RTS_UNLIKELY(class)) { \ + if (DEBUG_RTS && RTS_UNLIKELY(class)) { \ trace_(msg, ##__VA_ARGS__); \ } -#else -#define debugTrace(class, str, ...) /* nothing */ -#endif -#if defined(DEBUG) -#define debugTraceCap(class, cap, msg, ...) \ - if (RTS_UNLIKELY(class)) { \ +#define debugTraceCap(class, cap, msg, ...) \ + if (DEBUG_RTS && RTS_UNLIKELY(class)) { \ traceCap_(cap, msg, ##__VA_ARGS__); \ } -#else -#define debugTraceCap(class, cap, str, ...) /* nothing */ -#endif /* * Emit a message/event describing the state of a thread ===================================== rts/TraverseHeap.c ===================================== @@ -48,7 +48,7 @@ static void debug(const char *s, ...) va_end(ap); } #else -#define debug(...) +static void debug(const char *s STG_UNUSED, ...) {} #endif // number of blocks allocated for one stack ===================================== rts/adjustor/LibffiAdjustor.c ===================================== @@ -11,7 +11,7 @@ #include "Hash.h" #include "Adjustor.h" -#include "ffi.h" +#include "rts/ghc_ffi.h" #include // Note that ffi_alloc_prep_closure is a non-standard libffi closure ===================================== rts/include/rts/ghc_ffi.h ===================================== @@ -0,0 +1,28 @@ +/* + * wrapper working around #23586. + * + * (c) The University of Glasgow 2023 + * + */ + +#pragma once + +/* + * Note [FFI_GO_CLOSURES workaround] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * Apple ships a broken libffi with Xcode which lacks a definition of + * FFI_GO_CLOSURES despite having references to said macro. Work around this + * for now to avoid -Wundef warnings. + * + * We choose the value zero here by following the model of OpenJDK. + * See https://github.com/openjdk/jdk17u-dev/pull/741/files. + * + * See #23568. + */ +#if defined(darwin_HOST_OS) +#if !defined(FFI_GO_CLOSURES) +#define FFI_GO_CLOSURES 0 +#endif +#endif + +#include "ffi.h" ===================================== rts/rts.cabal.in ===================================== @@ -237,6 +237,7 @@ library rts/EventLogConstants.h rts/EventTypes.h -- ^ generated + rts/ghc_ffi.h rts/Adjustor.h rts/ExecPage.h rts/BlockSignals.h ===================================== rts/sm/GC.c ===================================== @@ -691,6 +691,7 @@ GarbageCollect (struct GcConfig config, } copied += mut_list_size; +#if defined(DEBUG) debugTrace(DEBUG_gc, "mut_list_size: %lu (%d vars, %d arrays, %d MVARs, %d TVARs, %d TVAR_WATCH_QUEUEs, %d TREC_CHUNKs, %d TREC_HEADERs, %d others)", (unsigned long)(mut_list_size * sizeof(W_)), @@ -702,6 +703,7 @@ GarbageCollect (struct GcConfig config, mutlist_scav_stats.n_TREC_CHUNK, mutlist_scav_stats.n_TREC_HEADER, mutlist_scav_stats.n_OTHERS); +#endif } bdescr *next, *prev; ===================================== rts/sm/NonMoving.c ===================================== @@ -901,14 +901,12 @@ static void nonmovingMark_(MarkQueue *mark_queue, StgWeak **dead_weaks, StgTSO * // 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; - 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; } else { @@ -1161,24 +1159,20 @@ void assert_in_nonmoving_heap(StgPtr p) } // Search active segments - int seg_idx = 0; struct NonmovingSegment *seg = alloca->active; while (seg) { if (p >= (P_)seg && p < (((P_)seg) + NONMOVING_SEGMENT_SIZE_W)) { return; } - seg_idx++; seg = seg->link; } // Search filled segments - seg_idx = 0; seg = alloca->filled; while (seg) { if (p >= (P_)seg && p < (((P_)seg) + NONMOVING_SEGMENT_SIZE_W)) { return; } - seg_idx++; seg = seg->link; } } ===================================== rts/sm/NonMovingMark.c ===================================== @@ -268,7 +268,7 @@ void nonmovingMarkInit() { #endif } -#if defined(THREADED_RTS) && defined(DEBUG) +#if defined(THREADED_RTS) static uint32_t markQueueLength(MarkQueue *q); #endif static void init_mark_queue_(MarkQueue *queue); @@ -985,7 +985,7 @@ void freeMarkQueue (MarkQueue *queue) freeChain_lock(queue->blocks); } -#if defined(THREADED_RTS) && defined(DEBUG) +#if defined(THREADED_RTS) static uint32_t markQueueLength (MarkQueue *q) { ===================================== rts/sm/Storage.c ===================================== @@ -53,7 +53,7 @@ #include -#include "ffi.h" +#include "rts/ghc_ffi.h" /* * All these globals require sm_mutex to access in THREADED_RTS mode. ===================================== testsuite/tests/overloadedrecflds/should_compile/T22106_A.hs ===================================== @@ -0,0 +1,5 @@ +module T22106_A where + +import T22106_aux ( foo ) + +xyzzy = foo ===================================== testsuite/tests/overloadedrecflds/should_compile/T22106_B.hs ===================================== @@ -0,0 +1,5 @@ +module T22106_B where + +import T22106_aux ( T(foo) ) + +xyzzy r = r { foo = 3 } ===================================== testsuite/tests/overloadedrecflds/should_compile/T22106_C.hs ===================================== @@ -0,0 +1,5 @@ +module T22106_C where + +import T22106_aux ( bar ) + +xyzzy = bar ===================================== testsuite/tests/overloadedrecflds/should_compile/T22106_C.stderr ===================================== @@ -0,0 +1,6 @@ + +T22106_C.hs:5:9: error: [GHC-88464] + Variable not in scope: bar + Suggested fix: + Notice that ‘bar’ is a field selector belonging to the type ‘T22106_aux.T’ + that has been suppressed by NoFieldSelectors. ===================================== testsuite/tests/overloadedrecflds/should_compile/T22106_D.hs ===================================== @@ -0,0 +1,5 @@ +module T22106_D where + +import T22106_aux ( T(bar) ) + +xyzzy r = r { bar = 7 } ===================================== testsuite/tests/overloadedrecflds/should_compile/T22106_aux.hs ===================================== @@ -0,0 +1,6 @@ +{-# LANGUAGE NoFieldSelectors #-} + +module T22106_aux where + +data T = MkT { foo :: Int, bar :: Int } +foo = () ===================================== testsuite/tests/overloadedrecflds/should_compile/all.T ===================================== @@ -50,3 +50,8 @@ test('BootFldReexport' test('T23220' , [req_th, extra_files(['T23220_aux.hs'])] , multimod_compile, ['T23220_aux.hs T23220.hs', '-v0']) + +test('T22106_A', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_A', '-v0']) +test('T22106_B', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_B', '-v0']) +test('T22106_C', [extra_files(['T22106_aux.hs'])], multimod_compile_fail, ['T22106_C', '-v0']) +test('T22106_D', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_D', '-v0']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/db699ff60a26760536df825f2ff8329b38a9c0f4...ae248f33f8b3c470a4f78136699123b6dee66ac1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/db699ff60a26760536df825f2ff8329b38a9c0f4...ae248f33f8b3c470a4f78136699123b6dee66ac1 You're receiving 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 Jun 29 23:24:00 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Thu, 29 Jun 2023 19:24:00 -0400 Subject: [Git][ghc/ghc][wip/sized-literals-deriving] 100 commits: Add more flags for dumping core passes (#23491) Message-ID: <649e12904281_238a8e29f7ffc573a3@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/sized-literals-deriving at Glasgow Haskell Compiler / GHC Commits: 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - c0746831 by Krzysztof Gogolewski at 2023-06-30T01:23:36+02:00 Change 'deriving Show' to use extended literals Also add support for Int64 and Word64. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.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 - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Opt/OccurAnal.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fdabd0b2ca5ce2bf287df6cebe1729cdbf768cea...c074683166baad4bdeb7c012ff342b214c987f35 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fdabd0b2ca5ce2bf287df6cebe1729cdbf768cea...c074683166baad4bdeb7c012ff342b214c987f35 You're receiving 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 Jun 29 23:24:56 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Thu, 29 Jun 2023 19:24:56 -0400 Subject: [Git][ghc/ghc][wip/sized-literals-deriving] Change 'deriving Show' to use extended literals Message-ID: <649e12c823e50_238a8e2e2fffc57550@gitlab.mail> Krzysztof Gogolewski pushed to branch wip/sized-literals-deriving at Glasgow Haskell Compiler / GHC Commits: 7f4cc96b by Krzysztof Gogolewski at 2023-06-30T01:24:37+02:00 Change 'deriving Show' to use extended literals Also add support for Int64 and Word64. - - - - - 3 changed files: - compiler/GHC/Tc/Deriv/Generate.hs - testsuite/tests/primops/should_run/ShowPrim.hs - testsuite/tests/primops/should_run/ShowPrim.stdout Changes: ===================================== compiler/GHC/Tc/Deriv/Generate.hs ===================================== @@ -1282,8 +1282,7 @@ gen_Show_binds get_fixity loc dit@(DerivInstTys{ dit_rep_tc = tycon show_arg b arg_ty | isUnliftedType arg_ty -- See Note [Deriving and unboxed types] in GHC.Tc.Deriv.Infer - = with_conv $ - nlHsApps compose_RDR + = nlHsApps compose_RDR [mk_shows_app boxed_arg, mk_showString_app postfixMod] | otherwise = mk_showsPrec_app arg_prec arg @@ -1291,14 +1290,6 @@ gen_Show_binds get_fixity loc dit@(DerivInstTys{ dit_rep_tc = tycon arg = nlHsVar b boxed_arg = box "Show" arg arg_ty postfixMod = assoc_ty_id "Show" postfixModTbl arg_ty - with_conv expr - | (Just conv) <- assoc_ty_id_maybe primConvTbl arg_ty = - nested_compose_Expr - [ mk_showString_app ("(" ++ conv ++ " ") - , expr - , mk_showString_app ")" - ] - | otherwise = expr -- Fixity stuff is_infix = dataConIsInfix data_con @@ -1514,9 +1505,8 @@ gfoldl_RDR, gunfold_RDR, toConstr_RDR, dataTypeOf_RDR, mkConstrTag_RDR, eqAddr_RDR , ltAddr_RDR , geAddr_RDR , gtAddr_RDR , leAddr_RDR , eqFloat_RDR , ltFloat_RDR , geFloat_RDR , gtFloat_RDR , leFloat_RDR , eqDouble_RDR, ltDouble_RDR, geDouble_RDR, gtDouble_RDR, leDouble_RDR, - word8ToWord_RDR , int8ToInt_RDR , - word16ToWord_RDR, int16ToInt_RDR, - word32ToWord_RDR, int32ToInt_RDR + int8DataCon_RDR, int16DataCon_RDR, int32DataCon_RDR, int64DataCon_RDR, + word8DataCon_RDR, word16DataCon_RDR, word32DataCon_RDR, word64DataCon_RDR :: RdrName gfoldl_RDR = varQual_RDR gENERICS (fsLit "gfoldl") gunfold_RDR = varQual_RDR gENERICS (fsLit "gunfold") @@ -1619,15 +1609,14 @@ leDouble_RDR = varQual_RDR gHC_PRIM (fsLit "<=##") gtDouble_RDR = varQual_RDR gHC_PRIM (fsLit ">##" ) geDouble_RDR = varQual_RDR gHC_PRIM (fsLit ">=##") -word8ToWord_RDR = varQual_RDR gHC_PRIM (fsLit "word8ToWord#") -int8ToInt_RDR = varQual_RDR gHC_PRIM (fsLit "int8ToInt#") - -word16ToWord_RDR = varQual_RDR gHC_PRIM (fsLit "word16ToWord#") -int16ToInt_RDR = varQual_RDR gHC_PRIM (fsLit "int16ToInt#") - -word32ToWord_RDR = varQual_RDR gHC_PRIM (fsLit "word32ToWord#") -int32ToInt_RDR = varQual_RDR gHC_PRIM (fsLit "int32ToInt#") - +int8DataCon_RDR = dataQual_RDR gHC_INT (fsLit "I8#") +int16DataCon_RDR = dataQual_RDR gHC_INT (fsLit "I16#") +int32DataCon_RDR = dataQual_RDR gHC_INT (fsLit "I32#") +int64DataCon_RDR = dataQual_RDR gHC_INT (fsLit "I64#") +word8DataCon_RDR = dataQual_RDR gHC_WORD (fsLit "W8#") +word16DataCon_RDR = dataQual_RDR gHC_WORD (fsLit "W16#") +word32DataCon_RDR = dataQual_RDR gHC_WORD (fsLit "W32#") +word64DataCon_RDR = dataQual_RDR gHC_WORD (fsLit "W64#") {- ************************************************************************ * * @@ -2416,7 +2405,6 @@ ordOpTbl -- A mapping from a primitive type to a function that constructs its boxed -- version. --- NOTE: Int8#/Word8# will become Int/Word. boxConTbl :: [(Type, LHsExpr GhcPs -> LHsExpr GhcPs)] boxConTbl = [ (charPrimTy , nlHsApp (nlHsVar $ getRdrName charDataCon)) @@ -2424,24 +2412,14 @@ boxConTbl = , (wordPrimTy , nlHsApp (nlHsVar $ getRdrName wordDataCon )) , (floatPrimTy , nlHsApp (nlHsVar $ getRdrName floatDataCon )) , (doublePrimTy, nlHsApp (nlHsVar $ getRdrName doubleDataCon)) - , (int8PrimTy, - nlHsApp (nlHsVar $ getRdrName intDataCon) - . nlHsApp (nlHsVar int8ToInt_RDR)) - , (word8PrimTy, - nlHsApp (nlHsVar $ getRdrName wordDataCon) - . nlHsApp (nlHsVar word8ToWord_RDR)) - , (int16PrimTy, - nlHsApp (nlHsVar $ getRdrName intDataCon) - . nlHsApp (nlHsVar int16ToInt_RDR)) - , (word16PrimTy, - nlHsApp (nlHsVar $ getRdrName wordDataCon) - . nlHsApp (nlHsVar word16ToWord_RDR)) - , (int32PrimTy, - nlHsApp (nlHsVar $ getRdrName intDataCon) - . nlHsApp (nlHsVar int32ToInt_RDR)) - , (word32PrimTy, - nlHsApp (nlHsVar $ getRdrName wordDataCon) - . nlHsApp (nlHsVar word32ToWord_RDR)) + , (int8PrimTy, nlHsApp (nlHsVar int8DataCon_RDR)) + , (word8PrimTy, nlHsApp (nlHsVar word8DataCon_RDR)) + , (int16PrimTy, nlHsApp (nlHsVar int16DataCon_RDR)) + , (word16PrimTy, nlHsApp (nlHsVar word16DataCon_RDR)) + , (int32PrimTy, nlHsApp (nlHsVar int32DataCon_RDR)) + , (word32PrimTy, nlHsApp (nlHsVar word32DataCon_RDR)) + , (int64PrimTy, nlHsApp (nlHsVar int64DataCon_RDR)) + , (word64PrimTy, nlHsApp (nlHsVar word64DataCon_RDR)) ] @@ -2453,22 +2431,14 @@ postfixModTbl ,(wordPrimTy , "##") ,(floatPrimTy , "#" ) ,(doublePrimTy, "##") - ,(int8PrimTy, "#") - ,(word8PrimTy, "##") - ,(int16PrimTy, "#") - ,(word16PrimTy, "##") - ,(int32PrimTy, "#") - ,(word32PrimTy, "##") - ] - -primConvTbl :: [(Type, String)] -primConvTbl = - [ (int8PrimTy, "intToInt8#") - , (word8PrimTy, "wordToWord8#") - , (int16PrimTy, "intToInt16#") - , (word16PrimTy, "wordToWord16#") - , (int32PrimTy, "intToInt32#") - , (word32PrimTy, "wordToWord32#") + ,(int8PrimTy , "#Int8") + ,(word8PrimTy , "#Word8") + ,(int16PrimTy , "#Int16") + ,(word16PrimTy, "#Word16") + ,(int32PrimTy , "#Int32") + ,(word32PrimTy, "#Word32") + ,(int64PrimTy , "#Int64") + ,(word64PrimTy, "#Word64") ] litConTbl :: [(Type, LHsExpr GhcPs -> LHsExpr GhcPs)] ===================================== testsuite/tests/primops/should_run/ShowPrim.hs ===================================== @@ -1,4 +1,4 @@ -{-# LANGUAGE MagicHash #-} +{-# LANGUAGE MagicHash, ExtendedLiterals #-} module Main where @@ -13,17 +13,24 @@ data Test2 = Test2 Int16# Word16# data Test3 = Test3 Int32# Word32# deriving (Show) +data Test4 = Test4 Int64# Word64# + deriving (Show) + test1 :: Test1 -test1 = Test1 (intToInt8# 1#) (wordToWord8# 2##) +test1 = Test1 1#Int8 2#Word8 test2 :: Test2 -test2 = Test2 (intToInt16# 1#) (wordToWord16# 2##) +test2 = Test2 1#Int16 2#Word16 test3 :: Test3 -test3 = Test3 (intToInt32# 1#) (wordToWord32# 2##) +test3 = Test3 1#Int32 2#Word32 + +test4 :: Test4 +test4 = Test4 -9223372036854775808#Int64 18446744073709551610#Word64 main :: IO () main = do print test1 print test2 print test3 + print test4 ===================================== testsuite/tests/primops/should_run/ShowPrim.stdout ===================================== @@ -1,3 +1,4 @@ -Test1 (intToInt8# 1#) (wordToWord8# 2##) -Test2 (intToInt16# 1#) (wordToWord16# 2##) -Test3 (intToInt32# 1#) (wordToWord32# 2##) +Test1 1#Int8 2#Word8 +Test2 1#Int16 2#Word16 +Test3 1#Int32 2#Word32 +Test4 -9223372036854775808#Int64 18446744073709551610#Word64 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f4cc96b3a2360840d05a2263f61cb23d5b2d15d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f4cc96b3a2360840d05a2263f61cb23d5b2d15d You're receiving 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 Jun 30 02:39:15 2023 From: gitlab at gitlab.haskell.org (=?UTF-8?B?R2VyZ8WRIMOJcmRpIChAY2FjdHVzKQ==?=) Date: Thu, 29 Jun 2023 22:39:15 -0400 Subject: [Git][ghc/ghc][wip/incoherent-spec-flag] 30 commits: Stop configuring unused Ld command in `settings` Message-ID: <649e40539bd15_238a8e2e3b2d072181@gitlab.mail> Gergő Érdi pushed to branch wip/incoherent-spec-flag at Glasgow Haskell Compiler / GHC Commits: ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - 4657ee03 by Gergő Érdi at 2023-06-30T02:37:46+01:00 Desugar bindings in the context of their evidence Closes #23172 - - - - - d8de204c by Gergő Érdi at 2023-06-30T03:39:11+01:00 Add flag to enable/disable incoherent instances Fixes #23287 - - - - - 30 changed files: - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.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 - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/InstEnv.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Types.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Linker/Linker.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d61f806e74f823dbc577d0e702d7bf601be7f10c...d8de204c647ea5dc566f46aced689bb813fcb586 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d61f806e74f823dbc577d0e702d7bf601be7f10c...d8de204c647ea5dc566f46aced689bb813fcb586 You're receiving 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 Jun 30 03:08:46 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 29 Jun 2023 23:08:46 -0400 Subject: [Git][ghc/ghc][wip/ci-interface-stability] testsuite: Add test to catch changes in core libraries Message-ID: <649e473e4cd36_238a8e20341647862b@gitlab.mail> Ben Gamari pushed to branch wip/ci-interface-stability at Glasgow Haskell Compiler / GHC Commits: 8e0c11f6 by Ben Gamari at 2023-06-29T23:08:16-04: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. - - - - - 11 changed files: - hadrian/src/Packages.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Default.hs - testsuite/mk/boilerplate.mk - + testsuite/tests/interface-stability/Makefile - + testsuite/tests/interface-stability/README.mkd - + testsuite/tests/interface-stability/all.T - + testsuite/tests/interface-stability/base-exports.stdout - + testsuite/tests/interface-stability/base-exports.stdout-mingw32 - + utils/dump-decls/Main.hs - + utils/dump-decls/dump-decls.cabal Changes: ===================================== hadrian/src/Packages.hs ===================================== @@ -3,7 +3,7 @@ module Packages ( -- * GHC packages array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, @@ -35,7 +35,7 @@ import Oracles.Setting ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps - , compareSizes, compiler, containers, deepseq, deriveConstants, directory + , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl @@ -51,7 +51,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, @@ -75,6 +75,7 @@ containers = lib "containers" `setPath` "libraries/containers/con deepseq = lib "deepseq" deriveConstants = util "deriveConstants" directory = lib "directory" +dumpDecls = util "dump-decls" exceptions = lib "exceptions" filepath = lib "filepath" genapply = util "genapply" ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -40,6 +40,12 @@ countDepsSourcePath = "utils/count-deps/Main.hs" countDepsExtra :: [String] countDepsExtra = ["-iutils/count-deps"] +dumpDeclsProgPath, dumpDeclsSourcePath :: FilePath +dumpDeclsProgPath = "test/bin/dump-decls" <.> exe +dumpDeclsSourcePath = "utils/dump-decls/Main.hs" +dumpDeclsExtra :: [String] +dumpDeclsExtra = [] + noteLinterProgPath, noteLinterSourcePath :: FilePath noteLinterProgPath = "test/bin/lint-notes" <.> exe noteLinterSourcePath = "linters/lint-notes/Main.hs" @@ -67,6 +73,7 @@ checkPrograms = [ CheckProgram "test:check-ppr" checkPprProgPath checkPprSourcePath checkPprExtra checkPpr id id , CheckProgram "test:check-exact" checkExactProgPath checkExactSourcePath checkExactExtra checkExact id id , CheckProgram "test:count-deps" countDepsProgPath countDepsSourcePath countDepsExtra countDeps id id + , CheckProgram "test:dump-decls" dumpDeclsProgPath dumpDeclsSourcePath dumpDeclsExtra dumpDecls id id , CheckProgram "lint:notes" noteLinterProgPath noteLinterSourcePath noteLinterExtra lintNotes (const stage0Boot) id , CheckProgram "lint:whitespace" whitespaceLinterProgPath whitespaceLinterSourcePath whitespaceLinterExtra lintWhitespace (const stage0Boot) (filter (/= lintersCommon)) ] @@ -260,6 +267,7 @@ testRules = do setEnv "CHECK_PPR" (top -/- root -/- checkPprProgPath) setEnv "CHECK_EXACT" (top -/- root -/- checkExactProgPath) + setEnv "DUMP_DECLS" (top -/- root -/- dumpDeclsProgPath) setEnv "COUNT_DEPS" (top -/- root -/- countDepsProgPath) setEnv "LINT_NOTES" (top -/- root -/- noteLinterProgPath) setEnv "LINT_WHITESPACE" (top -/- root -/- whitespaceLinterProgPath) ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -167,7 +167,7 @@ stage2Packages = stage1Packages -- | Packages that are built only for the testsuite. testsuitePackages :: Action [Package] -testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig ]) +testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig, dumpDecls ]) -- | Default build ways for library packages: -- * We always build 'vanilla' way. ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -227,6 +227,10 @@ ifeq "$(CHECK_EXACT)" "" CHECK_EXACT := $(abspath $(TOP)/../inplace/bin/check-exact) endif +ifeq "$(DUMP_DECLS)" "" +DUMP_DECLS := $(abspath $(TOP)/../inplace/bin/dump-decls) +endif + ifeq "$(COUNT_DEPS)" "" COUNT_DEPS := $(abspath $(TOP)/../inplace/bin/count-deps) endif ===================================== testsuite/tests/interface-stability/Makefile ===================================== @@ -0,0 +1,6 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +exports_% : + "$(DUMP_DECLS)" "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" $* ===================================== testsuite/tests/interface-stability/README.mkd ===================================== @@ -0,0 +1,11 @@ +# Interface stability testing + +The tests in this directory verify that the interfaces of exposed by GHC's +core libraries do not inadvertently change. They use the `utils/dump-decls` +utility to dump all exported declarations of all exposed modules for the +following packages: + + * base + +These are compared against the expected exports in the test's corresponding +`.stdout` file. ===================================== testsuite/tests/interface-stability/all.T ===================================== @@ -0,0 +1,7 @@ +def check_package(pkg_name): + test(f'{pkg_name}-exports', + req_hadrian_deps(['test:dump-decls']), + makefile_test, + [f'exports_{pkg_name}']) + +check_package('base') ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== The diff for this file was not included because it is too large. ===================================== testsuite/tests/interface-stability/base-exports.stdout-mingw32 ===================================== The diff for this file was not included because it is too large. ===================================== utils/dump-decls/Main.hs ===================================== @@ -0,0 +1,243 @@ +module Main where + +import GHC +import GHC.Core.InstEnv (instEnvElts, instanceHead) +import GHC.Core.Class (classMinimalDef) +import GHC.Core.TyCo.FVs (tyConsOfType) +import GHC.Driver.Ppr (showSDocForUser) +import GHC.Unit.State (lookupUnitId, lookupPackageName) +import GHC.Unit.Info (UnitInfo, unitExposedModules, PackageName(..)) +import GHC.Data.FastString (fsLit) +import GHC.Driver.Env (hsc_units, hscEPS) +import GHC.Utils.Outputable +import GHC.Types.Unique.Set (nonDetEltsUniqSet) +import GHC.Types.TyThing (tyThingParent_maybe) +import GHC.Types.TyThing.Ppr (pprTyThing) +import GHC.Types.Name (nameOccName, nameModule_maybe, stableNameCmp) +import GHC.Types.Name.Occurrence (OccName, mkDataOcc, mkVarOcc) +import GHC.Unit.External (eps_inst_env) +import GHC.Iface.Syntax (ShowSub(..), ShowHowMuch(..), AltPpr(..)) +import GHC.Iface.Type (ShowForAllFlag(..)) + +import Data.Function (on) +import Data.List (sortBy) +import Control.Monad.IO.Class +import System.Environment (getArgs) +import Prelude hiding ((<>)) + +main :: IO () +main = do + ghcRoot:pkg_names <- getArgs + mapM_ (run ghcRoot) pkg_names + +run :: FilePath -> String -> IO () +run root pkg_nm = runGhc (Just root) $ do + let args = map noLoc + [ "-package=" ++ pkg_nm + , "-dppr-cols=1000" + , "-fprint-explicit-runtime-reps" + , "-fprint-explicit-foralls" + ] + dflags <- do + dflags <- getSessionDynFlags + logger <- getLogger + (dflags', _fileish_args, _dynamicFlagWarnings) <- + GHC.parseDynamicFlags logger dflags args + return dflags' + + _ <- setProgramDynFlags dflags + unit_state <- hsc_units <$> getSession + unit_id <- case lookupPackageName unit_state (PackageName $ fsLit pkg_nm) of + Just unit_id -> return unit_id + Nothing -> fail "failed to find package" + unit_info <- case lookupUnitId unit_state unit_id of + Just unit_info -> return unit_info + Nothing -> fail "unknown package" + + decls_doc <- reportUnitDecls unit_info + insts_doc <- reportInstances + + name_ppr_ctx <- GHC.getNamePprCtx + let rendered = showSDocForUser dflags unit_state name_ppr_ctx (vcat [decls_doc, insts_doc]) + liftIO $ putStrLn rendered + +ignoredModules :: [ModuleName] +ignoredModules = + map mkModuleName $ concat + [ unstableModules + , platformDependentModules + ] + where + unstableModules = + [ "GHC.Prim" + , "GHC.Conc.POSIX" + , "GHC.Conc.IO" + ] + platformDependentModules = + [ "System.Posix.Types" + , "Foreign.C.Types" + ] + +ignoredOccNames :: [OccName] +ignoredOccNames = + map mkDataOcc cTypeCons ++ + map mkVarOcc integerConversionIds + where + -- Data constructors from Foreign.C.Types whose RHSs are inherently platform-dependent + cTypeCons = + [ "CBool" + , "CChar" + , "CClock" + , "CDouble" + , "CFile" + , "CFloat" + , "CFpos" + , "CInt" + , "CIntMax" + , "CIntPtr" + , "CJmpBuf" + , "CLLong" + , "CLong" + , "CPtrdiff" + , "CSChar" + , "CSUSeconds" + , "CShort" + , "CSigAtomic" + , "CSize" + , "CTime" + , "CUChar" + , "CUInt" + , "CUIntMax" + , "CUIntPtr" + , "CULLong" + , "CULong" + , "CUSeconds" + , "CUShort" + , "CWchar" + ] + + -- Conversion functions in GHC.Integer which are only exposed on 32-bit + -- platforms + integerConversionIds = + [ "int64ToInteger" + , "integerToInt64" + , "integerToWord64" + , "word64ToInteger" + ] + +ignoredOccName :: OccName -> Bool +ignoredOccName occ = occ `elem` ignoredOccNames + +ignoredName :: Name -> Bool +ignoredName nm + | ignoredOccName (getOccName nm) + = True + | Just md <- nameModule_maybe nm + , moduleName md `elem` ignoredModules + = True + | otherwise + = False + +ignoredTyThing :: TyThing -> Bool +ignoredTyThing _ = False + +ignoredTyCon :: TyCon -> Bool +ignoredTyCon = ignoredName . getName + +ignoredType :: Type -> Bool +ignoredType = any ignoredTyCon . nonDetEltsUniqSet . tyConsOfType + +-- | Ignore instances whose heads mention ignored types. +ignoredInstance :: ClsInst -> Bool +ignoredInstance inst + | ignoredName $ getName cls + = True + | any ignoredType tys + = True + | otherwise + = False + where + (_, cls, tys) = instanceHead inst + +reportUnitDecls :: UnitInfo -> Ghc SDoc +reportUnitDecls unit_info = do + let exposed :: [ModuleName] + exposed = map fst (unitExposedModules unit_info) + vcat <$> mapM reportModuleDecls exposed + +reportModuleDecls :: ModuleName -> Ghc SDoc +reportModuleDecls modl_nm + | modl_nm `elem` ignoredModules = do + return $ vcat [ mod_header, text "-- ignored", text "" ] + | otherwise = do + modl <- GHC.lookupQualifiedModule NoPkgQual modl_nm + mb_mod_info <- GHC.getModuleInfo modl + mod_info <- case mb_mod_info of + Nothing -> fail "Failed to find module" + Just mod_info -> return mod_info + + Just name_ppr_ctx <- mkNamePprCtxForModule mod_info + let names = GHC.modInfoExports mod_info + sorted_names = sortBy (compare `on` nameOccName) names + + exported_occs :: [OccName] + exported_occs = map nameOccName names + + is_exported :: OccName -> Bool + is_exported occ = occ `elem` exported_occs + + show_occ :: OccName -> Bool + show_occ occ = is_exported occ && not (ignoredOccName occ) + + things <- mapM GHC.lookupName sorted_names + let contents = vcat $ + [ text "-- Safety:" <+> ppr (modInfoSafe mod_info) ] ++ + [ pprTyThing ss thing $$ extras + | Just thing <- things + , case tyThingParent_maybe thing of + Just parent + | is_exported (getOccName parent) -> False + _ -> True + , not $ ignoredTyThing thing + , let ss = ShowSub { ss_how_much = ShowSome (Just show_occ) (AltPpr Nothing) + , ss_forall = ShowForAllMust + } + , let extras = case thing of + ATyCon tycon + | Just cls <- tyConClass_maybe tycon + -> nest 2 (text "{-# MINIMAL" <+> ppr (classMinimalDef cls) <+> text "#-}") + _ -> empty + ] + + return $ withUserStyle name_ppr_ctx AllTheWay $ + hang mod_header 2 contents <> + text "" + where + mod_header = vcat + [ text "" + , text "module" <+> ppr modl_nm <+> text "where" + , text "" + ] + +reportInstances :: Ghc SDoc +reportInstances = do + hsc_env <- getSession + eps <- liftIO $ hscEPS hsc_env + let instances = eps_inst_env eps + return $ vcat $ + [ text "" + , text "" + , text "-- Instances:" + ] ++ + [ ppr inst + | inst <- sortBy compareInstances (instEnvElts instances) + , not $ ignoredInstance inst + ] + +compareInstances :: ClsInst -> ClsInst -> Ordering +compareInstances inst1 inst2 = mconcat + [ stableNameCmp (getName cls1) (getName cls2) + ] + where + (_, cls1, _tys1) = instanceHead inst1 + (_, cls2, _tys2) = instanceHead inst2 ===================================== utils/dump-decls/dump-decls.cabal ===================================== @@ -0,0 +1,13 @@ +cabal-version: 2.4 +name: dump-decls +version: 0.1.0.0 +synopsis: Dump the declarations of a package. +license: BSD-3-Clause +author: Ben Gamari +maintainer: ben at smart-cactus.org +copyright: (c) 2023 Ben Gamari + +executable dump-decls + main-is: Main.hs + build-depends: base, ghc + default-language: Haskell2010 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8e0c11f65c1ae36db50e54001e3645f36a7f8ed7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8e0c11f65c1ae36db50e54001e3645f36a7f8ed7 You're receiving 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 Jun 30 03:26:31 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Thu, 29 Jun 2023 23:26:31 -0400 Subject: [Git][ghc/ghc][wip/drop-touch] Drop dependence on `touch` Message-ID: <649e4b67d179a_238a8e2034164795d4@gitlab.mail> Ben Gamari pushed to branch wip/drop-touch at Glasgow Haskell Compiler / GHC Commits: dd2b60eb by Ben Gamari at 2023-06-29T23:26:21-04:00 Drop dependence on `touch` This drops GHC's dependence on the `touch` program, instead implementing it within GHC. This eliminates an external dependency and means that we have one fewer program to keep track of in the `configure` script - - - - - 22 changed files: - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools/Tasks.hs - + compiler/GHC/Utils/Touch.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Builder.hs - hadrian/src/Hadrian/Builder.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Program.hs - hadrian/src/Settings/Default.hs - m4/fp_settings.m4 - − utils/touchy/Makefile - − utils/touchy/touchy.c - − utils/touchy/touchy.cabal Changes: ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -259,6 +259,7 @@ import GHC.Utils.Outputable import GHC.Utils.Misc import GHC.Utils.Logger import GHC.Utils.TmpFs +import GHC.Utils.Touch import qualified GHC.LanguageExtensions as LangExt @@ -1262,7 +1263,7 @@ hscMaybeWriteIface logger dflags is_simple iface old_iface mod_location = do -- .hie files. let hie_file = ml_hie_file mod_location whenM (doesFileExist hie_file) $ - GHC.SysTools.touch logger dflags "Touching hie file" hie_file + GHC.Utils.Touch.touch hie_file else -- See Note [Strictness in ModIface] forceModIface iface ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -72,6 +72,7 @@ import System.IO import GHC.Linker.ExtraObj import GHC.Linker.Dynamic import GHC.Utils.Panic +import GHC.Utils.Touch import GHC.Unit.Module.Env import GHC.Driver.Env.KnotVars import GHC.Driver.Config.Finder @@ -369,7 +370,7 @@ runJsPhase _pipe_env hsc_env _location input_fn = do -- The object file is already generated. We only touch it to ensure the -- timestamp is refreshed, see Note [JS Backend .o file procedure]. - touchObjectFile logger dflags input_fn + touchObjectFile input_fn return input_fn @@ -552,7 +553,7 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do -- In the case of hs-boot files, generate a dummy .o-boot -- stamp file for the benefit of Make - HsBootFile -> touchObjectFile logger dflags o_file + HsBootFile -> touchObjectFile o_file HsSrcFile -> panic "HscUpdate not relevant for HscSrcFile" -- MP: I wonder if there are any lurking bugs here because we @@ -1148,10 +1149,10 @@ linkDynLibCheck logger tmpfs dflags unit_env o_files dep_units = do -touchObjectFile :: Logger -> DynFlags -> FilePath -> IO () -touchObjectFile logger dflags path = do +touchObjectFile :: FilePath -> IO () +touchObjectFile path = do createDirectoryIfMissing True $ takeDirectory path - GHC.SysTools.touch logger dflags "Touching object file" path + GHC.Utils.Touch.touch path -- Note [-fPIC for assembler] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -102,7 +102,6 @@ module GHC.Driver.Session ( sPgm_l, sPgm_lm, sPgm_dll, - sPgm_T, sPgm_windres, sPgm_ar, sPgm_ranlib, @@ -137,7 +136,7 @@ module GHC.Driver.Session ( versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, - pgm_dll, pgm_T, pgm_windres, pgm_ar, + pgm_dll, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -406,8 +405,6 @@ pgm_lm :: DynFlags -> Maybe (String,[Option]) pgm_lm dflags = toolSettings_pgm_lm $ toolSettings dflags pgm_dll :: DynFlags -> (String,[Option]) pgm_dll dflags = toolSettings_pgm_dll $ toolSettings dflags -pgm_T :: DynFlags -> String -pgm_T dflags = toolSettings_pgm_T $ toolSettings dflags pgm_windres :: DynFlags -> String pgm_windres dflags = toolSettings_pgm_windres $ toolSettings dflags pgm_lcc :: DynFlags -> (String,[Option]) ===================================== compiler/GHC/Settings.hs ===================================== @@ -34,7 +34,6 @@ module GHC.Settings , sPgm_l , sPgm_lm , sPgm_dll - , sPgm_T , sPgm_windres , sPgm_ar , sPgm_otool @@ -111,7 +110,6 @@ data ToolSettings = ToolSettings -- merging, hence the 'Maybe'. See Note [Object merging] in -- "GHC.Driver.Pipeline.Execute" for details. , toolSettings_pgm_dll :: (String, [Option]) - , toolSettings_pgm_T :: String , toolSettings_pgm_windres :: String , toolSettings_pgm_ar :: String , toolSettings_pgm_otool :: String @@ -226,8 +224,6 @@ sPgm_lm :: Settings -> Maybe (String, [Option]) sPgm_lm = toolSettings_pgm_lm . sToolSettings sPgm_dll :: Settings -> (String, [Option]) sPgm_dll = toolSettings_pgm_dll . sToolSettings -sPgm_T :: Settings -> String -sPgm_T = toolSettings_pgm_T . sToolSettings sPgm_windres :: Settings -> String sPgm_windres = toolSettings_pgm_windres . sToolSettings sPgm_ar :: Settings -> String ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -125,8 +125,6 @@ initSettings top_dir = do install_name_tool_path <- getToolSetting "install_name_tool command" ranlib_path <- getToolSetting "ranlib command" - touch_path <- getToolSetting "touch command" - mkdll_prog <- getToolSetting "dllwrap command" let mkdll_args = [] @@ -191,7 +189,6 @@ initSettings top_dir = do , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r , toolSettings_pgm_dll = (mkdll_prog,mkdll_args) - , toolSettings_pgm_T = touch_path , toolSettings_pgm_windres = windres_path , toolSettings_pgm_ar = ar_path , toolSettings_pgm_otool = otool_path ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -395,6 +395,3 @@ runWindres logger dflags args = traceSystoolCommand logger "windres" $ do mb_env <- getGccEnv cc_args runSomethingFiltered logger id "Windres" windres (opts ++ args) Nothing mb_env -touch :: Logger -> DynFlags -> String -> String -> IO () -touch logger dflags purpose arg = traceSystoolCommand logger "touch" $ - runSomething logger purpose (pgm_T dflags) [FileOption "" arg] ===================================== compiler/GHC/Utils/Touch.hs ===================================== @@ -0,0 +1,29 @@ +{-# LANGUAGE CPP #-} + +module GHC.Utils.Touch (touch) where + +import GHC.Prelude + +#if defined(mingw32_HOST_OS) +import System.Win32.File +import System.Win32.Time +#else +import System.Posix.Files +import System.Posix.IO +#endif + +-- | Set the mtime of the given file to the current time. +touch :: FilePath -> IO () +touch file = do +#if defined(mingw32_HOST_OS) + hdl <- createFile file gENERIC_WRITE fILE_SHARE_NONE Nothing oPEN_ALWAYS fILE_ATTRIBUTE_NORMAL Nothing + t <- getSystemTimeAsFileTime + setFileTime hdl Nothing Nothing (Just t) + closeHandle hdl +#else + let oflags = defaultFileFlags { noctty = True } + fd <- openFd file WriteOnly (Just 0o666) oflags + touchFd fd + closeFd fd +#endif + ===================================== compiler/ghc.cabal.in ===================================== @@ -902,6 +902,7 @@ Library GHC.Utils.Ppr GHC.Utils.Ppr.Colour GHC.Utils.TmpFs + GHC.Utils.Touch GHC.Utils.Trace GHC.Wasm.ControlFlow GHC.Wasm.ControlFlow.FromCmm ===================================== hadrian/bindist/Makefile ===================================== @@ -102,7 +102,6 @@ lib/settings : config.mk @echo ',("ranlib command", "$(SettingsRanlibCommand)")' >> $@ @echo ',("otool command", "$(SettingsOtoolCommand)")' >> $@ @echo ',("install_name_tool command", "$(SettingsInstallNameToolCommand)")' >> $@ - @echo ',("touch command", "$(SettingsTouchCommand)")' >> $@ @echo ',("dllwrap command", "$(SettingsDllWrapCommand)")' >> $@ @echo ',("windres command", "$(SettingsWindresCommand)")' >> $@ @echo ',("unlit command", "$$topdir/bin/$(CrossCompilePrefix)unlit")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -274,7 +274,6 @@ SettingsRanlibCommand = @SettingsRanlibCommand@ SettingsDllWrapCommand = @SettingsDllWrapCommand@ SettingsWindresCommand = @SettingsWindresCommand@ SettingsLibtoolCommand = @SettingsLibtoolCommand@ -SettingsTouchCommand = @SettingsTouchCommand@ SettingsClangCommand = @SettingsClangCommand@ SettingsLlcCommand = @SettingsLlcCommand@ SettingsOptCommand = @SettingsOptCommand@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -158,7 +158,6 @@ settings-otool-command = @SettingsOtoolCommand@ settings-install_name_tool-command = @SettingsInstallNameToolCommand@ settings-dll-wrap-command = @SettingsDllWrapCommand@ settings-windres-command = @SettingsWindresCommand@ -settings-touch-command = @SettingsTouchCommand@ settings-clang-command = @SettingsClangCommand@ settings-llc-command = @SettingsLlcCommand@ settings-opt-command = @SettingsOptCommand@ ===================================== hadrian/src/Builder.hs ===================================== @@ -236,7 +236,6 @@ instance H.Builder Builder where pure [] Ghc _ stage -> do root <- buildRoot - touchyPath <- programPath (vanillaContext (Stage0 InTreeLibs) touchy) unlitPath <- builderPath Unlit -- GHC from the previous stage is used to build artifacts in the @@ -245,7 +244,6 @@ instance H.Builder Builder where return $ [ unlitPath ] ++ ghcdeps - ++ [ touchyPath | windowsHost ] ++ [ root -/- mingwStamp | windowsHost ] -- proxy for the entire mingw toolchain that -- we have in inplace/mingw initially, and then at ===================================== hadrian/src/Hadrian/Builder.hs ===================================== @@ -49,8 +49,8 @@ class ShakeValue b => Builder b where -- capture the @stdout@ result and return it. askBuilderWith :: b -> BuildInfo -> Action String - -- | Runtime dependencies of a builder. For example, on Windows GHC requires - -- the utility @touchy.exe@ to be available on a specific path. + -- | Runtime dependencies of a builder. For example, GHC requires the + -- utility @unlit@ to be available on a specific path. runtimeDependencies :: b -> Action [FilePath] runtimeDependencies _ = return [] ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -125,7 +125,6 @@ data SettingsFileSetting | SettingsFileSetting_InstallNameToolCommand | SettingsFileSetting_DllWrapCommand | SettingsFileSetting_WindresCommand - | SettingsFileSetting_TouchCommand | SettingsFileSetting_ClangCommand | SettingsFileSetting_LlcCommand | SettingsFileSetting_OptCommand @@ -223,7 +222,6 @@ settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_InstallNameToolCommand -> "settings-install_name_tool-command" SettingsFileSetting_DllWrapCommand -> "settings-dll-wrap-command" SettingsFileSetting_WindresCommand -> "settings-windres-command" - SettingsFileSetting_TouchCommand -> "settings-touch-command" SettingsFileSetting_ClangCommand -> "settings-clang-command" SettingsFileSetting_LlcCommand -> "settings-llc-command" SettingsFileSetting_OptCommand -> "settings-opt-command" ===================================== hadrian/src/Packages.hs ===================================== @@ -8,7 +8,7 @@ module Packages ( ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, - runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, touchy, + runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, ghcPackages, isGhcPackage, @@ -40,7 +40,7 @@ ghcPackages = , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell - , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml + , terminfo, text, time, transformers, unlit, unix, win32, xhtml , timeout , lintersCommon , lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace ] @@ -56,7 +56,7 @@ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, count ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, - terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml, + terminfo, text, time, transformers, unlit, unix, win32, xhtml, timeout, lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace :: Package @@ -117,7 +117,6 @@ terminfo = lib "terminfo" text = lib "text" time = lib "time" timeout = util "timeout" `setPath` "testsuite/timeout" -touchy = util "touchy" transformers = lib "transformers" unlit = util "unlit" unix = lib "unix" @@ -192,12 +191,12 @@ programName Context {..} = do -- | The 'FilePath' to a program executable in a given 'Context'. programPath :: Context -> Action FilePath programPath context at Context {..} = do - -- TODO: The @touchy@ utility lives in the @lib/bin@ directory instead of - -- @bin@, which is likely just a historical accident that should be fixed. - -- See: https://github.com/snowleopard/hadrian/issues/570 - -- Likewise for @iserv@ and @unlit at . + -- TODO: The @iserv@ and @unlit@ utilities live in the @lib/bin@ directory + -- instead of @bin@, which is likely just a historical accident that should + -- be fixed. See: + -- https://github.com/snowleopard/hadrian/issues/570 name <- programName context - path <- if package `elem` [iserv, touchy, unlit] + path <- if package `elem` [iserv, unlit] then stageLibPath stage <&> (-/- "bin") else stageBinPath stage return $ path -/- name <.> exe @@ -210,7 +209,7 @@ timeoutPath = "testsuite/timeout/install-inplace/bin/timeout" <.> exe -- TODO: Can we extract this information from Cabal files? -- | Some program packages should not be linked with Haskell main function. nonHsMainPackage :: Package -> Bool -nonHsMainPackage = (`elem` [hp2ps, iserv, touchy, unlit, ghciWrapper]) +nonHsMainPackage = (`elem` [hp2ps, iserv, unlit, ghciWrapper]) -- TODO: Combine this with 'programName'. -- | Path to the @autogen@ directory generated by 'buildAutogenFiles'. ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -461,7 +461,6 @@ generateSettings = do , ("ranlib command", expr $ settingsFileSetting SettingsFileSetting_RanlibCommand) , ("otool command", expr $ settingsFileSetting SettingsFileSetting_OtoolCommand) , ("install_name_tool command", expr $ settingsFileSetting SettingsFileSetting_InstallNameToolCommand) - , ("touch command", expr $ settingsFileSetting SettingsFileSetting_TouchCommand) , ("dllwrap command", expr $ settingsFileSetting SettingsFileSetting_DllWrapCommand) , ("windres command", expr $ settingsFileSetting SettingsFileSetting_WindresCommand) , ("unlit command", ("$topdir/bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) ===================================== hadrian/src/Rules/Program.hs ===================================== @@ -105,7 +105,7 @@ buildProgram bin ctx@(Context{..}) rs = do (True, s) | s > stage0InTree -> do srcDir <- buildRoot <&> (-/- (stageString stage0InTree -/- "bin")) copyFile (srcDir -/- takeFileName bin) bin - (False, s) | s > stage0InTree && (package `elem` [touchy, unlit]) -> do + (False, s) | s > stage0InTree && (package `elem` [unlit]) -> do srcDir <- stageLibPath stage0InTree <&> (-/- "bin") copyFile (srcDir -/- takeFileName bin) bin _ -> buildBinary rs bin ctx ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -105,7 +105,6 @@ stage0Packages = do ] ++ [ terminfo | not windowsHost, not cross ] ++ [ timeout | windowsHost ] - ++ [ touchy | windowsHost ] -- | Packages built in 'Stage1' by default. You can change this in "UserSettings". stage1Packages :: Action [Package] @@ -155,9 +154,8 @@ stage1Packages = do , runGhc ] , when (winTarget && not cross) - [ touchy - -- See Note [Hadrian's ghci-wrapper package] - , ghciWrapper + [ -- See Note [Hadrian's ghci-wrapper package] + ghciWrapper ] ] @@ -185,16 +183,14 @@ defaultLibraryWays = Set.fromList <$> defaultRtsWays :: Ways defaultRtsWays = Set.fromList <$> mconcat - [ pure [vanilla] + [ pure [vanilla, threaded] , notStage0 ? pure - [ profiling, debugProfiling - , debug + [ profiling, threadedProfiling, debugProfiling, threadedDebugProfiling + , debug, threadedDebug ] - , notStage0 ? targetSupportsThreadedRts ? pure [threaded, threadedProfiling, threadedDebugProfiling, threadedDebug] , notStage0 ? platformSupportsSharedLibs ? pure - [ dynamic, debugDynamic + [ dynamic, threadedDynamic, debugDynamic, threadedDebugDynamic ] - , notStage0 ? platformSupportsSharedLibs ? targetSupportsThreadedRts ? pure [ threadedDynamic, threadedDebugDynamic ] ] -- TODO: Move C source arguments here ===================================== m4/fp_settings.m4 ===================================== @@ -25,7 +25,6 @@ AC_DEFUN([FP_SETTINGS], SettingsRanlibCommand="${mingw_bin_prefix}llvm-ranlib.exe" SettingsDllWrapCommand="${mingw_bin_prefix}llvm-dllwrap.exe" SettingsWindresCommand="${mingw_bin_prefix}llvm-windres.exe" - SettingsTouchCommand='$$topdir/bin/touchy.exe' else # This case handles the "normal" platforms (e.g. not Windows) where we @@ -56,12 +55,6 @@ AC_DEFUN([FP_SETTINGS], SettingsWindresCommand="$WindresCmd" fi - if test "$HostOS" = "mingw32"; then - SettingsTouchCommand='$$topdir/bin/touchy.exe' - else - SettingsTouchCommand='touch' - fi - if test "$EnableDistroToolchain" = "YES"; then # If the user specified --enable-distro-toolchain then we just use the # executable names, not paths. @@ -123,7 +116,6 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsInstallNameToolCommand) AC_SUBST(SettingsDllWrapCommand) AC_SUBST(SettingsWindresCommand) - AC_SUBST(SettingsTouchCommand) AC_SUBST(SettingsClangCommand) AC_SUBST(SettingsLlcCommand) AC_SUBST(SettingsOptCommand) ===================================== utils/touchy/Makefile deleted ===================================== @@ -1,37 +0,0 @@ -# ----------------------------------------------------------------------------- -# -# (c) 2009 The University of Glasgow -# -# This file is part of the GHC build system. -# -# To understand how the build system works and how to modify it, see -# https://gitlab.haskell.org/ghc/ghc/wikis/building/architecture -# https://gitlab.haskell.org/ghc/ghc/wikis/building/modifying -# -# ----------------------------------------------------------------------------- - -# -# Substitute for 'touch' on win32 platforms (without an Unix toolset installed). -# -TOP=../.. -include $(TOP)/mk/boilerplate.mk - -C_SRCS=touchy.c -C_PROG=touchy -SRC_CC_OPTS += -O - -# -# Install touchy in lib/.* -# -INSTALL_LIBEXECS += $(C_PROG) - -include $(TOP)/mk/target.mk - -# Get it over with! -boot :: all - -binary-dist: - $(INSTALL_DIR) $(BIN_DIST_DIR)/utils/touchy - $(INSTALL_DATA) Makefile $(BIN_DIST_DIR)/utils/touchy/ - $(INSTALL_PROGRAM) $(C_PROG) $(BIN_DIST_DIR)/utils/touchy/ - ===================================== utils/touchy/touchy.c deleted ===================================== @@ -1,123 +0,0 @@ -/* - * Simple 'touch' program for Windows - * - */ -#if !defined(_WIN32) -#error "Win32-only, the platform you're using is supposed to have 'touch' already." -#else -#include -#include -#include -#include -#include -#include -#include - -/* -touch is used by GHC both during building and during compilation of -Haskell files. Unfortunately this means we need a 'touch' like program -in the GHC bindist. Since touch is not standard on Windows and msys2 -doesn't include a mingw-w64 build of coreutils we need touchy for now. - -With Windows 7 in a virtual box VM on OS X, some very odd things happen -with dates and time stamps when SSHing into cygwin. e.g. here the -"Change" time is in the past: - -$ date; touch foo; stat foo -Fri Dec 2 16:58:07 GMTST 2011 - File: `foo' - Size: 0 Blocks: 0 IO Block: 65536 regular -empty file -Device: 540aba0bh/1409989131d Inode: 562949953592977 Links: 1 -Access: (0644/-rw-r--r--) Uid: ( 1000/ ian) Gid: ( 513/ None) -Access: 2011-12-02 16:58:07.414457900 +0000 -Modify: 2011-12-02 16:58:07.414457900 +0000 -Change: 2011-12-02 16:58:03.495141800 +0000 - Birth: 2011-12-02 16:57:57.731469900 +0000 - -And if we copy such a file, then the copy is older (as determined by the -"Modify" time) than the original: - -$ date; touch foo; stat foo; cp foo bar; stat bar -Fri Dec 2 16:59:10 GMTST 2011 - File: `foo' - Size: 0 Blocks: 0 IO Block: 65536 regular -empty file -Device: 540aba0bh/1409989131d Inode: 1407374883725128 Links: 1 -Access: (0644/-rw-r--r--) Uid: ( 1000/ ian) Gid: ( 513/ None) -Access: 2011-12-02 16:59:10.118457900 +0000 -Modify: 2011-12-02 16:59:10.118457900 +0000 -Change: 2011-12-02 16:59:06.189477700 +0000 - Birth: 2011-12-02 16:57:57.731469900 +0000 - File: `bar' - Size: 0 Blocks: 0 IO Block: 65536 regular -empty file -Device: 540aba0bh/1409989131d Inode: 281474976882512 Links: 1 -Access: (0644/-rw-r--r--) Uid: ( 1000/ ian) Gid: ( 513/ None) -Access: 2011-12-02 16:59:06.394555800 +0000 -Modify: 2011-12-02 16:59:06.394555800 +0000 -Change: 2011-12-02 16:59:06.395532400 +0000 - Birth: 2011-12-02 16:58:40.921899600 +0000 - -This means that make thinks that things are out of date when it -shouldn't, so reinvokes itself repeatedly until the MAKE_RESTARTS -infinite-recursion test triggers. - -The touchy program, like most other programs, creates files with both -Modify and Change in the past, which is still a little odd, but is -consistent, so doesn't break make. - -We used to use _utime(argv[i],NULL)) to set the file modification times, -but after a BST -> GMT change this started giving files a modification -time an hour in the future: - -$ date; utils/touchy/dist/build/tmp/touchy testfile; stat testfile -Tue, Oct 30, 2012 11:33:06 PM - File: `testfile' - Size: 0 Blocks: 0 IO Block: 65536 regular empty file -Device: 540aba0bh/1409989131d Inode: 9851624184986293 Links: 1 -Access: (0755/-rwxr-xr-x) Uid: ( 1000/ ian) Gid: ( 513/ None) -Access: 2012-10-31 00:33:06.000000000 +0000 -Modify: 2012-10-31 00:33:06.000000000 +0000 -Change: 2012-10-30 23:33:06.769118900 +0000 - Birth: 2012-10-30 23:33:06.769118900 +0000 - -so now we use the Win32 functions GetSystemTimeAsFileTime and SetFileTime. -*/ - -int -main(int argc, char** argv) -{ - int i; - FILETIME ft; - BOOL b; - HANDLE hFile; - - if (argc == 1) { - fprintf(stderr, "Usage: %s \n", argv[0]); - return 1; - } - - for (i = 1; i < argc; i++) { - hFile = CreateFile(argv[i], GENERIC_WRITE, 0, NULL, OPEN_ALWAYS, - FILE_ATTRIBUTE_NORMAL, NULL); - if (hFile == INVALID_HANDLE_VALUE) { - fprintf(stderr, "Unable to open %s\n", argv[i]); - exit(1); - } - GetSystemTimeAsFileTime(&ft); - b = SetFileTime(hFile, (LPFILETIME) NULL, (LPFILETIME) NULL, &ft); - if (b == 0) { - fprintf(stderr, "Unable to change mod. time for %s\n", argv[i]); - exit(1); - } - b = CloseHandle(hFile); - if (b == 0) { - fprintf(stderr, "Closing failed for %s\n", argv[i]); - exit(1); - } - } - - return 0; -} -#endif ===================================== utils/touchy/touchy.cabal deleted ===================================== @@ -1,15 +0,0 @@ -cabal-version: 2.2 -Name: touchy -Version: 0.1 -Copyright: XXX -License: BSD-3-Clause -Author: XXX -Maintainer: XXX -Synopsis: @touch@ for windows -Description: XXX -Category: Development -build-type: Simple - -Executable touchy - Default-Language: Haskell2010 - Main-Is: touchy.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dd2b60ebfd790d3aabdf1a61a21039d9c706aff7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dd2b60ebfd790d3aabdf1a61a21039d9c706aff7 You're receiving 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 Jun 30 06:12:01 2023 From: gitlab at gitlab.haskell.org (Bryan R (@chreekat)) Date: Fri, 30 Jun 2023 02:12:01 -0400 Subject: [Git][ghc/ghc][wip/b/missing-prototypes] 39 commits: Support large stack frames/offsets in GHCi bytecode interpreter Message-ID: <649e72317b2b5_238a8e2e3b2d09669e@gitlab.mail> Bryan R pushed to branch wip/b/missing-prototypes at Glasgow Haskell Compiler / GHC Commits: 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - 52c174d7 by Bryan Richter at 2023-06-30T09:11:31+03:00 Add missing void prototypes to rts functions See #23561. - - - - - 30 changed files: - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - compiler/GHC/Builtin/Types.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.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 - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCon.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8c8c27863c6ff9d0eefefcbc956bbfd102d09992...52c174d71eccc5841cecec4ae80df7b87fc1db5a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8c8c27863c6ff9d0eefefcbc956bbfd102d09992...52c174d71eccc5841cecec4ae80df7b87fc1db5a You're receiving 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 Jun 30 07:59:41 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 30 Jun 2023 03:59:41 -0400 Subject: [Git][ghc/ghc][wip/T22010] Refactor Unique to be represented by Word64 Message-ID: <649e8b6db7b09_238a8e2e300101052d9@gitlab.mail> Jaro Reinders pushed to branch wip/T22010 at Glasgow Haskell Compiler / GHC Commits: 4b1e3426 by Jaro Reinders at 2023-06-30T09:59:26+02:00 Refactor Unique to be represented by Word64 In #22010 we established that Int was not always sufficient to store all the uniques we generate during compilation on 32-bit platforms. This commit addresses that problem by using Word64 instead of Int for uniques. The core of the change is in GHC.Core.Types.Unique and GHC.Core.Types.Unique.Supply. However, the representation of uniques is used in many other places, so those needed changes too. Additionally, the RTS has been extended with an atomic_inc64 operation. One major change from this commit is the introduction of the Word64Set and Word64Map data types. These are adapted versions of IntSet and IntMap from the containers package. These are planned to be upstreamed in the future. As a natural consequence of these changes, the compiler will be a bit slower and take more space on 32-bit platforms. Our CI tests indicate around a 5% residency increase. Metric Increase: CoOpt_Read CoOpt_Singletons LargeRecord ManyAlternatives ManyConstructors MultiComponentModules MultiLayerModulesTH_OneShot RecordUpdPerf T10421 T10547 T12150 T12227 T12234 T12425 T12707 T13035 T13056 T13253 T13253-spj T13379 T13386 T13719 T14683 T14766 T15164 T15703 T16577 T16875 T17516 T18140 T18223 T18282 T18304 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T3294 T4801 T5030 T5321FD T5321Fun T5631 T5642 T5837 T6048 T783 T8095 T9020 T9198 T9233 T9630 T9675 T9872a T9872b T9872b_defer T9872c T9872d T9961 TcPlugin_RewritePerf UniqLoop WWRec hard_hole_fits - - - - - 18 changed files: - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/Dataflow/Collections.hs - compiler/GHC/Cmm/Dataflow/Label.hs - compiler/GHC/Cmm/Dominators.hs - compiler/GHC/Cmm/LRegSet.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Wasm/Asm.hs - compiler/GHC/CmmToAsm/Wasm/FromCmm.hs - compiler/GHC/CmmToAsm/Wasm/Types.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Data/Graph/UnVar.hs - + compiler/GHC/Data/Word64Map.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4b1e3426720366985e7dd2e204480042856bca97 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4b1e3426720366985e7dd2e204480042856bca97 You're receiving 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 Jun 30 08:12:21 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Fri, 30 Jun 2023 04:12:21 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/supersven/imulMayOflo_x86 Message-ID: <649e8e65cdaff_238a8e2e300101079ca@gitlab.mail> Sven Tennie pushed new branch wip/supersven/imulMayOflo_x86 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/supersven/imulMayOflo_x86 You're receiving 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 Jun 30 08:24:08 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Fri, 30 Jun 2023 04:24:08 -0400 Subject: [Git][ghc/ghc][wip/supersven/imulMayOflo_x86] Add test for %mulmayoflo primop Message-ID: <649e9128830f5_238a8e2e2fffc1143a3@gitlab.mail> Sven Tennie pushed to branch wip/supersven/imulMayOflo_x86 at Glasgow Haskell Compiler / GHC Commits: de473996 by Sven Tennie at 2023-06-30T08:23:43+00:00 Add test for %mulmayoflo primop - - - - - 3 changed files: - + testsuite/tests/codeGen/should_run/MulMayOflo.hs - + testsuite/tests/codeGen/should_run/MulMayOflo_cmm.cmm - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== testsuite/tests/codeGen/should_run/MulMayOflo.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnliftedFFITypes #-} + +module Main where + +import GHC.Exts + +foreign import prim "runCmmzh" runCmmzh# :: Word# -> Word# + +main :: IO () +main = print . show $ W# (runCmmzh# 42##) ===================================== testsuite/tests/codeGen/should_run/MulMayOflo_cmm.cmm ===================================== @@ -0,0 +1,89 @@ +// Suppress empty ASSERT() optimization +#define USE_ASSERTS_ALL_WAYS 1 + +#include "Cmm.h" + +runCmmzh() { +// BEWARE: Cmm isn't really type checked. I.e. you may construct +// 256::I8, which is obviously wrong and let's to strange behaviour. + +// N.B. the contract of '%mulmayoflo' is a bit weak: +// "Return non-zero if there is any possibility that the signed multiply +// of a and b might overflow. Return zero only if you are absolutely sure +// that it won't overflow. If in doubt, return non-zero." (Stg.h) +// So, this test might be a bit too strict for some architectures as it +// expects a perfect implementation. + + // --- I8 + ASSERT(%mulmayoflo(1::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(0::I8, 0::I8) == 0::I8); + ASSERT(%mulmayoflo(-1::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(1::I8, -1::I8) == 0::I8); + ASSERT(%mulmayoflo(127::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(1::I8, 127::I8) == 0::I8); + ASSERT(%mulmayoflo(63::I8, 2::I8) == 0::I8); + ASSERT(%mulmayoflo(2::I8, 63::I8) == 0::I8); + ASSERT(%mulmayoflo(64::I8, 2::I8) > 0::I8); + ASSERT(%mulmayoflo(2::I8, 64::I8) > 0::I8); + ASSERT(%mulmayoflo(127::I8, -1::I8) == 0::I8); + ASSERT(%mulmayoflo(-1::I8, 127::I8) == 0::I8); + ASSERT(%mulmayoflo(-128::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(-64::I8, 2::I8) == 0::I8); + ASSERT(%mulmayoflo(2::I8, -64::I8) == 0::I8); + ASSERT(%mulmayoflo(-65::I8, 2::I8) > 0::I8); + ASSERT(%mulmayoflo(2::I8, -65::I8) > 0::I8); + + // --- I16 + ASSERT(%mulmayoflo(1::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(0::I16, 0::I16) == 0::I16); + ASSERT(%mulmayoflo(-1::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16, -1::I16) == 0::I16); + ASSERT(%mulmayoflo(32767::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16,32767 ::I16) == 0::I16); + ASSERT(%mulmayoflo(16383::I16, 2::I16) == 0::I16); + ASSERT(%mulmayoflo(2::I16, 16383::I16) == 0::I16); + ASSERT(%mulmayoflo(16384::I16, 2::I16) > 0::I16); + ASSERT(%mulmayoflo(2::I16, 16384::I16) > 0::I16); + ASSERT(%mulmayoflo(-16384::I16, 2::I16) == 0::I16); + ASSERT(%mulmayoflo(2::I16, -16384::I16) == 0::I16); + ASSERT(%mulmayoflo(-32768::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16, -32768::I16) == 0::I16); + + // -- I32 + ASSERT(%mulmayoflo(1::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(0::I32, 0::I32) == 0::I32); + ASSERT(%mulmayoflo(-1::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, -1::I32) == 0::I32); + ASSERT(%mulmayoflo(2147483647::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, 2147483647::I32) == 0::I32); + ASSERT(%mulmayoflo(-2147483648::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, -2147483648::I32) == 0::I32); + ASSERT(%mulmayoflo(2::I32, 1073741823::I32) == 0::I32); + ASSERT(%mulmayoflo(1073741823::I32, 2::I32) == 0::I32); + ASSERT(%mulmayoflo(2::I32, 1073741824::I32) > 0::I32); + ASSERT(%mulmayoflo(1073741824::I32, 2::I32) > 0::I32); + ASSERT(%mulmayoflo(2::I32, -1073741824::I32) == 0::I32); + ASSERT(%mulmayoflo(-1073741824::I32, 2::I32) == 0::I32); + ASSERT(%mulmayoflo(2::I32, -1073741825::I32) > 0::I32); + ASSERT(%mulmayoflo(-1073741825::I32, 2::I32) > 0::I32); + + // -- I64 + ASSERT(%mulmayoflo(1::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(0::I64, 0::I64) == 0::I64); + ASSERT(%mulmayoflo(-1::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(1::I64, -1::I64) == 0::I64); + ASSERT(%mulmayoflo(9223372036854775807::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(1::I64, 9223372036854775807::I64) == 0::I64); + ASSERT(%mulmayoflo(-9223372036854775808::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(1::I64, -9223372036854775808::I64) == 0::I64); + ASSERT(%mulmayoflo(4611686018427387903::I64, 2::I64) == 0::I64); + ASSERT(%mulmayoflo(2::I64, 4611686018427387903::I64) == 0::I64); + ASSERT(%mulmayoflo(-4611686018427387904::I64, 2::I64) == 0::I64); + ASSERT(%mulmayoflo(2::I64, -4611686018427387904::I64) == 0::I64); + ASSERT(%mulmayoflo(-4611686018427387905::I64, 2::I64) > 0::I64); + ASSERT(%mulmayoflo(2::I64, -4611686018427387905::I64) > 0::I64); + ASSERT(%mulmayoflo(4611686018427387904::I64, 2::I64) > 0::I64); + ASSERT(%mulmayoflo(2::I64, 4611686018427387904::I64) > 0::I64); + + return(0); +} ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -225,3 +225,8 @@ test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['-fregs-graph']) test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) + +test('MulMayOflo', + [ omit_ways(['ghci']), js_skip, ignore_stdout], + multi_compile_and_run, + ['MulMayOflo', [('MulMayOflo_cmm.cmm', '')], '']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/de4739961ee2d1ca2a269f77106140a444a73e90 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/de4739961ee2d1ca2a269f77106140a444a73e90 You're receiving 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 Jun 30 08:28:43 2023 From: gitlab at gitlab.haskell.org (Sven Tennie (@supersven)) Date: Fri, 30 Jun 2023 04:28:43 -0400 Subject: [Git][ghc/ghc][wip/supersven/imulMayOflo_x86] 2 commits: x86 CodeGen: Implement MO_S_MulMayOflo for W8 Message-ID: <649e923b9e889_238a8e2775ef01164f7@gitlab.mail> Sven Tennie pushed to branch wip/supersven/imulMayOflo_x86 at Glasgow Haskell Compiler / GHC Commits: 7493dad6 by Sven Tennie at 2023-06-30T08:28:22+00:00 x86 CodeGen: Implement MO_S_MulMayOflo for W8 This case wasn't handled before. But, the test-primops test suite showed that it actually might appear. - - - - - 8b601d25 by Sven Tennie at 2023-06-30T08:28:30+00:00 Add test for %mulmayoflo primop - - - - - 4 changed files: - compiler/GHC/CmmToAsm/X86/CodeGen.hs - + testsuite/tests/codeGen/should_run/MulMayOflo.hs - + testsuite/tests/codeGen/should_run/MulMayOflo_cmm.cmm - testsuite/tests/codeGen/should_run/all.T Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -966,8 +966,29 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = -- dyadic MachOps return (Fixed format eax code) - imulMayOflo :: Width -> CmmExpr -> CmmExpr -> NatM Register + imulMayOflo W8 a b = do + -- The general case (W16, W32, W64) doesn't work for W8 as its + -- multiplication doesn't use two registers. + -- + -- The plan is: + -- 1. truncate and sign-extend a and b to 8bit width + -- 2. multiply a' = a * b in 32bit width + -- 3. copy and sign-extend 8bit from a' to c + -- 4. compare a' and c: they are equal if there was no overflow + (a_reg, a_code) <- getNonClobberedReg a + (b_reg, b_code) <- getNonClobberedReg b + let + code = a_code `appOL` b_code `appOL` + toOL [ + MOVSxL II8 (OpReg a_reg) (OpReg a_reg), + MOVSxL II8 (OpReg b_reg) (OpReg b_reg), + IMUL II32 (OpReg b_reg) (OpReg a_reg), + MOVSxL II8 (OpReg a_reg) (OpReg eax), + CMP II16 (OpReg a_reg) (OpReg eax), + SETCC NE (OpReg eax) + ] + return (Fixed II8 eax code) imulMayOflo rep a b = do (a_reg, a_code) <- getNonClobberedReg a b_code <- getAnyReg b ===================================== testsuite/tests/codeGen/should_run/MulMayOflo.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnliftedFFITypes #-} + +module Main where + +import GHC.Exts + +foreign import prim "runCmmzh" runCmmzh# :: Word# -> Word# + +main :: IO () +main = print . show $ W# (runCmmzh# 42##) ===================================== testsuite/tests/codeGen/should_run/MulMayOflo_cmm.cmm ===================================== @@ -0,0 +1,89 @@ +// Suppress empty ASSERT() optimization +#define USE_ASSERTS_ALL_WAYS 1 + +#include "Cmm.h" + +runCmmzh() { +// BEWARE: Cmm isn't really type checked. I.e. you may construct +// 256::I8, which is obviously wrong and let's to strange behaviour. + +// N.B. the contract of '%mulmayoflo' is a bit weak: +// "Return non-zero if there is any possibility that the signed multiply +// of a and b might overflow. Return zero only if you are absolutely sure +// that it won't overflow. If in doubt, return non-zero." (Stg.h) +// So, this test might be a bit too strict for some architectures as it +// expects a perfect implementation. + + // --- I8 + ASSERT(%mulmayoflo(1::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(0::I8, 0::I8) == 0::I8); + ASSERT(%mulmayoflo(-1::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(1::I8, -1::I8) == 0::I8); + ASSERT(%mulmayoflo(127::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(1::I8, 127::I8) == 0::I8); + ASSERT(%mulmayoflo(63::I8, 2::I8) == 0::I8); + ASSERT(%mulmayoflo(2::I8, 63::I8) == 0::I8); + ASSERT(%mulmayoflo(64::I8, 2::I8) > 0::I8); + ASSERT(%mulmayoflo(2::I8, 64::I8) > 0::I8); + ASSERT(%mulmayoflo(127::I8, -1::I8) == 0::I8); + ASSERT(%mulmayoflo(-1::I8, 127::I8) == 0::I8); + ASSERT(%mulmayoflo(-128::I8, 1::I8) == 0::I8); + ASSERT(%mulmayoflo(-64::I8, 2::I8) == 0::I8); + ASSERT(%mulmayoflo(2::I8, -64::I8) == 0::I8); + ASSERT(%mulmayoflo(-65::I8, 2::I8) > 0::I8); + ASSERT(%mulmayoflo(2::I8, -65::I8) > 0::I8); + + // --- I16 + ASSERT(%mulmayoflo(1::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(0::I16, 0::I16) == 0::I16); + ASSERT(%mulmayoflo(-1::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16, -1::I16) == 0::I16); + ASSERT(%mulmayoflo(32767::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16,32767 ::I16) == 0::I16); + ASSERT(%mulmayoflo(16383::I16, 2::I16) == 0::I16); + ASSERT(%mulmayoflo(2::I16, 16383::I16) == 0::I16); + ASSERT(%mulmayoflo(16384::I16, 2::I16) > 0::I16); + ASSERT(%mulmayoflo(2::I16, 16384::I16) > 0::I16); + ASSERT(%mulmayoflo(-16384::I16, 2::I16) == 0::I16); + ASSERT(%mulmayoflo(2::I16, -16384::I16) == 0::I16); + ASSERT(%mulmayoflo(-32768::I16, 1::I16) == 0::I16); + ASSERT(%mulmayoflo(1::I16, -32768::I16) == 0::I16); + + // -- I32 + ASSERT(%mulmayoflo(1::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(0::I32, 0::I32) == 0::I32); + ASSERT(%mulmayoflo(-1::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, -1::I32) == 0::I32); + ASSERT(%mulmayoflo(2147483647::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, 2147483647::I32) == 0::I32); + ASSERT(%mulmayoflo(-2147483648::I32, 1::I32) == 0::I32); + ASSERT(%mulmayoflo(1::I32, -2147483648::I32) == 0::I32); + ASSERT(%mulmayoflo(2::I32, 1073741823::I32) == 0::I32); + ASSERT(%mulmayoflo(1073741823::I32, 2::I32) == 0::I32); + ASSERT(%mulmayoflo(2::I32, 1073741824::I32) > 0::I32); + ASSERT(%mulmayoflo(1073741824::I32, 2::I32) > 0::I32); + ASSERT(%mulmayoflo(2::I32, -1073741824::I32) == 0::I32); + ASSERT(%mulmayoflo(-1073741824::I32, 2::I32) == 0::I32); + ASSERT(%mulmayoflo(2::I32, -1073741825::I32) > 0::I32); + ASSERT(%mulmayoflo(-1073741825::I32, 2::I32) > 0::I32); + + // -- I64 + ASSERT(%mulmayoflo(1::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(0::I64, 0::I64) == 0::I64); + ASSERT(%mulmayoflo(-1::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(1::I64, -1::I64) == 0::I64); + ASSERT(%mulmayoflo(9223372036854775807::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(1::I64, 9223372036854775807::I64) == 0::I64); + ASSERT(%mulmayoflo(-9223372036854775808::I64, 1::I64) == 0::I64); + ASSERT(%mulmayoflo(1::I64, -9223372036854775808::I64) == 0::I64); + ASSERT(%mulmayoflo(4611686018427387903::I64, 2::I64) == 0::I64); + ASSERT(%mulmayoflo(2::I64, 4611686018427387903::I64) == 0::I64); + ASSERT(%mulmayoflo(-4611686018427387904::I64, 2::I64) == 0::I64); + ASSERT(%mulmayoflo(2::I64, -4611686018427387904::I64) == 0::I64); + ASSERT(%mulmayoflo(-4611686018427387905::I64, 2::I64) > 0::I64); + ASSERT(%mulmayoflo(2::I64, -4611686018427387905::I64) > 0::I64); + ASSERT(%mulmayoflo(4611686018427387904::I64, 2::I64) > 0::I64); + ASSERT(%mulmayoflo(2::I64, 4611686018427387904::I64) > 0::I64); + + return(0); +} ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -225,3 +225,8 @@ test('T22296',[only_ways(llvm_ways) ,unless(arch('x86_64'), skip)],compile_and_run,['']) test('T22798', expect_broken_for(23272, ['ghci-opt']), compile_and_run, ['-fregs-graph']) test('CheckBoundsOK', normal, compile_and_run, ['-fcheck-prim-bounds']) + +test('MulMayOflo', + [ omit_ways(['ghci']), js_skip, ignore_stdout], + multi_compile_and_run, + ['MulMayOflo', [('MulMayOflo_cmm.cmm', '')], '']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/de4739961ee2d1ca2a269f77106140a444a73e90...8b601d25f707b5ee5fa5dee87447d9537c7bed69 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/de4739961ee2d1ca2a269f77106140a444a73e90...8b601d25f707b5ee5fa5dee87447d9537c7bed69 You're receiving 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 Jun 30 08:38:24 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 30 Jun 2023 04:38:24 -0400 Subject: [Git][ghc/ghc][wip/T23109] 87 commits: Add -Wmissing-poly-kind-signatures Message-ID: <649e9480164ce_238a8e2e3b2d01204eb@gitlab.mail> Simon Peyton Jones pushed to branch wip/T23109 at Glasgow Haskell Compiler / GHC Commits: e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - cca1179e by Simon Peyton Jones at 2023-06-28T17:06:57+01:00 Inline more, sooner - - - - - 3dda3a5f by Simon Peyton Jones at 2023-06-28T17:06:57+01:00 One more Simplifier optimistaions Inline in exprIsConAppMaybe - - - - - a69cd79b by Simon Peyton Jones at 2023-06-28T17:06:57+01:00 Further improvements - - - - - f737fa77 by Simon Peyton Jones at 2023-06-28T22:46:14+01:00 Remove trace - - - - - a52e3c44 by Simon Peyton Jones at 2023-06-29T14:23:22+01:00 Add a strategic inline pragma - - - - - 74d7ab44 by Simon Peyton Jones at 2023-06-29T22:31:52+01:00 Two improvements to coercion optimisation One (mkSymCo) makes a big difference in GHC.Read The other (in zapSubstEnv) makes a big diffference in T18223 - - - - - a92f9cd8 by Simon Peyton Jones at 2023-06-30T08:39:30+01:00 Make newtype instances opaque I think this will help with #23109 Wibbles Allow SelCo for newtype classes Experimental change Wibble Furher wibbles Further improvments Further wibbles esp exprIsConLike Run classop rule first Newtype classops are small needs comments - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/Core/Coercion.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Expr.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/Monad.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/SimpleOpt.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/Tidy.hs - compiler/GHC/Core/TyCo/Rep.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9d4130f649066a5e77a5f718782afac024501818...a92f9cd8a58364b07938bf76b5eeb378a8191ae5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9d4130f649066a5e77a5f718782afac024501818...a92f9cd8a58364b07938bf76b5eeb378a8191ae5 You're receiving 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 Jun 30 08:39:41 2023 From: gitlab at gitlab.haskell.org (Andrei Borzenkov (@sand-witch)) Date: Fri, 30 Jun 2023 04:39:41 -0400 Subject: [Git][ghc/ghc][wip/sand-witch/pattern-@a-binders] 10 commits: Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Message-ID: <649e94cdb62eb_238a8e23136b4121320@gitlab.mail> Andrei Borzenkov pushed to branch wip/sand-witch/pattern- at a-binders at Glasgow Haskell Compiler / GHC Commits: 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - 1e5b2642 by Andrei Borzenkov at 2023-06-30T12:39:32+04:00 Draft: Type patterns (22478, 18986) Improved name resolution and type checking of type patterns in constructors: 1. HsTyPat: a new dedicated data type that represents type patterns in HsConPatDetails instead of reusing HsPatSigType 2. rnHsTyPat: a new function that renames a type pattern and collects its binders into three groups: - explicitly bound type variables, excluding locally bound variables - implicitly bound type variables from kind signatures (only if ScopedTypeVariables are enabled) - named wildcards (only from kind signatures) 2a. rnHsPatSigTypeBindingVars: removed in favour of rnHsTyPat 2b. rnImplcitTvBndrs: removed because no longer needed 3. collect_pat: updated to collect type variable binders from type patterns (this means that types and terms use the same infrastructure to detect conflicting bindings, unused variables and name shadowing) 3a. CollVarTyVarBinders: a new CollectFlag constructor that enables collection of type variables 4. tcHsTyPat: a new function that typechecks type patterns, capable of handling polymorphic kinds. See Note [Type patterns: binders and unifiers] Examples of code that is now accepted: f = \(P @a) -> \(P @a) -> ... -- triggers -Wname-shadowing g :: forall a. Proxy a -> ... g (P @a) = ... -- also triggers -Wname-shadowing h (P @($(TH.varT (TH.mkName "t")))) = ... -- t is bound at splice time j (P @(a :: (x,x))) = ... -- (x,x) is no longer rejected data T where MkT :: forall (f :: forall k. k -> Type). f Int -> f Maybe -> T k :: T -> () k (MkT @f (x :: f Int) (y :: f Maybe)) = () -- f :: forall k. k -> Type Examples of code that is rejected with better error messages: f (Left @a @a _) = ... -- new message: -- • Conflicting definitions for ‘a’ -- Bound at: Test.hs:1:11 -- Test.hs:1:14 Examples of code that is now rejected: {-# OPTIONS_GHC -Werror=unused-matches #-} f (P @a) = () -- Defined but not used: type variable ‘a’ - - - - - 5956c7bd by Andrei Borzenkov at 2023-06-30T12:39:32+04:00 Add more notes and comments to the patch - - - - - 9da7d3d5 by Andrei Borzenkov at 2023-06-30T12:39:32+04:00 Apply Simon's suggestions about documentation - - - - - 30 changed files: - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/Types.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Rename/Splice.hs-boot - compiler/GHC/Rename/Utils.hs - compiler/GHC/SysTools.hs - − compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.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/Utils/TcMType.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/19f42c6793547def0cd5d5d29a6f4a0072146a4d...9da7d3d5e775392e563b714a00f552bf9cabd887 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/19f42c6793547def0cd5d5d29a6f4a0072146a4d...9da7d3d5e775392e563b714a00f552bf9cabd887 You're receiving 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 Jun 30 09:36:11 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 30 Jun 2023 05:36:11 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/deb10-i386 Message-ID: <649ea20b70720_238a8e2775ef01488a@gitlab.mail> Matthew Pickering pushed new branch wip/deb10-i386 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/deb10-i386 You're receiving 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 Jun 30 09:39:45 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 30 Jun 2023 05:39:45 -0400 Subject: [Git][ghc/ghc][wip/deb10-i386] Try deb10 for i386 bindists Message-ID: <649ea2e16b43d_238a8e2034164151084@gitlab.mail> Matthew Pickering pushed to branch wip/deb10-i386 at Glasgow Haskell Compiler / GHC Commits: ddae1932 by Matthew Pickering at 2023-06-30T10:38:59+01:00 Try deb10 for i386 bindists - - - - - 3 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml 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: 243a00f06550e6b9a00fa0f1530d1bb761e8b7cc + DOCKER_REV: 96a18cc74ee973db95f33affaf743997774605db # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. ===================================== .gitlab/gen_ci.hs ===================================== @@ -916,7 +916,8 @@ job_groups = , standardBuilds AArch64 Darwin , standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla) , disableValidate (validateBuilds AArch64 (Linux Debian10) llvm) - , standardBuildsWithConfig I386 (Linux Debian9) (splitSectionsBroken vanilla) +-- , standardBuildsWithConfig I386 (Linux Debian9) (splitSectionsBroken vanilla) + , standardBuildsWithConfig I386 (Linux Debian10) (splitSectionsBroken vanilla) -- Fully static build, in theory usable on any linux distribution. , fullyStaticBrokenTests (standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken static)) -- Dynamically linked build, suitable for building your own static executables on alpine ===================================== .gitlab/jobs.yaml ===================================== @@ -120,7 +120,7 @@ "TEST_ENV": "aarch64-linux-deb10-validate" } }, - "i386-linux-deb9-validate": { + "i386-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -130,7 +130,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-i386-linux-deb9-validate.tar.xz", + "ghc-i386-linux-deb10-validate.tar.xz", "junit.xml" ], "reports": { @@ -139,14 +139,14 @@ "when": "always" }, "cache": { - "key": "i386-linux-deb9-$CACHE_REV", + "key": "i386-linux-deb10-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb9:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -172,10 +172,10 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", + "BIN_DIST_NAME": "ghc-i386-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", - "TEST_ENV": "i386-linux-deb9-validate" + "TEST_ENV": "i386-linux-deb10-validate" } }, "nightly-aarch64-darwin-validate": { @@ -359,7 +359,7 @@ "XZ_OPT": "-9" } }, - "nightly-i386-linux-deb9-validate": { + "nightly-i386-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -369,7 +369,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-i386-linux-deb9-validate.tar.xz", + "ghc-i386-linux-deb10-validate.tar.xz", "junit.xml" ], "reports": { @@ -378,14 +378,14 @@ "when": "always" }, "cache": { - "key": "i386-linux-deb9-$CACHE_REV", + "key": "i386-linux-deb10-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb9:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -411,10 +411,10 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", + "BIN_DIST_NAME": "ghc-i386-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", - "TEST_ENV": "i386-linux-deb9-validate", + "TEST_ENV": "i386-linux-deb10-validate", "XZ_OPT": "-9" } }, @@ -2355,7 +2355,7 @@ "XZ_OPT": "-9" } }, - "release-i386-linux-deb9-release+no_split_sections": { + "release-i386-linux-deb10-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2365,7 +2365,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-i386-linux-deb9-release+no_split_sections.tar.xz", + "ghc-i386-linux-deb10-release+no_split_sections.tar.xz", "junit.xml" ], "reports": { @@ -2374,14 +2374,14 @@ "when": "always" }, "cache": { - "key": "i386-linux-deb9-$CACHE_REV", + "key": "i386-linux-deb10-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb9:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -2407,12 +2407,12 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-i386-linux-deb9-release+no_split_sections", + "BIN_DIST_NAME": "ghc-i386-linux-deb10-release+no_split_sections", "BUILD_FLAVOUR": "release+no_split_sections", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", - "TEST_ENV": "i386-linux-deb9-release+no_split_sections", + "TEST_ENV": "i386-linux-deb10-release+no_split_sections", "XZ_OPT": "-9" } }, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ddae1932e9f6040126fdcb45c5b43542c59ddec9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ddae1932e9f6040126fdcb45c5b43542c59ddec9 You're receiving 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 Jun 30 09:41:15 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 30 Jun 2023 05:41:15 -0400 Subject: [Git][ghc/ghc][wip/deb10-i386] Try deb10 for i386 bindists Message-ID: <649ea33bdd09_238a8e2e30010155469@gitlab.mail> Matthew Pickering pushed to branch wip/deb10-i386 at Glasgow Haskell Compiler / GHC Commits: 515cdb16 by Matthew Pickering at 2023-06-30T10:41:06+01:00 Try deb10 for i386 bindists - - - - - 4 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py 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: 243a00f06550e6b9a00fa0f1530d1bb761e8b7cc + DOCKER_REV: 96a18cc74ee973db95f33affaf743997774605db # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. ===================================== .gitlab/gen_ci.hs ===================================== @@ -916,7 +916,8 @@ job_groups = , standardBuilds AArch64 Darwin , standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla) , disableValidate (validateBuilds AArch64 (Linux Debian10) llvm) - , standardBuildsWithConfig I386 (Linux Debian9) (splitSectionsBroken vanilla) +-- , standardBuildsWithConfig I386 (Linux Debian9) (splitSectionsBroken vanilla) + , standardBuildsWithConfig I386 (Linux Debian10) (splitSectionsBroken vanilla) -- Fully static build, in theory usable on any linux distribution. , fullyStaticBrokenTests (standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken static)) -- Dynamically linked build, suitable for building your own static executables on alpine ===================================== .gitlab/jobs.yaml ===================================== @@ -120,7 +120,7 @@ "TEST_ENV": "aarch64-linux-deb10-validate" } }, - "i386-linux-deb9-validate": { + "i386-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -130,7 +130,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-i386-linux-deb9-validate.tar.xz", + "ghc-i386-linux-deb10-validate.tar.xz", "junit.xml" ], "reports": { @@ -139,14 +139,14 @@ "when": "always" }, "cache": { - "key": "i386-linux-deb9-$CACHE_REV", + "key": "i386-linux-deb10-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb9:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -172,10 +172,10 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", + "BIN_DIST_NAME": "ghc-i386-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", - "TEST_ENV": "i386-linux-deb9-validate" + "TEST_ENV": "i386-linux-deb10-validate" } }, "nightly-aarch64-darwin-validate": { @@ -359,7 +359,7 @@ "XZ_OPT": "-9" } }, - "nightly-i386-linux-deb9-validate": { + "nightly-i386-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -369,7 +369,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-i386-linux-deb9-validate.tar.xz", + "ghc-i386-linux-deb10-validate.tar.xz", "junit.xml" ], "reports": { @@ -378,14 +378,14 @@ "when": "always" }, "cache": { - "key": "i386-linux-deb9-$CACHE_REV", + "key": "i386-linux-deb10-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb9:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -411,10 +411,10 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", + "BIN_DIST_NAME": "ghc-i386-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", - "TEST_ENV": "i386-linux-deb9-validate", + "TEST_ENV": "i386-linux-deb10-validate", "XZ_OPT": "-9" } }, @@ -2355,7 +2355,7 @@ "XZ_OPT": "-9" } }, - "release-i386-linux-deb9-release+no_split_sections": { + "release-i386-linux-deb10-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2365,7 +2365,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-i386-linux-deb9-release+no_split_sections.tar.xz", + "ghc-i386-linux-deb10-release+no_split_sections.tar.xz", "junit.xml" ], "reports": { @@ -2374,14 +2374,14 @@ "when": "always" }, "cache": { - "key": "i386-linux-deb9-$CACHE_REV", + "key": "i386-linux-deb10-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb9:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -2407,12 +2407,12 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-i386-linux-deb9-release+no_split_sections", + "BIN_DIST_NAME": "ghc-i386-linux-deb10-release+no_split_sections", "BUILD_FLAVOUR": "release+no_split_sections", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", - "TEST_ENV": "i386-linux-deb9-release+no_split_sections", + "TEST_ENV": "i386-linux-deb10-release+no_split_sections", "XZ_OPT": "-9" } }, ===================================== .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py ===================================== @@ -34,6 +34,7 @@ def job_triple(job_name): 'release-x86_64-linux-alpine3_12-int_native-release+fully_static': 'x86_64-alpine3_12-linux-static-int_native', 'release-x86_64-darwin-release': 'x86_64-apple-darwin', 'release-i386-linux-deb9-release': 'i386-deb9-linux', + 'release-i386-linux-deb10-release': 'i386-deb10-linux', 'release-armv7-linux-deb10-release': 'armv7-deb10-linux', 'release-aarch64-linux-deb10-release': 'aarch64-deb10-linux', 'release-aarch64-darwin-release': 'aarch64-apple-darwin', View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/515cdb16d882521b8801aa46a1d29f629cb1f0d7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/515cdb16d882521b8801aa46a1d29f629cb1f0d7 You're receiving 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 Jun 30 09:43:04 2023 From: gitlab at gitlab.haskell.org (Matthew Pickering (@mpickering)) Date: Fri, 30 Jun 2023 05:43:04 -0400 Subject: [Git][ghc/ghc][wip/deb10-i386] Try deb10 for i386 bindists Message-ID: <649ea3a8c5ff5_238a8e203416415605a@gitlab.mail> Matthew Pickering pushed to branch wip/deb10-i386 at Glasgow Haskell Compiler / GHC Commits: 62a604b6 by Matthew Pickering at 2023-06-30T10:42:47+01:00 Try deb10 for i386 bindists - - - - - 5 changed files: - .gitlab-ci.yml - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py 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: 243a00f06550e6b9a00fa0f1530d1bb761e8b7cc + DOCKER_REV: 96a18cc74ee973db95f33affaf743997774605db # Sequential version number of all cached things. # Bump to invalidate GitLab CI cache. @@ -1051,7 +1051,7 @@ ghcup-metadata-nightly: artifacts: false - job: nightly-x86_64-linux-deb9-validate artifacts: false - - job: nightly-i386-linux-deb9-validate + - job: nightly-i386-linux-deb10-validate artifacts: false - job: nightly-x86_64-linux-deb10-validate artifacts: false ===================================== .gitlab/gen_ci.hs ===================================== @@ -916,7 +916,8 @@ job_groups = , standardBuilds AArch64 Darwin , standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla) , disableValidate (validateBuilds AArch64 (Linux Debian10) llvm) - , standardBuildsWithConfig I386 (Linux Debian9) (splitSectionsBroken vanilla) +-- , standardBuildsWithConfig I386 (Linux Debian9) (splitSectionsBroken vanilla) + , standardBuildsWithConfig I386 (Linux Debian10) (splitSectionsBroken vanilla) -- Fully static build, in theory usable on any linux distribution. , fullyStaticBrokenTests (standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken static)) -- Dynamically linked build, suitable for building your own static executables on alpine ===================================== .gitlab/jobs.yaml ===================================== @@ -120,7 +120,7 @@ "TEST_ENV": "aarch64-linux-deb10-validate" } }, - "i386-linux-deb9-validate": { + "i386-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -130,7 +130,7 @@ "artifacts": { "expire_in": "2 weeks", "paths": [ - "ghc-i386-linux-deb9-validate.tar.xz", + "ghc-i386-linux-deb10-validate.tar.xz", "junit.xml" ], "reports": { @@ -139,14 +139,14 @@ "when": "always" }, "cache": { - "key": "i386-linux-deb9-$CACHE_REV", + "key": "i386-linux-deb10-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb9:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -172,10 +172,10 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", + "BIN_DIST_NAME": "ghc-i386-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", - "TEST_ENV": "i386-linux-deb9-validate" + "TEST_ENV": "i386-linux-deb10-validate" } }, "nightly-aarch64-darwin-validate": { @@ -359,7 +359,7 @@ "XZ_OPT": "-9" } }, - "nightly-i386-linux-deb9-validate": { + "nightly-i386-linux-deb10-validate": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -369,7 +369,7 @@ "artifacts": { "expire_in": "8 weeks", "paths": [ - "ghc-i386-linux-deb9-validate.tar.xz", + "ghc-i386-linux-deb10-validate.tar.xz", "junit.xml" ], "reports": { @@ -378,14 +378,14 @@ "when": "always" }, "cache": { - "key": "i386-linux-deb9-$CACHE_REV", + "key": "i386-linux-deb10-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb9:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -411,10 +411,10 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-i386-linux-deb9-validate", + "BIN_DIST_NAME": "ghc-i386-linux-deb10-validate", "BUILD_FLAVOUR": "validate", "CONFIGURE_ARGS": "", - "TEST_ENV": "i386-linux-deb9-validate", + "TEST_ENV": "i386-linux-deb10-validate", "XZ_OPT": "-9" } }, @@ -2355,7 +2355,7 @@ "XZ_OPT": "-9" } }, - "release-i386-linux-deb9-release+no_split_sections": { + "release-i386-linux-deb10-release+no_split_sections": { "after_script": [ ".gitlab/ci.sh save_cache", ".gitlab/ci.sh clean", @@ -2365,7 +2365,7 @@ "artifacts": { "expire_in": "1 year", "paths": [ - "ghc-i386-linux-deb9-release+no_split_sections.tar.xz", + "ghc-i386-linux-deb10-release+no_split_sections.tar.xz", "junit.xml" ], "reports": { @@ -2374,14 +2374,14 @@ "when": "always" }, "cache": { - "key": "i386-linux-deb9-$CACHE_REV", + "key": "i386-linux-deb10-$CACHE_REV", "paths": [ "cabal-cache", "toolchain" ] }, "dependencies": [], - "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb9:$DOCKER_REV", + "image": "registry.gitlab.haskell.org/ghc/ci-images/i386-linux-deb10:$DOCKER_REV", "needs": [ { "artifacts": false, @@ -2407,12 +2407,12 @@ ], "variables": { "BIGNUM_BACKEND": "gmp", - "BIN_DIST_NAME": "ghc-i386-linux-deb9-release+no_split_sections", + "BIN_DIST_NAME": "ghc-i386-linux-deb10-release+no_split_sections", "BUILD_FLAVOUR": "release+no_split_sections", "CONFIGURE_ARGS": "", "HADRIAN_ARGS": "--hash-unit-ids", "IGNORE_PERF_FAILURES": "all", - "TEST_ENV": "i386-linux-deb9-release+no_split_sections", + "TEST_ENV": "i386-linux-deb10-release+no_split_sections", "XZ_OPT": "-9" } }, ===================================== .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py ===================================== @@ -34,6 +34,7 @@ def job_triple(job_name): 'release-x86_64-linux-alpine3_12-int_native-release+fully_static': 'x86_64-alpine3_12-linux-static-int_native', 'release-x86_64-darwin-release': 'x86_64-apple-darwin', 'release-i386-linux-deb9-release': 'i386-deb9-linux', + 'release-i386-linux-deb10-release': 'i386-deb10-linux', 'release-armv7-linux-deb10-release': 'armv7-deb10-linux', 'release-aarch64-linux-deb10-release': 'aarch64-deb10-linux', 'release-aarch64-darwin-release': 'aarch64-apple-darwin', ===================================== .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py ===================================== @@ -191,7 +191,7 @@ def mk_new_yaml(release_mode, version, date, pipeline_type, job_map): deb10 = mk(debian("x86_64", 10)) deb11 = mk(debian("x86_64", 11)) deb10_arm64 = mk(debian("aarch64", 10)) - deb9_i386 = mk(debian("i386", 9)) + deb10_i386 = mk(debian("i386", 10)) source = mk_one_metadata(release_mode, version, job_map, source_artifact) test = mk_one_metadata(release_mode, version, job_map, test_artifact) @@ -221,10 +221,10 @@ def mk_new_yaml(release_mode, version, date, pipeline_type, job_map): } - a32 = { "Linux_Debian": { "<10": deb9_i386, "unknown_versioning": deb9_i386 } - , "Linux_Ubuntu": { "unknown_versioning": deb9_i386 } - , "Linux_Mint" : { "unknown_versioning": deb9_i386 } - , "Linux_UnknownLinux" : { "unknown_versioning": deb9_i386 } + a32 = { "Linux_Debian": { "unknown_versioning": deb10_i386 } + , "Linux_Ubuntu": { "unknown_versioning": deb10_i386 } + , "Linux_Mint" : { "unknown_versioning": deb10_i386 } + , "Linux_UnknownLinux" : { "unknown_versioning": deb10_i386 } } arm64 = { "Linux_UnknownLinux": { "unknown_versioning": deb10_arm64 } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/62a604b69545ffec1e3c53d1b2bc05bb7acbda7f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/62a604b69545ffec1e3c53d1b2bc05bb7acbda7f You're receiving 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 Jun 30 10:17:17 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 30 Jun 2023 06:17:17 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23576 Message-ID: <649eabad1fa19_238a8e2e3b2d018001a@gitlab.mail> Jaro Reinders pushed new branch wip/T23576 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23576 You're receiving 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 Jun 30 11:41:42 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 30 Jun 2023 07:41:42 -0400 Subject: [Git][ghc/ghc][wip/T23576] Allow big arith on x86 Message-ID: <649ebf762abd4_238a8e2e3001022114e@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: 82d25cc4 by Jaro Reinders at 2023-06-30T13:41:35+02:00 Allow big arith on x86 - - - - - 1 changed file: - compiler/GHC/Driver/Config/StgToCmm.hs Changes: ===================================== compiler/GHC/Driver/Config/StgToCmm.hs ===================================== @@ -50,7 +50,7 @@ initStgToCmmConfig dflags mod = StgToCmmConfig , stgToCmmDoBoundsCheck = gopt Opt_DoBoundsChecking dflags , stgToCmmDoTagCheck = gopt Opt_DoTagInferenceChecks dflags -- backend flags - , stgToCmmAllowBigArith = not ncg || platformArch platform == ArchWasm32 + , stgToCmmAllowBigArith = not ncg || platformArch platform == ArchWasm32 || platformArch platform == ArchX86 , stgToCmmAllowQuotRemInstr = ncg && (x86ish || ppc) , stgToCmmAllowQuotRem2 = (ncg && (x86ish || ppc)) || llvm , stgToCmmAllowExtendedAddSubInstrs = (ncg && (x86ish || ppc)) || llvm View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/82d25cc44ea7d0e3ab21104c5f62f397814f9bad -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/82d25cc44ea7d0e3ab21104c5f62f397814f9bad You're receiving 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 Jun 30 12:06:47 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 30 Jun 2023 08:06:47 -0400 Subject: [Git][ghc/ghc][wip/T23576] More detailed panic in iselExpr64 Message-ID: <649ec557e0b72_238a8e2e300102245bc@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: e0df4eb9 by Jaro Reinders at 2023-06-30T14:06:42+02:00 More detailed panic in iselExpr64 - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -613,7 +613,7 @@ iselExpr64 (CmmMachOp (MO_SS_Conv W32 W64) [expr]) = do iselExpr64 expr = do platform <- getPlatform - pprPanic "iselExpr64(i386)" (pdoc platform expr) + pprPanic "iselExpr64(i386)" (pdoc platform expr <+> text (show expr)) -------------------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e0df4eb943dd13807009cbc5bed5436cf27f1d5e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e0df4eb943dd13807009cbc5bed5436cf27f1d5e You're receiving 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 Jun 30 12:08:34 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 30 Jun 2023 08:08:34 -0400 Subject: [Git][ghc/ghc][wip/T23576] Better debug message attempt 2 Message-ID: <649ec5c25547_238a8e29f7ffc227169@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: ef63ff1a by Jaro Reinders at 2023-06-30T14:08:27+02:00 Better debug message attempt 2 - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -613,7 +613,7 @@ iselExpr64 (CmmMachOp (MO_SS_Conv W32 W64) [expr]) = do iselExpr64 expr = do platform <- getPlatform - pprPanic "iselExpr64(i386)" (pdoc platform expr <+> text (show expr)) + pprPanic "iselExpr64(i386)" (pdoc platform expr $+$ text (show expr)) -------------------------------------------------------------------------------- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ef63ff1a41938f5535450e765ddff314157f344c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ef63ff1a41938f5535450e765ddff314157f344c You're receiving 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 Jun 30 12:30:29 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 30 Jun 2023 08:30:29 -0400 Subject: [Git][ghc/ghc][wip/T23576] Implement negation Message-ID: <649ecae541ad_238a8e2771b70247047@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: 43921f63 by Jaro Reinders at 2023-06-30T14:30:23+02:00 Implement negation - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -610,6 +610,17 @@ iselExpr64 (CmmMachOp (MO_SS_Conv W32 W64) [expr]) = do r_dst_hi r_dst_lo +iselExpr64 (CmmMachOp (MO_S_Neg _) [expr]) = do + RegCode64 code rhi rlo <- iselExpr64 expr + Reg64 rohi rolo <- getNewReg64 + let + ocode = code `appOL` + toOL [ MOV II32 (OpReg rlo) (OpReg rolo), + XOR II32 (OpReg rohi) (OpReg rohi), + NEGI II32 (OpReg rolo), + SBB II32 (OpReg rhi) (OpReg rohi) ] + return (RegCode64 ocode rohi rolo) + iselExpr64 expr = do platform <- getPlatform View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/43921f63e9cfff96b01e2c0bf37f71f114affcd4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/43921f63e9cfff96b01e2c0bf37f71f114affcd4 You're receiving 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 Jun 30 13:09:21 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 30 Jun 2023 09:09:21 -0400 Subject: [Git][ghc/ghc][wip/T23576] Add MO_Mul case in iselExpr64 Message-ID: <649ed401e915c_238a8e29f7ffc249038@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: 84f415b4 by Jaro Reinders at 2023-06-30T15:09:14+02:00 Add MO_Mul case in iselExpr64 - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -621,6 +621,26 @@ iselExpr64 (CmmMachOp (MO_S_Neg _) [expr]) = do SBB II32 (OpReg rhi) (OpReg rohi) ] return (RegCode64 ocode rohi rolo) +iselExpr64 (CmmMachOp (MO_Mul _) [e1,e2]) = do + RegCode64 code1 r1hi r1lo <- iselExpr64 e1 + RegCode64 code2 r2hi r2lo <- iselExpr64 e2 + Reg64 rhi rlo <- getNewReg64 + let + code = code1 `appOL` + code2 `appOL` + toOL [ MOV II32 (OpReg r1lo) (OpReg eax), + MOV II32 (OpReg r2lo) (OpReg edx), + MOV II32 (OpReg r1hi) (OpReg rhi), + IMUL II32 (OpReg edx) (OpReg rhi), + MOV II32 (OpReg r2hi) (OpReg rlo), + IMUL II32 (OpReg eax) (OpReg rlo), + ADD II32 (OpReg rlo) (OpReg rhi), + MUL2 II32 (OpReg edx), + ADD II32 (OpReg edx) (OpReg rhi), + MOV II32 (OpReg eax) (OpReg rlo) + ] + return (RegCode64 code rhi rlo) + iselExpr64 expr = do platform <- getPlatform View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/84f415b41eb42dd018e5a3fac79352626403b1f1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/84f415b41eb42dd018e5a3fac79352626403b1f1 You're receiving 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 Jun 30 13:53:09 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 30 Jun 2023 09:53:09 -0400 Subject: [Git][ghc/ghc][wip/T23576] Try fixing iselExpr64 for MO_Mul Message-ID: <649ede45543ba_238a8e280c58026012f@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: fca81f47 by Jaro Reinders at 2023-06-30T15:53:02+02:00 Try fixing iselExpr64 for MO_Mul - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -625,17 +625,18 @@ iselExpr64 (CmmMachOp (MO_Mul _) [e1,e2]) = do RegCode64 code1 r1hi r1lo <- iselExpr64 e1 RegCode64 code2 r2hi r2lo <- iselExpr64 e2 Reg64 rhi rlo <- getNewReg64 + Reg64 rhi' rlo' <- getNewReg64 let code = code1 `appOL` code2 `appOL` - toOL [ MOV II32 (OpReg r1lo) (OpReg eax), - MOV II32 (OpReg r2lo) (OpReg edx), + toOL [ MOV II32 (OpReg r1lo) (OpReg rlo'), + MOV II32 (OpReg r2lo) (OpReg rhi'), MOV II32 (OpReg r1hi) (OpReg rhi), - IMUL II32 (OpReg edx) (OpReg rhi), + IMUL II32 (OpReg rhi') (OpReg rhi), MOV II32 (OpReg r2hi) (OpReg rlo), - IMUL II32 (OpReg eax) (OpReg rlo), + IMUL II32 (OpReg rlo') (OpReg rlo), ADD II32 (OpReg rlo) (OpReg rhi), - MUL2 II32 (OpReg edx), + MUL2 II32 (OpReg rhi'), ADD II32 (OpReg edx) (OpReg rhi), MOV II32 (OpReg eax) (OpReg rlo) ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fca81f47f3256c2a56823c7ee7f11425498af059 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fca81f47f3256c2a56823c7ee7f11425498af059 You're receiving 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 Jun 30 14:02:47 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 30 Jun 2023 10:02:47 -0400 Subject: [Git][ghc/ghc][wip/T23576] Fix MO_Mul some more Message-ID: <649ee0875ca4c_238a8e10ef12342620d6@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: cfac2bae by Jaro Reinders at 2023-06-30T16:02:41+02:00 Fix MO_Mul some more - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -625,23 +625,25 @@ iselExpr64 (CmmMachOp (MO_Mul _) [e1,e2]) = do RegCode64 code1 r1hi r1lo <- iselExpr64 e1 RegCode64 code2 r2hi r2lo <- iselExpr64 e2 Reg64 rhi rlo <- getNewReg64 - Reg64 rhi' rlo' <- getNewReg64 + tmp <- getNewRegNat II32 let code = code1 `appOL` code2 `appOL` - toOL [ MOV II32 (OpReg r1lo) (OpReg rlo'), - MOV II32 (OpReg r2lo) (OpReg rhi'), + toOL [ MOV II32 (OpReg r1lo) (OpReg eax), + MOV II32 (OpReg r2lo) (OpReg tmp), MOV II32 (OpReg r1hi) (OpReg rhi), - IMUL II32 (OpReg rhi') (OpReg rhi), + IMUL II32 (OpReg tmp) (OpReg rhi), MOV II32 (OpReg r2hi) (OpReg rlo), - IMUL II32 (OpReg rlo') (OpReg rlo), + IMUL II32 (OpReg eax) (OpReg rlo), ADD II32 (OpReg rlo) (OpReg rhi), - MUL2 II32 (OpReg rhi'), + MUL2 II32 (OpReg tmp), ADD II32 (OpReg edx) (OpReg rhi), MOV II32 (OpReg eax) (OpReg rlo) ] return (RegCode64 code rhi rlo) + + iselExpr64 expr = do platform <- getPlatform View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cfac2baeeef291b5caf6e43620fb956671550309 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cfac2baeeef291b5caf6e43620fb956671550309 You're receiving 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 Jun 30 14:26:09 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 30 Jun 2023 10:26:09 -0400 Subject: [Git][ghc/ghc][wip/T23576] Add AllowBigQuot option to StgToCmm Message-ID: <649ee601f00ac_238a8ec95a42652d1@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: 5c659c69 by Jaro Reinders at 2023-06-30T16:26:04+02:00 Add AllowBigQuot option to StgToCmm - - - - - 3 changed files: - compiler/GHC/Driver/Config/StgToCmm.hs - compiler/GHC/StgToCmm/Config.hs - compiler/GHC/StgToCmm/Prim.hs Changes: ===================================== compiler/GHC/Driver/Config/StgToCmm.hs ===================================== @@ -51,6 +51,7 @@ initStgToCmmConfig dflags mod = StgToCmmConfig , stgToCmmDoTagCheck = gopt Opt_DoTagInferenceChecks dflags -- backend flags , stgToCmmAllowBigArith = not ncg || platformArch platform == ArchWasm32 || platformArch platform == ArchX86 + , stgToCmmAllowBigQuot = not ncg || platformArch platform == ArchWasm32 , stgToCmmAllowQuotRemInstr = ncg && (x86ish || ppc) , stgToCmmAllowQuotRem2 = (ncg && (x86ish || ppc)) || llvm , stgToCmmAllowExtendedAddSubInstrs = (ncg && (x86ish || ppc)) || llvm ===================================== compiler/GHC/StgToCmm/Config.hs ===================================== @@ -63,6 +63,7 @@ data StgToCmmConfig = StgToCmmConfig , stgToCmmDoTagCheck :: !Bool -- ^ Verify tag inference predictions. ------------------------------ Backend Flags ---------------------------------- , stgToCmmAllowBigArith :: !Bool -- ^ Allowed to emit larger than native size arithmetic (only LLVM and C backends) + , stgToCmmAllowBigQuot :: !Bool -- ^ Allowed to emit larger than native size division operations , stgToCmmAllowQuotRemInstr :: !Bool -- ^ Allowed to generate QuotRem instructions , stgToCmmAllowQuotRem2 :: !Bool -- ^ Allowed to generate QuotRem , stgToCmmAllowExtendedAddSubInstrs :: !Bool -- ^ Allowed to generate AddWordC, SubWordC, Add2, etc. ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -1679,6 +1679,13 @@ emitPrimOp cfg primop = let stmt = mkAssign (CmmLocal res) (CmmMachOp mop args) emit stmt + isQuottishOp :: CallishMachOp -> Bool + isQuottishOp MO_I64_Quot = True + isQuottishOp MO_I64_Rem = True + isQuottishOp MO_W64_Quot = True + isQuottishOp MO_W64_Rem = True + isQuottishOp _ = False + opTranslate64 :: [CmmExpr] -> (Width -> MachOp) @@ -1687,7 +1694,8 @@ emitPrimOp cfg primop = opTranslate64 args mkMop callish = case platformWordSize platform of -- LLVM and C `can handle larger than native size arithmetic natively. - _ | stgToCmmAllowBigArith cfg -> opTranslate args $ mkMop W64 + _ | not (isQuottishOp callish), stgToCmmAllowBigArith cfg -> opTranslate args $ mkMop W64 + | isQuottishOp callish, stgToCmmAllowBigQuot cfg -> opTranslate args $ mkMop W64 PW4 -> opCallish args callish PW8 -> opTranslate args $ mkMop W64 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5c659c69f24e6264ee7b5c355ddaa48a643a3220 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5c659c69f24e6264ee7b5c355ddaa48a643a3220 You're receiving 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 Jun 30 14:33:33 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 30 Jun 2023 10:33:33 -0400 Subject: [Git][ghc/ghc][wip/T23577] 4 commits: Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Message-ID: <649ee7bd2264e_238a8ec95a42655ec@gitlab.mail> Ben Gamari pushed to branch wip/T23577 at Glasgow Haskell Compiler / GHC Commits: 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - fd3e06f6 by Ben Gamari at 2023-06-30T10:33:12-04:00 rts: Don't rely on initializers for sigaction_t As noted in #23577, CentOS's ancient toolchain throws spurious missing-field-initializer warnings. - - - - - b360c896 by Ben Gamari at 2023-06-30T10:33:12-04:00 hadrian: Don't treat -Winline warnings as fatal Such warnings are highly dependent upon the toolchain, platform, and build configuration. It's simply too fragile to rely on these. - - - - - 20 changed files: - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/DynFlags.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Linker/ExtraObj.hs - compiler/GHC/SysTools.hs - − compiler/GHC/SysTools/Info.hs - compiler/GHC/SysTools/Tasks.hs - compiler/ghc.cabal.in - docs/users_guide/9.8.1-notes.rst - docs/users_guide/using-optimisation.rst - hadrian/src/Flavour.hs - + m4/fp_link_supports_no_as_needed.m4 - m4/fptools_set_c_ld_flags.m4 - rts/posix/Signals.c - testsuite/tests/simplCore/should_compile/T8331.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -2490,6 +2490,12 @@ specArgFreeIds (SpecDict dx) = exprFreeIds dx specArgFreeIds UnspecType = emptyVarSet specArgFreeIds UnspecArg = emptyVarSet +specArgFreeVars :: SpecArg -> VarSet +specArgFreeVars (SpecType ty) = tyCoVarsOfType ty +specArgFreeVars (SpecDict dx) = exprFreeVars dx +specArgFreeVars UnspecType = emptyVarSet +specArgFreeVars UnspecArg = emptyVarSet + isSpecDict :: SpecArg -> Bool isSpecDict (SpecDict {}) = True isSpecDict _ = False @@ -2798,6 +2804,12 @@ non-dictionary bindings too. Note [Specialising polymorphic dictionaries] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Note June 2023: This has proved to be quite a tricky optimisation to get right +see (#23469, #23109, #21229, #23445) so it is now guarded by a flag +`-fpolymorphic-specialisation`. + + Consider class M a where { foo :: a -> Int } @@ -2988,14 +3000,23 @@ getTheta = fmap piTyBinderType . filter isInvisiblePiTyBinder . filter isAnonPiT ------------------------------------------------------------ -singleCall :: Id -> [SpecArg] -> UsageDetails -singleCall id args +singleCall :: SpecEnv -> Id -> [SpecArg] -> UsageDetails +singleCall spec_env id args = MkUD {ud_binds = emptyFDBs, ud_calls = unitDVarEnv id $ CIS id $ unitBag (CI { ci_key = args , ci_fvs = call_fvs }) } where - call_fvs = foldr (unionVarSet . specArgFreeIds) emptyVarSet args + call_fvs = + foldr (unionVarSet . free_var_fn) emptyVarSet args + + free_var_fn = + if gopt Opt_PolymorphicSpecialisation (se_dflags spec_env) + then specArgFreeIds + else specArgFreeVars + + + -- specArgFreeIds: we specifically look for free Ids, not TyVars -- see (MP1) in Note [Specialising polymorphic dictionaries] -- @@ -3014,7 +3035,7 @@ mkCallUDs' env f args | wantCallsFor env f -- We want it, and... , not (null ci_key) -- this call site has a useful specialisation = -- pprTrace "mkCallUDs: keeping" _trace_doc - singleCall f ci_key + singleCall env f ci_key | otherwise -- See also Note [Specialisations already covered] = -- pprTrace "mkCallUDs: discarding" _trace_doc ===================================== compiler/GHC/Driver/Backend.hs ===================================== @@ -58,8 +58,6 @@ module GHC.Driver.Backend , DefunctionalizedCodeOutput(..) -- *** Back-end functions for assembly , DefunctionalizedPostHscPipeline(..) - , DefunctionalizedAssemblerProg(..) - , DefunctionalizedAssemblerInfoGetter(..) -- *** Other back-end functions , DefunctionalizedCDefs(..) -- ** Names of back ends (for API clients of version 9.4 or earlier) @@ -94,8 +92,6 @@ module GHC.Driver.Backend , backendSupportsHpc , backendSupportsCImport , backendSupportsCExport - , backendAssemblerProg - , backendAssemblerInfoGetter , backendCDefs , backendCodeOutput , backendUseJSLinker @@ -348,40 +344,6 @@ data PrimitiveImplementation deriving Show --- | Names a function that runs the assembler, of this type: --- --- > Logger -> DynFlags -> Platform -> [Option] -> IO () --- --- The functions so named are defined in "GHC.Driver.Pipeline.Execute". - -data DefunctionalizedAssemblerProg - = StandardAssemblerProg - -- ^ Use the standard system assembler - | JSAssemblerProg - -- ^ JS Backend compile to JS via Stg, and so does not use any assembler - | DarwinClangAssemblerProg - -- ^ If running on Darwin, use the assembler from the @clang@ - -- toolchain. Otherwise use the standard system assembler. - - - --- | Names a function that discover from what toolchain the assembler --- is coming, of this type: --- --- > Logger -> DynFlags -> Platform -> IO CompilerInfo --- --- The functions so named are defined in "GHC.Driver.Pipeline.Execute". - -data DefunctionalizedAssemblerInfoGetter - = StandardAssemblerInfoGetter - -- ^ Interrogate the standard system assembler - | JSAssemblerInfoGetter - -- ^ If using the JS backend; return 'Emscripten' - | DarwinClangAssemblerInfoGetter - -- ^ If running on Darwin, return `Clang`; otherwise - -- interrogate the standard system assembler. - - -- | Names a function that generates code and writes the results to a -- file, of this type: -- @@ -767,45 +729,6 @@ backendSupportsCExport (Named JavaScript) = True backendSupportsCExport (Named Interpreter) = False backendSupportsCExport (Named NoBackend) = True --- | This (defunctionalized) function runs the assembler --- used on the code that is written by this back end. A --- program determined by a combination of back end, --- `DynFlags`, and `Platform` is run with the given --- `Option`s. --- --- The function's type is --- @ --- Logger -> DynFlags -> Platform -> [Option] -> IO () --- @ --- --- This field is usually defaulted. -backendAssemblerProg :: Backend -> DefunctionalizedAssemblerProg -backendAssemblerProg (Named NCG) = StandardAssemblerProg -backendAssemblerProg (Named LLVM) = DarwinClangAssemblerProg -backendAssemblerProg (Named ViaC) = StandardAssemblerProg -backendAssemblerProg (Named JavaScript) = JSAssemblerProg -backendAssemblerProg (Named Interpreter) = StandardAssemblerProg -backendAssemblerProg (Named NoBackend) = StandardAssemblerProg - --- | This (defunctionalized) function is used to retrieve --- an enumeration value that characterizes the C/assembler --- part of a toolchain. The function caches the info in a --- mutable variable that is part of the `DynFlags`. --- --- The function's type is --- @ --- Logger -> DynFlags -> Platform -> IO CompilerInfo --- @ --- --- This field is usually defaulted. -backendAssemblerInfoGetter :: Backend -> DefunctionalizedAssemblerInfoGetter -backendAssemblerInfoGetter (Named NCG) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named LLVM) = DarwinClangAssemblerInfoGetter -backendAssemblerInfoGetter (Named ViaC) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named JavaScript) = JSAssemblerInfoGetter -backendAssemblerInfoGetter (Named Interpreter) = StandardAssemblerInfoGetter -backendAssemblerInfoGetter (Named NoBackend) = StandardAssemblerInfoGetter - -- | When using this back end, it may be necessary or -- advisable to pass some `-D` options to a C compiler. -- This (defunctionalized) function produces those ===================================== compiler/GHC/Driver/DynFlags.hs ===================================== @@ -116,7 +116,6 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Trans.Reader (ReaderT) import Control.Monad.Trans.Writer (WriterT) -import Data.IORef import System.IO import System.IO.Error (catchIOError) import System.Environment (lookupEnv) @@ -420,15 +419,6 @@ data DynFlags = DynFlags { avx512pf :: Bool, -- Enable AVX-512 PreFetch Instructions. fma :: Bool, -- ^ Enable FMA instructions. - -- | Run-time linker information (what options we need, etc.) - rtldInfo :: IORef (Maybe LinkerInfo), - - -- | Run-time C compiler information - rtccInfo :: IORef (Maybe CompilerInfo), - - -- | Run-time assembler information - rtasmInfo :: IORef (Maybe CompilerInfo), - -- Constants used to control the amount of optimization done. -- | Max size, in bytes, of inline array allocations. @@ -490,9 +480,6 @@ class ContainsDynFlags t where initDynFlags :: DynFlags -> IO DynFlags initDynFlags dflags = do let - refRtldInfo <- newIORef Nothing - refRtccInfo <- newIORef Nothing - refRtasmInfo <- newIORef Nothing canUseUnicode <- do let enc = localeEncoding str = "‘’" (withCString enc str $ \cstr -> @@ -514,9 +501,6 @@ initDynFlags dflags = do useColor = useColor', canUseColor = stderrSupportsAnsiColors, colScheme = colScheme', - rtldInfo = refRtldInfo, - rtccInfo = refRtccInfo, - rtasmInfo = refRtasmInfo, tmpDir = TempDir tmp_dir } @@ -695,9 +679,6 @@ defaultDynFlags mySettings = avx512f = False, avx512pf = False, fma = False, - rtldInfo = panic "defaultDynFlags: no rtldInfo", - rtccInfo = panic "defaultDynFlags: no rtccInfo", - rtasmInfo = panic "defaultDynFlags: no rtasmInfo", maxInlineAllocSize = 128, maxInlineMemcpyInsns = 32, ===================================== compiler/GHC/Driver/Flags.hs ===================================== @@ -257,6 +257,7 @@ data GeneralFlag | Opt_Specialise | Opt_SpecialiseAggressively | Opt_CrossModuleSpecialise + | Opt_PolymorphicSpecialisation | Opt_InlineGenerics | Opt_InlineGenericsAggressively | Opt_StaticArgumentTransformation ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -110,7 +110,6 @@ module GHC.Driver.Main import GHC.Prelude import GHC.Platform -import GHC.Platform.Ways import GHC.Driver.Plugins import GHC.Driver.Session @@ -345,41 +344,11 @@ initHscEnv mb_top_dir = do mySettings <- initSysTools top_dir dflags <- initDynFlags (defaultDynFlags mySettings) hsc_env <- newHscEnv top_dir dflags - checkBrokenTablesNextToCode (hsc_logger hsc_env) dflags setUnsafeGlobalDynFlags dflags -- c.f. DynFlags.parseDynamicFlagsFull, which -- creates DynFlags and sets the UnsafeGlobalDynFlags return hsc_env --- | The binutils linker on ARM emits unnecessary R_ARM_COPY relocations which --- breaks tables-next-to-code in dynamically linked modules. This --- check should be more selective but there is currently no released --- version where this bug is fixed. --- See https://sourceware.org/bugzilla/show_bug.cgi?id=16177 and --- https://gitlab.haskell.org/ghc/ghc/issues/4210#note_78333 -checkBrokenTablesNextToCode :: Logger -> DynFlags -> IO () -checkBrokenTablesNextToCode logger dflags = do - let invalidLdErr = "Tables-next-to-code not supported on ARM \ - \when using binutils ld (please see: \ - \https://sourceware.org/bugzilla/show_bug.cgi?id=16177)" - broken <- checkBrokenTablesNextToCode' logger dflags - when broken (panic invalidLdErr) - -checkBrokenTablesNextToCode' :: Logger -> DynFlags -> IO Bool -checkBrokenTablesNextToCode' logger dflags - | not (isARM arch) = return False - | ways dflags `hasNotWay` WayDyn = return False - | not tablesNextToCode = return False - | otherwise = do - linkerInfo <- liftIO $ GHC.SysTools.getLinkerInfo logger dflags - case linkerInfo of - GnuLD _ -> return True - _ -> return False - where platform = targetPlatform dflags - arch = platformArch platform - tablesNextToCode = platformTablesNextToCode platform - - -- ----------------------------------------------------------------------------- getDiagnostics :: Hsc (Messages GhcMessage) ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -287,12 +287,6 @@ runAsPhase :: Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO F runAsPhase with_cpp pipe_env hsc_env location input_fn = do let dflags = hsc_dflags hsc_env let logger = hsc_logger hsc_env - let unit_env = hsc_unit_env hsc_env - let platform = ue_platform unit_env - - -- LLVM from version 3.0 onwards doesn't support the OS X system - -- assembler, so we use clang as the assembler instead. (#5636) - let as_prog = applyAssemblerProg $ backendAssemblerProg (backend dflags) let cmdline_include_paths = includePaths dflags let pic_c_flags = picCCOpts dflags @@ -310,9 +304,8 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do includePathsQuoteImplicit cmdline_include_paths] let runAssembler inputFilename outputFilename = withAtomicRename outputFilename $ \temp_outputFilename -> - as_prog + runAs logger dflags - platform (local_includes ++ global_includes -- See Note [-fPIC for assembler] ++ map GHC.SysTools.Option pic_c_flags @@ -392,22 +385,6 @@ runForeignJsPhase pipe_env hsc_env _location input_fn = do embedJsFile logger dflags tmpfs unit_env input_fn output_fn return output_fn - -applyAssemblerProg - :: DefunctionalizedAssemblerProg - -> Logger -> DynFlags -> Platform -> [Option] -> IO () -applyAssemblerProg StandardAssemblerProg logger dflags _platform = - runAs logger dflags -applyAssemblerProg JSAssemblerProg logger dflags _platform = - runEmscripten logger dflags -applyAssemblerProg DarwinClangAssemblerProg logger dflags platform = - if platformOS platform == OSDarwin then - runClang logger dflags - else - runAs logger dflags - - - runCcPhase :: Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO FilePath runCcPhase cc_phase pipe_env hsc_env location input_fn = do let dflags = hsc_dflags hsc_env ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -2432,6 +2432,7 @@ fFlagsDeps = [ flagSpec "specialize-aggressively" Opt_SpecialiseAggressively, flagSpec "cross-module-specialise" Opt_CrossModuleSpecialise, flagSpec "cross-module-specialize" Opt_CrossModuleSpecialise, + flagSpec "polymorphic-specialisation" Opt_PolymorphicSpecialisation, flagSpec "inline-generics" Opt_InlineGenerics, flagSpec "inline-generics-aggressively" Opt_InlineGenericsAggressively, flagSpec "static-argument-transformation" Opt_StaticArgumentTransformation, ===================================== compiler/GHC/Linker/ExtraObj.hs ===================================== @@ -12,7 +12,6 @@ module GHC.Linker.ExtraObj , mkNoteObjsToLinkIntoBinary , checkLinkInfo , getLinkInfo - , getCompilerInfo , ghcLinkInfoSectionName , ghcLinkInfoNoteName , platformSupportsSavingLinkOpts @@ -40,10 +39,8 @@ import qualified GHC.Data.ShortText as ST import GHC.SysTools.Elf import GHC.SysTools.Tasks -import GHC.SysTools.Info import GHC.Linker.Unit -import Control.Monad.IO.Class import Control.Monad import Data.Maybe @@ -52,7 +49,6 @@ mkExtraObj logger tmpfs dflags unit_state extn xs = do cFile <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule extn oFile <- newTempName logger tmpfs (tmpDir dflags) TFL_GhcSession "o" writeFile cFile xs - ccInfo <- liftIO $ getCompilerInfo logger dflags runCc Nothing logger tmpfs dflags ([Option "-c", FileOption "" cFile, @@ -60,7 +56,7 @@ mkExtraObj logger tmpfs dflags unit_state extn xs FileOption "" oFile] ++ if extn /= "s" then cOpts - else asmOpts ccInfo) + else []) return oFile where -- Pass a different set of options to the C compiler depending one whether @@ -70,14 +66,6 @@ mkExtraObj logger tmpfs dflags unit_state extn xs ++ map (FileOption "-I" . ST.unpack) (unitIncludeDirs $ unsafeLookupUnit unit_state rtsUnit) - -- When compiling assembler code, we drop the usual C options, and if the - -- compiler is Clang, we add an extra argument to tell Clang to ignore - -- unused command line options. See trac #11684. - asmOpts ccInfo = - if any (ccInfo ==) [Clang, AppleClang, AppleClang51] - then [Option "-Qunused-arguments"] - else [] - -- When linking a binary, we need to create a C main() function that -- starts everything off. This used to be compiled statically as part -- of the RTS, but that made it hard to change the -rtsopts setting, ===================================== compiler/GHC/SysTools.hs ===================================== @@ -17,7 +17,6 @@ module GHC.SysTools ( -- * Interface to system tools module GHC.SysTools.Tasks, - module GHC.SysTools.Info, -- * Fast file copy copyFile, @@ -35,8 +34,6 @@ import GHC.Prelude import GHC.Utils.Panic import GHC.Driver.Session -import GHC.Linker.ExtraObj -import GHC.SysTools.Info import GHC.SysTools.Tasks import GHC.SysTools.BaseDir import GHC.Settings.IO ===================================== compiler/GHC/SysTools/Info.hs deleted ===================================== @@ -1,243 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables #-} ------------------------------------------------------------------------------ --- --- Compiler information functions --- --- (c) The GHC Team 2017 --- ------------------------------------------------------------------------------ -module GHC.SysTools.Info where - -import GHC.Utils.Exception -import GHC.Utils.Error -import GHC.Driver.Session -import GHC.Utils.Outputable -import GHC.Utils.Misc -import GHC.Utils.Logger - -import Data.List ( isInfixOf, isPrefixOf ) -import Data.IORef - -import System.IO - -import GHC.Platform -import GHC.Prelude - -import GHC.SysTools.Process - -{- Note [Run-time linker info] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~ -See also: #5240, #6063, #10110 - -Before 'runLink', we need to be sure to get the relevant information -about the linker we're using at runtime to see if we need any extra -options. - -Generally, the linker changing from what was detected at ./configure -time has always been possible using -pgml, but on Linux it can happen -'transparently' by installing packages like binutils-gold, which -change what /usr/bin/ld actually points to. - -Clang vs GCC notes: - -For gcc, 'gcc -Wl,--version' gives a bunch of output about how to -invoke the linker before the version information string. For 'clang', -the version information for 'ld' is all that's output. For this -reason, we typically need to slurp up all of the standard error output -and look through it. - -Other notes: - -We cache the LinkerInfo inside DynFlags, since clients may link -multiple times. The definition of LinkerInfo is there to avoid a -circular dependency. - --} - -{- Note [ELF needed shared libs] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Some distributions change the link editor's default handling of -ELF DT_NEEDED tags to include only those shared objects that are -needed to resolve undefined symbols. For Template Haskell we need -the last temporary shared library also if it is not needed for the -currently linked temporary shared library. We specify --no-as-needed -to override the default. This flag exists in GNU ld and GNU gold. - -The flag is only needed on ELF systems. On Windows (PE) and Mac OS X -(Mach-O) the flag is not needed. - --} - -neededLinkArgs :: LinkerInfo -> [Option] -neededLinkArgs (GnuLD o) = o -neededLinkArgs (Mold o) = o -neededLinkArgs (GnuGold o) = o -neededLinkArgs (LlvmLLD o) = o -neededLinkArgs (DarwinLD o) = o -neededLinkArgs (SolarisLD o) = o -neededLinkArgs (AixLD o) = o -neededLinkArgs UnknownLD = [] - --- Grab linker info and cache it in DynFlags. -getLinkerInfo :: Logger -> DynFlags -> IO LinkerInfo -getLinkerInfo logger dflags = do - info <- readIORef (rtldInfo dflags) - case info of - Just v -> return v - Nothing -> do - v <- getLinkerInfo' logger dflags - writeIORef (rtldInfo dflags) (Just v) - return v - --- See Note [Run-time linker info]. -getLinkerInfo' :: Logger -> DynFlags -> IO LinkerInfo -getLinkerInfo' logger dflags = do - let platform = targetPlatform dflags - os = platformOS platform - (pgm,args0) = pgm_l dflags - args1 = map Option (getOpts dflags opt_l) - args2 = args0 ++ args1 - args3 = filter notNull (map showOpt args2) - - -- Try to grab the info from the process output. - parseLinkerInfo stdo _stde _exitc - | any ("GNU ld" `isPrefixOf`) stdo = - -- Set DT_NEEDED for all shared libraries. #10110. - return (GnuLD $ map Option [-- ELF specific flag - -- 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] - return (GnuGold [Option "-Wl,--no-as-needed"]) - - | any (\line -> "LLD" `isPrefixOf` line || "LLD" `elem` words line) stdo = - return (LlvmLLD $ map Option [ --see Note [ELF needed shared libs] - "-Wl,--no-as-needed" | osElfTarget os || os == OSMinGW32 ]) - - -- Unknown linker. - | otherwise = fail "invalid --version output, or linker is unsupported" - - -- Process the executable call - catchIO ( - case os of - OSSolaris2 -> - -- Solaris uses its own Solaris linker. Even all - -- GNU C are recommended to configure with Solaris - -- linker instead of using GNU binutils linker. Also - -- all GCC distributed with Solaris follows this rule - -- precisely so we assume here, the Solaris linker is - -- used. - return $ SolarisLD [] - OSAIX -> - -- IBM AIX uses its own non-binutils linker as well - return $ AixLD [] - OSDarwin -> - -- Darwin has neither GNU Gold or GNU LD, but a strange linker - -- that doesn't support --version. We can just assume that's - -- what we're using. - return $ DarwinLD [] - OSMinGW32 -> - -- GHC doesn't support anything but GNU ld on Windows anyway. - -- Process creation is also fairly expensive on win32, so - -- we short-circuit here. - return $ GnuLD $ map Option - [ -- Emit stack checks - -- See Note [Windows stack allocations] - "-fstack-check" - ] - _ -> do - -- In practice, we use the compiler as the linker here. Pass - -- -Wl,--version to get linker version info. - (exitc, stdo, stde) <- readProcessEnvWithExitCode pgm - (["-Wl,--version"] ++ args3) - c_locale_env - -- Split the output by lines to make certain kinds - -- of processing easier. In particular, 'clang' and 'gcc' - -- have slightly different outputs for '-Wl,--version', but - -- it's still easy to figure out. - parseLinkerInfo (lines stdo) (lines stde) exitc - ) - (\err -> do - debugTraceMsg logger 2 - (text "Error (figuring out linker information):" <+> - text (show err)) - errorMsg logger $ hang (text "Warning:") 9 $ - text "Couldn't figure out linker information!" $$ - text "Make sure you're using GNU ld, GNU gold" <+> - text "or the built in OS X linker, etc." - return UnknownLD - ) - --- | Grab compiler info and cache it in DynFlags. -getCompilerInfo :: Logger -> DynFlags -> IO CompilerInfo -getCompilerInfo logger dflags = do - info <- readIORef (rtccInfo dflags) - case info of - Just v -> return v - Nothing -> do - let pgm = pgm_c dflags - v <- getCompilerInfo' logger pgm - writeIORef (rtccInfo dflags) (Just v) - return v - --- | Grab assembler info and cache it in DynFlags. -getAssemblerInfo :: Logger -> DynFlags -> IO CompilerInfo -getAssemblerInfo logger dflags = do - info <- readIORef (rtasmInfo dflags) - case info of - Just v -> return v - Nothing -> do - let (pgm, _) = pgm_a dflags - v <- getCompilerInfo' logger pgm - writeIORef (rtasmInfo dflags) (Just v) - return v - --- See Note [Run-time linker info]. -getCompilerInfo' :: Logger -> String -> IO CompilerInfo -getCompilerInfo' logger pgm = do - let -- Try to grab the info from the process output. - parseCompilerInfo _stdo stde _exitc - -- Regular GCC - | any ("gcc version" `isInfixOf`) stde = - return GCC - -- Regular clang - | any ("clang version" `isInfixOf`) stde = - return Clang - -- FreeBSD clang - | any ("FreeBSD clang version" `isInfixOf`) stde = - return Clang - -- Xcode 5.1 clang - | any ("Apple LLVM version 5.1" `isPrefixOf`) stde = - return AppleClang51 - -- Xcode 5 clang - | any ("Apple LLVM version" `isPrefixOf`) stde = - return AppleClang - -- Xcode 4.1 clang - | any ("Apple clang version" `isPrefixOf`) stde = - return AppleClang - -- Unknown compiler. - | otherwise = fail $ "invalid -v output, or compiler is unsupported (" ++ pgm ++ "): " ++ unlines stde - - -- Process the executable call - catchIO (do - (exitc, stdo, stde) <- - readProcessEnvWithExitCode pgm ["-v"] c_locale_env - -- Split the output by lines to make certain kinds - -- of processing easier. - parseCompilerInfo (lines stdo) (lines stde) exitc - ) - (\err -> do - debugTraceMsg logger 2 - (text "Error (figuring out C compiler information):" <+> - text (show err)) - errorMsg logger $ hang (text "Warning:") 9 $ - text "Couldn't figure out C compiler information!" $$ - text "Make sure you're using GNU gcc, or clang" - return UnknownCC - ) ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -19,7 +19,6 @@ import GHC.CmmToLlvm.Config (LlvmVersion, llvmVersionStr, supportedLlvmVersionUp import GHC.Settings import GHC.SysTools.Process -import GHC.SysTools.Info import GHC.Driver.Session @@ -292,15 +291,12 @@ figureLlvmVersion logger dflags = traceSystoolCommand logger "llc" $ do runLink :: Logger -> TmpFs -> DynFlags -> [Option] -> IO () runLink logger tmpfs dflags args = traceSystoolCommand logger "linker" $ do - -- See Note [Run-time linker info] - -- -- `-optl` args come at the end, so that later `-l` options -- given there manually can fill in symbols needed by -- Haskell libraries coming in via `args`. - linkargs <- neededLinkArgs `fmap` getLinkerInfo logger dflags let (p,args0) = pgm_l dflags optl_args = map Option (getOpts dflags opt_l) - args2 = args0 ++ linkargs ++ args ++ optl_args + args2 = args0 ++ args ++ optl_args mb_env <- getGccEnv args2 runSomethingResponseFile logger tmpfs dflags ld_filter "Linker" p args2 mb_env where ===================================== compiler/ghc.cabal.in ===================================== @@ -715,7 +715,6 @@ Library GHC.SysTools.BaseDir GHC.SysTools.Cpp GHC.SysTools.Elf - GHC.SysTools.Info GHC.SysTools.Process GHC.SysTools.Tasks GHC.SysTools.Terminal ===================================== docs/users_guide/9.8.1-notes.rst ===================================== @@ -174,11 +174,16 @@ Compiler D(D2) ) D = D1 | D2 - + This allows for changing the structure of a library without immediately breaking user code, but instead being able to warn the user that a change in the library interface will occur in the future. +- Guard polymorphic specialisation behind the flag :ghc-flag:`-fpolymorphic-specialisation`. + This optimisation has led to a number of incorrect runtime result bugs, so we are disabling it + by default for now whilst we consider more carefully an appropiate fix. + (See :ghc-ticket:`23469`, :ghc-ticket:`23109`, :ghc-ticket:`21229`, :ghc-ticket:`23445`) + GHCi ~~~~ @@ -241,8 +246,8 @@ Runtime system We use this functionality in GHCi to modify how some messages are displayed. - The extensions fields of constructors of ``IE`` now take ``Maybe (WarningTxt p)`` - in ``GhcPs`` and ``GhcRn`` variants of the Syntax Tree. - This represents the warning assigned to a certain export item, + in ``GhcPs`` and ``GhcRn`` variants of the Syntax Tree. + This represents the warning assigned to a certain export item, which is used for :ref:`deprecated-exports`. ``ghc-heap`` library ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -1113,6 +1113,21 @@ as such you shouldn't need to set any of them explicitly. A flag which they are called in this module. Note that specialisation must be enabled (by ``-fspecialise``) for this to have any effect. +.. ghc-flag:: -fpolymorphic-specialisation + :shortdesc: Allow specialisation to abstract over free type variables + :type: dynamic + :reverse: -fno-polymorphic-specialisation + :category: + + :default: off + + Warning, this feature is highly experimental and may lead to incorrect runtime + results. Use at your own risk (:ghc-ticket:`23469`, :ghc-ticket:`23109`, :ghc-ticket:`21229`, :ghc-ticket:`23445`). + + Enable specialisation of function calls to known dictionaries with free type variables. + The created specialisation will abstract over the type variables free in the dictionary. + + .. ghc-flag:: -flate-specialise :shortdesc: Run a late specialisation pass :type: dynamic ===================================== hadrian/src/Flavour.hs ===================================== @@ -138,6 +138,8 @@ werror = [ arg "-optc-Werror" -- clang complains about #pragma GCC pragmas , arg "-optc-Wno-error=unknown-pragmas" + -- rejected inlinings are highly dependent upon toolchain and way + , arg "-optc-Wno-error=inline" ] -- N.B. We currently don't build the boot libraries' C sources with -Werror -- as this tends to be a portability nightmare. ===================================== m4/fp_link_supports_no_as_needed.m4 ===================================== @@ -0,0 +1,33 @@ +# FP_LINK_SUPPORTS_NO_AS_NEEDED +# ---------------------------------- +# Set the Cc linker flag -Wl,--no-as-needed if it is supported +# $1 is the name of the linker flags variable when linking with gcc +# See also Note [ELF needed shared libs] +AC_DEFUN([FP_LINK_SUPPORTS_NO_AS_NEEDED], +[ + AC_MSG_CHECKING([whether Cc linker supports -Wl,--no-as-needed]) + echo 'int f(int a) {return 2*a;}' > conftest.a.c + echo 'int f(int a); int main(int argc, char **argv) {return f(0);}' > conftest.b.c + $CC -c -o conftest.a.o conftest.a.c > /dev/null 2>&1 + $CC -c -o conftest.b.o conftest.b.c > /dev/null 2>&1 + if "$CC" "$$1" -Wl,--no-as-needed -o conftest conftest.a.o conftest.b.o > /dev/null 2>&1 + then + $1="$$1 -Wl,--no-as-needed" + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + fi + rm -f conftest* +]) + +# Note [ELF needed shared libs] +# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# Some distributions change the link editor's default handling of +# ELF DT_NEEDED tags to include only those shared objects that are +# needed to resolve undefined symbols. For Template Haskell we need +# the last temporary shared library also if it is not needed for the +# currently linked temporary shared library. We specify --no-as-needed +# to override the default. This flag exists in GNU ld and GNU gold. +# +# The flag is only needed on ELF systems. On Windows (PE) and Mac OS X +# (Mach-O) the flag is not needed. ===================================== m4/fptools_set_c_ld_flags.m4 ===================================== @@ -17,6 +17,21 @@ AC_DEFUN([FPTOOLS_SET_C_LD_FLAGS], ;; esac + # See Note [ELF needed shared libs] + case $$1 in + *-linux|*-freebsd*) + FP_LINK_SUPPORTS_NO_AS_NEEDED([$3]) + ;; + esac + + # Emit stack checks + # See Note [Windows stack allocations] + case $$1 in + *-mingw32*) + $3="$$3 -fstack-check" + ;; + esac + case $$1 in i386-unknown-mingw32) $2="$$2 -march=i686" ===================================== rts/posix/Signals.c ===================================== @@ -368,9 +368,11 @@ int stg_sig_install(int sig, int spi, void *mask) { sigset_t signals, osignals; - struct sigaction action; StgInt previous_spi; + struct sigaction action; + memset(&action, 0, sizeof(struct sigaction)); + ACQUIRE_LOCK(&sig_mutex); // Block the signal until we figure out what to do @@ -619,6 +621,7 @@ static void set_sigtstp_action (bool handle) { struct sigaction sa; + memset(&sa, 0, sizeof(struct sigaction)); if (handle) { sa.sa_handler = sigtstp_handler; } else { @@ -635,7 +638,8 @@ set_sigtstp_action (bool handle) void install_vtalrm_handler(int sig, TickProc handle_tick) { - struct sigaction action = {}; + struct sigaction action; + memset(&action, 0, sizeof(struct sigaction)); action.sa_handler = handle_tick; @@ -677,8 +681,11 @@ install_vtalrm_handler(int sig, TickProc handle_tick) void initDefaultHandlers(void) { - struct sigaction action = {}; - struct sigaction oact = {}; + // N.B. We can't use initializers here as CentOS's ancient toolchain throws + // spurious warnings. See #23577. + struct sigaction action, oact; + memset(&oact, 0, sizeof(struct sigaction)); + memset(&action, 0, sizeof(struct sigaction)); // install the SIGINT handler action.sa_handler = shutdown_handler; ===================================== testsuite/tests/simplCore/should_compile/T8331.stderr ===================================== @@ -1,149 +1,5 @@ ==================== Tidy Core rules ==================== -"SPEC $c*> @(ST s) @_" - forall (@s) (@r) ($dApplicative :: Applicative (ST s)). - $fApplicativeReaderT_$c*> @(ST s) @r $dApplicative - = ($fApplicativeReaderT2 @s @r) - `cast` (forall (a :: <*>_N) (b :: <*>_N). - _R - %<'Many>_N ->_R _R - %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) - ; Sym (N:ReaderT[0] <*>_N _R _R _N) - :: Coercible - (forall {a} {b}. - ReaderT r (ST s) a -> ReaderT r (ST s) b -> r -> STRep s b) - (forall {a} {b}. - ReaderT r (ST s) a -> ReaderT r (ST s) b -> ReaderT r (ST s) b)) -"SPEC $c<$ @(ST s) @_" - forall (@s) (@r) ($dFunctor :: Functor (ST s)). - $fFunctorReaderT_$c<$ @(ST s) @r $dFunctor - = ($fApplicativeReaderT6 @s @r) - `cast` (forall (a :: <*>_N) (b :: <*>_N). - _R - %<'Many>_N ->_R _R - %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) - ; Sym (N:ReaderT[0] <*>_N _R _R _N) - :: Coercible - (forall {a} {b}. a -> ReaderT r (ST s) b -> r -> STRep s a) - (forall {a} {b}. a -> ReaderT r (ST s) b -> ReaderT r (ST s) a)) -"SPEC $c<* @(ST s) @_" - forall (@s) (@r) ($dApplicative :: Applicative (ST s)). - $fApplicativeReaderT_$c<* @(ST s) @r $dApplicative - = ($fApplicativeReaderT1 @s @r) - `cast` (forall (a :: <*>_N) (b :: <*>_N). - _R - %<'Many>_N ->_R _R - %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) - ; Sym (N:ReaderT[0] <*>_N _R _R _N) - :: Coercible - (forall {a} {b}. - ReaderT r (ST s) a -> ReaderT r (ST s) b -> r -> STRep s a) - (forall {a} {b}. - ReaderT r (ST s) a -> ReaderT r (ST s) b -> ReaderT r (ST s) a)) -"SPEC $c<*> @(ST s) @_" - forall (@s) (@r) ($dApplicative :: Applicative (ST s)). - $fApplicativeReaderT9 @(ST s) @r $dApplicative - = ($fApplicativeReaderT4 @s @r) - `cast` (forall (a :: <*>_N) (b :: <*>_N). - b)>_R - %<'Many>_N ->_R _R - %<'Many>_N ->_R _R - %<'Many>_N ->_R Sym (N:ST[0] _N _R) - :: Coercible - (forall {a} {b}. - ReaderT r (ST s) (a -> b) -> ReaderT r (ST s) a -> r -> STRep s b) - (forall {a} {b}. - ReaderT r (ST s) (a -> b) -> ReaderT r (ST s) a -> r -> ST s b)) -"SPEC $c>> @(ST s) @_" - forall (@s) (@r) ($dMonad :: Monad (ST s)). - $fMonadReaderT1 @(ST s) @r $dMonad - = $fMonadAbstractIOSTReaderT_$s$c>> @s @r -"SPEC $c>>= @(ST s) @_" - forall (@s) (@r) ($dMonad :: Monad (ST s)). - $fMonadReaderT2 @(ST s) @r $dMonad - = ($fMonadAbstractIOSTReaderT2 @s @r) - `cast` (forall (a :: <*>_N) (b :: <*>_N). - _R - %<'Many>_N ->_R ReaderT r (ST s) b>_R - %<'Many>_N ->_R _R - %<'Many>_N ->_R Sym (N:ST[0] _N _R) - :: Coercible - (forall {a} {b}. - ReaderT r (ST s) a -> (a -> ReaderT r (ST s) b) -> r -> STRep s b) - (forall {a} {b}. - ReaderT r (ST s) a -> (a -> ReaderT r (ST s) b) -> r -> ST s b)) -"SPEC $cfmap @(ST s) @_" - forall (@s) (@r) ($dFunctor :: Functor (ST s)). - $fFunctorReaderT_$cfmap @(ST s) @r $dFunctor - = ($fApplicativeReaderT7 @s @r) - `cast` (forall (a :: <*>_N) (b :: <*>_N). - b>_R - %<'Many>_N ->_R _R - %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) - ; Sym (N:ReaderT[0] <*>_N _R _R _N) - :: Coercible - (forall {a} {b}. (a -> b) -> ReaderT r (ST s) a -> r -> STRep s b) - (forall {a} {b}. - (a -> b) -> ReaderT r (ST s) a -> ReaderT r (ST s) b)) -"SPEC $cliftA2 @(ST s) @_" - forall (@s) (@r) ($dApplicative :: Applicative (ST s)). - $fApplicativeReaderT_$cliftA2 @(ST s) @r $dApplicative - = ($fApplicativeReaderT3 @s @r) - `cast` (forall (a :: <*>_N) (b :: <*>_N) (c :: <*>_N). - b -> c>_R - %<'Many>_N ->_R _R - %<'Many>_N ->_R _R - %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) - ; Sym (N:ReaderT[0] <*>_N _R _R _N) - :: Coercible - (forall {a} {b} {c}. - (a -> b -> c) - -> ReaderT r (ST s) a -> ReaderT r (ST s) b -> r -> STRep s c) - (forall {a} {b} {c}. - (a -> b -> c) - -> ReaderT r (ST s) a -> ReaderT r (ST s) b -> ReaderT r (ST s) c)) -"SPEC $cp1Applicative @(ST s) @_" - forall (@s) (@r) ($dApplicative :: Applicative (ST s)). - $fApplicativeReaderT_$cp1Applicative @(ST s) @r $dApplicative - = $fApplicativeReaderT_$s$fFunctorReaderT @s @r -"SPEC $cp1Monad @(ST s) @_" - forall (@s) (@r) ($dMonad :: Monad (ST s)). - $fMonadReaderT_$cp1Monad @(ST s) @r $dMonad - = $fApplicativeReaderT_$s$fApplicativeReaderT @s @r -"SPEC $cpure @(ST s) @_" - forall (@s) (@r) ($dApplicative :: Applicative (ST s)). - $fApplicativeReaderT_$cpure @(ST s) @r $dApplicative - = ($fApplicativeReaderT5 @s @r) - `cast` (forall (a :: <*>_N). - _R - %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) - ; Sym (N:ReaderT[0] <*>_N _R _R _N) - :: Coercible - (forall {a}. a -> r -> STRep s a) - (forall {a}. a -> ReaderT r (ST s) a)) -"SPEC $creturn @(ST s) @_" - forall (@s) (@r) ($dMonad :: Monad (ST s)). - $fMonadReaderT_$creturn @(ST s) @r $dMonad - = ($fApplicativeReaderT5 @s @r) - `cast` (forall (a :: <*>_N). - _R - %<'Many>_N ->_R _R %<'Many>_N ->_R Sym (N:ST[0] _N _R) - ; Sym (N:ReaderT[0] <*>_N _R _R _N) - :: Coercible - (forall {a}. a -> r -> STRep s a) - (forall {a}. a -> ReaderT r (ST s) a)) -"SPEC $fApplicativeReaderT @(ST s) @_" - forall (@s) (@r) ($dApplicative :: Applicative (ST s)). - $fApplicativeReaderT @(ST s) @r $dApplicative - = $fApplicativeReaderT_$s$fApplicativeReaderT @s @r -"SPEC $fFunctorReaderT @(ST s) @_" - forall (@s) (@r) ($dFunctor :: Functor (ST s)). - $fFunctorReaderT @(ST s) @r $dFunctor - = $fApplicativeReaderT_$s$fFunctorReaderT @s @r -"SPEC $fMonadReaderT @(ST s) @_" - forall (@s) (@r) ($dMonad :: Monad (ST s)). - $fMonadReaderT @(ST s) @r $dMonad - = $fMonadAbstractIOSTReaderT_$s$fMonadReaderT @s @r "USPEC useAbstractMonad @(ReaderT Int (ST s))" forall (@s) ($dMonadAbstractIOST :: MonadAbstractIOST (ReaderT Int (ST s))). ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -435,7 +435,7 @@ test('T21851', [grep_errmsg(r'case.*w\$sf') ], multimod_compile, ['T21851', '-O # One module, T22097.hs, has OPTIONS_GHC -ddump-simpl test('T22097', [grep_errmsg(r'case.*wgoEven') ], multimod_compile, ['T22097', '-O -dno-typeable-binds -dsuppress-uniques']) -test('T13873', [ grep_errmsg(r'SPEC') ], compile, ['-O -ddump-rules']) +test('T13873', [ grep_errmsg(r'SPEC') ], compile, ['-O -ddump-rules -fpolymorphic-specialisation']) test('T22357', normal, compile, ['-O']) test('T22471', normal, compile, ['-O']) test('T22347', normal, compile, ['-O -fno-full-laziness']) @@ -443,8 +443,8 @@ test('T22347a', normal, compile, ['-O2 -fno-full-laziness']) # T17366: expecting to see a rule # Rule fired: SPEC/T17366 f @(Tagged tag) @_ (T17366) -test('T17366', normal, multimod_compile, ['T17366', '-O -v0 -ddump-rule-firings']) -test('T17366_AR', [grep_errmsg(r'SPEC')], multimod_compile, ['T17366_AR', '-O -v0 -ddump-rule-firings']) +test('T17366', normal, multimod_compile, ['T17366', '-O -v0 -ddump-rule-firings -fpolymorphic-specialisation']) +test('T17366_AR', [grep_errmsg(r'SPEC')], multimod_compile, ['T17366_AR', '-O -v0 -ddump-rule-firings -fpolymorphic-specialisation']) test('T22375', normal, compile, ['-O -ddump-simpl -dsuppress-uniques -dno-typeable-binds -dsuppress-unfoldings']) # One module, T21851_2.hs, has OPTIONS_GHC -ddump-simpl @@ -467,7 +467,7 @@ test('T22623', normal, multimod_compile, ['T22623', '-O -v0']) test('T22662', normal, compile, ['']) test('T22725', normal, compile, ['-O']) test('T22502', normal, compile, ['-O']) -test('T22611', [when(wordsize(32), skip), grep_errmsg(r'\$salterF') ], compile, ['-O -ddump-simpl -dsuppress-uniques -dsuppress-all']) +test('T22611', [when(wordsize(32), skip), grep_errmsg(r'\$salterF') ], compile, ['-O -ddump-simpl -dsuppress-uniques -dsuppress-all -fpolymorphic-specialisation']) 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/fac496bc326c78275d1aba3e0d06f2693274e7d2...b360c896b389eec86e2fdc2565ae2021f30ee226 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fac496bc326c78275d1aba3e0d06f2693274e7d2...b360c896b389eec86e2fdc2565ae2021f30ee226 You're receiving 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 Jun 30 14:41:08 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 30 Jun 2023 10:41:08 -0400 Subject: [Git][ghc/ghc][wip/base-stability] 12 commits: compiler: Make OccSet opaque Message-ID: <649ee984de60c_238a8e10ef12342757e1@gitlab.mail> Ben Gamari pushed to branch wip/base-stability at Glasgow Haskell Compiler / GHC Commits: 13f83f4b by Ben Gamari at 2023-05-15T21:26:23-04:00 compiler: Make OccSet opaque - - - - - 725f9280 by Ben Gamari at 2023-05-15T21:26:24-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc. - - - - - 28e2c415 by Ben Gamari at 2023-05-15T21:26:25-04: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. - - - - - dc7ca88b by Ben Gamari at 2023-05-16T07:58:47-04:00 Don't use OccSet OccSet appears not to behave as one would expect. - - - - - f0fbf1cc by Ben Gamari at 2023-06-30T10:40:54-04:00 base: Introduce Data.Enum - - - - - ffc985c2 by Ben Gamari at 2023-06-30T10:40:54-04:00 base: Add export list to GHC.Num.Integer - - - - - 711d5e70 by Ben Gamari at 2023-06-30T10:40:54-04:00 base: Add export list to GHC.Num - - - - - 3042e7d2 by Ben Gamari at 2023-06-30T10:40:54-04:00 base: Add export list to GHC.Num.Natural - - - - - bd20c69c by Ben Gamari at 2023-06-30T10:40:54-04:00 base: Introduce Data.Show - - - - - 0e741cdc by Ben Gamari at 2023-06-30T10:40:54-04:00 base: Add export list to GHC.Float - - - - - d54b9825 by Ben Gamari at 2023-06-30T10:40:54-04:00 base: Add export list to GHC.Real - - - - - 8098c78a by Ben Gamari at 2023-06-30T10:40:54-04:00 base: Eliminate module reexport in GHC.Exception - - - - - 22 changed files: - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Types/TyThing/Ppr.hs - hadrian/src/Packages.hs - hadrian/src/Rules/Test.hs - hadrian/src/Settings/Default.hs - + libraries/base/Data/Enum.hs - + libraries/base/Data/Show.hs - libraries/base/GHC/Exception.hs - libraries/base/GHC/Float.hs - libraries/base/GHC/Num.hs - libraries/base/GHC/Real.hs - libraries/base/base.cabal - libraries/ghc-bignum/src/GHC/Num/Integer.hs - libraries/ghc-bignum/src/GHC/Num/Natural.hs - testsuite/mk/boilerplate.mk - + testsuite/tests/interface-stability/Makefile - + testsuite/tests/interface-stability/README.mkd - + testsuite/tests/interface-stability/all.T - + testsuite/tests/interface-stability/base-exports.stdout - + utils/dump-decls/Main.hs - + utils/dump-decls/dump-decls.cabal Changes: ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -759,13 +759,9 @@ newtype AltPpr = AltPpr (Maybe (OccName -> SDoc)) data ShowHowMuch = ShowHeader AltPpr -- ^Header information only, not rhs - | ShowSome [OccName] AltPpr - -- ^ Show only some sub-components. Specifically, - -- - -- [@\[\]@] Print all sub-components. - -- [@(n:ns)@] Print sub-component @n@ with @ShowSub = ns@; - -- elide other sub-components to @...@ - -- May 14: the list is max 1 element long at the moment + | ShowSome (OccName -> Bool) AltPpr + -- ^ Show only those sub-components for which the given predicate is 'True'. + -- All others will be elided with @... at . | ShowIface -- ^Everything including GHC-internal information (used in --show-iface) @@ -783,9 +779,9 @@ everything unqualified, so we can just print the OccName directly. -} instance Outputable ShowHowMuch where - ppr (ShowHeader _) = text "ShowHeader" - ppr ShowIface = text "ShowIface" - ppr (ShowSome occs _) = text "ShowSome" <+> ppr occs + ppr (ShowHeader _) = text "ShowHeader" + ppr ShowIface = text "ShowIface" + ppr (ShowSome _ _) = text "ShowSome" showToHeader :: ShowSub showToHeader = ShowSub { ss_how_much = ShowHeader $ AltPpr Nothing @@ -801,18 +797,18 @@ ppShowIface _ _ = Outputable.empty -- show if all sub-components or the complete interface is shown ppShowAllSubs :: ShowSub -> SDoc -> SDoc -- See Note [Minimal complete definition] -ppShowAllSubs (ShowSub { ss_how_much = ShowSome [] _ }) doc = doc -ppShowAllSubs (ShowSub { ss_how_much = ShowIface }) doc = doc -ppShowAllSubs _ _ = Outputable.empty +ppShowAllSubs (ShowSub { ss_how_much = ShowSome _ _ }) doc = doc +ppShowAllSubs (ShowSub { ss_how_much = ShowIface }) doc = doc +ppShowAllSubs _ _ = Outputable.empty ppShowRhs :: ShowSub -> SDoc -> SDoc ppShowRhs (ShowSub { ss_how_much = ShowHeader _ }) _ = Outputable.empty ppShowRhs _ doc = doc showSub :: HasOccName n => ShowSub -> n -> Bool -showSub (ShowSub { ss_how_much = ShowHeader _ }) _ = False -showSub (ShowSub { ss_how_much = ShowSome (n:_) _ }) thing = n == occName thing -showSub (ShowSub { ss_how_much = _ }) _ = True +showSub (ShowSub { ss_how_much = ShowHeader _ }) _ = False +showSub (ShowSub { ss_how_much = ShowSome f _ }) thing = f (occName thing) +showSub (ShowSub { ss_how_much = _ }) _ = True ppr_trim :: [Maybe SDoc] -> [SDoc] -- Collapse a group of Nothings to a single "..." ===================================== compiler/GHC/Types/Name/Occurrence.hs ===================================== @@ -806,7 +806,7 @@ forceOccEnv nf (MkOccEnv fs) = seqEltsUFM (seqEltsUFM nf) fs -------------------------------------------------------------------------------- -type OccSet = FastStringEnv (UniqSet NameSpace) +newtype OccSet = OccSet (FastStringEnv (UniqSet NameSpace)) emptyOccSet :: OccSet unitOccSet :: OccName -> OccSet @@ -818,15 +818,15 @@ unionManyOccSets :: [OccSet] -> OccSet elemOccSet :: OccName -> OccSet -> Bool isEmptyOccSet :: OccSet -> Bool -emptyOccSet = emptyFsEnv -unitOccSet (OccName ns s) = unitFsEnv s (unitUniqSet ns) +emptyOccSet = OccSet emptyFsEnv +unitOccSet (OccName ns s) = OccSet $ unitFsEnv s (unitUniqSet ns) mkOccSet = extendOccSetList emptyOccSet -extendOccSet occs (OccName ns s) = extendFsEnv occs s (unitUniqSet ns) -extendOccSetList = foldl extendOccSet -unionOccSets = plusFsEnv_C unionUniqSets +extendOccSet (OccSet occs) (OccName ns s) = OccSet $ extendFsEnv occs s (unitUniqSet ns) +extendOccSetList = foldl' extendOccSet +unionOccSets (OccSet xs) (OccSet ys) = OccSet $ plusFsEnv_C unionUniqSets xs ys unionManyOccSets = foldl' unionOccSets emptyOccSet -elemOccSet (OccName ns s) occs = maybe False (elementOfUniqSet ns) $ lookupFsEnv occs s -isEmptyOccSet = isNullUFM +elemOccSet (OccName ns s) (OccSet occs) = maybe False (elementOfUniqSet ns) $ lookupFsEnv occs s +isEmptyOccSet (OccSet occs) = isNullUFM occs {- ************************************************************************ ===================================== compiler/GHC/Types/TyThing/Ppr.hs ===================================== @@ -145,12 +145,12 @@ pprTyThingHdr = pprTyThing showToHeader -- parts omitted. pprTyThingInContext :: ShowSub -> TyThing -> SDoc pprTyThingInContext show_sub thing - = go [] thing + = go (const False) thing where go ss thing = case tyThingParent_maybe thing of Just parent -> - go (getOccName thing : ss) parent + go (\occ -> occ == getOccName thing || ss occ) parent Nothing -> pprTyThing (show_sub { ss_how_much = ShowSome ss (AltPpr Nothing) }) ===================================== hadrian/src/Packages.hs ===================================== @@ -3,7 +3,7 @@ module Packages ( -- * GHC packages array, base, binary, bytestring, cabal, cabalSyntax, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, @@ -35,7 +35,7 @@ import Oracles.Setting ghcPackages :: [Package] ghcPackages = [ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps - , compareSizes, compiler, containers, deepseq, deriveConstants, directory + , compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl @@ -51,7 +51,7 @@ isGhcPackage = (`elem` ghcPackages) -- | Package definitions, see 'Package'. array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps, - compareSizes, compiler, containers, deepseq, deriveConstants, directory, + compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, @@ -75,6 +75,7 @@ containers = lib "containers" `setPath` "libraries/containers/con deepseq = lib "deepseq" deriveConstants = util "deriveConstants" directory = lib "directory" +dumpDecls = util "dump-decls" exceptions = lib "exceptions" filepath = lib "filepath" genapply = util "genapply" ===================================== hadrian/src/Rules/Test.hs ===================================== @@ -40,6 +40,12 @@ countDepsSourcePath = "utils/count-deps/Main.hs" countDepsExtra :: [String] countDepsExtra = ["-iutils/count-deps"] +dumpDeclsProgPath, dumpDeclsSourcePath :: FilePath +dumpDeclsProgPath = "test/bin/dump-decls" <.> exe +dumpDeclsSourcePath = "utils/dump-decls/Main.hs" +dumpDeclsExtra :: [String] +dumpDeclsExtra = [] + noteLinterProgPath, noteLinterSourcePath :: FilePath noteLinterProgPath = "test/bin/lint-notes" <.> exe noteLinterSourcePath = "linters/lint-notes/Main.hs" @@ -67,6 +73,7 @@ checkPrograms = [ CheckProgram "test:check-ppr" checkPprProgPath checkPprSourcePath checkPprExtra checkPpr id id , CheckProgram "test:check-exact" checkExactProgPath checkExactSourcePath checkExactExtra checkExact id id , CheckProgram "test:count-deps" countDepsProgPath countDepsSourcePath countDepsExtra countDeps id id + , CheckProgram "test:dump-decls" dumpDeclsProgPath dumpDeclsSourcePath dumpDeclsExtra dumpDecls id id , CheckProgram "lint:notes" noteLinterProgPath noteLinterSourcePath noteLinterExtra lintNotes (const stage0Boot) id , CheckProgram "lint:whitespace" whitespaceLinterProgPath whitespaceLinterSourcePath whitespaceLinterExtra lintWhitespace (const stage0Boot) (filter (/= lintersCommon)) ] @@ -260,6 +267,7 @@ testRules = do setEnv "CHECK_PPR" (top -/- root -/- checkPprProgPath) setEnv "CHECK_EXACT" (top -/- root -/- checkExactProgPath) + setEnv "DUMP_DECLS" (top -/- root -/- dumpDeclsProgPath) setEnv "COUNT_DEPS" (top -/- root -/- countDepsProgPath) setEnv "LINT_NOTES" (top -/- root -/- noteLinterProgPath) setEnv "LINT_WHITESPACE" (top -/- root -/- whitespaceLinterProgPath) ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -167,7 +167,7 @@ stage2Packages = stage1Packages -- | Packages that are built only for the testsuite. testsuitePackages :: Action [Package] -testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig ]) +testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps, ghcConfig, dumpDecls ]) -- | Default build ways for library packages: -- * We always build 'vanilla' way. ===================================== libraries/base/Data/Enum.hs ===================================== @@ -0,0 +1,22 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Enum +-- Copyright : (c) The University of Glasgow, 1992-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc at haskell.org +-- Stability : stable +-- Portability : non-portable (GHC extensions) +-- +-- The 'Enum' and 'Bounded' classes. +-- +----------------------------------------------------------------------------- + +module Data.Enum + ( Bounded(..) + , Enum(..) + ) where + +import GHC.Enum ===================================== libraries/base/Data/Show.hs ===================================== @@ -0,0 +1,28 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Show +-- Copyright : (c) The University of Glasgow, 1992-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc at haskell.org +-- Stability : stable +-- Portability : non-portable (GHC extensions) +-- +-- The 'Show' class. +-- +----------------------------------------------------------------------------- + +module Data.Show + ( Show(..) + -- * 'ShowS' + , ShowS + , shows + , showChar, showString, showMultiLineString + , showParen, showCommaSpace, showSpace + , showLitChar, showLitString + ) where + +import GHC.Show + ===================================== libraries/base/GHC/Exception.hs ===================================== @@ -23,16 +23,33 @@ ----------------------------------------------------------------------------- module GHC.Exception - ( module GHC.Exception.Type - , throw - , ErrorCall(..,ErrorCall) - , errorCallException - , errorCallWithCallStackException - -- re-export CallStack and SrcLoc from GHC.Types - , CallStack, fromCallSiteList, getCallStack, prettyCallStack - , prettyCallStackLines, showCCSStack - , SrcLoc(..), prettySrcLoc - ) where + ( -- * 'Exception' class + Exception(..) + + -- * 'SomeException' + , SomeException(..) + + -- * Throwing + , throw + + -- * Concrete exceptions + -- ** Arithmetic exceptions + , ArithException(..) + , divZeroException + , overflowException + , ratioZeroDenomException + , underflowException + -- ** 'ErrorCall' + , ErrorCall(..,ErrorCall) + , errorCallException + , errorCallWithCallStackException + + -- * Reexports + -- Re-export CallStack and SrcLoc from GHC.Types + , CallStack, fromCallSiteList, getCallStack, prettyCallStack + , prettyCallStackLines, showCCSStack + , SrcLoc(..), prettySrcLoc + ) where import GHC.Base import GHC.Show ===================================== libraries/base/GHC/Float.hs ===================================== @@ -45,14 +45,102 @@ module GHC.Float - ( module GHC.Float - , Float(..), Double(..), Float#, Double# - , double2Int, int2Double, float2Int, int2Float - - -- * Monomorphic equality operators - -- | See GHC.Classes#matching_overloaded_methods_in_rules - , eqFloat, eqDouble - ) where + ( -- * Classes + Floating(..) + , RealFloat(..) + + -- * 'Float' + , Float(..), Float# + -- ** Conversion + , float2Int + , int2Float + , word2Float + , integerToFloat# + , naturalToFloat# + , rationalToFloat + , castWord32ToFloat + , castFloatToWord32 + , float2Double + -- ** Operations + , floorFloat + , ceilingFloat + , roundFloat + , properFractionFloat + -- ** Predicate + , isFloatDenormalized + , isFloatFinite + , isFloatInfinite + , isFloatNaN + , isFloatNegativeZero + -- ** Comparison + , gtFloat, geFloat, leFloat, ltFloat + -- ** Arithmetic + , plusFloat, minusFloat, timesFloat, divideFloat + , negateFloat + , expFloat, expm1Float + , logFloat, log1pFloat, sqrtFloat, fabsFloat + , sinFloat, cosFloat, tanFloat + , asinFloat, acosFloat, atanFloat + , sinhFloat, coshFloat, tanhFloat + , asinhFloat, acoshFloat, atanhFloat + + -- * 'Double' + , Double(..) + , Double# + -- ** Conversion + , double2Int + , int2Double + , word2Double + , integerToDouble# + , naturalToDouble# + , rationalToDouble + , castWord64ToDouble + , castDoubleToWord64 + , double2Float + -- ** Operations + , floorDouble + , ceilingDouble + , truncateDouble + , roundDouble + , properFractionDouble + -- ** Predicate + , isDoubleDenormalized + , isDoubleFinite + , isDoubleInfinite + , isDoubleNaN + , isDoubleNegativeZero + -- ** Comparison + , gtDouble, geDouble, leDouble, ltDouble + -- ** Arithmetic + , plusDouble, minusDouble, timesDouble, divideDouble + , negateDouble + , expDouble, expm1Double + , logDouble, log1pDouble, sqrtDouble, fabsDouble + , sinDouble, cosDouble, tanDouble + , asinDouble, acosDouble, atanDouble + , sinhDouble, coshDouble, tanhDouble + , asinhDouble, acoshDouble, atanhDouble + + -- * Formatting + , showFloat + , FFFormat(..) + , formatRealFloat + , formatRealFloatAlt + , showSignedFloat + + -- * Operations + , log1mexpOrd + , roundTo + , floatToDigits + , integerToBinaryFloat' + , fromRat + , fromRat' + , roundingMode# + + -- * Monomorphic equality operators + -- | See GHC.Classes#matching_overloaded_methods_in_rules + , eqFloat, eqDouble + ) where import Data.Maybe ===================================== libraries/base/GHC/Num.hs ===================================== @@ -18,7 +18,9 @@ module GHC.Num - ( module GHC.Num + ( Num(..) + , subtract + , quotRemInteger , module GHC.Num.Integer , module GHC.Num.Natural -- reexported for backward compatibility ===================================== libraries/base/GHC/Real.hs ===================================== @@ -18,7 +18,66 @@ -- ----------------------------------------------------------------------------- -module GHC.Real where +module GHC.Real + ( -- * Classes + Real(..) + , Integral(..) + , Fractional(..) + , RealFrac(..) + + -- * Conversion + , fromIntegral + , realToFrac + + -- * Formatting + , showSigned + + -- * Predicates + , even + , odd + + -- * Arithmetic + , (^) + , (^^) + , gcd + , lcm + + -- * 'Ratio' + , Ratio(..) + , Rational + , infinity + , notANumber + + -- * 'Enum' helpers + , numericEnumFrom + , numericEnumFromThen + , numericEnumFromTo + , numericEnumFromThenTo + , integralEnumFrom + , integralEnumFromThen + , integralEnumFromTo + , integralEnumFromThenTo + + -- ** Construction + , (%) + + -- ** Projection + , numerator + , denominator + + -- ** Operations + , reduce + + -- * Internal + , ratioPrec + , ratioPrec1 + , divZeroError + , ratioZeroDenominatorError + , overflowError + , underflowError + , mkRationalBase2 + , mkRationalBase10 + ) where #include "MachDeps.h" ===================================== libraries/base/base.cabal ===================================== @@ -127,6 +127,7 @@ Library Data.Dynamic Data.Either Data.Eq + Data.Enum Data.Fixed Data.Foldable Data.Foldable1 @@ -151,6 +152,7 @@ Library Data.Proxy Data.Ratio Data.Semigroup + Data.Show Data.STRef Data.STRef.Lazy Data.STRef.Strict ===================================== libraries/ghc-bignum/src/GHC/Num/Integer.hs ===================================== @@ -20,7 +20,131 @@ -- -- The 'Integer' type. -module GHC.Num.Integer where +module GHC.Num.Integer + ( Integer(..) + , integerCheck + , integerCheck# + + -- * Useful constants + , integerZero + , integerOne + + -- * Conversion with... + -- ** 'Int' + , integerFromInt# + , integerFromInt + , integerToInt# + , integerToInt + -- ** 'BigNat' + , integerFromBigNat# + , integerFromBigNatNeg# + , integerFromBigNatSign# + , integerToBigNatSign# + , integerToBigNatClamp# + -- ** 'Word' + , integerFromWord# + , integerFromWord + , integerFromWordNeg# + , integerFromWordSign# + , integerToWord# + , integerToWord + -- ** 'Natural' + , integerFromNatural + , integerToNaturalClamp + , integerToNatural + , integerToNaturalThrow + -- ** 'Int64'/'Word64' + , integerFromInt64# + , integerFromWord64# + , integerToInt64# + , integerToWord64# + -- ** Floating-point + , integerDecodeDouble# + , integerEncodeDouble# + , integerEncodeDouble + , integerEncodeFloat# + -- ** 'Addr#' + , integerToAddr# + , integerToAddr + , integerFromAddr# + , integerFromAddr + -- ** Limbs + , integerFromWordList + , integerToMutableByteArray# + , integerToMutableByteArray + , integerFromByteArray# + , integerFromByteArray + + -- * Predicates + , integerIsNegative# + , integerIsNegative + , integerIsZero + , integerIsOne + + -- * Comparison + , integerNe + , integerEq + , integerLe + , integerLt + , integerGt + , integerGe + , integerEq# + , integerNe# + , integerGt# + , integerLe# + , integerLt# + , integerGe# + , integerCompare + + -- * Arithmetic + , integerSub + , integerAdd + , integerMul + , integerNegate + , integerAbs + , integerSignum + , integerSignum# + , integerQuotRem# + , integerQuotRem + , integerQuot + , integerRem + , integerDivMod# + , integerDivMod + , integerDiv + , integerMod + , integerGcd + , integerLcm + , integerSqr + , integerLog2# + , integerLog2 + , integerLogBaseWord# + , integerLogBaseWord + , integerLogBase# + , integerLogBase + , integerIsPowerOf2# + , integerGcde# + , integerGcde + , integerRecipMod# + , integerPowMod# + + -- * Bit operations + , integerPopCount# + , integerBit# + , integerBit + , integerTestBit# + , integerTestBit + , integerShiftR# + , integerShiftR + , integerShiftL# + , integerShiftL + , integerOr + , integerXor + , integerAnd + , integerComplement + + -- * Miscellaneous + , integerSizeInBase# + ) where #include "MachDeps.h" #include "WordSize.h" ===================================== libraries/ghc-bignum/src/GHC/Num/Natural.hs ===================================== @@ -8,7 +8,109 @@ #include "MachDeps.h" #include "WordSize.h" -module GHC.Num.Natural where +module GHC.Num.Natural + ( Natural(..) + , naturalCheck# + , naturalCheck + + -- * Useful constants + , naturalZero + , naturalOne + + -- * Predicates + , naturalIsZero + , naturalIsOne + , naturalIsPowerOf2# + + -- * Conversion with... + -- ** 'BigNat' + , naturalFromBigNat# + , naturalToBigNat# + -- ** 'Word' + , naturalFromWord# + , naturalFromWord2# + , naturalFromWord + , naturalToWord# + , naturalToWord + , naturalToWordClamp# + , naturalToWordClamp + , naturalToWordMaybe# + -- ** Limbs + , naturalFromWordList + , naturalToMutableByteArray# + , naturalFromByteArray# + -- ** Floating point + , naturalEncodeDouble# + , naturalEncodeFloat# + -- ** 'Addr#' + , naturalToAddr# + , naturalToAddr + , naturalFromAddr# + , naturalFromAddr + + -- * Comparison + , naturalEq# + , naturalEq + , naturalNe# + , naturalNe + , naturalGe# + , naturalGe + , naturalLe# + , naturalLe + , naturalGt# + , naturalGt + , naturalLt# + , naturalLt + , naturalCompare + + -- * Bit operations + , naturalPopCount# + , naturalPopCount + , naturalShiftR# + , naturalShiftR + , naturalShiftL# + , naturalShiftL + , naturalAnd + , naturalAndNot + , naturalOr + , naturalXor + , naturalTestBit# + , naturalTestBit + , naturalBit# + , naturalBit + , naturalSetBit# + , naturalSetBit + , naturalClearBit# + , naturalClearBit + , naturalComplementBit# + , naturalComplementBit + + -- * Arithmetic + , naturalAdd + , naturalSub + , naturalSubThrow + , naturalSubUnsafe + , naturalMul + , naturalSqr + , naturalSignum + , naturalNegate + , naturalQuotRem# + , naturalQuotRem + , naturalQuot + , naturalRem + , naturalGcd + , naturalLcm + , naturalLog2# + , naturalLog2 + , naturalLogBaseWord# + , naturalLogBaseWord + , naturalLogBase# + , naturalLogBase + , naturalPowMod + + -- * Miscellaneous + , naturalSizeInBase# + ) where import GHC.Prim import GHC.Types ===================================== testsuite/mk/boilerplate.mk ===================================== @@ -227,6 +227,10 @@ ifeq "$(CHECK_EXACT)" "" CHECK_EXACT := $(abspath $(TOP)/../inplace/bin/check-exact) endif +ifeq "$(DUMP_DECLS)" "" +DUMP_DECLS := $(abspath $(TOP)/../inplace/bin/dump-decls) +endif + ifeq "$(COUNT_DEPS)" "" COUNT_DEPS := $(abspath $(TOP)/../inplace/bin/count-deps) endif ===================================== testsuite/tests/interface-stability/Makefile ===================================== @@ -0,0 +1,6 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +exports_% : + "$(DUMP_DECLS)" "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" $* ===================================== testsuite/tests/interface-stability/README.mkd ===================================== @@ -0,0 +1,11 @@ +# Interface stability testing + +The tests in this directory verify that the interfaces of exposed by GHC's +core libraries do not inadvertently change. They use the `utils/dump-decls` +utility to dump all exported declarations of all exposed modules for the +following packages: + + * base + +These are compared against the expected exports in the test's corresponding +`.stdout` file. ===================================== testsuite/tests/interface-stability/all.T ===================================== @@ -0,0 +1,7 @@ +def check_package(pkg_name): + test(f'{pkg_name}-exports', + req_hadrian_deps(['test:dump-decls']), + makefile_test, + [f'exports_{pkg_name}']) + +check_package('base') ===================================== testsuite/tests/interface-stability/base-exports.stdout ===================================== The diff for this file was not included because it is too large. ===================================== utils/dump-decls/Main.hs ===================================== @@ -0,0 +1,182 @@ +module Main where + +import GHC +import GHC.Core.InstEnv (instEnvElts, instanceHead) +import GHC.Core.TyCo.FVs (tyConsOfType) +import GHC.Driver.Ppr (showSDocForUser) +import GHC.Unit.State (lookupUnitId, lookupPackageName) +import GHC.Unit.Info (UnitInfo, unitExposedModules, PackageName(..)) +import GHC.Data.FastString (fsLit) +import GHC.Driver.Env (hsc_units, hscEPS) +import GHC.Utils.Outputable +import GHC.Types.Unique.Set (nonDetEltsUniqSet) +import GHC.Types.TyThing (tyThingParent_maybe) +import GHC.Types.TyThing.Ppr (pprTyThing) +import GHC.Types.Name (nameOccName, nameModule_maybe, stableNameCmp) +import GHC.Types.Name.Occurrence (OccName) +import GHC.Unit.External (eps_inst_env) +import GHC.Iface.Syntax (ShowSub(..), ShowHowMuch(..), AltPpr(..)) +import GHC.Iface.Type (ShowForAllFlag(..)) + +import Data.Function (on) +import Data.List (sortBy) +import Control.Monad.IO.Class +import System.Environment (getArgs) +import Prelude hiding ((<>)) + +main :: IO () +main = do + ghcRoot:pkg_names <- getArgs + mapM_ (run ghcRoot) pkg_names + +run :: FilePath -> String -> IO () +run root pkg_nm = runGhc (Just root) $ do + let args = map noLoc + [ "-package=" ++ pkg_nm + , "-dppr-cols=1000" + , "-fprint-explicit-runtime-reps" + , "-fprint-explicit-foralls" + ] + dflags <- do + dflags <- getSessionDynFlags + logger <- getLogger + (dflags', _fileish_args, _dynamicFlagWarnings) <- + GHC.parseDynamicFlags logger dflags args + return dflags' + + _ <- setProgramDynFlags dflags + unit_state <- hsc_units <$> getSession + unit_id <- case lookupPackageName unit_state (PackageName $ fsLit pkg_nm) of + Just unit_id -> return unit_id + Nothing -> fail "failed to find package" + unit_info <- case lookupUnitId unit_state unit_id of + Just unit_info -> return unit_info + Nothing -> fail "unknown package" + + decls_doc <- reportUnitDecls unit_info + insts_doc <- reportInstances + + name_ppr_ctx <- GHC.getNamePprCtx + let rendered = showSDocForUser dflags unit_state name_ppr_ctx (vcat [decls_doc, insts_doc]) + liftIO $ putStrLn rendered + +ignoredModules :: [ModuleName] +ignoredModules = + map mkModuleName $ concat + [ unstableModules + , platformDependentModules + ] + where + unstableModules = + [ "GHC.Prim" + , "GHC.Conc.POSIX" + , "GHC.Conc.IO" + ] + platformDependentModules = + [ "System.Posix.Types" + , "Foreign.C.Types" + ] + +ignoredName :: Name -> Bool +ignoredName nm + | Just md <- nameModule_maybe nm + , moduleName md `elem` ignoredModules + = True + | otherwise + = False + +ignoredTyThing :: TyThing -> Bool +ignoredTyThing _ = False + +ignoredTyCon :: TyCon -> Bool +ignoredTyCon = ignoredName . getName + +ignoredType :: Type -> Bool +ignoredType = any ignoredTyCon . nonDetEltsUniqSet . tyConsOfType + +-- | Ignore instances whose heads mention ignored types. +ignoredInstance :: ClsInst -> Bool +ignoredInstance inst + | ignoredName $ getName cls + = True + | any ignoredType tys + = True + | otherwise + = False + where + (_, cls, tys) = instanceHead inst + +reportUnitDecls :: UnitInfo -> Ghc SDoc +reportUnitDecls unit_info = do + let exposed :: [ModuleName] + exposed = map fst (unitExposedModules unit_info) + vcat <$> mapM reportModuleDecls exposed + +reportModuleDecls :: ModuleName -> Ghc SDoc +reportModuleDecls modl_nm + | modl_nm `elem` ignoredModules = do + return $ vcat [ mod_header, text "-- ignored", text "" ] + | otherwise = do + modl <- GHC.lookupQualifiedModule NoPkgQual modl_nm + mb_mod_info <- GHC.getModuleInfo modl + mod_info <- case mb_mod_info of + Nothing -> fail "Failed to find module" + Just mod_info -> return mod_info + + Just name_ppr_ctx <- mkNamePprCtxForModule mod_info + let names = GHC.modInfoExports mod_info + sorted_names = sortBy (compare `on` nameOccName) names + + exported_occs :: [OccName] + exported_occs = map nameOccName names + + is_exported :: OccName -> Bool + is_exported = (`elem` exported_occs) + + things <- mapM GHC.lookupName sorted_names + let contents = vcat $ + [ text "-- Safety:" <+> ppr (modInfoSafe mod_info) ] ++ + [ pprTyThing ss thing + | Just thing <- things + , case tyThingParent_maybe thing of + Just parent + | is_exported (getOccName parent) -> False + _ -> True + , not $ ignoredTyThing thing + , let ss = ShowSub { ss_how_much = ShowSome is_exported (AltPpr Nothing) + , ss_forall = ShowForAllMust + } + ] + + return $ withUserStyle name_ppr_ctx AllTheWay $ + hang mod_header 2 contents <> + text "" + where + mod_header = vcat + [ text "" + , text "module" <+> ppr modl_nm <+> text "where" + , text "" + ] + +reportInstances :: Ghc SDoc +reportInstances = do + hsc_env <- getSession + eps <- liftIO $ hscEPS hsc_env + let instances = eps_inst_env eps + return $ vcat $ + [ text "" + , text "" + , text "-- Instances:" + ] ++ + [ ppr inst + | inst <- sortBy compareInstances (instEnvElts instances) + , not $ ignoredInstance inst + ] + +compareInstances :: ClsInst -> ClsInst -> Ordering +compareInstances inst1 inst2 = mconcat + [ stableNameCmp (getName cls1) (getName cls2) + ] + where + (_, cls1, _tys1) = instanceHead inst1 + (_, cls2, _tys2) = instanceHead inst2 ===================================== utils/dump-decls/dump-decls.cabal ===================================== @@ -0,0 +1,13 @@ +cabal-version: 2.4 +name: dump-decls +version: 0.1.0.0 +synopsis: Dump the declarations of a package. +license: BSD-3-Clause +author: Ben Gamari +maintainer: ben at smart-cactus.org +copyright: (c) 2023 Ben Gamari + +executable dump-decls + main-is: Main.hs + build-depends: base, ghc + default-language: Haskell2010 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cb04f82c51612d52b7494b260007513a1358b3cf...8098c78a9b5e6aab27e5bc4aa965bdca249b902c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cb04f82c51612d52b7494b260007513a1358b3cf...8098c78a9b5e6aab27e5bc4aa965bdca249b902c You're receiving 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 Jun 30 14:53:36 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 30 Jun 2023 10:53:36 -0400 Subject: [Git][ghc/ghc][wip/drop-touch] Drop dependence on `touch` Message-ID: <649eec702aaea_238a8ec95a427988a@gitlab.mail> Ben Gamari pushed to branch wip/drop-touch at Glasgow Haskell Compiler / GHC Commits: 32f586e6 by Ben Gamari at 2023-06-30T10:53:25-04:00 Drop dependence on `touch` This drops GHC's dependence on the `touch` program, instead implementing it within GHC. This eliminates an external dependency and means that we have one fewer program to keep track of in the `configure` script - - - - - 22 changed files: - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools/Tasks.hs - + compiler/GHC/Utils/Touch.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Builder.hs - hadrian/src/Hadrian/Builder.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Program.hs - hadrian/src/Settings/Default.hs - m4/fp_settings.m4 - − utils/touchy/Makefile - − utils/touchy/touchy.c - − utils/touchy/touchy.cabal Changes: ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -259,6 +259,7 @@ import GHC.Utils.Outputable import GHC.Utils.Misc import GHC.Utils.Logger import GHC.Utils.TmpFs +import GHC.Utils.Touch import qualified GHC.LanguageExtensions as LangExt @@ -1262,7 +1263,7 @@ hscMaybeWriteIface logger dflags is_simple iface old_iface mod_location = do -- .hie files. let hie_file = ml_hie_file mod_location whenM (doesFileExist hie_file) $ - GHC.SysTools.touch logger dflags "Touching hie file" hie_file + GHC.Utils.Touch.touch hie_file else -- See Note [Strictness in ModIface] forceModIface iface ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -72,6 +72,7 @@ import System.IO import GHC.Linker.ExtraObj import GHC.Linker.Dynamic import GHC.Utils.Panic +import GHC.Utils.Touch import GHC.Unit.Module.Env import GHC.Driver.Env.KnotVars import GHC.Driver.Config.Finder @@ -369,7 +370,7 @@ runJsPhase _pipe_env hsc_env _location input_fn = do -- The object file is already generated. We only touch it to ensure the -- timestamp is refreshed, see Note [JS Backend .o file procedure]. - touchObjectFile logger dflags input_fn + touchObjectFile input_fn return input_fn @@ -552,7 +553,7 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do -- In the case of hs-boot files, generate a dummy .o-boot -- stamp file for the benefit of Make - HsBootFile -> touchObjectFile logger dflags o_file + HsBootFile -> touchObjectFile o_file HsSrcFile -> panic "HscUpdate not relevant for HscSrcFile" -- MP: I wonder if there are any lurking bugs here because we @@ -1148,10 +1149,10 @@ linkDynLibCheck logger tmpfs dflags unit_env o_files dep_units = do -touchObjectFile :: Logger -> DynFlags -> FilePath -> IO () -touchObjectFile logger dflags path = do +touchObjectFile :: FilePath -> IO () +touchObjectFile path = do createDirectoryIfMissing True $ takeDirectory path - GHC.SysTools.touch logger dflags "Touching object file" path + GHC.Utils.Touch.touch path -- Note [-fPIC for assembler] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -102,7 +102,6 @@ module GHC.Driver.Session ( sPgm_l, sPgm_lm, sPgm_dll, - sPgm_T, sPgm_windres, sPgm_ar, sPgm_ranlib, @@ -137,7 +136,7 @@ module GHC.Driver.Session ( versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, - pgm_dll, pgm_T, pgm_windres, pgm_ar, + pgm_dll, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -406,8 +405,6 @@ pgm_lm :: DynFlags -> Maybe (String,[Option]) pgm_lm dflags = toolSettings_pgm_lm $ toolSettings dflags pgm_dll :: DynFlags -> (String,[Option]) pgm_dll dflags = toolSettings_pgm_dll $ toolSettings dflags -pgm_T :: DynFlags -> String -pgm_T dflags = toolSettings_pgm_T $ toolSettings dflags pgm_windres :: DynFlags -> String pgm_windres dflags = toolSettings_pgm_windres $ toolSettings dflags pgm_lcc :: DynFlags -> (String,[Option]) ===================================== compiler/GHC/Settings.hs ===================================== @@ -34,7 +34,6 @@ module GHC.Settings , sPgm_l , sPgm_lm , sPgm_dll - , sPgm_T , sPgm_windres , sPgm_ar , sPgm_otool @@ -111,7 +110,6 @@ data ToolSettings = ToolSettings -- merging, hence the 'Maybe'. See Note [Object merging] in -- "GHC.Driver.Pipeline.Execute" for details. , toolSettings_pgm_dll :: (String, [Option]) - , toolSettings_pgm_T :: String , toolSettings_pgm_windres :: String , toolSettings_pgm_ar :: String , toolSettings_pgm_otool :: String @@ -226,8 +224,6 @@ sPgm_lm :: Settings -> Maybe (String, [Option]) sPgm_lm = toolSettings_pgm_lm . sToolSettings sPgm_dll :: Settings -> (String, [Option]) sPgm_dll = toolSettings_pgm_dll . sToolSettings -sPgm_T :: Settings -> String -sPgm_T = toolSettings_pgm_T . sToolSettings sPgm_windres :: Settings -> String sPgm_windres = toolSettings_pgm_windres . sToolSettings sPgm_ar :: Settings -> String ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -125,8 +125,6 @@ initSettings top_dir = do install_name_tool_path <- getToolSetting "install_name_tool command" ranlib_path <- getToolSetting "ranlib command" - touch_path <- getToolSetting "touch command" - mkdll_prog <- getToolSetting "dllwrap command" let mkdll_args = [] @@ -191,7 +189,6 @@ initSettings top_dir = do , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r , toolSettings_pgm_dll = (mkdll_prog,mkdll_args) - , toolSettings_pgm_T = touch_path , toolSettings_pgm_windres = windres_path , toolSettings_pgm_ar = ar_path , toolSettings_pgm_otool = otool_path ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -395,6 +395,3 @@ runWindres logger dflags args = traceSystoolCommand logger "windres" $ do mb_env <- getGccEnv cc_args runSomethingFiltered logger id "Windres" windres (opts ++ args) Nothing mb_env -touch :: Logger -> DynFlags -> String -> String -> IO () -touch logger dflags purpose arg = traceSystoolCommand logger "touch" $ - runSomething logger purpose (pgm_T dflags) [FileOption "" arg] ===================================== compiler/GHC/Utils/Touch.hs ===================================== @@ -0,0 +1,33 @@ +{-# LANGUAGE CPP #-} + +module GHC.Utils.Touch (touch) where + +import GHC.Prelude + +#if defined(mingw32_HOST_OS) +import System.Win32.File +import System.Win32.Time +#else +import System.Posix.Files +import System.Posix.IO +#endif + +-- | Set the mtime of the given file to the current time. +touch :: FilePath -> IO () +touch file = do +#if defined(mingw32_HOST_OS) + hdl <- createFile file gENERIC_WRITE fILE_SHARE_NONE Nothing oPEN_ALWAYS fILE_ATTRIBUTE_NORMAL Nothing + t <- getSystemTimeAsFileTime + setFileTime hdl Nothing Nothing (Just t) + closeHandle hdl +#else + let oflags = defaultFileFlags { noctty = True } +#if MIN_VERSION_unix(2,8,0) + fd <- openFd file WriteOnly oflags +#else + fd <- openFd file WriteOnly (Just 0o666) oflags +#endif + touchFd fd + closeFd fd +#endif + ===================================== compiler/ghc.cabal.in ===================================== @@ -902,6 +902,7 @@ Library GHC.Utils.Ppr GHC.Utils.Ppr.Colour GHC.Utils.TmpFs + GHC.Utils.Touch GHC.Utils.Trace GHC.Wasm.ControlFlow GHC.Wasm.ControlFlow.FromCmm ===================================== hadrian/bindist/Makefile ===================================== @@ -102,7 +102,6 @@ lib/settings : config.mk @echo ',("ranlib command", "$(SettingsRanlibCommand)")' >> $@ @echo ',("otool command", "$(SettingsOtoolCommand)")' >> $@ @echo ',("install_name_tool command", "$(SettingsInstallNameToolCommand)")' >> $@ - @echo ',("touch command", "$(SettingsTouchCommand)")' >> $@ @echo ',("dllwrap command", "$(SettingsDllWrapCommand)")' >> $@ @echo ',("windres command", "$(SettingsWindresCommand)")' >> $@ @echo ',("unlit command", "$$topdir/bin/$(CrossCompilePrefix)unlit")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -274,7 +274,6 @@ SettingsRanlibCommand = @SettingsRanlibCommand@ SettingsDllWrapCommand = @SettingsDllWrapCommand@ SettingsWindresCommand = @SettingsWindresCommand@ SettingsLibtoolCommand = @SettingsLibtoolCommand@ -SettingsTouchCommand = @SettingsTouchCommand@ SettingsClangCommand = @SettingsClangCommand@ SettingsLlcCommand = @SettingsLlcCommand@ SettingsOptCommand = @SettingsOptCommand@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -158,7 +158,6 @@ settings-otool-command = @SettingsOtoolCommand@ settings-install_name_tool-command = @SettingsInstallNameToolCommand@ settings-dll-wrap-command = @SettingsDllWrapCommand@ settings-windres-command = @SettingsWindresCommand@ -settings-touch-command = @SettingsTouchCommand@ settings-clang-command = @SettingsClangCommand@ settings-llc-command = @SettingsLlcCommand@ settings-opt-command = @SettingsOptCommand@ ===================================== hadrian/src/Builder.hs ===================================== @@ -236,7 +236,6 @@ instance H.Builder Builder where pure [] Ghc _ stage -> do root <- buildRoot - touchyPath <- programPath (vanillaContext (Stage0 InTreeLibs) touchy) unlitPath <- builderPath Unlit -- GHC from the previous stage is used to build artifacts in the @@ -245,7 +244,6 @@ instance H.Builder Builder where return $ [ unlitPath ] ++ ghcdeps - ++ [ touchyPath | windowsHost ] ++ [ root -/- mingwStamp | windowsHost ] -- proxy for the entire mingw toolchain that -- we have in inplace/mingw initially, and then at ===================================== hadrian/src/Hadrian/Builder.hs ===================================== @@ -49,8 +49,8 @@ class ShakeValue b => Builder b where -- capture the @stdout@ result and return it. askBuilderWith :: b -> BuildInfo -> Action String - -- | Runtime dependencies of a builder. For example, on Windows GHC requires - -- the utility @touchy.exe@ to be available on a specific path. + -- | Runtime dependencies of a builder. For example, GHC requires the + -- utility @unlit@ to be available on a specific path. runtimeDependencies :: b -> Action [FilePath] runtimeDependencies _ = return [] ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -125,7 +125,6 @@ data SettingsFileSetting | SettingsFileSetting_InstallNameToolCommand | SettingsFileSetting_DllWrapCommand | SettingsFileSetting_WindresCommand - | SettingsFileSetting_TouchCommand | SettingsFileSetting_ClangCommand | SettingsFileSetting_LlcCommand | SettingsFileSetting_OptCommand @@ -223,7 +222,6 @@ settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_InstallNameToolCommand -> "settings-install_name_tool-command" SettingsFileSetting_DllWrapCommand -> "settings-dll-wrap-command" SettingsFileSetting_WindresCommand -> "settings-windres-command" - SettingsFileSetting_TouchCommand -> "settings-touch-command" SettingsFileSetting_ClangCommand -> "settings-clang-command" SettingsFileSetting_LlcCommand -> "settings-llc-command" SettingsFileSetting_OptCommand -> "settings-opt-command" ===================================== hadrian/src/Packages.hs ===================================== @@ -8,7 +8,7 @@ module Packages ( ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, - runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, touchy, + runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, ghcPackages, isGhcPackage, @@ -40,7 +40,7 @@ ghcPackages = , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell - , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml + , terminfo, text, time, transformers, unlit, unix, win32, xhtml , timeout , lintersCommon , lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace ] @@ -56,7 +56,7 @@ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, count ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, - terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml, + terminfo, text, time, transformers, unlit, unix, win32, xhtml, timeout, lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace :: Package @@ -117,7 +117,6 @@ terminfo = lib "terminfo" text = lib "text" time = lib "time" timeout = util "timeout" `setPath` "testsuite/timeout" -touchy = util "touchy" transformers = lib "transformers" unlit = util "unlit" unix = lib "unix" @@ -192,12 +191,12 @@ programName Context {..} = do -- | The 'FilePath' to a program executable in a given 'Context'. programPath :: Context -> Action FilePath programPath context at Context {..} = do - -- TODO: The @touchy@ utility lives in the @lib/bin@ directory instead of - -- @bin@, which is likely just a historical accident that should be fixed. - -- See: https://github.com/snowleopard/hadrian/issues/570 - -- Likewise for @iserv@ and @unlit at . + -- TODO: The @iserv@ and @unlit@ utilities live in the @lib/bin@ directory + -- instead of @bin@, which is likely just a historical accident that should + -- be fixed. See: + -- https://github.com/snowleopard/hadrian/issues/570 name <- programName context - path <- if package `elem` [iserv, touchy, unlit] + path <- if package `elem` [iserv, unlit] then stageLibPath stage <&> (-/- "bin") else stageBinPath stage return $ path -/- name <.> exe @@ -210,7 +209,7 @@ timeoutPath = "testsuite/timeout/install-inplace/bin/timeout" <.> exe -- TODO: Can we extract this information from Cabal files? -- | Some program packages should not be linked with Haskell main function. nonHsMainPackage :: Package -> Bool -nonHsMainPackage = (`elem` [hp2ps, iserv, touchy, unlit, ghciWrapper]) +nonHsMainPackage = (`elem` [hp2ps, iserv, unlit, ghciWrapper]) -- TODO: Combine this with 'programName'. -- | Path to the @autogen@ directory generated by 'buildAutogenFiles'. ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -461,7 +461,6 @@ generateSettings = do , ("ranlib command", expr $ settingsFileSetting SettingsFileSetting_RanlibCommand) , ("otool command", expr $ settingsFileSetting SettingsFileSetting_OtoolCommand) , ("install_name_tool command", expr $ settingsFileSetting SettingsFileSetting_InstallNameToolCommand) - , ("touch command", expr $ settingsFileSetting SettingsFileSetting_TouchCommand) , ("dllwrap command", expr $ settingsFileSetting SettingsFileSetting_DllWrapCommand) , ("windres command", expr $ settingsFileSetting SettingsFileSetting_WindresCommand) , ("unlit command", ("$topdir/bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) ===================================== hadrian/src/Rules/Program.hs ===================================== @@ -105,7 +105,7 @@ buildProgram bin ctx@(Context{..}) rs = do (True, s) | s > stage0InTree -> do srcDir <- buildRoot <&> (-/- (stageString stage0InTree -/- "bin")) copyFile (srcDir -/- takeFileName bin) bin - (False, s) | s > stage0InTree && (package `elem` [touchy, unlit]) -> do + (False, s) | s > stage0InTree && (package `elem` [unlit]) -> do srcDir <- stageLibPath stage0InTree <&> (-/- "bin") copyFile (srcDir -/- takeFileName bin) bin _ -> buildBinary rs bin ctx ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -105,7 +105,6 @@ stage0Packages = do ] ++ [ terminfo | not windowsHost, not cross ] ++ [ timeout | windowsHost ] - ++ [ touchy | windowsHost ] -- | Packages built in 'Stage1' by default. You can change this in "UserSettings". stage1Packages :: Action [Package] @@ -155,9 +154,8 @@ stage1Packages = do , runGhc ] , when (winTarget && not cross) - [ touchy - -- See Note [Hadrian's ghci-wrapper package] - , ghciWrapper + [ -- See Note [Hadrian's ghci-wrapper package] + ghciWrapper ] ] @@ -185,16 +183,14 @@ defaultLibraryWays = Set.fromList <$> defaultRtsWays :: Ways defaultRtsWays = Set.fromList <$> mconcat - [ pure [vanilla] + [ pure [vanilla, threaded] , notStage0 ? pure - [ profiling, debugProfiling - , debug + [ profiling, threadedProfiling, debugProfiling, threadedDebugProfiling + , debug, threadedDebug ] - , notStage0 ? targetSupportsThreadedRts ? pure [threaded, threadedProfiling, threadedDebugProfiling, threadedDebug] , notStage0 ? platformSupportsSharedLibs ? pure - [ dynamic, debugDynamic + [ dynamic, threadedDynamic, debugDynamic, threadedDebugDynamic ] - , notStage0 ? platformSupportsSharedLibs ? targetSupportsThreadedRts ? pure [ threadedDynamic, threadedDebugDynamic ] ] -- TODO: Move C source arguments here ===================================== m4/fp_settings.m4 ===================================== @@ -25,7 +25,6 @@ AC_DEFUN([FP_SETTINGS], SettingsRanlibCommand="${mingw_bin_prefix}llvm-ranlib.exe" SettingsDllWrapCommand="${mingw_bin_prefix}llvm-dllwrap.exe" SettingsWindresCommand="${mingw_bin_prefix}llvm-windres.exe" - SettingsTouchCommand='$$topdir/bin/touchy.exe' else # This case handles the "normal" platforms (e.g. not Windows) where we @@ -56,12 +55,6 @@ AC_DEFUN([FP_SETTINGS], SettingsWindresCommand="$WindresCmd" fi - if test "$HostOS" = "mingw32"; then - SettingsTouchCommand='$$topdir/bin/touchy.exe' - else - SettingsTouchCommand='touch' - fi - if test "$EnableDistroToolchain" = "YES"; then # If the user specified --enable-distro-toolchain then we just use the # executable names, not paths. @@ -123,7 +116,6 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsInstallNameToolCommand) AC_SUBST(SettingsDllWrapCommand) AC_SUBST(SettingsWindresCommand) - AC_SUBST(SettingsTouchCommand) AC_SUBST(SettingsClangCommand) AC_SUBST(SettingsLlcCommand) AC_SUBST(SettingsOptCommand) ===================================== utils/touchy/Makefile deleted ===================================== @@ -1,37 +0,0 @@ -# ----------------------------------------------------------------------------- -# -# (c) 2009 The University of Glasgow -# -# This file is part of the GHC build system. -# -# To understand how the build system works and how to modify it, see -# https://gitlab.haskell.org/ghc/ghc/wikis/building/architecture -# https://gitlab.haskell.org/ghc/ghc/wikis/building/modifying -# -# ----------------------------------------------------------------------------- - -# -# Substitute for 'touch' on win32 platforms (without an Unix toolset installed). -# -TOP=../.. -include $(TOP)/mk/boilerplate.mk - -C_SRCS=touchy.c -C_PROG=touchy -SRC_CC_OPTS += -O - -# -# Install touchy in lib/.* -# -INSTALL_LIBEXECS += $(C_PROG) - -include $(TOP)/mk/target.mk - -# Get it over with! -boot :: all - -binary-dist: - $(INSTALL_DIR) $(BIN_DIST_DIR)/utils/touchy - $(INSTALL_DATA) Makefile $(BIN_DIST_DIR)/utils/touchy/ - $(INSTALL_PROGRAM) $(C_PROG) $(BIN_DIST_DIR)/utils/touchy/ - ===================================== utils/touchy/touchy.c deleted ===================================== @@ -1,123 +0,0 @@ -/* - * Simple 'touch' program for Windows - * - */ -#if !defined(_WIN32) -#error "Win32-only, the platform you're using is supposed to have 'touch' already." -#else -#include -#include -#include -#include -#include -#include -#include - -/* -touch is used by GHC both during building and during compilation of -Haskell files. Unfortunately this means we need a 'touch' like program -in the GHC bindist. Since touch is not standard on Windows and msys2 -doesn't include a mingw-w64 build of coreutils we need touchy for now. - -With Windows 7 in a virtual box VM on OS X, some very odd things happen -with dates and time stamps when SSHing into cygwin. e.g. here the -"Change" time is in the past: - -$ date; touch foo; stat foo -Fri Dec 2 16:58:07 GMTST 2011 - File: `foo' - Size: 0 Blocks: 0 IO Block: 65536 regular -empty file -Device: 540aba0bh/1409989131d Inode: 562949953592977 Links: 1 -Access: (0644/-rw-r--r--) Uid: ( 1000/ ian) Gid: ( 513/ None) -Access: 2011-12-02 16:58:07.414457900 +0000 -Modify: 2011-12-02 16:58:07.414457900 +0000 -Change: 2011-12-02 16:58:03.495141800 +0000 - Birth: 2011-12-02 16:57:57.731469900 +0000 - -And if we copy such a file, then the copy is older (as determined by the -"Modify" time) than the original: - -$ date; touch foo; stat foo; cp foo bar; stat bar -Fri Dec 2 16:59:10 GMTST 2011 - File: `foo' - Size: 0 Blocks: 0 IO Block: 65536 regular -empty file -Device: 540aba0bh/1409989131d Inode: 1407374883725128 Links: 1 -Access: (0644/-rw-r--r--) Uid: ( 1000/ ian) Gid: ( 513/ None) -Access: 2011-12-02 16:59:10.118457900 +0000 -Modify: 2011-12-02 16:59:10.118457900 +0000 -Change: 2011-12-02 16:59:06.189477700 +0000 - Birth: 2011-12-02 16:57:57.731469900 +0000 - File: `bar' - Size: 0 Blocks: 0 IO Block: 65536 regular -empty file -Device: 540aba0bh/1409989131d Inode: 281474976882512 Links: 1 -Access: (0644/-rw-r--r--) Uid: ( 1000/ ian) Gid: ( 513/ None) -Access: 2011-12-02 16:59:06.394555800 +0000 -Modify: 2011-12-02 16:59:06.394555800 +0000 -Change: 2011-12-02 16:59:06.395532400 +0000 - Birth: 2011-12-02 16:58:40.921899600 +0000 - -This means that make thinks that things are out of date when it -shouldn't, so reinvokes itself repeatedly until the MAKE_RESTARTS -infinite-recursion test triggers. - -The touchy program, like most other programs, creates files with both -Modify and Change in the past, which is still a little odd, but is -consistent, so doesn't break make. - -We used to use _utime(argv[i],NULL)) to set the file modification times, -but after a BST -> GMT change this started giving files a modification -time an hour in the future: - -$ date; utils/touchy/dist/build/tmp/touchy testfile; stat testfile -Tue, Oct 30, 2012 11:33:06 PM - File: `testfile' - Size: 0 Blocks: 0 IO Block: 65536 regular empty file -Device: 540aba0bh/1409989131d Inode: 9851624184986293 Links: 1 -Access: (0755/-rwxr-xr-x) Uid: ( 1000/ ian) Gid: ( 513/ None) -Access: 2012-10-31 00:33:06.000000000 +0000 -Modify: 2012-10-31 00:33:06.000000000 +0000 -Change: 2012-10-30 23:33:06.769118900 +0000 - Birth: 2012-10-30 23:33:06.769118900 +0000 - -so now we use the Win32 functions GetSystemTimeAsFileTime and SetFileTime. -*/ - -int -main(int argc, char** argv) -{ - int i; - FILETIME ft; - BOOL b; - HANDLE hFile; - - if (argc == 1) { - fprintf(stderr, "Usage: %s \n", argv[0]); - return 1; - } - - for (i = 1; i < argc; i++) { - hFile = CreateFile(argv[i], GENERIC_WRITE, 0, NULL, OPEN_ALWAYS, - FILE_ATTRIBUTE_NORMAL, NULL); - if (hFile == INVALID_HANDLE_VALUE) { - fprintf(stderr, "Unable to open %s\n", argv[i]); - exit(1); - } - GetSystemTimeAsFileTime(&ft); - b = SetFileTime(hFile, (LPFILETIME) NULL, (LPFILETIME) NULL, &ft); - if (b == 0) { - fprintf(stderr, "Unable to change mod. time for %s\n", argv[i]); - exit(1); - } - b = CloseHandle(hFile); - if (b == 0) { - fprintf(stderr, "Closing failed for %s\n", argv[i]); - exit(1); - } - } - - return 0; -} -#endif ===================================== utils/touchy/touchy.cabal deleted ===================================== @@ -1,15 +0,0 @@ -cabal-version: 2.2 -Name: touchy -Version: 0.1 -Copyright: XXX -License: BSD-3-Clause -Author: XXX -Maintainer: XXX -Synopsis: @touch@ for windows -Description: XXX -Category: Development -build-type: Simple - -Executable touchy - Default-Language: Haskell2010 - Main-Is: touchy.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/32f586e61f7a3d3a1ca4971239ae5b60a58af7d1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/32f586e61f7a3d3a1ca4971239ae5b60a58af7d1 You're receiving 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 Jun 30 14:58:58 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 30 Jun 2023 10:58:58 -0400 Subject: [Git][ghc/ghc][wip/drop-touch] Drop dependence on `touch` Message-ID: <649eedb2124a7_238a8e2775ef02828d@gitlab.mail> Ben Gamari pushed to branch wip/drop-touch at Glasgow Haskell Compiler / GHC Commits: 70fdbb6b by Ben Gamari at 2023-06-30T10:58:46-04:00 Drop dependence on `touch` This drops GHC's dependence on the `touch` program, instead implementing it within GHC. This eliminates an external dependency and means that we have one fewer program to keep track of in the `configure` script - - - - - 22 changed files: - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools/Tasks.hs - + compiler/GHC/Utils/Touch.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Builder.hs - hadrian/src/Hadrian/Builder.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Program.hs - hadrian/src/Settings/Default.hs - m4/fp_settings.m4 - − utils/touchy/Makefile - − utils/touchy/touchy.c - − utils/touchy/touchy.cabal Changes: ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -259,6 +259,7 @@ import GHC.Utils.Outputable import GHC.Utils.Misc import GHC.Utils.Logger import GHC.Utils.TmpFs +import GHC.Utils.Touch import qualified GHC.LanguageExtensions as LangExt @@ -1262,7 +1263,7 @@ hscMaybeWriteIface logger dflags is_simple iface old_iface mod_location = do -- .hie files. let hie_file = ml_hie_file mod_location whenM (doesFileExist hie_file) $ - GHC.SysTools.touch logger dflags "Touching hie file" hie_file + GHC.Utils.Touch.touch hie_file else -- See Note [Strictness in ModIface] forceModIface iface ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -72,6 +72,7 @@ import System.IO import GHC.Linker.ExtraObj import GHC.Linker.Dynamic import GHC.Utils.Panic +import GHC.Utils.Touch import GHC.Unit.Module.Env import GHC.Driver.Env.KnotVars import GHC.Driver.Config.Finder @@ -369,7 +370,7 @@ runJsPhase _pipe_env hsc_env _location input_fn = do -- The object file is already generated. We only touch it to ensure the -- timestamp is refreshed, see Note [JS Backend .o file procedure]. - touchObjectFile logger dflags input_fn + touchObjectFile input_fn return input_fn @@ -552,7 +553,7 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do -- In the case of hs-boot files, generate a dummy .o-boot -- stamp file for the benefit of Make - HsBootFile -> touchObjectFile logger dflags o_file + HsBootFile -> touchObjectFile o_file HsSrcFile -> panic "HscUpdate not relevant for HscSrcFile" -- MP: I wonder if there are any lurking bugs here because we @@ -1148,10 +1149,10 @@ linkDynLibCheck logger tmpfs dflags unit_env o_files dep_units = do -touchObjectFile :: Logger -> DynFlags -> FilePath -> IO () -touchObjectFile logger dflags path = do +touchObjectFile :: FilePath -> IO () +touchObjectFile path = do createDirectoryIfMissing True $ takeDirectory path - GHC.SysTools.touch logger dflags "Touching object file" path + GHC.Utils.Touch.touch path -- Note [-fPIC for assembler] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -102,7 +102,6 @@ module GHC.Driver.Session ( sPgm_l, sPgm_lm, sPgm_dll, - sPgm_T, sPgm_windres, sPgm_ar, sPgm_ranlib, @@ -137,7 +136,7 @@ module GHC.Driver.Session ( versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, - pgm_dll, pgm_T, pgm_windres, pgm_ar, + pgm_dll, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -406,8 +405,6 @@ pgm_lm :: DynFlags -> Maybe (String,[Option]) pgm_lm dflags = toolSettings_pgm_lm $ toolSettings dflags pgm_dll :: DynFlags -> (String,[Option]) pgm_dll dflags = toolSettings_pgm_dll $ toolSettings dflags -pgm_T :: DynFlags -> String -pgm_T dflags = toolSettings_pgm_T $ toolSettings dflags pgm_windres :: DynFlags -> String pgm_windres dflags = toolSettings_pgm_windres $ toolSettings dflags pgm_lcc :: DynFlags -> (String,[Option]) ===================================== compiler/GHC/Settings.hs ===================================== @@ -34,7 +34,6 @@ module GHC.Settings , sPgm_l , sPgm_lm , sPgm_dll - , sPgm_T , sPgm_windres , sPgm_ar , sPgm_otool @@ -111,7 +110,6 @@ data ToolSettings = ToolSettings -- merging, hence the 'Maybe'. See Note [Object merging] in -- "GHC.Driver.Pipeline.Execute" for details. , toolSettings_pgm_dll :: (String, [Option]) - , toolSettings_pgm_T :: String , toolSettings_pgm_windres :: String , toolSettings_pgm_ar :: String , toolSettings_pgm_otool :: String @@ -226,8 +224,6 @@ sPgm_lm :: Settings -> Maybe (String, [Option]) sPgm_lm = toolSettings_pgm_lm . sToolSettings sPgm_dll :: Settings -> (String, [Option]) sPgm_dll = toolSettings_pgm_dll . sToolSettings -sPgm_T :: Settings -> String -sPgm_T = toolSettings_pgm_T . sToolSettings sPgm_windres :: Settings -> String sPgm_windres = toolSettings_pgm_windres . sToolSettings sPgm_ar :: Settings -> String ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -125,8 +125,6 @@ initSettings top_dir = do install_name_tool_path <- getToolSetting "install_name_tool command" ranlib_path <- getToolSetting "ranlib command" - touch_path <- getToolSetting "touch command" - mkdll_prog <- getToolSetting "dllwrap command" let mkdll_args = [] @@ -191,7 +189,6 @@ initSettings top_dir = do , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r , toolSettings_pgm_dll = (mkdll_prog,mkdll_args) - , toolSettings_pgm_T = touch_path , toolSettings_pgm_windres = windres_path , toolSettings_pgm_ar = ar_path , toolSettings_pgm_otool = otool_path ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -395,6 +395,3 @@ runWindres logger dflags args = traceSystoolCommand logger "windres" $ do mb_env <- getGccEnv cc_args runSomethingFiltered logger id "Windres" windres (opts ++ args) Nothing mb_env -touch :: Logger -> DynFlags -> String -> String -> IO () -touch logger dflags purpose arg = traceSystoolCommand logger "touch" $ - runSomething logger purpose (pgm_T dflags) [FileOption "" arg] ===================================== compiler/GHC/Utils/Touch.hs ===================================== @@ -0,0 +1,34 @@ +{-# LANGUAGE CPP #-} + +module GHC.Utils.Touch (touch) where + +import GHC.Prelude + +#if defined(mingw32_HOST_OS) +import System.Win32.File +import System.Win32.Time +#else +import System.Posix.Files +import System.Posix.IO +#endif + +-- | Set the mtime of the given file to the current time. +touch :: FilePath -> IO () +touch file = do +#if defined(mingw32_HOST_OS) + hdl <- createFile file gENERIC_WRITE fILE_SHARE_NONE Nothing oPEN_ALWAYS fILE_ATTRIBUTE_NORMAL Nothing + t <- getSystemTimeAsFileTime + setFileTime hdl Nothing Nothing (Just t) + closeHandle hdl +#else +#if MIN_VERSION_unix(2,8,0) + let oflags = defaultFileFlags { noctty = True, creat = Just 0o666 } + fd <- openFd file WriteOnly oflags +#else + let oflags = defaultFileFlags { noctty = True } + fd <- openFd file WriteOnly (Just 0o666) oflags +#endif + touchFd fd + closeFd fd +#endif + ===================================== compiler/ghc.cabal.in ===================================== @@ -902,6 +902,7 @@ Library GHC.Utils.Ppr GHC.Utils.Ppr.Colour GHC.Utils.TmpFs + GHC.Utils.Touch GHC.Utils.Trace GHC.Wasm.ControlFlow GHC.Wasm.ControlFlow.FromCmm ===================================== hadrian/bindist/Makefile ===================================== @@ -102,7 +102,6 @@ lib/settings : config.mk @echo ',("ranlib command", "$(SettingsRanlibCommand)")' >> $@ @echo ',("otool command", "$(SettingsOtoolCommand)")' >> $@ @echo ',("install_name_tool command", "$(SettingsInstallNameToolCommand)")' >> $@ - @echo ',("touch command", "$(SettingsTouchCommand)")' >> $@ @echo ',("dllwrap command", "$(SettingsDllWrapCommand)")' >> $@ @echo ',("windres command", "$(SettingsWindresCommand)")' >> $@ @echo ',("unlit command", "$$topdir/bin/$(CrossCompilePrefix)unlit")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -274,7 +274,6 @@ SettingsRanlibCommand = @SettingsRanlibCommand@ SettingsDllWrapCommand = @SettingsDllWrapCommand@ SettingsWindresCommand = @SettingsWindresCommand@ SettingsLibtoolCommand = @SettingsLibtoolCommand@ -SettingsTouchCommand = @SettingsTouchCommand@ SettingsClangCommand = @SettingsClangCommand@ SettingsLlcCommand = @SettingsLlcCommand@ SettingsOptCommand = @SettingsOptCommand@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -158,7 +158,6 @@ settings-otool-command = @SettingsOtoolCommand@ settings-install_name_tool-command = @SettingsInstallNameToolCommand@ settings-dll-wrap-command = @SettingsDllWrapCommand@ settings-windres-command = @SettingsWindresCommand@ -settings-touch-command = @SettingsTouchCommand@ settings-clang-command = @SettingsClangCommand@ settings-llc-command = @SettingsLlcCommand@ settings-opt-command = @SettingsOptCommand@ ===================================== hadrian/src/Builder.hs ===================================== @@ -236,7 +236,6 @@ instance H.Builder Builder where pure [] Ghc _ stage -> do root <- buildRoot - touchyPath <- programPath (vanillaContext (Stage0 InTreeLibs) touchy) unlitPath <- builderPath Unlit -- GHC from the previous stage is used to build artifacts in the @@ -245,7 +244,6 @@ instance H.Builder Builder where return $ [ unlitPath ] ++ ghcdeps - ++ [ touchyPath | windowsHost ] ++ [ root -/- mingwStamp | windowsHost ] -- proxy for the entire mingw toolchain that -- we have in inplace/mingw initially, and then at ===================================== hadrian/src/Hadrian/Builder.hs ===================================== @@ -49,8 +49,8 @@ class ShakeValue b => Builder b where -- capture the @stdout@ result and return it. askBuilderWith :: b -> BuildInfo -> Action String - -- | Runtime dependencies of a builder. For example, on Windows GHC requires - -- the utility @touchy.exe@ to be available on a specific path. + -- | Runtime dependencies of a builder. For example, GHC requires the + -- utility @unlit@ to be available on a specific path. runtimeDependencies :: b -> Action [FilePath] runtimeDependencies _ = return [] ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -125,7 +125,6 @@ data SettingsFileSetting | SettingsFileSetting_InstallNameToolCommand | SettingsFileSetting_DllWrapCommand | SettingsFileSetting_WindresCommand - | SettingsFileSetting_TouchCommand | SettingsFileSetting_ClangCommand | SettingsFileSetting_LlcCommand | SettingsFileSetting_OptCommand @@ -223,7 +222,6 @@ settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_InstallNameToolCommand -> "settings-install_name_tool-command" SettingsFileSetting_DllWrapCommand -> "settings-dll-wrap-command" SettingsFileSetting_WindresCommand -> "settings-windres-command" - SettingsFileSetting_TouchCommand -> "settings-touch-command" SettingsFileSetting_ClangCommand -> "settings-clang-command" SettingsFileSetting_LlcCommand -> "settings-llc-command" SettingsFileSetting_OptCommand -> "settings-opt-command" ===================================== hadrian/src/Packages.hs ===================================== @@ -8,7 +8,7 @@ module Packages ( ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, - runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, touchy, + runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, ghcPackages, isGhcPackage, @@ -40,7 +40,7 @@ ghcPackages = , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell - , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml + , terminfo, text, time, transformers, unlit, unix, win32, xhtml , timeout , lintersCommon , lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace ] @@ -56,7 +56,7 @@ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, count ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, - terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml, + terminfo, text, time, transformers, unlit, unix, win32, xhtml, timeout, lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace :: Package @@ -117,7 +117,6 @@ terminfo = lib "terminfo" text = lib "text" time = lib "time" timeout = util "timeout" `setPath` "testsuite/timeout" -touchy = util "touchy" transformers = lib "transformers" unlit = util "unlit" unix = lib "unix" @@ -192,12 +191,12 @@ programName Context {..} = do -- | The 'FilePath' to a program executable in a given 'Context'. programPath :: Context -> Action FilePath programPath context at Context {..} = do - -- TODO: The @touchy@ utility lives in the @lib/bin@ directory instead of - -- @bin@, which is likely just a historical accident that should be fixed. - -- See: https://github.com/snowleopard/hadrian/issues/570 - -- Likewise for @iserv@ and @unlit at . + -- TODO: The @iserv@ and @unlit@ utilities live in the @lib/bin@ directory + -- instead of @bin@, which is likely just a historical accident that should + -- be fixed. See: + -- https://github.com/snowleopard/hadrian/issues/570 name <- programName context - path <- if package `elem` [iserv, touchy, unlit] + path <- if package `elem` [iserv, unlit] then stageLibPath stage <&> (-/- "bin") else stageBinPath stage return $ path -/- name <.> exe @@ -210,7 +209,7 @@ timeoutPath = "testsuite/timeout/install-inplace/bin/timeout" <.> exe -- TODO: Can we extract this information from Cabal files? -- | Some program packages should not be linked with Haskell main function. nonHsMainPackage :: Package -> Bool -nonHsMainPackage = (`elem` [hp2ps, iserv, touchy, unlit, ghciWrapper]) +nonHsMainPackage = (`elem` [hp2ps, iserv, unlit, ghciWrapper]) -- TODO: Combine this with 'programName'. -- | Path to the @autogen@ directory generated by 'buildAutogenFiles'. ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -461,7 +461,6 @@ generateSettings = do , ("ranlib command", expr $ settingsFileSetting SettingsFileSetting_RanlibCommand) , ("otool command", expr $ settingsFileSetting SettingsFileSetting_OtoolCommand) , ("install_name_tool command", expr $ settingsFileSetting SettingsFileSetting_InstallNameToolCommand) - , ("touch command", expr $ settingsFileSetting SettingsFileSetting_TouchCommand) , ("dllwrap command", expr $ settingsFileSetting SettingsFileSetting_DllWrapCommand) , ("windres command", expr $ settingsFileSetting SettingsFileSetting_WindresCommand) , ("unlit command", ("$topdir/bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) ===================================== hadrian/src/Rules/Program.hs ===================================== @@ -105,7 +105,7 @@ buildProgram bin ctx@(Context{..}) rs = do (True, s) | s > stage0InTree -> do srcDir <- buildRoot <&> (-/- (stageString stage0InTree -/- "bin")) copyFile (srcDir -/- takeFileName bin) bin - (False, s) | s > stage0InTree && (package `elem` [touchy, unlit]) -> do + (False, s) | s > stage0InTree && (package `elem` [unlit]) -> do srcDir <- stageLibPath stage0InTree <&> (-/- "bin") copyFile (srcDir -/- takeFileName bin) bin _ -> buildBinary rs bin ctx ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -105,7 +105,6 @@ stage0Packages = do ] ++ [ terminfo | not windowsHost, not cross ] ++ [ timeout | windowsHost ] - ++ [ touchy | windowsHost ] -- | Packages built in 'Stage1' by default. You can change this in "UserSettings". stage1Packages :: Action [Package] @@ -155,9 +154,8 @@ stage1Packages = do , runGhc ] , when (winTarget && not cross) - [ touchy - -- See Note [Hadrian's ghci-wrapper package] - , ghciWrapper + [ -- See Note [Hadrian's ghci-wrapper package] + ghciWrapper ] ] @@ -185,16 +183,14 @@ defaultLibraryWays = Set.fromList <$> defaultRtsWays :: Ways defaultRtsWays = Set.fromList <$> mconcat - [ pure [vanilla] + [ pure [vanilla, threaded] , notStage0 ? pure - [ profiling, debugProfiling - , debug + [ profiling, threadedProfiling, debugProfiling, threadedDebugProfiling + , debug, threadedDebug ] - , notStage0 ? targetSupportsThreadedRts ? pure [threaded, threadedProfiling, threadedDebugProfiling, threadedDebug] , notStage0 ? platformSupportsSharedLibs ? pure - [ dynamic, debugDynamic + [ dynamic, threadedDynamic, debugDynamic, threadedDebugDynamic ] - , notStage0 ? platformSupportsSharedLibs ? targetSupportsThreadedRts ? pure [ threadedDynamic, threadedDebugDynamic ] ] -- TODO: Move C source arguments here ===================================== m4/fp_settings.m4 ===================================== @@ -25,7 +25,6 @@ AC_DEFUN([FP_SETTINGS], SettingsRanlibCommand="${mingw_bin_prefix}llvm-ranlib.exe" SettingsDllWrapCommand="${mingw_bin_prefix}llvm-dllwrap.exe" SettingsWindresCommand="${mingw_bin_prefix}llvm-windres.exe" - SettingsTouchCommand='$$topdir/bin/touchy.exe' else # This case handles the "normal" platforms (e.g. not Windows) where we @@ -56,12 +55,6 @@ AC_DEFUN([FP_SETTINGS], SettingsWindresCommand="$WindresCmd" fi - if test "$HostOS" = "mingw32"; then - SettingsTouchCommand='$$topdir/bin/touchy.exe' - else - SettingsTouchCommand='touch' - fi - if test "$EnableDistroToolchain" = "YES"; then # If the user specified --enable-distro-toolchain then we just use the # executable names, not paths. @@ -123,7 +116,6 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsInstallNameToolCommand) AC_SUBST(SettingsDllWrapCommand) AC_SUBST(SettingsWindresCommand) - AC_SUBST(SettingsTouchCommand) AC_SUBST(SettingsClangCommand) AC_SUBST(SettingsLlcCommand) AC_SUBST(SettingsOptCommand) ===================================== utils/touchy/Makefile deleted ===================================== @@ -1,37 +0,0 @@ -# ----------------------------------------------------------------------------- -# -# (c) 2009 The University of Glasgow -# -# This file is part of the GHC build system. -# -# To understand how the build system works and how to modify it, see -# https://gitlab.haskell.org/ghc/ghc/wikis/building/architecture -# https://gitlab.haskell.org/ghc/ghc/wikis/building/modifying -# -# ----------------------------------------------------------------------------- - -# -# Substitute for 'touch' on win32 platforms (without an Unix toolset installed). -# -TOP=../.. -include $(TOP)/mk/boilerplate.mk - -C_SRCS=touchy.c -C_PROG=touchy -SRC_CC_OPTS += -O - -# -# Install touchy in lib/.* -# -INSTALL_LIBEXECS += $(C_PROG) - -include $(TOP)/mk/target.mk - -# Get it over with! -boot :: all - -binary-dist: - $(INSTALL_DIR) $(BIN_DIST_DIR)/utils/touchy - $(INSTALL_DATA) Makefile $(BIN_DIST_DIR)/utils/touchy/ - $(INSTALL_PROGRAM) $(C_PROG) $(BIN_DIST_DIR)/utils/touchy/ - ===================================== utils/touchy/touchy.c deleted ===================================== @@ -1,123 +0,0 @@ -/* - * Simple 'touch' program for Windows - * - */ -#if !defined(_WIN32) -#error "Win32-only, the platform you're using is supposed to have 'touch' already." -#else -#include -#include -#include -#include -#include -#include -#include - -/* -touch is used by GHC both during building and during compilation of -Haskell files. Unfortunately this means we need a 'touch' like program -in the GHC bindist. Since touch is not standard on Windows and msys2 -doesn't include a mingw-w64 build of coreutils we need touchy for now. - -With Windows 7 in a virtual box VM on OS X, some very odd things happen -with dates and time stamps when SSHing into cygwin. e.g. here the -"Change" time is in the past: - -$ date; touch foo; stat foo -Fri Dec 2 16:58:07 GMTST 2011 - File: `foo' - Size: 0 Blocks: 0 IO Block: 65536 regular -empty file -Device: 540aba0bh/1409989131d Inode: 562949953592977 Links: 1 -Access: (0644/-rw-r--r--) Uid: ( 1000/ ian) Gid: ( 513/ None) -Access: 2011-12-02 16:58:07.414457900 +0000 -Modify: 2011-12-02 16:58:07.414457900 +0000 -Change: 2011-12-02 16:58:03.495141800 +0000 - Birth: 2011-12-02 16:57:57.731469900 +0000 - -And if we copy such a file, then the copy is older (as determined by the -"Modify" time) than the original: - -$ date; touch foo; stat foo; cp foo bar; stat bar -Fri Dec 2 16:59:10 GMTST 2011 - File: `foo' - Size: 0 Blocks: 0 IO Block: 65536 regular -empty file -Device: 540aba0bh/1409989131d Inode: 1407374883725128 Links: 1 -Access: (0644/-rw-r--r--) Uid: ( 1000/ ian) Gid: ( 513/ None) -Access: 2011-12-02 16:59:10.118457900 +0000 -Modify: 2011-12-02 16:59:10.118457900 +0000 -Change: 2011-12-02 16:59:06.189477700 +0000 - Birth: 2011-12-02 16:57:57.731469900 +0000 - File: `bar' - Size: 0 Blocks: 0 IO Block: 65536 regular -empty file -Device: 540aba0bh/1409989131d Inode: 281474976882512 Links: 1 -Access: (0644/-rw-r--r--) Uid: ( 1000/ ian) Gid: ( 513/ None) -Access: 2011-12-02 16:59:06.394555800 +0000 -Modify: 2011-12-02 16:59:06.394555800 +0000 -Change: 2011-12-02 16:59:06.395532400 +0000 - Birth: 2011-12-02 16:58:40.921899600 +0000 - -This means that make thinks that things are out of date when it -shouldn't, so reinvokes itself repeatedly until the MAKE_RESTARTS -infinite-recursion test triggers. - -The touchy program, like most other programs, creates files with both -Modify and Change in the past, which is still a little odd, but is -consistent, so doesn't break make. - -We used to use _utime(argv[i],NULL)) to set the file modification times, -but after a BST -> GMT change this started giving files a modification -time an hour in the future: - -$ date; utils/touchy/dist/build/tmp/touchy testfile; stat testfile -Tue, Oct 30, 2012 11:33:06 PM - File: `testfile' - Size: 0 Blocks: 0 IO Block: 65536 regular empty file -Device: 540aba0bh/1409989131d Inode: 9851624184986293 Links: 1 -Access: (0755/-rwxr-xr-x) Uid: ( 1000/ ian) Gid: ( 513/ None) -Access: 2012-10-31 00:33:06.000000000 +0000 -Modify: 2012-10-31 00:33:06.000000000 +0000 -Change: 2012-10-30 23:33:06.769118900 +0000 - Birth: 2012-10-30 23:33:06.769118900 +0000 - -so now we use the Win32 functions GetSystemTimeAsFileTime and SetFileTime. -*/ - -int -main(int argc, char** argv) -{ - int i; - FILETIME ft; - BOOL b; - HANDLE hFile; - - if (argc == 1) { - fprintf(stderr, "Usage: %s \n", argv[0]); - return 1; - } - - for (i = 1; i < argc; i++) { - hFile = CreateFile(argv[i], GENERIC_WRITE, 0, NULL, OPEN_ALWAYS, - FILE_ATTRIBUTE_NORMAL, NULL); - if (hFile == INVALID_HANDLE_VALUE) { - fprintf(stderr, "Unable to open %s\n", argv[i]); - exit(1); - } - GetSystemTimeAsFileTime(&ft); - b = SetFileTime(hFile, (LPFILETIME) NULL, (LPFILETIME) NULL, &ft); - if (b == 0) { - fprintf(stderr, "Unable to change mod. time for %s\n", argv[i]); - exit(1); - } - b = CloseHandle(hFile); - if (b == 0) { - fprintf(stderr, "Closing failed for %s\n", argv[i]); - exit(1); - } - } - - return 0; -} -#endif ===================================== utils/touchy/touchy.cabal deleted ===================================== @@ -1,15 +0,0 @@ -cabal-version: 2.2 -Name: touchy -Version: 0.1 -Copyright: XXX -License: BSD-3-Clause -Author: XXX -Maintainer: XXX -Synopsis: @touch@ for windows -Description: XXX -Category: Development -build-type: Simple - -Executable touchy - Default-Language: Haskell2010 - Main-Is: touchy.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/70fdbb6b5e6a888746aa2009545e591bebb7f9e0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/70fdbb6b5e6a888746aa2009545e591bebb7f9e0 You're receiving 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 Jun 30 15:05:54 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 30 Jun 2023 11:05:54 -0400 Subject: [Git][ghc/ghc][wip/T23576] Implement MO_Shl in iselExpr64 Message-ID: <649eef52adc71_238a8e10ef12342839ad@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: a995c3dd by Jaro Reinders at 2023-06-30T17:05:48+02:00 Implement MO_Shl in iselExpr64 - - - - - 2 changed files: - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -642,7 +642,26 @@ iselExpr64 (CmmMachOp (MO_Mul _) [e1,e2]) = do ] return (RegCode64 code rhi rlo) - +iselExpr64 (CmmMachOp (MO_Shl _) [e1,e2]) = do + RegCode64 code1 r1hi r1lo <- iselExpr64 e1 + (r2, code2) <- getSomeReg e2 + Reg64 rhi rlo <- getNewReg64 + b <- newBlockId + let + code = code1 `appOL` + code2 `appOL` + toOL [ MOV II32 (OpReg r1lo) (OpReg rlo), + MOV II32 (OpReg r1hi) (OpReg rhi), + MOV II32 (OpReg r2) (OpReg ecx), + SHRD II32 (OpReg ecx) (OpReg rhi) (OpReg rlo), + SAR II32 (OpReg ecx) (OpReg rhi), + TEST II32 (OpImm (ImmInt 32)) (OpReg ecx), + JXX EQQ b, + MOV II32 (OpReg rhi) (OpReg rlo), + SAR II32 (OpImm (ImmInt 31)) (OpReg rhi), + NEWBLOCK b + ] + return (RegCode64 code rhi rlo) iselExpr64 expr = do ===================================== compiler/GHC/CmmToAsm/X86/Instr.hs ===================================== @@ -249,6 +249,7 @@ data Instr | SHL Format Operand{-amount-} Operand | SAR Format Operand{-amount-} Operand | SHR Format Operand{-amount-} Operand + | SHRD Format Operand{-amount-} Operand Operand | BT Format Imm Operand | NOP View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a995c3dd83607e50ea94f1616eae09f820a7764e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a995c3dd83607e50ea94f1616eae09f820a7764e You're receiving 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 Jun 30 15:09:17 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 30 Jun 2023 11:09:17 -0400 Subject: [Git][ghc/ghc][wip/T23576] Add SHRD to regUsage Message-ID: <649ef01d14293_238a8e20341642860a2@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: 1f87f44e by Jaro Reinders at 2023-06-30T17:09:12+02:00 Add SHRD to regUsage - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/Instr.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/Instr.hs ===================================== @@ -400,6 +400,7 @@ regUsageOfInstr platform instr SHL _ imm dst -> usageRM imm dst SAR _ imm dst -> usageRM imm dst SHR _ imm dst -> usageRM imm dst + SHRD _ imm dst1 dst2 -> usageRMM imm dst1 dst2 BT _ _ src -> mkRUR (use_R src []) PUSH _ op -> mkRUR (use_R op []) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1f87f44ea108ea585556b93827175fa410ae28fb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1f87f44ea108ea585556b93827175fa410ae28fb You're receiving 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 Jun 30 15:10:07 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 30 Jun 2023 11:10:07 -0400 Subject: [Git][ghc/ghc][wip/ipe-optimisation-9.4] Accept testsuite changes Message-ID: <649ef04f4e479_238a8e2034164286240@gitlab.mail> Ben Gamari pushed to branch wip/ipe-optimisation-9.4 at Glasgow Haskell Compiler / GHC Commits: e3db595d by Ben Gamari at 2023-06-30T11:09:45-04:00 Accept testsuite changes - - - - - 2 changed files: - testsuite/tests/ghci/scripts/T9881.stdout - testsuite/tests/ghci/scripts/ghci025.stdout Changes: ===================================== testsuite/tests/ghci/scripts/T9881.stdout ===================================== @@ -19,19 +19,19 @@ instance Ord Data.ByteString.Lazy.ByteString type Data.ByteString.ByteString :: * data Data.ByteString.ByteString - = 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’ + = Data.ByteString.Internal.BS {-# UNPACK #-}(GHC.ForeignPtr.ForeignPtr + GHC.Word.Word8) + {-# UNPACK #-}Int + -- Defined in ‘Data.ByteString.Internal’ instance Monoid Data.ByteString.ByteString - -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’ + -- Defined in ‘Data.ByteString.Internal’ instance Read Data.ByteString.ByteString - -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’ + -- Defined in ‘Data.ByteString.Internal’ instance Semigroup Data.ByteString.ByteString - -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’ + -- Defined in ‘Data.ByteString.Internal’ instance Show Data.ByteString.ByteString - -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’ + -- Defined in ‘Data.ByteString.Internal’ instance Eq Data.ByteString.ByteString - -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’ + -- Defined in ‘Data.ByteString.Internal’ instance Ord Data.ByteString.ByteString - -- Defined in ‘bytestring-0.11.4.0:Data.ByteString.Internal.Type’ + -- Defined in ‘Data.ByteString.Internal’ ===================================== testsuite/tests/ghci/scripts/ghci025.stdout ===================================== @@ -53,9 +53,7 @@ Prelude.length :: Data.Foldable.Foldable t => t a -> GHC.Types.Int -- imported via T type T.Integer :: * data T.Integer = ... -T.length :: - bytestring-0.11.4.0:Data.ByteString.Internal.Type.ByteString - -> GHC.Types.Int +T.length :: Data.ByteString.Internal.ByteString -> GHC.Types.Int :browse! T -- defined locally T.length :: T.Integer View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e3db595d80f4b455f768126842e1c76ba387d7bd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e3db595d80f4b455f768126842e1c76ba387d7bd You're receiving 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 Jun 30 15:11:04 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 30 Jun 2023 11:11:04 -0400 Subject: [Git][ghc/ghc][wip/T23576] Add SHRD to patchRegs Message-ID: <649ef08847ef8_238a8e2e300102864ae@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: d3c1c96e by Jaro Reinders at 2023-06-30T17:10:59+02:00 Add SHRD to patchRegs - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/Instr.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/Instr.hs ===================================== @@ -570,6 +570,7 @@ patchRegsOfInstr instr env SHL fmt imm dst -> patch1 (SHL fmt imm) dst SAR fmt imm dst -> patch1 (SAR fmt imm) dst SHR fmt imm dst -> patch1 (SHR fmt imm) dst + SHRD fmt imm dst1 dst2 -> patch2 (SHRD fmt imm) dst1 dst2 BT fmt imm src -> patch1 (BT fmt imm) src TEST fmt src dst -> patch2 (TEST fmt) src dst CMP fmt src dst -> patch2 (CMP fmt) src dst View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d3c1c96ebb766c8a1dec6faa928e15d55c27f4c1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d3c1c96ebb766c8a1dec6faa928e15d55c27f4c1 You're receiving 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 Jun 30 15:13:38 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 30 Jun 2023 11:13:38 -0400 Subject: [Git][ghc/ghc][wip/T23576] Add SHRD to pprInstr Message-ID: <649ef12284ef6_238a8e10ef123428660@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: 131e830a by Jaro Reinders at 2023-06-30T17:13:32+02:00 Add SHRD to pprInstr - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/Ppr.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/Ppr.hs ===================================== @@ -731,6 +731,16 @@ pprInstr platform i = case i of SHR format src dst -> pprShift (text "shr") format src dst + + SHRD format src dst1 dst2 + -> line $ hcat [ + pprMnemonic (text "shrd") format, + pprOperand platform II8 src, -- src is 8-bit sized + comma, + pprOperand platform format dst1, + comma, + pprOperand platform format dst2 + ] BT format imm src -> pprFormatImmOp (text "bt") format imm src View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/131e830a7a60e3d7256c4b7f1e6fbd53ff18d073 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/131e830a7a60e3d7256c4b7f1e6fbd53ff18d073 You're receiving 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 Jun 30 15:26:13 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 30 Jun 2023 11:26:13 -0400 Subject: [Git][ghc/ghc][wip/T23576] Add more shifts Message-ID: <649ef41570dcf_238a8e10ef123428921a@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: da6d9762 by Jaro Reinders at 2023-06-30T17:26:03+02:00 Add more shifts - - - - - 3 changed files: - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToAsm/X86/Instr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -643,6 +643,27 @@ iselExpr64 (CmmMachOp (MO_Mul _) [e1,e2]) = do return (RegCode64 code rhi rlo) iselExpr64 (CmmMachOp (MO_Shl _) [e1,e2]) = do + RegCode64 code1 r1hi r1lo <- iselExpr64 e1 + (r2, code2) <- getSomeReg e2 + Reg64 rhi rlo <- getNewReg64 + b <- newBlockId + let + code = code1 `appOL` + code2 `appOL` + toOL [ MOV II32 (OpReg r1lo) (OpReg rlo), + MOV II32 (OpReg r1hi) (OpReg rhi), + MOV II32 (OpReg r2) (OpReg ecx), + SHLD II32 (OpReg ecx) (OpReg rlo) (OpReg rhi), + SAL II32 (OpReg ecx) (OpReg rlo), + TEST II32 (OpImm (ImmInt 32)) (OpReg ecx), + JXX EQQ b, + MOV II32 (OpReg rlo) (OpReg rhi), + XOR II32 (OpReg rlo) (OpReg rlo), + NEWBLOCK b + ] + return (RegCode64 code rhi rlo) + +iselExpr64 (CmmMachOp (MO_S_Shr _) [e1,e2]) = do RegCode64 code1 r1hi r1lo <- iselExpr64 e1 (r2, code2) <- getSomeReg e2 Reg64 rhi rlo <- getNewReg64 @@ -663,6 +684,27 @@ iselExpr64 (CmmMachOp (MO_Shl _) [e1,e2]) = do ] return (RegCode64 code rhi rlo) +iselExpr64 (CmmMachOp (MO_U_Shr _) [e1,e2]) = do + RegCode64 code1 r1hi r1lo <- iselExpr64 e1 + (r2, code2) <- getSomeReg e2 + Reg64 rhi rlo <- getNewReg64 + b <- newBlockId + let + code = code1 `appOL` + code2 `appOL` + toOL [ MOV II32 (OpReg r1lo) (OpReg rlo), + MOV II32 (OpReg r1hi) (OpReg rhi), + MOV II32 (OpReg r2) (OpReg ecx), + SHRD II32 (OpReg ecx) (OpReg rhi) (OpReg rlo), + SHR II32 (OpReg ecx) (OpReg rhi), + TEST II32 (OpImm (ImmInt 32)) (OpReg ecx), + JXX EQQ b, + MOV II32 (OpReg rhi) (OpReg rlo), + XOR II32 (OpReg rhi) (OpReg rhi), + NEWBLOCK b + ] + return (RegCode64 code rhi rlo) + iselExpr64 expr = do platform <- getPlatform ===================================== compiler/GHC/CmmToAsm/X86/Instr.hs ===================================== @@ -248,8 +248,10 @@ data Instr -- Shifts (amount may be immediate or %cl only) | SHL Format Operand{-amount-} Operand | SAR Format Operand{-amount-} Operand + | SAL Format Operand{-amount-} Operand | SHR Format Operand{-amount-} Operand | SHRD Format Operand{-amount-} Operand Operand + | SHLD Format Operand{-amount-} Operand Operand | BT Format Imm Operand | NOP @@ -398,8 +400,10 @@ regUsageOfInstr platform instr BSWAP _ reg -> mkRU [reg] [reg] NEGI _ op -> usageM op SHL _ imm dst -> usageRM imm dst + SAL _ imm dst -> usageRM imm dst SAR _ imm dst -> usageRM imm dst SHR _ imm dst -> usageRM imm dst + SHLD _ imm dst1 dst2 -> usageRMM imm dst1 dst2 SHRD _ imm dst1 dst2 -> usageRMM imm dst1 dst2 BT _ _ src -> mkRUR (use_R src []) @@ -568,8 +572,10 @@ patchRegsOfInstr instr env BSWAP fmt reg -> BSWAP fmt (env reg) NEGI fmt op -> patch1 (NEGI fmt) op SHL fmt imm dst -> patch1 (SHL fmt imm) dst + SAL fmt imm dst -> patch1 (SAR fmt imm) dst SAR fmt imm dst -> patch1 (SAR fmt imm) dst SHR fmt imm dst -> patch1 (SHR fmt imm) dst + SHLD fmt imm dst1 dst2 -> patch2 (SHRD fmt imm) dst1 dst2 SHRD fmt imm dst1 dst2 -> patch2 (SHRD fmt imm) dst1 dst2 BT fmt imm src -> patch1 (BT fmt imm) src TEST fmt src dst -> patch2 (TEST fmt) src dst ===================================== compiler/GHC/CmmToAsm/X86/Ppr.hs ===================================== @@ -726,21 +726,20 @@ pprInstr platform i = case i of SHL format src dst -> pprShift (text "shl") format src dst + SAL format src dst + -> pprShift (text "sal") format src dst + SAR format src dst -> pprShift (text "sar") format src dst SHR format src dst -> pprShift (text "shr") format src dst + SHLD format src dst1 dst2 + -> pprShift2 (text "shld") format src dst1 dst2 + SHRD format src dst1 dst2 - -> line $ hcat [ - pprMnemonic (text "shrd") format, - pprOperand platform II8 src, -- src is 8-bit sized - comma, - pprOperand platform format dst1, - comma, - pprOperand platform format dst2 - ] + -> pprShift2 (text "shrd") format src dst1 dst2 BT format imm src -> pprFormatImmOp (text "bt") format imm src @@ -1080,6 +1079,17 @@ pprInstr platform i = case i of pprOperand platform format dest ] + pprShift2 :: Line doc -> Format -> Operand -> Operand -> Operand -> doc + pprShift2 name format src dest1 dest2 + = line $ hcat [ + pprMnemonic name format, + pprOperand platform II8 src, -- src is 8-bit sized + comma, + pprOperand platform format dest1, + comma, + pprOperand platform format dest2 + ] + pprFormatOpOpCoerce :: Line doc -> Format -> Format -> Operand -> Operand -> doc pprFormatOpOpCoerce name format1 format2 op1 op2 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/da6d97628c5e5259f0e51d3ed116095d0023e3fb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/da6d97628c5e5259f0e51d3ed116095d0023e3fb You're receiving 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 Jun 30 15:30:51 2023 From: gitlab at gitlab.haskell.org (Jaro Reinders (@Noughtmare)) Date: Fri, 30 Jun 2023 11:30:51 -0400 Subject: [Git][ghc/ghc][wip/T23576] Add bitwise operations Message-ID: <649ef52b4f1c7_238a8e2034164291191@gitlab.mail> Jaro Reinders pushed to branch wip/T23576 at Glasgow Haskell Compiler / GHC Commits: 6d371000 by Jaro Reinders at 2023-06-30T17:30:46+02:00 Add bitwise operations - - - - - 1 changed file: - compiler/GHC/CmmToAsm/X86/CodeGen.hs Changes: ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -705,6 +705,60 @@ iselExpr64 (CmmMachOp (MO_U_Shr _) [e1,e2]) = do ] return (RegCode64 code rhi rlo) +iselExpr64 (CmmMachOp (MO_And _) [e1,e2]) = do + RegCode64 code1 r1hi r1lo <- iselExpr64 e1 + RegCode64 code2 r2hi r2lo <- iselExpr64 e2 + Reg64 rhi rlo <- getNewReg64 + let + code = code1 `appOL` + code2 `appOL` + toOL [ MOV II32 (OpReg r1lo) (OpReg rlo), + MOV II32 (OpReg r1hi) (OpReg rhi), + AND II32 (OpReg r2lo) (OpReg rlo), + AND II32 (OpReg r2hi) (OpReg rhi) + ] + return (RegCode64 code rhi rlo) + +iselExpr64 (CmmMachOp (MO_Or _) [e1,e2]) = do + RegCode64 code1 r1hi r1lo <- iselExpr64 e1 + RegCode64 code2 r2hi r2lo <- iselExpr64 e2 + Reg64 rhi rlo <- getNewReg64 + let + code = code1 `appOL` + code2 `appOL` + toOL [ MOV II32 (OpReg r1lo) (OpReg rlo), + MOV II32 (OpReg r1hi) (OpReg rhi), + OR II32 (OpReg r2lo) (OpReg rlo), + OR II32 (OpReg r2hi) (OpReg rhi) + ] + return (RegCode64 code rhi rlo) + +iselExpr64 (CmmMachOp (MO_Xor _) [e1,e2]) = do + RegCode64 code1 r1hi r1lo <- iselExpr64 e1 + RegCode64 code2 r2hi r2lo <- iselExpr64 e2 + Reg64 rhi rlo <- getNewReg64 + let + code = code1 `appOL` + code2 `appOL` + toOL [ MOV II32 (OpReg r1lo) (OpReg rlo), + MOV II32 (OpReg r1hi) (OpReg rhi), + XOR II32 (OpReg r2lo) (OpReg rlo), + XOR II32 (OpReg r2hi) (OpReg rhi) + ] + return (RegCode64 code rhi rlo) + +iselExpr64 (CmmMachOp (MO_Not _) [e1]) = do + RegCode64 code1 r1hi r1lo <- iselExpr64 e1 + Reg64 rhi rlo <- getNewReg64 + let + code = code1 `appOL` + toOL [ MOV II32 (OpReg r1lo) (OpReg rlo), + MOV II32 (OpReg r1hi) (OpReg rhi), + NOT II32 (OpReg rlo), + NOT II32 (OpReg rhi) + ] + return (RegCode64 code rhi rlo) + iselExpr64 expr = do platform <- getPlatform View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6d371000c30511957b8a82db26235edea9589c64 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6d371000c30511957b8a82db26235edea9589c64 You're receiving 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 Jun 30 16:00:38 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 30 Jun 2023 12:00:38 -0400 Subject: [Git][ghc/ghc][wip/drop-touch] Drop dependence on `touch` Message-ID: <649efc26b45d0_238a8e280c5803035f@gitlab.mail> Ben Gamari pushed to branch wip/drop-touch at Glasgow Haskell Compiler / GHC Commits: 7af47da5 by Ben Gamari at 2023-06-30T12:00:27-04:00 Drop dependence on `touch` This drops GHC's dependence on the `touch` program, instead implementing it within GHC. This eliminates an external dependency and means that we have one fewer program to keep track of in the `configure` script - - - - - 22 changed files: - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools/Tasks.hs - + compiler/GHC/Utils/Touch.hs - compiler/ghc.cabal.in - hadrian/bindist/Makefile - hadrian/bindist/config.mk.in - hadrian/cfg/system.config.in - hadrian/src/Builder.hs - hadrian/src/Hadrian/Builder.hs - hadrian/src/Oracles/Setting.hs - hadrian/src/Packages.hs - hadrian/src/Rules/Generate.hs - hadrian/src/Rules/Program.hs - hadrian/src/Settings/Default.hs - m4/fp_settings.m4 - − utils/touchy/Makefile - − utils/touchy/touchy.c - − utils/touchy/touchy.cabal Changes: ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -259,6 +259,7 @@ import GHC.Utils.Outputable import GHC.Utils.Misc import GHC.Utils.Logger import GHC.Utils.TmpFs +import GHC.Utils.Touch import qualified GHC.LanguageExtensions as LangExt @@ -269,7 +270,6 @@ import qualified GHC.Data.Stream as Stream import GHC.Data.Stream (Stream) import GHC.Data.Maybe -import qualified GHC.SysTools import GHC.SysTools (initSysTools) import GHC.SysTools.BaseDir (findTopDir) @@ -1262,7 +1262,7 @@ hscMaybeWriteIface logger dflags is_simple iface old_iface mod_location = do -- .hie files. let hie_file = ml_hie_file mod_location whenM (doesFileExist hie_file) $ - GHC.SysTools.touch logger dflags "Touching hie file" hie_file + GHC.Utils.Touch.touch hie_file else -- See Note [Strictness in ModIface] forceModIface iface ===================================== compiler/GHC/Driver/Pipeline/Execute.hs ===================================== @@ -72,6 +72,7 @@ import System.IO import GHC.Linker.ExtraObj import GHC.Linker.Dynamic import GHC.Utils.Panic +import GHC.Utils.Touch import GHC.Unit.Module.Env import GHC.Driver.Env.KnotVars import GHC.Driver.Config.Finder @@ -364,12 +365,9 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do -- | Run the JS Backend postHsc phase. runJsPhase :: PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO FilePath runJsPhase _pipe_env hsc_env _location input_fn = do - let dflags = hsc_dflags hsc_env - let logger = hsc_logger hsc_env - -- The object file is already generated. We only touch it to ensure the -- timestamp is refreshed, see Note [JS Backend .o file procedure]. - touchObjectFile logger dflags input_fn + touchObjectFile input_fn return input_fn @@ -552,7 +550,7 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do -- In the case of hs-boot files, generate a dummy .o-boot -- stamp file for the benefit of Make - HsBootFile -> touchObjectFile logger dflags o_file + HsBootFile -> touchObjectFile o_file HsSrcFile -> panic "HscUpdate not relevant for HscSrcFile" -- MP: I wonder if there are any lurking bugs here because we @@ -1148,10 +1146,10 @@ linkDynLibCheck logger tmpfs dflags unit_env o_files dep_units = do -touchObjectFile :: Logger -> DynFlags -> FilePath -> IO () -touchObjectFile logger dflags path = do +touchObjectFile :: FilePath -> IO () +touchObjectFile path = do createDirectoryIfMissing True $ takeDirectory path - GHC.SysTools.touch logger dflags "Touching object file" path + GHC.Utils.Touch.touch path -- Note [-fPIC for assembler] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -102,7 +102,6 @@ module GHC.Driver.Session ( sPgm_l, sPgm_lm, sPgm_dll, - sPgm_T, sPgm_windres, sPgm_ar, sPgm_ranlib, @@ -137,7 +136,7 @@ module GHC.Driver.Session ( versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, pgm_L, pgm_P, pgm_F, pgm_c, pgm_cxx, pgm_cpp, pgm_a, pgm_l, pgm_lm, - pgm_dll, pgm_T, pgm_windres, pgm_ar, + pgm_dll, pgm_windres, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, @@ -406,8 +405,6 @@ pgm_lm :: DynFlags -> Maybe (String,[Option]) pgm_lm dflags = toolSettings_pgm_lm $ toolSettings dflags pgm_dll :: DynFlags -> (String,[Option]) pgm_dll dflags = toolSettings_pgm_dll $ toolSettings dflags -pgm_T :: DynFlags -> String -pgm_T dflags = toolSettings_pgm_T $ toolSettings dflags pgm_windres :: DynFlags -> String pgm_windres dflags = toolSettings_pgm_windres $ toolSettings dflags pgm_lcc :: DynFlags -> (String,[Option]) ===================================== compiler/GHC/Settings.hs ===================================== @@ -34,7 +34,6 @@ module GHC.Settings , sPgm_l , sPgm_lm , sPgm_dll - , sPgm_T , sPgm_windres , sPgm_ar , sPgm_otool @@ -111,7 +110,6 @@ data ToolSettings = ToolSettings -- merging, hence the 'Maybe'. See Note [Object merging] in -- "GHC.Driver.Pipeline.Execute" for details. , toolSettings_pgm_dll :: (String, [Option]) - , toolSettings_pgm_T :: String , toolSettings_pgm_windres :: String , toolSettings_pgm_ar :: String , toolSettings_pgm_otool :: String @@ -226,8 +224,6 @@ sPgm_lm :: Settings -> Maybe (String, [Option]) sPgm_lm = toolSettings_pgm_lm . sToolSettings sPgm_dll :: Settings -> (String, [Option]) sPgm_dll = toolSettings_pgm_dll . sToolSettings -sPgm_T :: Settings -> String -sPgm_T = toolSettings_pgm_T . sToolSettings sPgm_windres :: Settings -> String sPgm_windres = toolSettings_pgm_windres . sToolSettings sPgm_ar :: Settings -> String ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -125,8 +125,6 @@ initSettings top_dir = do install_name_tool_path <- getToolSetting "install_name_tool command" ranlib_path <- getToolSetting "ranlib command" - touch_path <- getToolSetting "touch command" - mkdll_prog <- getToolSetting "dllwrap command" let mkdll_args = [] @@ -191,7 +189,6 @@ initSettings top_dir = do , toolSettings_pgm_l = (ld_prog, ld_args) , toolSettings_pgm_lm = ld_r , toolSettings_pgm_dll = (mkdll_prog,mkdll_args) - , toolSettings_pgm_T = touch_path , toolSettings_pgm_windres = windres_path , toolSettings_pgm_ar = ar_path , toolSettings_pgm_otool = otool_path ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -395,6 +395,3 @@ runWindres logger dflags args = traceSystoolCommand logger "windres" $ do mb_env <- getGccEnv cc_args runSomethingFiltered logger id "Windres" windres (opts ++ args) Nothing mb_env -touch :: Logger -> DynFlags -> String -> String -> IO () -touch logger dflags purpose arg = traceSystoolCommand logger "touch" $ - runSomething logger purpose (pgm_T dflags) [FileOption "" arg] ===================================== compiler/GHC/Utils/Touch.hs ===================================== @@ -0,0 +1,34 @@ +{-# LANGUAGE CPP #-} + +module GHC.Utils.Touch (touch) where + +import GHC.Prelude + +#if defined(mingw32_HOST_OS) +import System.Win32.File +import System.Win32.Time +#else +import System.Posix.Files +import System.Posix.IO +#endif + +-- | Set the mtime of the given file to the current time. +touch :: FilePath -> IO () +touch file = do +#if defined(mingw32_HOST_OS) + hdl <- createFile file gENERIC_WRITE fILE_SHARE_NONE Nothing oPEN_ALWAYS fILE_ATTRIBUTE_NORMAL Nothing + t <- getSystemTimeAsFileTime + setFileTime hdl Nothing Nothing (Just t) + closeHandle hdl +#else +#if MIN_VERSION_unix(2,8,0) + let oflags = defaultFileFlags { noctty = True, creat = Just 0o666 } + fd <- openFd file WriteOnly oflags +#else + let oflags = defaultFileFlags { noctty = True } + fd <- openFd file WriteOnly (Just 0o666) oflags +#endif + touchFd fd + closeFd fd +#endif + ===================================== compiler/ghc.cabal.in ===================================== @@ -902,6 +902,7 @@ Library GHC.Utils.Ppr GHC.Utils.Ppr.Colour GHC.Utils.TmpFs + GHC.Utils.Touch GHC.Utils.Trace GHC.Wasm.ControlFlow GHC.Wasm.ControlFlow.FromCmm ===================================== hadrian/bindist/Makefile ===================================== @@ -102,7 +102,6 @@ lib/settings : config.mk @echo ',("ranlib command", "$(SettingsRanlibCommand)")' >> $@ @echo ',("otool command", "$(SettingsOtoolCommand)")' >> $@ @echo ',("install_name_tool command", "$(SettingsInstallNameToolCommand)")' >> $@ - @echo ',("touch command", "$(SettingsTouchCommand)")' >> $@ @echo ',("dllwrap command", "$(SettingsDllWrapCommand)")' >> $@ @echo ',("windres command", "$(SettingsWindresCommand)")' >> $@ @echo ',("unlit command", "$$topdir/bin/$(CrossCompilePrefix)unlit")' >> $@ ===================================== hadrian/bindist/config.mk.in ===================================== @@ -274,7 +274,6 @@ SettingsRanlibCommand = @SettingsRanlibCommand@ SettingsDllWrapCommand = @SettingsDllWrapCommand@ SettingsWindresCommand = @SettingsWindresCommand@ SettingsLibtoolCommand = @SettingsLibtoolCommand@ -SettingsTouchCommand = @SettingsTouchCommand@ SettingsClangCommand = @SettingsClangCommand@ SettingsLlcCommand = @SettingsLlcCommand@ SettingsOptCommand = @SettingsOptCommand@ ===================================== hadrian/cfg/system.config.in ===================================== @@ -158,7 +158,6 @@ settings-otool-command = @SettingsOtoolCommand@ settings-install_name_tool-command = @SettingsInstallNameToolCommand@ settings-dll-wrap-command = @SettingsDllWrapCommand@ settings-windres-command = @SettingsWindresCommand@ -settings-touch-command = @SettingsTouchCommand@ settings-clang-command = @SettingsClangCommand@ settings-llc-command = @SettingsLlcCommand@ settings-opt-command = @SettingsOptCommand@ ===================================== hadrian/src/Builder.hs ===================================== @@ -236,7 +236,6 @@ instance H.Builder Builder where pure [] Ghc _ stage -> do root <- buildRoot - touchyPath <- programPath (vanillaContext (Stage0 InTreeLibs) touchy) unlitPath <- builderPath Unlit -- GHC from the previous stage is used to build artifacts in the @@ -245,7 +244,6 @@ instance H.Builder Builder where return $ [ unlitPath ] ++ ghcdeps - ++ [ touchyPath | windowsHost ] ++ [ root -/- mingwStamp | windowsHost ] -- proxy for the entire mingw toolchain that -- we have in inplace/mingw initially, and then at ===================================== hadrian/src/Hadrian/Builder.hs ===================================== @@ -49,8 +49,8 @@ class ShakeValue b => Builder b where -- capture the @stdout@ result and return it. askBuilderWith :: b -> BuildInfo -> Action String - -- | Runtime dependencies of a builder. For example, on Windows GHC requires - -- the utility @touchy.exe@ to be available on a specific path. + -- | Runtime dependencies of a builder. For example, GHC requires the + -- utility @unlit@ to be available on a specific path. runtimeDependencies :: b -> Action [FilePath] runtimeDependencies _ = return [] ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -125,7 +125,6 @@ data SettingsFileSetting | SettingsFileSetting_InstallNameToolCommand | SettingsFileSetting_DllWrapCommand | SettingsFileSetting_WindresCommand - | SettingsFileSetting_TouchCommand | SettingsFileSetting_ClangCommand | SettingsFileSetting_LlcCommand | SettingsFileSetting_OptCommand @@ -223,7 +222,6 @@ settingsFileSetting key = lookupSystemConfig $ case key of SettingsFileSetting_InstallNameToolCommand -> "settings-install_name_tool-command" SettingsFileSetting_DllWrapCommand -> "settings-dll-wrap-command" SettingsFileSetting_WindresCommand -> "settings-windres-command" - SettingsFileSetting_TouchCommand -> "settings-touch-command" SettingsFileSetting_ClangCommand -> "settings-clang-command" SettingsFileSetting_LlcCommand -> "settings-llc-command" SettingsFileSetting_OptCommand -> "settings-opt-command" ===================================== hadrian/src/Packages.hs ===================================== @@ -8,7 +8,7 @@ module Packages ( ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, libffi, mtl, parsec, pretty, primitive, process, remoteIserv, rts, - runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, touchy, + runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout, transformers, unlit, unix, win32, xhtml, lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, ghcPackages, isGhcPackage, @@ -40,7 +40,7 @@ ghcPackages = , ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell - , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml + , terminfo, text, time, transformers, unlit, unix, win32, xhtml , timeout , lintersCommon , lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace ] @@ -56,7 +56,7 @@ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, count ghcCompact, ghcConfig, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, - terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml, + terminfo, text, time, transformers, unlit, unix, win32, xhtml, timeout, lintersCommon, lintNotes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace :: Package @@ -117,7 +117,6 @@ terminfo = lib "terminfo" text = lib "text" time = lib "time" timeout = util "timeout" `setPath` "testsuite/timeout" -touchy = util "touchy" transformers = lib "transformers" unlit = util "unlit" unix = lib "unix" @@ -192,12 +191,12 @@ programName Context {..} = do -- | The 'FilePath' to a program executable in a given 'Context'. programPath :: Context -> Action FilePath programPath context at Context {..} = do - -- TODO: The @touchy@ utility lives in the @lib/bin@ directory instead of - -- @bin@, which is likely just a historical accident that should be fixed. - -- See: https://github.com/snowleopard/hadrian/issues/570 - -- Likewise for @iserv@ and @unlit at . + -- TODO: The @iserv@ and @unlit@ utilities live in the @lib/bin@ directory + -- instead of @bin@, which is likely just a historical accident that should + -- be fixed. See: + -- https://github.com/snowleopard/hadrian/issues/570 name <- programName context - path <- if package `elem` [iserv, touchy, unlit] + path <- if package `elem` [iserv, unlit] then stageLibPath stage <&> (-/- "bin") else stageBinPath stage return $ path -/- name <.> exe @@ -210,7 +209,7 @@ timeoutPath = "testsuite/timeout/install-inplace/bin/timeout" <.> exe -- TODO: Can we extract this information from Cabal files? -- | Some program packages should not be linked with Haskell main function. nonHsMainPackage :: Package -> Bool -nonHsMainPackage = (`elem` [hp2ps, iserv, touchy, unlit, ghciWrapper]) +nonHsMainPackage = (`elem` [hp2ps, iserv, unlit, ghciWrapper]) -- TODO: Combine this with 'programName'. -- | Path to the @autogen@ directory generated by 'buildAutogenFiles'. ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -461,7 +461,6 @@ generateSettings = do , ("ranlib command", expr $ settingsFileSetting SettingsFileSetting_RanlibCommand) , ("otool command", expr $ settingsFileSetting SettingsFileSetting_OtoolCommand) , ("install_name_tool command", expr $ settingsFileSetting SettingsFileSetting_InstallNameToolCommand) - , ("touch command", expr $ settingsFileSetting SettingsFileSetting_TouchCommand) , ("dllwrap command", expr $ settingsFileSetting SettingsFileSetting_DllWrapCommand) , ("windres command", expr $ settingsFileSetting SettingsFileSetting_WindresCommand) , ("unlit command", ("$topdir/bin/" <>) <$> expr (programName (ctx { Context.package = unlit }))) ===================================== hadrian/src/Rules/Program.hs ===================================== @@ -105,7 +105,7 @@ buildProgram bin ctx@(Context{..}) rs = do (True, s) | s > stage0InTree -> do srcDir <- buildRoot <&> (-/- (stageString stage0InTree -/- "bin")) copyFile (srcDir -/- takeFileName bin) bin - (False, s) | s > stage0InTree && (package `elem` [touchy, unlit]) -> do + (False, s) | s > stage0InTree && (package `elem` [unlit]) -> do srcDir <- stageLibPath stage0InTree <&> (-/- "bin") copyFile (srcDir -/- takeFileName bin) bin _ -> buildBinary rs bin ctx ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -105,7 +105,6 @@ stage0Packages = do ] ++ [ terminfo | not windowsHost, not cross ] ++ [ timeout | windowsHost ] - ++ [ touchy | windowsHost ] -- | Packages built in 'Stage1' by default. You can change this in "UserSettings". stage1Packages :: Action [Package] @@ -155,9 +154,8 @@ stage1Packages = do , runGhc ] , when (winTarget && not cross) - [ touchy - -- See Note [Hadrian's ghci-wrapper package] - , ghciWrapper + [ -- See Note [Hadrian's ghci-wrapper package] + ghciWrapper ] ] @@ -185,16 +183,14 @@ defaultLibraryWays = Set.fromList <$> defaultRtsWays :: Ways defaultRtsWays = Set.fromList <$> mconcat - [ pure [vanilla] + [ pure [vanilla, threaded] , notStage0 ? pure - [ profiling, debugProfiling - , debug + [ profiling, threadedProfiling, debugProfiling, threadedDebugProfiling + , debug, threadedDebug ] - , notStage0 ? targetSupportsThreadedRts ? pure [threaded, threadedProfiling, threadedDebugProfiling, threadedDebug] , notStage0 ? platformSupportsSharedLibs ? pure - [ dynamic, debugDynamic + [ dynamic, threadedDynamic, debugDynamic, threadedDebugDynamic ] - , notStage0 ? platformSupportsSharedLibs ? targetSupportsThreadedRts ? pure [ threadedDynamic, threadedDebugDynamic ] ] -- TODO: Move C source arguments here ===================================== m4/fp_settings.m4 ===================================== @@ -25,7 +25,6 @@ AC_DEFUN([FP_SETTINGS], SettingsRanlibCommand="${mingw_bin_prefix}llvm-ranlib.exe" SettingsDllWrapCommand="${mingw_bin_prefix}llvm-dllwrap.exe" SettingsWindresCommand="${mingw_bin_prefix}llvm-windres.exe" - SettingsTouchCommand='$$topdir/bin/touchy.exe' else # This case handles the "normal" platforms (e.g. not Windows) where we @@ -56,12 +55,6 @@ AC_DEFUN([FP_SETTINGS], SettingsWindresCommand="$WindresCmd" fi - if test "$HostOS" = "mingw32"; then - SettingsTouchCommand='$$topdir/bin/touchy.exe' - else - SettingsTouchCommand='touch' - fi - if test "$EnableDistroToolchain" = "YES"; then # If the user specified --enable-distro-toolchain then we just use the # executable names, not paths. @@ -123,7 +116,6 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsInstallNameToolCommand) AC_SUBST(SettingsDllWrapCommand) AC_SUBST(SettingsWindresCommand) - AC_SUBST(SettingsTouchCommand) AC_SUBST(SettingsClangCommand) AC_SUBST(SettingsLlcCommand) AC_SUBST(SettingsOptCommand) ===================================== utils/touchy/Makefile deleted ===================================== @@ -1,37 +0,0 @@ -# ----------------------------------------------------------------------------- -# -# (c) 2009 The University of Glasgow -# -# This file is part of the GHC build system. -# -# To understand how the build system works and how to modify it, see -# https://gitlab.haskell.org/ghc/ghc/wikis/building/architecture -# https://gitlab.haskell.org/ghc/ghc/wikis/building/modifying -# -# ----------------------------------------------------------------------------- - -# -# Substitute for 'touch' on win32 platforms (without an Unix toolset installed). -# -TOP=../.. -include $(TOP)/mk/boilerplate.mk - -C_SRCS=touchy.c -C_PROG=touchy -SRC_CC_OPTS += -O - -# -# Install touchy in lib/.* -# -INSTALL_LIBEXECS += $(C_PROG) - -include $(TOP)/mk/target.mk - -# Get it over with! -boot :: all - -binary-dist: - $(INSTALL_DIR) $(BIN_DIST_DIR)/utils/touchy - $(INSTALL_DATA) Makefile $(BIN_DIST_DIR)/utils/touchy/ - $(INSTALL_PROGRAM) $(C_PROG) $(BIN_DIST_DIR)/utils/touchy/ - ===================================== utils/touchy/touchy.c deleted ===================================== @@ -1,123 +0,0 @@ -/* - * Simple 'touch' program for Windows - * - */ -#if !defined(_WIN32) -#error "Win32-only, the platform you're using is supposed to have 'touch' already." -#else -#include -#include -#include -#include -#include -#include -#include - -/* -touch is used by GHC both during building and during compilation of -Haskell files. Unfortunately this means we need a 'touch' like program -in the GHC bindist. Since touch is not standard on Windows and msys2 -doesn't include a mingw-w64 build of coreutils we need touchy for now. - -With Windows 7 in a virtual box VM on OS X, some very odd things happen -with dates and time stamps when SSHing into cygwin. e.g. here the -"Change" time is in the past: - -$ date; touch foo; stat foo -Fri Dec 2 16:58:07 GMTST 2011 - File: `foo' - Size: 0 Blocks: 0 IO Block: 65536 regular -empty file -Device: 540aba0bh/1409989131d Inode: 562949953592977 Links: 1 -Access: (0644/-rw-r--r--) Uid: ( 1000/ ian) Gid: ( 513/ None) -Access: 2011-12-02 16:58:07.414457900 +0000 -Modify: 2011-12-02 16:58:07.414457900 +0000 -Change: 2011-12-02 16:58:03.495141800 +0000 - Birth: 2011-12-02 16:57:57.731469900 +0000 - -And if we copy such a file, then the copy is older (as determined by the -"Modify" time) than the original: - -$ date; touch foo; stat foo; cp foo bar; stat bar -Fri Dec 2 16:59:10 GMTST 2011 - File: `foo' - Size: 0 Blocks: 0 IO Block: 65536 regular -empty file -Device: 540aba0bh/1409989131d Inode: 1407374883725128 Links: 1 -Access: (0644/-rw-r--r--) Uid: ( 1000/ ian) Gid: ( 513/ None) -Access: 2011-12-02 16:59:10.118457900 +0000 -Modify: 2011-12-02 16:59:10.118457900 +0000 -Change: 2011-12-02 16:59:06.189477700 +0000 - Birth: 2011-12-02 16:57:57.731469900 +0000 - File: `bar' - Size: 0 Blocks: 0 IO Block: 65536 regular -empty file -Device: 540aba0bh/1409989131d Inode: 281474976882512 Links: 1 -Access: (0644/-rw-r--r--) Uid: ( 1000/ ian) Gid: ( 513/ None) -Access: 2011-12-02 16:59:06.394555800 +0000 -Modify: 2011-12-02 16:59:06.394555800 +0000 -Change: 2011-12-02 16:59:06.395532400 +0000 - Birth: 2011-12-02 16:58:40.921899600 +0000 - -This means that make thinks that things are out of date when it -shouldn't, so reinvokes itself repeatedly until the MAKE_RESTARTS -infinite-recursion test triggers. - -The touchy program, like most other programs, creates files with both -Modify and Change in the past, which is still a little odd, but is -consistent, so doesn't break make. - -We used to use _utime(argv[i],NULL)) to set the file modification times, -but after a BST -> GMT change this started giving files a modification -time an hour in the future: - -$ date; utils/touchy/dist/build/tmp/touchy testfile; stat testfile -Tue, Oct 30, 2012 11:33:06 PM - File: `testfile' - Size: 0 Blocks: 0 IO Block: 65536 regular empty file -Device: 540aba0bh/1409989131d Inode: 9851624184986293 Links: 1 -Access: (0755/-rwxr-xr-x) Uid: ( 1000/ ian) Gid: ( 513/ None) -Access: 2012-10-31 00:33:06.000000000 +0000 -Modify: 2012-10-31 00:33:06.000000000 +0000 -Change: 2012-10-30 23:33:06.769118900 +0000 - Birth: 2012-10-30 23:33:06.769118900 +0000 - -so now we use the Win32 functions GetSystemTimeAsFileTime and SetFileTime. -*/ - -int -main(int argc, char** argv) -{ - int i; - FILETIME ft; - BOOL b; - HANDLE hFile; - - if (argc == 1) { - fprintf(stderr, "Usage: %s \n", argv[0]); - return 1; - } - - for (i = 1; i < argc; i++) { - hFile = CreateFile(argv[i], GENERIC_WRITE, 0, NULL, OPEN_ALWAYS, - FILE_ATTRIBUTE_NORMAL, NULL); - if (hFile == INVALID_HANDLE_VALUE) { - fprintf(stderr, "Unable to open %s\n", argv[i]); - exit(1); - } - GetSystemTimeAsFileTime(&ft); - b = SetFileTime(hFile, (LPFILETIME) NULL, (LPFILETIME) NULL, &ft); - if (b == 0) { - fprintf(stderr, "Unable to change mod. time for %s\n", argv[i]); - exit(1); - } - b = CloseHandle(hFile); - if (b == 0) { - fprintf(stderr, "Closing failed for %s\n", argv[i]); - exit(1); - } - } - - return 0; -} -#endif ===================================== utils/touchy/touchy.cabal deleted ===================================== @@ -1,15 +0,0 @@ -cabal-version: 2.2 -Name: touchy -Version: 0.1 -Copyright: XXX -License: BSD-3-Clause -Author: XXX -Maintainer: XXX -Synopsis: @touch@ for windows -Description: XXX -Category: Development -build-type: Simple - -Executable touchy - Default-Language: Haskell2010 - Main-Is: touchy.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7af47da5077576672c7325fe2dac4083cb36a9c4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7af47da5077576672c7325fe2dac4083cb36a9c4 You're receiving 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 Jun 30 16:03:57 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 30 Jun 2023 12:03:57 -0400 Subject: [Git][ghc/ghc][wip/T21134] 71 commits: IPE data compression Message-ID: <649efced39952_238a8e2e300103041c7@gitlab.mail> Ben Gamari pushed to branch wip/T21134 at Glasgow Haskell Compiler / GHC Commits: cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - 5125cba0 by Ben Gamari at 2023-06-30T12:03:49-04:00 Drop latent mentions of -split-objs Closes #21134. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - .gitlab/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.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 - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/191fd7b77ed375a70be5e06fc85ddde5047c45e8...5125cba0507700eae7e024baddd12dfca60eb553 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/191fd7b77ed375a70be5e06fc85ddde5047c45e8...5125cba0507700eae7e024baddd12dfca60eb553 You're receiving 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 Jun 30 16:39:05 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 30 Jun 2023 12:39:05 -0400 Subject: [Git][ghc/ghc][master] hadrian: Fix dependencies of docs:* rule Message-ID: <649f0529d08a_238a8ec95a43306a3@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - 1 changed file: - hadrian/src/Rules/Documentation.hs Changes: ===================================== hadrian/src/Rules/Documentation.hs ===================================== @@ -258,6 +258,15 @@ buildPackageDocumentation = do need [ takeDirectory file -/- "haddock-prologue.txt"] haddocks <- haddockDependencies context + -- Build Haddock documentation + -- TODO: Pass the correct way from Rules via Context. + dynamicPrograms <- dynamicGhcPrograms =<< flavour + let haddockWay = if dynamicPrograms then dynamic else vanilla + + -- Build the dependencies of the package we are going to build documentation for + dep_pkgs <- sequence [pkgConfFile (context { way = haddockWay, Context.package = p}) + | (p, _) <- haddocks] + -- `ghc-prim` has a source file for 'GHC.Prim' which is generated just -- for Haddock. We need to 'union' (instead of '++') to avoid passing -- 'GHC.PrimopWrappers' (which unfortunately shows up in both @@ -266,12 +275,8 @@ buildPackageDocumentation = do vanillaSrcs <- hsSources context let srcs = vanillaSrcs `union` generatedSrcs - need $ srcs ++ (map snd haddocks) + need $ srcs ++ (map snd haddocks) ++ dep_pkgs - -- Build Haddock documentation - -- TODO: Pass the correct way from Rules via Context. - dynamicPrograms <- dynamicGhcPrograms =<< flavour - let haddockWay = if dynamicPrograms then dynamic else vanilla statsFilesDir <- haddockStatsFilesDir createDirectory statsFilesDir build $ target (context {way = haddockWay}) (Haddock BuildPackage) srcs [file] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d7f6448aa06bbf26173a06ee5c624f5b734786c5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d7f6448aa06bbf26173a06ee5c624f5b734786c5 You're receiving 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 Jun 30 16:39:45 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 30 Jun 2023 12:39:45 -0400 Subject: [Git][ghc/ghc][master] Add tests for #22106 Message-ID: <649f0551e9b43_238a8e10ef1234335991@gitlab.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - 7 changed files: - + testsuite/tests/overloadedrecflds/should_compile/T22106_A.hs - + testsuite/tests/overloadedrecflds/should_compile/T22106_B.hs - + testsuite/tests/overloadedrecflds/should_compile/T22106_C.hs - + testsuite/tests/overloadedrecflds/should_compile/T22106_C.stderr - + testsuite/tests/overloadedrecflds/should_compile/T22106_D.hs - + testsuite/tests/overloadedrecflds/should_compile/T22106_aux.hs - testsuite/tests/overloadedrecflds/should_compile/all.T Changes: ===================================== testsuite/tests/overloadedrecflds/should_compile/T22106_A.hs ===================================== @@ -0,0 +1,5 @@ +module T22106_A where + +import T22106_aux ( foo ) + +xyzzy = foo ===================================== testsuite/tests/overloadedrecflds/should_compile/T22106_B.hs ===================================== @@ -0,0 +1,5 @@ +module T22106_B where + +import T22106_aux ( T(foo) ) + +xyzzy r = r { foo = 3 } ===================================== testsuite/tests/overloadedrecflds/should_compile/T22106_C.hs ===================================== @@ -0,0 +1,5 @@ +module T22106_C where + +import T22106_aux ( bar ) + +xyzzy = bar ===================================== testsuite/tests/overloadedrecflds/should_compile/T22106_C.stderr ===================================== @@ -0,0 +1,6 @@ + +T22106_C.hs:5:9: error: [GHC-88464] + Variable not in scope: bar + Suggested fix: + Notice that ‘bar’ is a field selector belonging to the type ‘T22106_aux.T’ + that has been suppressed by NoFieldSelectors. ===================================== testsuite/tests/overloadedrecflds/should_compile/T22106_D.hs ===================================== @@ -0,0 +1,5 @@ +module T22106_D where + +import T22106_aux ( T(bar) ) + +xyzzy r = r { bar = 7 } ===================================== testsuite/tests/overloadedrecflds/should_compile/T22106_aux.hs ===================================== @@ -0,0 +1,6 @@ +{-# LANGUAGE NoFieldSelectors #-} + +module T22106_aux where + +data T = MkT { foo :: Int, bar :: Int } +foo = () ===================================== testsuite/tests/overloadedrecflds/should_compile/all.T ===================================== @@ -50,3 +50,8 @@ test('BootFldReexport' test('T23220' , [req_th, extra_files(['T23220_aux.hs'])] , multimod_compile, ['T23220_aux.hs T23220.hs', '-v0']) + +test('T22106_A', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_A', '-v0']) +test('T22106_B', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_B', '-v0']) +test('T22106_C', [extra_files(['T22106_aux.hs'])], multimod_compile_fail, ['T22106_C', '-v0']) +test('T22106_D', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_D', '-v0']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cec903899234bf9e25ea404477ba846ac1e963bb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cec903899234bf9e25ea404477ba846ac1e963bb You're receiving 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 Jun 30 17:11:41 2023 From: gitlab at gitlab.haskell.org (Marge Bot (@marge-bot)) Date: Fri, 30 Jun 2023 13:11:41 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 12 commits: hadrian: Fix dependencies of docs:* rule Message-ID: <649f0ccd3e70_238a8e280c5803518ef@gitlab.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - bb381619 by Ben Gamari at 2023-06-30T13:11:12-04:00 rts: Ensure that pinned allocations respect block size Previously, it was possible for pinned, aligned allocation requests to allocate beyond the end of the pinned accumulator block. Specifically, we failed to account for the padding needed to achieve the requested alignment in the "large object" check. With large alignment requests, this can result in the allocator using the capability's pinned object accumulator block to service a request which is larger than `PINNED_EMPTY_SIZE`. To fix this we reorganize `allocatePinned` to consistently account for the alignment padding in all large object checks. This is a bit subtle as we must handle the case of a small allocation request filling the accumulator block, as well as large requests. Fixes #23400. - - - - - d97ac8b8 by Ben Gamari at 2023-06-30T13:11:12-04:00 testsuite: Add test for #23400 - - - - - d257e82d by Ben Gamari at 2023-06-30T13:11:12-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 9f76f95b by Ben Gamari at 2023-06-30T13:11:12-04:00 Drop circle-ci-job.sh - - - - - cc26a386 by Ben Gamari at 2023-06-30T13:11:12-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - e71eb40a by Ben Gamari at 2023-06-30T13:11:12-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - e81f8bd8 by Ben Gamari at 2023-06-30T13:11:13-04:00 ghc-heap: Support for BLOCKING_QUEUE closures - - - - - a9fcc38a by Ben Bellick at 2023-06-30T13:11:18-04:00 Add some structured diagnostics in Tc/Validity.hs This addresses the work of ticket #20118 Created the following constructors for TcRnMessage - TcRnInaccessibleCoAxBranch - TcRnPatersonCondFailure - - - - - f705e71d by Ryan Hendrickson at 2023-06-30T13:11:24-04:00 Add regression test for #23549 - - - - - ae1dd0c5 by Alexis King at 2023-06-30T13:11:34-04:00 perf tests: Increase default stack size for MultiLayerModules An unhelpfully small stack size appears to have been the real culprit behind the metric fluctuations in #19293. Debugging metric decreases triggered by !10729 helped to finally identify the problem. Metric Decrease: MultiLayerModules MultiLayerModulesTH_Make T13701 T14697 - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Utils/TcType.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Error/Codes.hs - hadrian/src/Rules/Documentation.hs - libraries/ghc-heap/GHC/Exts/Heap.hs - rts/Heap.c - rts/sm/Storage.c - testsuite/driver/runtests.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - testsuite/tests/dependent/should_compile/T14066a.stderr - testsuite/tests/deriving/should_fail/T8165_fail2.stderr - testsuite/tests/indexed-types/should_compile/T9085.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ae248f33f8b3c470a4f78136699123b6dee66ac1...ae1dd0c5ca5e4bbcad28854b29727f366655b908 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ae248f33f8b3c470a4f78136699123b6dee66ac1...ae1dd0c5ca5e4bbcad28854b29727f366655b908 You're receiving 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 Jun 30 18:03:41 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 30 Jun 2023 14:03:41 -0400 Subject: [Git][ghc/ghc][wip/T23577] hadrian: Only pass -Wno-nonportable-include-path on Darwin Message-ID: <649f18fd93f91_238a8e1a29554438183@gitlab.mail> Ben Gamari pushed to branch wip/T23577 at Glasgow Haskell Compiler / GHC Commits: a9fc4dfd by Ben Gamari at 2023-06-30T13:41:29-04:00 hadrian: Only pass -Wno-nonportable-include-path on Darwin This flag, which was introduced due to #17798, is specific to the Darwin toolchain and consequently throws warnings on other platforms. See #23577. - - - - - 1 changed file: - hadrian/src/Settings/Warnings.hs Changes: ===================================== hadrian/src/Settings/Warnings.hs ===================================== @@ -2,6 +2,7 @@ module Settings.Warnings (defaultGhcWarningsArgs, ghcWarningsArgs) where import Expression import Oracles.Flag +import Oracles.Setting (isOsxTarget) import Packages -- See @mk/warnings.mk@ for warning-related arguments in the Make build system. @@ -12,7 +13,7 @@ defaultGhcWarningsArgs = mconcat [ notStage0 ? arg "-Wnoncanonical-monad-instances" , notM (flag CcLlvmBackend) ? arg "-optc-Wno-error=inline" , flag CcLlvmBackend ? arg "-optc-Wno-unknown-pragmas" - , arg "-optP-Wno-nonportable-include-path" -- #17798 + , isOsxTarget ? arg "-optP-Wno-nonportable-include-path" -- #17797 ] -- | Package-specific warnings-related arguments, mostly suppressing various warnings. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a9fc4dfd4a6558cfd1a4dcf8ad9680c8e4c8515c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a9fc4dfd4a6558cfd1a4dcf8ad9680c8e4c8515c You're receiving 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 Jun 30 18:10:54 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 30 Jun 2023 14:10:54 -0400 Subject: [Git][ghc/ghc][wip/base-stability] 293 commits: Replace the implementation of CodeBuffers with unboxed types Message-ID: <649f1aae532f2_238a8e1a2955443864f2@gitlab.mail> Ben Gamari pushed to branch wip/base-stability at Glasgow Haskell Compiler / GHC Commits: fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 68e474fd by Ben Gamari at 2023-06-29T10:59:06-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - eddaa89c by Ben Gamari at 2023-06-29T11:10:50-04:00 Drop circle-ci-job.sh - - - - - 9c2ba7ed by Ben Gamari at 2023-06-29T11:10:50-04:00 testsuite: Allow preservation of unexpected output Here we introduce a new flag to the testsuite driver, --unexpected-output-dir=<dir>, which allows the user to ask the driver to preserve unexpected output from tests. The intent is for this to be used in CI to allow users to more easily fix unexpected platform-dependent output. - - - - - 3bdc8b13 by Ben Gamari at 2023-06-29T13:58:23-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - d13f10ff by Ben Gamari at 2023-06-29T13:58:32-04:00 gitlab-ci: Preserve unexpected output Here we enable use of the testsuite driver's `--unexpected-output-dir` flag by CI, preserving the result as an artifact for use by users. - - - - - f9b38e18 by Ben Gamari at 2023-06-29T13:58:32-04:00 compiler: Make OccSet opaque - - - - - 2e4ed59f by Ben Gamari at 2023-06-29T13:58:32-04:00 compiler: Rework ShowSome Previously the field used to filter the sub-declarations to show was rather ad-hoc and was only able to show at most one sub-declaration. - - - - - 8e0c11f6 by Ben Gamari at 2023-06-29T23:08:16-04: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. - - - - - 5fc9a62c by Ben Gamari at 2023-06-30T14:09:51-04:00 base: Introduce Data.Enum - - - - - 62eb85d0 by Ben Gamari at 2023-06-30T14:09:51-04:00 base: Add export list to GHC.Num.Integer - - - - - e3a64752 by Ben Gamari at 2023-06-30T14:09:51-04:00 base: Add export list to GHC.Num - - - - - 68c7b18d by Ben Gamari at 2023-06-30T14:09:51-04:00 base: Add export list to GHC.Num.Natural - - - - - 287e42eb by Ben Gamari at 2023-06-30T14:10:00-04:00 base: Introduce Data.Show - - - - - 66dff1de by Ben Gamari at 2023-06-30T14:10:00-04:00 base: Add export list to GHC.Float - - - - - d3618c65 by Ben Gamari at 2023-06-30T14:10:00-04:00 base: Add export list to GHC.Real - - - - - f2c9923b by Ben Gamari at 2023-06-30T14:10:00-04:00 base: Eliminate module reexport in GHC.Exception - - - - - 26 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - − .gitlab/circle-ci-job.sh - .gitlab/darwin/toolchain.nix - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .gitlab/generate_job_metadata - − .gitlab/generate_jobs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - .gitlab/rel_eng/mk-ghcup-metadata/README.mkd - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - CODEOWNERS - HACKING.md - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types/Prim.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8098c78a9b5e6aab27e5bc4aa965bdca249b902c...f2c9923bc8e2d7a56f47d62dd97446b20d72e6b0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8098c78a9b5e6aab27e5bc4aa965bdca249b902c...f2c9923bc8e2d7a56f47d62dd97446b20d72e6b0 You're receiving 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 Jun 30 18:16:25 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 30 Jun 2023 14:16:25 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23554 Message-ID: <649f1bf947711_238a8e188c99d0386674@gitlab.mail> Ben Gamari pushed new branch wip/T23554 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23554 You're receiving 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 Jun 30 18:23:49 2023 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski (@monoidal)) Date: Fri, 30 Jun 2023 14:23:49 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T23567 Message-ID: <649f1db587cb7_238a8e280c580392174@gitlab.mail> Krzysztof Gogolewski pushed new branch wip/T23567 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T23567 You're receiving 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 Jun 30 18:39:01 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 30 Jun 2023 14:39:01 -0400 Subject: [Git][ghc/ghc][wip/test-speed-ci] 1389 commits: Mark T7919 as fragile Message-ID: <649f2145de992_238a8e280c580400352@gitlab.mail> Ben Gamari pushed to branch wip/test-speed-ci at Glasgow Haskell Compiler / GHC Commits: 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 - - - - - 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 - - - - - 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. - - - - - 08c0822c by doyougnu at 2023-02-15T00:16:39-05:00 docs: release notes, user guide: add js backend Follow up from #21078 - - - - - 79d8fd65 by Bryan Richter at 2023-02-15T00:17:15-05:00 Allow failure in nightly-x86_64-linux-deb10-no_tntc-validate See #22343 - - - - - 9ca51f9e by Cheng Shao at 2023-02-15T00:17:53-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. - - - - - 26df73fb by Oleg Grenrus at 2023-02-15T22:20:57-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 - - - - - 631c6c72 by Cheng Shao at 2023-02-16T06:43:09-05:00 docs: add a section for the wasm backend Fixes #22658 - - - - - 1878e0bd by Bryan Richter at 2023-02-16T06:43:47-05:00 tests: Mark T12903 fragile everywhere See #21184 - - - - - b9420eac by Bryan Richter at 2023-02-16T06:43:47-05:00 Mark all T5435 variants as fragile See #22970. - - - - - df3d94bd by Sylvain Henry at 2023-02-16T06:44:33-05:00 Testsuite: mark T13167 as fragile for JS (#22921) - - - - - 324e925b by Sylvain Henry at 2023-02-16T06:45:15-05:00 JS: disable debugging info for heap objects - - - - - 518af814 by Josh Meredith at 2023-02-16T10:16:32-05:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 34cd308e by Ben Gamari at 2023-02-16T10:17:08-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 12965aba by Simon Peyton Jones at 2023-02-16T10:17:46-05: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 - - - - - 5b038888 by Bodigrim at 2023-02-16T10:18:24-05:00 Documentation: add an example of SPEC usage - - - - - 681e0e8c by sheaf at 2023-02-16T14:09:56-05:00 No default finalizer exception handler Commit cfc8e2e2 introduced a mechanism for handling of exceptions that occur during Handle finalization, and 372cf730 set the default handler to print out the error to stderr. However, #21680 pointed out we might not want to set this by default, as it might pollute users' terminals with unwanted information. So, for the time being, the default handler discards the exception. Fixes #21680 - - - - - b3ac17ad by Matthew Pickering at 2023-02-16T14:10:31-05: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 ------------------------- - - - - - 8988eeef by sheaf at 2023-02-16T20:32:27-05:00 Expand synonyms in RoughMap We were failing to expand type synonyms in the function GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the RoughMap infrastructure crucially relies on type synonym expansion to work. This patch adds the missing type-synonym expansion. Fixes #22985 - - - - - 3dd50e2f by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Add test artifact Add the released testsuite tarball to the generated ghcup metadata. - - - - - c6a967d9 by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Use Ubuntu and Rocky bindists Prefer to use the Ubuntu 20.04 and 18.04 binary distributions on Ubuntu and Linux Mint. Prefer to use the Rocky 8 binary distribution on unknown distributions. - - - - - be0b7209 by Matthew Pickering at 2023-02-17T09:37:16+00:00 Add INLINABLE pragmas to `generic*` functions in Data.OldList These functions are * recursive * overloaded So it's important to add an `INLINABLE` pragma to each so that they can be specialised at the use site when the specific numeric type is known. Adding these pragmas improves the LazyText replicate benchmark (see https://gitlab.haskell.org/ghc/ghc/-/issues/22886#note_481020) https://github.com/haskell/core-libraries-committee/issues/129 - - - - - a203ad85 by Sylvain Henry at 2023-02-17T15:59:16-05:00 Merge libiserv with ghci `libiserv` serves no purpose. As it depends on `ghci` and doesn't have more dependencies than the `ghci` package, its code could live in the `ghci` package too. This commit also moves most of the code from the `iserv` program into the `ghci` package as well so that it can be reused. This is especially useful for the implementation of TH for the JS backend (#22261, !9779). - - - - - 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01: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 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-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. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-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. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-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. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 7192ef91 by Simon Peyton Jones at 2023-02-28T18:54:59-05:00 Take more care with unlifted bindings in the specialiser As #22998 showed, we were floating an unlifted binding to top level, which breaks a Core invariant. The fix is easy, albeit a little bit conservative. See Note [Care with unlifted bindings] in GHC.Core.Opt.Specialise - - - - - bb500e2a by Simon Peyton Jones at 2023-02-28T18:55:35-05:00 Account for TYPE vs CONSTRAINT in mkSelCo As #23018 showed, in mkRuntimeRepCo we need to account for coercions between TYPE and COERCION. See Note [mkRuntimeRepCo] in GHC.Core.Coercion. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-05:00 hadrian: Add dependency from lib/settings to mk/config.mk In 81975ef375de07a0ea5a69596b2077d7f5959182 we attempted to fix #20253 by adding logic to the bindist Makefile to regenerate the `settings` file from information gleaned by the bindist `configure` script. However, this fix had no effect as `lib/settings` is shipped in the binary distribution (to allow in-place use of the binary distribution). As `lib/settings` already existed and its rule declared no dependencies, `make` would fail to use the added rule to regenerate it. Fix this by explicitly declaring a dependency from `lib/settings` on `mk/config.mk`. Fixes #22982. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-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. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-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. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00: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. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 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: ...lots of lines omitted... 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. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04: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. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04: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> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+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. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 68e474fd by Ben Gamari at 2023-06-29T10:59:06-04:00 gitlab-ci: Refactor compilation of gen_ci Flakify and document it, making it far less sensitive to the build environment. - - - - - 4c927dc0 by Ben Gamari at 2023-06-30T14:30:12-04:00 gitlab-ci: Add support for test speed - - - - - 9163f689 by Ben Gamari at 2023-06-30T14:32:51-04:00 gitlab-ci: Use slow test speed in debug job - - - - - 00f7e0e6 by Ben Gamari at 2023-06-30T14:32:52-04:00 testsuite: ds014 is not longer broken It now appears to pass in the ways it was marked as broken in. Closes #14901. - - - - - 7c1f1542 by Ben Gamari at 2023-06-30T14:32:52-04:00 testsuite: Overflow test is not longer broken in hpc way Closes #16543. - - - - - b32cb2bc by Ben Gamari at 2023-06-30T14:38:47-04:00 testsuite: Only run stack cloning tests in the normal way These are too dependent upon code generation specifics to pass in most other ways. - - - - - 17 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/darwin/nix/sources.json - .gitlab/darwin/toolchain.nix - + .gitlab/gen-ci.cabal - + .gitlab/generate-ci/LICENSE - + .gitlab/generate-ci/README.mkd - + .gitlab/generate-ci/flake.lock - + .gitlab/generate-ci/flake.nix - .gitlab/gen_ci.hs → .gitlab/generate-ci/gen_ci.hs - + .gitlab/generate-ci/generate-ci.cabal - + .gitlab/generate-ci/generate-job-metadata - + .gitlab/generate-ci/generate-jobs - − .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/4669ad4950491db410acbe510129cd852730a071...b32cb2bc6647ec761c71487ebc47a89fde32e0f9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4669ad4950491db410acbe510129cd852730a071...b32cb2bc6647ec761c71487ebc47a89fde32e0f9 You're receiving 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 Jun 30 18:40:30 2023 From: gitlab at gitlab.haskell.org (Ryan Scott (@RyanGlScott)) Date: Fri, 30 Jun 2023 14:40:30 -0400 Subject: [Git][ghc/ghc][wip/T23496] 45 commits: Support large stack frames/offsets in GHCi bytecode interpreter Message-ID: <649f219e5e44c_238a8e188c99d04006ec@gitlab.mail> Ryan Scott pushed to branch wip/T23496 at Glasgow Haskell Compiler / GHC Commits: 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - b53bf1e4 by Ryan Scott at 2023-06-30T14:39:05-04:00 Make InstDeclFreeVarsMap polymorphic over the decl type For now, this `decl` type parameter will only ever be instantiated to `LInstDecl GhcRn`, but we will also instantiate this with `LDerivDecl GhcRn` in a subsequent commit. - - - - - 594c8fd0 by Ryan Scott at 2023-06-30T14:39:05-04:00 Move DerivDecls into TyClGroups - - - - - 318b111b by Ryan Scott at 2023-06-30T14:39:05-04:00 Draft: Call tyInstDeclsDeriv from tcTyClGroup This allows to interleave typechecking of `deriving` declarations with the typechecking of ordinary instance declarations, which will be important for #23496. Sadly, this does not yet work, as GHC fails to build itself (during a stage-2 build) with these changes: ``` compiler/GHC/Hs.hs:99:1: error: [GHC-39999] • No instance for ‘Data (HsDecl GhcPs)’ arising from a use of ‘k’ • In the expression: ((((z (\ a1 a2 a3 a4 a5 -> HsModule a1 a2 a3 a4 a5) `k` a1) `k` a2) `k` a3) `k` a4) `k` a5 In an equation for ‘gfoldl’: gfoldl k z (HsModule a1 a2 a3 a4 a5) = (((((z (\ a1 a2 a3 a4 a5 -> HsModule a1 a2 a3 a4 a5) `k` a1) `k` a2) `k` a3) `k` a4) `k` a5) When typechecking the code for ‘gfoldl’ in a derived instance for ‘Data (HsModule GhcPs)’: To see the code I am typechecking, use -ddump-deriv In the instance declaration for ‘Data (HsModule GhcPs)’ | 99 | deriving instance Data (HsModule GhcPs) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ compiler/GHC/Hs.hs:99:1: error: [GHC-39999] • No instance for ‘Data (HsDecl GhcPs)’ arising from a use of ‘k’ • In the expression: k (k (k (k (k (z (\ a1 a2 a3 a4 a5 -> HsModule a1 a2 a3 a4 a5)))))) In a case alternative: ghc-prim-0.10.0:GHC.Types.I# 1# -> k (k (k (k (k (z (\ a1 a2 a3 a4 a5 -> HsModule a1 a2 a3 a4 a5)))))) In the expression: case constrIndex c of ghc-prim-0.10.0:GHC.Types.I# 1# -> k (k (k (k (k (z (\ a1 a2 a3 a4 a5 -> HsModule a1 a2 a3 a4 a5)))))) _ -> k (z (\ a1 -> XModule a1)) When typechecking the code for ‘gunfold’ in a derived instance for ‘Data (HsModule GhcPs)’: To see the code I am typechecking, use -ddump-deriv | 99 | deriving instance Data (HsModule GhcPs) | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ``` - - - - - fe43718e by Ryan Scott at 2023-06-30T14:39:06-04:00 Draft: Split GHC.Generics into two modules Most of `GHC.Generics` has now been moved to `GHC.Generics.Internal`, which `GHC.Generics` re-exports. The only things now defined in `GHC.Generics` are the derived `Generic(1)` instances. These need to be put in a different module because of GHC's new approach to dependency analysis, which is perfectly within its rights to typecheck a derived `Generic` instance before it typechecks any of the definitions that are referenced in the generated code. Putting the definitions in a separate module from the derived `Generic` instances is a sure-fire way to ensure that this doesn't happen. Unfortunately, this uncovers another issue when building `Cabal-syntax`: ``` libraries/Cabal/Cabal-syntax/src/Distribution/Compat/Prelude.hs:279:21: error: [GHC-88464] Variable not in scope: from :: a -> f0 a0 Suggested fix: Add ‘from’ to the import list in the import of ‘GHC.Generics’ (at libraries/Cabal/Cabal-syntax/src/Distribution/Compat/Prelude.hs:251:1-105). | 279 | genericRnf = grnf . from | ^^^^ ``` See https://gitlab.haskell.org/ghc/ghc/-/issues/23496#note_507555. - - - - - 516eae27 by Ryan Scott at 2023-06-30T14:40:12-04:00 Draft: Bump Cabal submodule - - - - - 30 changed files: - .gitlab/ci.sh - .gitlab/darwin/toolchain.nix - .gitlab/merge_request_templates/merge-request.md → .gitlab/merge_request_templates/Default.md - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Linker.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Utils.hs - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.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 - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map/Expr.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Ppr.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/Tidy.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1e741c9600f1ba28b2294cb965cd32fcbce43fbb...516eae27a6c9333eb0e97e9bfdd9443630edc9e9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1e741c9600f1ba28b2294cb965cd32fcbce43fbb...516eae27a6c9333eb0e97e9bfdd9443630edc9e9 You're receiving 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 Jun 30 19:34:04 2023 From: gitlab at gitlab.haskell.org (Vladislav Zavialov (@int-index)) Date: Fri, 30 Jun 2023 15:34:04 -0400 Subject: [Git][ghc/ghc][wip/int-index/tycl-inst-deps] 8 commits: Define FFI_GO_CLOSURES Message-ID: <649f2e2ccb681_238a8e1a439db4414229@gitlab.mail> Vladislav Zavialov pushed to branch wip/int-index/tycl-inst-deps at Glasgow Haskell Compiler / GHC Commits: 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - d7f6448a by Matthew Pickering at 2023-06-30T12:38:43-04:00 hadrian: Fix dependencies of docs:* rule For the docs:* rule we need to actually build the package rather than just the haddocks for the dependent packages. Therefore we depend on the .conf files of the packages we are trying to build documentation for as well as the .haddock files. Fixes #23472 - - - - - cec90389 by sheaf at 2023-06-30T12:39:27-04:00 Add tests for #22106 Fixes #22106 - - - - - feb6d723 by Vladislav Zavialov at 2023-06-30T20:35:02+03:00 Draft: instances in dependency analysis - - - - - 30 changed files: - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Rename/Module.hs - hadrian/src/Flavour.hs - hadrian/src/Rules/Documentation.hs - libraries/base/include/HsBase.h - libraries/ghci/GHCi/FFI.hsc - rts/Interpreter.c - rts/Schedule.c - rts/Sparks.c - rts/Trace.h - rts/TraverseHeap.c - rts/adjustor/LibffiAdjustor.c - + rts/include/rts/ghc_ffi.h - rts/rts.cabal.in - rts/sm/GC.c - rts/sm/NonMoving.c - rts/sm/NonMovingMark.c - rts/sm/Storage.c - + testsuite/tests/dependent/should_compile/T12088a.hs - + testsuite/tests/dependent/should_compile/T12088b.hs - + testsuite/tests/dependent/should_compile/T12088c.hs - + testsuite/tests/dependent/should_compile/T12088sg1.hs - + testsuite/tests/dependent/should_compile/T12239.hs - + testsuite/tests/dependent/should_compile/T14668a.hs - + testsuite/tests/dependent/should_compile/T14668b.hs - + testsuite/tests/dependent/should_compile/T22257a.hs - + testsuite/tests/dependent/should_compile/T22257b.hs - testsuite/tests/dependent/should_compile/all.T - testsuite/tests/deriving/should_compile/T17339.stderr - testsuite/tests/ghci/scripts/T4175.stdout The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/188c505027357133036e336ebdf0dbc6166547ff...feb6d7236e9fa1de8aecd6fc8ad7ae1ced043118 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/188c505027357133036e336ebdf0dbc6166547ff...feb6d7236e9fa1de8aecd6fc8ad7ae1ced043118 You're receiving 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 Jun 30 20:28:14 2023 From: gitlab at gitlab.haskell.org (Ben Gamari (@bgamari)) Date: Fri, 30 Jun 2023 16:28:14 -0400 Subject: [Git][ghc/ghc][wip/T22710] 916 commits: Bump submodule bytestring to 0.11.4.0 Message-ID: <649f3ade9cae1_238a8e18f7fff442574a@gitlab.mail> Ben Gamari pushed to branch wip/T22710 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` - - - - - 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. - - - - - 08c0822c by doyougnu at 2023-02-15T00:16:39-05:00 docs: release notes, user guide: add js backend Follow up from #21078 - - - - - 79d8fd65 by Bryan Richter at 2023-02-15T00:17:15-05:00 Allow failure in nightly-x86_64-linux-deb10-no_tntc-validate See #22343 - - - - - 9ca51f9e by Cheng Shao at 2023-02-15T00:17:53-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. - - - - - 26df73fb by Oleg Grenrus at 2023-02-15T22:20:57-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 - - - - - 631c6c72 by Cheng Shao at 2023-02-16T06:43:09-05:00 docs: add a section for the wasm backend Fixes #22658 - - - - - 1878e0bd by Bryan Richter at 2023-02-16T06:43:47-05:00 tests: Mark T12903 fragile everywhere See #21184 - - - - - b9420eac by Bryan Richter at 2023-02-16T06:43:47-05:00 Mark all T5435 variants as fragile See #22970. - - - - - df3d94bd by Sylvain Henry at 2023-02-16T06:44:33-05:00 Testsuite: mark T13167 as fragile for JS (#22921) - - - - - 324e925b by Sylvain Henry at 2023-02-16T06:45:15-05:00 JS: disable debugging info for heap objects - - - - - 518af814 by Josh Meredith at 2023-02-16T10:16:32-05:00 Factor JS Rts generation for h$c{_,0,1,2} into h$c{n} and improve name caching - - - - - 34cd308e by Ben Gamari at 2023-02-16T10:17:08-05:00 base: Note move of GHC.Stack.CCS.whereFrom to GHC.InfoProv in changelog Fixes #22883. - - - - - 12965aba by Simon Peyton Jones at 2023-02-16T10:17:46-05: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 - - - - - 5b038888 by Bodigrim at 2023-02-16T10:18:24-05:00 Documentation: add an example of SPEC usage - - - - - 681e0e8c by sheaf at 2023-02-16T14:09:56-05:00 No default finalizer exception handler Commit cfc8e2e2 introduced a mechanism for handling of exceptions that occur during Handle finalization, and 372cf730 set the default handler to print out the error to stderr. However, #21680 pointed out we might not want to set this by default, as it might pollute users' terminals with unwanted information. So, for the time being, the default handler discards the exception. Fixes #21680 - - - - - b3ac17ad by Matthew Pickering at 2023-02-16T14:10:31-05: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 ------------------------- - - - - - 8988eeef by sheaf at 2023-02-16T20:32:27-05:00 Expand synonyms in RoughMap We were failing to expand type synonyms in the function GHC.Core.RoughMap.typeToRoughMatchLookupTc, even though the RoughMap infrastructure crucially relies on type synonym expansion to work. This patch adds the missing type-synonym expansion. Fixes #22985 - - - - - 3dd50e2f by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Add test artifact Add the released testsuite tarball to the generated ghcup metadata. - - - - - c6a967d9 by Matthew Pickering at 2023-02-16T20:33:03-05:00 ghcup-metadata: Use Ubuntu and Rocky bindists Prefer to use the Ubuntu 20.04 and 18.04 binary distributions on Ubuntu and Linux Mint. Prefer to use the Rocky 8 binary distribution on unknown distributions. - - - - - be0b7209 by Matthew Pickering at 2023-02-17T09:37:16+00:00 Add INLINABLE pragmas to `generic*` functions in Data.OldList These functions are * recursive * overloaded So it's important to add an `INLINABLE` pragma to each so that they can be specialised at the use site when the specific numeric type is known. Adding these pragmas improves the LazyText replicate benchmark (see https://gitlab.haskell.org/ghc/ghc/-/issues/22886#note_481020) https://github.com/haskell/core-libraries-committee/issues/129 - - - - - a203ad85 by Sylvain Henry at 2023-02-17T15:59:16-05:00 Merge libiserv with ghci `libiserv` serves no purpose. As it depends on `ghci` and doesn't have more dependencies than the `ghci` package, its code could live in the `ghci` package too. This commit also moves most of the code from the `iserv` program into the `ghci` package as well so that it can be reused. This is especially useful for the implementation of TH for the JS backend (#22261, !9779). - - - - - 7080a93f by Simon Peyton Jones at 2023-02-20T12:06:32+01: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 - - - - - 2592ab69 by Cheng Shao at 2023-02-20T10:35:30-05:00 compiler: fix cost centre profiling breakage in wasm NCG due to incorrect register mapping The wasm NCG used to map CCCS to a wasm global, based on the observation that CCCS is a transient register that's already handled by thread state load/store logic, so it doesn't need to be backed by the rCCCS field in the register table. Unfortunately, this is wrong, since even when Cmm execution hasn't yielded back to the scheduler, the Cmm code may call enterFunCCS, which does use rCCCS. This breaks cost centre profiling in a subtle way, resulting in inaccurate stack traces in some test cases. The fix is simple though: just remove the CCCS mapping. - - - - - 26243de1 by Alexis King at 2023-02-20T15:27:17-05:00 Handle top-level Addr# literals in the bytecode compiler Fixes #22376. - - - - - 0196cc2b by romes at 2023-02-20T15:27:52-05:00 fix: Explicitly flush stdout on plugin Because of #20791, the plugins tests often fail. This is a temporary fix to stop the tests from failing due to unflushed outputs on windows and the explicit flush should be removed when #20791 is fixed. - - - - - 4327d635 by Ryan Scott at 2023-02-20T20:44:34-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. - - - - - 96dc58b9 by Ryan Scott at 2023-02-20T20:44:35-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. - - - - - ff8e99f6 by Ryan Scott at 2023-02-20T20:44:35-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. - - - - - 8e765aff by Bodigrim at 2023-02-21T12:03:24-05:00 Bump submodule text to 2.0.2 - - - - - 172ff88f by Georgi Lyubenov at 2023-02-21T18:35:56-05:00 GHC proposal 496 - Nullary record wildcards This patch implements GHC proposal 496, which allows record wildcards to be used for nullary constructors, e.g. data A = MkA1 | MkA2 { fld1 :: Int } f :: A -> Int f (MkA1 {..}) = 0 f (MkA2 {..}) = fld1 To achieve this, we add arity information to the record field environment, so that we can accept a constructor which has no fields while continuing to reject non-record constructors with more than 1 field. See Note [Nullary constructors and empty record wildcards], as well as the more general overview in Note [Local constructor info in the renamer], both in the newly introduced GHC.Types.ConInfo module. Fixes #22161 - - - - - f70a0239 by sheaf at 2023-02-21T18:36:35-05:00 ghc-prim: levity-polymorphic array equality ops This patch changes the pointer-equality comparison operations in GHC.Prim.PtrEq to work with arrays of unlifted values, e.g. sameArray# :: forall {l} (a :: TYPE (BoxedRep l)). Array# a -> Array# a -> Int# Fixes #22976 - - - - - 9296660b by Andreas Klebinger at 2023-02-21T23:58:05-05:00 base: Correct @since annotation for FP<->Integral bit cast operations. Fixes #22708 - - - - - f11d9c27 by romes at 2023-02-21T23:58:42-05:00 fix: Update documentation links Closes #23008 Additionally batches some fixes to pointers to the Note [Wired-in units], and a typo in said note. - - - - - fb60339f by Bryan Richter at 2023-02-23T14:45:17+02:00 Propagate failure if unable to push notes - - - - - 8e170f86 by Alexis King at 2023-02-23T16:59:22-05:00 rts: Fix `prompt#` when profiling is enabled This commit also adds a new -Dk RTS option to the debug RTS to assist debugging continuation captures. Currently, the printed information is quite minimal, but more can be added in the future if it proves to be useful when debugging future issues. fixes #23001 - - - - - e9e7a00d by sheaf at 2023-02-23T17:00:01-05:00 Explicit migration timeline for loopy SC solving This patch updates the warning message introduced in commit 9fb4ca89bff9873e5f6a6849fa22a349c94deaae to specify an explicit migration timeline: GHC will no longer support this constraint solving mechanism starting from GHC 9.10. Fixes #22912 - - - - - 4eb9c234 by Sylvain Henry at 2023-02-24T17:27:45-05:00 JS: make some arithmetic primops faster (#22835) Don't use BigInt for wordAdd2, mulWord32, and timesInt32. Co-authored-by: Matthew Craven <5086-clyring at users.noreply.gitlab.haskell.org> - - - - - 92e76483 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump terminfo submodule to 0.4.1.6 - - - - - f229db14 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump unix submodule to 2.8.1.0 - - - - - 47bd48c1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump deepseq submodule to 1.4.8.1 - - - - - d2012594 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump directory submodule to 1.3.8.1 - - - - - df6f70d1 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump process submodule to v1.6.17.0 - - - - - 4c869e48 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump hsc2hs submodule to 0.68.8 - - - - - 81d96642 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump array submodule to 0.5.4.0 - - - - - 6361f771 by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump Cabal submodule to 3.9 pre-release - - - - - 4085fb6c by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump filepath submodule to 1.4.100.1 - - - - - 2bfad50f by Ben Gamari at 2023-02-24T17:28:20-05:00 Bump haskeline submodule to 0.8.2.1 - - - - - fdc89a8d by Ben Gamari at 2023-02-24T21:29:32-05:00 gitlab-ci: Run nix-build with -v0 This significantly cuts down on the amount of noise in the job log. Addresses #22861. - - - - - 69fb0b13 by Aaron Allen at 2023-02-24T21:30:10-05:00 Fix ParallelListComp out of scope suggestion This patch makes it so vars from one block of a parallel list comprehension are not in scope in a subsequent block during type checking. This was causing GHC to emit a faulty suggestion when an out of scope variable shared the occ name of a var from a different block. Fixes #22940 - - - - - ece092d0 by Simon Peyton Jones at 2023-02-24T21:30:45-05:00 Fix shadowing bug in prepareAlts As #23012 showed, GHC.Core.Opt.Simplify.Utils.prepareAlts was using an OutType to construct an InAlt. When shadowing is in play, this is outright wrong. See Note [Shadowing in prepareAlts]. - - - - - 7825fef9 by Sylvain Henry at 2023-02-24T21:31:25-05:00 JS: Store CI perf results (fix #22923) - - - - - b56025f4 by Gergő Érdi at 2023-02-27T13:34:22+00:00 Don't specialise incoherent instance applications Using incoherent instances, there can be situations where two occurrences of the same overloaded function at the same type use two different instances (see #22448). For incoherently resolved instances, we must mark them with `nospec` to avoid the specialiser rewriting one to the other. This marking is done during the desugaring of the `WpEvApp` wrapper. Fixes #22448 Metric Increase: T15304 - - - - - d0c7bbed by Tom Ellis at 2023-02-27T20:04:07-05:00 Fix SCC grouping example - - - - - f84a8cd4 by Bryan Richter at 2023-02-28T05:58:37-05:00 Mark setnumcapabilities001 fragile - - - - - 29a04d6e by Bryan Richter at 2023-02-28T05:58:37-05:00 Allow nightly-x86_64-linux-deb10-validate+thread_sanitizer to fail See #22520 - - - - - 9fa54572 by Cheng Shao at 2023-02-28T05:59:15-05:00 ghc-prim: fix hs_cmpxchg64 function prototype hs_cmpxchg64 must return a StgWord64, otherwise incorrect runtime results of 64-bit MO_Cmpxchg will appear in 32-bit unregisterised builds, which go unnoticed at compile-time due to C implicit casting in .hc files. - - - - - 0c200ab7 by Simon Peyton Jones at 2023-02-28T11:10:31-05:00 Account for local rules in specImports As #23024 showed, in GHC.Core.Opt.Specialise.specImports, we were generating specialisations (a locally-define function) for imported functions; and then generating specialisations for those locally-defined functions. The RULE for the latter should be attached to the local Id, not put in the rules-for-imported-ids set. Fix is easy; similar to what happens in GHC.HsToCore.addExportFlagsAndRules - - - - - 8b77f9bf by Sylvain Henry at 2023-02-28T11:11:21-05:00 JS: fix for overlap with copyMutableByteArray# (#23033) The code wasn't taking into account some kind of overlap. cgrun070 has been extended to test the missing case. - - - - - 239202a2 by Sylvain Henry at 2023-02-28T11:12:03-05:00 Testsuite: replace some js_skip with req_cmm req_cmm is more informative than js_skip - - - - - 7192ef91 by Simon Peyton Jones at 2023-02-28T18:54:59-05:00 Take more care with unlifted bindings in the specialiser As #22998 showed, we were floating an unlifted binding to top level, which breaks a Core invariant. The fix is easy, albeit a little bit conservative. See Note [Care with unlifted bindings] in GHC.Core.Opt.Specialise - - - - - bb500e2a by Simon Peyton Jones at 2023-02-28T18:55:35-05:00 Account for TYPE vs CONSTRAINT in mkSelCo As #23018 showed, in mkRuntimeRepCo we need to account for coercions between TYPE and COERCION. See Note [mkRuntimeRepCo] in GHC.Core.Coercion. - - - - - 79ffa170 by Ben Gamari at 2023-03-01T04:17:20-05:00 hadrian: Add dependency from lib/settings to mk/config.mk In 81975ef375de07a0ea5a69596b2077d7f5959182 we attempted to fix #20253 by adding logic to the bindist Makefile to regenerate the `settings` file from information gleaned by the bindist `configure` script. However, this fix had no effect as `lib/settings` is shipped in the binary distribution (to allow in-place use of the binary distribution). As `lib/settings` already existed and its rule declared no dependencies, `make` would fail to use the added rule to regenerate it. Fix this by explicitly declaring a dependency from `lib/settings` on `mk/config.mk`. Fixes #22982. - - - - - a2a1a1c0 by Sebastian Graf at 2023-03-01T04:17:56-05:00 Revert the main payload of "Make `drop` and `dropWhile` fuse (#18964)" This reverts the bits affecting fusion of `drop` and `dropWhile` of commit 0f7588b5df1fc7a58d8202761bf1501447e48914 and keeps just the small refactoring unifying `flipSeqTake` and `flipSeqScanl'` into `flipSeq`. It also adds a new test for #23021 (which was the reason for reverting) as well as adds a clarifying comment to T18964. Fixes #23021, unfixes #18964. Metric Increase: T18964 Metric Decrease: T18964 - - - - - cf118e2f by Simon Peyton Jones at 2023-03-01T04:18:33-05:00 Refine the test for naughty record selectors The test for naughtiness in record selectors is surprisingly subtle. See the revised Note [Naughty record selectors] in GHC.Tc.TyCl.Utils. Fixes #23038. - - - - - 86f240ca by romes at 2023-03-01T04:19:10-05:00 fix: Consider strictness annotation in rep_bind Fixes #23036 - - - - - 1ed573a5 by Richard Eisenberg at 2023-03-02T22:42:06-05:00 Don't suppress *all* Wanteds Code in GHC.Tc.Errors.reportWanteds suppresses a Wanted if its rewriters have unfilled coercion holes; see Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. But if we thereby suppress *all* errors that's really confusing, and as #22707 shows, GHC goes on without even realising that the program is broken. Disaster. This MR arranges to un-suppress them all if they all get suppressed. Close #22707 - - - - - 8919f341 by Luite Stegeman at 2023-03-02T22:42:45-05:00 Check for platform support for JavaScript foreign imports GHC was accepting `foreign import javascript` declarations on non-JavaScript platforms. This adds a check so that these are only supported on an platform that supports the JavaScript calling convention. Fixes #22774 - - - - - db83f8bb by Ben Gamari at 2023-03-02T22:43:22-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. - - - - - 5f7a4a6d by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Introduce stgMallocAlignedBytes - - - - - 8a6f745d by Ben Gamari at 2023-03-02T22:43:22-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. - - - - - 5464c73f by Ben Gamari at 2023-03-02T22:43:22-05:00 rts: Drop no-alignment special case for Windows For reasons that aren't clear, we were previously not giving Capability the same favorable alignment on Windows that we provided on other platforms. Fix this. - - - - - a86aae8b by Matthew Pickering at 2023-03-02T22:43:59-05:00 constant folding: Correct type of decodeDouble_Int64 rule The first argument is Int64# unconditionally, so we better produce something of that type. This fixes a core lint error found in the ad package. Fixes #23019 - - - - - 68dd64ff by Zubin Duggal at 2023-03-02T22:44:35-05:00 ncg/aarch64: Handle MULTILINE_COMMENT identically as COMMENTs Commit 7566fd9de38c67360c090f828923d41587af519c with the fix for #22798 was incomplete as it failed to handle MULTILINE_COMMENT pseudo-instructions, and didn't completly fix the compiler panics when compiling with `-fregs-graph`. Fixes #23002 - - - - - 2f97c861 by Simon Peyton Jones at 2023-03-02T22:45:11-05:00 Get the right in-scope set in etaBodyForJoinPoint Fixes #23026 - - - - - 45af8482 by David Feuer at 2023-03-03T11:40:47-05:00 Export getSolo from Data.Tuple Proposed in [CLC proposal #113](https://github.com/haskell/core-libraries-committee/issues/113) and [approved by the CLC](https://github.com/haskell/core-libraries-committee/issues/113#issuecomment-1452452191) - - - - - 0c694895 by David Feuer at 2023-03-03T11:40:47-05:00 Document getSolo - - - - - bd0536af by Simon Peyton Jones at 2023-03-03T11:41:23-05:00 More fixes for `type data` declarations This MR fixes #23022 and #23023. Specifically * Beef up Note [Type data declarations] in GHC.Rename.Module, to make invariant (I1) explicit, and to name the several wrinkles. And add references to these specific wrinkles. * Add a Lint check for invariant (I1) above. See GHC.Core.Lint.checkTypeDataConOcc * Disable the `caseRules` for dataToTag# for `type data` values. See Wrinkle (W2c) in the Note above. Fixes #23023. * Refine the assertion in dataConRepArgTys, so that it does not complain about the absence of a wrapper for a `type data` constructor Fixes #23022. Acked-by: Simon Peyton Jones <simon.peytonjones at gmail.com> - - - - - 858f34d5 by Oleg Grenrus at 2023-03-04T01:13:55+02:00 Add decideSymbol, decideChar, decideNat, decTypeRep, decT and hdecT These all type-level equality decision procedures. Implementes a CLC proposal https://github.com/haskell/core-libraries-committee/issues/98 - - - - - bf43ba92 by Simon Peyton Jones at 2023-03-04T01:18:23-05:00 Add test for T22793 - - - - - c6e1f3cd by Chris Wendt at 2023-03-04T03:35:18-07:00 Fix typo in docs referring to threadLabel - - - - - 232cfc24 by Simon Peyton Jones at 2023-03-05T19:57:30-05:00 Add regression test for #22328 - - - - - 5ed77deb by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Enable response files for linker if supported - - - - - 1e0f6c89 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Synchronize `configure.ac` and `distrib/configure.ac.in` - - - - - 70560952 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix `hadrian/bindist/config.mk.in` … as suggested by @bgamari - - - - - b042b125 by sheaf at 2023-03-06T17:06:50-05:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 674b6b81 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Try to create somewhat portable `ld` command I cannot figure out a good way to generate an `ld` command that works on both Linux and macOS. Normally you'd use something like `AC_LINK_IFELSE` for this purpose (I think), but that won't let us test response file support. - - - - - 83b0177e by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Quote variables … as suggested by @bgamari - - - - - 845f404d by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Fix configure failure on alpine linux - - - - - c56a3ae6 by Gabriella Gonzalez at 2023-03-06T17:06:50-05:00 Small fixes to configure script - - - - - cad5c576 by Andrei Borzenkov at 2023-03-06T17:07:33-05:00 Convert diagnostics in GHC.Rename.Module to proper TcRnMessage (#20115) I've turned almost all occurrences of TcRnUnknownMessage in GHC.Rename.Module module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnIllegalInstanceHeadDecl TcRnUnexpectedStandaloneDerivingDecl TcRnUnusedVariableInRuleDecl TcRnUnexpectedStandaloneKindSig TcRnIllegalRuleLhs TcRnBadAssocRhs TcRnDuplicateRoleAnnot TcRnDuplicateKindSig TcRnIllegalDerivStrategy TcRnIllegalMultipleDerivClauses TcRnNoDerivStratSpecified TcRnStupidThetaInGadt TcRnBadImplicitSplice TcRnShadowedTyVarNameInFamResult TcRnIncorrectTyVarOnLhsOfInjCond TcRnUnknownTyVarsOnRhsOfInjCond Was introduced one helper type: RuleLhsErrReason - - - - - c6432eac by Apoorv Ingle at 2023-03-06T23:26:12+00: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. Adds 3 dynamic flags for controlling the fuels for each type of constraints `-fgivens-expansion-fuel` for givens `-fwanteds-expansion-fuel` for wanteds and `-fqcs-expansion-fuel` for quantified constraints Fixes #21909 Added Tests T21909, T21909b Added Note [Expanding Recursive Superclasses and ExpansionFuel] - - - - - a5afc8ab by Bodigrim at 2023-03-06T22:51:01-05:00 Documentation: describe laziness of several function from Data.List - - - - - fa559c28 by Ollie Charles at 2023-03-07T20:56:21+00:00 Add `Data.Functor.unzip` This function is currently present in `Data.List.NonEmpty`, but `Data.Functor` is a better home for it. This change was discussed and approved by the CLC at https://github.com/haskell/core-libraries-committee/issues/88. - - - - - 2aa07708 by MorrowM at 2023-03-07T21:22:22-05:00 Fix documentation for traceWith and friends - - - - - f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00 Remove utils/hpc subdirectory and its contents - - - - - cf98e286 by David Binder at 2023-03-08T01:24:17-05:00 Add git submodule for utils/hpc - - - - - 605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 606793d4 by David Binder at 2023-03-08T01:24:18-05:00 Update commit for utils/hpc git submodule - - - - - 4158722a by Sylvain Henry at 2023-03-08T01:24:58-05:00 linker: fix linking with aligned sections (#23066) Take section alignment into account instead of assuming 16 bytes (which is wrong when the section requires 32 bytes, cf #23066). - - - - - 1e0d8fdb by Greg Steuck at 2023-03-08T08:59:05-05:00 Change hostSupportsRPaths to report False on OpenBSD OpenBSD does support -rpath but ghc build process relies on some related features that don't work there. See ghc/ghc#23011 - - - - - bed3a292 by Alexis King at 2023-03-08T08:59:53-05:00 bytecode: Fix bitmaps for BCOs used to tag tuples and prim call args fixes #23068 - - - - - 321d46d9 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Drop redundant prototype - - - - - abb6070f by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Fix style - - - - - be278901 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Deduplicate assertion - - - - - b9034639 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Fix type issues in Sparks.h Adds explicit casts to satisfy a C++ compiler. - - - - - da7b2b94 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts: Use release ordering when storing thread labels Since this makes the ByteArray# visible from other cores. - - - - - 5b7f6576 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 6283144f by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Mark pinned_object_blocks - - - - - 9b528404 by Ben Gamari at 2023-03-08T15:02:30-05:00 rts/Sanity: Look at nonmoving saved_filled lists - - - - - 0edc5438 by Ben Gamari at 2023-03-08T15:02:30-05:00 Evac: Squash data race in eval_selector_chain - - - - - 7eab831a by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify implementation This makes the intent of this implementation a bit clearer. - - - - - 532262b9 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Clarify comment - - - - - bd9cd84b by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Add missing no-op in busy-wait loop - - - - - c4e6bfc8 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 92227b60 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - ba7e7972 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Sanity check nonmoving large objects and compacts - - - - - 71b038a1 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 99d144d5 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Don't show occupancy if we didn't collect live words - - - - - 81d6cc55 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 58e53bc4 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Assert state of swept segments - - - - - 2db92e01 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - e4c3249f by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - 1b069671 by Ben Gamari at 2023-03-08T15:02:30-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. - - - - - d4032690 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Post-sweep sanity checking - - - - - 0baa8752 by Ben Gamari at 2023-03-08T15:02:30-05:00 nonmoving: Avoid n_caps race - - - - - 5d3232ba by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Don't push if nonmoving collector isn't enabled - - - - - 0a7eb0aa by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - 7c817c0a by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - ce22a3e2 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Allow pinned gen0 objects to be WEAK keys - - - - - 78746906 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Reenable assertion - - - - - b500867a by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - 56e669c1 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix Note references Some references to Note [Deadlock detection under the non-moving collector] were missing an article. - - - - - 4a7650d7 by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - 96a5aaed by Ben Gamari at 2023-03-08T15:02:31-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. - - - - - 6c6674ca by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Encapsulate block allocator spinlock This makes it a bit easier to add instrumentation on this spinlock while debugging. - - - - - e84f7167 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip some tests when sanity checking is enabled - - - - - 3ae0f368 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Fix unregisterised build - - - - - 4eb9d06b by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Ensure that sanity checker accounts for saved_filled segments - - - - - f0cf384d by Ben Gamari at 2023-03-08T15:02:31-05:00 hadrian: Add +boot_nonmoving_gc flavour transformer For using GHC bootstrapping to validate the non-moving GC. - - - - - 581e58ac by Ben Gamari at 2023-03-08T15:02:31-05:00 gitlab-ci: Add job bootstrapping with nonmoving GC - - - - - 487a8b58 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Move allocator into new source file - - - - - 8f374139 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Split out nonmovingAllocateGC - - - - - 662b6166 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Only run T22795* in the normal way It doesn't make sense to run these in multiple ways as they merely test whether `-threaded`/`-single-threaded` flags. - - - - - 0af21dfa by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Rename clear_segment(_free_blocks)? To reflect the fact that these are to do with the nonmoving collector, now since they are exposed no longer static. - - - - - 7bcb192b by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Fix incorrect STATIC_INLINE This should be INLINE_HEADER lest we get unused declaration warnings. - - - - - f1fd3ffb by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Mark ffi023 as broken due to #23089 - - - - - a57f12b3 by Ben Gamari at 2023-03-08T15:02:31-05:00 testsuite: Skip T7160 in the nonmoving way Finalization order is different under the nonmoving collector. - - - - - f6f12a36 by Ben Gamari at 2023-03-08T15:02:31-05:00 rts: Capture GC configuration in a struct The number of distinct arguments passed to GarbageCollect was getting a bit out of hand. - - - - - ba73a807 by Ben Gamari at 2023-03-08T15:02:31-05:00 nonmoving: Non-concurrent collection - - - - - 7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00 hadrian: Fix flavour compiler stage options off-by-one error !9193 pointed out that ghcDebugAssertions was supposed to be a predicate on the stage of the built compiler, but in practice it was a predicate on the stage of the compiler used to build. Unfortunately, while it fixed that issue for ghcDebugAssertions, it documented every other similar option as behaving the same way when in fact they all used the old behavior. The new behavior of ghcDebugAssertions seems more intuitive, so this commit changes the interpretation of every other option to match. It also improves the enableProfiledGhc and debugGhc flavour transformers by making them more selective about which stages in which they build additional library/RTS ways. - - - - - f97c7f6d by Luite Stegeman at 2023-03-09T09:52:09-05:00 Delete created temporary subdirectories at end of session. This patch adds temporary subdirectories to the list of paths do clean up at the end of the GHC session. This fixes warnings about non-empty temporary directories. Fixes #22952 - - - - - 9ea719f2 by Apoorv Ingle at 2023-03-09T09:52:45-05:00 Fixes #19627. Previously the solver failed with an unhelpful "solver reached too may iterations" error. With the fix for #21909 in place we no longer have the possibility of generating such an error if we have `-fconstraint-solver-iteration` > `-fgivens-fuel > `-fwanteds-fuel`. This is true by default, and the said fix also gives programmers a knob to control how hard the solver should try before giving up. This commit adds: * Reference to ticket #19627 in the Note [Expanding Recursive Superclasses and ExpansionFuel] * Test `typecheck/should_fail/T19627.hs` for regression purposes - - - - - ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00 DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997) We should not panic in `add_demands` (now `set_lam_dmds`), because that code path is legimitely taken for OPAQUE PAP bindings, as in T22997. Fixes #22997. - - - - - 5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00 JS: remove dead code for old integer-gmp - - - - - bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00 JS: Fix implementation of MK_JSVAL - - - - - ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00 Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check There is no need to run arity analysis and what not if we are not in a Simplifier phase that eta-expands or if we don't want to eta-expand the expression in the first place. Purely a refactoring with the goal of improving compiler perf. - - - - - 047e9d4f by Josh Meredith at 2023-03-13T03:56:03+00:00 JS: fix implementation of forceBool to use JS backend syntax - - - - - 559a4804 by Sebastian Graf at 2023-03-13T07:31:23-04:00 Simplifier: `countValArgs` should not count Type args (#23102) I observed miscompilations while working on !10088 caused by this. Fixes #23102. Metric Decrease: T10421 - - - - - 536d1f90 by Matthew Pickering at 2023-03-13T14:04:49+00:00 Bump Win32 to 2.13.4.0 Updates Win32 submodule - - - - - ee17001e by Ben Gamari at 2023-03-13T21:18:24-04:00 ghc-bignum: Drop redundant include-dirs field - - - - - c9c26cd6 by Teo Camarasu at 2023-03-16T12:17:50-04:00 Fix BCO creation setting caps when -j > -N * Remove calls to 'setNumCapabilities' in 'createBCOs' These calls exist to ensure that 'createBCOs' can benefit from parallelism. But this is not the right place to call `setNumCapabilities`. Furthermore the logic differs from that in the driver causing the capability count to be raised and lowered at each TH call if -j > -N. * Remove 'BCOOpts' No longer needed as it was only used to thread the job count down to `createBCOs` Resolves #23049 - - - - - 5ddbf5ed by Teo Camarasu at 2023-03-16T12:17:50-04:00 Add changelog entry for #23049 - - - - - 6e3ce9a4 by Ben Gamari at 2023-03-16T12:18:26-04:00 configure: Fix FIND_CXX_STD_LIB test on Darwin Annoyingly, Darwin's <cstddef> includes <version> and APFS is case-insensitive. Consequently, it will end up #including the `VERSION` file generated by the `configure` script on the second and subsequent runs of the `configure` script. See #23116. - - - - - 19d6d039 by sheaf at 2023-03-16T21:31:22+01:00 ghci: only keep the GlobalRdrEnv in ModInfo The datatype GHC.UI.Info.ModInfo used to store a ModuleInfo, which includes a TypeEnv. This can easily cause space leaks as we have no way of forcing everything in a type environment. In GHC, we only use the GlobalRdrEnv, which we can force completely. So we only store that instead of a fully-fledged ModuleInfo. - - - - - 73d07c6e by Torsten Schmits at 2023-03-17T14:36:49-04:00 Add structured error messages for GHC.Tc.Utils.Backpack Tracking ticket: #20119 MR: !10127 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. One occurrence, when handing a nested error from the interface loading machinery, was omitted. It will be handled by a subsequent changeset that addresses interface errors. - - - - - a13affce by Andrei Borzenkov at 2023-03-21T11:17:17-04:00 Rename () into Unit, (,,...,,) into Tuple<n> (#21294) This patch implements a part of GHC Proposal #475. The key change is in GHC.Tuple.Prim: - data () = () - data (a,b) = (a,b) - data (a,b,c) = (a,b,c) ... + data Unit = () + data Tuple2 a b = (a,b) + data Tuple3 a b c = (a,b,c) ... And the rest of the patch makes sure that Unit and Tuple<n> are pretty-printed as () and (,,...,,) in various contexts. Updates the haddock submodule. Co-authored-by: Vladislav Zavialov <vlad.z.4096 at gmail.com> - - - - - 23642bf6 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: fix some wrongs in the eventlog format documentation - - - - - 90159773 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: explain the BLOCK_MARKER event - - - - - ab1c25e8 by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add BlockedOnMVarRead thread status in eventlog encodings - - - - - 898afaef by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add TASK_DELETE event in eventlog encodings - - - - - bb05b4cc by Adam Sandberg Ericsson at 2023-03-21T11:17:53-04:00 docs: add WALL_CLOCK_TIME event in eventlog encodings - - - - - eeea0343 by Torsten Schmits at 2023-03-21T11:18:34-04:00 Add structured error messages for GHC.Tc.Utils.Env Tracking ticket: #20119 MR: !10129 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - be1d4be8 by Bodigrim at 2023-03-21T11:19:13-04:00 Document pdep / pext primops - - - - - e8b4aac4 by Alex Mason at 2023-03-21T18:11:04-04:00 Allow LLVM backend to use HDoc for faster file generation. Also remove the MetaStmt constructor from LlvmStatement and places the annotations into the Store statement. Includes “Implement a workaround for -no-asm-shortcutting bug“ (https://gitlab.haskell.org/ghc/ghc/-/commit/2fda9e0df886cc551e2cd6b9c2a384192bdc3045) - - - - - ea24360d by Luite Stegeman at 2023-03-21T18:11:44-04:00 Compute LambdaFormInfo when using JavaScript backend. CmmCgInfos is needed to write interface files, but the JavaScript backend does not generate it, causing "Name without LFInfo" warnings. This patch adds a conservative but always correct CmmCgInfos when the JavaScript backend is used. Fixes #23053 - - - - - 926ad6de by Simon Peyton Jones at 2023-03-22T01:03:08-04:00 Be more careful about quantification This MR is driven by #23051. It does several things: * It is guided by the generalisation plan described in #20686. But it is still far from a complete implementation of that plan. * Add Note [Inferred type with escaping kind] to GHC.Tc.Gen.Bind. This explains that we don't (yet, pending #20686) directly prevent generalising over escaping kinds. * In `GHC.Tc.Utils.TcMType.defaultTyVar` we default RuntimeRep and Multiplicity variables, beause we don't want to quantify over them. We want to do the same for a Concrete tyvar, but there is nothing sensible to default it to (unless it has kind RuntimeRep, in which case it'll be caught by an earlier case). So we promote instead. * Pure refactoring in GHC.Tc.Solver: * Rename decideMonoTyVars to decidePromotedTyVars, since that's what it does. * Move the actual promotion of the tyvars-to-promote from `defaultTyVarsAndSimplify` to `decidePromotedTyVars`. This is a no-op; just tidies up the code. E.g then we don't need to return the promoted tyvars from `decidePromotedTyVars`. * A little refactoring in `defaultTyVarsAndSimplify`, but no change in behaviour. * When making a TauTv unification variable into a ConcreteTv (in GHC.Tc.Utils.Concrete.makeTypeConcrete), preserve the occ-name of the type variable. This just improves error messages. * Kill off dead code: GHC.Tc.Utils.TcMType.newConcreteHole - - - - - 0ab0cc11 by Sylvain Henry at 2023-03-22T01:03:48-04:00 Testsuite: use appropriate predicate for ManyUbxSums test (#22576) - - - - - 048c881e by romes at 2023-03-22T01:04:24-04:00 fix: Incorrect @since annotations in GHC.TypeError Fixes #23128 - - - - - a1528b68 by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T16318 (#22370) - - - - - ad765b6f by Sylvain Henry at 2023-03-22T01:05:04-04:00 Testsuite: use req_interp predicate for T20214 - - - - - e0b8eaf3 by Simon Peyton Jones at 2023-03-22T09:50:13+00:00 Refactor the constraint solver pipeline The big change is to put the entire type-equality solver into GHC.Tc.Solver.Equality, rather than scattering it over Canonical and Interact. Other changes * EqCt becomes its own data type, a bit like QCInst. This is great because EqualCtList is then just [EqCt] * New module GHC.Tc.Solver.Dict has come of the class-contraint solver. In due course it will be all. One step at a time. This MR is intended to have zero change in behaviour: it is a pure refactor. It opens the way to subsequent tidying up, we believe. - - - - - cedf9a3b by Torsten Schmits at 2023-03-22T15:31:18-04:00 Add structured error messages for GHC.Tc.Utils.TcMType Tracking ticket: #20119 MR: !10138 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 30d45e97 by Sylvain Henry at 2023-03-22T15:32:01-04:00 Testsuite: use js_skip for T2615 (#22374) - - - - - 8c98deba by Armando Ramirez at 2023-03-23T09:19:32-04:00 Optimized Foldable methods for Data.Functor.Compose Explicitly define length, elem, etc. in Foldable instance for Data.Functor.Compose Implementation of https://github.com/haskell/core-libraries-committee/issues/57 - - - - - bc066108 by Armando Ramirez at 2023-03-23T09:19:32-04:00 Additional optimized versions - - - - - 80fce576 by Bodigrim at 2023-03-23T09:19:32-04:00 Simplify minimum/maximum in instance Foldable (Compose f g) - - - - - 8cb88a5a by Bodigrim at 2023-03-23T09:19:32-04:00 Update changelog to mention changes to instance Foldable (Compose f g) - - - - - e1c8c41d by Torsten Schmits at 2023-03-23T09:20:13-04:00 Add structured error messages for GHC.Tc.TyCl.PatSyn Tracking ticket: #20117 MR: !10158 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - f932c589 by Adam Gundry at 2023-03-24T02:36:09-04:00 Allow WARNING pragmas to be controlled with custom categories Closes #17209. This implements GHC Proposal 541, allowing a WARNING pragma to be annotated with a category like so: {-# WARNING in "x-partial" head "This function is undefined on empty lists." #-} The user can then enable, disable and set the severity of such warnings using command-line flags `-Wx-partial`, `-Werror=x-partial` and so on. There is a new warning group `-Wextended-warnings` containing all these warnings. Warnings without a category are treated as if the category was `deprecations`, and are (still) controlled by the flags `-Wdeprecations` and `-Wwarnings-deprecations`. Updates Haddock submodule. - - - - - 0426515b by Adam Gundry at 2023-03-24T02:36:09-04:00 Move mention of warning groups change to 9.8.1 release notes - - - - - b8d783d2 by Ben Gamari at 2023-03-24T02:36:45-04:00 nativeGen/AArch64: Fix bitmask immediate predicate Previously the predicate for determining whether a logical instruction operand could be encoded as a bitmask immediate was far too conservative. This meant that, e.g., pointer untagged required five instructions whereas it should only require one. Fixes #23030. - - - - - 46120bb6 by Joachim Breitner at 2023-03-24T13:09:43-04:00 User's guide: Improve docs for -Wall previously it would list the warnings _not_ enabled by -Wall. That’s unnecessary round-about and was out of date. So let's just name the relevant warnings (based on `compiler/GHC/Driver/Flags.hs`). - - - - - 509d1f11 by Ben Gamari at 2023-03-24T13:10:20-04:00 codeGen/tsan: Disable instrumentation of unaligned stores There is some disagreement regarding the prototype of `__tsan_unaligned_write` (specifically whether it takes just the written address, or the address and the value as an argument). Moreover, I have observed crashes which appear to be due to it. Disable instrumentation of unaligned stores as a temporary mitigation. Fixes #23096. - - - - - 6a73655f by Li-yao Xia at 2023-03-25T00:02:44-04:00 base: Document GHC versions associated with past base versions in the changelog - - - - - 43bd7694 by Teo Camarasu at 2023-03-25T00:03:24-04:00 Add regression test for #17574 This test currently fails in the nonmoving way - - - - - f2d56bf7 by Teo Camarasu at 2023-03-25T00:03:24-04:00 fix: account for large and compact object stats with nonmoving gc Make sure that we keep track of the size of large and compact objects that have been moved onto the nonmoving heap. We keep track of their size and add it to the amount of live bytes in nonmoving segments to get the total size of the live nonmoving heap. Resolves #17574 - - - - - 7131b705 by David Feuer at 2023-03-25T00:04:04-04:00 Modify ThreadId documentation and comments For a long time, `GHC.Conc.Sync` has said ```haskell -- ToDo: data ThreadId = ThreadId (Weak ThreadId#) -- But since ThreadId# is unlifted, the Weak type must use open -- type variables. ``` We are now actually capable of using `Weak# ThreadId#`, but the world has moved on. To support the `Show` and `Ord` instances, we'd need to store the thread ID number in the `ThreadId`. And it seems very difficult to continue to support `threadStatus` in that regime, since it needs to be able to explain how threads died. In addition, garbage collection of weak references can be quite expensive, and it would be hard to evaluate the cost over he whole ecosystem. As discussed in [this CLC issue](https://github.com/haskell/core-libraries-committee/issues/125), it doesn't seem very likely that we'll actually switch to weak references here. - - - - - c421bbbb by Ben Gamari at 2023-03-25T00:04:41-04:00 rts: Fix barriers of IND and IND_STATIC Previously IND and IND_STATIC lacked the acquire barriers enjoyed by BLACKHOLE. As noted in the (now updated) Note [Heap memory barriers], this barrier is critical to ensure that the indirectee is visible to the entering core. Fixes #22872. - - - - - 62fa7faa by Bodigrim at 2023-03-25T00:05:22-04:00 Improve documentation of atomicModifyMutVar2# - - - - - b2d14d0b by Cheng Shao at 2023-03-25T03:46:43-04:00 rts: use performBlockingMajorGC in hs_perform_gc and fix ffi023 This patch does a few things: - Add the missing RtsSymbols.c entry of performBlockingMajorGC - Make hs_perform_gc call performBlockingMajorGC, which restores previous behavior - Use hs_perform_gc in ffi023 - Remove rts_clearMemory() call in ffi023, it now works again in some test ways previously marked as broken. Fixes #23089 - - - - - d9ae24ad by Cheng Shao at 2023-03-25T03:46:44-04:00 testsuite: add the rts_clearMemory test case This patch adds a standalone test case for rts_clearMemory that mimics how it's typically used by wasm backend users and ensures this RTS API isn't broken by future RTS refactorings. Fixes #23901. - - - - - 80729d96 by Bodigrim at 2023-03-25T03:47:22-04:00 Improve documentation for resizing of byte arrays - - - - - c6ec4cd1 by Ben Gamari at 2023-03-25T20:23:47-04:00 rts: Don't rely on EXTERN_INLINE for slop-zeroing logic Previously we relied on calling EXTERN_INLINE functions defined in ClosureMacros.h from Cmm to zero slop. However, as far as I can tell, this is no longer safe to do in C99 as EXTERN_INLINE definitions may be emitted in each compilation unit. Fix this by explicitly declaring a new set of non-inline functions in ZeroSlop.c which can be called from Cmm and marking the ClosureMacros.h definitions as INLINE_HEADER. In the future we should try to eliminate EXTERN_INLINE. - - - - - c32abd4b by Ben Gamari at 2023-03-25T20:23:48-04:00 rts: Fix capability-count check in zeroSlop Previously `zeroSlop` examined `RtsFlags` to determine whether the program was single-threaded. This is wrong; a program may be started with `+RTS -N1` yet the process may later increase the capability count with `setNumCapabilities`. This lead to quite subtle and rare crashes. Fixes #23088. - - - - - 656d4cb3 by Ryan Scott at 2023-03-25T20:24:23-04:00 Add Eq/Ord instances for SSymbol, SChar, and SNat This implements [CLC proposal #148](https://github.com/haskell/core-libraries-committee/issues/148). - - - - - 4f93de88 by David Feuer at 2023-03-26T15:33:02-04:00 Update and expand atomic modification Haddocks * The documentation for `atomicModifyIORef` and `atomicModifyIORef'` were incomplete, and the documentation for `atomicModifyIORef` was out of date. Update and expand. * Remove a useless lazy pattern match in the definition of `atomicModifyIORef`. The pair it claims to match lazily was already forced by `atomicModifyIORef2`. - - - - - e1fb56b2 by David Feuer at 2023-03-26T15:33:41-04:00 Document the constructor name for lists Derived `Data` instances use raw infix constructor names when applicable. The `Data.Data [a]` instance, if derived, would have a constructor name of `":"`. However, it actually uses constructor name `"(:)"`. Document this peculiarity. See https://github.com/haskell/core-libraries-committee/issues/147 - - - - - c1f755c4 by Simon Peyton Jones at 2023-03-27T22:09:41+01:00 Make exprIsConApp_maybe a bit cleverer Addresses #23159. See Note Note [Exploit occ-info in exprIsConApp_maybe] in GHC.Core.SimpleOpt. Compile times go down very slightly, but always go down, never up. Good! Metrics: compile_time/bytes allocated ------------------------------------------------ CoOpt_Singletons(normal) -1.8% T15703(normal) -1.2% GOOD geo. mean -0.1% minimum -1.8% maximum +0.0% Metric Decrease: CoOpt_Singletons T15703 - - - - - 76bb4c58 by Ryan Scott at 2023-03-28T08:12:08-04:00 Add COMPLETE pragmas to TypeRep, SSymbol, SChar, and SNat This implements [CLC proposal #149](https://github.com/haskell/core-libraries-committee/issues/149). - - - - - 3f374399 by sheaf at 2023-03-29T13:57:33+02:00 Handle records in the renamer This patch moves the field-based logic for disambiguating record updates to the renamer. The type-directed logic, scheduled for removal, remains in the typechecker. To do this properly (and fix the myriad of bugs surrounding the treatment of duplicate record fields), we took the following main steps: 1. Create GREInfo, a renamer-level equivalent to TyThing which stores information pertinent to the renamer. This allows us to uniformly treat imported and local Names in the renamer, as described in Note [GREInfo]. 2. Remove GreName. Instead of a GlobalRdrElt storing GreNames, which distinguished between normal names and field names, we now store simple Names in GlobalRdrElt, along with the new GREInfo information which allows us to recover the FieldLabel for record fields. 3. Add namespacing for record fields, within the OccNames themselves. This allows us to remove the mangling of duplicate field selectors. This change ensures we don't print mangled names to the user in error messages, and allows us to handle duplicate record fields in Template Haskell. 4. Move record disambiguation to the renamer, and operate on the level of data constructors instead, to handle #21443. The error message text for ambiguous record updates has also been changed to reflect that type-directed disambiguation is on the way out. (3) means that OccEnv is now a bit more complex: we first key on the textual name, which gives an inner map keyed on NameSpace: OccEnv a ~ FastStringEnv (UniqFM NameSpace a) Note that this change, along with (2), both increase the memory residency of GlobalRdrEnv = OccEnv [GlobalRdrElt], which causes a few tests to regress somewhat in compile-time allocation. Even though (3) simplified a lot of code (in particular the treatment of field selectors within Template Haskell and in error messages), it came with one important wrinkle: in the situation of -- M.hs-boot module M where { data A; foo :: A -> Int } -- M.hs module M where { data A = MkA { foo :: Int } } we have that M.hs-boot exports a variable foo, which is supposed to match with the record field foo that M exports. To solve this issue, we add a new impedance-matching binding to M foo{var} = foo{fld} This mimics the logic that existed already for impedance-binding DFunIds, but getting it right was a bit tricky. See Note [Record field impedance matching] in GHC.Tc.Module. We also needed to be careful to avoid introducing space leaks in GHCi. So we dehydrate the GlobalRdrEnv before storing it anywhere, e.g. in ModIface. This means stubbing out all the GREInfo fields, with the function forceGlobalRdrEnv. When we read it back in, we rehydrate with rehydrateGlobalRdrEnv. This robustly avoids any space leaks caused by retaining old type environments. Fixes #13352 #14848 #17381 #17551 #19664 #21443 #21444 #21720 #21898 #21946 #21959 #22125 #22160 #23010 #23062 #23063 Updates haddock submodule ------------------------- Metric Increase: MultiComponentModules MultiLayerModules MultiLayerModulesDefsGhci MultiLayerModulesNoCode T13701 T14697 hard_hole_fits ------------------------- - - - - - 4f1940f0 by sheaf at 2023-03-29T13:57:33+02:00 Avoid repeatedly shadowing in shadowNames This commit refactors GHC.Type.Name.Reader.shadowNames to first accumulate all the shadowing arising from the introduction of a new set of GREs, and then applies all the shadowing to the old GlobalRdrEnv in one go. - - - - - d246049c by sheaf at 2023-03-29T13:57:34+02:00 igre_prompt_env: discard "only-qualified" names We were unnecessarily carrying around names only available qualified in igre_prompt_env, violating the icReaderEnv invariant. We now get rid of these, as they aren't needed for the shadowing computation that igre_prompt_env exists for. Fixes #23177 ------------------------- Metric Decrease: T14052 T14052Type ------------------------- - - - - - 41a572f6 by Matthew Pickering at 2023-03-29T16:17:21-04:00 hadrian: Fix path to HpcParser.y The source for this project has been moved into a src/ folder so we also need to update this path. Fixes #23187 - - - - - b159e0e9 by doyougnu at 2023-03-30T01:40:08-04:00 js: split JMacro into JS eDSL and JS syntax This commit: Splits JExpr and JStat into two nearly identical DSLs: - GHC.JS.Syntax is the JMacro based DSL without unsaturation, i.e., a value cannot be unsaturated, or, a value of this DSL is a witness that a value of GHC.JS.Unsat has been saturated - GHC.JS.Unsat is the JMacro DSL from GHCJS with Unsaturation. Then all binary and outputable instances are changed to use GHC.JS.Syntax. This moves us closer to closing out #22736 and #22352. See #22736 for roadmap. ------------------------- Metric Increase: CoOpt_Read LargeRecord ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T10858 T11195 T11374 T11822 T12227 T12707 T13035 T13253 T13253-spj T13379 T14683 T15164 T15703 T16577 T17096 T17516 T17836 T18140 T18282 T18304 T18478 T18698a T18698b T18923 T1969 T19695 T20049 T21839c T3064 T4801 T5321FD T5321Fun T5631 T5642 T783 T9198 T9233 T9630 TcPlugin_RewritePerf WWRec ------------------------- - - - - - f4f1f14f by Sylvain Henry at 2023-03-30T01:40:49-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. Also used the opportunity to reenable 64-bit Word/Int tests - - - - - a5360490 by Ben Gamari at 2023-03-30T01:41:25-04:00 testsuite: Fix racing prints in T21465 As noted in #23155, we previously failed to add flushes necessary to ensure predictable output. Fixes #23155. - - - - - 98b5cf67 by Matthew Pickering at 2023-03-30T09:58:40+01:00 Revert "ghc-heap: remove wrong Addr# coercion (#23181)" This reverts commit f4f1f14f8009c3c120b8b963ec130cbbc774ec02. This fails to build with GHC-9.2 as a boot compiler. See #23195 for tracking this issue. - - - - - 61a2dfaa by Bodigrim at 2023-03-30T14:35:57-04:00 Add {-# WARNING #-} to Data.List.{head,tail} - - - - - 8f15c47c by Bodigrim at 2023-03-30T14:35:57-04:00 Fixes to accomodate Data.List.{head,tail} with {-# WARNING #-} - - - - - 7c7dbade by Bodigrim at 2023-03-30T14:35:57-04:00 Bump submodules - - - - - d2d8251b by Bodigrim at 2023-03-30T14:35:57-04:00 Fix tests - - - - - 3d38dcb6 by sheaf at 2023-03-30T14:35:57-04:00 Proxies for head and tail: review suggestions - - - - - 930edcfd by sheaf at 2023-03-30T14:36:33-04:00 docs: move RecordUpd changelog entry to 9.8 This was accidentally included in the 9.6 changelog instead of the 9.6 changelog. - - - - - 6f885e65 by sheaf at 2023-03-30T14:37:09-04:00 Add LANGUAGE GADTs to GHC.Rename.Env We need to enable this extension for the file to compile with ghc 9.2, as we are pattern matching on a GADT and this required the GADT extension to be enabled until 9.4. - - - - - 6d6a37a8 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: make lint-ci-config job fast again We don't pin our nixpkgs revision and tracks the default nixpkgs-unstable channel anyway. Instead of using haskell.packages.ghc924, we should be using haskell.packages.ghc92 to maximize the binary cache hit rate and make lint-ci-config job fast again. Also bumps the nix docker image to the latest revision. - - - - - ef1548c4 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: ensure that all non-i386 pipelines do parallel xz compression We can safely enable parallel xz compression for non-i386 pipelines. However, previously we didn't export XZ_OPT, so the xz process won't see it if XZ_OPT hasn't already been set in the current job. - - - - - 20432d16 by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: unset CROSS_EMULATOR for js job - - - - - 4a24dbbe by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: fix lint-testsuite job The list_broken make target will transitively depend on the calibrate.out target, which used STAGE1_GHC instead of TEST_HC. It really should be TEST_HC since that's what get passed in the gitlab CI config. - - - - - cea56ccc by Cheng Shao at 2023-03-30T18:42:56+00:00 ci: use alpine3_17-wasm image for wasm jobs Bump the ci-images dependency and use the new alpine3_17-wasm docker image for wasm jobs. - - - - - 79d0cb32 by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Add basic support for testing cross-compilers - - - - - e7392b4e by Ben Gamari at 2023-03-30T18:43:53+00:00 testsuite/driver: Normalize away differences in ghc executable name - - - - - ee160d06 by Ben Gamari at 2023-03-30T18:43:53+00:00 hadrian: Pass CROSS_EMULATOR to runtests.py - - - - - 30c84511 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: don't add optllvm way for wasm32 - - - - - f1beee36 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: normalize the .wasm extension - - - - - a984a103 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: strip the cross ghc prefix in output and error message - - - - - f7478d95 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: handle target executable extension - - - - - 8fe8b653 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: mypy typing error fixes This patch fixes some mypy typing errors which weren't caught in previous linting jobs. - - - - - 0149f32f by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: use context variable instead of thread-local variable This patch changes a thread-local variable to context variable instead, which works as intended when the testsuite transitions to use asyncio & coroutines instead of multi-threading to concurrently run test cases. Note that this also raises the minimum Python version to 3.7. - - - - - ea853ff0 by Cheng Shao at 2023-03-30T18:43:53+00:00 testsuite: asyncify the testsuite driver This patch refactors the testsuite driver, gets rid of multi-threading logic for running test cases concurrently, and uses asyncio & coroutines instead. This is not yak shaving for its own sake; the previous multi-threading logic is prone to livelock/deadlock conditions for some reason, even if the total number of threads is bounded to a thread pool's capacity. The asyncify change is an internal implementation detail of the testsuite driver and does not impact most GHC maintainers out there. The patch does not touch the .T files, test cases can be added/modified the exact same way as before. - - - - - 0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00 Add test for T23184 There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch: ``` commit 6656f0165a30fc2a22208532ba384fc8e2f11b46 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Fri Jul 23 23:57:01 2021 +0100 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: ...lots of lines omitted... 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. ``` Note this "Fix a fairly longstanding outright bug". This is the specific fix ``` @@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds -- let a = ...arg... -- in [...hole...] a -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable - do { let (dmd:_) = dmds -- Never fails - ; (floats1, cont') <- mkDupableContWithDmds env dmds cont + do { let (dmd:cont_dmds) = dmds -- Never fails + ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont ; let env' = env `setInScopeFromF` floats1 ; (_, se', arg') <- simplArg env' dup se arg ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg' ``` Ticket #23184 is a report of the bug that this diff fixes. - - - - - 62d25071 by mangoiv at 2023-04-01T04:20:01-04:00 [feat] make ($) representation polymorphic - this change was approved by the CLC in [1] following a CLC proposal [2] - make ($) representation polymorphic (adjust the type signature) - change ($) implementation to allow additional polymorphism - adjust the haddock of ($) to reflect these changes - add additional documentation to document these changes - add changelog entry - adjust tests (move now succeeding tests and adjust stdout of some tests) [1] https://github.com/haskell/core-libraries-committee/issues/132#issuecomment-1487456854 [2] https://github.com/haskell/core-libraries-committee/issues/132 - - - - - 77c33fb9 by Artem Pelenitsyn at 2023-04-01T04:20:41-04:00 User Guide: update copyright year: 2020->2023 - - - - - 3b5be05a by doyougnu at 2023-04-01T09:42:31-04:00 driver: Unit State Data.Map -> GHC.Unique.UniqMap In pursuit of #22426. The driver and unit state are major contributors. This commit also bumps the haddock submodule to reflect the API changes in UniqMap. ------------------------- Metric Decrease: MultiComponentModules MultiComponentModulesRecomp T10421 T10547 T12150 T12234 T12425 T13035 T16875 T18140 T18304 T18698a T18698b T18923 T20049 T5837 T6048 T9198 ------------------------- - - - - - a84fba6e by Torsten Schmits at 2023-04-01T09:43:12-04:00 Add structured error messages for GHC.Tc.TyCl Tracking ticket: #20117 MR: !10183 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 6e2eb275 by doyougnu at 2023-04-01T18:27:56-04:00 JS: Linker: use saturated JExpr Follow on to MR!10142 in pursuit of #22736 - - - - - 3da69346 by sheaf at 2023-04-01T18:28:37-04:00 Improve haddocks of template-haskell Con datatype This adds a bit more information, in particular about the lists of constructors in the GadtC and RecGadtC cases. - - - - - 3b7bbb39 by sheaf at 2023-04-01T18:28:37-04:00 TH: revert changes to GadtC & RecGadtC Commit 3f374399 included a breaking-change to the template-haskell library when it made the GadtC and RecGadtC constructors take non-empty lists of names. As this has the potential to break many users' packages, we decided to revert these changes for now. - - - - - f60f6110 by Bodigrim at 2023-04-02T18:59:30-04:00 Rework documentation for data Char - - - - - 43ebd5dc by Bodigrim at 2023-04-02T19:00:09-04:00 cmm: implement parsing of MO_AtomicRMW from hand-written CMM files Fixes #23206 - - - - - ab9cd52d by Sylvain Henry at 2023-04-03T08:15:21-04:00 ghc-heap: remove wrong Addr# coercion (#23181) Conversion from Addr# to I# isn't correct with the JS backend. - - - - - 2b2afff3 by Matthew Pickering at 2023-04-03T08:15:58-04:00 hadrian: Update bootstrap plans for 9.2.6, 9.2.7, 9.4.4, 9.4.5, 9.6.1 Also fixes the ./generate_bootstrap_plans script which was recently broken We can hopefully drop the 9.2 plans soon but they still work so kept them around for now. - - - - - c2605e25 by Matthew Pickering at 2023-04-03T08:15:58-04:00 ci: Add job to test 9.6 bootstrapping - - - - - 53e4d513 by Krzysztof Gogolewski at 2023-04-03T08:16:35-04:00 hadrian: Improve option parsing Several options in Hadrian had their argument marked as optional (`OptArg`), but if the argument wasn't there they were just giving an error. It's more idiomatic to mark the argument as required instead; the code uses less Maybes, the parser can enforce that the argument is present, --help gives better output. - - - - - a8e36892 by Sylvain Henry at 2023-04-03T08:17:16-04:00 JS: fix issues with FD api support - Add missing implementations for fcntl_read/write/lock - Fix fdGetMode These were found while implementing TH in !9779. These functions must be used somehow by the external interpreter code. - - - - - 8b092910 by Haskell-mouse at 2023-04-03T19:31:26-04:00 Convert diagnostics in GHC.Rename.HsType to proper TcRnMessage I've turned all occurrences of TcRnUnknownMessage in GHC.Rename.HsType module into a proper TcRnMessage. Instead, these TcRnMessage messages were introduced: TcRnDataKindsError TcRnUnusedQuantifiedTypeVar TcRnIllegalKindSignature TcRnUnexpectedPatSigType TcRnSectionPrecedenceError TcRnPrecedenceParsingError TcRnIllegalKind TcRnNegativeNumTypeLiteral TcRnUnexpectedKindVar TcRnBindMultipleVariables TcRnBindVarAlreadyInScope - - - - - 220a7a48 by Krzysztof Gogolewski at 2023-04-03T19:32:02-04:00 Fixes around unsafeCoerce# 1. `unsafeCoerce#` was documented in `GHC.Prim`. But since the overhaul in 74ad75e87317, `unsafeCoerce#` is no longer defined there. I've combined the documentation in `GHC.Prim` with the `Unsafe.Coerce` module. 2. The documentation of `unsafeCoerce#` stated that you should not cast a function to an algebraic type, even if you later cast it back before applying it. But ghci was doing that type of cast, as can be seen with 'ghci -ddump-ds' and typing 'x = not'. I've changed it to use Any following the documentation. - - - - - 9095e297 by Matthew Craven at 2023-04-04T01:04:10-04:00 Add a few more memcpy-ish primops * copyMutableByteArrayNonOverlapping# * copyAddrToAddr# * copyAddrToAddrNonOverlapping# * setAddrRange# The implementations of copyBytes, moveBytes, and fillBytes in base:Foreign.Marshal.Utils now use these new primops, which can cause us to work a bit harder generating code for them, resulting in the metric increase in T21839c observed by CI on some architectures. But in exchange, we get better code! Metric Increase: T21839c - - - - - f7da530c by Matthew Craven at 2023-04-04T01:04:10-04:00 StgToCmm: Upgrade -fcheck-prim-bounds behavior Fixes #21054. Additionally, we can now check for range overlap when generating Cmm for primops that use memcpy internally. - - - - - cd00e321 by sheaf at 2023-04-04T01:04:50-04:00 Relax assertion in varToRecFieldOcc When using Template Haskell, it is possible to re-parent a field OccName belonging to one data constructor to another data constructor. The lsp-types package did this in order to "extend" a data constructor with additional fields. This ran into an assertion in 'varToRecFieldOcc'. This assertion can simply be relaxed, as the resulting splices are perfectly sound. Fixes #23220 - - - - - eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00 GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201) - - - - - 071139c3 by Ryan Scott at 2023-04-04T11:09:51-04:00 Make INLINE pragmas for pattern synonyms work with TH Previously, the code for converting `INLINE <name>` pragmas from TH splices used `vNameN`, which assumed that `<name>` must live in the variable namespace. Pattern synonyms, on the other hand, live in the constructor namespace. I've fixed the issue by switching to `vcNameN` instead, which works for both the variable and constructor namespaces. Fixes #23203. - - - - - 7c16f3be by Krzysztof Gogolewski at 2023-04-04T17:13:00-04:00 Fix unification with oversaturated type families unify_ty was incorrectly saying that F x y ~ T x are surely apart, where F x y is an oversaturated type family and T x is a tyconapp. As a result, the simplifier dropped a live case alternative (#23134). - - - - - c165f079 by sheaf at 2023-04-04T17:13:40-04:00 Add testcase for #23192 This issue around solving of constraints arising from superclass expansion using other constraints also borned from superclass expansion was the topic of commit aed1974e. That commit made sure we don't emit a "redundant constraint" warning in a situation in which removing the constraint would cause errors. Fixes #23192 - - - - - d1bb16ed by Ben Gamari at 2023-04-06T03:40:45-04:00 nonmoving: Disable slop-zeroing As noted in #23170, the nonmoving GC can race with a mutator zeroing the slop of an updated thunk (in much the same way that two mutators would race). Consequently, we must disable slop-zeroing when the nonmoving GC is in use. Closes #23170 - - - - - 04b80850 by Brandon Chinn at 2023-04-06T03:41:21-04:00 Fix reverse flag for -Wunsupported-llvm-version - - - - - 0c990e13 by Pierre Le Marre at 2023-04-06T10:16:29+00:00 Add release note for GHC.Unicode refactor in base-4.18. Also merge CLC proposal 130 in base-4.19 with CLC proposal 59 in base-4.18 and add proper release date. - - - - - cbbfb283 by Alex Dixon at 2023-04-07T18:27:45-04:00 Improve documentation for ($) (#22963) - - - - - 5193c2b0 by Alex Dixon at 2023-04-07T18:27:45-04:00 Remove trailing whitespace from ($) commentary - - - - - b384523b by Sebastian Graf at 2023-04-07T18:27:45-04:00 Adjust wording wrt representation polymorphism of ($) - - - - - 6a788f0a by Torsten Schmits at 2023-04-07T22:29:28-04:00 Add structured error messages for GHC.Tc.TyCl.Utils Tracking ticket: #20117 MR: !10251 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 3ba77b36 by sheaf at 2023-04-07T22:30:07-04:00 Renamer: don't call addUsedGRE on an exact Name When looking up a record field in GHC.Rename.Env.lookupRecFieldOcc, we could end up calling addUsedGRE on an exact Name, which would then lead to a panic in the bestImport function: it would be incapable of processing a GRE which is not local but also not brought into scope by any imports (as it is referred to by its unique instead). Fixes #23240 - - - - - bc4795d2 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add support for -debug in the testsuite Confusingly, GhcDebugged referred to GhcDebugAssertions. - - - - - b7474b57 by Krzysztof Gogolewski at 2023-04-11T19:24:54-04:00 Add missing cases in -Di prettyprinter Fixes #23142 - - - - - 6c392616 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: make WasmCodeGenM an instance of MonadUnique - - - - - 05d26a65 by Cheng Shao at 2023-04-11T19:25:31-04:00 compiler: apply cmm node-splitting for wasm backend This patch applies cmm node-splitting for wasm32 NCG, which is required when handling irreducible CFGs. Fixes #23237. - - - - - f1892cc0 by Bodigrim at 2023-04-11T19:26:09-04:00 Set base 'maintainer' field to CLC - - - - - ecf22da3 by Simon Peyton Jones at 2023-04-11T19:26:45-04:00 Clarify a couple of Notes about 'nospec' - - - - - ebd8918b by Oleg Grenrus at 2023-04-12T12:32:57-04:00 Allow generation of TTH syntax with TH In other words allow generation of typed splices and brackets with Untyped Template Haskell. That is useful in cases where a library is build with TTH in mind, but we still want to generate some auxiliary declarations, where TTH cannot help us, but untyped TH can. Such example is e.g. `staged-sop` which works with TTH, but we would like to derive `Generic` declarations with TH. An alternative approach is to use `unsafeCodeCoerce`, but then the derived `Generic` instances would be type-checked only at use sites, i.e. much later. Also `-ddump-splices` output is quite ugly: user-written instances would use TTH brackets, not `unsafeCodeCoerce`. This commit doesn't allow generating of untyped template splices and brackets with untyped TH, as I don't know why one would want to do that (instead of merging the splices, e.g.) - - - - - 690d0225 by Rodrigo Mesquita at 2023-04-12T12:33:33-04:00 Add regression test for #23229 - - - - - 59321879 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quotRem rules (#22152) case quotRemInt# x y of (# q, _ #) -> body ====> case quotInt# x y of q -> body case quotRemInt# x y of (# _, r #) -> body ====> case remInt# x y of r -> body - - - - - 4dd02122 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Add quot folding rule (#22152) (x / l1) / l2 l1 and l2 /= 0 l1*l2 doesn't overflow ==> x / (l1 * l2) - - - - - 1148ac72 by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make Int64/Word64 division ok for speculation too. Only when the divisor is definitely non-zero. - - - - - 8af401cc by Sylvain Henry at 2023-04-13T08:50:33-04:00 Make WordQuotRem2Op ok-for-speculation too - - - - - 27d2978e by Josh Meredith at 2023-04-13T08:51:09-04:00 Base/JS: GHC.JS.Foreign.Callback module (issue 23126) * Add the Callback module for "exporting" Haskell functions to be available to plain JavaScript code * Fix some primitives defined in GHC.JS.Prim * Add a JavaScript section to the user guide with instructions on how to use the JavaScript FFI, building up to using Callbacks to interact with the browser * Add tests for the JavaScript FFI and Callbacks - - - - - a34aa8da by Adam Sandberg Ericsson at 2023-04-14T04:17:52-04:00 rts: improve memory ordering and add some comments in the StablePtr implementation - - - - - d7a768a4 by Matthew Pickering at 2023-04-14T04:18:28-04:00 docs: Generate docs/index.html with version number * Generate docs/index.html to include the version of the ghc library * This also fixes the packageVersions interpolations which were - Missing an interpolation for `LIBRARY_ghc_VERSION` - Double quoting the version so that "9.7" was being inserted. Fixes #23121 - - - - - d48fbfea by Simon Peyton Jones at 2023-04-14T04:19:05-04:00 Stop if type constructors have kind errors Otherwise we get knock-on errors, such as #23252. This makes GHC fail a bit sooner, and I have not attempted to add recovery code, to add a fake TyCon place of the erroneous one, in an attempt to get more type errors in one pass. We could do that (perhaps) if there was a call for it. - - - - - 2371d6b2 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Major refactor in the handling of equality constraints This MR substantially refactors the way in which the constraint solver deals with equality constraints. The big thing is: * Intead of a pipeline in which we /first/ canonicalise and /then/ interact (the latter including performing unification) the two steps are more closely integreated into one. That avoids the current rather indirect communication between the two steps. The proximate cause for this refactoring is fixing #22194, which involve solving [W] alpha[2] ~ Maybe (F beta[4]) by doing this: alpha[2] := Maybe delta[2] [W] delta[2] ~ F beta[4] That is, we don't promote beta[4]! This is very like introducing a cycle breaker, and was very awkward to do before, but now it is all nice. See GHC.Tc.Utils.Unify Note [Promotion and level-checking] and Note [Family applications in canonical constraints]. The big change is this: * Several canonicalisation checks (occurs-check, cycle-breaking, checking for concreteness) are combined into one new function: GHC.Tc.Utils.Unify.checkTyEqRhs This function is controlled by `TyEqFlags`, which says what to do for foralls, type families etc. * `canEqCanLHSFinish` now sees if unification is possible, and if so, actually does it: see `canEqCanLHSFinish_try_unification`. There are loads of smaller changes: * The on-the-fly unifier `GHC.Tc.Utils.Unify.unifyType` has a cheap-and-cheerful version of `checkTyEqRhs`, called `simpleUnifyCheck`. If `simpleUnifyCheck` succeeds, it can unify, otherwise it defers by emitting a constraint. This is simpler than before. * I simplified the swapping code in `GHC.Tc.Solver.Equality.canEqCanLHS`. Especially the nasty stuff involving `swap_for_occurs` and `canEqTyVarFunEq`. Much nicer now. See Note [Orienting TyVarLHS/TyFamLHS] Note [Orienting TyFamLHS/TyFamLHS] * Added `cteSkolemOccurs`, `cteConcrete`, and `cteCoercionHole` to the problems that can be discovered by `checkTyEqRhs`. * I fixed #23199 `pickQuantifiablePreds`, which actually allows GHC to to accept both cases in #22194 rather than rejecting both. Yet smaller: * Added a `synIsConcrete` flag to `SynonymTyCon` (alongside `synIsFamFree`) to reduce the need for synonym expansion when checking concreteness. Use it in `isConcreteType`. * Renamed `isConcrete` to `isConcreteType` * Defined `GHC.Core.TyCo.FVs.isInjectiveInType` as a more efficient way to find if a particular type variable is used injectively than finding all the injective variables. It is called in `GHC.Tc.Utils.Unify.definitely_poly`, which in turn is used quite a lot. * Moved `rewriterView` to `GHC.Core.Type`, so we can use it from the constraint solver. Fixes #22194, #23199 Compile times decrease by an average of 0.1%; but there is a 7.4% drop in compiler allocation on T15703. Metric Decrease: T15703 - - - - - 99b2734b by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Add some documentation about redundant constraints - - - - - 3f2d0eb8 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Improve partial signatures This MR fixes #23223. The changes are in two places: * GHC.Tc.Bind.checkMonomorphismRestriction See the new `Note [When the MR applies]` We now no longer stupidly attempt to apply the MR when the user specifies a context, e.g. f :: Eq a => _ -> _ * GHC.Tc.Solver.decideQuantification See rewritten `Note [Constraints in partial type signatures]` Fixing this bug apparently breaks three tests: * partial-sigs/should_compile/T11192 * partial-sigs/should_fail/Defaulting1MROff * partial-sigs/should_fail/T11122 However they are all symptoms of #23232, so I'm marking them as expect_broken(23232). I feel happy about this MR. Nice. - - - - - 23e2a8a0 by Simon Peyton Jones at 2023-04-14T20:01:02+02:00 Make approximateWC a bit cleverer This MR fixes #23224: making approximateWC more clever See the long `Note [ApproximateWC]` in GHC.Tc.Solver All this is delicate and ad-hoc -- but it /has/ to be: we are talking about inferring a type for a binding in the presence of GADTs, type families and whatnot: known difficult territory. We just try as hard as we can. - - - - - 2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00 docs: Update template-haskell docs to use Code Q a rather than Q (TExp a) Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a rather than Q (TExp a). The documentation in the `template-haskell` library wasn't updated to reflect this change. Fixes #23148 - - - - - 0da18eb7 by Krzysztof Gogolewski at 2023-04-15T14:35:53+02:00 Show an error when we cannot default a concrete tyvar Fixes #23153 - - - - - bad2f8b8 by sheaf at 2023-04-15T15:14:36+02:00 Handle ConcreteTvs in inferResultToType inferResultToType was discarding the ir_frr information, which meant some metavariables ended up being MetaTvs instead of ConcreteTvs. This function now creates new ConcreteTvs as necessary, instead of always creating MetaTvs. Fixes #23154 - - - - - 3b0ea480 by Simon Peyton Jones at 2023-04-16T18:12:20-04:00 Transfer DFunId_ness onto specialised bindings Whether a binding is a DFunId or not has consequences for the `-fdicts-strict` flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does not apply because the constraint solver can create recursive groups of dictionaries. In #22549 this was fixed for the "normal" case, see Note [Do not strictify the argument dictionaries of a dfun]. However the loop still existed if the DFunId was being specialised. The problem was that the specialiser would specialise a DFunId and turn it into a VanillaId and so the demand analyser didn't know to apply special treatment to the binding anymore and the whole recursive group was optimised to bottom. The solution is to transfer over the DFunId-ness of the binding in the specialiser so that the demand analyser knows not to apply the `-fstrict-dicts`. Fixes #22549 - - - - - a1371ebb by Oleg Grenrus at 2023-04-16T18:12:59-04:00 Add import lists to few GHC.Driver.Session imports Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261. There are a lot of GHC.Driver.Session which only use DynFlags, but not the parsing code. - - - - - 51479ceb by Matthew Pickering at 2023-04-17T08:08:48-04:00 Account for special GHC.Prim import in warnUnusedPackages The GHC.Prim import is treated quite specially primarily because there isn't an interface file for GHC.Prim. Therefore we record separately in the ModSummary if it's imported or not so we don't go looking for it. This logic hasn't made it's way to `-Wunused-packages` so if you imported GHC.Prim then the warning would complain you didn't use `-package ghc-prim`. Fixes #23212 - - - - - 1532a8b2 by Simon Peyton Jones at 2023-04-17T08:09:24-04:00 Add regression test for #23199 - - - - - 0158c5f1 by Ryan Scott at 2023-04-17T18:43:27-04:00 validDerivPred: Reject exotic constraints in IrredPreds This brings the `IrredPred` case in sync with the treatment of `ClassPred`s as described in `Note [Valid 'deriving' predicate]` in `GHC.Tc.Validity`. Namely, we should reject `IrredPred`s that are inferred from `deriving` clauses whose arguments contain other type constructors, as described in `(VD2) Reject exotic constraints` of that Note. This has the nice property that `deriving` clauses whose inferred instance context mention `TypeError` will now emit the type error in the resulting error message, which better matches existing intuitions about how `TypeError` should work. While I was in town, I noticed that much of `Note [Valid 'deriving' predicate]` was duplicated in a separate `Note [Exotic derived instance contexts]` in `GHC.Tc.Deriv.Infer`. I decided to fold the latter Note into the former so that there is a single authority on describing the conditions under which an inferred `deriving` constraint can be considered valid. This changes the behavior of `deriving` in a way that existing code might break, so I have made a mention of this in the GHC User's Guide. It seems very, very unlikely that much code is relying on this strange behavior, however, and even if there is, there is a clear, backwards-compatible migration path using `StandaloneDeriving`. Fixes #22696. - - - - - 10364818 by Krzysztof Gogolewski at 2023-04-17T18:44:03-04:00 Misc cleanup - Use dedicated list functions - Make cloneBndrs and cloneRecIdBndrs monadic - Fix invalid haddock comments in libraries/base - - - - - 5e1d33d7 by Matthew Pickering at 2023-04-18T10:31:02-04:00 Convert interface file loading errors into proper diagnostics This patch converts all the errors to do with loading interface files into proper structured diagnostics. * DriverMessage: Sometimes in the driver we attempt to load an interface file so we embed the IfaceMessage into the DriverMessage. * TcRnMessage: Most the time we are loading interface files during typechecking, so we embed the IfaceMessage This patch also removes the TcRnInterfaceLookupError constructor which is superceded by the IfaceMessage, which is now structured compared to just storing an SDoc before. - - - - - df1a5811 by sheaf at 2023-04-18T10:31:43-04:00 Don't panic in ltPatersonSize The function GHC.Tc.Utils.TcType.ltPatersonSize would panic when it encountered a type family on the RHS, as usually these are not allowed (type families are not allowed on the RHS of class instances or of quantified constraints). However, it is possible to still encounter type families on the RHS after doing a bit of constraint solving, as seen in test case T23171. This could trigger the panic in the call to ltPatersonSize in GHC.Tc.Solver.Canonical.mk_strict_superclasses, which is involved in avoiding loopy superclass constraints. This patch simply changes ltPatersonSize to return "I don't know, because there's a type family involved" in these cases. Fixes #23171 - - - - - d442ac05 by Sylvain Henry at 2023-04-19T20:04:35-04:00 JS: fix thread-related primops - - - - - 7a96f90b by Bryan Richter at 2023-04-19T20:05:11-04:00 CI: Disable abi-test-nightly See #23269 - - - - - ab6c1d29 by Sylvain Henry at 2023-04-19T20:05:50-04:00 Testsuite: don't use obsolescent egrep (#22351) Recent egrep displays the following message, breaking golden tests: egrep: warning: egrep is obsolescent; using grep -E Switch to using "grep -E" instead - - - - - f15b0ce5 by Matthew Pickering at 2023-04-20T11:01:06-04:00 hadrian: Pass haddock file arguments in a response file In !10119 CI was failing on windows because the command line was too long. We can mitigate this by passing the file arguments to haddock in a response file. We can't easily pass all the arguments in a response file because the `+RTS` arguments can't be placed in the response file. Fixes #23273 - - - - - 7012ec2f by tocic at 2023-04-20T11:01:42-04:00 Fix doc typo in GHC.Read.readList - - - - - 5c873124 by sheaf at 2023-04-20T18:33:34-04:00 Implement -jsem: parallelism controlled by semaphores See https://github.com/ghc-proposals/ghc-proposals/pull/540/ for a complete description for the motivation for this feature. The `-jsem` option allows a build tool to pass a semaphore to GHC which GHC can use in order to control how much parallelism it requests. GHC itself acts as a client in the GHC jobserver protocol. ``` GHC Jobserver Protocol ~~~~~~~~~~~~~~~~~~~~~~ This proposal introduces the GHC Jobserver Protocol. This protocol allows a server to dynamically invoke many instances of a client process, while restricting all of those instances to use no more than <n> capabilities. This is achieved by coordination over a system semaphore (either a POSIX semaphore [6]_ in the case of Linux and Darwin, or a Win32 semaphore [7]_ in the case of Windows platforms). There are two kinds of participants in the GHC Jobserver protocol: - The *jobserver* creates a system semaphore with a certain number of available tokens. Each time the jobserver wants to spawn a new jobclient subprocess, it **must** first acquire a single token from the semaphore, before spawning the subprocess. This token **must** be released once the subprocess terminates. Once work is finished, the jobserver **must** destroy the semaphore it created. - A *jobclient* is a subprocess spawned by the jobserver or another jobclient. Each jobclient starts with one available token (its *implicit token*, which was acquired by the parent which spawned it), and can request more tokens through the Jobserver Protocol by waiting on the semaphore. Each time a jobclient wants to spawn a new jobclient subprocess, it **must** pass on a single token to the child jobclient. This token can either be the jobclient's implicit token, or another token which the jobclient acquired from the semaphore. Each jobclient **must** release exactly as many tokens as it has acquired from the semaphore (this does not include the implicit tokens). ``` Build tools such as cabal act as jobservers in the protocol and are responsibile for correctly creating, cleaning up and managing the semaphore. Adds a new submodule (semaphore-compat) for managing and interacting with semaphores in a cross-platform way. Fixes #19349 - - - - - 52d3e9b4 by Ben Gamari at 2023-04-20T18:34:11-04:00 rts: Initialize Array# header in listThreads# Previously the implementation of listThreads# failed to initialize the header of the created array, leading to various nastiness. Fixes #23071 - - - - - 1db30fe1 by Ben Gamari at 2023-04-20T18:34:11-04:00 testsuite: Add test for #23071 - - - - - dae514f9 by tocic at 2023-04-21T13:31:21-04:00 Fix doc typos in libraries/base/GHC - - - - - 113e21d7 by Sylvain Henry at 2023-04-21T13:32:01-04:00 Testsuite: replace some js_broken/js_skip predicates with req_c Using req_c is more precise. - - - - - 038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00 Minor doc fixes - Add docs/index.html to .gitignore. It is created by ./hadrian/build docs, and it was the only file in Hadrian's templateRules not present in .gitignore. - Mention that MultiWayIf supports non-boolean guards - Remove documentation of optdll - removed in 2007, 763daed95 - Fix markdown syntax - - - - - e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00 User's guide: DeepSubsumption is implied by Haskell{98,2010} - - - - - 499a1c20 by PHO at 2023-04-23T13:39:32-04:00 Implement executablePath for Solaris and make getBaseDir less platform-dependent Use base-4.17 executablePath when possible, and fall back on getExecutablePath when it's not available. The sole reason why getBaseDir had #ifdef's was apparently that getExecutablePath wasn't reliable, and we could reduce the number of CPP conditionals by making use of executablePath instead. Also export executablePath on js_HOST_ARCH. - - - - - 97a6f7bc by tocic at 2023-04-23T13:40:08-04:00 Fix doc typos in libraries/base - - - - - 787c6e8c by Ben Gamari at 2023-04-24T12:19:06-04:00 testsuite/T20137: Avoid impl.-defined behavior Previously we would cast pointers to uint64_t. However, implementations are allowed to either zero- or sign-extend such casts. Instead cast to uintptr_t to avoid this. Fixes #23247. - - - - - 87095f6a by Cheng Shao at 2023-04-24T12:19:44-04:00 rts: always build 64-bit atomic ops This patch does a few things: - Always build 64-bit atomic ops in rts/ghc-prim, even on 32-bit platforms - Remove legacy "64bit" cabal flag of rts package - Fix hs_xchg64 function prototype for 32-bit platforms - Fix AtomicFetch test for wasm32 - - - - - 2685a12d by Cheng Shao at 2023-04-24T12:20:21-04:00 compiler: don't install signal handlers when the host platform doesn't have signals Previously, large parts of GHC API will transitively invoke withSignalHandlers, which doesn't work on host platforms without signal functionality at all (e.g. wasm32-wasi). By making withSignalHandlers a no-op on those platforms, we can make more parts of GHC API work out of the box when signals aren't supported. - - - - - 1338b7a3 by Cheng Shao at 2023-04-24T16:21:30-04:00 hadrian: fix non-ghc program paths passed to testsuite driver when testing cross GHC - - - - - 1a10f556 by Bodigrim at 2023-04-24T16:22:09-04:00 Add since pragma to Data.Functor.unzip - - - - - 0da9e882 by Soham Chowdhury at 2023-04-25T00:15:22-04:00 More informative errors for bad imports (#21826) - - - - - ebd5b078 by Josh Meredith at 2023-04-25T00:15:58-04:00 JS/base: provide implementation for mkdir (issue 22374) - - - - - 8f656188 by Josh Meredith at 2023-04-25T18:12:38-04:00 JS: Fix h$base_access implementation (issue 22576) - - - - - 74c55712 by Andrei Borzenkov at 2023-04-25T18:13:19-04:00 Give more guarntees about ImplicitParams (#23289) - Added new section in the GHC user's guide that legends behavior of nested implicit parameter bindings in these two cases: let ?f = 1 in let ?f = 2 in ?f and data T where MkT :: (?f :: Int) => T f :: T -> T -> Int f MkT MkT = ?f - Added new test case to examine this behavior. - - - - - c30ac25f by Sebastian Graf at 2023-04-26T14:50:51-04:00 DmdAnal: Unleash demand signatures of free RULE and unfolding binders (#23208) In #23208 we observed that the demand signature of a binder occuring in a RULE wasn't unleashed, leading to a transitively used binder being discarded as absent. The solution was to use the same code path that we already use for handling exported bindings. See the changes to `Note [Absence analysis for stable unfoldings and RULES]` for more details. I took the chance to factor out the old notion of a `PlusDmdArg` (a pair of a `VarEnv Demand` and a `Divergence`) into `DmdEnv`, which fits nicely into our existing framework. As a result, I had to touch quite a few places in the code. This refactoring exposed a few small bugs around correct handling of bottoming demand environments. As a result, some strictness signatures now mention uniques that weren't there before which caused test output changes to T13143, T19969 and T22112. But these tests compared whole -ddump-simpl listings which is a very fragile thing to begin with. I changed what exactly they test for based on the symptoms in the corresponding issues. There is a single regression in T18894 because we are more conservative around stable unfoldings now. Unfortunately it is not easily fixed; let's wait until there is a concrete motivation before invest more time. Fixes #23208. - - - - - 77f506b8 by Josh Meredith at 2023-04-26T14:51:28-04:00 Refactor GenStgRhs to include the Type in both constructors (#23280, #22576, #22364) Carry the actual type of an expression through the PreStgRhs and into GenStgRhs for use in later stages. Currently this is used in the JavaScript backend to fix some tests from the above mentioned issues: EtaExpandLevPoly, RepPolyWrappedVar2, T13822, T14749. - - - - - 052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00 EPA: Use ExplicitBraces only in HsModule !9018 brought in exact print annotations in LayoutInfo for open and close braces at the top level. But it retained them in the HsModule annotations too. Remove the originals, so exact printing uses LayoutInfo - - - - - d5c4629b by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: update ci.sh to actually run the entire testsuite for wasm backend For the time being, we still need to use in-tree mode and can't test the bindist yet. - - - - - 533d075e by Cheng Shao at 2023-04-27T16:00:35-04:00 ci: additional wasm32 manual jobs in validate pipelines This patch enables bignum native & unregisterised wasm32 jobs as manual jobs in validate pipelines, which can be useful to prevent breakage when working on wasm32 related patches. - - - - - b5f00811 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix cross prefix stripping This patch fixes cross prefix stripping in the testsuite driver. The normalization logic used to only handle prefixes of the triple form <arch>-<vendor>-<os>, now it's relaxed to allow any number of tokens in the prefix tuple, so the cross prefix stripping logic would work when ghc is configured with something like --target=wasm32-wasi. - - - - - 6f511c36 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: include target exe extension in heap profile filenames This patch fixes hp2ps related framework failures when testing the wasm backend by including target exe extension in heap profile filenames. - - - - - e6416b10 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: exclude ghci ways if no rts linker is present This patch implements logic to automatically exclude ghci ways when there is no rts linker. It's way better than having to annotate individual test cases. - - - - - 791cce64 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: fix permission bits in copy_files When the testsuite driver copy files instead of symlinking them, it should also copy the permission bits, otherwise there'll be permission denied errors. Also, enforce file copying when testing wasm32, since wasmtime doesn't handle host symlinks quite well (https://github.com/bytecodealliance/wasmtime/issues/6227). - - - - - aa6afe8a by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_ghc_with_threaded_rts predicate This patch adds the req_ghc_with_threaded_rts predicate to the testsuite to assert the platform has threaded RTS, and mark some tests as req_ghc_with_threaded_rts. Also makes ghc_with_threaded_rts a config field instead of a global variable. - - - - - ce580426 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_process predicate This patch adds the req_process predicate to the testsuite to assert the platform has a process model, also marking tests that involve spawning processes as req_process. Also bumps hpc & process submodule. - - - - - cb933665 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add the req_host_target_ghc predicate This patch adds the req_host_target_ghc predicate to the testsuite to assert the ghc compiler being tested can compile both host/target code. When testing cross GHCs this is not supported yet, but it may change in the future. - - - - - b174a110 by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: add missing annotations for some tests This patch adds missing annotations (req_th, req_dynamic_lib_support, req_rts_linker) to some tests. They were discovered when testing wasm32, though it's better to be explicit about what features they require, rather than simply adding when(arch('wasm32'), skip). - - - - - bd2bfdec by Cheng Shao at 2023-04-27T16:00:35-04:00 testsuite: wasm32-specific fixes This patch includes all wasm32-specific testsuite fixes. - - - - - 4eaf2c2a by Josh Meredith at 2023-04-27T16:01:11-04:00 JS: change GHC.JS.Transform.identsS/E/V to take a saturated IR (#23304) - - - - - 57277662 by sheaf at 2023-04-29T20:23:06+02:00 Add the Unsatisfiable class This commit implements GHC proposal #433, adding the Unsatisfiable class to the GHC.TypeError module. This provides an alternative to TypeError for which error reporting is more predictable: we report it when we are reporting unsolved Wanted constraints. Fixes #14983 #16249 #16906 #18310 #20835 - - - - - 00a8a5ff by Torsten Schmits at 2023-04-30T03:45:09-04:00 Add structured error messages for GHC.Rename.Names Tracking ticket: #20115 MR: !10336 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 931c8d82 by Ben Orchard at 2023-05-03T20:16:18-04:00 Add sized primitive literal syntax Adds a new LANGUAGE pragma ExtendedLiterals, which enables defining unboxed numeric literals such as `0xFF#Word8 :: Word8#`. Implements GHC proposal 0451: https://github.com/ghc-proposals/ghc-proposals/blob/b384a538b34f79d18a0201455b7b3c473bc8c936/proposals/0451-sized-literals.rst Fixes #21422. Bumps haddock submodule. Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski at tweag.io> - - - - - f3460845 by Bodigrim at 2023-05-03T20:16:57-04:00 Document instances of Double - - - - - 1e9caa1a by Sylvain Henry at 2023-05-03T20:17:37-04:00 Bump Cabal submodule (#22356) - - - - - 4eafb52a by sheaf at 2023-05-03T20:18:16-04:00 Don't forget to check the parent in an export list Commit 3f374399 introduced a bug which caused us to forget to include the parent of an export item of the form T(..) (that is, IEThingAll) when checking for duplicate exports. Fixes #23318 - - - - - 8fde4ac8 by amesgen at 2023-05-03T20:18:57-04:00 Fix unlit path in cross bindists - - - - - 8cc9a534 by Matthew Pickering at 2023-05-04T14:58:14-04:00 hadrian: Flavour: Change args -> extraArgs Previously in a flavour definition you could override all the flags which were passed to GHC. This causes issues when needed to compute a package hash because we need to know what these extra arguments are going to be before computing the hash. The solution is to modify flavour so that the arguments you pass here are just extra ones rather than all the arguments that you need to compile something. This makes things work more like how cabal.project files work when you give extra arguments to a package and also means that flavour transformers correctly affect the hash. - - - - - 3fdb18f8 by romes at 2023-05-04T14:58:14-04:00 Hardwire a better unit-id for ghc Previously, the unit-id of ghc-the-library was fixed as `ghc`. This was done primarily because the compiler must know the unit-id of some packages (including ghc) a-priori to define wired-in names. However, as seen in #20742, a reinstallable `ghc` whose unit-id is fixed to `ghc` might result in subtle bugs when different ghc's interact. A good example of this is having GHC_A load a plugin compiled by GHC_B, where GHC_A and GHC_B are linked to ghc-libraries that are ABI incompatible. Without a distinction between the unit-id of the ghc library GHC_A is linked against and the ghc library the plugin it is loading was compiled against, we can't check compatibility. This patch gives a slightly better unit-id to ghc (ghc-version) by (1) Not setting -this-unit-id to ghc, but rather to the new unit-id (modulo stage0) (2) Adding a definition to `GHC.Settings.Config` whose value is the new unit-id. (2.1) `GHC.Settings.Config` is generated by Hadrian (2.2) and also by cabal through `compiler/Setup.hs` This unit-id definition is imported by `GHC.Unit.Types` and used to set the wired-in unit-id of "ghc", which was previously fixed to "ghc" The commits following this one will improve the unit-id with a cabal-style package hash and check compatibility when loading plugins. Note that we also ensure that ghc's unit key matches unit id both when hadrian or cabal builds ghc, and in this way we no longer need to add `ghc` to the WiringMap. - - - - - 6689c9c6 by romes at 2023-05-04T14:58:14-04:00 Validate compatibility of ghcs when loading plugins Ensure, when loading plugins, that the ghc the plugin depends on is the ghc loading the plugin -- otherwise fail to load the plugin. Progress towards #20742. - - - - - db4be339 by romes at 2023-05-04T14:58:14-04:00 Add hashes to unit-ids created by hadrian This commit adds support for computing an inputs hash for packages compiled by hadrian. The result is that ABI incompatible packages should be given different hashes and therefore be distinct in a cabal store. Hashing is enabled by the `--flag`, and is off by default as the hash contains a hash of the source files. We enable it when we produce release builds so that the artifacts we distribute have the right unit ids. - - - - - 944a9b94 by Matthew Pickering at 2023-05-04T14:58:14-04:00 Use hash-unit-ids in release jobs Includes fix upload_ghc_libs glob - - - - - 116d7312 by Josh Meredith at 2023-05-04T14:58:51-04:00 JS: fix bounds checking (Issue 23123) * For ByteArray-based bounds-checking, the JavaScript backend must use the `len` field, instead of the inbuild JavaScript `length` field. * Range-based operations must also check both the start and end of the range for bounds * All indicies are valid for ranges of size zero, since they are essentially no-ops * For cases of ByteArray accesses (e.g. read as Int), the end index is (i * sizeof(type) + sizeof(type) - 1), while the previous implementation uses (i + sizeof(type) - 1). In the Int32 example, this is (i * 4 + 3) * IndexByteArrayOp_Word8As* primitives use byte array indicies (unlike the previous point), but now check both start and end indicies * Byte array copies now check if the arrays are the same by identity and then if the ranges overlap. - - - - - 2d5c1dde by Sylvain Henry at 2023-05-04T14:58:51-04:00 Fix remaining issues with bound checking (#23123) While fixing these I've also changed the way we store addresses into ByteArray#. Addr# are composed of two parts: a JavaScript array and an offset (32-bit number). Suppose we want to store an Addr# in a ByteArray# foo at offset i. Before this patch, we were storing both fields as a tuple in the "arr" array field: foo.arr[i] = [addr_arr, addr_offset]; Now we only store the array part in the "arr" field and the offset directly in the array: foo.dv.setInt32(i, addr_offset): foo.arr[i] = addr_arr; It avoids wasting space for the tuple. - - - - - 98c5ee45 by Luite Stegeman at 2023-05-04T14:59:31-04:00 JavaScript: Correct arguments to h$appendToHsStringA fixes #23278 - - - - - ca611447 by Josh Meredith at 2023-05-04T15:00:07-04:00 base/encoding: add an allocations performance test (#22946) - - - - - e3ddf58d by Krzysztof Gogolewski at 2023-05-04T15:00:44-04:00 linear types: Don't add external names to the usage env This has no observable effect, but avoids storing useless data. - - - - - b3226616 by Andrei Borzenkov at 2023-05-04T15:01:25-04:00 Improved documentation for the Data.OldList.nub function There was recomentation to use map head . group . sort instead of nub function, but containers library has more suitable and efficient analogue - - - - - e8b72ff6 by Ryan Scott at 2023-05-04T15:02:02-04:00 Fix type variable substitution in gen_Newtype_fam_insts Previously, `gen_Newtype_fam_insts` was substituting the type variable binders of a type family instance using `substTyVars`, which failed to take type variable dependencies into account. There is similar code in `GHC.Tc.TyCl.Class.tcATDefault` that _does_ perform this substitution properly, so this patch: 1. Factors out this code into a top-level `substATBndrs` function, and 2. Uses `substATBndrs` in `gen_Newtype_fam_insts`. Fixes #23329. - - - - - 275836d2 by Torsten Schmits at 2023-05-05T08:43:02+00:00 Add structured error messages for GHC.Rename.Utils Tracking ticket: #20115 MR: !10350 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 983ce558 by Oleg Grenrus at 2023-05-05T13:11:29-04:00 Use TemplateHaskellQuotes in TH.Syntax to construct Names - - - - - a5174a59 by Matthew Pickering at 2023-05-05T18:42:31-04: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. - - - - - 18a7d03d by Aaron Allen at 2023-05-05T18:42:31-04: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> - - - - - 6e776ed3 by Matthew Pickering at 2023-05-05T18:42:31-04:00 docs: Add Note [Timing of plugin initialization] - - - - - e1df8511 by Matthew Pickering at 2023-05-05T18:43:07-04:00 Incrementally update ghcup metadata in ghc/ghcup-metadata This job paves the way for distributing nightly builds * A new repo https://gitlab.haskell.org/ghc/ghcup-metadata stores the metadata on the "updates" branch. * Each night this metadata is downloaded and the nightly builds are appended to the end of the metadata. * The update job only runs on the scheduled nightly pipeline, not just when NIGHTLY=1. Things which are not done yet * Modify the retention policy for nightly jobs * Think about building release flavour compilers to distribute nightly. Fixes #23334 - - - - - 8f303d27 by Rodrigo Mesquita at 2023-05-05T22:04:31-04:00 docs: Remove mentions of ArrayArray# from unlifted FFI section Fixes #23277 - - - - - 994bda56 by Torsten Schmits at 2023-05-05T22:05:12-04:00 Add structured error messages for GHC.Rename.Module Tracking ticket: #20115 MR: !10361 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. Only addresses the single warning missing from the previous MR. - - - - - 3e3a6be4 by Ben Gamari at 2023-05-08T12:15:19+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. - - - - - 78c8dc50 by Torsten Schmits at 2023-05-08T21:41:51-04:00 Add structured error messages for GHC.IfaceToCore Tracking ticket: #20114 MR: !10390 This converts uses of `mkTcRnUnknownMessage` to newly added constructors of `TcRnMessage`. - - - - - 0e2df4c9 by Bryan Richter at 2023-05-09T12:03:35+03:00 Fix up rules for ghcup-metadata-nightly-push - - - - - b970e64f by Ben Gamari at 2023-05-09T08:41:33-04:00 testsuite: Add test for atomicSwapIORef - - - - - 81cfefd2 by Ben Gamari at 2023-05-09T08:41:53-04:00 compiler: Implement atomicSwapIORef with xchg As requested by @treeowl in CLC#139. - - - - - 6b29154d by Ben Gamari at 2023-05-09T08:41:53-04:00 Make atomicSwapMutVar# an inline primop - - - - - 64064cfe by doyougnu at 2023-05-09T18:40:01-04:00 JS: add GHC.JS.Optimizer, remove RTS.Printer, add Linker.Opt This MR changes some simple optimizations and is a first step in re-architecting the JS backend pipeline to add the optimizer. In particular it: - removes simple peep hole optimizations from `GHC.StgToJS.Printer` and removes that module - adds module `GHC.JS.Optimizer` - defines the same peep hole opts that were removed only now they are `Syntax -> Syntax` transformations rather than `Syntax -> JS code` optimizations - hooks the optimizer into code gen - adds FuncStat and ForStat constructors to the backend. Working Ticket: - #22736 Related MRs: - MR !10142 - MR !10000 ------------------------- Metric Decrease: CoOpt_Read ManyAlternatives PmSeriesS PmSeriesT PmSeriesV T10421 T12707 T13253 T13253-spj T15164 T17516 T18140 T18282 T18698a T18698b T18923 T1969 T19695 T20049 T3064 T5321FD T5321Fun T783 T9198 T9233 T9630 ------------------------- - - - - - 6738c01d by Krzysztof Gogolewski at 2023-05-09T18:40:38-04:00 Add a regression test for #21050 - - - - - b2cdb7da by Ben Gamari at 2023-05-09T18:41:14-04:00 nonmoving: Account for mutator allocations in bytes_allocated Previously we failed to account direct mutator allocations into the nonmoving heap against the mutator's allocation limit and `cap->total_allocated`. This only manifests during CAF evaluation (since we allocate the CAF's blackhole directly into the nonmoving heap). Fixes #23312. - - - - - 0657b482 by Sven Tennie at 2023-05-09T22:22:42-04:00 Adjust AArch64 stackFrameHeaderSize The prologue of each stack frame are the saved LR and FP registers, 8 byte each. I.e. the size of the stack frame header is 2 * 8 byte. - - - - - 7788c09c by konsumlamm at 2023-05-09T22:23:23-04:00 Make `(&)` representation polymorphic in the return type - - - - - b3195922 by Ben Gamari at 2023-05-10T05:06:45-04:00 ghc-prim: Generalize keepAlive#/touch# in state token type Closes #23163. - - - - - 1e6861dd by Cheng Shao at 2023-05-10T05:07:25-04:00 Bump hsc2hs submodule Fixes #22981. - - - - - 0a513952 by Ben Gamari at 2023-05-11T04:10:17-04:00 base: Export GHC.Conc.Sync.fromThreadId Closes #22706. - - - - - 29be39ba by Matthew Pickering at 2023-05-11T04:10:54-04:00 Build vanilla alpine bindists We currently attempt to build and distribute fully static alpine bindists (ones which could be used on any linux platform) but most people who use the alpine bindists want to use alpine to build their own static applications (for which a fully static bindist is not necessary). We should build and distribute these bindists for these users whilst the fully-static bindist is still unusable. Fixes #23349 - - - - - 40c7daed by Simon Peyton Jones at 2023-05-11T04:11:30-04:00 Look both ways when looking for quantified equalities When looking up (t1 ~# t2) in the quantified constraints, check both orientations. Forgetting this led to #23333. - - - - - c17bb82f by Rodrigo Mesquita at 2023-05-11T04:12:07-04:00 Move "target has RTS linker" out of settings We move the "target has RTS linker" information out of configure into a predicate in GHC, and remove this option from the settings file where it is unnecessary -- it's information statically known from the platform. Note that previously we would consider `powerpc`s and `s390x`s other than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker, but the RTS linker supports neither platform. Closes #23361 - - - - - bd0b056e by Krzysztof Gogolewski at 2023-05-11T04:12:44-04:00 Add a test for #17284 Since !10123 we now reject this program. - - - - - 630b1fea by Bodigrim at 2023-05-11T04:13:24-04:00 Document unlawfulness of instance Num Fixed Fixes #22712 - - - - - 87eebf98 by sheaf at 2023-05-11T11:55:22-04:00 Add fused multiply-add instructions This patch adds eight new primops that fuse a multiplication and an addition or subtraction: - `{fmadd,fmsub,fnmadd,fnmsub}{Float,Double}#` fmadd x y z is x * y + z, computed with a single rounding step. This patch implements code generation for these primops in the following backends: - X86, AArch64 and PowerPC NCG, - LLVM - C WASM uses the C implementation. The primops are unsupported in the JavaScript backend. The following constant folding rules are also provided: - compute a * b + c when a, b, c are all literals, - x * y + 0 ==> x * y, - ±1 * y + z ==> z ± y and x * ±1 + z ==> z ± x. NB: the constant folding rules incorrectly handle signed zero. This is a known limitation with GHC's floating-point constant folding rules (#21227), which we hope to resolve in the future. - - - - - ad16a066 by Krzysztof Gogolewski at 2023-05-11T11:55:59-04:00 Add a test for #21278 - - - - - 05cea68c by Matthew Pickering at 2023-05-11T11:56:36-04:00 rts: Refine memory retention behaviour to account for pinned/compacted objects When using the copying collector there is still a lot of data which isn't copied (such as pinned, compacted, large objects etc). The logic to decide how much memory to retain didn't take into account that these wouldn't be copied. Therefore we pessimistically retained 2* the amount of memory for these blocks even though they wouldn't be copied by the collector. The solution is to split up the heap into two parts, the parts which will be copied and the parts which won't be copied. Then the appropiate factor is applied to each part individually (2 * for copying and 1.2 * for not copying). The T23221 test demonstrates this improvement with a program which first allocates many unpinned ByteArray# followed by many pinned ByteArray# and observes the difference in the ultimate memory baseline between the two. There are some charts on #23221. Fixes #23221 - - - - - 1bb24432 by Cheng Shao at 2023-05-11T11:57:15-04:00 hadrian: fix no_dynamic_libs flavour transformer This patch fixes the no_dynamic_libs flavour transformer and make fully_static reuse it. Previously building with no_dynamic_libs fails since ghc program is still dynamic and transitively brings in dyn ways of rts which are produced by no rules. - - - - - 0ed493a3 by Josh Meredith at 2023-05-11T23:08:27-04:00 JS: refactor jsSaturate to return a saturated JStat (#23328) - - - - - a856d98e by Pierre Le Marre at 2023-05-11T23:09:08-04:00 Doc: Fix out-of-sync using-optimisation page - Make explicit that default flag values correspond to their -O0 value. - Fix -fignore-interface-pragmas, -fstg-cse, -fdo-eta-reduction, -fcross-module-specialise, -fsolve-constant-dicts, -fworker-wrapper. - - - - - c176ad18 by sheaf at 2023-05-12T06:10:57-04:00 Don't panic in mkNewTyConRhs This function could come across invalid newtype constructors, as we only perform validity checking of newtypes once we are outside the knot-tied typechecking loop. This patch changes this function to fake up a stub type in the case of an invalid newtype, instead of panicking. This patch also changes "checkNewDataCon" so that it reports as many errors as possible at once. Fixes #23308 - - - - - ab63daac by Krzysztof Gogolewski at 2023-05-12T06:11:38-04:00 Allow Core optimizations when interpreting bytecode Tracking ticket: #23056 MR: !10399 This adds the flag `-funoptimized-core-for-interpreter`, permitting use of the `-O` flag to enable optimizations when compiling with the interpreter backend, like in ghci. - - - - - c6cf9433 by Ben Gamari at 2023-05-12T06:12:14-04:00 hadrian: Fix mention of non-existent removeFiles function Previously Hadrian's bindist Makefile referred to a `removeFiles` function that was previously defined by the `make` build system. Since the `make` build system is no longer around, this function is now undefined. Naturally, make being make, this appears to be silently ignored instead of producing an error. Fix this by rewriting it to `rm -f`. Closes #23373. - - - - - eb60ec18 by Bodigrim at 2023-05-12T06:12:54-04:00 Mention new implementation of GHC.IORef.atomicSwapIORef in the changelog - - - - - aa84cff4 by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Ensure non-moving gc is not running when pausing - - - - - 5ad776ab by Teo Camarasu at 2023-05-12T19:27:23-04:00 rts: Teach listAllBlocks about nonmoving heap List all blocks on the non-moving heap. Resolves #22627 - - - - - d683b2e5 by Krzysztof Gogolewski at 2023-05-12T19:28:00-04:00 Fix coercion optimisation for SelCo (#23362) setNominalRole_maybe is supposed to output a nominal coercion. In the SelCo case, it was not updating the stored role to Nominal, causing #23362. - - - - - 59aa4676 by Alexis King at 2023-05-12T19:28:47-04:00 hadrian: Fix linker script flag for MergeObjects builder This fixes what appears to have been a typo in !9530. The `-t` flag just enables tracing on all versions of `ld` I’ve looked at, while `-T` is used to specify a linker script. It seems that this worked anyway for some reason on some `ld` implementations (perhaps because they automatically detect linker scripts), but the missing `-T` argument causes `gold` to complain. - - - - - 4bf9fa0f by Adam Gundry at 2023-05-12T23:49:49-04:00 Less coercion optimization for non-newtype axioms See Note [Push transitivity inside newtype axioms only] for an explanation of the change here. This change substantially improves the performance of coercion optimization for programs involving transitive type family reductions. ------------------------- Metric Decrease: CoOpt_Singletons LargeRecord T12227 T12545 T13386 T15703 T5030 T8095 ------------------------- - - - - - dc0c9574 by Adam Gundry at 2023-05-12T23:49:49-04:00 Move checkAxInstCo to GHC.Core.Lint A consequence of the previous change is that checkAxInstCo is no longer called during coercion optimization, so it can be moved back where it belongs. Also includes some edits to Note [Conflict checking with AxiomInstCo] as suggested by @simonpj. - - - - - 8b9b7dbc by Simon Peyton Jones at 2023-05-12T23:50:25-04:00 Use the eager unifier in the constraint solver This patch continues the refactoring of the constraint solver described in #23070. The Big Deal in this patch is to call the regular, eager unifier from the constraint solver, when we want to create new equalities. This replaces the existing, unifyWanted which amounted to yet-another-unifier, so it reduces duplication of a rather subtle piece of technology. See * Note [The eager unifier] in GHC.Tc.Utils.Unify * GHC.Tc.Solver.Monad.wrapUnifierTcS I did lots of other refactoring along the way * I simplified the treatment of right hand sides that contain CoercionHoles. Now, a constraint that contains a hetero-kind CoercionHole is non-canonical, and cannot be used for rewriting or unification alike. This required me to add the ch_hertero_kind flag to CoercionHole, with consequent knock-on effects. See wrinkle (2) of `Note [Equalities with incompatible kinds]` in GHC.Tc.Solver.Equality. * I refactored the StopOrContinue type to add StartAgain, so that after a fundep improvement (for example) we can simply start the pipeline again. * I got rid of the unpleasant (and inefficient) rewriterSetFromType/Co functions. With Richard I concluded that they are never needed. * I discovered Wrinkle (W1) in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint, and therefore now prioritise non-rewritten equalities. Quite a few error messages change, I think always for the better. Compiler runtime stays about the same, with one outlier: a 17% improvement in T17836 Metric Decrease: T17836 T18223 - - - - - 5cad28e7 by Bartłomiej Cieślar at 2023-05-12T23:51:06-04:00 Cleanup of dynflags override in export renaming The deprecation warnings are normally emitted whenever the name's GRE is being looked up, which calls the GHC.Rename.Env.addUsedGRE function. We do not want those warnings to be emitted when renaming export lists, so they are artificially turned off by removing all warning categories from DynFlags at the beginning of GHC.Tc.Gen.Export.rnExports. This commit removes that dependency by unifying the function used for GRE lookup in lookup_ie to lookupGreAvailRn and disabling the call to addUsedGRE in said function (the warnings are also disabled in a call to lookupSubBndrOcc_helper in lookupChildrenExport), as per #17957. This commit also changes the setting for whether to warn about deprecated names in addUsedGREs to be an explicit enum instead of a boolean. - - - - - d85ed900 by Alexis King at 2023-05-13T08:45:18-04:00 Use a uniform return convention in bytecode for unary results fixes #22958 - - - - - 8a0d45f7 by Bodigrim at 2023-05-13T08:45:58-04:00 Add more instances for Compose: Enum, Bounded, Num, Real, Integral See https://github.com/haskell/core-libraries-committee/issues/160 for discussion - - - - - 902f0730 by Simon Peyton Jones at 2023-05-13T14:58:34-04:00 Make GHC.Types.Id.Make.shouldUnpackTy a bit more clever As #23307, GHC.Types.Id.Make.shouldUnpackTy was leaving money on the table, failing to unpack arguments that are perfectly unpackable. The fix is pretty easy; see Note [Recursive unboxing] - - - - - a5451438 by sheaf at 2023-05-13T14:59:13-04:00 Fix bad multiplicity role in tyConAppFunCo_maybe The function tyConAppFunCo_maybe produces a multiplicity coercion for the multiplicity argument of the function arrow, except that it could be at the wrong role if asked to produce a representational coercion. We fix this by using the 'funRole' function, which computes the right roles for arguments to the function arrow TyCon. Fixes #23386 - - - - - 5b9e9300 by sheaf at 2023-05-15T11:26:59-04:00 Turn "ambiguous import" error into a panic This error should never occur, as a lookup of a type or data constructor should never be ambiguous. This is because a single module cannot export multiple Names with the same OccName, as per item (1) of Note [Exporting duplicate declarations] in GHC.Tc.Gen.Export. This code path was intended to handle duplicate record fields, but the rest of the code had since been refactored to handle those in a different way. We also remove the AmbiguousImport constructor of IELookupError, as it is no longer used. Fixes #23302 - - - - - e305e60c by M Farkas-Dyck at 2023-05-15T11:27:41-04:00 Unbreak some tests with latest GNU grep, which now warns about stray '\'. Confusingly, the testsuite mangled the error to say "stray /". We also migrate some tests from grep to grep -E, as it seems the author actually wanted an "POSIX extended" (a.k.a. sane) regex. Background: POSIX specifies 2 "regex" syntaxen: "basic" and "extended". Of these, only "extended" syntax is actually a regular expression. Furthermore, "basic" syntax is inconsistent in its use of the '\' character — sometimes it escapes a regex metacharacter, but sometimes it unescapes it, i.e. it makes an otherwise normal character become a metacharacter. This baffles me and it seems also the authors of these tests. Also, the regex(7) man page (at least on Linux) says "basic" syntax is obsolete. Nearly all modern tools and libraries are consistent in this use of the '\' character (of which many use "extended" syntax by default). - - - - - 5ae81842 by sheaf at 2023-05-15T14:49:17-04:00 Improve "ambiguous occurrence" error messages This error was sometimes a bit confusing, especially when data families were involved. This commit improves the general presentation of the "ambiguous occurrence" error, and adds a bit of extra context in the case of data families. Fixes #23301 - - - - - 2f571afe by Sylvain Henry at 2023-05-15T14:50:07-04:00 Fix GHCJS OS platform (fix #23346) - - - - - 86aae570 by Oleg Grenrus at 2023-05-15T14:50:43-04:00 Split DynFlags structure into own module This will allow to make command line parsing to depend on diagnostic system (which depends on dynflags) - - - - - fbe3fe00 by Josh Meredith at 2023-05-15T18:01:43-04:00 Replace the implementation of CodeBuffers with unboxed types - - - - - 21f3aae7 by Josh Meredith at 2023-05-15T18:01:43-04:00 Use unboxed codebuffers in base Metric Decrease: encodingAllocations - - - - - 18ea2295 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Weak pointer cleanups Various stylistic cleanups. No functional changes. - - - - - c343112f by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't force debug output to stderr Previously `+RTS -Dw -l` would emit debug output to the eventlog while `+RTS -l -Dw` would emit it to stderr. This was because the parser for `-D` would unconditionally override the debug output target. Now we instead only do so if no it is currently `TRACE_NONE`. - - - - - a5f5f067 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Forcibly flush eventlog on barf Previously we would attempt to flush via `endEventLogging` which can easily deadlock, e.g., if `barf` fails during GC. Using `flushEventLog` directly may result in slightly less consistent eventlog output (since we don't take all capabilities before flushing) but avoids deadlocking. - - - - - 73b1e87c by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Assert that pointers aren't cleared by -DZ This turns many segmentation faults into much easier-to-debug assertion failures by ensuring that LOOKS_LIKE_*_PTR checks recognize bit-patterns produced by `+RTS -DZ` clearing as invalid pointers. This is a bit ad-hoc but this is the debug runtime. - - - - - 37fb61d8 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Introduce printGlobalThreads - - - - - 451d65a6 by Ben Gamari at 2023-05-15T18:02:20-04:00 rts: Don't sanity-check StgTSO.global_link See Note [Avoid dangling global_link pointers]. Fixes #19146. - - - - - d69cbd78 by sheaf at 2023-05-15T18:03:00-04:00 Split up tyThingToIfaceDecl from GHC.Iface.Make This commit moves tyThingToIfaceDecl and coAxiomToIfaceDecl from GHC.Iface.Make into GHC.Iface.Decl. This avoids GHC.Types.TyThing.Ppr, which needs tyThingToIfaceDecl, transitively depending on e.g. GHC.Iface.Load and GHC.Tc.Utils.Monad. - - - - - 4d29ecdf by sheaf at 2023-05-15T18:03:00-04:00 Migrate errors to diagnostics in GHC.Tc.Module This commit migrates the errors in GHC.Tc.Module to use the new diagnostic infrastructure. It required a significant overhaul of the compatibility checks between an hs-boot or signature module and its implementation; we now use a Writer monad to accumulate errors; see the BootMismatch datatype in GHC.Tc.Errors.Types, with its panoply of subtypes. For the sake of readability, several local functions inside the 'checkBootTyCon' function were split off into top-level functions. We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file" datatype, as this mirrors the logic in several other places where we want to treat hs-boot and hsig files in a similar fashion. This commit also refactors the Backpack checks for type synonyms implementing abstract data, to correctly reject implementations that contain qualified or quantified types (this fixes #23342 and #23344). - - - - - d986c98e by Rodrigo Mesquita at 2023-05-16T00:14:04-04:00 configure: Drop unused AC_PROG_CPP In configure, we were calling `AC_PROG_CPP` but never making use of the $CPP variable it sets or reads. The issue is $CPP will show up in the --help output of configure, falsely advertising a configuration option that does nothing. The reason we don't use the $CPP variable is because HS_CPP_CMD is expected to be a single command (without flags), but AC_PROG_CPP, when CPP is unset, will set said variable to something like `/usr/bin/gcc -E`. Instead, we configure HS_CPP_CMD through $CC. - - - - - a8f0435f by Cheng Shao at 2023-05-16T00:14:42-04:00 rts: fix --disable-large-address-space This patch moves ACQUIRE_ALLOC_BLOCK_SPIN_LOCK/RELEASE_ALLOC_BLOCK_SPIN_LOCK from Storage.h to HeapAlloc.h. When --disable-large-address-space is passed to configure, the code in HeapAlloc.h makes use of these two macros. Fixes #23385. - - - - - bdb93cd2 by Oleg Grenrus at 2023-05-16T07:59:21+03:00 Add -Wmissing-role-annotations Implements #22702 - - - - - 41ecfc34 by Ben Gamari at 2023-05-16T07:28:15-04:00 base: Export {get,set}ExceptionFinalizer from System.Mem.Weak As proposed in CLC Proposal #126 [1]. [1]: https://github.com/haskell/core-libraries-committee/issues/126 - - - - - 67330303 by Ben Gamari at 2023-05-16T07:28:16-04:00 base: Introduce printToHandleFinalizerExceptionHandler - - - - - 5e3f9bb5 by Josh Meredith at 2023-05-16T13:59:22-04:00 JS: Implement h$clock_gettime in the JavaScript RTS (#23360) - - - - - 90e69d5d by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for SourceText SourceText is serialized along with INLINE pragmas into interface files. Many of these SourceTexts are identical, for example "{-# INLINE#". When deserialized, each such SourceText was previously expanded out into a [Char], which is highly wasteful of memory, and each such instance of the text would allocate an independent list with its contents as deserializing breaks any sharing that might have existed. Instead, we use a `FastString` to represent these, so that each instance unique text will be interned and stored in a memory efficient manner. - - - - - b70bc690 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation/FastStrings for `SourceNote`s `SourceNote`s should not be stored as [Char] as this is highly wasteful and in certain scenarios can be highly duplicated. Metric Decrease: hard_hole_fits - - - - - 6231a126 by Zubin Duggal at 2023-05-16T14:00:00-04:00 compiler: Use compact representation for UsageFile (#22744) Use FastString to store filepaths in interface files, as this data is highly redundant so we want to share all instances of filepaths in the compiler session. - - - - - 47a58150 by Zubin Duggal at 2023-05-16T14:00:00-04:00 testsuite: add test for T22744 This test checks for #22744 by compiling 100 modules which each have a dependency on 1000 distinct external files. Previously, when loading these interfaces from disk, each individual instance of a filepath in the interface will would be allocated as an individual object on the heap, meaning we have heap objects for 100*1000 files, when there are only 1000 distinct files we care about. This test checks this by first compiling the module normally, then measuring the peak memory usage in a no-op recompile, as the recompilation checking will force the allocation of all these filepaths. - - - - - 0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00 users guide: Add glossary Currently this merely explains the meaning of "technology preview" in the context of released features. - - - - - 0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00 Update glossary.rst - - - - - 3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00 Use glossary directive - - - - - 2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00 JS: fix getpid (fix #23399) - - - - - 5fe1d3e6 by Matthew Pickering at 2023-05-17T21:42:00-04:00 Use setSrcSpan rather than setLclEnv in solveForAll In subsequent MRs (#23409) we want to remove the TcLclEnv argument from a CtLoc. This MR prepares us for that by removing the one place where the entire TcLclEnv is used, by using it more precisely to just set the contexts source location. Fixes #23390 - - - - - 385edb65 by Torsten Schmits at 2023-05-17T21:42:40-04:00 Update the users guide paragraph on -O in GHCi In relation to #23056 - - - - - 87626ef0 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Add test for #13660 - - - - - 9eef53b1 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Move implementation of GHC.Foreign to GHC.Internal - - - - - 174ea2fa by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Introduce {new,with}CStringLen0 These are useful helpers for implementing the internal-NUL code unit check needed to fix #13660. - - - - - a46ced16 by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Clean up documentation - - - - - b98d99cc by Ben Gamari at 2023-05-18T15:18:53-04:00 base: Ensure that FilePaths don't contain NULs POSIX filepaths may not contain the NUL octet but previously we did not reject such paths. This could be exploited by untrusted input to cause discrepancies between various `FilePath` queries and the opened filename. For instance, `readFile "hello.so\x00.txt"` would open the file `"hello.so"` yet `takeFileExtension` would return `".txt"`. The same argument applies to Windows FilePaths Fixes #13660. - - - - - 7ae45459 by Simon Peyton Jones at 2023-05-18T15:19:29-04:00 Allow the demand analyser to unpack tuple and equality dictionaries Addresses #23398. The demand analyser usually does not unpack class dictionaries: see Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal. This patch makes an exception for tuple dictionaries and equality dictionaries, for reasons explained in wrinkles (DNB1) and (DNB2) of the above Note. Compile times fall by 0.1% for some reason (max 0.7% on T18698b). - - - - - b53a9086 by Greg Steuck at 2023-05-18T15:20:08-04:00 Use a simpler and more portable construct in ld.ldd check printf '%q\n' is a bash extension which led to incorrectly failing an ld.lld test on OpenBSD which uses pdksh as /bin/sh - - - - - dd5710af by Torsten Schmits at 2023-05-18T15:20:50-04:00 Update the warning about interpreter optimizations to reflect that they're not incompatible anymore, but guarded by a flag - - - - - 4f6dd999 by Matthew Pickering at 2023-05-18T15:21:26-04:00 Remove stray dump flags in GHC.Rename.Names - - - - - 4bca0486 by Oleg Grenrus at 2023-05-19T11:51:33+03:00 Make Warn = Located DriverMessage This change makes command line argument parsing use diagnostic framework for producing warnings. - - - - - 525ed554 by Simon Peyton Jones at 2023-05-19T10:09:15-04:00 Type inference for data family newtype instances This patch addresses #23408, a tricky case with data family newtype instances. Consider type family TF a where TF Char = Bool data family DF a newtype instance DF Bool = MkDF Int and [W] Int ~R# DF (TF a), with a Given (a ~# Char). We must fully rewrite the Wanted so the tpye family can fire; that wasn't happening. - - - - - c6fb6690 by Peter Trommler at 2023-05-20T03:16:08-04:00 testsuite: fix predicate on rdynamic test Test rdynamic requires dynamic linking support, which is orthogonal to RTS linker support. Change the predicate accordingly. Fixes #23316 - - - - - 735d504e by Matthew Pickering at 2023-05-20T03:16:44-04:00 docs: Use ghc-ticket directive where appropiate in users guide Using the directive automatically formats and links the ticket appropiately. - - - - - b56d7379 by Sylvain Henry at 2023-05-22T14:21:22-04:00 NCG: remove useless .align directive (#20758) - - - - - 15b93d2f by Simon Peyton Jones at 2023-05-22T14:21:58-04:00 Add test for #23156 This program had exponential typechecking time in GHC 9.4 and 9.6 - - - - - 2b53f206 by Greg Steuck at 2023-05-22T20:23:11-04:00 Revert "Change hostSupportsRPaths to report False on OpenBSD" This reverts commit 1e0d8fdb55a38ece34fa6cf214e1d2d46f5f5bf2. - - - - - 882e43b7 by Greg Steuck at 2023-05-22T20:23:11-04:00 Disable T17414 on OpenBSD Like on other systems it's not guaranteed that there's sufficient space in /tmp to write 2G out. - - - - - 9d531f9a by Greg Steuck at 2023-05-22T20:23:11-04:00 Bring back getExecutablePath to getBaseDir on OpenBSD Fix #18173 - - - - - 9db0eadd by Krzysztof Gogolewski at 2023-05-22T20:23:47-04:00 Add an error origin for impedance matching (#23427) - - - - - 33cf4659 by Ben Gamari at 2023-05-23T03:46:20-04:00 testsuite: Add tests for #23146 Both lifted and unlifted variants. - - - - - 76727617 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Fix some Haddocks - - - - - 33a8c348 by Ben Gamari at 2023-05-23T03:46:21-04:00 codeGen: Give proper LFInfo to datacon wrappers As noted in `Note [Conveying CAF-info and LFInfo between modules]`, when importing a binding from another module we must ensure that it gets the appropriate `LambdaFormInfo` if it is in WHNF to ensure that references to it are tagged correctly. However, the implementation responsible for doing this, `GHC.StgToCmm.Closure.mkLFImported`, only dealt with datacon workers and not wrappers. This lead to the crash of this program in #23146: module B where type NP :: [UnliftedType] -> UnliftedType data NP xs where UNil :: NP '[] module A where import B fieldsSam :: NP xs -> NP xs -> Bool fieldsSam UNil UNil = True x = fieldsSam UNil UNil Due to its GADT nature, `UNil` produces a trivial wrapper $WUNil :: NP '[] $WUNil = UNil @'[] @~(<co:1>) which is referenced in the RHS of `A.x`. Due to the above-mentioned bug in `mkLFImported`, the references to `$WUNil` passed to `fieldsSam` were not tagged. This is problematic as `fieldsSam` expected its arguments to be tagged as they are unlifted. The fix is straightforward: extend the logic in `mkLFImported` to cover (nullary) datacon wrappers as well as workers. This is safe because we know that the wrapper of a nullary datacon will be in WHNF, even if it includes equalities evidence (since such equalities are not runtime relevant). Thanks to @MangoIV for the great ticket and @alt-romes for his minimization and help debugging. Fixes #23146. - - - - - 2fc18e9e by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 codeGen: Fix LFInfo of imported datacon wrappers As noted in #23231 and in the previous commit, we were failing to give a an LFInfo of LFCon to a nullary datacon wrapper from another module, failing to properly tag pointers which ultimately led to the segmentation fault in #23146. On top of the previous commit which now considers wrappers where we previously only considered workers, we change the order of the guards so that we check for the arity of the binding before we check whether it is a constructor. This allows us to (1) Correctly assign `LFReEntrant` to imported wrappers whose worker was nullary, which we previously would fail to do (2) Remove the `isNullaryRepDataCon` predicate: (a) which was previously wrong, since it considered wrappers whose workers had zero-width arguments to be non-nullary and would fail to give `LFCon` to them (b) is now unnecessary, since arity == 0 guarantees - that the worker takes no arguments at all - and the wrapper takes no arguments and its RHS must be an application of the worker to zero-width-args only. - we lint these two items with an assertion that the datacon `hasNoNonZeroWidthArgs` We also update `isTagged` to use the new logic in determining the LFInfos of imported Ids. The creation of LFInfos for imported Ids and this detail are explained in Note [The LFInfo of Imported Ids]. Note that before the patch to those issues we would already consider these nullary wrappers to have `LFCon` lambda form info; but failed to re-construct that information in `mkLFImported` Closes #23231, #23146 (I've additionally batched some fixes to documentation I found while investigating this issue) - - - - - 0598f7f0 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Make LFInfos for DataCons on construction As a result of the discussion in !10165, we decided to amend the previous commit which fixed the logic of `mkLFImported` with regard to datacon workers and wrappers. Instead of having the logic for the LFInfo of datacons be in `mkLFImported`, we now construct an LFInfo for all data constructors on GHC.Types.Id.Make and store it in the `lfInfo` field. See the new Note [LFInfo of DataCon workers and wrappers] and ammendments to Note [The LFInfo of Imported Ids] - - - - - 12294b22 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Update Note [Core letrec invariant] Authored by @simonpj - - - - - e93ab972 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Rename mkLFImported to importedIdLFInfo The `mkLFImported` sounded too much like a constructor of sorts, when really it got the `LFInfo` of an imported Id from its `lf_info` field when this existed, and otherwise returned a conservative estimate of that imported Id's LFInfo. This in contrast to functions such as `mkLFReEntrant` which really are about constructing an `LFInfo`. - - - - - e54d9259 by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Enforce invariant on typePrimRepArgs in the types As part of the documentation effort in !10165 I came across this invariant on 'typePrimRepArgs' which is easily expressed at the type-level through a NonEmpty list. It allowed us to remove one panic. - - - - - b8fe6a0c by Rodrigo Mesquita at 2023-05-23T03:46:21-04:00 Merge outdated Note [Data con representation] into Note [Data constructor representation] Introduce new Note [Constructor applications in STG] to better support the merge, and reference it from the relevant bits in the STG syntax. - - - - - e1590ddc by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Add the SolverStage monad This refactoring makes a substantial improvement in the structure of the type-checker's constraint solver: #23070. Specifically: * Introduced the SolverStage monad. See GHC.Tc.Solver.Monad Note [The SolverStage monad] * Make each solver pipeline (equalities, dictionaries, irreds etc) deal with updating the inert set, as a separate SolverStage. There is sometimes special stuff to do, and it means that each full pipeline can have type SolverStage Void, indicating that they never return anything. * Made GHC.Tc.Solver.Equality.zonkEqTypes into a SolverStage. Much nicer. * Combined the remnants of GHC.Tc.Solver.Canonical and GHC.Tc.Solver.Interact into a new module GHC.Tc.Solver.Solve. (Interact and Canonical are removed.) * Gave the same treatment to dictionary and irred constraints as I have already done for equality constraints: * New types (akin to EqCt): IrredCt and DictCt * Ct is now just a simple sum type data Ct = CDictCan DictCt | CIrredCan IrredCt | CEqCan EqCt | CQuantCan QCInst | CNonCanonical CtEvidence * inert_dicts can now have the better type DictMap DictCt, instead of DictMap Ct; and similarly inert_irreds. * Significantly simplified the treatment of implicit parameters. Previously we had a number of special cases * interactGivenIP, an entire function * special case in maybeKickOut * special case in findDict, when looking up dictionaries But actually it's simpler than that. When adding a new Given, implicit parameter constraint to the InertSet, we just need to kick out any existing inert constraints that mention that implicit parameter. The main work is done in GHC.Tc.Solver.InertSet.delIPDict, along with its auxiliary GHC.Core.Predicate.mentionsIP. See Note [Shadowing of implicit parameters] in GHC.Tc.Solver.Dict. * Add a new fast-path in GHC.Tc.Errors.Hole.tcCheckHoleFit. See Note [Fast path for tcCheckHoleFit]. This is a big win in some cases: test hard_hole_fits gets nearly 40% faster (at compile time). * Add a new fast-path for solving /boxed/ equality constraints (t1 ~ t2). See Note [Solving equality classes] in GHC.Tc.Solver.Dict. This makes a big difference too: test T17836 compiles 40% faster. * Implement the PermissivePlan of #23413, which concerns what happens with insoluble Givens. Our previous treatment was wildly inconsistent as that ticket pointed out. A part of this, I simplified GHC.Tc.Validity.checkAmbiguity: now we simply don't run the ambiguity check at all if -XAllowAmbiguousTypes is on. Smaller points: * In `GHC.Tc.Errors.misMatchOrCND` instead of having a special case for insoluble /occurs/ checks, broaden in to all insouluble constraints. Just generally better. See Note [Insoluble mis-match] in that module. As noted above, compile time perf gets better. Here are the changes over 0.5% on Fedora. (The figures are slightly larger on Windows for some reason.) Metrics: compile_time/bytes allocated ------------------------------------- LargeRecord(normal) -0.9% MultiLayerModulesTH_OneShot(normal) +0.5% T11822(normal) -0.6% T12227(normal) -1.8% GOOD T12545(normal) -0.5% T13035(normal) -0.6% T15703(normal) -1.4% GOOD T16875(normal) -0.5% T17836(normal) -40.7% GOOD T17836b(normal) -12.3% GOOD T17977b(normal) -0.5% T5837(normal) -1.1% T8095(normal) -2.7% GOOD T9020(optasm) -1.1% hard_hole_fits(normal) -37.0% GOOD geo. mean -1.3% minimum -40.7% maximum +0.5% Metric Decrease: T12227 T15703 T17836 T17836b T8095 hard_hole_fits LargeRecord T9198 T13035 - - - - - 6abf3648 by Simon Peyton Jones at 2023-05-23T03:46:57-04:00 Avoid an assertion failure in abstractFloats The function GHC.Core.Opt.Simplify.Utils.abstractFloats was carelessly calling lookupIdSubst_maybe on a CoVar; but a precondition of the latter is being given an Id. In fact it's harmless to call it on a CoVar, but still, the precondition on lookupIdSubst_maybe makes sense, so I added a test for CoVars. This avoids a crash in a DEBUG compiler, but otherwise has no effect. Fixes #23426. - - - - - 838aaf4b by hainq at 2023-05-24T12:41:19-04:00 Migrate errors in GHC.Tc.Validity This patch migrates the error messages in GHC.Tc.Validity to use the new diagnostic infrastructure. It adds the constructors: - TcRnSimplifiableConstraint - TcRnArityMismatch - TcRnIllegalInstanceDecl, with sub-datatypes for HasField errors and fundep coverage condition errors. - - - - - 8539764b by Krzysztof Gogolewski at 2023-05-24T12:41:56-04:00 linear lint: Add missing processing of DEFAULT In this correct program f :: a %1 -> a f x = case x of x { _DEFAULT -> x } after checking the alternative we weren't popping the case binder 'x' from the usage environment, which meant that the lambda-bound 'x' was counted twice: in the scrutinee and (incorrectly) in the alternative. In fact, we weren't checking the usage of 'x' at all. Now the code for handling _DEFAULT is similar to the one handling data constructors. Fixes #23025. - - - - - ae683454 by Matthew Pickering at 2023-05-24T12:42:32-04:00 Remove outdated "Don't check hs-boot type family instances too early" note This note was introduced in 25b70a29f623 which delayed performing some consistency checks for type families. However, the change was reverted later in 6998772043a7f0b0360116eb5ffcbaa5630b21fb but the note was not removed. I found it confusing when reading to code to try and work out what special behaviour there was for hs-boot files (when in-fact there isn't any). - - - - - 44af57de by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: Define ticky macro stubs These macros have long been undefined which has meant we were missing reporting these allocations in ticky profiles. The most critical missing definition was TICK_ALLOC_HEAP_NOCTR which was missing all the RTS calls to allocate, this leads to a the overall ALLOC_RTS_tot number to be severaly underreported. Of particular interest though is the ALLOC_STACK_ctr and ALLOC_STACK_tot counters which are useful to tracking stack allocations. Fixes #23421 - - - - - b2dabe3a by Matthew Pickering at 2023-05-24T12:43:08-04:00 rts: ticky: Rename TICK_ALLOC_HEAP_NOCTR to TICK_ALLOC_RTS This macro increments the ALLOC_HEAP_tot and ALLOC_HEAP_ctr so it makes more sense to name it after that rather than the suffix NOCTR, whose meaning has been lost to the mists of time. - - - - - eac4420a by Ben Gamari at 2023-05-24T12:43:45-04:00 users guide: A few small mark-up fixes - - - - - a320ca76 by Rodrigo Mesquita at 2023-05-24T12:44:20-04:00 configure: Fix support check for response files. In failing to escape the '-o' in '-o\nconftest\nconftest.o\n' argument to printf, the writing of the arguments response file always failed. The fix is to pass the arguments after `--` so that they are treated positional arguments rather than flags to printf. Closes #23435 - - - - - f21ce0e4 by mangoiv at 2023-05-24T12:45:00-04:00 [feat] add .direnv to the .gitignore file - - - - - 36d5944d by Bodigrim at 2023-05-24T20:58:34-04:00 Add Data.List.unsnoc See https://github.com/haskell/core-libraries-committee/issues/165 for discussion - - - - - c0f2f9e3 by Bartłomiej Cieślar at 2023-05-24T20:59:14-04:00 Fix crash in backpack signature merging with -ddump-rn-trace In some cases, backpack signature merging could crash in addUsedGRE when -ddump-rn-trace was enabled, as pretty-printing the GREInfo would cause unavailable interfaces to be loaded. This commit fixes that issue by not pretty-printing the GREInfo in addUsedGRE when -ddump-rn-trace is enabled. Fixes #23424 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - 5a07d94a by Krzysztof Gogolewski at 2023-05-25T03:30:20-04:00 Add a regression test for #13981 The panic was fixed by 6998772043a7f0b. Fixes #13981. - - - - - 182df90e by Krzysztof Gogolewski at 2023-05-25T03:30:57-04:00 Add a test for #23355 It was fixed by !10061, so I'm adding it in the same group. - - - - - 1b31b039 by uhbif19 at 2023-05-25T12:08:28+02:00 Migrate errors in GHC.Rename.Splice GHC.Rename.Pat This commit migrates the errors in GHC.Rename.Splice and GHC.Rename.Pat to use the new diagnostic infrastructure. - - - - - 56abe494 by sheaf at 2023-05-25T12:09:55+02:00 Common up Template Haskell errors in TcRnMessage This commit commons up the various Template Haskell errors into a single constructor, TcRnTHError, of TcRnMessage. - - - - - a487ba9e by Krzysztof Gogolewski at 2023-05-25T14:35:56-04:00 Enable ghci tests for unboxed tuples The tests were originally skipped because ghci used not to support unboxed tuples/sums. - - - - - dc3422d4 by Matthew Pickering at 2023-05-25T18:57:19-04:00 rts: Build ticky GHC with single-threaded RTS The threaded RTS allows you to use ticky profiling but only for the counters in the generated code. The counters used in the C portion of the RTS are disabled. Updating the counters is also racy using the threaded RTS which can lead to misleading or incorrect ticky results. Therefore we change the hadrian flavour to build using the single-threaded RTS (mainly in order to get accurate C code counter increments) Fixes #23430 - - - - - fbc8e04e by sheaf at 2023-05-25T18:58:00-04:00 Propagate long-distance info in generated code When desugaring generated pattern matches, we skip pattern match checks. However, this ended up also discarding long-distance information, which might be needed for user-written sub-expressions. Example: ```haskell okay (GADT di) cd = let sr_field :: () sr_field = case getFooBar di of { Foo -> () } in case cd of { SomeRec _ -> SomeRec sr_field } ``` With sr_field a generated FunBind, we still want to propagate the outer long-distance information from the GADT pattern match into the checks for the user-written RHS of sr_field. Fixes #23445 - - - - - f8ced241 by Matthew Pickering at 2023-05-26T15:26:21-04:00 Introduce GHCiMessage to wrap GhcMessage By introducing a wrapped message type we can control how certain messages are printed in GHCi (to add extra information for example) - - - - - 58e554c1 by Matthew Pickering at 2023-05-26T15:26:22-04:00 Generalise UnknownDiagnostic to allow embedded diagnostics to access parent diagnostic options. * Split default diagnostic options from Diagnostic class into HasDefaultDiagnosticOpts class. * Generalise UnknownDiagnostic to allow embedded diagnostics to access options. The principle idea here is that when wrapping an error message (such as GHCMessage to make GHCiMessage) then we need to also be able to lift the configuration when overriding how messages are printed (see load' for an example). - - - - - b112546a by Matthew Pickering at 2023-05-26T15:26:22-04:00 Allow API users to wrap error messages created during 'load' This allows API users to configure how messages are rendered when they are emitted from the load function. For an example see how 'loadWithCache' is used in GHCi. - - - - - 2e4cf0ee by Matthew Pickering at 2023-05-26T15:26:22-04:00 Abstract cantFindError and turn Opt_BuildingCabal into a print-time option * cantFindError is abstracted so that the parts which mention specific things about ghc/ghci are parameters. The intention being that GHC/GHCi can specify the right values to put here but otherwise display the same error message. * The BuildingCabalPackage argument from GenericMissing is removed and turned into a print-time option. The reason for the error is not dependent on whether `-fbuilding-cabal-package` is passed, so we don't want to store that in the error message. - - - - - 34b44f7d by Matthew Pickering at 2023-05-26T15:26:22-04:00 error messages: Don't display ghci specific hints for missing packages Tickets like #22884 suggest that it is confusing that GHC used on the command line can suggest options which only work in GHCi. This ticket uses the error message infrastructure to override certain error messages which displayed GHCi specific information so that this information is only showed when using GHCi. The main annoyance is that we mostly want to display errors in the same way as before, but with some additional information. This means that the error rendering code has to be exported from the Iface/Errors/Ppr.hs module. I am unsure about whether the approach taken here is the best or most maintainable solution. Fixes #22884 - - - - - 05a1b626 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't override existing metadata if version already exists. If a nightly pipeline runs twice for some reason for the same version then we really don't want to override an existing entry with new bindists. This could cause ABI compatability issues for users or break ghcup's caching logic. - - - - - fcbcb3cc by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Use proper API url for bindist download Previously we were using links from the web interface, but it's more robust and future-proof to use the documented links to the artifacts. https://docs.gitlab.com/ee/api/job_artifacts.html - - - - - 5b59c8fe by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Set Nightly and LatestNightly tags The latest nightly release needs the LatestNightly tag, and all other nightly releases need the Nightly tag. Therefore when the metadata is updated we need to replace all LatestNightly with Nightly.` - - - - - 914e1468 by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download nightly metadata for correct date The metadata now lives in https://gitlab.haskell.org/ghc/ghcup-metadata with one metadata file per year. When we update the metadata we download and update the right file for the current year. - - - - - 16cf7d2e by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Download metadata and update for correct year something about pipeline date - - - - - 14792c4b by Matthew Pickering at 2023-05-26T15:26:58-04:00 ghcup-metadata: Don't skip CI On a push we now have a CI job which updates gitlab pages with the metadata files. - - - - - 1121bdd8 by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add --date flag to specify the release date The ghcup-metadata now has a viReleaseDay field which needs to be populated with the day of the release. - - - - - bc478bee by Matthew Pickering at 2023-05-26T15:26:59-04:00 ghcup-metadata: Add dlOutput field ghcup now requires us to add this field which specifies where it should download the bindist to. See https://gitlab.haskell.org/ghc/ghcup-metadata/-/issues/1 for some more discussion. - - - - - 2bdbd9da by Josh Meredith at 2023-05-26T15:27:35-04:00 JS: Convert rendering to use HLine instead of SDoc (#22455) - - - - - abd9e37c by Norman Ramsey at 2023-05-26T15:28:12-04:00 testsuite: add WasmControlFlow test This patch adds the WasmControlFlow test to test the wasm backend's relooper component. - - - - - 07f858eb by Sylvain Henry at 2023-05-26T15:28:53-04:00 Factorize getLinkDeps Prepare reuse of getLinkDeps for TH implementation in the JS backend (cf #22261 and review of !9779). - - - - - fad9d092 by Oleg Grenrus at 2023-05-27T13:38:08-04:00 Change GHC.Driver.Session import to .DynFlags Also move targetPlatform selector Plenty of GHC needs just DynFlags. Even more can be made to use .DynFlags if more selectors is migrated. This is a low hanging fruit. - - - - - 69fdbece by Alan Zimmerman at 2023-05-27T13:38:45-04:00 EPA: Better fix for #22919 The original fix for #22919 simply removed the ability to match up prior comments with the first declaration in the file. Restore it, but add a check that the comment is on a single line, by ensuring that it comes immediately prior to the next thing (comment or start of declaration), and that the token preceding it is not on the same line. closes #22919 - - - - - 0350b186 by Josh Meredith at 2023-05-29T12:46:27+00:00 Remove JavaScriptFFI from --supported-extensions for non-JS targets (#11214) - - - - - b4816919 by Matthew Pickering at 2023-05-30T17:07:43-04:00 testsuite: Pass -kb16k -kc128k for performance tests Setting a larger stack chunk size gives a greater protection from stack thrashing (where the repeated overflow/underflow allocates a lot of stack chunks which sigificantly impact allocations). This stabilises some tests against differences cause by more things being pushed onto the stack. The performance tests are generally testing work done by the compiler, using allocation as a proxy, so removing/stabilising the allocations due to the stack gives us more stable tests which are also more sensitive to actual changes in compiler performance. The tests which increase are ones where we compile a lot of modules, and for each module we spawn a thread to compile the module in. Therefore increasing these numbers has a multiplying effect on these tests because there are many more stacks which we can increase in size. The most significant improvements though are cases such as T8095 which reduce significantly in allocations (30%). This isn't a performance improvement really but just helps stabilise the test against this threshold set by the defaults. Fixes #23439 ------------------------- Metric Decrease: InstanceMatching T14683 T8095 T9872b_defer T9872d T9961 hie002 T19695 T3064 Metric Increase: MultiLayerModules T13701 T14697 ------------------------- - - - - - 6629f1c5 by Ben Gamari at 2023-05-30T17:08:20-04:00 Move via-C flags into GHC These were previously hardcoded in configure (with no option for overriding them) and simply passed onto ghc through the settings file. Since configure already guarantees gcc supports those flags, we simply move them into GHC. - - - - - 981e5e11 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Allow CPR on unrestricted constructors Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will allow CPR to handle `Ur`, in particular. - - - - - bf9344d2 by Arnaud Spiwack at 2023-05-31T08:34:33-04:00 Push coercions across multiplicity boundaries Per the new `Note [Linting linearity]`, we want optimisations over trying to preserve linearity. This will avoid preventing inlinings and reductions and make linear programs more efficient. - - - - - d56dd695 by sheaf at 2023-05-31T11:37:12-04:00 Data.Bag: add INLINEABLE to polymorphic functions This commit allows polymorphic methods in GHC.Data.Bag to be specialised, avoiding having to pass explicit dictionaries when they are instantiated with e.g. a known monad. - - - - - 5366cd35 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcBinderStack into its own module This commit splits off TcBinderStack into its own module, to avoid module cycles: we might want to refer to it without also pulling in the TcM monad. - - - - - 09d4d307 by sheaf at 2023-05-31T11:37:12-04:00 Split off TcRef into its own module This helps avoid pull in the full TcM monad when we just want access to mutable references in the typechecker. This facilitates later patches which introduce a slimmed down TcM monad for zonking. - - - - - 88cc19b3 by sheaf at 2023-05-31T11:37:12-04:00 Introduce Codensity monad The Codensity monad is useful to write state-passing computations in continuation-passing style, e.g. to implement a State monad as continuation-passing style over a Reader monad. - - - - - f62d8195 by sheaf at 2023-05-31T11:37:12-04:00 Restructure the zonker This commit splits up the zonker into a few separate components, described in Note [The structure of the zonker] in `GHC.Tc.Zonk.Type`. 1. `GHC.Tc.Zonk.Monad` introduces a pared-down `TcM` monad, `ZonkM`, which has enough information for zonking types. This allows us to refactor `ErrCtxt` to use `ZonkM` instead of `TcM`, which guarantees we don't throw an error while reporting an error. 2. `GHC.Tc.Zonk.Env` is the new home of `ZonkEnv`, and also defines two zonking monad transformers, `ZonkT` and `ZonkBndrT`. `ZonkT` is a reader monad transformer over `ZonkEnv`. `ZonkBndrT m` is the codensity monad over `ZonkT m`. `ZonkBndrT` is used for computations that accumulate binders in the `ZonkEnv`. 3. `GHC.Tc.Zonk.TcType` contains the code for zonking types, for use in the typechecker. It uses the `ZonkM` monad. 4. `GHC.Tc.Zonk.Type` contains the code for final zonking to `Type`, which has been refactored to use `ZonkTcM = ZonkT TcM` and `ZonkBndrTcM = ZonkBndrT TcM`. Allocations slightly decrease on the whole due to using continuation-passing style instead of manual state passing of ZonkEnv in the final zonking to Type. ------------------------- Metric Decrease: T4029 T8095 T14766 T15304 hard_hole_fits RecordUpdPerf Metric Increase: T10421 ------------------------- - - - - - 70526f5b by mimi.vx at 2023-05-31T11:37:53-04:00 Update rdt-theme to latest upstream version Fixes https://gitlab.haskell.org/ghc/ghc/-/issues/23444 - - - - - f3556d6c by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5d1f2411 by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - b7a640ac by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 5aef5658 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 69563c97 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Add note describing IPE data compression See ticket #21766 - - - - - 7872e2b6 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 0e85099b by Finley McIlwaine at 2023-06-01T04:53:12-04: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 - - - - - a0048866 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 09d93bd0 by Finley McIlwaine at 2023-06-01T04:53:12-04: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. - - - - - 3ded9a1c by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Update user's guide and release notes, small fixes 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. Change IpeBufferListNode compression check so only the value `1` indicates compression. See ticket #21766 - - - - - 41b41577 by Finley McIlwaine at 2023-06-01T04:53:12-04:00 Remove IPE enabled builds from CI We don't need to explicitly specify the +ipe transformer to test IPE data since there are tests which manually enable IPE information. This commit does leave zstd IPE data compression enabled on the debian CI jobs. - - - - - 982bef3a by Krzysztof Gogolewski at 2023-06-01T04:53:49-04:00 Fix build with 9.2 GHC.Tc.Zonk.Type uses an equality constraint. ghc.nix currently provides 9.2. - - - - - 1c96bc3d by Krzysztof Gogolewski at 2023-06-01T10:56:11-04:00 Output Lint errors to stderr instead of stdout This is a continuation of 7b095b99, which fixed warnings but not errors. Refs #13342 - - - - - 8e81f140 by sheaf at 2023-06-01T10:56:51-04:00 Refactor lookupExactOrOrig & friends This refactors the panoply of renamer lookup functions relating to lookupExactOrOrig to more graciously handle Exact and Orig names. In particular, we avoid the situation in which we would add Exact/Orig GREs to the tcg_used_gres field, which could cause a panic in bestImport like in #23240. Fixes #23428 - - - - - 5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04:00 Use the one-shot trick for UM and RewriteM functors As described in Note [The one-shot state monad trick], we shouldn't use derived Functor instances for monads using one-shot. This was done for most of them, but UM and RewriteM were missed. - - - - - 2c38551e by Krzysztof Gogolewski at 2023-06-01T10:58:08-04:00 Fix testsuite skipping Lint setTestOpts() is used to modify the test options for an entire .T file, rather than a single test. If there was a test using collect_compiler_stats, all of the tests in the same file had lint disabled. Fixes #21247 - - - - - 00a1e50b by Krzysztof Gogolewski at 2023-06-01T10:58:44-04:00 Add testcases for already fixed #16432 They were fixed by 40c7daed0. Fixes #16432 - - - - - f6e060cc by Krzysztof Gogolewski at 2023-06-02T09:07:25-04:00 cleanup: Remove unused field from SelfBoot It is no longer needed since Note [Extra dependencies from .hs-boot files] was deleted in 6998772043. I've also added tildes to Note headers, otherwise they're not detected by the linter. - - - - - 82eacab6 by sheaf at 2023-06-02T09:08:01-04:00 Delete GHC.Tc.Utils.Zonk This module was split up into GHC.Tc.Zonk.Type and GHC.Tc.Zonk.TcType in commit f62d8195, but I forgot to delete the original module - - - - - 4a4eb761 by Ben Gamari at 2023-06-02T23:53:21-04:00 base: Add build-order import of GHC.Types in GHC.IO.Handle.Types For reasons similar to those described in Note [Depend on GHC.Num.Integer]. Fixes #23411. - - - - - f53ac0ae by Sylvain Henry at 2023-06-02T23:54:01-04:00 JS: fix and enhance non-minimized code generation (#22455) Flag -ddisable-js-minimizer was producing invalid code. Fix that and also a few other things to generate nicer JS code for debugging. The added test checks that we don't regress when using the flag. - - - - - f7744e8e by Andrey Mokhov at 2023-06-03T16:49:44-04:00 [hadrian] Fix multiline synopsis rendering - - - - - b2c745db by Bodigrim at 2023-06-03T16:50:23-04:00 Elaborate on performance properties of Data.List.++ - - - - - 7cd8a61e by Matthew Pickering at 2023-06-05T11:46:23+01:00 Big TcLclEnv and CtLoc refactoring The overall goal of this refactoring is to reduce the dependency footprint of the parser and syntax tree. Good reasons include: - Better module graph parallelisability - Make it easier to migrate error messages without introducing module loops - Philosophically, there's not reason for the AST to depend on half the compiler. One of the key edges which added this dependency was > GHC.Hs.Expr -> GHC.Tc.Types (TcLclEnv) As this in turn depending on TcM which depends on HscEnv and so on. Therefore the goal of this patch is to move `TcLclEnv` out of `GHC.Tc.Types` so that `GHC.Hs.Expr` can import TcLclEnv without incurring a huge dependency chain. The changes in this patch are: * Move TcLclEnv from GHC.Tc.Types to GHC.Tc.Types.LclEnv * Create new smaller modules for the types used in TcLclEnv New Modules: - GHC.Tc.Types.ErrCtxt - GHC.Tc.Types.BasicTypes - GHC.Tc.Types.TH - GHC.Tc.Types.LclEnv - GHC.Tc.Types.CtLocEnv - GHC.Tc.Errors.Types.PromotionErr Removed Boot File: - {-# SOURCE #-} GHC.Tc.Types * Introduce TcLclCtxt, the part of the TcLclEnv which doesn't participate in restoreLclEnv. * Replace TcLclEnv in CtLoc with specific CtLocEnv which is defined in GHC.Tc.Types.CtLocEnv. Use CtLocEnv in Implic and CtLoc to record the location of the implication and constraint. By splitting up TcLclEnv from GHC.Tc.Types we allow GHC.Hs.Expr to no longer depend on the TcM monad and all that entails. Fixes #23389 #23409 - - - - - 3d8d39d1 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Utils.TcType on GHC.Driver.Session This removes the usage of DynFlags from Tc.Utils.TcType so that it no longer depends on GHC.Driver.Session. In general we don't want anything which is a dependency of Language.Haskell.Syntax to depend on GHC.Driver.Session and removing this edge gets us closer to that goal. - - - - - 18db5ada by Matthew Pickering at 2023-06-05T11:46:23+01:00 Move isIrrefutableHsPat to GHC.Rename.Utils and rename to isIrrefutableHsPatRn This removes edge from GHC.Hs.Pat to GHC.Driver.Session, which makes Language.Haskell.Syntax end up depending on GHC.Driver.Session. - - - - - 12919dd5 by Matthew Pickering at 2023-06-05T11:46:23+01:00 Remove dependency of GHC.Tc.Types.Constraint on GHC.Driver.Session - - - - - eb852371 by Matthew Pickering at 2023-06-05T11:46:24+01:00 hole fit plugins: Split definition into own module The hole fit plugins are defined in terms of TcM, a type we want to avoid depending on from `GHC.Tc.Errors.Types`. By moving it into its own module we can remove this dependency. It also simplifies the necessary boot file. - - - - - 9e5246d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Move GHC.Core.Opt.CallerCC Types into separate module This allows `GHC.Driver.DynFlags` to depend on these types without depending on CoreM and hence the entire simplifier pipeline. We can also remove a hs-boot file with this change. - - - - - 52d6a7d7 by Matthew Pickering at 2023-06-05T11:46:24+01:00 Remove unecessary SOURCE import - - - - - 698d160c by Matthew Pickering at 2023-06-05T11:46:24+01:00 testsuite: Accept new output for CountDepsAst and CountDepsParser tests These are in a separate commit as the improvement to these tests is the cumulative effect of the previous set of patches rather than just the responsibility of the last one in the patchset. - - - - - 58ccf02e by sheaf at 2023-06-05T16:00:47-04:00 TTG: only allow VarBind at GhcTc The VarBind constructor of HsBind is only used at the GhcTc stage. This commit makes that explicit by setting the extension field of VarBind to be DataConCantHappen at all other stages. This allows us to delete a dead code path in GHC.HsToCore.Quote.rep_bind, and remove some panics. - - - - - 54b83253 by Matthew Craven at 2023-06-06T12:59:25-04:00 Generate Addr# access ops programmatically The existing utils/genprimopcode/gen_bytearray_ops.py was relocated and extended for this purpose. Additionally, hadrian now knows about this script and uses it when generating primops.txt - - - - - ecadbc7e by Matthew Pickering at 2023-06-06T13:00:01-04:00 ghcup-metadata: Only add Nightly tag when replacing LatestNightly Previously we were always adding the Nightly tag, but this led to all the previous builds getting an increasing number of nightly tags over time. Now we just add it once, when we remove the LatestNightly tag. - - - - - 4aea0a72 by Vladislav Zavialov at 2023-06-07T12:06:46+02: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> - - - - - b7600997 by Josh Meredith at 2023-06-07T13:10:21-04:00 JS: clean up FFI 'fat arrow' calls in base:System.Posix.Internals (#23481) - - - - - e5d3940d by Sebastian Graf at 2023-06-07T18:01:28-04:00 Update CODEOWNERS - - - - - 960ef111 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Remove IPE enabled builds from CI" This reverts commit 41b41577c8a28c236fa37e8f73aa1c6dc368d951. - - - - - bad1c8cc by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Update user's guide and release notes, small fixes" This reverts commit 3ded9a1cd22f9083f31bc2f37ee1b37f9d25dab7. - - - - - 12726d90 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE-enabled builds to CI" This reverts commit 09d93bd0305b0f73422ce7edb67168c71d32c15f. - - - - - dbdd989d by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add optional dependencies to ./configure output" This reverts commit a00488665cd890a26a5564a64ba23ff12c9bec58. - - - - - 240483af by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix IPE data decompression buffer allocation" This reverts commit 0e85099b9316ee24565084d5586bb7290669b43a. - - - - - 9b8c7dd8 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix byte order of IPE data, fix IPE tests" This reverts commit 7872e2b6f08ea40d19a251c4822a384d0b397327. - - - - - 3364379b by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add note describing IPE data compression" This reverts commit 69563c97396b8fde91678fae7d2feafb7ab9a8b0. - - - - - fda30670 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Fix libzstd detection in configure and RTS" This reverts commit 5aef5658ad5fb96bac7719710e0ea008bf7b62e0. - - - - - 1cbcda9a by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "IPE data compression" This reverts commit b7a640acf7adc2880e5600d69bcf2918fee85553. - - - - - fb5e99aa by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Add IPE compression to configure" This reverts commit 5d1f2411f4becea8650d12d168e989241edee186. - - - - - 2cdcb3a5 by Matthew Pickering at 2023-06-07T18:02:04-04:00 Revert "Restructure IPE buffer layout" This reverts commit f3556d6cefd3d923b36bfcda0c8185abb1d11a91. - - - - - 2b0c9f5e by Simon Peyton Jones at 2023-06-08T07:52:34+00:00 Don't report redundant Givens from quantified constraints This fixes #23323 See (RC4) in Note [Tracking redundant constraints] - - - - - 567b32e1 by David Binder at 2023-06-08T18:41:29-04:00 Update the outdated instructions in HACKING.md on how to compile GHC - - - - - 2b1a4abe by Ryan Scott at 2023-06-09T07:56:58-04:00 Restore mingwex dependency on Windows This partially reverts some of the changes in !9475 to make `base` and `ghc-prim` depend on the `mingwex` library on Windows. It also restores the RTS's stubs for `mingwex`-specific symbols such as `_lock_file`. This is done because the C runtime provides `libmingwex` nowadays, and moreoever, not linking against `mingwex` requires downstream users to link against it explicitly in difficult-to-predict circumstances. Better to always link against `mingwex` and prevent users from having to do the guesswork themselves. See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10360#note_495873 for the discussion that led to this. - - - - - 28954758 by Ryan Scott at 2023-06-09T07:56:58-04:00 RtsSymbols.c: Remove mingwex symbol stubs As of !9475, the RTS now links against `ucrt` instead of `msvcrt` on Windows, which means that the RTS no longer needs to declare stubs for the `__mingw_*` family of symbols. Let's remove these stubs to avoid confusion. Fixes #23309. - - - - - 3ab0155b by Ryan Scott at 2023-06-09T07:57:35-04:00 Consistently use validity checks for TH conversion of data constructors We were checking that TH-spliced data declarations do not look like this: ```hs data D :: Type = MkD Int ``` But we were only doing so for `data` declarations' data constructors, not for `newtype`s, `data instance`s, or `newtype instance`s. This patch factors out the necessary validity checks into its own `cvtDataDefnCons` function and uses it in all of the places where it needs to be. Fixes #22559. - - - - - a24b83dd by Matthew Pickering at 2023-06-09T15:19:00-04:00 Fix behaviour of -keep-tmp-files when used in OPTIONS_GHC pragma This fixes the behaviour of -keep-tmp-files when used in an OPTIONS_GHC pragma for files with module level scope. Instead of simple not deleting the files, we also need to remove them from the TmpFs so they are not deleted later on when all the other files are deleted. There are additional complications because you also need to remove the directory where these files live from the TmpFs so we don't try to delete those later either. I added two tests. 1. Tests simply that -keep-tmp-files works at all with a single module and --make mode. 2. The other tests that temporary files are deleted for other modules which don't enable -keep-tmp-files. Fixes #23339 - - - - - dcf32882 by Matthew Pickering at 2023-06-09T15:19:00-04:00 withDeferredDiagnostics: When debugIsOn, write landmine into IORef to catch use-after-free. Ticket #23305 reports an error where we were attempting to use the logger which was created by withDeferredDiagnostics after its scope had ended. This problem would have been caught by this patch and a validate build: ``` +*** Exception: Use after free +CallStack (from HasCallStack): + error, called at compiler/GHC/Driver/Make.hs:<line>:<column> in <package-id>:GHC.Driver.Make ``` This general issue is tracked by #20981 - - - - - 432c736c by Matthew Pickering at 2023-06-09T15:19:00-04:00 Don't return complete HscEnv from upsweep By returning a complete HscEnv from upsweep the logger (as introduced by withDeferredDiagnostics) was escaping the scope of withDeferredDiagnostics and hence we were losing error messages. This is reminiscent of #20981, which also talks about writing errors into messages after their scope has ended. See #23305 for details. - - - - - 26013cdc by Alexander McKenna at 2023-06-09T15:19:41-04:00 Dump `SpecConstr` specialisations separately Introduce a `-ddump-spec-constr` flag which debugs specialisations from `SpecConstr`. These are no longer shown when you use `-ddump-spec`. - - - - - 4639100b by Matthew Pickering at 2023-06-09T18:50:43-04:00 Add role annotations to SNat, SSymbol and SChar Ticket #23454 explained it was possible to implement unsafeCoerce because SNat was lacking a role annotation. As these are supposed to be singleton types but backed by an efficient representation the correct annotation is nominal to ensure these kinds of coerces are forbidden. These annotations were missed from https://github.com/haskell/core-libraries-committee/issues/85 which was implemented in 532de36870ed9e880d5f146a478453701e9db25d. CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/170 Fixes #23454 - - - - - 9c0dcff7 by Matthew Pickering at 2023-06-09T18:51:19-04:00 Remove non-existant bytearray-ops.txt.pp file from ghc.cabal.in This broke the sdist generation. Fixes #23489 - - - - - 273ff0c7 by David Binder at 2023-06-09T18:52:00-04:00 Regression test T13438 is no longer marked as "expect_broken" in the testsuite driver. - - - - - b84a2900 by Andrei Borzenkov at 2023-06-10T08:27:28-04:00 Fix -Wterm-variable-capture scope (#23434) -Wterm-variable-capture wasn't accordant with type variable scoping in associated types, in type classes. For example, this code produced the warning: k = 12 class C k a where type AT a :: k -> Type I solved this issue by reusing machinery of newTyVarNameRn function that is accordand with associated types: it does lookup for each free type variable when we are in the type class context. And in this patch I use result of this work to make sure that -Wterm-variable-capture warns only on implicitly quantified type variables. - - - - - 9d1a8d87 by Jorge Mendes at 2023-06-10T08:28:10-04:00 Remove redundant case statement in rts/js/mem.js. - - - - - a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00 Change WarningWithFlag to plural WarningWithFlags Resolves #22825 Now each diagnostic can name multiple different warning flags for its reason. There is currently one use case: missing signatures. Currently we need to check which warning flags are enabled when generating the diagnostic, which is against the declarative nature of the diagnostic framework. This patch allows a warning diagnostic to have multiple warning flags, which makes setup more declarative. The WarningWithFlag pattern synonym is added for backwards compatibility The 'msgEnvReason' field is added to MsgEnvelope to store the `ResolvedDiagnosticReason`, which accounts for the enabled flags, and then that is used for pretty printing the diagnostic. - - - - - ec01f0ec by Matthew Pickering at 2023-06-13T09:42:59-04:00 Add a test Way for running ghci with Core optimizations Tracking ticket: #23059 This runs compile_and_run tests with optimised code with bytecode interpreter Changed submodules: hpc, process Co-authored-by: Torsten Schmits <git at tryp.io> - - - - - c6741e72 by Rodrigo Mesquita at 2023-06-13T09:43:38-04:00 Configure -Qunused-arguments instead of hardcoding it When GHC invokes clang, it currently passes -Qunused-arguments to discard warnings resulting from GHC using multiple options that aren't used. In this commit, we configure -Qunused-arguments into the Cc options instead of checking if the compiler is clang at runtime and hardcoding the flag into GHC. This is part of the effort to centralise toolchain information in toolchain target files at configure time with the end goal of a runtime retargetable GHC. This also means we don't need to call getCompilerInfo ever, which improves performance considerably (see !10589). Metric Decrease: PmSeriesG T10421 T11303b T12150 T12227 T12234 T12425 T13035 T13253-spj T13386 T15703 T16875 T17836b T17977 T17977b T18140 T18282 T18304 T18698a T18698b T18923 T20049 T21839c T3064 T5030 T5321FD T5321Fun T5837 T6048 T9020 T9198 T9872d T9961 - - - - - 0128db87 by Victor Cacciari Miraldo at 2023-06-13T09:44:18-04:00 Improve docs for Data.Fixed; adds 'realToFrac' as an option for conversion between different precisions. - - - - - 95b69cfb by Ryan Scott at 2023-06-13T09:44:55-04:00 Add regression test for #23143 !10541, the fix for #23323, also fixes #23143. Let's add a regression test to ensure that it stays fixed. Fixes #23143. - - - - - ed2dbdca by Emily Martins at 2023-06-13T09:45:37-04:00 delete GHCi.UI.Tags module and remove remaining references Co-authored-by: Tilde Rose <t1lde at protonmail.com> - - - - - c90d96e4 by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Add regression test for 17328 - - - - - de58080c by Victor Cacciari Miraldo at 2023-06-13T09:46:26-04:00 Skip checking whether constructors are in scope when deriving newtype instances. Fixes #17328 - - - - - 5e3c2b05 by Philip Hazelden at 2023-06-13T09:47:07-04:00 Don't suggest `DeriveAnyClass` when instance can't be derived. Fixes #19692. Prototypical cases: class C1 a where x1 :: a -> Int data G1 = G1 deriving C1 class C2 a where x2 :: a -> Int x2 _ = 0 data G2 = G2 deriving C2 Both of these used to give this suggestion, but for C1 the suggestion would have failed (generated code with undefined methods, which compiles but warns). Now C2 still gives the suggestion but C1 doesn't. - - - - - 80a0b099 by David Binder at 2023-06-13T09:47:49-04:00 Add testcase for error GHC-00711 to testsuite - - - - - e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00 Add -Wmissing-poly-kind-signatures Implements #22826 This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types. - - - - - f8395b94 by doyougnu at 2023-06-14T07:02:01-04:00 ci: special case in req_host_target_ghc for JS - - - - - b852a5b6 by Gergo ERDI at 2023-06-14T07:02:42-04:00 When forcing a `ModIface`, force the `MINIMAL` pragmas in class definitions Fixes #23486 - - - - - c29b45ee by Krzysztof Gogolewski at 2023-06-14T07:03:19-04:00 Add a testcase for #20076 Remove 'recursive' in the error message, since the error can arise without recursion. - - - - - b80ef202 by Krzysztof Gogolewski at 2023-06-14T07:03:56-04:00 Use tcInferFRR to prevent bad generalisation Fixes #23176 - - - - - bd8ef37d by Matthew Pickering at 2023-06-14T07:04:31-04:00 ci: Add dependenices on necessary aarch64 jobs for head.hackage ci These need to be added since we started testing aarch64 on head.hackage CI. The jobs will sometimes fail because they will start before the relevant aarch64 job has finished. Fixes #23511 - - - - - a0c27cee by Vladislav Zavialov at 2023-06-14T07:05:08-04:00 Add standalone kind signatures for Code and TExp CodeQ and TExpQ already had standalone kind signatures even before this change: type TExpQ :: TYPE r -> Kind.Type type CodeQ :: TYPE r -> Kind.Type Now Code and TExp have signatures too: type TExp :: TYPE r -> Kind.Type type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type This is a stylistic change. - - - - - e70c1245 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeLits.Internal should not be used - - - - - 100650e3 by Tom Ellis at 2023-06-14T07:05:48-04:00 Warn that GHC.TypeNats.Internal should not be used - - - - - 078250ef by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add more flags for dumping core passes (#23491) - - - - - 1b7604af by Jacco Krijnen at 2023-06-14T17:17:53-04:00 Add tests for dumping flags (#23491) - - - - - 42000000 by Sebastian Graf at 2023-06-14T17:18:29-04:00 Provide a demand signature for atomicModifyMutVar.# (#23047) Fixes #23047 - - - - - 8f27023b by Ben Gamari at 2023-06-15T03:10:24-04:00 compiler: Cross-reference Note [StgToJS design] In particular, the numeric representations are quite useful context in a few places. - - - - - a71b60e9 by Andrei Borzenkov at 2023-06-15T03:11:00-04:00 Implement the -Wimplicit-rhs-quantification warning (#23510) GHC Proposal #425 "Invisible binders in type declarations" forbids implicit quantification of type variables that occur free on the right-hand side of a type synonym but are not mentioned on the left-hand side. The users are expected to rewrite this using invisible binders: type T1 :: forall a . Maybe a type T1 = 'Nothing :: Maybe a -- old type T1 @a = 'Nothing :: Maybe a -- new Since the @k-binders are a new feature, we need to wait for three releases before we require the use of the new syntax. In the meantime, we ought to provide users with a new warning, -Wimplicit-rhs-quantification, that would detect when such implicit quantification takes place, and include it in -Wcompat. - - - - - 0078dd00 by Sven Tennie at 2023-06-15T03:11:36-04:00 Minor refactorings to mkSpillInstr and mkLoadInstr Better error messages. And, use the existing `off` constant to reduce duplication. - - - - - 1792b57a by doyougnu at 2023-06-15T03:12:17-04:00 JS: merge util modules Merge Core and StgUtil modules for StgToJS pass. Closes: #23473 - - - - - 469ff08b by Vladislav Zavialov at 2023-06-15T03:12:57-04:00 Check visibility of nested foralls in can_eq_nc (#18863) Prior to this change, `can_eq_nc` checked the visibility of the outermost layer of foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here Then it delegated the rest of the work to `can_eq_nc_forall`, which split off all foralls: forall a. forall b. forall c. phi1 forall x. forall y. forall z. phi2 ^^ up to here This meant that some visibility flags were completely ignored. We fix this oversight by moving the check to `can_eq_nc_forall`. - - - - - 59c9065b by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: use regular mask for blocking IO Blocking IO used uninterruptibleMask which should make any thread blocked on IO unreachable by async exceptions (such as those from timeout). This changes it to a regular mask. It's important to note that the nodejs runtime does not actually interrupt the blocking IO when the Haskell thread receives an async exception, and that file positions may be updated and buffers may be written after the Haskell thread has already resumed. Any file descriptor affected by an async exception interruption should therefore be used with caution. - - - - - 907c06c3 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: nodejs: do not set 'readable' handler on stdin at startup The Haskell runtime used to install a 'readable' handler on stdin at startup in nodejs. This would cause the nodejs system to start buffering the stream, causing data loss if the stdin file descriptor is passed to another process. This change delays installation of the 'readable' handler until the first read of stdin by Haskell code. - - - - - a54b40a9 by Luite Stegeman at 2023-06-15T03:13:37-04:00 JS: reserve one more virtual (negative) file descriptor This is needed for upcoming support of the process package - - - - - 78cd1132 by Andrei Borzenkov at 2023-06-15T11:16:11+04:00 Report scoped kind variables at the type-checking phase (#16635) This patch modifies the renamer to respect ScopedTypeVariables in kind signatures. This means that kind variables bound by the outermost `forall` now scope over the type: type F = '[Right @a @() () :: forall a. Either a ()] -- ^^^^^^^^^^^^^^^ ^^^ -- in scope here bound here However, any use of such variables is a type error, because we don't have type-level lambdas to bind them in Core. This is described in the new Note [Type variable scoping errors during type check] in GHC.Tc.Types. - - - - - 4a41ba75 by Sylvain Henry at 2023-06-15T18:09:15-04:00 JS: testsuite: use correct ticket number Replace #22356 with #22349 for these tests because #22356 has been fixed but now these tests fail because of #22349. - - - - - 15f150c8 by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: testsuite: update ticket numbers - - - - - 08d8e9ef by Sylvain Henry at 2023-06-15T18:09:16-04:00 JS: more triage - - - - - e8752e12 by Krzysztof Gogolewski at 2023-06-15T18:09:52-04:00 Fix test T18522-deb-ppr Fixes #23509 - - - - - 62c56416 by Ben Price at 2023-06-16T05:52:39-04:00 Lint: more details on "Occurrence is GlobalId, but binding is LocalId" This is helpful when debugging a pass which accidentally shadowed a binder. - - - - - d4c10238 by Ryan Hendrickson at 2023-06-16T05:53:22-04:00 Clean a stray bit of text in user guide - - - - - 93647b5c by Vladislav Zavialov at 2023-06-16T05:54:02-04:00 testsuite: Add forall visibility test cases The added tests ensure that the type checker does not confuse visible and invisible foralls. VisFlag1: kind-checking type applications and inferred type variable instantiations VisFlag1_ql: kind-checking Quick Look instantiations VisFlag2: kind-checking type family instances VisFlag3: checking kind annotations on type parameters of associated type families VisFlag4: checking kind annotations on type parameters in type declarations with SAKS VisFlag5: checking the result kind annotation of data family instances - - - - - a5f0c00e by Sylvain Henry at 2023-06-16T12:25:40-04:00 JS: factorize SaneDouble into its own module Follow-up of b159e0e9 whose ticket is #22736 - - - - - 0baf9e7c by Krzysztof Gogolewski at 2023-06-16T12:26:17-04:00 Add tests for #21973 - - - - - 640ea90e by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation for `<**>` - - - - - 2469a813 by Diego Diverio at 2023-06-16T23:07:55-04:00 Update text - - - - - 1f515bbb by Diego Diverio at 2023-06-16T23:07:55-04:00 Update examples - - - - - 7af99a0d by Diego Diverio at 2023-06-16T23:07:55-04:00 Update documentation to actually display code correctly - - - - - 800aad7e by Andrei Borzenkov at 2023-06-16T23:08:32-04:00 Type/data instances: require that variables on the RHS are mentioned on the LHS (#23512) GHC Proposal #425 "Invisible binders in type declarations" restricts the scope of type and data family instances as follows: In type family and data family instances, require that every variable mentioned on the RHS must also occur on the LHS. For example, here are three equivalent type instance definitions accepted before this patch: type family F1 a :: k type instance F1 Int = Any :: j -> j type family F2 a :: k type instance F2 @(j -> j) Int = Any :: j -> j type family F3 a :: k type instance forall j. F3 Int = Any :: j -> j - In F1, j is implicitly quantified and it occurs only on the RHS; - In F2, j is implicitly quantified and it occurs both on the LHS and the RHS; - In F3, j is explicitly quantified. Now F1 is rejected with an out-of-scope error, while F2 and F3 continue to be accepted. - - - - - 9132d529 by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: testsuite: use correct ticket numbers - - - - - c3a1274c by Sylvain Henry at 2023-06-18T02:50:34-04:00 JS: don't dump eventlog to stderr by default Fix T16707 Bump stm submodule - - - - - 89bb8ad8 by Ryan Hendrickson at 2023-06-18T02:51:14-04:00 Fix TH name lookup for symbolic tycons (#23525) - - - - - cb9e1ce4 by Finley McIlwaine at 2023-06-18T21:16:45-06:00 IPE data compression IPE data resulting from the `-finfo-table-map` flag may now be compressed by configuring the GHC build with the `--enable-ipe-data-compression` flag. This results in about a 20% reduction in the size of IPE-enabled build results. The compression library, zstd, may optionally be statically linked by configuring with the `--enabled-static-libzstd` flag (on non-darwin platforms) libzstd version 1.4.0 or greater is required. - - - - - 0cbc3ae0 by Gergő Érdi at 2023-06-19T09:11:38-04:00 Add `IfaceWarnings` to represent the `ModIface`-storable parts of a `Warnings GhcRn`. Fixes #23516 - - - - - 3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00 Avoid desugaring non-recursive lets into recursive lets This prepares for having linear let expressions in the frontend. When desugaring lets, SPECIALISE statements create more copies of a let binding. Because of the rewrite rules attached to the bindings, there are dependencies between the generated binds. Before this commit, we simply wrapped all these in a mutually recursive let block, and left it to the simplified to sort it out. With this commit: we are careful to generate the bindings in dependency order, so that we can wrap them in consecutive lets (if the source is non-recursive). - - - - - 9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00 rts: Do not call exit() from SIGINT handler Previously `shutdown_handler` would call `stg_exit` if the scheduler was Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However, `stg_exit` is not signal-safe as it calls `exit` (which calls `atexit` handlers). The only safe thing to do in this situation is to call `_exit`, which terminates with minimal cleanup. Fixes #23417. - - - - - 7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00 Bump Cabal submodule This requires changing the recomp007 test because now cabal passes `this-unit-id` to executable components, and that unit-id contains a hash which includes the ABI of the dependencies. Therefore changing the dependencies means that -this-unit-id changes and recompilation is triggered. The spririt of the test is to test GHC's recompilation logic assuming that `-this-unit-id` is constant, so we explicitly pass `-ipid` to `./configure` rather than letting `Cabal` work it out. - - - - - 1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00 [feat] add a hint to `HasField` error message - add a hint that indicates that the record that the record dot is used on might just be missing a field - as the intention of the programmer is not entirely clear, it is only shown if the type is known - This addresses in part issue #22382 - - - - - b65e78dd by Ben Gamari at 2023-06-20T16:56:43-04:00 rts/ipe: Fix unused lock warning - - - - - 6086effd by Ben Gamari at 2023-06-20T16:56:44-04:00 rts/ProfilerReportJson: Fix memory leak - - - - - 1e48c434 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Various warnings fixes - - - - - 471486b9 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix printf format mismatch - - - - - 80603fb3 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect #include <sys/poll.h> According to Alpine's warnings and poll(2), <poll.h> should be preferred. - - - - - ff18e6fd by Ben Gamari at 2023-06-20T16:56:44-04:00 nonmoving: Fix unused definition warrnings - - - - - 6e7fe8ee by Ben Gamari at 2023-06-20T16:56:44-04:00 Disable futimens on Darwin. See #22938 - - - - - b7706508 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect CPP guard - - - - - 94f00e9b by Ben Gamari at 2023-06-20T16:56:44-04: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. - - - - - 5fb54bf8 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Disable `#pragma GCC`s on clang compilers Otherwise the build fails due to warnings. See #23530. - - - - - cf87f380 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix capitalization of prototype - - - - - 17f250d7 by Ben Gamari at 2023-06-20T16:56:44-04:00 rts: Fix incorrect format specifier - - - - - 0ff1c501 by Josh Meredith at 2023-06-20T16:57:20-04:00 JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576) - - - - - 3d1d42b7 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Memory usage fixes for Haddock - Do not include `mi_globals` in the `NoBackend` backend. It was only included for Haddock, but Haddock does not actually need it. This causes a 200MB reduction in max residency when generating haddocks on the Agda codebase (roughly 1GB to 800MB). - Make haddock_{parser,renamer}_perf tests more accurate by forcing docs to be written to interface files using `-fwrite-interface` Bumps haddock submodule. Metric Decrease: haddock.base - - - - - 8185b1c2 by Finley McIlwaine at 2023-06-21T12:04:58-04:00 Fix associated data family doc structure items Associated data families were being given their own export DocStructureItems, which resulted in them being documented separately from their classes in haddocks. This commit fixes it. - - - - - 4d356ea3 by Sylvain Henry at 2023-06-21T12:04:59-04: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> - - - - - 3249cf12 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Don't use getKey - - - - - f84ff161 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Stg: return imported FVs This is used to determine what to link when using the interpreter. For now it's only used by the JS interpreter but it could easily be used by the native interpreter too (instead of extracting names from compiled BCOs). - - - - - fab2ad23 by Sylvain Henry at 2023-06-21T12:04:59-04:00 Fix some recompilation avoidance tests - - - - - a897dc13 by Sylvain Henry at 2023-06-21T12:04:59-04:00 TH_import_loop is now broken as expected - - - - - dbb4ad51 by Sylvain Henry at 2023-06-21T12:04:59-04:00 JS: always recompile when TH is enabled (cf #23013) - - - - - 711b1d24 by Bartłomiej Cieślar at 2023-06-21T12:59:27-04:00 Add support for deprecating exported items (proposal #134) This is an implementation of the deprecated exports proposal #134. The proposal introduces an ability to introduce warnings to exports. This allows for deprecating a name only when it is exported from a specific module, rather than always depreacting its usage. In this example: module A ({-# DEPRECATED "do not use" #-} x) where x = undefined --- module B where import A(x) `x` will emit a warning when it is explicitly imported. Like the declaration warnings, export warnings are first accumulated within the `Warnings` struct, then passed into the ModIface, from which they are then looked up and warned about in the importing module in the `lookup_ie` helpers of the `filterImports` function (for the explicitly imported names) and in the `addUsedGRE(s)` functions where they warn about regular usages of the imported name. In terms of the AST information, the custom warning is stored in the extension field of the variants of the `IE` type (see Trees that Grow for more information). The commit includes a bump to the haddock submodule added in MR #28 Signed-off-by: Bartłomiej Cieślar <bcieslar2001 at gmail.com> - - - - - c1865854 by Ben Gamari at 2023-06-21T12:59:30-04:00 configure: Bump version to 9.8 Bumps Haddock submodule - - - - - 4e1de71c by Ben Gamari at 2023-06-21T21:07:48-04:00 configure: Bump version to 9.9 Bumps haddock submodule. - - - - - 5b6612bc by Ben Gamari at 2023-06-23T03:56:49-04:00 rts: Work around missing prototypes errors Darwin's toolchain inexpliciably claims that `write_barrier` and friends have declarations without prototypes, despite the fact that (a) they are definitions, and (b) the prototypes appear only a few lines above. Work around this by making the definitions proper prototypes. - - - - - 43b66a13 by Matthew Pickering at 2023-06-23T03:57:26-04:00 ghcup-metadata: Fix date modifier (M = minutes, m = month) Fixes #23552 - - - - - 564164ef by Luite Stegeman at 2023-06-24T10:27:29+09:00 Support large stack frames/offsets in GHCi bytecode interpreter Bytecode instructions like PUSH_L (push a local variable) contain an operand that refers to the stack slot. Before this patch, the operand type was SmallOp (Word16), limiting the maximum stack offset to 65535 words. This could cause compiler panics in some cases (See #22888). This patch changes the operand type for stack offsets from SmallOp to Op, removing the stack offset limit. Fixes #22888 - - - - - 8d6574bc by Sylvain Henry at 2023-06-26T13:15:06-04:00 JS: support levity-polymorphic datatypes (#22360,#22291) - thread knowledge about levity into PrimRep instead of panicking - JS: remove assumption that unlifted heap objects are rts objects (TVar#, etc.) Doing this also fixes #22291 (test added). There is a small performance hit (~1% more allocations). Metric Increase: T18698a T18698b - - - - - 5578bbad by Matthew Pickering at 2023-06-26T13:15:43-04:00 MR Review Template: Mention "Blocked on Review" label In order to improve our MR review processes we now have the label "Blocked on Review" which allows people to signal that a MR is waiting on a review to happen. See: https://mail.haskell.org/pipermail/ghc-devs/2023-June/021255.html - - - - - 4427e9cf by Matthew Pickering at 2023-06-26T13:15:43-04:00 Move MR template to Default.md This makes it more obvious what you have to modify to affect the default template rather than looking in the project settings. - - - - - 522bd584 by Arnaud Spiwack at 2023-06-26T13:16:33-04:00 Revert "Avoid desugaring non-recursive lets into recursive lets" This (temporary) reverts commit 3e80c2b40213bebe302b1bd239af48b33f1b30ef. Fixes #23550 - - - - - c59fbb0b by Torsten Schmits at 2023-06-26T19:34:20+02:00 Propagate breakpoint information when inlining across modules Tracking ticket: #23394 MR: !10448 * Add constructor `IfaceBreakpoint` to `IfaceTickish` * Store breakpoint data in interface files * Store `BreakArray` for the breakpoint's module, not the current module, in BCOs * Store module name in BCOs instead of `Unique`, since the `Unique` from an `Iface` doesn't match the modules in GHCi's state * Allocate module name in `ModBreaks`, like `BreakArray` * Lookup breakpoint by module name in GHCi * Skip creating breakpoint instructions when no `ModBreaks` are available, rather than injecting `ModBreaks` in the linker when breakpoints are enabled, and panicking when `ModBreaks` is missing - - - - - 6f904808 by Greg Steuck at 2023-06-27T16:53:07-04:00 Remove undefined FP_PROG_LD_BUILD_ID from configure.ac's - - - - - e89aa072 by Andrei Borzenkov at 2023-06-27T16:53:44-04:00 Remove arity inference in type declarations (#23514) Arity inference in type declarations was introduced as a workaround for the lack of @k-binders. They were added in 4aea0a72040, so I simplified all of this by simply removing arity inference altogether. This is part of GHC Proposal #425 "Invisible binders in type declarations". - - - - - 459dee1b by Torsten Schmits at 2023-06-27T16:54:20-04:00 Relax defaulting of RuntimeRep/Levity when printing Fixes #16468 MR: !10702 Only default RuntimeRep to LiftedRep when variables are bound by the toplevel forall - - - - - 151f8f18 by Torsten Schmits at 2023-06-27T16:54:57-04:00 Remove duplicate link label in linear types docs - - - - - ecdc4353 by Rodrigo Mesquita at 2023-06-28T12:24:57-04:00 Stop configuring unused Ld command in `settings` GHC has no direct dependence on the linker. Rather, we depend upon the C compiler for linking and an object-merging program (which is typically `ld`) for production of GHCi objects and merging of C stubs into final object files. Despite this, for historical reasons we still recorded information about the linker into `settings`. Remove these entries from `settings`, `hadrian/cfg/system.config`, as well as the `configure` logic responsible for this information. Closes #23566. - - - - - bf9ec3e4 by Bryan Richter at 2023-06-28T12:25:33-04:00 Remove extraneous debug output - - - - - 7eb68dd6 by Bryan Richter at 2023-06-28T12:25:33-04:00 Work with unset vars in -e mode - - - - - 49c27936 by Bryan Richter at 2023-06-28T12:25:33-04:00 Pass positional arguments in their positions By quoting $cmd, the default "bash -i" is a single argument to run, and no file named "bash -i" actually exists to be run. - - - - - 887dc4fc by Bryan Richter at 2023-06-28T12:25:33-04:00 Handle unset value in -e context - - - - - 5ffc7d7b by Rodrigo Mesquita at 2023-06-28T21:07:36-04:00 Configure CPP into settings There is a distinction to be made between the Haskell Preprocessor and the C preprocessor. The former is used to preprocess Haskell files, while the latter is used in C preprocessing such as Cmm files. In practice, they are both the same program (usually the C compiler) but invoked with different flags. Previously we would, at configure time, configure the haskell preprocessor and save the configuration in the settings file, but, instead of doing the same for CPP, we had hardcoded in GHC that the CPP program was either `cc -E` or `cpp`. This commit fixes that asymmetry by also configuring CPP at configure time, and tries to make more explicit the difference between HsCpp and Cpp (see Note [Preprocessing invocations]). Note that we don't use the standard CPP and CPPFLAGS to configure Cpp, but instead use the non-standard --with-cpp and --with-cpp-flags. The reason is that autoconf sets CPP to "$CC -E", whereas we expect the CPP command to be configured as a standalone executable rather than a command. These are symmetrical with --with-hs-cpp and --with-hs-cpp-flags. Cleanup: Hadrian no longer needs to pass the CPP configuration for CPP to be C99 compatible through -optP, since we now configure that into settings. Closes #23422 - - - - - 5efa9ca5 by Ben Gamari at 2023-06-28T21:08:13-04:00 hadrian: Always canonicalize topDirectory Hadrian's `topDirectory` is intended to provide an absolute path to the root of the GHC tree. However, if the tree is reached via a symlink this One question here is whether the `canonicalizePath` call is expensive enough to warrant caching. In a quick microbenchmark I observed that `canonicalizePath "."` takes around 10us per call; this seems sufficiently low not to worry. Alternatively, another approach here would have been to rather move the canonicalization into `m4/fp_find_root.m4`. This would have avoided repeated canonicalization but sadly path canonicalization is a hard problem in POSIX shell. Addresses #22451. - - - - - b3e1436f by aadaa_fgtaa at 2023-06-28T21:08:53-04:00 Optimise ELF linker (#23464) - cache last elements of `relTable`, `relaTable` and `symbolTables` in `ocInit_ELF` - cache shndx table in ObjectCode - run `checkProddableBlock` only with debug rts - - - - - 30525b00 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Introduce MO_{ACQUIRE,RELEASE}_FENCE - - - - - b787e259 by Ben Gamari at 2023-06-28T21:09:30-04:00 compiler: Drop MO_WriteBarrier rts: Drop write_barrier - - - - - 7550b4a5 by Ben Gamari at 2023-06-28T21:09:30-04:00 rts: Drop load_store_barrier() This is no longer used. - - - - - d5f2875e by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop last instances of prim_{write,read}_barrier - - - - - 965ac2ba by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Eliminate remaining uses of load_load_barrier - - - - - 0fc5cb97 by Sven Tennie at 2023-06-28T21:09:31-04:00 compiler: Drop MO_ReadBarrier - - - - - 7a7d326c by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Drop load_load_barrier This is no longer used. - - - - - 9f63da66 by Sven Tennie at 2023-06-28T21:09:31-04:00 Delete write_barrier function - - - - - bb0ed354 by Ben Gamari at 2023-06-28T21:09:31-04:00 rts: Make collectFreshWeakPtrs definition a prototype x86-64/Darwin's toolchain inexplicably warns that collectFreshWeakPtrs needs to be a prototype. - - - - - ef81a1eb by Sven Tennie at 2023-06-28T21:10:08-04:00 Fix number of free double regs D1..D4 are defined for aarch64 and thus not free. - - - - - c335fb7c by Ryan Scott at 2023-06-28T21:10:44-04:00 Fix typechecking of promoted empty lists The `'[]` case in `tc_infer_hs_type` is smart enough to handle arity-0 uses of `'[]` (see the newly added `T23543` test case for an example), but the `'[]` case in `tc_hs_type` was not. We fix this by changing the `tc_hs_type` case to invoke `tc_infer_hs_type`, as prescribed in `Note [Future-proofing the type checker]`. There are some benign changes to test cases' expected output due to the new code path using `forall a. [a]` as the kind of `'[]` rather than `[k]`. Fixes #23543. - - - - - fcf310e7 by Rodrigo Mesquita at 2023-06-28T21:11:21-04:00 Configure MergeObjs supports response files rather than Ld The previous configuration script to test whether Ld supported response files was * Incorrect (see #23542) * Used, in practice, to check if the *merge objects tool* supported response files. This commit modifies the macro to run the merge objects tool (rather than Ld), using a response file, and checking the result with $NM Fixes #23542 - - - - - 78b2f3cc by Sylvain Henry at 2023-06-28T21:12:02-04:00 JS: fix JS stack printing (#23565) - - - - - 9f01d14b by Matthew Pickering at 2023-06-29T04:13:41-04:00 Add -fpolymorphic-specialisation flag (off by default at all optimisation levels) Polymorphic specialisation has led to a number of hard to diagnose incorrect runtime result bugs (see #23469, #23109, #21229, #23445) so this commit introduces a flag `-fpolymorhphic-specialisation` which allows users to turn on this experimental optimisation if they are willing to buy into things going very wrong. Ticket #23469 - - - - - b1e611d5 by Ben Gamari at 2023-06-29T04:14:17-04:00 Rip out runtime linker/compiler checks We used to choose flags to pass to the toolchain at runtime based on the platform running GHC, and in this commit we drop all of those runtime linker checks Ultimately, this represents a change in policy: We no longer adapt at runtime to the toolchain being used, but rather make final decisions about the toolchain used at /configure time/ (we have deleted Note [Run-time linker info] altogether!). This works towards the goal of having all toolchain configuration logic living in the same place, which facilities the work towards a runtime-retargetable GHC (see #19877). As of this commit, the runtime linker/compiler logic was moved to autoconf, but soon it, and the rest of the existing toolchain configuration logic, will live in the standalone ghc-toolchain program (see !9263) In particular, what used to be done at runtime is now as follows: * The flags -Wl,--no-as-needed for needed shared libs are configured into settings * The flag -fstack-check is configured into settings * The check for broken tables-next-to-code was outdated * We use the configured c compiler by default as the assembler program * We drop `asmOpts` because we already configure -Qunused-arguments flag into settings (see !10589) Fixes #23562 Co-author: Rodrigo Mesquita (@alt-romes) - - - - - 8b35e8ca by Ben Gamari at 2023-06-29T18:46:12-04:00 Define FFI_GO_CLOSURES The libffi shipped with Apple's XCode toolchain does not contain a definition of the FFI_GO_CLOSURES macro, despite containing references to said macro. Work around this by defining the macro, following the model of a similar workaround in OpenJDK [1]. [1] https://github.com/openjdk/jdk17u-dev/pull/741/files - - - - - d7ef1704 by Ben Gamari at 2023-06-29T18:46:12-04:00 base: Fix incorrect CPP guard This was guarded on `darwin_HOST_OS` instead of `defined(darwin_HOST_OS)`. - - - - - 7c7d1f66 by Ben Gamari at 2023-06-29T18:46:48-04:00 rts/Trace: Ensure that debugTrace arguments are used As debugTrace is a macro we must take care to ensure that the fact is clear to the compiler lest we see warnings. - - - - - cb92051e by Ben Gamari at 2023-06-29T18:46:48-04:00 rts: Various warnings fixes - - - - - dec81dd1 by Ben Gamari at 2023-06-29T18:46:48-04:00 hadrian: Ignore warnings in unix and semaphore-compat - - - - - 42e6a8b0 by Ben Gamari at 2023-06-30T12:10:55-04:00 primops: Introduce unsafeThawByteArray# This addresses an odd asymmetry in the ByteArray# primops, which previously provided unsafeFreezeByteArray# but no corresponding thaw operation. Closes #22710 - - - - - 11 changed files: - .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/36fe85b90f5cdb36f2323d6ba6f4e6f59596fbc8...42e6a8b057a858c68cb9740301f8126b108ab126 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/36fe85b90f5cdb36f2323d6ba6f4e6f59596fbc8...42e6a8b057a858c68cb9740301f8126b108ab126 You're receiving 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 Jun 30 21:48:19 2023 From: gitlab at gitlab.haskell.org (Simon Peyton Jones (@simonpj)) Date: Fri, 30 Jun 2023 17:48:19 -0400 Subject: [Git][ghc/ghc][wip/simplifier-tweaks] Optimise every time we do mkTransCo Message-ID: <649f4da336f63_238a8e18f7fff4435577@gitlab.mail> Simon Peyton Jones pushed to branch wip/simplifier-tweaks at Glasgow Haskell Compiler / GHC Commits: ce6e6c6f by Simon Peyton Jones at 2023-06-30T22:47:56+01:00 Optimise every time we do mkTransCo - - - - - 2 changed files: - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify/Env.hs ===================================== @@ -23,6 +23,7 @@ module GHC.Core.Opt.Simplify.Env ( getInScope, setInScopeFromE, setInScopeFromF, setInScopeSet, modifyInScope, addNewInScopeIds, getSimplRules, enterRecGroupRHSs, + bumpCallDepth, reSimplifying, -- * Substitution results SimplSR(..), mkContEx, substId, lookupRecBndr, @@ -61,28 +62,31 @@ import GHC.Core.Utils import GHC.Core.Multiplicity ( scaleScaled ) import GHC.Core.Unfold import GHC.Core.TyCo.Subst (emptyIdSubstEnv) -import GHC.Types.Var -import GHC.Types.Var.Env -import GHC.Types.Var.Set -import GHC.Data.OrdList -import GHC.Data.Graph.UnVar -import GHC.Types.Id as Id import GHC.Core.Make ( mkWildValBinder, mkCoreLet ) -import GHC.Builtin.Types -import qualified GHC.Core.Type as Type import GHC.Core.Type hiding ( substTy, substTyVar, substTyVarBndr, substCo , extendTvSubst, extendCvSubst ) import qualified GHC.Core.Coercion as Coercion import GHC.Core.Coercion hiding ( substCo, substCoVar, substCoVarBndr ) -import GHC.Core.Coercion.Opt( OptCoercionOpts(..) ) -import GHC.Platform ( Platform ) +import qualified GHC.Core.Type as Type + +import GHC.Types.Var +import GHC.Types.Var.Env +import GHC.Types.Var.Set +import GHC.Types.Id as Id import GHC.Types.Basic +import GHC.Types.Unique.FM ( pprUniqFM ) + +import GHC.Builtin.Types + +import GHC.Data.OrdList +import GHC.Data.Graph.UnVar +import GHC.Platform ( Platform ) + import GHC.Utils.Monad import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Panic.Plain import GHC.Utils.Misc -import GHC.Types.Unique.FM ( pprUniqFM ) import Data.List ( intersperse, mapAccumL ) @@ -182,6 +186,8 @@ data SimplEnv , seInScope :: !InScopeSet -- OutVars only , seCaseDepth :: !Int -- Depth of multi-branch case alternatives + , seCallDepth :: !Int -- 0 initially, 1 when we inline an already-simplified + -- unfolding, and simplify again; and so on } seArityOpts :: SimplEnv -> ArityOpts @@ -496,7 +502,8 @@ mkSimplEnv mode fam_envs , seCvSubst = emptyVarEnv , seIdSubst = emptyVarEnv , seRecIds = emptyUnVarSet - , seCaseDepth = 0 } + , seCaseDepth = 0 + , seCallDepth = 0 } -- The top level "enclosing CC" is "SUBSUMED". init_in_scope :: InScopeSet @@ -532,6 +539,12 @@ updMode upd env bumpCaseDepth :: SimplEnv -> SimplEnv bumpCaseDepth env = env { seCaseDepth = seCaseDepth env + 1 } +bumpCallDepth :: SimplEnv -> SimplEnv +bumpCallDepth env = env { seCallDepth = seCallDepth env + 1 } + +reSimplifying :: SimplEnv -> Bool +reSimplifying (SimplEnv { seCallDepth = n }) = n>0 + --------------------- extendIdSubst :: SimplEnv -> Id -> SimplSR -> SimplEnv extendIdSubst env@(SimplEnv {seIdSubst = subst}) var res @@ -617,11 +630,9 @@ setInScopeFromE. --------------------- zapSubstEnv :: SimplEnv -> SimplEnv -zapSubstEnv env@(SimplEnv { seMode = mode }) +zapSubstEnv env@(SimplEnv { seMode = mode, seCallDepth = n }) = env { seTvSubst = emptyVarEnv, seCvSubst = emptyVarEnv, seIdSubst = emptyVarEnv - , seMode = mode { sm_co_opt_opts = OptCoercionOpts False } } - -- Zapping coercion optimisation here saves a /lot/ in T18223; - -- reduces compiled time allocation by more than 50% + , seCallDepth = n+1 } setSubstEnv :: SimplEnv -> TvSubstEnv -> CvSubstEnv -> SimplIdSubst -> SimplEnv setSubstEnv env tvs cvs ids = env { seTvSubst = tvs, seCvSubst = cvs, seIdSubst = ids } ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -18,7 +18,7 @@ import GHC.Driver.Flags import GHC.Core import GHC.Core.Opt.Simplify.Monad import GHC.Core.Opt.ConstantFold -import GHC.Core.Type hiding ( substTy, substTyVar, extendTvSubst, extendCvSubst ) +import GHC.Core.Type hiding ( substCo, substTy, substTyVar, extendTvSubst, extendCvSubst ) import GHC.Core.TyCo.Compare( eqType ) import GHC.Core.Opt.Simplify.Env import GHC.Core.Opt.Simplify.Inline @@ -1334,7 +1334,10 @@ simplCoercionF env co cont simplCoercion :: SimplEnv -> InCoercion -> SimplM OutCoercion simplCoercion env co - = do { let opt_co = optCoercion opts (getSubst env) co + = do { let opt_co | reSimplifying env + = substCo env co + | otherwise + = optCoercion opts (getSubst env) co ; seqCo opt_co `seq` return opt_co } where opts = seOptCoercionOpts env @@ -1615,6 +1618,9 @@ simplCast env body co0 cont0 else addCoerce co1 cont0 ; {-#SCC "simplCast-simplExprF" #-} simplExprF env body cont1 } where + empty_subst = mkEmptySubst (seInScope env) + opts = seOptCoercionOpts env + -- If the first parameter is MRefl, then simplifying revealed a -- reflexive coercion. Omit. addCoerceM :: MOutCoercion -> SimplCont -> SimplM SimplCont @@ -1623,10 +1629,10 @@ simplCast env body co0 cont0 addCoerce :: OutCoercion -> SimplCont -> SimplM SimplCont addCoerce co1 (CastIt co2 cont) -- See Note [Optimising reflexivity] - | isReflexiveCo co' = return cont - | otherwise = addCoerce co' cont + | isReflCo co' = return cont + | otherwise = addCoerce co' cont where - co' = mkTransCo co1 co2 + co' = optCoercion opts empty_subst (mkTransCo co1 co2) addCoerce co (ApplyToTy { sc_arg_ty = arg_ty, sc_cont = tail }) | Just (arg_ty', m_co') <- pushCoTyArg co arg_ty View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ce6e6c6f9bced132be8e01f65116414fe69906b8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ce6e6c6f9bced132be8e01f65116414fe69906b8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: